diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/AUTHORS b/Luminescence.BuildResults/Library/RcppArmadillo/AUTHORS deleted file mode 100644 index ddb2ede54..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/AUTHORS +++ /dev/null @@ -1,15 +0,0 @@ - -Armadillo itself carries the following in file NOTICE.TXT: - - Armadillo C++ Linear Algebra Library - Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) - Copyright 2008-2016 National ICT Australia (NICTA) - - This product includes software developed by Conrad Sanderson (http://conradsanderson.id.au) - This product includes software developed at National ICT Australia (NICTA) - - -The RcppArmadillo package integrates Armadillo into R, provides wrappers, -converters, a test framework, examples and more. It was written by Dirk -Eddelbuettel, Romain Francois and Doug Bates with contributions by many -others as detailed in the ChangeLog file. diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/CITATION b/Luminescence.BuildResults/Library/RcppArmadillo/CITATION deleted file mode 100644 index ddfcf32bd..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/CITATION +++ /dev/null @@ -1,17 +0,0 @@ -bibentry("Article", - title = "RcppArmadillo: Accelerating R with high-performance C++ linear algebra", - author = c(person("Dirk", "Eddelbuettel", - email = "edd@debian.org", - comment = c(ORCID = "0000-0001-6419-907X")), - person("Conrad", "Sanderson", - comment = c(ORCID = "0000-0002-0049-4501"))), - journal = "Computational Statistics and Data Analysis", - year = "2014", - volume = "71", - month = "March", - pages = "1054--1063", - doi = "10.1016/j.csda.2013.02.005" - ) - -bibentry("Manual", - other = unlist(citation(auto = meta), recursive = FALSE)) diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/COPYRIGHTS b/Luminescence.BuildResults/Library/RcppArmadillo/COPYRIGHTS deleted file mode 100644 index 05d61f540..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/COPYRIGHTS +++ /dev/null @@ -1,22 +0,0 @@ - -Overall license: -================ - - The (vast) majority of the files in this package are released under the - Apache License, Version 2.0, January 2004 (http://www.apache.org/licenses/) - - The aggregation, integration and packaging work is released under the - GNU GPL (>= 2). - -Details: -======== - -Files: * -Copyright: 2010 - 2017 Dirk Eddelbuettel, Romain Francois and Doug Bates -License: GPL (>= 2) - -Files: inst/include/armadillo: - inst/include/armadillo_bits/*: -Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -Copyright 2008-2016 National ICT Australia (NICTA) -License: Apache-2.0 diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/DESCRIPTION b/Luminescence.BuildResults/Library/RcppArmadillo/DESCRIPTION deleted file mode 100644 index c35b2ffbd..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/DESCRIPTION +++ /dev/null @@ -1,49 +0,0 @@ -Package: RcppArmadillo -Type: Package -Title: 'Rcpp' Integration for the 'Armadillo' Templated Linear Algebra - Library -Version: 14.0.2-1 -Date: 2024-09-10 -Authors@R: c(person("Dirk", "Eddelbuettel", role = c("aut", "cre"), email = "edd@debian.org", - comment = c(ORCID = "0000-0001-6419-907X")), - person("Romain", "Francois", role = "aut", - comment = c(ORCID = "0000-0002-2444-4226")), - person("Doug", "Bates", role = "aut", - comment = c(ORCID = "0000-0001-8316-9503")), - person("Binxiang", "Ni", role = "aut"), - person("Conrad", "Sanderson", role = "aut", - comment = c(ORCID = "0000-0002-0049-4501"))) -Description: 'Armadillo' is a templated C++ linear algebra library (by Conrad - Sanderson) that aims towards a good balance between speed and ease of - use. Integer, floating point and complex numbers are supported, as - well as a subset of trigonometric and statistics functions. Various - matrix decompositions are provided through optional integration with - LAPACK and ATLAS libraries. The 'RcppArmadillo' package includes the - header files from the templated 'Armadillo' library. Thus users do - not need to install 'Armadillo' itself in order to use - 'RcppArmadillo'. From release 7.800.0 on, 'Armadillo' is licensed - under Apache License 2; previous releases were under licensed as MPL - 2.0 from version 3.800.0 onwards and LGPL-3 prior to that; - 'RcppArmadillo' (the 'Rcpp' bindings/bridge to Armadillo) is licensed - under the GNU GPL version 2 or later, as is the rest of 'Rcpp'. -License: GPL (>= 2) -LazyLoad: yes -Depends: R (>= 3.3.0) -LinkingTo: Rcpp -Imports: Rcpp (>= 1.0.8), stats, utils, methods -Suggests: tinytest, Matrix (>= 1.3.0), pkgKitten, reticulate, slam -URL: https://github.com/RcppCore/RcppArmadillo, - https://dirk.eddelbuettel.com/code/rcpp.armadillo.html -BugReports: https://github.com/RcppCore/RcppArmadillo/issues -RoxygenNote: 6.0.1 -NeedsCompilation: yes -Packaged: 2024-09-11 13:53:21 UTC; edd -Author: Dirk Eddelbuettel [aut, cre] (), - Romain Francois [aut] (), - Doug Bates [aut] (), - Binxiang Ni [aut], - Conrad Sanderson [aut] () -Maintainer: Dirk Eddelbuettel -Repository: CRAN -Date/Publication: 2024-09-12 06:50:02 UTC -Built: R 4.4.1; aarch64-apple-darwin20; 2024-09-12 11:16:46 UTC; unix diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/INDEX b/Luminescence.BuildResults/Library/RcppArmadillo/INDEX deleted file mode 100644 index 2c6006907..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/INDEX +++ /dev/null @@ -1,17 +0,0 @@ -RcppArmadillo-package R and Armadillo Integration -RcppArmadillo.package.skeleton - Create a skeleton for a new package that - intends to use RcppArmadillo -armadillo_get_number_of_omp_threads - Report (or Set) Maximum Number of OpenMP - Threads -armadillo_set_seed Set the Armadillo Random Number Generator to - the given value -armadillo_set_seed_random - Set the Armadillo Random Number Generator to a - random value -armadillo_throttle_cores - Throttle (or Reset) (Rcpp)Armadillo to Two - Cores -armadillo_version Report the version of Armadillo -fastLm Bare-bones linear model fitting function diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/Meta/Rd.rds b/Luminescence.BuildResults/Library/RcppArmadillo/Meta/Rd.rds deleted file mode 100644 index a8b4002e9..000000000 Binary files a/Luminescence.BuildResults/Library/RcppArmadillo/Meta/Rd.rds and /dev/null differ diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/Meta/features.rds b/Luminescence.BuildResults/Library/RcppArmadillo/Meta/features.rds deleted file mode 100644 index 781f60d47..000000000 Binary files a/Luminescence.BuildResults/Library/RcppArmadillo/Meta/features.rds and /dev/null differ diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/Meta/hsearch.rds b/Luminescence.BuildResults/Library/RcppArmadillo/Meta/hsearch.rds deleted file mode 100644 index 3a1891bd8..000000000 Binary files a/Luminescence.BuildResults/Library/RcppArmadillo/Meta/hsearch.rds and /dev/null differ diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/Meta/links.rds b/Luminescence.BuildResults/Library/RcppArmadillo/Meta/links.rds deleted file mode 100644 index 816ad0f35..000000000 Binary files a/Luminescence.BuildResults/Library/RcppArmadillo/Meta/links.rds and /dev/null differ diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/Meta/nsInfo.rds b/Luminescence.BuildResults/Library/RcppArmadillo/Meta/nsInfo.rds deleted file mode 100644 index dc3bf5699..000000000 Binary files a/Luminescence.BuildResults/Library/RcppArmadillo/Meta/nsInfo.rds and /dev/null differ diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/Meta/package.rds b/Luminescence.BuildResults/Library/RcppArmadillo/Meta/package.rds deleted file mode 100644 index a196b1a5f..000000000 Binary files a/Luminescence.BuildResults/Library/RcppArmadillo/Meta/package.rds and /dev/null differ diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/Meta/vignette.rds b/Luminescence.BuildResults/Library/RcppArmadillo/Meta/vignette.rds deleted file mode 100644 index b6f1effca..000000000 Binary files a/Luminescence.BuildResults/Library/RcppArmadillo/Meta/vignette.rds and /dev/null differ diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/NAMESPACE b/Luminescence.BuildResults/Library/RcppArmadillo/NAMESPACE deleted file mode 100644 index f3c50c6dd..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/NAMESPACE +++ /dev/null @@ -1,25 +0,0 @@ -useDynLib("RcppArmadillo", .registration=TRUE) - -importFrom("Rcpp", "evalCpp", "sourceCpp") -importFrom("stats", "coef", "fitted", "model.frame", "model.matrix", "model.response", "printCoefmat", "pt") -importFrom("utils", "packageDescription", "package.skeleton") -importFrom("methods", "new") - -export("fastLmPure", - "fastLm", - "RcppArmadillo.package.skeleton", - "armadillo_version", - "armadillo_set_seed", - "armadillo_set_seed_random", - - "armadillo_throttle_cores", - "armadillo_reset_cores", - "armadillo_get_number_of_omp_threads", - "armadillo_set_number_of_omp_threads" - ) -S3method("fastLm", "default") -S3method("fastLm", "formula") -S3method("predict", "fastLm") -S3method("print", "fastLm") -S3method("summary", "fastLm") -S3method("print", "summary.fastLm") diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/NEWS.Rd b/Luminescence.BuildResults/Library/RcppArmadillo/NEWS.Rd deleted file mode 100644 index d13132750..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/NEWS.Rd +++ /dev/null @@ -1,2811 +0,0 @@ -\name{NEWS} -\title{News for Package \pkg{RcppArmadillo}} -\newcommand{\ghpr}{\href{https://github.com/RcppCore/RcppArmadillo/pull/#1}{##1}} -\newcommand{\ghit}{\href{https://github.com/RcppCore/RcppArmadillo/issues/#1}{##1}} - -\section{Changes in RcppArmadillo version 14.0.2-1 (2024-09-11)}{ - \itemize{ - \item Upgraded to Armadillo release 14.0.2 (Stochastic Parrot) - \itemize{ - \item Optionally use C++20 memory alignment - \item Minor corrections for several corner-cases - } - \item The order of items displayed by \code{citation()} is reversed (Conrad - in \ghpr{449}) - \item The DESCRIPTION file now uses an Authors@R field with ORCID IDs - } -} - -\section{Changes in RcppArmadillo version 14.0.0-1 (2024-07-05)}{ - \itemize{ - \item Upgraded to Armadillo release 14.0.0 (Stochastic Parrot) - \itemize{ - \item C++14 is now the minimum recommended C++ standard - \item Faster handling of compound expressions by \code{as_scalar()}, - \code{accu()}, \code{dot()} - \item Faster interactions between sparse and dense matrices - \item Expanded \code{stddev()} to handle sparse matrices - \item Expanded relational operators to handle expressions between - sparse matrices and scalars - \item Added \code{.as_dense()} to obtain dense vector/matrix - representation of any sparse matrix expression - \item Updated physical constants to NIST 2022 CODATA values - } - \item New package version numbering scheme following upstream versions - \item Re-enabling \code{ARMA_IGNORE_DEPRECATED_MARKE} for silent CRAN - builds - } -} - -\section{Changes in RcppArmadillo version 0.12.8.4.0 (2024-05-30)}{ - \itemize{ - \item Upgraded to Armadillo release 12.8.4 (Cortisol Injector) - \itemize{ - \item Faster handling of sparse submatrix views - } - \item Update versioned Depends on \pkg{Rcpp} to 1.0.8 or later to match - use of Light/Lighter/Lightest headers. - } -} - -\section{Changes in RcppArmadillo version 0.12.8.3.0 (2024-05-07)}{ - \itemize{ - \item Upgraded to Armadillo release 12.8.3 (Cortisol Injector) - \itemize{ - \item Fix issue in \code{fft()} and \code{fft2()} in multi-threaded - contexts with FFTW3 enabled - } - \item No longer set C++11 for the \pkg{Rcpp} plugin as this standard has - been the default by R for very long time now. - } -} - -\section{Changes in RcppArmadillo version 0.12.8.2.1 (2024-04-15)}{ - \itemize{ - \item One-char bug fix release commenting out one test that upsets - \pkg{reticulate} when accessing a \pkg{scipy} sparse matrix - } -} - -\section{Changes in RcppArmadillo version 0.12.8.2.0 (2024-04-02)}{ - \itemize{ - \item Upgraded to Armadillo release 12.8.2 (Cortisol Injector) - \itemize{ - \item Workaround for FFTW3 header clash - \item Workaround in testing framework for issue under macOS - \item Minor cleanups to reduce code bloat - \item Improved documentation - } - } -} - -\section{Changes in RcppArmadillo version 0.12.8.1.0 (2024-03-02)}{ - \itemize{ - \item Upgraded to Armadillo release 12.8.1 (Cortisol Injector) - \itemize{ - \item Workaround in \code{norm()} for yet another bug in macOS - accelerate framework - } - \item Update README for RcppArmadillo usage counts - \item Update examples to use '#include ' for - faster compilation excluding unused Rcpp features - } -} - -\section{Changes in RcppArmadillo version 0.12.8.0.0 (2024-02-06)}{ - \itemize{ - \item Upgraded to Armadillo release 12.8.0 (Cortisol Injector) - \itemize{ - \item Faster detection of symmetric expressions by \code{pinv()} and \code{rank()} - \item Expanded \code{shift()} to handle sparse matrices - \item Expanded \code{conv_to} for more flexible conversions between - sparse and dense matrices - \item Added \code{cbrt()} - \item More compact representation of integers when saving matrices in CSV format - } - \item Five non-user facing top-level include files have been removed - (\ghpr{432} closing \ghit{400} and building on \ghpr{395} and \ghpr{396}) - } -} - -\section{Changes in RcppArmadillo version 0.12.6.7.0 (2023-12-18)}{ - \itemize{ - \item Upgraded to Armadillo release 12.6.7 (Cortisol Retox) - \itemize{ - \item Fix for saving sparse matrices as CSV files - } - \item Added unit tests for thread throttling - } -} - -\section{Changes in RcppArmadillo version 0.12.6.6.1 (2023-12-03)}{ - \itemize{ - \item Following the extendeded transition in \ghit{391} and \ghit{402}, - this release no longer sets \code{ARMA_IGNORE_DEPRECATED_MARKER}. - Maintainers of affected packages have received pull requests or patches - and can set \code{-DARMA_IGNORE_DEPRECATED_MARKER} as \code{PKG_CPPFLAGS}. - } -} - -\section{Changes in RcppArmadillo version 0.12.6.6.0 (2023-10-31)}{ - \itemize{ - \item Upgraded to Armadillo release 12.6.6 (Cortisol Retox) - \itemize{ - \item Fix \code{eigs_sym()}, \code{eigs_gen()} and \code{svds()} to - generate deterministic results in ARPACK mode - } - \item Add helper functions to set and get the number of OpenMP threads - \item Store initial thread count at package load and use in - thread-throttling helper (and resetter) suitable for CRAN constraints - } -} - -\section{Changes in RcppArmadillo version 0.12.6.5.0 (2023-10-14)}{ - \itemize{ - \item Upgraded to Armadillo release 12.6.5 (Cortisol Retox) - \itemize{ - \item Fix for corner-case bug in handling sparse matrices with no - non-zero elements - } - } -} - -\section{Changes in RcppArmadillo version 0.12.6.4.0 (2023-09-06)}{ - \itemize{ - \item Upgraded to Armadillo release 12.6.4 (Cortisol Retox) - \itemize{ - \item Workarounds for bugs in Apple accelerate framework - \item Fix incorrect calculation of rcond for band matrices in \code{solve()} - \item Remove expensive and seldom used optimisations, leading to faster - compilation times - } - } -} - -\section{Changes in RcppArmadillo version 0.12.6.3.0 (2023-08-28)}{ - \itemize{ - \item Upgraded to Armadillo release 12.6.3 (Cortisol Retox) - \itemize{ - \item Fix for corner-case in loading CSV files with headers - \item For consistent file handling, all \code{.load()} functions now - open text files in binary mode - } - } -} - -\section{Changes in RcppArmadillo version 0.12.6.2.0 (2023-08-08)}{ - \itemize{ - \item Upgraded to Armadillo release 12.6.2 (Cortisol Retox) - \itemize{ - \item use thread-safe Mersenne Twister as the default RNG on all - platforms - \item use unique RNG seed for each thread within multi-threaded - execution (such as OpenMP) - \item explicitly document \code{arma_rng::set_seed()} and - \code{arma_rng::set_seed_random() } - } - \item None of the changes above affect R use as \pkg{RcppArmadillo} - connects the RNGs used by R to Armadillo - } -} - -\section{Changes in RcppArmadillo version 0.12.6.1.0 (2023-07-26)}{ - \itemize{ - \item Upgraded to Armadillo release 12.6.1 (Cortisol Retox) - \itemize{ - \item faster multiplication of dense vectors by sparse matrices (and - vice versa) - \item faster \code{eigs_sym()} and \code{eigs_gen()} - \item faster \code{conv()} and \code{conv2()} when using OpenMP - \item added \code{diags()} and \code{spdiags()} for generating band - matrices from set of vectors - } - } -} - -\section{Changes in RcppArmadillo version 0.12.4.1.0 (2023-06-17)}{ - \itemize{ - \item Upgraded to Armadillo release 12.4.1 (Cortisol Profusion Redux) - \itemize{ - \item fix bug in \code{SpMat::shed_cols()} - \item functions such as \code{.is_finite()} and \code{find_nonfinite()} - will now emit a runtime warning when compiled in fast math mode; such - compilation mode disables detection of non-finite values - } - \item Accommodate upcoming change in package \pkg{Matrix} (Mikael Jagan - in \ghpr{417} addressing \ghit{415}) - } -} - -\section{Changes in RcppArmadillo version 0.12.4.0.0 (2023-05-26)}{ - \itemize{ - \item Upgraded to Armadillo release 12.4.0 (Cortisol Profusion Redux) - \itemize{ - \item Added \code{norm2est()} for finding fast estimates of matrix - 2-norm (spectral norm) - \item Added \code{vecnorm()} for obtaining the vector norm of each row - or column of a matrix - } - } -} - -\section{Changes in RcppArmadillo version 0.12.2.0.0 (2023-04-04)}{ - \itemize{ - \item Upgraded to Armadillo release 12.2.0 (Cortisol Profusion Deluxe) - \itemize{ - \item more efficient use of FFTW3 by \code{fft()} and \code{ifft()} - \item faster in-place element-wise multiplication of sparse matrices by - dense matrices - \item added spsolve_factoriser class to allow reuse of sparse matrix - factorisation for solving systems of linear equations - } - } -} - -\section{Changes in RcppArmadillo version 0.12.0.1.0 (2023-02-20)}{ - \itemize{ - \item Upgraded to Armadillo release 12.0.1 (Cortisol Profusion) - \itemize{ - \item faster \code{fft()} and \code{ifft()} via optional use of FFTW3 - \item faster \code{min()} and \code{max()} - \item faster \code{index_min()} and \code{index_max()} - \item added \code{.col_as_mat()} and \code{.row_as_mat()} which return - matrix representation of cube column and cube row - \item added \code{csv_opts::strict} option to loading CSV files to - interpret missing values as NaN - \item added \code{check_for_zeros} option to form 4 of sparse matrix batch constructors - \item \code{inv()} and \code{inv_sympd()} with options - \code{inv_opts::no_ugly} or \code{inv_opts::allow_approx} now use a scaled - threshold similar to \code{pinv()} - \item \code{set_cout_stream()} and \code{set_cerr_stream()} are now - no-ops; instead use the options \code{ARMA_WARN_LEVEL}, or - \code{ARMA_COUT_STREAM}, or \code{ARMA_CERR_STREAM} - \item fix regression (mis-compilation) in \code{shift()} function - (reported by us in \ghit{409}) - } - \item The include directory order is now more robust (Kevin Ushey in - \ghpr{407} addressing \ghit{406}) - } -} - -\section{Changes in RcppArmadillo version 0.11.4.4.0 (2023-02-09)}{ - \itemize{ - \item Upgraded to Armadillo release 11.4.4 (Ship of Theseus) - \itemize{ - \item extended \code{pow()} with various forms of element-wise power operations - \item added \code{find_nan()} to find indices of NaN elements - \item faster handling of compound expressions by \code{sum()} - } - \item The package no longer sets a compilation standard, or progagates on - in the generated packages as R ensures C++11 on all non-ancient versions - \item The CITATION file was updated to the current format - } -} - -\section{Changes in RcppArmadillo version 0.11.4.3.1 (2023-01-14)}{ - \itemize{ - \item The \code{#define ARMA_IGNORE_DEPRECATED_MARKER} remains active - to suppress the (upstream) deprecation warnings, see \ghit{391} and - \ghit{402} for details. - } -} - -\section{Changes in RcppArmadillo version 0.11.4.3.0 (2022-12-28) (GitHub Only)}{ - \itemize{ - \item Upgraded to Armadillo release 11.4.3 (Ship of Theseus) - \itemize{ - \item fix corner case in \code{pinv()} when processing symmetric matrices - } - \item Protect the undefine of \code{NDEBUG} behind additional opt-in define - } -} - -\section{Changes in RcppArmadillo version 0.11.4.2.1 (2022-11-08)}{ - \itemize{ - \item Upgraded to Armadillo release 11.4.2 (Ship of Theseus) - \itemize{ - \item more robust handling of corner cases in multi-threaded contexts - } - \item Internal header organisation with new sub-directories while - providing full compatibility via existing paths (\ghpr{395} \ghpr{396}) - } -} - -\section{Changes in RcppArmadillo version 0.11.4.1.0 (2022-10-10) (GitHub Only)}{ - \itemize{ - \item Upgraded to Armadillo release 11.4.1 (Ship of Theseus) - \itemize{ - \item fix data race in \code{Cube::slice()} - \item workarounds for false warnings emitted by GCC 12 when - compiling with \code{FORTIFY_SOURCE} enabled (already in - RcppArmadillo 0.11.4.0.1 too) - } - } -} - -\section{Changes in RcppArmadillo version 0.11.4.0.1 (2022-10-01)}{ - \itemize{ - \item Upgraded to Armadillo release 11.4.0 (Ship of Theseus) - \itemize{ - \item faster handling of compound expressions by \code{sum()} - \item extended \code{pow()} with various forms of element-wise power operations - \item added \code{find_nan()} to find indices of NaN elements - } - \item Also applied fixes to avoid g++-12 warnings affecting just a - handful of CRAN packages. - } -} - -\section{Changes in RcppArmadillo version 0.11.2.4.0 (2022-09-09)}{ - \itemize{ - \item Upgraded to Armadillo release 11.2.4 (Classic Roast) - \itemize{ - \item fix handling of \code{std::move()} involving matrices - constructed with auxiliary memory - } - \item In the \code{fastLm()} examples, use \code{arma::dot()} to - compute to the inner product (as proposed by Conrad), plus small edits - \item Support optional \code{#define} named \code{RCPPARMADILLO_FORCE_DEPRECATE} - to suppress use of \code{ARMA_IGNORE_DEPRECATED_MARKER} permitting - use and development under deprecation - } -} - -\section{Changes in RcppArmadillo version 0.11.2.3.1 (2022-08-16)}{ - \itemize{ - \item Accomodate upcoming \pkg{Matrix} 1.4-2 deprecation for - conversion (Dirk in \ghpr{387}) - \item CRAN release with small upstream changes in Armadillo - 11.2.(1,2,3) made since the last CRAN release 0.11.2.0.0 - (Dirk in \ghpr{383}, \ghpr{384} and \ghpr{386}) - \item Undefine \code{arma_deprecated} warning as it affects a number - of CRAN packages which will likely need a small transition - } -} - -\section{Changes in RcppArmadillo version 0.11.2.3.0 (2022-07-12) (GitHub Only)}{ - \itemize{ - \item Upgraded to Armadillo release 11.2.3 (Classic Roast) - \itemize{ - \item fix \code{Cube::insert_slices()} to accept \code{Cube::slice()} as input - } - } -} - -\section{Changes in RcppArmadillo version 0.11.2.2.0 (2022-07-04) (GitHub Only)}{ - \itemize{ - \item Upgraded to Armadillo release 11.2.2 (Classic Roast) - \itemize{ - \item fix incorrect and/or slow convergence in single-threaded - versions of \code{kmeans()}, \code{gmm_diag::learn()}, - \code{gmm_full::learn()} - } - } -} - -\section{Changes in RcppArmadillo version 0.11.2.1.0 (2022-06-28) (GitHub Only)}{ - \itemize{ - \item Upgraded to Armadillo release 11.2.1 (Classic Roast) - \itemize{ - \item old style matrix initialisation via the \code{<<} operator - will now emit a compile-time deprecation warning - \item use of the old and inactive \code{ARMA_DONT_PRINT_ERRORS} - option will now emit a compile-time deprecation warning - \item the option \code{ARMA_WARN_LEVEL} can be used instead - } - } -} - -\section{Changes in RcppArmadillo version 0.11.2.0.0 (2022-06-10)}{ - \itemize{ - \item Upgraded to Armadillo release 11.2 (Classic Roast) - \itemize{ - \item faster handling of sparse submatrix column views by - \code{norm()}, \code{accu()}, \code{nonzeros() } - \item extended \code{randu()} and \code{randn()} to allow - specification of distribution parameters - \item internal refactoring, leading to faster compilation times - } - } -} - -\section{Changes in RcppArmadillo version 0.11.1.1.0 (2022-05-15)}{ - \itemize{ - \item Upgraded to Armadillo release 11.1.1 (Angry Kitchen Appliance) - \itemize{ - \item added \code{inv_opts::no_ugly} option to \code{inv()} and - \code{inv_sympd()} to disallow inverses of poorly conditioned matrices - \item more efficient handling of rank-deficient matrices via - \code{inv_opts::allow_approx} option in \code{inv()} and \code{inv_sympd()} - \item better detection of rank deficient matrices by \code{solve()} - \item faster handling of symmetric and diagonal matrices by \code{cond()} - } - \item The \code{configure} script again propagates the'found' case again, - thanks to Justin Silverman for the heads-up and suggested fix (Dirk - and Justin in \ghpr{376} and \ghpr{377} fixing \ghit{375}). - } -} - -\section{Changes in RcppArmadillo version 0.11.0.1.0 (2022-04-14)}{ - \itemize{ - \item Upgraded to Armadillo release 11.0.1 (Creme Brulee) - \itemize{ - \item fix miscompilation of \code{inv()} and \code{inv_sympd()} - functions when using \code{inv_opts::allow_approx} and - \code{inv_opts::tiny} options - } - } -} - -\section{Changes in RcppArmadillo version 0.11.0.0.0 (2022-04-04)}{ - \itemize{ - \item Upgraded to Armadillo release 11.0.0 (Creme Brulee) - \itemize{ - \item added variants of \code{inv()} and \code{inv_sympd()} that - provide rcond (reciprocal condition number) - \item expanded \code{inv()} and \code{inv_sympd()} with options - \code{inv_opts::tiny} and \code{inv_opts::allow_approx} - \item stricter handling of singular matrices by \code{inv()} and - \code{inv_sympd()} - \item stricter handling of non-sympd matrices by \code{inv()} and - \code{inv_sympd()} - \item stricter handling of non-finitie matrices by \code{pinv()} - \item more robust handling of rank deficient matrices by - \code{solve()} - \item faster handling of diagonal matrices by \code{rcond()} - \item changed \code{eigs_sym()} and \code{eigs_gen()} to use - higher quality RNG - \item \code{quantile()} and \code{median()} will now throw an - exception if given matrices/vectors have NaN elements - \item workaround for yet another bug in Intel MKL - } - \item Until May 2022, protect correction to Field behavior via - define of \code{RCPP_ARMADILLO_FIX_Field} - \item If a LAPACK installation with missing complex routines is - found (as e.g. Ubuntu using 3.9.0) then the LAPACK unit test is - skipped. - } -} - -\section{Changes in RcppArmadillo version 0.10.8.2.0 (2022-02-01)}{ - \itemize{ - \item Upgraded to Armadillo release 10.8.2 (Realm Raider) - \itemize{ - \item fix potential speed regression in \code{pinv()} and \code{rank()} - } - } -} - -\section{Changes in RcppArmadillo version 0.10.8.1.0 (2022-01-23)}{ - \itemize{ - \item Upgraded to Armadillo release 10.8.1 (Realm Raider) - \itemize{ - \item fix interaction between OpenBLAS and LAPACK - \item emit warning if \code{find()} is incorrectly used to locate - NaN elements - } - } -} - -\section{Changes in RcppArmadillo version 0.10.8.0.0 (2022-01-02)}{ - \itemize{ - \item Upgraded to Armadillo release 10.8 (Realm Raider) - \itemize{ - \item faster handling of symmetric matrices by \code{pinv()} and - \code{rank()} - \item faster handling of diagonal matrices by \code{inv_sympd()}, - \code{pinv()}, \code{rank()} - \item expanded \code{norm()} to handle integer vectors and - matrices - \item added \code{datum::tau} to replace \code{2π} - } - } -} - -\section{Changes in RcppArmadillo version 0.10.7.5.0 (2021-12-16)}{ - \itemize{ - \item Upgraded to Armadillo release 10.7.5 - \itemize{ - \item fix aliasing bug in \code{diagmat()} - \item fix detection of 2x2 triangular matrices - } - } -} - -\section{Changes in RcppArmadillo version 0.10.7.4.0 (2021-11-23)}{ - \itemize{ - \item Upgraded to Armadillo release 10.7.4 - \itemize{ - \item faster handling of diagonal matrices by \code{inv_sympd()}, - \code{pinv()}, \code{rank()} - \item more robust detection of incorrect data format by - \code{.load()} - } - \item Correct dimensions setting in import/export of - \code{arma::field} types, protected by \code{#define} (Jonathan - Berrisch in \ghpr{352} fixing \ghit{351}) - \item Add unit tests for \code{fields} both with and without new - \code{#define} (Dirk) - } -} - -\section{Changes in RcppArmadillo version 0.10.7.3.0 (2021-11-04)}{ - \itemize{ - \item Upgraded to Armadillo release 10.7.3 - \itemize{ - \item fix regression in alias handling by \code{fliplr()}, - \code{flipud()}, \code{reverse()} - } - } -} - -\section{Changes in RcppArmadillo version 0.10.7.2.0 (2021-11-02)}{ - \itemize{ - \item Upgraded to Armadillo release 10.7.2 - \itemize{ - \item more robust handling of diagonal matrices by \code{pinv()} - } - } -} - -\section{Changes in RcppArmadillo version 0.10.7.1.0 (2021-10-08)}{ - \itemize{ - \item Upgraded to Armadillo release 10.7.1 - \itemize{ - \item fix regression in interactions between dense matrix subviews - and sparse matrices - } - } -} - -\section{Changes in RcppArmadillo version 0.10.7.0.0 (2021-09-30)}{ - \itemize{ - \item Upgraded to Armadillo release 10.7.0 (Entropy Maximizer) - \itemize{ - \item faster handling of submatrix views accessed by - \code{X.cols(first_col,last_col)} - \item faster handling of element-wise \code{min()} and \code{max()} - in compound expressions - \item expanded \code{solve()} with \code{solve_opts::force_approx} - option to force use of the approximate solver - } - } -} - -\section{Changes in RcppArmadillo version 0.10.6.2.0 (2021-08-05)}{ - \itemize{ - \item Upgraded to Armadillo release 10.6.2 (Keep Calm) - \itemize{ - \item fix incorrect use of \code{constexpr} for handling fixed-size - matrices and vectors - \item improved documentation - } - \item GitHub- and drat-only release - } -} - -\section{Changes in RcppArmadillo version 0.10.6.0.0 (2021-07-16)}{ - \itemize{ - \item Upgraded to Armadillo release 10.6.0 (Keep Calm) - \itemize{ - \item expanded \code{chol()} to optionally use pivoted decomposition - \item expanded vector, matrix and cube constructors to allow element - initialisation via \code{fill::value(scalar)}, eg. \code{mat X(4,5,fill::value(123))} - \item faster loading of CSV files when using OpenMP - \item added \code{csv_opts::semicolon} option to allow saving/loading of - CSV files with semicolon (;) instead of comma (,) as the separator - } - } -} - -\section{Changes in RcppArmadillo version 0.10.5.3.0 (2021-07-01)}{ - \itemize{ - \item Upgraded to Armadillo release 10.5.3 (Antipodean Fortress) - \item GitHub-only release - \item Extended test coverage with several new tests, added a coverage badge. - } -} - -\section{Changes in RcppArmadillo version 0.10.5.0 (2021-05-21)}{ - \itemize{ - \item Upgraded to Armadillo release 10.5 (Antipodean Fortress) - \itemize{ - \item added \code{.clamp()} member function - \item expanded the standalone \code{clamp()} function to handle complex values - \item more efficient use of OpenMP - \item vector, matrix and cube constructors now initialise elements - to zero by default; use the \code{fill::none} specifier, - eg. \code{mat X(4,5,fill::none)}, to disable element initialisation - } - \item Added \code{codecov.yml} to exclude Armadillo from coverage analysis - } -} - -\section{Changes in RcppArmadillo version 0.10.4.1.0 (2021-04-23)}{ - \itemize{ - \item Upgraded to Armadillo release 10.4.1 (Pressure Cooker) - \item GitHub-only release - } -} - -\section{Changes in RcppArmadillo version 0.10.4.0.0 (2021-04-12)}{ - \itemize{ - \item Upgraded to Armadillo release 10.4.0 (Pressure Cooker) - \itemize{ - \item faster handling of triangular matrices by \code{log_det()} - \item added \code{log_det_sympd()} for log determinant of - symmetric positive matrices - \item added ARMA_WARN_LEVEL configuration option, to control the - degree of emitted warning messages - \item reduced the default degree of warning messages, so that - failed decompositions, failed saving/loading, etc, no longer emit - warnings - } - \item Apply one upstream corrections for \code{arma::randn} draws - when using alternative (here R) generator, and \code{arma::randg}. - } -} - -\section{Changes in RcppArmadillo version 0.10.3.0.0 (2021-03-10)}{ - \itemize{ - \item Upgraded to Armadillo release 10.3 (Sunrise Chaos) - \itemize{ - \item faster handling of symmetric positive definite matrices by - \code{pinv()} - \item expanded \code{.save()} / \code{.load()} for dense matrices - to handle coord_ascii format - \item for out of bounds access, element accessors now throw the - more nuanced \code{std::out_of_range} exception, instead of only - \code{std::logic_error} - \item improved quality of random numbers - } - } -} - -\section{Changes in RcppArmadillo version 0.10.2.2.0 (2021-03-09)}{ - \itemize{ - \item Upgraded to Armadillo release 10.2.2 (Cicada Swarm) - \itemize{ - \item faster handling of subcubes - \item added \code{tgamma()} - \item added \code{.brief_print()} for abridged printing of matrices & cubes - \item expanded forms of \code{trimatu()} and \code{trimatl()} with - diagonal specification to handle sparse matrices - \item expanded \code{eigs_sym()} and \code{eigs_gen()} with optional shift-invert mode - } - \item Removed \code{debian/} directory from repository as packaging - is on salsa.debian.org. - \item Relaxed tolerance on two \code{cube} tests on Windows to - accomodate new 'gcc10-UCRT' builder. - } -} - -\section{Changes in RcppArmadillo version 0.10.2.1.0 (2021-02-09)}{ - \itemize{ - \item Upgraded to Armadillo release 10.2.1 (Cicada Swarm) - \itemize{ - \item faster handling of subcubes - \item added \code{tgamma()} - \item added \code{.brief_print()} for abridged printing of matrices & cubes - \item expanded forms of \code{trimatu()} and \code{trimatl()} with - diagonal specification to handle sparse matrices - \item expanded \code{eigs_sym()} and \code{eigs_gen()} with optional shift-invert mode - } - } -} - -\section{Changes in RcppArmadillo version 0.10.1.2.2 (2021-01-08)}{ - \itemize{ - \item Correct one unit test for \pkg{Matrix} 1.3.0-caused changed - (Binxiang in \ghpr{319} and Dirk in \ghpr{322}). - \item Suppress one further warning from \pkg{Matrix} (Dirk) - \item Apply an upstream \code{NaN} correction (Conrad in \ghpr{321}) - \item Added GitHub Actions CI using \code{run.sh} from r-ci (Dirk) - } -} - -\section{Changes in RcppArmadillo version 0.10.1.2.0 (2020-11-15)}{ - \itemize{ - \item Upgraded to Armadillo release 10.1.2 (Orchid Ambush) - \item Remove three unused int constants (\ghit{313}) - \item Include main armadillo header using quotes instead of brackets - \item Rewrite version number use in old-school mode because gcc 4.8.5 - \item Skipping parts of sparse conversion on Windows as win-builder fails - } -} - -\section{Changes in RcppArmadillo version 0.10.1.0.0 (2020-10-09)}{ - \itemize{ - \item Upgraded to Armadillo release 10.1.0 (Orchid Ambush) - \itemize{ - \item C++11 is now the minimum required C++ standard - \item faster handling of compound expressions by \code{trimatu()} - and \code{trimatl()} - \item faster sparse matrix addition, subtraction and element-wise - multiplication - \item expanded sparse submatrix views to handle the non-contiguous - form of \code{X.cols(vector_of_column_indices)} - \item expanded \code{eigs_sym()} and \code{eigs_gen()} with optional - fine-grained parameters (subspace dimension, number of iterations, - eigenvalues closest to specified value) - \item deprecated form of \code{reshape()} removed from Cube and - SpMat classes - \item ignore and warn on use of the \code{ARMA_DONT_USE_CXX11} macro - } - \item Switch Travis CI testing to focal and BSPM - } -} - -\section{Changes in RcppArmadillo version 0.9.900.3.0 (2020-09-02)}{ - \itemize{ - \item Upgraded to Armadillo release 9.900.3 (Nocturnal Misbehaviour) - \itemize{ - \item More efficient code for initialising matrices with \code{fill::zeros} - \item Fixes for various error messages - } - } - } - -\section{Changes in RcppArmadillo version 0.9.900.2.0 (2020-07-17)}{ - \itemize{ - \item Upgraded to Armadillo release 9.900.2 (Nocturnal Misbehaviour) - \itemize{ - \item In \code{sort()}, fixes for inconsistencies between checks - applied to matrix and vector expressions - \item In \code{sort()}, remove unnecessary copying when applied in-place to vectors - function when applied in-place to vectors - } - } -} - -\section{Changes in RcppArmadillo version 0.9.900.1.0 (2020-06-08)}{ - \itemize{ - \item Upgraded to Armadillo release 9.900.1 (Nocturnal Misbehaviour) - \itemize{ - \item faster \code{solve()} for under/over-determined systems - \item faster \code{eig_gen()} and \code{eig_pair()} for large matrices - \item expanded \code{eig_gen()} and \code{eig_pair()} to - optionally provide left and right eigenvectors - } - \item Switch Travis CI testing to R 4.0.0, use bionic as base distro - and test R 3.6.3 and 4.0.0 in a matrix (Dirk in \ghpr{298}). - \item Add two badges to README for indirect use and the CSDA paper. - \item Adapt \code{RcppArmadillo.package.skeleton()} to a change in R - 4.0.0 affecting what it exports in \code{NAMESPACE}. - } -} - -\section{Changes in RcppArmadillo version 0.9.880.1.0 (2020-05-15)}{ - \itemize{ - \item Upgraded to Armadillo release 9.880.1 (Roasted Mocha Detox) - \itemize{ - \item expanded \code{qr()} to optionally use pivoted decomposition - \item updated physical constants to NIST 2018 CODATA values - \item added \code{ARMA_DONT_USE_CXX11_MUTEX} confguration option - to disable use of \code{std::mutex} - } - \item OpenMP capability is tested explicitly (Kevin Ushey and Dirk - in \ghpr{294}, \ghpr{295}, and \ghpr{296} all fixing \ghit{290}). - } -} - -\section{Changes in RcppArmadillo version 0.9.870.2.0 (2020-04-24)}{ - \itemize{ - \item Upgraded to Armadillo release 9.870.2 (Roasted Mocha Retox) - \itemize{ - \item faster handling of matrix multiplication expressions by - \code{diagvec()} and \code{diagmat()} - \item added \code{trimatu_ind()} and \code{trimatl_ind()} - \item more consistent detection of sparse vector expressions - } - } -} - -\section{Changes in RcppArmadillo version 0.9.860.2.0 (2020-04-13)}{ - \itemize{ - \item Upgraded to Armadillo release 9.860.2 (Roasted Mocha Fix) - \itemize{ - \item added \code{powmat()} - \item faster access to columns in sparse submatrix views - \item faster handling of relational expressions by \code{accu()} - \item faster handling of sympd matrices by \code{expmat()}, \code{logmat()}, \code{sqrtmat()} - \item workaround for save/load issues with HDF5 v1.12 - } - \item Vignettes are now pre-made and include (\ghpr{285}) - \item Two test files are now skipped on 32-bit Windows - } -} - -\section{Changes in RcppArmadillo version 0.9.850.1.0 (2020-02-09)}{ - \itemize{ - \item Upgraded to Armadillo release 9.850.1 (Pyrocumulus Wrath) - \itemize{ - \item faster handling of compound expressions by \code{diagmat()} - \item expanded \code{.save()} and \code{.load()} to handle CSV files with headers via - csv_name(filename,header) specification - \item added \code{log_normpdf()} - \item added \code{.is_zero()} - \item added \code{quantile()} - } - \item The sparse matrix test using scipy, if available, is now - simplified thanks to recently added \CRANpkg{reticulate} conversions. - } -} - -\section{Changes in RcppArmadillo version 0.9.800.4.0 (2020-01-24)}{ - \itemize{ - \item Upgraded to Armadillo release 9.800.4 (Horizon Scraper) - \itemize{ - \item fixes for incorrect type promotion in \code{normpdf()} - } - } -} - -\section{Changes in RcppArmadillo version 0.9.800.3.0 (2019-12-04)}{ - \itemize{ - \item Upgraded to Armadillo release 9.800.3 (Horizon Scraper) - \itemize{ - \item fixes for matrix row iterators - \item better detection of non-hermitian matrices by - \code{eig_sym()}, \code{inv_sympd()}, \code{chol()}, - \code{expmat_sym()} - } - \item The \code{sample} function passes the prob vector as const allowing - subsequent calls (Christian Gunning in \ghpr{276} fixing \ghit{275}) - } -} - -\section{Changes in RcppArmadillo version 0.9.800.1.0 (2019-10-09)}{ - \itemize{ - \item Upgraded to Armadillo release 9.800 (Horizon Scraper) - \itemize{ - \item faster \code{solve()} in default operation; iterative - refinement is no longer applied by default; use - \code{solve_opts::refine} to explicitly enable refinement - \item faster \code{expmat()} - \item faster handling of triangular matrices by \code{rcond()} - \item added \code{.front()} and \code{.back()} - \item added \code{.is_trimatu()} and \code{.is_trimatl()} - \item added \code{.is_diagmat()} - } - \item The package now uses \pkg{tinytest} for unit tests (Dirk in - \ghpr{269}). - \item The \code{configure.ac} script is now more careful about shell - portability (Min Kim in \ghpr{270}). - } -} - -\section{Changes in RcppArmadillo version 0.9.700.2.0 (2019-09-01)}{ - \itemize{ - \item Upgraded to Armadillo release 9.700.2 (Gangster Democracy) - \itemize{ - \item faster handling of cubes by \code{vectorise()} - \item faster faster handling of sparse matrices by \code{nonzeros()} - \item faster row-wise \code{index_min()} and \code{index_max()} - \item expanded \code{join_rows()} and \code{join_cols()} to handle joining up to 4 matrices - \item expanded \code{.save()} and \code{.load()} to allow storing sparse matrices in CSV format - \item added \code{randperm()} to generate a vector with random - permutation of a sequence of integers - } - \item Expanded the list of known good \code{gcc} and \code{clang} - versions in \code{configure.ac} - } -} - -\section{Changes in RcppArmadillo version 0.9.600.4.0 (2019-07-14)}{ - \itemize{ - \item Upgraded to Armadillo release 9.600.4 (Napa Invasion) - \itemize{ - \item faster handling of sparse submatrices - \item faster handling of sparse diagonal views - \item faster handling of sparse matrices by \code{symmatu()} and \code{symmatl()} - \item faster handling of sparse matrices by \code{join_cols()} - \item expanded \code{clamp()} to handle sparse matrices - \item added \code{.clean()} to replace elements below a threshold with zeros - } - } -} - -\section{Changes in RcppArmadillo version 0.9.500.2.0 (2019-06-11)}{ - \itemize{ - \item Upgraded to Armadillo release 9.500.2 (Riot Compact) - \itemize{ - \item Expanded \code{solve()} with \code{solve_opts::likely_sympd} - to indicate that the given matrix is likely positive definite - \item more robust automatic detection of positive definite - matrices by \code{solve()} and \code{inv()} - \item faster handling of sparse submatrices - \item expanded \code{eigs_sym()} to print a warning if the given - matrix is not symmetric - \item extended LAPACK function prototypes to follow Fortran - passing conventions for so-called "hidden arguments", in order - to address GCC Bug 90329; to use previous LAPACK function - prototypes without the "hidden arguments", - \code{#define ARMA_DONT_USE_FORTRAN_HIDDEN_ARGS before - #include } - } - } -} - -\section{Changes in RcppArmadillo version 0.9.400.3.0 (2019-05-09)}{ - \itemize{ - \item Upgraded to Armadillo release 9.400.3 (Surrogate Miscreant) - \itemize{ - \item check for symmetric / hermitian matrices (used by - decomposition functions) has been made more robust - \item \code{linspace()} and \code{logspace()} now honour requests - for generation of vectors with zero elements - \item fix for vectorisation / flattening of complex sparse matrices - } - } -} - -\section{Changes in RcppArmadillo version 0.9.400.2.0 (2019-04-28)}{ - \itemize{ - \item Upgraded to Armadillo release 9.400.2 (Surrogate Miscreant) - \itemize{ - \item faster \code{cov()} and \code{cor()} - \item added \code{.as_col()} and \code{.as_row()} - \item expanded \code{.shed_rows()} / \code{.shed_cols()} / - \code{.shed_slices()} to remove rows/columns/slices specified in a - vector - \item expanded \code{vectorise()} to handle sparse matrices - \item expanded element-wise versions of \code{max()} and - \code{min()} to handle sparse matrices - \item optimised handling of sparse matrix expressions: - \code{sparse \% (sparse +- scalar)} and \code{sparse / (sparse +- scalar)} - \item expanded \code{eig_sym()}, \code{chol()}, - \code{expmat_sym()}, \code{logmat_sympd()}, \code{sqrtmat_sympd()}, - \code{inv_sympd()} to print a warning if the given matrix is not - symmetric - \item more consistent detection of vector expressions - } - } -} - -\section{Changes in RcppArmadillo version 0.9.300.2.0 (2019-03-21)}{ - \itemize{ - \item Upgraded to Armadillo release 9.300.2 (Fomo Spiral) - \itemize{ - \item Faster handling of compound complex matrix expressions by - \code{trace()} - \item More efficient handling of element access for inplace - modifications in sparse matrices - \item Added \code{.is_sympd()} to check whether a matrix is - symmetric/hermitian positive definite - \item Added \code{interp2()} for 2D data interpolation - \item Added \code{expm1()} and \code{log1p()} - \item Expanded \code{.is_sorted()} with options "strictascend" and - "strictdescend" - \item Expanded \code{eig_gen()} to optionally perform balancing - prior to decomposition - } - } -} - -\section{Changes in RcppArmadillo version 0.9.200.7.1 (2019-03-08)}{ - \itemize{ - \item Explicit setting of \code{RNGversion("3.5.0")} in one unit - test to accomodate the change in \code{sample()} in R 3.6.0 - \item Back-ported a fix to the Wishart RNG from upstream (Dirk in - \ghpr{248} fixing \ghit{247}) - } -} - -\section{Changes in RcppArmadillo version 0.9.200.7.0 (2019-01-17)}{ - \itemize{ - \item Upgraded to Armadillo release 9.200.7 (Carpe Noctem) - \item Fixes in 9.200.7 compared to 9.200.5: - \itemize{ - \item handling complex compound expressions by \code{trace()} - \item handling \code{.rows()} and \code{.cols()} by the - \code{Cube} class - } - } -} - -\section{Changes in RcppArmadillo version 0.9.200.5.0 (2018-11-27)}{ - \itemize{ - \item Upgraded to Armadillo release 9.200.5 (Carpe Noctem) - \item Changes in this release - \itemize{ - \item linking issue when using fixed size matrices and vectors - \item faster handling of common cases by \code{princomp()} - } - } -} - -\section{Changes in RcppArmadillo version 0.9.200.4.0 (2018-11-09)}{ - \itemize{ - \item Upgraded to Armadillo release 9.200.4 (Carpe Noctem) - \itemize{ - \item faster handling of symmetric positive definite matrices by - \code{rcond()} - \item faster transpose of matrices with size ≥ 512x512 - \item faster handling of compound sparse matrix expressions by - \code{accu()}, \code{diagmat()}, \code{trace()} - \item faster handling of sparse matrices by \code{join_rows()} - \item expanded \code{sign()} to handle scalar arguments - \item expanded operators (\code{*}, \code{\%}, \code{+}, \code{−}) - to handle sparse matrices with differing element types - (eg. multiplication of complex matrix by real matrix) - \item expanded \code{conv_to()} to allow conversion between sparse - matrices with differing element types - \item expanded \code{solve()} to optionally allow keeping - solutions of systems singular to working precision - \item workaround for \code{gcc} and \code{clang} bug in C++17 mode - } - \item Commented-out sparse matrix test consistently failing on the - fedora-clang machine CRAN, and only there. No fix without access. - \item The 'Unit test' vignette is no longer included. - } -} - -\section{Changes in RcppArmadillo version 0.9.100.5.0 (2018-08-16)}{ - \itemize{ - \item Upgraded to Armadillo release 9.100.4 (Armatus Ad Infinitum) - \itemize{ - \item faster handling of symmetric/hermitian positive definite - matrices by \code{solve()} - \item faster handling of \code{inv_sympd()} in compound expressions - \item added \code{.is_symmetric()} - \item added \code{.is_hermitian()} - \item expanded \code{spsolve()} to optionally allow keeping - solutions of systems singular to working precision - \item new configuration options \code{ARMA_OPTIMISE_SOLVE_BAND} - and \code{ARMA_OPTIMISE_SOLVE_SYMPD} - smarter use of the element cache in sparse matrices - \item smarter use of the element cache in sparse matrices - } - \item Aligned OpenMP flags in the RcppArmadillo.package.skeleton - used Makevars(,.win) to not use one C and C++ flag. - } -} - -\section{Changes in RcppArmadillo version 0.8.600.0.0 (2018-06-28)}{ - \itemize{ - \item Upgraded to Armadillo release 8.600.0 (Sabretooth Rugrat) - \itemize{ - \item added \code{hess()} for Hessenberg decomposition - \item added \code{.row()}, \code{.rows()}, \code{.col()}, - \code{.cols()} to subcube views - \item expanded \code{.shed_rows()} and \code{.shed_cols()} to - handle cubes - \item expanded \code{.insert_rows()} and \code{.insert_cols()} to - handle cubes - \item expanded subcube views to allow non-contiguous access to - slices - \item improved tuning of sparse matrix element access operators - \item faster handling of tridiagonal matrices by \code{solve()} - \item faster multiplication of matrices with differing element - types when using OpenMP - } - } -} - -\section{Changes in RcppArmadillo version 0.8.500.1.1 (2018-05-17) [GH only]}{ - \itemize{ - \item Upgraded to Armadillo release 8.500.1 (Caffeine Raider) - \itemize{ - \item bug fix for banded matricex - } - \item Added \code{slam} to Suggests: as it is used in two unit test - functions [CRAN requests] - \item The \code{RcppArmadillo.package.skeleton()} function now works - with \code{example_code=FALSE} when \CRANpkg{pkgKitten} is present - (Santiago Olivella in \ghpr{231} fixing \ghpr{229}) - \item The LAPACK tests now cover band matrix solvers (Keith O'Hara - in \ghpr{230}). - } -} - -\section{Changes in RcppArmadillo version 0.8.500.0 (2018-04-21)}{ - \itemize{ - \item Upgraded to Armadillo release 8.500 (Caffeine Raider) - \itemize{ - \item faster handling of sparse matrices by \code{kron()} and \code{repmat()} - \item faster transpose of sparse matrices - \item faster element access in sparse matrices - \item faster row iterators for sparse matrices - \item faster handling of compound expressions by \code{trace()} - \item more efficient handling of aliasing in submatrix views - \item expanded \code{normalise()} to handle sparse matrices - \item expanded \code{.transform()} and \code{.for_each()} to handle sparse matrices - \item added \code{reverse()} for reversing order of elements - \item added \code{repelem()} for replicating elements - \item added \code{roots()} for finding the roots of a polynomial - } - \item Fewer LAPACK compile-time guards are used, new unit tests for underlying - features have been added (Keith O'Hara in \ghpr{211} addressing \ghit{207}). - \item The configure check for LAPACK features has been updated - accordingly (Keith O'Hara in \ghpr{214} addressing \ghit{213}). - \item The compile-time check for \code{g++} is now more robust to - minimal shell versions (\ghpr{217} addressing \ghit{216}). - \item Compiler tests to were added for macOS (Keith O'Hara in \ghpr{219}). - } -} - -\section{Changes in RcppArmadillo version 0.8.400.0.0 (2018-02-19)}{ - \itemize{ - \item Upgraded to Armadillo release 8.400.0 (Entropy Bandit) - \itemize{ - \item faster handling of sparse matrices by \code{repmat()} - \item faster loading of CSV files - \item expanded \code{kron()} to handle sparse matrices - \item expanded \code{index_min()} and \code{index_max()} to handle cubes - \item expanded \code{randi()}, \code{randu()}, \code{randn()}, - \code{randg()} to output single scalars - \item added submatrix & subcube iterators - \item added \code{normcdf()} - \item added \code{mvnrnd()} - \item added \code{chi2rnd()} - \item added \code{wishrnd()} and \code{iwishrnd()} - } - \item The \code{configure} generated header settings for LAPACK and - OpenMP can be overridden by the user. - \item This release was preceded by two release candidates which were - tested extensively. - } -} - -\section{Changes in RcppArmadillo version 0.8.300.1.0 (2017-12-04)}{ - \itemize{ - \item Upgraded to Armadillo release 8.300.1 (Tropical Shenanigans) - \itemize{ - \item faster handling of band matrices by \code{solve()} - \item faster handling of band matrices by \code{chol()} - \item faster \code{randg()} when using OpenMP - \item added \code{normpdf()} - \item expanded \code{.save()} to allow appending new datasets to existing HDF5 files - } - \item Includes changes made in several earlier GitHub-only releases - (versions 0.8.300.0.0, 0.8.200.2.0 and 0.8.200.1.0). - \item Conversion from \code{simple_triplet_matrix} is now supported - (Serguei Sokol in \ghpr{192}). - \item Updated configure code to check for g++ 5.4 or later to enable OpenMP. - \item Updated the skeleton package to current packaging standards - \item Suppress warnings from Armadillo about missing OpenMP support - and \code{-fopenmp} flags by setting \code{ARMA_DONT_PRINT_OPENMP_WARNING} - } -} - -\section{Changes in RcppArmadillo version 0.8.100.1.0 (2017-10-10)}{ - \itemize{ - \item Upgraded to Armadillo release 8.100.1 (Feral Pursuits) - \itemize{ - \item faster incremental construction of sparse matrices via - element access operators - \item faster diagonal views in sparse matrices - \item expanded \code{SpMat} to save/load sparse matrices in coord - format - \item expanded \code{.save()},\code{.load()} to allow - specification of datasets within HDF5 files - \item added \code{affmul()} to simplify application of affine - transformations - \item warnings and errors are now printed by default to the - \code{std::cerr} stream - \item added \code{set_cerr_stream()} and \code{get_cerr_stream()} - to replace \code{set_stream_err1()}, \code{set_stream_err2()}, - \code{get_stream_err1()}, \code{get_stream_err2()} - \item new configuration options \code{ARMA_COUT_STREAM} and - \code{ARMA_CERR_STREAM} - } - \item Constructors for sparse matrices of types \code{dgt}, - \code{dtt} amd \code{dst} now use Armadillo code for improved - performance (Serguei Sokol in \ghpr{175} addressing \ghit{173}) - \item Sparse matrices call \code{.sync()} before accessing internal - arrays (Binxiang Ni in \ghpr{171}) - \item The sparse matrix vignette has been converted to Rmarkdown - using the pinp package, and is now correctly indexed. (\ghpr{176}) - } -} - -\section{Changes in RcppArmadillo version 0.7.960.1.2 (2017-08-29)}{ - \itemize{ - \item On macOS, OpenMP support is now turned off (\ghpr{170}). - \item The package is now compiling under the C++11 standard (\ghpr{170}). - \item The vignette dependency are correctly set (James and Dirk in - \ghpr{168} and \ghpr{169}) - } -} - -\section{Changes in RcppArmadillo version 0.7.960.1.1 (2017-08-20)}{ - \itemize{ - \item Added improved check for inherited S4 matrix classes - (\ghpr{162} fixing \ghit{161}) - \item Changed \code{fastLm} C++ function to \code{fastLm_impl} to not - clash with R method (\ghpr{164} fixing \ghpr{163}) - \item Added OpenMP check for \code{configure} (\ghpr{166} fixing - \ghit{165}) - } -} - -\section{Changes in RcppArmadillo version 0.7.960.1.0 (2017-08-11)}{ - \itemize{ - \item Upgraded to Armadillo release 7.960.1 (Northern Banana Republic Deluxe) - \itemize{ - \item faster \code{randn()} when using OpenMP (NB: usually omitted - when used fromR) - \item faster \code{gmm_diag} class, for Gaussian mixture models - with diagonal covariance matrices - \item added \code{.sum_log_p()} to the \code{gmm_diag} class - \item added \code{gmm_full} class, for Gaussian mixture models - with full covariance matrices - \item expanded \code{.each_slice()} to optionally use OpenMP for - multi-threaded execution - } - \item Upgraded to Armadillo release 7.950.0 (Northern Banana Republic) - \itemize{ - \item expanded \code{accu()} and \code{sum()} to use OpenMP for - processing expressions with computationally expensive element-wise - functions - \item expanded \code{trimatu()} and \code{trimatl()} to allow - specification of the diagonal which delineates the boundary of the - triangular part - } - \item Enhanced support for sparse matrices (Binxiang Ni as part of - Google Summer of Code 2017) - \itemize{ - \item Add support for \code{dtCMatrix} and \code{dsCMatrix} - (\ghpr{135}) - \item Add conversion and unit tests for \code{dgT}, \code{dtT} and - \code{dsTMatrix} (\ghpr{136}) - \item Add conversion and unit tests for \code{dgR}, \code{dtR} and - \code{dsRMatrix} (\ghpr{139}) - \item Add conversion and unit tests for \code{pMatrix} and - \code{ddiMatrix} (\ghpr{140}) - \item Rewrite conversion for \code{dgT}, \code{dtT} and - \code{dsTMatrix}, and add file-based tests (\ghpr{142}) - \item Add conversion and unit tests for \code{indMatrix} (\ghpr{144}) - \item Rewrite conversion for \code{ddiMatrix} (\ghpr{145}) - \item Add a warning message for matrices that cannot be converted - (\ghpr{147}) - \item Add new vignette for sparse matrix support (\ghpr{152}; Dirk - in \ghpr{153}) - \item Add support for sparse matrix conversion from Python SciPy - (\ghpr{158} addressing \ghit{141}) - } - \item Optional return of row or column vectors in collapsed form if - appropriate \code{#define} is set (Serguei Sokol in \ghpr{151} and - \ghpr{154}) - \item Correct \code{speye()} for non-symmetric cases (Qiang Kou in - \ghpr{150} closing \ghit{149}). - \item Ensure tests using Scientific Python and reticulate are properly - conditioned on the packages being present. - \item Added \code{.aspell/} directory with small local directory now - supported by R-devel. - } -} - -\section{Changes in RcppArmadillo version 0.7.900.2.0 (2017-06-02)}{ - \itemize{ - \item Upgraded to Armadillo release 7.900.2 (Evil Banana Republic) - \itemize{ - \item Expanded \code{clamp()} to handle cubes - \item Computationally expensive element-wise functions (such as - \code{exp()}, \code{log()}, \code{cos()}, etc) can now be - automatically sped up via OpenMP; this requires a C++11/C++14 - compiler with OpenMP 3.0+ support for GCC and clang compilers - \item One caveat: when using GCC, use of \code{-march=native} in - conjunction with \code{-fopenmp} may lead to speed regressions on - recent processors - } - \item Added gcc 7 to support compiler check (James Balamuta in \ghpr{128} - addressing \ghit{126}). - \item A unit test helper function for \code{rmultinom} was - corrected (\ghpr{133}). - \item OpenMP support was added to the skeleton helper in \code{inline.R} - } -} - -\section{Changes in RcppArmadillo version 0.7.800.2.0 (2017-04-12)}{ - \itemize{ - \item Upgraded to Armadillo release 7.800.2 (Rogue State Redux) - \itemize{ - \item The Armadillo license changed to Apache License 2.0 - } - \item The \code{DESCRIPTION} file now mentions the Apache License - 2.0, as well as the former MPL2 license used for earlier releases. - \item A new file \code{init.c} was added with calls to - \code{R_registerRoutines()} and \code{R_useDynamicSymbols()} - \item Symbol registration is enabled in \code{useDynLib} - \item The \code{fastLm} example was updated - } -} - -\section{Changes in RcppArmadillo version 0.7.700.0.0 (2017-02-07)}{ - \itemize{ - \item Upgraded to Armadillo release 7.700.0 (Rogue State) - \itemize{ - \item added \code{polyfit()} and \code{polyval()} - \item added second form of \code{log_det()} to directly return the - result as a complex number - \item added \code{range()} to statistics functions - \item expanded \code{trimatu()}/\code{trimatl()} and - \code{symmatu()}/\code{symmatl()} to handle sparse matrice - } - } -} - -\section{Changes in RcppArmadillo version 0.7.600.2.0 (2017-01-05)}{ - \itemize{ - \item Upgraded to Armadillo release 7.600.2 (Coup d'Etat Deluxe) - \itemize{ - \item Bug fix to memory allocation for \code{fields} - } - } -} - -\section{Changes in RcppArmadillo version 0.7.600.1.0 (2016-12-16)}{ - \itemize{ - \item Upgraded to Armadillo release 7.600.1 (Coup d'Etat Deluxe) - \itemize{ - \item more accurate \code{eigs_sym()} and \code{eigs_gen()} - \item expanded \code{floor()}, \code{ceil()}, \code{round()}, - \code{trunc()}, \code{sign()} to handle sparse matrices - \item added \code{arg()}, \code{atan2()}, \code{hypot()} - } - } -} - -\section{Changes in RcppArmadillo version 0.7.500.1.0 (2016-11-11)}{ - \itemize{ - \item Upgraded to Armadillo release 7.500.1 - \item Small improvement to return value treatment - \item The \code{sample.h} extension was updated to the newer - Armadillo interface. (Closes \ghit{111}) - } -} - -\section{Changes in RcppArmadillo version 0.7.500.0.0 (2016-10-20)}{ - \itemize{ - \item Upgraded to Armadillo release 7.500.0 (Coup d'Etat) - \itemize{ - \item Expanded \code{qz()} to optionally specify ordering of the Schur form - \item Expanded \code{each_slice()} to support matrix multiplication - } - } -} - -\section{Changes in RcppArmadillo version 0.7.400.2.0 (2016-08-24)}{ - \itemize{ - \item Upgraded to Armadillo release 7.400.2 (Feral Winter Deluxe) - \itemize{ - \item added \code{expmat_sym()}, \code{logmat_sympd()}, - \code{sqrtmat_sympd()} - \item added \code{.replace()} - } - } -} - -\section{Changes in RcppArmadillo version 0.7.300.1.0 (2016-07-30)}{ - \itemize{ - \item Upgraded to Armadillo release 7.300.1 - \itemize{ - \item added \code{index_min()} and \code{index_max()} standalone functions - \item expanded \code{.subvec()} to accept \code{size()} arguments - \item more robust handling of non-square matrices by \code{lu()} - } - } -} - -\section{Changes in RcppArmadillo version 0.7.200.2.0 (2016-07-22)}{ - \itemize{ - \item Upgraded to Armadillo release 7.200.2 - \item The sampling extension was rewritten to use Armadillo vector types - instead of Rcpp types (PR \ghpr{101} by James Balamuta) - } -} - -\section{Changes in RcppArmadillo version 0.7.200.1.0 (2016-06-06)}{ - \itemize{ - \item Upgraded to Armadillo release 7.200.1 - \itemize{ - \item added \code{.index_min()} and \code{.index_max()} - \item expanded \code{ind2sub()} to handle vectors of indices - \item expanded \code{sub2ind()} to handle matrix of subscripts - \item expanded \code{expmat()}, \code{logmat()} and - \code{sqrtmat()} to optionally return a bool indicating success - \item faster handling of compound expressions by \code{vectorise()} - } - \item The \code{configure} code now (once again) sets the values for - the LAPACK feature \code{#define} correctly. - } -} - -\section{Changes in RcppArmadillo version 0.7.100.3.0 (2016-05-25)}{ - \itemize{ - \item Upgraded to Armadillo test release 7.100.3 - \itemize{ - \item added \code{erf()}, \code{erfc()}, \code{lgamma()} - \item added \code{.head_slices()} and \code{.tail_slices()} to - subcube views - \item \code{spsolve()} now requires SuperLU 5.2 - \item \code{eigs_sym()}, \code{eigs_gen()} and \code{svds()} now - use a built-in reimplementation of ARPACK for real (non-complex) - matrices (code contributed by Yixuan Qiu) - } - \item The \code{configure} code now checks against old \code{g++} - version which are no longer sufficient to build the package. - } -} - -\section{Changes in RcppArmadillo version 0.6.700.6.0 (2016-05-05)}{ - \itemize{ - \item Upgraded to Armadillo 6.700.6 (Catabolic Amalgamator Deluxe) - \itemize{ - \item fix for handling empty matrices by \code{kron()} - \item fix for clang warning in advanced matrix constructors - \item fix for false deprecated warning in \code{trunc_log()} and - \code{trunc_exp()} - \item fix for gcc-6.1 warning about misleading indentation - \item corrected documentation for the \code{solve()} function - } - \item Added support for \code{int64_t} (\code{ARMA_64BIT_WORD}) when - required during compilation time. (PR \ghpr{90} by George G. Vega - Yon, fixing \ghpr{88}) - \item Fixed bug in \code{SpMat} exporter (PR \ghpr{91} by George G. Vega Yon, - fixing \ghit{89} and \ghit{72}) - } -} - -\section{Changes in RcppArmadillo version 0.6.700.3.0 (2016-04-05)}{ - \itemize{ - \item Upgraded to Armadillo 6.700.3 (Catabolic Amalgamator Deluxe) - \itemize{ - \item added \code{logmat()} for calcuating the matrix logarithm - \item added \code{regspace()} for generating vectors with - regularly spaced elements - \item added \code{logspace()} for generating vectors with - logarithmically spaced elements - \item added \code{approx_equal()} for determining approximate equality - \item added \code{trapz()} for numerical integration - \item expanded \code{.save()} and \code{.load()} with - hdf5_binary_trans file type, to save/load data with columns - transposed to rows - } - } -} - -\section{Changes in RcppArmadillo version 0.6.600.4.0 (2016-03-15)}{ - \itemize{ - \item Upgraded to Armadillo 6.600.4 (Catabolic Amalgamator) - \itemize{ - \item expanded \code{sum()}, \code{mean()}, \code{min()}, \code{max()} to handle cubes - \item expanded \code{Cube} class to handle arbitrarily sized empty cubes (eg. 0x5x2) - \item added \code{shift()} for circular shifts of elements - \item added \code{sqrtmat()} for finding the square root of a matrix - \item fix for \code{gmm_diag} when using Mahalanobis distance - } - \item The \code{configure} script now reflects the full LAPACK - fallback offered by R 3.3.0 or later (PR \ghpr{81}) - } -} - -\section{Changes in RcppArmadillo version 0.6.500.4.0 (2016-01-26)}{ - \itemize{ - \item Upgraded to Armadillo 6.500.4 (Gourmet Electron Jumper) - \itemize{ - \item added \code{conv2()} for 2D convolution - \item added stand-alone \code{kmeans()} function for clustering data - \item added \code{trunc()} - \item extended \code{conv()} to optionally provide central convolution - \item faster handling of multiply-and-accumulate by \code{accu()} - when using Intel MKL, ATLAS or OpenBLAS - } - \item The \code{configure} script now uses \code{#!/usr/bin/env - bash} to cope with systems that do not have \code{#!/bin/bash} (PR - \ghpr{75} fixing issue \ghpr{74}) - \item RcppArmadillo now defines ARMA_32BIT_WORD to ensure we always - use integer vectors that be passed to R - } -} - -\section{Changes in RcppArmadillo version 0.6.400.2.0 (2015-12-15)}{ - \itemize{ - \item Upgraded to Armadillo 6.400.2 ("Flying Spaghetti Monster Deluxe") - \itemize{ - \item expanded \code{each_col()}, \code{each_row()} and - \code{each_slice()} to handle C++11 lambda functions - \item added \code{ind2sub()} and \code{sub2ind()} - \item fixes for corner cases in gmm_diag class - } - } -} - -\section{Changes in RcppArmadillo version 0.6.300.2.2 (2015-12-12)}{ - \itemize{ - \item Upgraded to Armadillo 6.300.3-test ("Flying Spaghetti Monster") - \itemize{ - \item Additional test in \code{auxlib_meat.hpp} for limited LAPACK - } - \item Updated test and \code{#define} for limited LAPACK version R - might be built with on Unix-alike systems - } -} - -\section{Changes in RcppArmadillo version 0.6.300.2.0 (2015-12-03)}{ - \itemize{ - \item Upgraded to Armadillo 6.300.2 ("Flying Spaghetti Monster") - \itemize{ - \item expanded \code{solve()} to find approximate solutions for rank-deficient systems - \item faster handling of non-contiguous submatrix views in compound expressions - \item added \code{.for_each()} to Mat, Row, Col, Cube and field classes - \item added \code{rcond()} for estimating the reciprocal condition number - \item fixes for \code{spsolve()}, \code{eigs_sym()}, \code{eigs_gen()}, \code{svds()} - } - \item Added support for \code{Cube} types via \code{as<>} converters - (PR \ghpr{64} by Nathan Russell, fixing \ghit{63} and \ghit{42}) - } -} - -\section{Changes in RcppArmadillo version 0.6.200.2.0 (2015-10-31)}{ - \itemize{ - \item Upgraded to Armadillo 6.200.0 ("Midnight Blue Deluxe") - \itemize{ - \item expanded \code{diagmat()} to handle non-square matrices and arbitrary diagonals - \item expanded \code{trace()} to handle non-square matrices - } - } -} - -\section{Changes in RcppArmadillo version 0.6.100.0.0 (2015-10-03)}{ - \itemize{ - \item Upgraded to Armadillo 6.100.0 ("Midnight Blue") - \itemize{ - \item faster \code{norm()} and \code{normalise()} when using ATLAS or OpenBLAS - \item added Schur decomposition: \code{schur()} - \item stricter handling of matrix objects by \code{hist()} and \code{histc()} - \item advanced constructors for using auxiliary memory by Mat, - Col, Row and Cube now have the default of \emph{strict = false} - \item Cube class now delays allocation of .slice() related structures until needed - \item expanded \code{join_slices()} to handle joining cubes with matrices - } - } -} - -\section{Changes in RcppArmadillo version 0.6.000.1.0 (2015-09-25)}{ - \itemize{ - \item Upgraded to Armadillo test / bug-fix release 0.6.000.1-test - \item Non-CRAN release - } -} - -\section{Changes in RcppArmadillo version 0.5.600.2.0 (2015-09-19)}{ - \itemize{ - \item Upgraded to Armadillo 5.600.2 ("Molotov Cocktail Deluxe") - \itemize{ - \item expanded \code{.each_col()} and \code{.each_row()} to handle out-of-place operations - \item added \code{.each_slice()} for repeated matrix operations on each slice of a cube - \item faster handling of compound expressions by \code{join_rows()} and \code{join_cols()} - } - } -} - -\section{Changes in RcppArmadillo version 0.5.500.2.0 (2015-09-03)}{ - \itemize{ - \item Upgraded to Armadillo 5.500.2 ("Molotov Cocktail") - \itemize{ - \item expanded object constructors and generators to handle \code{size()} based specification of dimensions - \item faster handling of submatrix rows - \item faster \code{clamp()} - \item fixes for handling sparse matrices - } - } -} - -\section{Changes in RcppArmadillo version 0.5.400.2.0 (2015-08-17)}{ - \itemize{ - \item Upgraded to Armadillo 5.400.2 ("Plutocracy Incorporated Deluxe") - \itemize{ - \item added \code{find_unique()} for finding indices of unique values - \item added \code{diff()} for calculating differences between consecutive elements - \item added \code{cumprod()} for calculating cumulative product - \item added \code{null()} for finding the orthonormal basis of null space - \item expanded \code{interp1()} to handle repeated locations - \item expanded \code{unique()} to handle complex numbers - \item faster \code{flupud()} - \item faster row-wise \code{cumsum()} - \item fix for k-means clustering in gmm_diag class - } - \item corrected use of \code{kitten()} thanks to Grant Brown - } -} - -\section{Changes in RcppArmadillo version 0.5.300.4 (2015-08-03)}{ - \itemize{ - \item Upgraded to Armadillo 5.300.4 ("Plutocrazy Incorporated") - \itemize{ - \item added generalised Schur decomposition: \code{qz()} - \item added \code{.has_inf()} and \code{.has_nan()} - \item expanded \code{interp1()} to handle out-of-domain locations - \item expanded sparse matrix class with \code{.set_imag()} and \code{.set_real()} - \item expanded \code{imag()}, \code{real()} and \code{conj()} to handle sparse matrices - \item expanded \code{diagmat()}, \code{reshape()} and \code{resize()} to handle sparse matrices - \item faster sparse \code{sum()} - \item faster row-wise \code{sum()}, \code{mean()}, \code{min()}, \code{max()} - \item updated physical constants to NIST 2014 CODATA values - \item fixes for handling sparse submatrix views - \item Armadillo can make use of GPUs by linking with NVIDIA NVBLAS - (a GPU-accelerated implementation of BLAS), or by linking with AMD - ACML (which can use GPUs via OpenCL) - } - \item Added \code{importFrom} statements for R functions not from base - \item Added explicit \code{Rcpp::sourceCpp()} reference as well - \item Updated one formatting detail in vignette to please TeXlive2015 - } -} - -\section{Changes in RcppArmadillo version 0.5.200.1.0 (2015-06-04)}{ - \itemize{ - \item Upgraded to Armadillo release 5.200.1 ("Boston Tea Smuggler") - \itemize{ - \item added \code{orth()} for finding the orthonormal basis of the range space of a matrix - \item expanded element initialisation to handle nested initialiser lists (C++11) - \item workarounds for bugs in GCC, Intel and MSVC C++ compilers - } - \item Added another example to \code{inst/examples/fastLm.r} - } -} - -\section{Changes in RcppArmadillo version 0.5.100.2.0 (2015-05-12)}{ - \itemize{ - \item Upgraded to Armadillo test / bug-fix release 5.100.2 - \item Non-CRAN release - } -} - -\section{Changes in RcppArmadillo version 0.5.100.1.0 (2015-05-01)}{ - \itemize{ - \item Upgraded to Armadillo release 5.100.1 ("Ankle Biter Deluxe") - \itemize{ - \item added \code{interp1()} for 1D interpolation - \item added \code{.is_sorted()} for checking whether a vector or matrix has sorted elements - \item updated physical constants to NIST 2010 CODATA values - } - } -} - -\section{Changes in RcppArmadillo version 0.5.000.0 (2015-04-12)}{ - \itemize{ - \item Upgraded to Armadillo release Version 5.000 ("Ankle Biter") - \itemize{ - \item added \code{spsolve()} for solving sparse systems of linear equations - \item added \code{svds()} for singular value decomposition of sparse matrices - \item added \code{nonzeros()} for extracting non-zero values from matrices - \item added handling of diagonal views by sparse matrices - \item expanded \code{repmat()} to handle sparse matrices - \item expanded \code{join_rows()} and \code{join_cols()} to handle sparse matrices - \item \code{sort_index()} and \code{stable_sort_index()} have been - placed in the delayed operations framework for increased efficiency - \item use of 64 bit integers is automatically enabled when using a C++11 compiler - \item workaround for a bug in recent releases of Apple Xcode - \item workaround for a bug in LAPACK 3.5 - } - } -} - -\section{Changes in RcppArmadillo version 0.4.999.1.0 (2015-04-04)}{ - \itemize{ - \item Upgraded to Armadillo release preview 4.999.1 - \item Non-CRAN test release - } -} - -\section{Changes in RcppArmadillo version 0.4.650.1.1 (2015-02-25)}{ - \itemize{ - \item Upgraded to Armadillo release Version 4.650.1 ("Intravenous Caffeine Injector") - \itemize{ - \item added \code{randg()} for generating random values from gamma distributions (C++11 only) - \item added \code{.head_rows()} and \code{.tail_rows()} to submatrix views - \item added \code{.head_cols()} and \code{.tail_cols()} to submatrix views - \item expanded \code{eigs_sym()} to optionally calculate - eigenvalues with smallest/largest algebraic values - fixes for handling of sparse matrices - } - \item Applied small correction to main header file to set up C++11 - RNG whether or not the alternate RNG (based on R, our default) is used - } -} - -\section{Changes in RcppArmadillo version 0.4.600.4.0 (2015-01-23)}{ - \itemize{ - \item Upgraded to Armadillo release Version 4.600.4 (still "Off The Reservation") - \itemize{ - \item Speedups in the transpose operation - \item Small bug fixes - } - } -} - -\section{Changes in RcppArmadillo version 0.4.600.0 (2014-12-27)}{ - \itemize{ - \item Upgraded to Armadillo release Version 4.600 ("Singapore Sling Deluxe") - \itemize{ - \item added \code{.head()} and \code{.tail()} to submatrix views - \item faster matrix transposes within compound expressions - \item faster \code{accu()} and \code{norm()} when compiling with - -O3 -ffast-math -march=native (gcc and clang) - \item workaround for a bug in GCC 4.4 - } - } -} - -\section{Changes in RcppArmadillo version 0.4.550.2.0 (2014-12-02)}{ - \itemize{ - \item Upgraded to Armadillo release Version 4.550.2 ("Singapore Sling Deluxe") - \itemize{ - \item Bug fixes for implicit template initiation for \code{std::pow()} seen with the old g++ 4.4* series - } - } -} - -\section{Changes in RcppArmadillo version 0.4.550.1.0 (2014-11-26)}{ - \itemize{ - \item Upgraded to Armadillo release Version 4.550.1 ("Singapore Sling Deluxe") - \itemize{ - \item added matrix exponential function: \code{expmat()} - \item faster \code{.log_p()} and \code{.avg_log_p()} functions in the \code{gmm_diag} class - when compiling with OpenMP enabled - \item faster handling of in-place addition/subtraction of expressions - with an outer product - \item applied correction to \code{gmm_diag} relative to the 4.550 release - } - \item The Armadillo Field type is now converted in \code{as<>} conversions - } -} - -\section{Changes in RcppArmadillo version 0.4.500.0 (2014-10-30)}{ - \itemize{ - \item Upgraded to Armadillo release Version 4.500 ("Singapore Sling") - \itemize{ - \item faster handling of complex vectors by \code{norm()} - \item expanded \code{chol()} to optionally specify output matrix - as upper or lower triangular - \item better handling of non-finite values when saving matrices as text files - } - \item The \code{sample} functionality has been extended to provide - the Walker Alias method (including new unit tests) via a pull request - by Christian Gunning - } -} - -\section{Changes in RcppArmadillo version 0.4.450.1.0 (2014-09-21)}{ - \itemize{ - \item Upgraded to Armadillo release Version 4.450.1 (Spring Hill Fort) - \itemize{ - \item faster handling of matrix transposes within compound - expressions - \item expanded \code{symmatu()}/\code{symmatl()} to optionally - disable taking the complex conjugate of elements - \item expanded \code{sort_index()} to handle complex vectors - \item expanded the \code{gmm_diag} class with functions to generate random samples - } - \item A new random-number implementation for Armadillo uses the RNG - from R as a fallback (when C++11 is not selected so the C++11-based - RNG is unavailable) which avoids using the older C++98-based \code{std::rand} - \item The \code{RcppArmadillo.package.skeleton()} function was - updated to only set an "Imports:" for Rcpp, but not RcppArmadillo - which (as a template library) needs only LinkingTo: - \item The \code{RcppArmadillo.package.skeleton()} function will now - prefer \code{pkgKitten::kitten()} over \code{package.skeleton()} in - order to create a working package which passes \code{R CMD check}. - \item The \CRANpkg{pkgKitten} package is now a \code{Suggests:} - \item A manual page was added to provide documentation for the - functions provided by the skeleton package. - \item A small update was made to the package manual page. - } -} - -\section{Changes in RcppArmadillo version 0.4.400.0 (2014-08-19)}{ - \itemize{ - \item Upgraded to Armadillo release Version 4.400 (Winter Shark Alley) - \itemize{ - \item added \code{gmm_diag} class for statistical modelling using Gaussian Mixture Models; - includes multi-threaded implementation of k-means and Expectation-Maximisation for parameter estimation - \item added \code{clamp()} for clamping values to be between lower and upper limits - \item expanded batch insertion constructors for sparse matrices to add values at repeated locations - \item faster handling of subvectors by \code{dot()} - \item faster handling of aliasing by submatrix views - } - \item Corrected a bug (found by the g++ Address Sanitizer) in sparse - matrix initialization where space for a sentinel was allocated, but - the sentinel was not set; with extra thanks to Ryan Curtin for help - \item Added a few unit tests for sparse matrices - } -} - -\section{Changes in RcppArmadillo version 0.4.320.0 (2014-07-03)}{ - \itemize{ - \item Upgraded to Armadillo release Version 4.320 (Daintree Tea Raider) - \itemize{ - \item expanded \code{eigs_sym()} and \code{eigs_gen()} to use an - optional tolerance parameter - \item expanded \code{eig_sym()} to automatically fall back to standard - decomposition method if divide-and-conquer fails - \item automatic installer enables use of C++11 random number generator - when using gcc 4.8.3+ in C++11 mode - } - } -} - -\section{Changes in RcppArmadillo version 0.4.300.8.0 (2014-05-31)}{ - \itemize{ - \item Upgraded to Armadillo release Version 4.300.8 (Medieval Cornea Scraper) - \itemize{ - \item More robust \code{norm}-related functions - \item Fixes between interactions between \code{cube} and - \code{vector} types. - } - \item Adds a \code{#define ARMA_DONT_USE_CXX11} to provide an option - to turn C++11 off for Armadillo (but client packages may still use it) - \item More robust Windows detection by using \code{_WIN32} as - well as \code{WIN32} as the latter gets diabled by MinGW with C++11 - \item On Windows, C++11 is turned off as the Armadillo code base uses - more features of C++11 than g++ 4.6.2 version in Rtools implements - } -} - -\section{Changes in RcppArmadillo version 0.4.300.5.0 (2014-05-19)}{ - \itemize{ - \item Upgraded to Armadillo release Version 4.300.5 (Medieval Cornea Scraper) - \itemize{ - \item Handle possible underflows and overflows in \code{norm()}, - \code{normalise()}, \code{norm_dot()} - \item Fix for handling of null vectors by \code{norm_dot()} - } - } -} - -\section{Changes in RcppArmadillo version 0.4.300.2.0 (2014-05-13)}{ - \itemize{ - \item Upgraded to Armadillo release Version 4.300.2 (Medieval Cornea Scraper) - \itemize{ - \item faster \code{find()} - } - } -} - -\section{Changes in RcppArmadillo version 0.4.300.0 (2014-05-04)}{ - \itemize{ - \item Upgraded to Armadillo release Version 4.300 (Medieval Cornea Scraper) - \itemize{ - \item faster \code{find()} - \item added \code{find_finite()} and \code{find_nonfinite()} for - finding indices of finite and non-finite elements - \item expressions \code{X=inv(A)*B*C} and \code{X=A.i()*B*C} are - automatically converted to X=solve(A,B*C) - } - \item Corrected conversion to \code{unsigned int} vectors and - matrices - \item Configure script now checks for R version 3.0.3 or newer to - enable complex divide-and-conquer SVD in case of R-supplied LAPACK - } -} - -\section{Changes in RcppArmadillo version 0.4.200.0 (2014-04-07)}{ - \itemize{ - \item Upgraded to Armadillo release Version 4.200 (Flintlock Swoop) - \itemize{ - \item faster transpose of sparse matrices - \item more efficient handling of aliasing during matrix multiplication - \item faster inverse of matrices marked as diagonal - } - } -} - -\section{Changes in RcppArmadillo version 0.4.100.2 (2014-03-07)}{ - \itemize{ - \item Upgraded to Armadillo release Version 4.100.2 - \itemize{ - \item fix for handling null vectors by \code{normalise()} - \item fix for memory handling by sparse matrices - } - \item Correct use of \code{[[ depends()]]} in skeleton example file - \item Prepare \code{src/Makevars} for C++11 support from R 3.1.0 by - defining \code{USE_CXX11} which is currently commented out - \item In the Armadillo configuration, turn on C++11 support if - \code{USE_CXX11} is defined - } -} - -\section{Changes in RcppArmadillo version 0.4.100.0 (2014-02-28)}{ - \itemize{ - \item Upgraded to Armadillo release Version 4.100.0 (Dirt Cruiser) - \itemize{ - \item added \code{normalise()} for normalising vectors to unit p-norm - \item extended the \code{field} class to handle 3D layout - \item extended \code{eigs_sym()} and \code{eigs_gen()} to obtain - eigenvalues of various forms (eg. largest or smallest magnitude) - \item automatic SIMD vectorisation of elementary expressions - (eg. matrix addition) when using Clang 3.4+ with -O3 optimisation - \item faster handling of sparse submatrix views - \item workaround for a bug in LAPACK 3.4 - } - } -} - -\section{Changes in RcppArmadillo version 0.4.000.4 (2014-02-19)}{ - \itemize{ - \item Upgraded to Armadillo release Version 4.000.4 - \itemize{ - \item fix for \code{randi()} generating out-of-interval values - \item fix for saving field objects - \item workaround for a bug in the Intel compiler - } - \item Updated for \CRANpkg{Rcpp} (>= 0.11.0) by removing linking step - from build process, added appropriate dependency on \CRANpkg{Rcpp} - \item Updated \code{RcppArmadillo.package.skeleton} function - accordingly to use proper \code{NAMESPACE} import - \item Rewritten \code{rcpparma_hello_world} (which is used by the - \code{RcppArmadillo.package.skeleton} function) to use Rcpp - Attributes, and added more examples - \item Added two functions to set Armadillo's RNGs (ie the system - RNG) from a given value and to randomize it, as suggested by Gábor - Csárdi. Note that these do not work within RStudio (which itself - also uses the same system RNG). - } -} - -\section{Changes in RcppArmadillo version 0.4.000.2 (2014-01-21)}{ - \itemize{ - \item Upgraded to Armadillo release Version 4.000.2 - \itemize{ - \item fix for \code{randi()} generating out-of-interval values - \item workaround for a bug in the Intel compiler - } - } -} - -\section{Changes in RcppArmadillo version 0.4.000 (2014-01-05)}{ - \itemize{ - \item Upgraded to Armadillo release Version 4.000 (Feral Steamroller) - \itemize{ - \item added eigen decompositions of sparse matrices: - \code{eigs_sym()} and \code{eigs_gen()} [ but this requires - linking against ARPACK which \CRANpkg{RcppArmadillo} as a - pure-template package does not do, and R is not linked against - ARPACK either. ] - \item added eigen decomposition for pair of matrices: \code{eig_pair()} - \item added simpler forms of \code{eig_gen()} - \item added condition number of matrices: \code{cond()} - \item expanded \code{find()} to handle cubes - \item expanded subcube views to access elements specified in a vector - \item template argument for \code{running_stat_vec} expanded to - accept vector types - \item more robust fast inverse of 4x4 matrices - \item faster divide-and-conquer decompositions are now used by - default for \code{eig_sym()}, \code{pinv()}, \code{princomp()}, - \code{rank()}, \code{svd()}, \code{svd_econ()} - \item the form \code{inv(sympd(X))} no longer assumes that X is - positive definite; use \code{inv_sympd()} instead - \item added MEX connector for interfacing Octave/Matlab with - Armadillo matrices (contributed by George Yammine) - } - } -} - -\section{Changes in RcppArmadillo version 0.3.930.1 (2013-12-09)}{ - \itemize{ - \item Upgraded to Armadillo release Version 3.930.1 - \itemize{ - \item Armadillo falls back to standard complex svd if the more - performant divide-and-conquer variant is unavailable - } - \item Added detection for Lapack library and distinguish between R's - own version (withhout zgesdd) and system Lapack; a preprocessor define is - set accordingly - } -} - -\section{Changes in RcppArmadillo version 0.3.930.0 (2013-12-06)}{ - \itemize{ - \item Upgraded to Armadillo release Version 3.930 ("Dragon's Back") - \itemize{ - \item added divide-and-conquer variant of \code{svd_econ()}, for - faster SVD - \item added divide-and-conquer variant of \code{pinv()}, for - faster pseudo-inverse - \item added element-wise variants of \code{min()} and \code{max()} - \item added \code{size()} based specifications of submatrix view - sizes - \item added \code{randi()} for generating matrices with random - integer values - \item added more intuitive specification of sort direction in - \code{sort()} and \code{sort_index()} - \item added more intuitive specification of method in - \code{det()}, \code{.i()}, \code{inv()} and \code{solve()} - \item added more precise timer for the \code{wall_clock} class - when using C++11 - } - \item New unit tests for complex matrices and vectors - } -} - -\section{Changes in RcppArmadillo version 0.3.920.3 (2013-11-20)}{ - \itemize{ - \item Upgraded to Armadillo release Version 3.920.3 - \itemize{ - \item fix for handling of tiny matrices by \code{.swap()} - } - } -} - -\section{Changes in RcppArmadillo version 0.3.920.1 (2013-09-27)}{ - \itemize{ - \item Upgraded to Armadillo release Version 3.920.1 (Agencia - Nacional Stasi) - \itemize{ - \item faster \code{.zeros()} - \item faster \code{round()}, \code{exp2()} and \code{log2()} when using C++11 - \item added signum function: \code{sign()} - \item added move constructors when using C++11 - \item added 2D fast Fourier transform: \code{fft2()} - \item added \code{.tube()} for easier extraction of vectors and subcubes from - cubes - \item added specification of a fill type during construction of Mat, Col, - Row and Cube classes, eg. \code{mat X(4, 5, fill::zeros)} - } - \item Initial implementation of \code{wrap} - \item Improved implementation of \code{as<>()} and \code{wrap()} - for sparse matrices - \item Converted main vignette from \code{LaTeX} style \code{minted} - to \code{lstlisting} which permits builds on CRAN; removed - set \code{BuildVignettes: FALSE}. - } -} - -\section{Changes in RcppArmadillo version 0.3.910.0 (2013-08-12)}{ - \itemize{ - \item Upgraded to Armadillo release Version 3.910.0 (Pyrenees) - \itemize{ - \item faster multiplication of a matrix with a transpose of - itself, ie. \code{X*X.t()} and \code{X.t()*X} - \item added \code{vectorise()} for reshaping matrices into vectors - \item added \code{all()} and \code{any()} for indicating presence - of elements satisfying a relational condition - } - \item Added conversion support for sparse matrices (of type double) - created by the \CRANpkg{Matrix} package as class \code{dgCMatrix} - \item Moved vignette sources from \code{inst/doc} to \code{vignettes}; - set \code{BuildVignettes: FALSE} as the \code{minted} mode for - \code{LaTeX} upsets the CRAN builders. - } -} - -\section{Changes in RcppArmadillo version 0.3.900.7 (2013-08-02)}{ - \itemize{ - \item Upgraded to Armadillo release Version 3.900.7 (Bavarian - Sunflower) - \itemize{ - \item minor fix for inplace \code{reshape()} - \item minor corrections for compilation issues under GCC 4.8+ and MSVC - } - \item Corrected setting of \code{vec_stats} in intialization of row, - vector and matrix objects - \item The \pkg{inline} package is no longer used in the examples and - unit tests which have all been converted to using Rcpp attributes - } -} - -\section{Changes in RcppArmadillo version 0.3.900 (2013-06-04)}{ - \itemize{ - \item Upgraded to Armadillo release Version 3.900.0 (Bavarian - Sunflower) - \itemize{ - \item added automatic SSE2 vectorisation of elementary expressions - (eg. matrix addition) when using GCC 4.7+ with -O3 optimisation - \item added support for saving & loading of cubes in HDF5 format, - contributed by Szabolcs Horvat - \item faster \code{median()}, contributed by Ruslan Shestopalyuk - \item faster handling of compound expressions with transposes of - submatrix rows - \item faster handling of compound expressions with transposes of - complex vectors - } - \item Kalman filter example switched from inline to \code{sourceCpp}, - which simplifies / streamlines the C++ side a little - } -} - -\section{Changes in RcppArmadillo version 0.3.820 (2013-05-12)}{ - \itemize{ - \item Upgraded to Armadillo release Version 3.820 (Mt Cootha) - \itemize{ - \item faster \code{as_scalar()} for compound expressions - \item faster transpose of small vectors - \item faster matrix-vector product for small vectors - \item faster multiplication of small fixed size matrices - } - } -} - -\section{Changes in RcppArmadillo version 0.3.810.2 (2013-04-30)}{ - \itemize{ - \item Upgraded to Armadillo release Version 3.810.2 - \itemize{ - \item minor fix for initialisation of sparse matrices - } - } -} - -\section{Changes in RcppArmadillo version 0.3.810.0 (2013-04-19)}{ - \itemize{ - \item Upgraded to Armadillo release Version 3.810.0 (Newell Highway) - \itemize{ - \item added fast Fourier transform: \code{fft()} - \item added handling of \code{.imbue()} and \code{.transform()} by - submatrices and subcubes - \item added batch insertion constructors for sparse matrices - \item minor fix for multiplication of complex sparse matrices - } - \item Updated sample() function and test again contributed by - Christian Gunning - } -} - -\section{Changes in RcppArmadillo version 0.3.800.1 (2013-03-12)}{ - \itemize{ - \item Upgraded to Armadillo release Version 3.800.1 (Miami Beach) - \itemize{ - \item workaround for a bug in ATLAS 3.8 on 64 bit systems - \item faster matrix-vector multiply for small matrices - } - \item Added new sample() function and tests contributed by Christian Gunning - \item Refactored unit testing code for faster unit test performance - } -} - -\section{Changes in RcppArmadillo version 0.3.800.0 (2013-03-01)}{ - \itemize{ - \item Upgraded to Armadillo release Version 3.800.0 (Miami Beach) - \itemize{ - \item Armadillo is now licensed using the Mozilla Public License 2.0 - \item added \code{.imbue()} for filling a matrix/cube with values provided by a functor or lambda expression - \item added \code{.swap()} for swapping contents with another matrix - \item added \code{.transform()} for transforming a matrix/cube using a functor or lambda expression - \item added \code{round()} for rounding matrix elements towards nearest integer - \item faster \code{find()} - \item fixes for handling non-square matrices by \code{qr()} and \code{qr_econ()} - \item minor fixes for handling empty matrices - \item reduction of pedantic compiler warnings - } - \item Updated vignette to paper now in press at CSDA - \item Added CITATION file with reference to CSDA paper - } -} - -\section{Changes in RcppArmadillo version 0.3.6.3 (2013-02-20)}{ - \itemize{ - \item Upgraded to Armadillo release Version 3.6.3 - \itemize{ - \item faster \code{find()} - \item minor fix for non-contiguous submatrix views to handle empty vectors of indices - \item reduction of pedantic compiler warnings - } - } -} - -\section{Changes in RcppArmadillo version 0.3.6.2 (2013-01-29)}{ - \itemize{ - \item Upgraded to Armadillo release Version 3.6.2 - \itemize{ - \item faster determinant for matrices marked as diagonal or triangular - \item more fine-grained handling of 64 bit integers - } - \item Added a new example of a Kalman filter implementation in R, and C++ - using Armadillo via RcppArmadillo, complete with timing comparison - } -} - -\section{Changes in RcppArmadillo version 0.3.6.1 (2012-12-17)}{ - \itemize{ - \item Upgraded to Armadillo release Version 3.6.1 (Piazza del Duomo) - \itemize{ - \item faster \code{trace()} - \item fix for handling sparse matrices by \code{dot()} - \item fixes for interactions between sparse and dense matrices - } - \item Now throws compiler error if \code{Rcpp.h} is included before - \code{RcppArmadillo.h} (as the former is included automatically by the - latter anyway, but template logic prefers this ordering). - } -} - -\section{Changes in RcppArmadillo version 0.3.4.3 (2012-10-04)}{ - \itemize{ - \item Upgraded to Armadillo release 3.4.3 - \itemize{ - \item fix for aliasing issue in \code{diagmat()} - \item fix for \code{speye()} signature - } - } -} - -\section{Changes in RcppArmadillo version 0.3.4.2 (2012-09-25)}{ - \itemize{ - \item Upgraded to Armadillo release 3.4.2 - \itemize{ - \item minor fixes for handling sparse submatrix views - \item minor speedups for sparse matrices - } - } -} - -\section{Changes in RcppArmadillo version 0.3.4.1 (2012-09-18)}{ - \itemize{ - \item Upgraded to Armadillo release 3.4.1 - \itemize{ - \item workaround for a bug in the Mac OS X accelerate framework - \item fixes for handling empty sparse matrices - \item added documentation for saving & loading matrices in HDF5 format - \item faster dot() and cdot() for complex numbers - } - } -} - -\section{Changes in RcppArmadillo version 0.3.4.0 (2012-09-06)}{ - \itemize{ - \item Upgraded to Armadillo release 3.4.0 (Ku De Ta) - \itemize{ - \item added economical QR decomposition: qr_econ() - \item added .each_col() & .each_row() for vector operations repeated on each column or row - \item added preliminary support for sparse matrices, contributed by Ryan Curtin et al. (Georgia Institute of Technology) - \item faster singular value decomposition via divide-and-conquer algorithm - \item faster .randn() - } - \item NEWS file converted to Rd format - } -} -\section{Changes in RcppArmadillo version 0.3.3.91 (2012-08-30)}{ - \itemize{ - \item Upgraded to Armadillo release 3.3.91 - \itemize{ - \item faster singular value decomposition via "divide and conquer" algorithm - \item added economical QR decomposition: qr_econ() - \item added .each_col() & .each_row() for vector operations repeated on each column or row - \item added preliminary support for sparse matrices, contributed by Ryan Curtin, James Cline and Matthew Amidon (Georgia Institute of Technology) - } - \item Corrected summary method to deal with the no intercept case when using a formula; also display residual summary() statistics - \item Expanded unit tests for fastLm - } -} -\section{Changes in RcppArmadillo version 0.3.2.4 (2012-07-11)}{ - \itemize{ - \item Upgraded to Armadillo release 3.2.4 - \itemize{ - \item workaround for a regression (bug) in GCC 4.7.0 and 4.7.1 - } - } -} -\section{Changes in RcppArmadillo version 0.3.2.3 (2012-07-01)}{ - \itemize{ - \item Upgraded to Armadillo release 3.2.3 - \itemize{ - \item minor correction for declaration of fixed size vectors and matrices - \item Reverted three header files \{Mat,Row,Col\}_bones.hpp back to previous release due to compilation failures under g++-4.7 - \item Added new vignette 'RcppArmadillo-intro' based on a just-submitted introductory paper (by Eddelbuettel and Sanderson) about RcppArmadillo - \item Change from release 3.2.2 which we skipped as it did not really affect builds under R: - \itemize{ - \item minor fix for compiling without debugging enabled (aka release mode) - \item better detection of ATLAS during installation on Fedora and Red Hat systems - } - \item Small enhancement to fastLm - } - } -} -\section{Changes in RcppArmadillo version 0.3.2.0 (2012-05-21)}{ - \itemize{ - \item Upgraded to Armadillo release 3.2.0 "Creamfields" - \itemize{ - \item faster eigen decomposition via "divide and conquer" algorithm - \item faster transpose of vectors and compound expressions - \item faster handling of diagonal views - \item faster handling of tiny fixed size vectors (≤ 4 elements) - \item added unique(), for finding unique elements of a matrix - } - } -} -\section{Changes in RcppArmadillo version 0.3.1.94 (2012-05-15)}{ - \itemize{ - \item Upgraded to Armadillo release 3.1.94 "v3.2 beta 2" - \itemize{ - \item added unique(), for finding unique elements of a matrix - \item faster eigen decomposition via "divide and conquer" algorithm - \item faster transpose of vectors and compound expressions - \item faster handling of tiny fixed size vectors (≤ 4 elements) - } - } -} -\section{Changes in RcppArmadillo version 0.3.1.92 (2012-05-10)}{ - \itemize{ - \item Upgraded to Armadillo release 3.1.92 "v3.2 beta 2" - \itemize{ - \item added unique(), for finding unique elements of a matrix - \item faster eigen decomposition via optional use of "divide and conquer" by eig_sym() - \item faster transpose of vectors and compound expressions - } - } -} -\section{Changes in RcppArmadillo version 0.3.0.3 (2012-05-03)}{ - \itemize{ - \item Upgraded to Armadillo release 3.0.3 - \itemize{ - \item fixes for inplace transpose of complex number matrices - \item fixes for complex number version of svd_econ() - \item fixes for potential aliasing issues with submatrix views - } - \item New example script fastLm - } -} -\section{Changes in RcppArmadillo version 0.3.0.2 (2012-04-19)}{ - \itemize{ - \item Upgraded to Armadillo release 3.0.2 - \itemize{ - \item fixes for handling diagonal matrices - } - \item Undefine NDEBUG if it has been set (as R does) as this prevents a number of useful debugging checks. Users can still define it or define ARMA_NO_DEBUG if they want a 'non-development' build - } -} -\section{Changes in RcppArmadillo version 0.3.0.1 (2012-04-12)}{ - \itemize{ - \item Upgraded to Armadillo release 3.0.1 - \itemize{ - \item fixes for compilation errors - \item fixes for potential aliasing issues - } - } -} -\section{Changes in RcppArmadillo version 0.3.0 (2012-04-10)}{ - \itemize{ - \item Upgraded to Armadillo release 3.0.0 "Antarctic Chilli Ranch" - \itemize{ - \item added non-contiguous submatrix views - \item added shorthand for inverse: .i() - \item added hist() and histc() - \item faster repmat() - \item faster handling of submatrix views with one row or column - \item faster generation of random numbers - \item faster element access in fixed size matrices - \item better detection of vector expressions by sum(), cumsum(), prod(), min(), max(), mean(), median(), stddev(), var() - \item expressions X=A.i()*B and X=inv(A)*B are automatically converted to X=solve(A,B) - } - } -} -\section{Changes in RcppArmadillo version 0.2.40 (2012-04-04)}{ - \itemize{ - \item Upgraded to Armadillo release 2.99.4 "Antarctic Chilli Ranch (Beta 4)" - \itemize{ - \item fixes for handling expressions with fixed size matrices - } - } -} -\section{Changes in RcppArmadillo version 0.2.39 (2012-04-02)}{ - \itemize{ - \item Upgraded to Armadillo release 2.99.3 "Antarctic Chilli Ranch (Beta 3)" - \itemize{ - \item faster repmat() - \item workarounds for braindead compilers (eg. Visual Studio) - } - } -} -\section{Changes in RcppArmadillo version 0.2.38 (2012-03-28)}{ - \itemize{ - \item Upgraded to Armadillo release 2.99.2 "Antarctic Chilli Ranch (Beta 2)" - \itemize{ - \item added .i() - \item much faster handling of .col() and .row() - \item expressions X=A.i()*B and X=inv(A)*B are automatically converted to X=solve(A,B) - } - } -} -\section{Changes in RcppArmadillo version 0.2.37 (2012-03-19)}{ - \itemize{ - \item Upgraded to Armadillo release 2.99.1 "Antarctic Chilli Ranch (Beta 1)" - \itemize{ - \item added non-contiguous submatrix views - \item added hist() and histc() - \item faster handling of submatrix views - \item faster generation of random numbers - \item faster element access in fixed size matrices - \item better detection of vector expressions by sum(), cumsum(), prod(), min(), max(), mean(), median(), stddev(), var() - } - } -} -\section{Changes in RcppArmadillo version 0.2.36 (2012-03-05)}{ - \itemize{ - \item Upgraded to Armadillo release 2.4.4 - \itemize{ - \item fixes for qr() and syl() - \item more portable wall_clock class - \item faster relational operators on submatrices - } - } -} -\section{Changes in RcppArmadillo version 0.2.35 (2012-02-17)}{ - \itemize{ - \item Upgraded to Armadillo release 2.4.3 - \itemize{ - \item Support for ARMA_DEFAULT_OSTREAM using Rcpp::Rcout added - \item Minor bug fix release improving corner cases affecting builds: - \itemize{ - \item Missing semicolon added in Mat_meat (when in C++0x mode), with thanks to Teo Guo Ci - \item Armadillo version vars now instantiated in RcppArmadillo.cpp which helps older g++ versions, with thanks to Gershon Bialer - \item Thanks also to Martin Renner for testing these changes - \item Unit tests output fallback directory changed per Brian Ripley's request to not ever use /tmp - \item Minor update to version numbers in RcppArmadillo-package.Rd - } - } - } -} -\section{Changes in RcppArmadillo version 0.2.34 (2011-12-12)}{ - \itemize{ - \item Upgraded to Armadillo release 2.4.2 - \itemize{ - \item clarified documentation for .reshape() - \item fix for handling of empty matrices by .resize() - } - } -} -\section{Changes in RcppArmadillo version 0.2.33 (2011-12-07)}{ - \itemize{ - \item Upgraded to Armadillo release 2.4.1 - \itemize{ - \item added .resize() - \item fix for vector initialisation - } - } -} -\section{Changes in RcppArmadillo version 0.2.32 (2011-12-04)}{ - \itemize{ - \item Upgraded to Armadillo test release 2.4.0 "Loco Lounge Lizard" - \item Minimal changes relative to 0.2.31 based on 2.3.92, next section is relative to the previous stable release series 2.2.* of Armadillo - \itemize{ - \item added shorter forms of transposes: .t() and .st() - \item added optional use of 64 bit indices, allowing matrices to have more than 4 billion elements - \item added experimental support for C++11 initialiser lists - \item faster pinv() - \item faster inplace transpose - \item faster handling of expressions with diagonal views - \item fixes for handling expressions with aliasing and submatrices - \item fixes for linking on Ubuntu and Debian systems - \item fixes for inconsistencies in interactions between matrices and cubes - \item refactored code to eliminate warnings when using the Clang C++ compiler - \item .print_trans() and .raw_print_trans() are deprecated - } - } -} -\section{Changes in RcppArmadillo version 0.2.31 (2011-11-28)}{ - \itemize{ - \item Upgraded to Armadillo test release 2.3.92 "Loco Lounge Lizard (Beta 2)" - \itemize{ - \item fixes for linking on Ubuntu and Debian systems - \item fixes for inconsistencies in interactions between matrices and cubes - } - } -} -\section{Changes in RcppArmadillo version 0.2.30 (2011-11-19)}{ - \itemize{ - \item Upgraded to Armadillo test release 2.3.91 "Loco Lounge Lizard (Beta 1)" - \itemize{ - \item added shorter forms of transposes: .t() and .st() - \item added optional use of 64 bit indices, allowing matrices to have more than 4 billion elements - \item added experimental support for C++11 initialiser lists - \item faster pinv() - \item faster inplace transpose - \item bugfixes for handling expressions with aliasing and submatrices - \item refactored code to eliminate warnings when using the Clang C++ compiler - \item .print_trans() and .raw_print_trans() are deprecated - } - } -} -\section{Changes in RcppArmadillo version 0.2.29 (2011-09-01)}{ - \itemize{ - \item Upgraded to Armadillo release 2.2.3 - \itemize{ - \item Release fixes a speed issue in the as_scalar() function. - } - } -} -\section{Changes in RcppArmadillo version 0.2.28 (2011-08-02)}{ - \itemize{ - \item Upgraded to Armadillo release 2.2.1 "Blue Skies Debauchery" - \itemize{ - \item faster multiplication of small matrices - \item faster trans() - \item faster handling of submatrices by norm() - \item added economical singular value decomposition: svd_thin() - \item added circ_toeplitz() - \item added .is_colvec() & .is_rowvec() - \item fixes for handling of complex numbers by cov(), cor(), running_stat_vec - } - } -} -\section{Changes in RcppArmadillo version 0.2.27 (2011-07-22)}{ - \itemize{ - \item Upgraded to Armadillo release 2.1.91 "v2.2 beta 1" - \itemize{ - \item faster multiplication of small matrices - \item faster trans() - \item faster handling of submatrices by norm() - \item added economical singular value decomposition: svd_thin() - \item added circ_toeplitz() - \item added .is_colvec() & .is_rowvec() - } - } -} -\section{Changes in RcppArmadillo version 0.2.26 (2011-07-17)}{ - \itemize{ - \item Upgraded to Armadillo release 2.0.2 - \itemize{ - \item fix for handling of conjugate transpose by as_scalar() - \item fix for handling of aliasing by diagmat() - \item fix for handling of empty matrices by symmatu()/symmatl() - } - } -} -\section{Changes in RcppArmadillo version 0.2.25 (2011-06-30)}{ - \itemize{ - \item Upgraded to Armadillo 2.0.1 which fixes two minor compilation issues - } -} -\section{Changes in RcppArmadillo version 0.2.24 (2011-06-29)}{ - \itemize{ - \item Upgraded to Armadillo release 2.0.0 "Carnivorous Sugar Glider" - \itemize{ - \item faster multiplication of tiny matrices (≤ 4x4) - \item faster compound expressions containing submatrices - \item faster inverse of symmetric positive definite matrices - \item faster element access for fixed size matrices - \item added handling of arbitrarily sized empty matrices (eg. 5x0) - \item added loading & saving of matrices as CSV text files - \item added .count() member function to running_stat and running_stat_vec - \item added syl(), strans(), symmatu()/symmatl() - \item added submatrices of submatrices - \item det(), inv() and solve() can be forced to use more precise - \item algorithms for tiny matrices (≤ 4x4) - \item htrans() has been deprecated; use trans() instead - \item API change: trans() now takes the complex conjugate when transposing a complex matrix - \item API change: .is_vec() now outputs true for empty vectors (eg. 0x1) - \item API change: forms of chol(), eig_sym(), eig_gen(), inv(), lu(), pinv(), princomp(), qr(), solve(), svd(), syl() that do not return a bool indicating success now throw std::runtime_error exceptions when failures are detected - \item API change: princomp_cov() has been removed; princomp() in conjunction with cov() can be used instead - \item API change: set_log_stream() & get_log_stream() have been replaced by set_stream_err1() & get_stream_err1() - } - } -} -\section{Changes in RcppArmadillo version 0.2.23 (2011-06-23)}{ - \itemize{ - \item Upgraded to Armadillo release 1.99.5 "v2.0 beta 5" - \itemize{ - \item Forms of chol(), eig_sym(), eig_gen(), inv(), lu(), pinv(), princomp(), qr(), solve(), svd(), syl() that do not return a bool indicating success now throw std::runtime_error exceptions when failures are detected - \item princomp_cov() has been removed; princomp() in conjunction with cov() can be used instead - \item set_log_stream() & get_log_stream() have been replaced by set_stream_err1() & get_stream_err1() - \item det(), inv() and solve() can be forced to use more precise algorithms for tiny matrices (≤ 4x4) - \item Added loading & saving of matrices as CSV text files - } - \item fastLmPure() now uses same argument order as R's lm.fit() - \item Export and document S3 methods in NAMESPACE and manual page as such - } -} -\section{Changes in RcppArmadillo version 0.2.22 (2011-06-06)}{ - \itemize{ - \item Upgraded to Armadillo release 1.99.4 "v2.0 beta 4" - \itemize{ - \item fixes for handling of tiny matrices - } - } -} -\section{Changes in RcppArmadillo version 0.2.21 (2011-05-27)}{ - \itemize{ - \item Upgraded to Armadillo release 1.99.3 "v2.0 beta 3" - \itemize{ - \item stricter size checking for row and column vectors - \item added .count() member function to running_stat and running_stat_vec - } - } -} -\section{Changes in RcppArmadillo version 0.2.20 (2011-05-25)}{ - \itemize{ - \item Upgraded to Armadillo release 1.99.2 "v2.0 beta 2" (and 1.99.1 before) - \itemize{ - \item faster inverse of symmetric matrices - \item faster element access for fixed size matrices - \item faster multiplication of tiny matrices (eg. 4x4) - \item faster compund expressions containing submatrices - \item added handling of arbitrarily sized empty matrices (eg. 5x0) - \item added syl() - \item added strans() - \item added symmatu()/symmatl() - \item added submatrices of submatrices - \item htrans() has been deprecated; use trans() instead - \item trans() now takes the complex conjugate when transposing a complex matrix - \item .is_vec() now outputs true for empty matrices - \item most functions with matrix inputs no longer throw exceptions when given empty matrices (eg. 5x0) - } - \item Added a new subdirectory examples/ seeded with a nice Vector Autoregression simulation simulation example by Lance Bachmeier - \item Rewrote armadillo_version as to no longer require an instance of arma::arma_version, with tanks to Conrad for the suggestion - } -} -\section{Changes in RcppArmadillo version 0.2.19 (2011-04-18)}{ - \itemize{ - \item Upgraded to Armadillo version 1.2.0 "Unscrupulous Carbon Emitter" - \itemize{ - \item Added ability to use Blas & Lapack libraries with capitalised function names - \item Reduction of pedantic compiler warnings - } - } -} -\section{Changes in RcppArmadillo version 0.2.18 (2011-04-03)}{ - \itemize{ - \item Upgraded to Armadillo version 1.1.92 "Jurassic Barbecue" - \itemize{ - \item Bugfix in cor() - \item Automatic installation now requires CMake >= 2.6 - } - } -} -\section{Changes in RcppArmadillo version 0.2.17 (2011-03-22)}{ - \itemize{ - \item Upgraded to Armadillo version 1.1.90 "Inside Job" - \itemize{ - \item Added .min() & .max(), which can provide the extremum's location - \item More robust mean(), var(), stddev() - } - } -} -\section{Changes in RcppArmadillo version 0.2.16 (2011-03-10)}{ - \itemize{ - \item Upgraded to Armadillo version 1.1.8 "Kangaroo Steak" - \itemize{ - \item Added floor() and ceil() - \item Added “not a number”: math::nan() - \item Added infinity: math::inf() - \item Added standalone is_finite() - \item Faster min(), max(), mean() - \item Bugfix for a corner case with NaNs in min() and max() - } - } -} -\section{Changes in RcppArmadillo version 0.2.15 (2011-03-04)}{ - \itemize{ - \item Upgraded to Armadillo version 1.1.6 “Baby Carpet Shark” - \itemize{ - \item fixed size matrices and vectors can use auxiliary (external) memory - \item .in_range() can use span() arguments - \item subfields can use span() arguments - } - } -} -\section{Changes in RcppArmadillo version 0.2.14 (2011-03-02)}{ - \itemize{ - \item Support Run-Time Type Information (RTTI) on matrices by setting the state variable vec_state in Row and Col instantiation, with thanks to Conrad Sanderson for the hint - \item fastLm code simplified further by instantiating the Armadillo matrix and vector directly from the SEXP coming from R - \item inst/doc/Makefile now respects $R_HOME environment variable - } -} -\section{Changes in RcppArmadillo version 0.2.13 (2011-02-18)}{ - \itemize{ - \item Upgraded to Armadillo version 1.1.4 “Manta Lodge” - \itemize{ - \item Faster sort() - \item Updated installation to detect recent versions of Intel's MKL - \item Added interpretation of arbitrary "flat" subcubes as matrices - } - } -} -\section{Changes in RcppArmadillo version 0.2.12 (2011-02-15)}{ - \itemize{ - \item Upgraded to Armadillo version 1.1.2 “Flood Kayak” - \itemize{ - \item Faster prod() - \item Faster solve() for compound expressions - \item Fix for compilation using GCC's C++0x mode - \item Fix for matrix handling by subcubes - } - } -} -\section{Changes in RcppArmadillo version 0.2.11 (2011-01-06)}{ - \itemize{ - \item Upgraded to Armadillo version 1.1.0 “Climate Vandal” - \itemize{ - \item Extended submatrix views, including access to elements whose indices are specified in a separate vector - \item Added handling of raw binary files by save/load functions - \item Added cumsum() - \item Added interpretation of matrices as triangular via trimatu()/trimatl() - \item Faster solve(), inv() via explicit handling of triangular matrices - \item The stream for logging of errors and warnings can now be changed - } - \item New unexported R function SHLIB, a small wrapper around R CMD SHLIB, which can be used as Rscript -e "RcppArmadillo:::SHLIB('foo.cpp')" - } -} -\section{Changes in RcppArmadillo version 0.2.10 (2010-11-25)}{ - \itemize{ - \item Upgraded to Armadillo 1.0.0 "Antipodean Antileech" - \itemize{ - \item After 2 1/2 years of collaborative development, we are proud to release the 1.0 milestone version. - \item Many thanks are extended to all contributors and bug reporters. - } - \item R/RcppArmadillo.package.skeleton.R: Updated to no longer rely on GNU make for builds of packages using RcppArmadillo - \item summary() for fastLm() objects now returns r.squared and adj.r.squared - } -} -\section{Changes in RcppArmadillo version 0.2.9 (2010-11-11)}{ - \itemize{ - \item Upgraded to Armadillo 0.9.92 "Wall Street Gangster": - \itemize{ - \item Fixes for compilation issues under the Intel C++ compiler - \item Added matrix norms - } - } -} -\section{Changes in RcppArmadillo version 0.2.8 (2010-10-16)}{ - \itemize{ - \item Upgraded to Armadillo 0.9.90 "Water Dragon": - \itemize{ - \item Added unsafe_col() - \item Speedups and bugfixes in lu() - \item Minimisation of pedantic compiler warnings - } - \item Switched NEWS and ChangeLog between inst/ and the top-level directory so that NEWS (this file) gets installed with the package - } -} -\section{Changes in RcppArmadillo version 0.2.7 (2010-09-25)}{ - \itemize{ - \item Upgraded to Armadillo 0.9.80 "Chihuahua Muncher": - \itemize{ - \item Added join_slices(), insert_slices(), shed_slices() - \item Added in-place operations on diagonals - \item Various speedups due to internal architecture improvements - } - } -} -\section{Changes in RcppArmadillo version 0.2.6 (2010-09-12)}{ - \itemize{ - \item Upgraded to Armadillo 0.9.70 "Subtropical Winter Safari" - \item arma::Mat, arma::Row and arma::Col get constructor that take vector or matrix sugar expressions. See the unit test "test.armadillo.sugar.ctor" and "test.armadillo.sugar.matrix.ctor" for examples. - } -} -\section{Changes in RcppArmadillo version 0.2.5 (2010-08-05)}{ - \itemize{ - \item Upgraded to Armadillo 0.9.60 "Killer Bush Turkey" - } -} -\section{Changes in RcppArmadillo version 0.2.4 (2010-07-27)}{ - \itemize{ - \item Upgraded to Armadillo 0.9.52 'Monkey Wrench' - \item src/fastLm.cpp: Switch from inv() to pinv() as inv() now tests for singular matrices and warns and returns an empty matrix which stops the example fastLm() implementation on the manual page -- and while this is generally reasonably it makes sense here to continue which the Moore-Penrose pseudo-inverse allows us to do this - } -} -\section{Changes in RcppArmadillo version 0.2.3 (2010-06-14)}{ - \itemize{ - \item Better configuration to detect suncc (which does not have std::isfinite) - } -} -\section{Changes in RcppArmadillo version 0.2.2 (2010-06-09)}{ - \itemize{ - \item Added RcppArmadillo:::CxxFlags for cases where RcppArmadillo is not used via a package - \item Upgraded to Armadillo 0.9.10 'Chilli Espresso' - \item Wrap support for mtOp, i.e. operations involving mixed types such as a complex and an arma::mat, which have been introduced in armadillo 0.9.10 - \item Wrap support for mtGlue, i.e. operations involving matrices of mixed types such as an arma::mat and an arma::imat, which have been introduced in armadillo 0.9.10 - \item Included an inline plugin to support the plugin system introduced in inline 0.3.5. The unit tests have moved from the src directory to the unit test directory (similar to Rcpp) using cxxfunction with the RcppArmadillo plugin. - } -} -\section{Changes in RcppArmadillo version 0.2.1 (2010-05-19)}{ - \itemize{ - \item Bug-fix release permitting compilation on Windows - } -} -\section{Changes in RcppArmadillo version 0.2.0 (2010-05-18)}{ - \itemize{ - \item fastLm() is now generic and has a formula interface as well as methods for print, summary, predict to behave like a standard model fitting function - \item Armadillo sources (using release 0.9.8) are now included in the package using a standardized build suitable for our purposes (not assuming Boost or Atlas) -- see ?RcppArmadillo for details - \item New R function RcppArmadillo.package.skeleton, similar to Rcpp::Rcpp.package.skeleton, but targetting use of RcppArmadillo - } -} -\section{Changes in RcppArmadillo version 0.1.0 (2010-03-11)}{ - \itemize{ - \item the fastLm() implementation of a bare-bones lm() fit (using Armadillo's solve() function) provides an example of how efficient code can be written compactly using the combination of Rcpp, RcppAramadillo and Armadillo - \item support for Rcpp implicit wrap of these types : Mat, Col, Row, Cube where T is one of : int, unsigned int, double, float - \item support for Rcpp implicit as of these types : Mat, Col, Row where R is one of : int, unsigned int, double, float - } -} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/R/RcppArmadillo b/Luminescence.BuildResults/Library/RcppArmadillo/R/RcppArmadillo deleted file mode 100644 index 668615632..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/R/RcppArmadillo +++ /dev/null @@ -1,27 +0,0 @@ -# File share/R/nspackloader.R -# Part of the R package, https://www.R-project.org -# -# Copyright (C) 1995-2012 The R Core Team -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# A copy of the GNU General Public License is available at -# https://www.r-project.org/Licenses/ - -local({ - info <- loadingNamespaceInfo() - pkg <- info$pkgname - ns <- .getNamespace(as.name(pkg)) - if (is.null(ns)) - stop("cannot find namespace environment for ", pkg, domain = NA); - dbbase <- file.path(info$libname, pkg, "R", pkg) - lazyLoad(dbbase, ns, filter = function(n) n != ".__NAMESPACE__.") -}) diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/R/RcppArmadillo.rdb b/Luminescence.BuildResults/Library/RcppArmadillo/R/RcppArmadillo.rdb deleted file mode 100644 index 912eddd5b..000000000 Binary files a/Luminescence.BuildResults/Library/RcppArmadillo/R/RcppArmadillo.rdb and /dev/null differ diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/R/RcppArmadillo.rdx b/Luminescence.BuildResults/Library/RcppArmadillo/R/RcppArmadillo.rdx deleted file mode 100644 index 5d5b3e567..000000000 Binary files a/Luminescence.BuildResults/Library/RcppArmadillo/R/RcppArmadillo.rdx and /dev/null differ diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/announce/ANNOUNCE-0.2.0.txt b/Luminescence.BuildResults/Library/RcppArmadillo/announce/ANNOUNCE-0.2.0.txt deleted file mode 100644 index 54747b27a..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/announce/ANNOUNCE-0.2.0.txt +++ /dev/null @@ -1,140 +0,0 @@ - -===== Armadillo ===== - -Armadillo is a C++ linear algebra library aiming towards a good balance -between speed and ease of use. Integer, floating point and complex numbers -are supported, as well as a subset of trigonometric and statistics -functions. Various matrix decompositions are provided through optional -integration with LAPACK and ATLAS libraries. - -A delayed evaluation approach is employed (during compile time) to combine -several operations into one and reduce (or eliminate) the need for -temporaries. This is accomplished through recursive templates and template -meta-programming. - -This library is useful if C++ has been decided as the language of choice -(due to speed and/or integration capabilities), rather than another language -like Matlab or Octave. It is distributed under a license that is useful in -both open-source and commercial contexts. - -Armadillo is primarily developed by Conrad Sanderson at NICTA (Australia), -with contributions from around the world. - - -===== RcppArmadillo ===== - -RcppArmadillo is an R package that facilitates using Armadillo classes -in R packages through Rcpp. It achieves the integration by extending Rcpp's -data interchange concepts to Armadillo classes. - - -===== Example ===== - -Here is a simple implementation of a fast linear regression (provided by -RcppArmadillo via the fastLm() function): - -#include - -extern "C" SEXP fastLm(SEXP ys, SEXP Xs) { - Rcpp::NumericVector yr(ys); // creates Rcpp vector from SEXP - Rcpp::NumericMatrix Xr(Xs); // creates Rcpp matrix from SEXP - int n = Xr.nrow(), k = Xr.ncol(); - - arma::mat X(Xr.begin(), n, k, false); // reuses memory and avoids extra copy - arma::colvec y(yr.begin(), yr.size(), false); - - arma::colvec coef = arma::solve(X, y); // fit model y ~ X - arma::colvec res = y - X*coef; // residuals - - double s2 = std::inner_product(res.begin(), res.end(), res.begin(), double())/(n - k); - // std.errors of coefficients - arma::colvec stderr = arma::sqrt(s2 * arma::diagvec( arma::inv(arma::trans(X)*X) )); - - return Rcpp::List::create(Rcpp::Named("coefficients") = coef, - Rcpp::Named("stderr") = stderr, - Rcpp::Named("df") = n - k - ); -} - -Note however that you may not want to compute a linear regression fit this -way in order to protect from numerical inaccuracies on rank-deficient -problems. The help page for fastLm() provides an example. - - -===== Using RcppArmadillo in other packages ===== - -RcppArmadillo is designed so that its classes can be used from other packages. - -Using RcppArmadillo requires: - - - Using the header files provided by Rcpp and RcppArmadillo. This is - typically achieved by adding this line in the DESCRIPTION file of the - client package: - - LinkingTo : Rcpp, RcppArmadillo - - and the following line in the package code: - - #include - - - Linking against Rcpp dynamic or shared library and librairies needed - by Armadillo, which is achieved by adding this line in the src/Makevars - file of the client package: - - PKG_LIBS = $(shell $(R_HOME)/bin/Rscript -e "Rcpp:::LdFlags()" ) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) - - and this line in the file src/Makevars.win: - - PKG_LIBS = $(shell Rscript.exe -e "Rcpp:::LdFlags()") $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) - -RcppArmadillo contains a function RcppArmadillo.package.skeleton, modelled -after package.skeleton from the utils package in base r, that creates a -skeleton of a package using RcppArmadillo, including example code. - - -===== Quality Assurance ===== - -RcppArmadillo uses the RUnit package by Matthias Burger et al to provide -unit testing. RcppArmadillo currently has 19 unit tests (called from 8 unit -test functions). - -Source code for unit test functions are stored in the unitTests directory -of the installed package and the results are collected in the -"RcppArmadillo-unitTests" vignette. - -We run unit tests before sending the package to CRAN on as many systems as -possible, including Mac OSX (Snow Leopard), Debian, Ubuntu, Fedora 12 -(64bit), Win 32 and Win64. - -Unit tests can also be run from the installed package by executing - - RcppArmadillo:::test() - -where an output directory can be provided as an optional first argument. - - -===== Links ===== - -Armadillo : http://arma.sourceforge.net/ -RcppArmadillo main page: http://dirk.eddelbuettel.com/code/rcpp.armadillo.html -R-forge Rcpp project page: http://r-forge.r-project.org/projects/rcpp/ -Dirk's blog : http://dirk.eddelbuettel.com/blog/code/rcpp/ -Romain's blog : http://romainfrancois.blog.free.fr/index.php?category/R-package/RcppArmadillo - - -===== Support ===== - -Questions about RcppArmadillo should be directed to the Rcpp-devel mailing -list at - https://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/rcpp-devel - -Questions about Armadillo itself should be directed to its forum -http://sourceforge.net/apps/phpbb/arma/ - - - -- Romain Francois, Montpellier, France - Dirk Eddelbuettel, Chicago, IL, USA - Doug Bates, Madison, WI, USA - - May 2010 - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/doc/RcppArmadillo-intro.Rnw b/Luminescence.BuildResults/Library/RcppArmadillo/doc/RcppArmadillo-intro.Rnw deleted file mode 100644 index c2bd7559d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/doc/RcppArmadillo-intro.Rnw +++ /dev/null @@ -1,10 +0,0 @@ -\documentclass{article} -\usepackage{pdfpages} -%\VignetteIndexEntry{RcppArmadillo-introduction} -%\VignetteKeywords{R, C++, Armadillo, linear algebra, kalman filter} -%\VignettePackage{RcppArmadillo} -%\VignetteEncoding{UTF-8} - -\begin{document} -\includepdf[pages=-, fitpaper=true]{pdf/RcppArmadillo-intro.pdf} -\end{document} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/doc/RcppArmadillo-intro.pdf b/Luminescence.BuildResults/Library/RcppArmadillo/doc/RcppArmadillo-intro.pdf deleted file mode 100644 index 34cfbcd52..000000000 Binary files a/Luminescence.BuildResults/Library/RcppArmadillo/doc/RcppArmadillo-intro.pdf and /dev/null differ diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/doc/RcppArmadillo-sparseMatrix.Rnw b/Luminescence.BuildResults/Library/RcppArmadillo/doc/RcppArmadillo-sparseMatrix.Rnw deleted file mode 100644 index 4a9598a0e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/doc/RcppArmadillo-sparseMatrix.Rnw +++ /dev/null @@ -1,10 +0,0 @@ -\documentclass{article} -\usepackage{pdfpages} -%\VignetteIndexEntry{RcppArmadillo-sparseMatrix} -%\VignetteKeywords{R, C++, Armadillo, linear algebra, sparse matrix} -%\VignettePackage{RcppArmadillo} -%\VignetteEncoding{UTF-8} - -\begin{document} -\includepdf[pages=-, fitpaper=true]{pdf/RcppArmadillo-sparseMatrix.pdf} -\end{document} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/doc/RcppArmadillo-sparseMatrix.pdf b/Luminescence.BuildResults/Library/RcppArmadillo/doc/RcppArmadillo-sparseMatrix.pdf deleted file mode 100644 index 5721b66eb..000000000 Binary files a/Luminescence.BuildResults/Library/RcppArmadillo/doc/RcppArmadillo-sparseMatrix.pdf and /dev/null differ diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/doc/index.html b/Luminescence.BuildResults/Library/RcppArmadillo/doc/index.html deleted file mode 100644 index f8d68df69..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/doc/index.html +++ /dev/null @@ -1,34 +0,0 @@ - - -R: Vignettes and other documentation - - - -
-

Vignettes and other documentation - -

-
-
-[Top] -
-

Vignettes from package 'RcppArmadillo'

- ------- - - - - - - - - - -
RcppArmadillo::RcppArmadillo-introRcppArmadillo-introductionPDFsource
RcppArmadillo::RcppArmadillo-sparseMatrixRcppArmadillo-sparseMatrixPDFsource
-
diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/examples/fastLm.r b/Luminescence.BuildResults/Library/RcppArmadillo/examples/fastLm.r deleted file mode 100644 index 5f006011e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/examples/fastLm.r +++ /dev/null @@ -1,161 +0,0 @@ -#!/usr/bin/r -## -## fastLm.r: Benchmarking lm() via RcppArmadillo and directly -## -## Copyright (C) 2010 - 2015 Dirk Eddelbuettel, Romain Francois and Douglas Bates -## -## This file is part of RcppArmadillo. -## -## RcppArmadillo is free software: you can redistribute it and/or modify it -## under the terms of the GNU General Public License as published by -## the Free Software Foundation, either version 2 of the License, or -## (at your option) any later version. -## -## RcppArmadillo is distributed in the hope that it will be useful, but -## WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with RcppArmadillo. If not, see . - -library(Rcpp) -library(RcppArmadillo) -library(rbenchmark) - -## start from SEXP, most conversions, longest code -src <- ' -Rcpp::List fLmSEXP(SEXP Xs, SEXP ys) { - Rcpp::NumericMatrix Xr(Xs); - Rcpp::NumericVector yr(ys); - int n = Xr.nrow(), k = Xr.ncol(); - arma::mat X(Xr.begin(), n, k, false); - arma::colvec y(yr.begin(), yr.size(), false); - int df = n - k; - - // fit model y ~ X, extract residuals - arma::colvec coef = arma::solve(X, y); - arma::colvec res = y - X*coef; - - double s2 = std::inner_product(res.begin(), res.end(), - res.begin(), 0.0)/df; - // std.errors of coefficients - arma::colvec sderr = arma::sqrt(s2 * - arma::diagvec(arma::pinv(arma::trans(X)*X))); - - return Rcpp::List::create(Rcpp::Named("coefficients")=coef, - Rcpp::Named("stderr") =sderr, - Rcpp::Named("df") =df); -} -' -cppFunction(code=src, depends="RcppArmadillo") - -## start from Rcpp types are early RcppArmadillo examples did -src <- ' -Rcpp::List fLmTwoCasts(Rcpp::NumericMatrix Xr, Rcpp::NumericVector yr) { - int n = Xr.nrow(), k = Xr.ncol(); - arma::mat X(Xr.begin(), n, k, false); - arma::colvec y(yr.begin(), yr.size(), false); - int df = n - k; - - // fit model y ~ X, extract residuals - arma::colvec coef = arma::solve(X, y); - arma::colvec res = y - X*coef; - - double s2 = std::inner_product(res.begin(), res.end(), - res.begin(), 0.0)/df; - // std.errors of coefficients - arma::colvec sderr = arma::sqrt(s2 * - arma::diagvec(arma::pinv(arma::trans(X)*X))); - - return Rcpp::List::create(Rcpp::Named("coefficients")=coef, - Rcpp::Named("stderr") =sderr, - Rcpp::Named("df") =df); -} -' -cppFunction(code=src, depends="RcppArmadillo") - -## start from Armadillo types -src <- ' -Rcpp::List fLmOneCast(arma::mat X, arma::colvec y) { - int df = X.n_rows - X.n_cols; - - // fit model y ~ X, extract residuals - arma::colvec coef = arma::solve(X, y); - arma::colvec res = y - X*coef; - - double s2 = std::inner_product(res.begin(), res.end(), - res.begin(), 0.0)/df; - // std.errors of coefficients - arma::colvec sderr = arma::sqrt(s2 * - arma::diagvec(arma::pinv(arma::trans(X)*X))); - - return Rcpp::List::create(Rcpp::Named("coefficients")=coef, - Rcpp::Named("stderr") =sderr, - Rcpp::Named("df") =df); -} -' -cppFunction(code=src, depends="RcppArmadillo") - -## start from Armadillo types passed as constant references -src <- ' -Rcpp::List fLmConstRef(const arma::mat & X, const arma::colvec & y) { - int df = X.n_rows - X.n_cols; - - // fit model y ~ X, extract residuals - arma::colvec coef = arma::solve(X, y); - arma::colvec res = y - X*coef; - - double s2 = std::inner_product(res.begin(), res.end(), - res.begin(), 0.0)/df; - // std.errors of coefficients - arma::colvec sderr = arma::sqrt(s2 * - arma::diagvec(arma::pinv(arma::trans(X)*X))); - - return Rcpp::List::create(Rcpp::Named("coefficients")=coef, - Rcpp::Named("stderr") =sderr, - Rcpp::Named("df") =df); -} -' -cppFunction(code=src, depends="RcppArmadillo") - - -fastLmPureDotCall <- function(X, y) { - .Call("_RcppArmadillo_fastLm_impl", X, y, PACKAGE = "RcppArmadillo") -} - - -y <- log(trees$Volume) -X <- cbind(1, log(trees$Girth)) -frm <- formula(log(Volume) ~ log(Girth)) - -res <- benchmark(fLmOneCast(X, y), # inline'd above - fLmTwoCasts(X, y), # inline'd above - fLmConstRef(X, y), # inline'd above - fLmSEXP(X, y), # inline'd above - fastLmPure(X, y), # similar, but with 2 error checks - fastLmPureDotCall(X, y), # now without the 2 error checks - fastLm(frm, data=trees), # using model matrix - lm.fit(X, y), # R's fast function, no stderr - lm(frm, data=trees), # R's standard function - columns = c("test", "replications", "relative", - "elapsed", "user.self", "sys.self"), - order="relative", - replications=5000) - -print(res[,1:4]) - -## second run without formulae approach but larger N -res <- benchmark(fLmOneCast(X, y), # inline'd above - fLmTwoCasts(X, y), # inline'd above - fLmSEXP(X, y), # inline'd above - fLmConstRef(X, y), # inline'd above - fastLmPure(X, y), # similar, but with 2 error checks - fastLmPureDotCall(X, y), # now without the 2 error checks - lm.fit(X, y), # R's fast function, no stderr - columns = c("test", "replications", "relative", - "elapsed", "user.self", "sys.self"), - order="relative", - replications=50000) - -print(res[,1:4]) diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/examples/kalman/FirstKalmanR.R b/Luminescence.BuildResults/Library/RcppArmadillo/examples/kalman/FirstKalmanR.R deleted file mode 100644 index d0ca4e4a8..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/examples/kalman/FirstKalmanR.R +++ /dev/null @@ -1,37 +0,0 @@ -FirstKalmanR <- function(pos) { - - kalmanfilter <- function(z) { - dt <- 1 - A <- matrix(c( 1, 0, dt, 0, 0, 0, 0, 1, 0, dt, 0, 0, # x, y - 0, 0, 1, 0, dt, 0, 0, 0, 0, 1, 0, dt, # Vx, Vy - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1), # Ax, Ay - 6, 6, byrow=TRUE) - H <- matrix( c(1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0), - 2, 6, byrow=TRUE) - Q <- diag(6) - R <- 1000 * diag(2) - - xprd <- A %*% xest # predicted state and covriance - pprd <- A %*% pest %*% t(A) + Q - - S <- H %*% t(pprd) %*% t(H) + R # estimation - B <- H %*% t(pprd) - kalmangain <- t(solve(S, B)) - - ## estimated state and covariance, assign to vars in parent env - xest <<- xprd + kalmangain %*% (z - H %*% xprd) - pest <<- pprd - kalmangain %*% H %*% pprd - - ## compute the estimated measurements - y <- H %*% xest - } - xest <- matrix(0, 6, 1) - pest <- matrix(0, 6, 6) - - N <- nrow(pos) - y <- matrix(NA, N, 2) - for (i in 1:N) { - y[i,] <- kalmanfilter(t(pos[i,,drop=FALSE])) - } - invisible(y) -} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/examples/kalman/Kalman.cpp b/Luminescence.BuildResults/Library/RcppArmadillo/examples/kalman/Kalman.cpp deleted file mode 100644 index b0488689e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/examples/kalman/Kalman.cpp +++ /dev/null @@ -1,59 +0,0 @@ - -// [[Rcpp::depends(RcppArmadillo)]] - -#include - -using namespace arma; - -class Kalman { -private: - mat A, H, Q, R, xest, pest; - double dt; - -public: - // constructor, sets up data structures - Kalman() : dt(1.0) { - A.eye(6,6); - A(0,2) = A(1,3) = A(2,4) = A(3,5) = dt; - H.zeros(2,6); - H(0,0) = H(1,1) = 1.0; - Q.eye(6,6); - R = 1000 * eye(2,2); - xest.zeros(6,1); - pest.zeros(6,6); - } - - // sole member function: estimate model - mat estimate(const mat & Z) { - unsigned int n = Z.n_rows, k = Z.n_cols; - mat Y = zeros(n, k); - mat xprd, pprd, S, B, kalmangain; - colvec z, y; - - for (unsigned int i = 0; i. - - -## load Rcpp to be able to use cppFunction() below -suppressMessages(library(Rcpp)) - - -## parameter and error terms used throughout -a <- matrix(c(0.5,0.1,0.1,0.5),nrow=2) -e <- matrix(rnorm(10000),ncol=2) - -## Let's start with the R version -rSim <- function(coeff, errors) { - simdata <- matrix(0, nrow(errors), ncol(errors)) - for (row in 2:nrow(errors)) { - simdata[row,] = coeff %*% simdata[(row-1),] + errors[row,] - } - return(simdata) -} - -rData <- rSim(a, e) # generated by R - - -## Now let's load the R compiler (requires R 2.13 or later) -suppressMessages(require(compiler)) -compRsim <- cmpfun(rSim) - -compRData <- compRsim(a,e) # generated by R 'compiled' - -stopifnot(all.equal(rData, compRData)) # checking results - - -## C++ variant: code passed as a text variable ... -code <- ' -arma::mat rcppSim(const arma::mat& coeff, const arma::mat& errors) { - int m = errors.n_rows; - int n = errors.n_cols; - arma::mat simdata(m,n); - simdata.row(0) = arma::zeros(1,n); - for (int row=1; row - -R: 'Rcpp' Integration for the 'Armadillo' Templated Linear Algebra -Library - - - -
-

'Rcpp' Integration for the 'Armadillo' Templated Linear Algebra -Library - -

-
-
-[Up] -[Top] -

Documentation for package ‘RcppArmadillo’ version 14.0.2-1

- - - -

Help Pages

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
RcppArmadillo-packageR and Armadillo Integration
armadillo_get_number_of_omp_threadsReport (or Set) Maximum Number of OpenMP Threads
armadillo_reset_coresThrottle (or Reset) (Rcpp)Armadillo to Two Cores
armadillo_set_number_of_omp_threadsReport (or Set) Maximum Number of OpenMP Threads
armadillo_set_seedSet the Armadillo Random Number Generator to the given value
armadillo_set_seed_randomSet the Armadillo Random Number Generator to a random value
armadillo_throttle_coresThrottle (or Reset) (Rcpp)Armadillo to Two Cores
armadillo_versionReport the version of Armadillo
fastLmBare-bones linear model fitting function
fastLm.defaultBare-bones linear model fitting function
fastLm.formulaBare-bones linear model fitting function
fastLmPureBare-bones linear model fitting function
RcppArmadilloR and Armadillo Integration
RcppArmadillo.package.skeletonCreate a skeleton for a new package that intends to use RcppArmadillo
RcppArmadilloExampleR and Armadillo Integration
-
diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/html/R.css b/Luminescence.BuildResults/Library/RcppArmadillo/html/R.css deleted file mode 100644 index c2289098f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/html/R.css +++ /dev/null @@ -1,130 +0,0 @@ -@media screen { - .container { - padding-right: 10px; - padding-left: 10px; - margin-right: auto; - margin-left: auto; - max-width: 900px; - } -} - -.rimage img { /* from knitr - for examples and demos */ - width: 96%; - margin-left: 2%; -} - -.katex { font-size: 1.1em; } - -code { - color: inherit; - background: inherit; -} - -body { - line-height: 1.4; - background: white; - color: black; -} - -a:link { - background: white; - color: blue; -} - -a:visited { - background: white; - color: rgb(50%, 0%, 50%); -} - -h1 { - background: white; - color: rgb(55%, 55%, 55%); - font-family: monospace; - font-size: 1.4em; /* x-large; */ - text-align: center; -} - -h2 { - background: white; - color: rgb(40%, 40%, 40%); - font-family: monospace; - font-size: 1.2em; /* large; */ - text-align: center; -} - -h3 { - background: white; - color: rgb(40%, 40%, 40%); - font-family: monospace; - font-size: 1.2em; /* large; */ -} - -h4 { - background: white; - color: rgb(40%, 40%, 40%); - font-family: monospace; - font-style: italic; - font-size: 1.2em; /* large; */ -} - -h5 { - background: white; - color: rgb(40%, 40%, 40%); - font-family: monospace; -} - -h6 { - background: white; - color: rgb(40%, 40%, 40%); - font-family: monospace; - font-style: italic; -} - -img.toplogo { - width: 4em; - vertical-align: middle; -} - -img.arrow { - width: 30px; - height: 30px; - border: 0; -} - -span.acronym { - font-size: small; -} - -span.env { - font-family: monospace; -} - -span.file { - font-family: monospace; -} - -span.option{ - font-family: monospace; -} - -span.pkg { - font-weight: bold; -} - -span.samp{ - font-family: monospace; -} - -div.vignettes a:hover { - background: rgb(85%, 85%, 85%); -} - -tr { - vertical-align: top; -} - -span.rlang { - font-family: Courier New, Courier; - color: #666666; -} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/README b/Luminescence.BuildResults/Library/RcppArmadillo/include/README deleted file mode 100644 index 9ab2ede54..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/README +++ /dev/null @@ -1,6 +0,0 @@ -to upgrade to a new release of armadillo: - -- copy the armadillo file here -- replace the armadillo_bits directory by the one from the armadillo source -- ignore (or remove) armadillo_bits/config.hpp.cmake as we do not configuration - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo.h b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo.h deleted file mode 100644 index 5590d193f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo.h +++ /dev/null @@ -1,39 +0,0 @@ - -// RcppArmadillo.h: Rcpp/Armadillo glue -// -// Copyright (C) 2010 - 2021 Dirk Eddelbuettel, Romain Francois and Douglas Bates -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -#ifndef RcppArmadillo__RcppArmadillo__h -#define RcppArmadillo__RcppArmadillo__h - -#if defined(Rcpp_hpp) && !defined(COMPILING_RCPPARMADILLO) - #error "The file 'Rcpp.h' should not be included. Please correct to include only 'RcppArmadillo.h'." -#endif - -// Set up actual #include after first #include and more config -#include - -// Now automatically include Rcpp as well -#include - -// Remaining RcppArmadillo code -#include -#include -#include - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/Alt_R_RNG.h b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/Alt_R_RNG.h deleted file mode 100644 index a6cafaaa0..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/Alt_R_RNG.h +++ /dev/null @@ -1,4 +0,0 @@ - -// This file support the legacy location and includes from the new location - -#include "RcppArmadillo/rng/Alt_R_RNG.h" diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/Light b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/Light deleted file mode 100644 index 96ebeb943..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/Light +++ /dev/null @@ -1,44 +0,0 @@ -// Emacs, please make this -*- mode: C++; -*- - -// RcppArmadillo: Rcpp/Armadillo glue -// -// Copyright (C) 2010 - 2022 Dirk Eddelbuettel, Romain Francois and Douglas Bates -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -#ifndef RcppArmadillo__RcppArmadillo -#define RcppArmadillo__RcppArmadillo - -#if defined(Rcpp_hpp) && !defined(COMPILING_RCPPARMADILLO) - #error "The file 'Rcpp.h' should not be included. Please correct to include only 'RcppArmadillo.h'." -#endif - -// We are undoing a design decision from early on by allowing vectors be returned -// as standard 'one-dimension' objects -- as opposed to the matrix form we imposed -#define RCPP_ARMADILLO_RETURN_ANYVEC_AS_VECTOR - -// Set up actual #include after first #include and more config -#include - -// Automatically include Rcpp as well -- but only the 'light' mode sans modules -#include - -// Remaining RcppArmadillo code -#include -#include -#include - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/Lighter b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/Lighter deleted file mode 100644 index 974c11748..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/Lighter +++ /dev/null @@ -1,44 +0,0 @@ -// Emacs, please make this -*- mode: C++; -*- - -// RcppArmadillo: Rcpp/Armadillo glue -// -// Copyright (C) 2010 - 2022 Dirk Eddelbuettel, Romain Francois and Douglas Bates -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -#ifndef RcppArmadillo__RcppArmadillo -#define RcppArmadillo__RcppArmadillo - -#if defined(Rcpp_hpp) && !defined(COMPILING_RCPPARMADILLO) - #error "The file 'Rcpp.h' should not be included. Please correct to include only 'RcppArmadillo.h'." -#endif - -// We are undoing a design decision from early on by allowing vectors be returned -// as standard 'one-dimension' objects -- as opposed to the matrix form we imposed -#define RCPP_ARMADILLO_RETURN_ANYVEC_AS_VECTOR - -// Set up actual #include after first #include and more config -#include - -// Automatically include Rcpp as well -- but only the 'lighter' mode sans modules and rtti -#include - -// Remaining RcppArmadillo code -#include -#include -#include - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/Lightest b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/Lightest deleted file mode 100644 index c25b06430..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/Lightest +++ /dev/null @@ -1,44 +0,0 @@ -// Emacs, please make this -*- mode: C++; -*- - -// RcppArmadillo: Rcpp/Armadillo glue -// -// Copyright (C) 2010 - 2022 Dirk Eddelbuettel, Romain Francois and Douglas Bates -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -#ifndef RcppArmadillo__RcppArmadillo -#define RcppArmadillo__RcppArmadillo - -#if defined(Rcpp_hpp) && !defined(COMPILING_RCPPARMADILLO) - #error "The file 'Rcpp.h' should not be included. Please correct to include only 'RcppArmadillo.h'." -#endif - -// We are undoing a design decision from early on by allowing vectors be returned -// as standard 'one-dimension' objects -- as opposed to the matrix form we imposed -#define RCPP_ARMADILLO_RETURN_ANYVEC_AS_VECTOR - -// Set up actual #include after first #include and more config -#include - -// Automatically include Rcpp as well -- but only the 'lightest' mode sans modules, rtti, sugar -#include - -// Remaining RcppArmadillo code -#include -#include -#include - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/RcppArmadillo b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/RcppArmadillo deleted file mode 100644 index 5517b6a7a..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/RcppArmadillo +++ /dev/null @@ -1,44 +0,0 @@ -// Emacs, please make this -*- mode: C++; -*- - -// RcppArmadillo: Rcpp/Armadillo glue -// -// Copyright (C) 2010 - 2022 Dirk Eddelbuettel, Romain Francois and Douglas Bates -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -#ifndef RcppArmadillo__RcppArmadillo -#define RcppArmadillo__RcppArmadillo - -#if defined(Rcpp_hpp) && !defined(COMPILING_RCPPARMADILLO) - #error "The file 'Rcpp.h' should not be included. Please correct to include only 'RcppArmadillo.h'." -#endif - -// We are undoing a design decision from early on by allowing vectors be returned -// as standard 'one-dimension' objects -- as opposed to the matrix form we imposed -#define RCPP_ARMADILLO_RETURN_ANYVEC_AS_VECTOR - -// Set up actual #include after first #include and more config -#include - -// Automatically include Rcpp as well -- full version -#include - -// Remaining RcppArmadillo code -#include -#include -#include - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/config/RcppArmadilloConfig.h b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/config/RcppArmadilloConfig.h deleted file mode 100644 index eecb7e7ed..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/config/RcppArmadilloConfig.h +++ /dev/null @@ -1,144 +0,0 @@ - -// RcppArmadilloConfig.h: Rcpp/Armadillo glue -// -// Copyright (C) 2010 - 2022 Dirk Eddelbuettel, Romain Francois and Douglas Bates -// Copyright (C) 2016 - 2022 George G. Vega Yon -// Copyright (C) 2017 - 2022 Serguei Sokol -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -#ifndef RcppArmadillo__RcppArmadilloConfig__h -#define RcppArmadillo__RcppArmadilloConfig__h - -#if !defined(ARMA_USE_LAPACK) -#define ARMA_USE_LAPACK -#endif - -#if !defined(ARMA_USE_BLAS) -#define ARMA_USE_BLAS -#endif - -#define ARMA_HAVE_STD_ISFINITE -#define ARMA_HAVE_STD_ISINF -#define ARMA_HAVE_STD_ISNAN -#define ARMA_HAVE_STD_SNPRINTF - - -/* TODO: we might need to undef this on other platforms as well */ -#if defined(__GNUC__) && defined(_WIN64) || defined(__FreeBSD__) -#undef ARMA_HAVE_STD_SNPRINTF -#endif - -/* - suncc does not have std::isfinite (which is not standard) - so we tell armadillo not to use it, and comment out a few - others while we are at it -*/ -#if defined(__SUNPRO_CC) -#undef ARMA_HAVE_STD_ISFINITE -#undef ARMA_HAVE_STD_SNPRINTF -#undef ARMA_HAVE_LOG1P -#undef ARMA_HAVE_STD_ISINF -#undef ARMA_HAVE_STD_ISNAN -#endif - -// Let's be careful for now and undef this as not all compilers support this -//#if defined(ARMA_USE_CXX11) -//#undef ARMA_USE_CXX11 -//#endif - -// If C++11 has been selected at the R package level, use it for Armadillo too -// This is actually not needed, if the proper switch is set via -std=... then -// Armadillo will know (cf compilation with -DARMA_EXTRA_DEBUG set) -// #if defined(USE_CXX1X) -// #define ARMA_USE_CXX11 -// #endif - -// We can use R as the RNG provider, see RcppArmadilloForward.h which -// enables inclusion of the appropriate headers. Alternatively, the -// C++11 RNG can be used by commenting out the current default and -// selecting the C++11 RNG instead. Lastly, one could (but should not) -// fall back to the C++98 RNG (often from the C library) by defining neither. - -// Rcpp has its own stream object which cooperates more nicely with R's i/o -// And as of Armadillo 2.4.3, we can use this stream object as well -// -// As of Armadillo 8.100.1, this has been renamed to ARMA_COUT_STREAM and -// ARMA_CERR_STREAM was added -// -#if !defined(ARMA_COUT_STREAM) -#define ARMA_COUT_STREAM Rcpp::Rcout -#endif -#if !defined(ARMA_CERR_STREAM) -#define ARMA_CERR_STREAM Rcpp::Rcerr -#endif - - -// R now defines NDEBUG which suppresses a number of useful Armadillo tests -// Users can still defined it later, and/or define ARMA_NO_DEBUG -// Updated 2022-Nov to only undefined if opt-in define has been set -#if defined(RCPPARMADILLO_UNDEFINE_NDEBUG) && defined(NDEBUG) - #undef NDEBUG -#endif - -// On Windows do not read autoconf-updated header -#if defined(WIN32) || defined(_WIN32) - // R can be built with its own Rlapack library, or use an external - // one. Only the latter has zgesdd, a complex-valued SVD using divide-and-conquer - // on Windows we do not assume ZGESDD - #define ARMA_CRIPPLED_LAPACK 1 - // on Windows we can now assume OpenMP with Rtools / gcc 4.9.3 - // note that performance is said to still be poor - // cf https://cran.r-project.org/doc/manuals/r-devel/R-admin.html#The-MinGW_002dw64-toolchain - #define ARMA_USE_OPENMP -#else - // on the other OSs we test via LAPACK_LIBS (in configure) which - // updates this include file - #include -#endif - -// Many client packages do not set the OpenMP compiler flag in their src/Makevars -// (ie add $(SHLIB_OPENMP_CXXFLAGS) to the PKG_CXXFLAGS line as we do) so to tone -// down the line noise we ask Armadillo not to print the warning -#if defined(ARMA_USE_OPENMP) - //#if !defined(_OPENMP) - // #pragma message("NOTE: To enable OpenMP-based speedups, add -fopenmp to the compiler flags. See Writing R Extension (Sec 1.2.1) and R Inst. + Admin. (Sec 6.3.3) for details.") - //#endif - #define ARMA_DONT_PRINT_OPENMP_WARNING 1 -#endif - - -// Under C++11 and C++14, Armadillo now defaults to using int64_t for -// integers. This prevents us from passing integer vectors to R as -// only used int32_t -- so we select the shorter representation here. -// Unless int64_t is explicitly required during compilation. -#if !defined(ARMA_64BIT_WORD) - #define ARMA_32BIT_WORD 1 -#endif - -// To return arma::vec or arma::rowvec as R vector (i.e. dimensionless), -// one of the following macro can be defined before including -// RcppArmadillo.h. "ANYVEC" applys for both col- and row-vec. -//#define RCPP_ARMADILLO_RETURN_COLVEC_AS_VECTOR -//#define RCPP_ARMADILLO_RETURN_ROWVEC_AS_VECTOR -//#define RCPP_ARMADILLO_RETURN_ANYVEC_AS_VECTOR - -// To preserve all dims of arma::field when passing objects to or from R -// the following macro can be defined before including RcppArmadillo.h. -// see https://github.com/RcppCore/RcppArmadillo/pull/352 -// #define RCPP_ARMADILLO_FIX_Field - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/config/RcppArmadilloConfigGenerated.h b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/config/RcppArmadilloConfigGenerated.h deleted file mode 100644 index 76f07be5c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/config/RcppArmadilloConfigGenerated.h +++ /dev/null @@ -1,34 +0,0 @@ - -// RcppArmadilloGenerated.h: Autoconf-updated file for LAPACK and OpenMP choices -// -// Copyright (C) 2013 - 2021 Dirk Eddelbuettel -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -#ifndef RcppArmadillo__RcppArmadilloConfigGenerated__h -#define RcppArmadillo__RcppArmadilloConfigGenerated__h - -#ifndef ARMA_CRIPPLED_LAPACK -// value on next line may be changed between #undef and #define by the configure script -#define ARMA_CRIPPLED_LAPACK 1 -#endif - -#ifndef ARMA_USE_OPENMP -// from configure test for OpenMP based on how R is configured, and whether g++ new enough -#define ARMA_DONT_USE_OPENMP 1 -#endif - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/config/RcppArmadilloConfigGenerated.h.in b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/config/RcppArmadilloConfigGenerated.h.in deleted file mode 100644 index 390ae2db1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/config/RcppArmadilloConfigGenerated.h.in +++ /dev/null @@ -1,34 +0,0 @@ - -// RcppArmadilloGenerated.h: Autoconf-updated file for LAPACK and OpenMP choices -// -// Copyright (C) 2013 - 2021 Dirk Eddelbuettel -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -#ifndef RcppArmadillo__RcppArmadilloConfigGenerated__h -#define RcppArmadillo__RcppArmadilloConfigGenerated__h - -#ifndef ARMA_CRIPPLED_LAPACK -// value on next line may be changed between #undef and #define by the configure script -@ARMA_LAPACK@ -#endif - -#ifndef ARMA_USE_OPENMP -// from configure test for OpenMP based on how R is configured, and whether g++ new enough -@ARMA_HAVE_OPENMP@ -#endif - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/interface/RcppArmadilloAs.h b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/interface/RcppArmadilloAs.h deleted file mode 100644 index e6dc8a72f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/interface/RcppArmadilloAs.h +++ /dev/null @@ -1,651 +0,0 @@ - -// RcppArmadilloAs.h: Rcpp/Armadillo glue, support for as -// -// Copyright (C) 2013 - 2021 Dirk Eddelbuettel and Romain Francois -// Copyright (C) 2017 - 2021 Serguei Sokol -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -#ifndef RcppArmadillo__RcppArmadilloAs__h -#define RcppArmadillo__RcppArmadilloAs__h - -namespace Rcpp{ - -namespace traits { - - template - class Exporter< arma::field > { - public: - Exporter(SEXP x) : data(x){} - inline arma::field get() { - size_t n = data.size(); - arma::field out(n); - # if defined(RCPP_ARMADILLO_FIX_Field) - if (!Rf_isNull(data.attr("dim"))) { - arma::ivec dims = data.attr("dim"); - if (dims.n_elem == 1) { - out.set_size(n); - } else if (dims.n_elem == 2) { - out.set_size(dims(0), dims(1)); - } else if (dims.n_elem == 3) { - out.set_size(dims(0), dims(1), dims(2)); - } - } - # endif - for (size_t i = 0; i < n; i++) - { - out(i) = as(data[i]); - } - return out ; - } - - private: - List data ; - }; - - template - class Exporter< arma::Col > : public IndexingExporter< arma::Col, T > { - public: - Exporter(SEXP x) : IndexingExporter< arma::Col, T >(x){} - }; - - template - class Exporter< arma::Row > : public IndexingExporter< arma::Row, T > { - public: - Exporter(SEXP x) : IndexingExporter< arma::Row, T >(x){} - }; - - template - class Exporter< arma::Mat > : public MatrixExporter< arma::Mat, T > { - public: - Exporter(SEXP x) : MatrixExporter< arma::Mat, T >(x){} - }; - - template - class Exporter< const arma::Mat& > { - public: - typedef typename Rcpp::Matrix< Rcpp::traits::r_sexptype_traits::rtype > MATRIX ; - - Exporter(SEXP x) : mat(x) {} - - inline arma::Mat* get(){ - return new arma::Mat( mat.begin(), mat.nrow(), mat.ncol(), false ) ; - } - - private: - MATRIX mat ; - }; - - // 14 June 2017 - // Add support for sparse matrices other than dgCMatrix - template - class Exporter< arma::SpMat > { - public: - Exporter( SEXP x ) { - is_stm=Rf_inherits(x, "simple_triplet_matrix"); - if (is_stm) { - li = x; - } - else { - mat = x; - } - } - - arma::SpMat get(){ - const int RTYPE = Rcpp::traits::r_sexptype_traits::rtype; - if (is_stm) { - arma::urowvec ti = as(li["i"]); - arma::urowvec tj = as(li["j"]); - arma::Col tx = li["v"]; - arma::SpMat res = arma::sp_mat(true, arma::join_cols(ti, tj)-1, tx, li["nrow"], li["ncol"], true, false); - return res; - } - - IntegerVector dims = mat.slot("Dim"); - int nrow = dims[0]; - int ncol = dims[1]; - - // Creating an empty SpMat - arma::SpMat res(static_cast(nrow), static_cast(ncol)); - - // Get the type of sparse matrix - std::string type = Rcpp::as(mat.slot("class")); - - if (type == "dgCMatrix" || mat.is("dgCMatrix")) { - IntegerVector i = mat.slot("i"); - IntegerVector p = mat.slot("p"); - Vector x = mat.slot("x"); - -#define DO_RESULT \ - do { \ - /* Allocate: */ \ - res.mem_resize(static_cast(x.size())); \ - \ - /* To access arrays internal to SpMat class: */ \ - res.sync(); \ - \ - /* Copy: */ \ - std::copy(i.begin(), i.end(), \ - arma::access::rwp(res.row_indices)); \ - std::copy(p.begin(), p.end(), \ - arma::access::rwp(res.col_ptrs)); \ - std::copy(x.begin(), x.end(), \ - arma::access::rwp(res.values)); \ - } while (0) - - DO_RESULT; - } - else if (type == "dtCMatrix" || mat.is("dtCMatrix")) { - IntegerVector i = mat.slot("i"); - IntegerVector p = mat.slot("p"); - Vector x = mat.slot("x"); - std::string diag = Rcpp::as(mat.slot("diag")); - - DO_RESULT; - - if (diag == "U") { - res.diag().ones(); - } - } - else if (type == "dsCMatrix" || mat.is("dsCMatrix")) { - IntegerVector i = mat.slot("i"); - IntegerVector p = mat.slot("p"); - Vector x = mat.slot("x"); - std::string uplo = Rcpp::as(mat.slot("uplo")); - - DO_RESULT; - - if (uplo == "U") { - res = symmatu(res); - } else { - res = symmatl(res); - } - } - else if (type == "dgTMatrix" || mat.is("dgTMatrix")) { - arma::urowvec ti = mat.slot("i"); - arma::urowvec tj = mat.slot("j"); - arma::Col tx = mat.slot("x"); - - res = arma::sp_mat(true, arma::join_cols(ti, tj), tx, nrow, ncol, true, false); - } - else if (type == "dtTMatrix" || mat.is("dtTMatrix")) { - arma::urowvec ti = mat.slot("i"); - arma::urowvec tj = mat.slot("j"); - arma::Col tx = mat.slot("x"); - - res = arma::sp_mat(true, arma::join_cols(ti, tj), tx, nrow, ncol, true, false); - if (Rcpp::as(mat.slot("diag")) == "U") { - res.diag().ones(); - } - } - else if (type == "dsTMatrix" || mat.is("dsTMatrix")) { - arma::urowvec ti = mat.slot("i"); - arma::urowvec tj = mat.slot("j"); - arma::Col tx = mat.slot("x"); - - res = arma::sp_mat(true, arma::join_cols(ti, tj), tx, nrow, ncol, true, false); - res = Rcpp::as(mat.slot("uplo")) == "U" ? symmatu(res) : symmatl(res); - } - else if (type == "dgRMatrix" || mat.is("dgRMatrix")) { - IntegerVector rj = mat.slot("j"); - IntegerVector rp = mat.slot("p"); - Vector rx = mat.slot("x"); - - int nnz = rx.size(); - IntegerVector i = IntegerVector(nnz); - IntegerVector p = IntegerVector(ncol + 1); - Vector x = Vector(nnz); - - // Count the nnz in each column - for(int n = 0; n < nnz; n++){ - p[rj[n] + 1]++; - } - - // Cumsum p - for(int col = 0, cumsum = 0; col < ncol + 1; col++){ - cumsum += p[col]; - p[col] = cumsum; - } - - // https://github.com/scipy/scipy/blob/master/scipy/sparse/sparsetools/csr.h#L436 - // Calculate i&x - for(int row = 0; row < nrow; row++){ - for(int tmp = rp[row]; tmp < rp[row + 1]; tmp++){ - int col = rj[tmp]; - int dest = p[col]; - - i[dest] = row; - x[dest] = rx[tmp]; - - p[col]++; - } - } - - // Fix the p - for(int col = 0, last = 0; col <= ncol; col++){ - int tmp = p[col]; - p[col] = last; - last = tmp; - } - - DO_RESULT; - } - else if (type == "dtRMatrix" || mat.is("dtRMatrix")) { - IntegerVector rj = mat.slot("j"); - IntegerVector rp = mat.slot("p"); - Vector rx = mat.slot("x"); - std::string diag = Rcpp::as(mat.slot("diag")); - - int nnz = rx.size(); - IntegerVector i = IntegerVector(nnz); - IntegerVector p = IntegerVector(ncol + 1); - Vector x = Vector(nnz); - - // Count the nnz in each column - for(int n = 0; n < nnz; n++){ - p[rj[n] + 1]++; - } - - // Cumsum p - for(int col = 0, cumsum = 0; col < ncol + 1; col++){ - cumsum += p[col]; - p[col] = cumsum; - } - - // https://github.com/scipy/scipy/blob/master/scipy/sparse/sparsetools/csr.h#L436 - // Calculate i&x - for(int row = 0; row < nrow; row++){ - for(int tmp = rp[row]; tmp < rp[row + 1]; tmp++){ - int col = rj[tmp]; - int dest = p[col]; - - i[dest] = row; - x[dest] = rx[tmp]; - - p[col]++; - } - } - - // Fix the p - for(int col = 0, last = 0; col <= ncol; col++){ - int tmp = p[col]; - p[col] = last; - last = tmp; - } - - DO_RESULT; - - if (diag == "U"){ - res.diag().ones(); - } - } - else if (type == "dsRMatrix" || mat.is("dsRMatrix")) { - IntegerVector rj = mat.slot("j"); - IntegerVector rp = mat.slot("p"); - Vector rx = mat.slot("x"); - std::string uplo = Rcpp::as(mat.slot("uplo")); - - int nnz = rx.size(); - IntegerVector i = IntegerVector(nnz); - IntegerVector p = IntegerVector(ncol + 1); - Vector x = Vector(nnz); - - // Count the nnz in each column - for(int n = 0; n < nnz; n++){ - p[rj[n] + 1]++; - } - - // Cumsum p - for(int col = 0, cumsum = 0; col < ncol + 1; col++){ - cumsum += p[col]; - p[col] = cumsum; - } - - // https://github.com/scipy/scipy/blob/master/scipy/sparse/sparsetools/csr.h#L436 - // Calculate i&x - for(int row = 0; row < nrow; row++){ - for(int tmp = rp[row]; tmp < rp[row + 1]; tmp++){ - int col = rj[tmp]; - int dest = p[col]; - - i[dest] = row; - x[dest] = rx[tmp]; - - p[col]++; - } - } - - // Fix the p - for(int col = 0, last = 0; col <= ncol; col++){ - int tmp = p[col]; - p[col] = last; - last = tmp; - } - - DO_RESULT; - - if (uplo == "U") { - res = symmatu(res); - } else { - res = symmatl(res); - } - } - else if (type == "indMatrix" || mat.is("indMatrix")) { - IntegerVector perm = mat.slot("perm"); - IntegerVector p(ncol + 1); - IntegerVector i(perm.size()); - IntegerVector x(perm.size()); - - if (!mat.hasSlot("margin") || - as(mat.slot("margin"))[0] == 1) { - int *work = reinterpret_cast( - R_alloc((std::size_t) ncol, sizeof(int))); - std::memset(work, 0, ncol * sizeof(int)); - for (int ii = 0; ii < nrow; ++ii) - work[perm[ii] - 1]++; - for (int jj = 0; jj < ncol; ++jj) { - p[jj + 1] = p[jj] + work[jj]; - work[jj] = p[jj]; - } - for (int ii = 0; ii < nrow; ++ii) { - i[work[perm[ii] - 1]++] = ii; - x[ii] = 1; - } - } else { - for (int jj = 0; jj < ncol; ++jj) { - p[jj] = jj; - i[jj] = perm[jj] - 1; - x[jj] = 1; - } - p[ncol] = ncol; - } - - DO_RESULT; - } - else if (type == "pMatrix" || mat.is("pMatrix")) { - IntegerVector perm = mat.slot("perm"); - IntegerVector p(ncol + 1); - IntegerVector i(ncol); - IntegerVector x(ncol); - - if (!mat.hasSlot("margin") || - as(mat.slot("margin"))[0] == 1) { - for (int jj = 0; jj < ncol; ++jj) { - p[jj] = jj; - i[perm[jj] - 1] = jj; - x[jj] = 1; - } - } else { - for (int jj = 0; jj < ncol; ++jj) { - p[jj] = jj; - i[jj] = perm[jj] - 1; - x[jj] = 1; - } - } - p[ncol] = ncol; - - DO_RESULT; - } - else if (type == "ddiMatrix" || mat.is("ddiMatrix")) { - std::vector i; - std::vector p; - std::vector x; - std::string diag = Rcpp::as(mat.slot("diag")); - - if (diag == "U") { - for(int idx = 0; idx < ncol; idx++){ - i.push_back(idx); - p.push_back(idx); - x.push_back(1); - } - p.push_back(ncol); - } else { - Vector tmpx = mat.slot("x"); - int tmpp = 0; - for(int idx = 0; idx < ncol; idx++){ - p.push_back(tmpp); - if (tmpx[idx] != 0) { - i.push_back(idx); - x.push_back(tmpx[idx]); - tmpp++; - } - } - p.push_back(tmpp); - } - - DO_RESULT; - -#undef DO_RESULT - - } - else { - Rcpp::stop(type + " is not supported."); - } - - // In order to access the internal arrays of the SpMat class - res.sync(); - - // Setting the sentinel - arma::access::rw(res.col_ptrs[static_cast(ncol + 1)]) = - std::numeric_limits::max(); - - return res; - } - - - private: - S4 mat ; - List li; - bool is_stm; - } ; - - // 30 November 2015 - // default Exporter-Cube specialization: - // handles cube, icube, and cx_cube - // fails on fcube, ucube, and cx_fcube - template - class Exporter< arma::Cube > { - public: - typedef arma::Cube cube_t; - enum { RTYPE = Rcpp::traits::r_sexptype_traits::rtype }; - typedef typename Rcpp::traits::storage_type::type value_t; - Exporter(SEXP x) : vec(x) {} - - cube_t get() { - Rcpp::Vector dims = vec.attr("dim"); - if (dims.size() != 3) { - std::string msg = - "Error converting object to arma::Cube:\n" - "Input array must have exactly 3 dimensions.\n"; - Rcpp::stop(msg); - } - - cube_t result( - reinterpret_cast(vec.begin()), - dims[0], dims[1], dims[2], false); - return result; - } - - private: - Rcpp::Vector vec; - }; - - // specializations for 3 cube typedefs that fail above - // first use viable conversion SEXP -> Cube - // then use conv_to::from(other_t other) - template <> - class Exporter { - public: - typedef arma::fcube cube_t; - - Exporter(SEXP x) - : tmp(Exporter(x).get()) {} - - cube_t get() { - cube_t result = arma::conv_to::from(tmp); - return result; - } - - private: - typedef arma::cube other_t; - other_t tmp; - }; - - template <> - class Exporter { - public: - typedef arma::ucube cube_t; - - Exporter(SEXP x) - : tmp(Exporter(x).get()) {} - - cube_t get() { - cube_t result = arma::conv_to::from(tmp); - return result; - } - - private: - typedef arma::icube other_t; - other_t tmp; - }; - - template <> - class Exporter { - public: - typedef arma::cx_fcube cube_t; - - Exporter(SEXP x) - : tmp(Exporter(x).get()) {} - - cube_t get() { - cube_t result = arma::conv_to::from(tmp); - return result; - } - - private: - typedef arma::cx_cube other_t; - other_t tmp; - }; - -} // end traits - - /* Begin Armadillo vector as support classes */ - - template ::type> - class ArmaMat_InputParameter; - - template - class ArmaMat_InputParameter { - public: - ArmaMat_InputParameter(SEXP x_) : m(x_), mat(reinterpret_cast(m.begin()), m.nrow(), m.ncol(), false) {} - - inline operator REF(){ - return mat ; - } - - private: - Rcpp::Matrix< Rcpp::traits::r_sexptype_traits::rtype > m ; - MAT mat ; - } ; - - template - class ArmaMat_InputParameter { - public: - ArmaMat_InputParameter( SEXP x_ ): m(x_), mat( as(m) ) {} - - inline operator REF(){ - return mat ; - } - - private: - Rcpp::Matrix< Rcpp::traits::r_sexptype_traits::rtype > m ; - MAT mat ; - } ; - - /* End Armadillo vector as support classes */ - - - /* Begin Armadillo vector as support classes */ - - template ::type> - class ArmaVec_InputParameter; - - template - class ArmaVec_InputParameter { - public: - ArmaVec_InputParameter( SEXP x_ ) : v(x_), vec( reinterpret_cast( v.begin() ), v.size(), false ){} - - inline operator REF(){ - return vec ; - } - - private: - Rcpp::Vector< Rcpp::traits::r_sexptype_traits::rtype > v ; - VEC vec ; - } ; - - template - class ArmaVec_InputParameter { - public: - ArmaVec_InputParameter( SEXP x_ ): v(x_), vec( as(v) ) {} - - inline operator REF(){ - return vec ; - } - - private: - Rcpp::Vector< Rcpp::traits::r_sexptype_traits::rtype > v ; - VEC vec ; - } ; - - /* End Armadillo vector as support classes */ - -#define MAKE_INPUT_PARAMETER(INPUT_TYPE,TYPE,REF) \ - template \ - class INPUT_TYPE : public ArmaVec_InputParameter{ \ - public: \ - INPUT_TYPE( SEXP x) : ArmaVec_InputParameter(x){} \ - } ; - - MAKE_INPUT_PARAMETER(ConstReferenceInputParameter, arma::Col, const arma::Col& ) - MAKE_INPUT_PARAMETER(ReferenceInputParameter , arma::Col, arma::Col& ) - MAKE_INPUT_PARAMETER(ConstInputParameter , arma::Col, const arma::Col ) - - MAKE_INPUT_PARAMETER(ConstReferenceInputParameter, arma::Row, const arma::Row& ) - MAKE_INPUT_PARAMETER(ReferenceInputParameter , arma::Row, arma::Row& ) - MAKE_INPUT_PARAMETER(ConstInputParameter , arma::Row, const arma::Row ) - -#undef MAKE_INPUT_PARAMETER - - -#define MAKE_INPUT_PARAMETER(INPUT_TYPE,TYPE,REF) \ - template \ - class INPUT_TYPE : public ArmaMat_InputParameter{ \ - public: \ - INPUT_TYPE( SEXP x) : ArmaMat_InputParameter(x){} \ - } ; - - MAKE_INPUT_PARAMETER(ConstReferenceInputParameter, arma::Mat, const arma::Mat& ) - MAKE_INPUT_PARAMETER(ReferenceInputParameter , arma::Mat, arma::Mat& ) - MAKE_INPUT_PARAMETER(ConstInputParameter , arma::Mat, const arma::Mat ) - -#undef MAKE_INPUT_PARAMETER - -} - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/interface/RcppArmadilloForward.h b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/interface/RcppArmadilloForward.h deleted file mode 100644 index cbd537580..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/interface/RcppArmadilloForward.h +++ /dev/null @@ -1,135 +0,0 @@ -// -// RcppArmadilloForward.h: Rcpp/Armadillo glue -// -// Copyright (C) 2010 - 2023 Dirk Eddelbuettel, Romain Francois and Douglas Bates -// Copyright (C) 2019 - 2023 Conrad Sanderson -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -#ifndef RcppArmadillo__RcppArmadilloForward__h -#define RcppArmadillo__RcppArmadilloForward__h - -#include -#include -#include - -#define ARMA_EXTRA_MAT_PROTO RcppArmadillo/internal/Mat_proto.h -#define ARMA_EXTRA_MAT_MEAT RcppArmadillo/internal/Mat_meat.h -#define ARMA_EXTRA_COL_PROTO RcppArmadillo/internal/Col_proto.h -#define ARMA_EXTRA_COL_MEAT RcppArmadillo/internal/Col_meat.h -#define ARMA_EXTRA_ROW_PROTO RcppArmadillo/internal/Row_proto.h -#define ARMA_EXTRA_ROW_MEAT RcppArmadillo/internal/Row_meat.h - -// Using this define makes the R RNG have precedent over both the -// C++11-based RNG provided by Armadillo, as well as the C++98-based -// fallback. -// -// One can use the C++11-based on by commenting out the following -// #define and also selecting C++11 (eg via src/Makevars* or the -// DESCRIPTION file) and/or defining #define-ing ARMA_USE_CXX11_RNG -#define ARMA_RNG_ALT RcppArmadillo/rng/Alt_R_RNG.h - -// Workaround to mitigate possible interference from a system-level -// installation of Armadillo -#define ARMA_DONT_USE_WRAPPER - -// Armadillo has deprecation warnings (which RcppArmadillo suppressed at time to -// minimise issies at CRAN). Should your package display any, and you decide -// _not_ to fix the root causes (see RcppArmadillo GitHub Issues #391 and #402 -// for details) then defining the following macro will help. You can add a -// #define in your source code before including the RcppArmadillo header, or add -// a -DARMA_IGNORE_DEPRECATED_MARKER to the PKG_CPPFLAGS in src/Makevars. -// Renabling globally for 14.0.0 release -#define ARMA_IGNORE_DEPRECATED_MARKER - -#include "armadillo" - -/* forward declarations */ -namespace Rcpp { - /* support for wrap */ - template SEXP wrap ( const arma::Mat& ) ; - template SEXP wrap ( const arma::Row& ) ; - template SEXP wrap ( const arma::Col& ) ; - template SEXP wrap ( const arma::field& ) ; - template SEXP wrap ( const arma::Cube& ) ; - template SEXP wrap ( const arma::subview& ) ; - template SEXP wrap ( const arma::subview_cols& ) ; - template SEXP wrap ( const arma::SpMat& ) ; - - template - SEXP wrap(const arma::Glue& X ) ; - - template - SEXP wrap(const arma::Op& X ) ; - - template - SEXP wrap(const arma::eGlue& X ) ; - - template - SEXP wrap(const arma::eOp& X ) ; - - template - SEXP wrap(const arma::OpCube& X ) ; - - template - SEXP wrap(const arma::GlueCube& X ) ; - - template - SEXP wrap(const arma::eOpCube& X ) ; - - template - SEXP wrap(const arma::eGlueCube& X ) ; - - template - SEXP wrap( const arma::mtOp& X ) ; - - template - SEXP wrap( const arma::mtGlue& X ); - - template - SEXP wrap( const arma::Gen& X) ; - - template - SEXP wrap( const arma::GenCube& X) ; - - namespace traits { - - /* support for as */ - template class Exporter< arma::Mat > ; - template class Exporter< arma::Row > ; - template class Exporter< arma::Col > ; - template class Exporter< arma::SpMat > ; - - template class Exporter< arma::field > ; - // template class Exporter< arma::Cube > ; - - } // namespace traits - - template class ConstReferenceInputParameter< arma::Mat > ; - template class ReferenceInputParameter< arma::Mat > ; - template class ConstInputParameter< arma::Mat > ; - - template class ConstReferenceInputParameter< arma::Col > ; - template class ReferenceInputParameter< arma::Col > ; - template class ConstInputParameter< arma::Col > ; - - template class ConstReferenceInputParameter< arma::Row > ; - template class ReferenceInputParameter< arma::Row > ; - template class ConstInputParameter< arma::Row > ; - -} - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/interface/RcppArmadilloSugar.h b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/interface/RcppArmadilloSugar.h deleted file mode 100644 index 349be7120..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/interface/RcppArmadilloSugar.h +++ /dev/null @@ -1,61 +0,0 @@ - -// RcppArmadilloSugar.h: Rcpp/Armadillo glue -// -// Copyright (C) 2010 - 2021 Dirk Eddelbuettel, Romain Francois and Douglas Bates -// Copyright (C) 2017 - 2021 Serguei Sokol -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -#ifndef RcppArmadillo__RcppArmadilloSugar__h -#define RcppArmadillo__RcppArmadilloSugar__h - -namespace Rcpp{ - -// forward is not needed anymore, but we just leave this -// for backwards compatibility -template -inline const T& forward(const T& x) { return x; } - -template List simple_triplet_matrix ( const arma::SpMat& sm ){ - const int RTYPE = Rcpp::traits::r_sexptype_traits::rtype; - sm.sync(); // important: update internal state of SpMat object - - // copy the data into R objects - Vector x(sm.values, sm.values + sm.n_nonzero); - IntegerVector i(sm.row_indices, sm.row_indices + sm.n_nonzero); - i=i+1; - IntegerVector p(sm.col_ptrs, sm.col_ptrs + sm.n_cols + 1); - IntegerVector j(i.size()); - for (size_t cp=1, ie=0; ie < sm.n_nonzero; ie++) { - for (; static_cast(p[cp]) <= ie && cp < sm.n_cols; cp++) - ; - j[ie] = cp; - } - - List s; - s("i") = i; - s("j") = j; - s("v") = x; - s("nrow") = sm.n_rows; - s("ncol") = sm.n_cols; - s("dimnames") = R_NilValue; - s.attr("class") = "simple_triplet_matrix"; - return s; -} - -} // Rcpp - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/interface/RcppArmadilloWrap.h b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/interface/RcppArmadilloWrap.h deleted file mode 100644 index 77457e3c1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/interface/RcppArmadilloWrap.h +++ /dev/null @@ -1,301 +0,0 @@ -// -// RcppArmadilloWrap.h: Rcpp/Armadillo glue -// -// Copyright (C) 2010 - 2021 Dirk Eddelbuettel, Romain Francois and Douglas Bates -// Copyright (C) 2017 - 2021 Binxiang Ni and Serguei Sokol -// Copyright (C) 2021 Conrad Sanderson -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -#ifndef RcppArmadillo__RcppArmadilloWrap__h -#define RcppArmadillo__RcppArmadilloWrap__h - -namespace Rcpp{ - - namespace RcppArmadillo{ - - template - SEXP arma_wrap( const T& object, const ::Rcpp::Dimension& dim){ - ::Rcpp::RObject x = ::Rcpp::wrap( object.memptr() , object.memptr() + object.n_elem ) ; - x.attr( "dim" ) = dim ; - return x; - } - - // DE 03-Aug-2013 - // here is an alternate form which would not set dimension which we could do - // for row and column vectors -- but the current form of return row and col - // as matrix types with one col (or row, respectively) is now entrenched - template - SEXP arma_wrap(const T& object) { - return ::Rcpp::wrap(object.memptr() , object.memptr() + object.n_elem); - } - - template - SEXP arma_subview_wrap( const arma::subview& data, int nrows, int ncols ){ - const int RTYPE = Rcpp::traits::r_sexptype_traits::rtype ; - Rcpp::Matrix mat( nrows, ncols ) ; - for( int j=0, k=0; j - SEXP arma_subview_wrap( const arma::subview_cols& data, int nrows, int ncols ){ - const int RTYPE = Rcpp::traits::r_sexptype_traits::rtype ; - Rcpp::Matrix mat( nrows, ncols ) ; - const int nelem = nrows*ncols; - const T* svcmem = data.colptr(0); - for( int i=0; i SEXP wrap ( const arma::Mat& data ){ - return RcppArmadillo::arma_wrap( data, Dimension( data.n_rows, data.n_cols ) ) ; - } - - template SEXP wrap( const arma::Col& data ){ -#if defined(RCPP_ARMADILLO_RETURN_COLVEC_AS_VECTOR) || defined(RCPP_ARMADILLO_RETURN_ANYVEC_AS_VECTOR) - return RcppArmadillo::arma_wrap( data ) ; -#else - return RcppArmadillo::arma_wrap( data, Dimension( data.n_elem, 1) ) ; -#endif - } - - template SEXP wrap( const arma::Row& data ){ -#if defined(RCPP_ARMADILLO_RETURN_ROWVEC_AS_VECTOR) || defined(RCPP_ARMADILLO_RETURN_ANYVEC_AS_VECTOR) - return RcppArmadillo::arma_wrap( data ) ; -#else - return RcppArmadillo::arma_wrap(data, Dimension( 1, data.n_elem ) ) ; -#endif - } - - template SEXP wrap( const arma::Cube& data ){ - return RcppArmadillo::arma_wrap(data, Dimension( data.n_rows, data.n_cols, data.n_slices ) ) ; - } - - template SEXP wrap( const arma::subview& data ){ - return RcppArmadillo::arma_subview_wrap( data, data.n_rows, data.n_cols ) ; - } - - template SEXP wrap( const arma::subview_cols& data ){ - return RcppArmadillo::arma_subview_wrap( data, data.n_rows, data.n_cols ) ; - } - - - template SEXP wrap ( const arma::SpMat& sm ){ - const int RTYPE = Rcpp::traits::r_sexptype_traits::rtype; - - sm.sync(); // important: update internal state of SpMat object - IntegerVector dim = IntegerVector::create(sm.n_rows, sm.n_cols); - - // copy the data into R objects - Vector x(sm.values, sm.values + sm.n_nonzero ) ; - IntegerVector i(sm.row_indices, sm.row_indices + sm.n_nonzero); - IntegerVector p(sm.col_ptrs, sm.col_ptrs + sm.n_cols+1 ) ; - - std::string klass = "dgCMatrix"; - // Since logical sparse matrix is not supported for now, the conditional statement is not currently used. - // switch( RTYPE ){ - // case REALSXP: klass = "dgCMatrix" ; break ; - // // case INTSXP : klass = "igCMatrix" ; break ; class not exported - // case LGLSXP : klass = "lgCMatrix" ; break ; - // default: - // throw std::invalid_argument( "RTYPE not matched in conversion to sparse matrix" ) ; - // } - S4 s(klass); - s.slot("i") = i; - s.slot("p") = p; - s.slot("x") = x; - s.slot("Dim") = dim; - return s; - } - - - namespace RcppArmadillo { - - /* Importer class for field */ - template class FieldImporter { - public: - typedef T r_import_type ; - FieldImporter( const arma::field& data_ ) : data(data_){} - inline int size() const { return data.n_elem ; } - inline T get(int i) const { return data[i] ; } - inline SEXP wrap( int i) const { return ::Rcpp::wrap( data[i] ) ; } - private: - const arma::field& data ; - } ; - - } // namespace RcppArmadillo - - template - SEXP wrap( const arma::field& data){ - RObject x = wrap( RcppArmadillo::FieldImporter( data ) ) ; - #if defined(RCPP_ARMADILLO_FIX_Field) - //#if !defined(RCPP_ARMADILLO_OLD_Field_BEHAVIOR) - x.attr("dim") = Dimension(data.n_rows , data.n_cols , data.n_slices); - #else - x.attr("dim") = Dimension(data.n_rows, data.n_cols); - #endif - return x ; - } - - /* TODO: maybe we could use the advanced constructor to avoid creating the - temporary Mat */ - template - SEXP wrap(const arma::Glue& X ){ - return wrap( arma::Mat(X) ) ; - } - - template - SEXP wrap(const arma::Op& X ){ - return wrap( arma::Mat(X) ) ; - } - - template - SEXP wrap(const arma::OpCube& X ){ - return wrap( arma::Cube(X) ) ; - } - - template - SEXP wrap(const arma::GlueCube& X ){ - return wrap( arma::Cube(X) ) ; - } - - template - SEXP wrap(const arma::GenCube& X){ - return wrap( arma::Cube( X ) ) ; - } - - namespace RcppArmadillo{ - - /* we can intercept and directly build the resulting matrix using - memory allocated by R */ - template - SEXP wrap_eglue( const arma::eGlue& X, ::Rcpp::traits::false_type ){ - int n_rows = X.P1.get_n_rows() ; - int n_cols = X.P1.get_n_cols() ; - typedef typename ::Rcpp::Vector< ::Rcpp::traits::r_sexptype_traits< typename T1::elem_type>::rtype > VECTOR ; - VECTOR res(::Rcpp::Dimension( n_rows , n_cols )) ; - ::arma::Mat result( res.begin(), n_rows, n_cols, false ) ; - result = X ; - return res ; - } - - template - SEXP wrap_eglue( const arma::eGlue& X, ::Rcpp::traits::true_type ){ - return ::Rcpp::wrap( arma::Mat(X) ) ; - } - - template - SEXP wrap_eop( const arma::eOp& X, ::Rcpp::traits::false_type ){ - int n_rows = X.get_n_rows(); - int n_cols = X.get_n_cols(); - typedef typename ::Rcpp::Vector< ::Rcpp::traits::r_sexptype_traits< typename T1::elem_type>::rtype > VECTOR ; - VECTOR res(::Rcpp::Dimension( n_rows , n_cols )) ; - ::arma::Mat result( res.begin(), n_rows, n_cols, false ) ; - result = X ; - return res ; - } - - template - SEXP wrap_eop( const arma::eOp& X, ::Rcpp::traits::true_type ){ - return ::Rcpp::wrap( arma::Mat(X) ) ; - } - - // template - // SEXP wrap_mtop( const arma::mtOp& X, ::Rcpp::traits::false_type ){ - // // int n_rows = X.P.n_rows ; - // // int n_cols = X.P.n_cols ; - // // typedef typename ::Rcpp::Vector< ::Rcpp::traits::r_sexptype_traits< typename T1::elem_type>::rtype > VECTOR ; - // // VECTOR res(::Rcpp::Dimension( n_rows , n_cols )) ; - // // ::arma::Mat result( res.begin(), n_rows, n_cols, false ) ; - // // result = X ; - // // return res ; - // return ::Rcpp::wrap( arma::Mat(X) ) ; - // } - // - // template - // SEXP wrap_mtop( const arma::mtOp& X, ::Rcpp::traits::true_type ){ - // return ::Rcpp::wrap( arma::Mat(X) ) ; - // } - // - // template - // SEXP wrap_mtglue( const arma::mtGlue& X, ::Rcpp::traits::false_type ){ - // // int n_rows = X.P1.n_rows ; - // // int n_cols = X.P1.n_cols ; - // // typedef typename ::Rcpp::Vector< ::Rcpp::traits::r_sexptype_traits< typename T1::elem_type>::rtype > VECTOR ; - // // VECTOR res(::Rcpp::Dimension( n_rows , n_cols )) ; - // // ::arma::Mat result( res.begin(), n_rows, n_cols, false ) ; - // // result = X ; - // // return res ; - // return ::Rcpp::wrap( arma::Mat(X) ) ; - // } - // - // template - // SEXP wrap_mtglue( const arma::mtGlue& X , ::Rcpp::traits::true_type ){ - // return ::Rcpp::wrap( arma::Mat(X) ) ; - // } - - - - } // namespace RcppArmadillo - - template - SEXP wrap(const arma::eGlue& X ){ - return RcppArmadillo::wrap_eglue( X, typename traits::r_sexptype_needscast::type() ) ; - } - - template - SEXP wrap(const arma::eOp& X ){ - return RcppArmadillo::wrap_eop( X, typename traits::r_sexptype_needscast::type() ) ; - } - - template - SEXP wrap(const arma::eOpCube& X ){ - return wrap( arma::Cube(X) ) ; - } - - template - SEXP wrap(const arma::eGlueCube& X ){ - return wrap( arma::Cube(X) ) ; - } - - template - SEXP wrap( const arma::mtOp& X ){ - // return RcppArmadillo::wrap_mtop( X, typename traits::r_sexptype_needscast::type() ) ; - return wrap( arma::Mat( X ) ) ; - } - - template - SEXP wrap( const arma::mtGlue& X ){ - // return RcppArmadillo::wrap_mtglue( X, typename traits::r_sexptype_needscast::type() ) ; - return wrap( arma::Mat( X ) ) ; - } - - template - SEXP wrap( const arma::Gen& X){ - return wrap( eT(X) ) ; - } - -} - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/internal/Col_meat.h b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/internal/Col_meat.h deleted file mode 100644 index 7924a952f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/internal/Col_meat.h +++ /dev/null @@ -1,47 +0,0 @@ -// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- -/* :tabSize=4:indentSize=4:noTabs=false:folding=explicit:collapseFolds=1: */ -// -// Col_meat.h: Rcpp/Armadillo glue -// -// Copyright (C) 2011 - 2013 Dirk Eddelbuettel, Romain Francois and Douglas Bates -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -#ifndef RCPPARMADILLO_COL_MEAT_H -#define RCPPARMADILLO_COL_MEAT_H - -template -template -inline Col::Col( const Rcpp::VectorBase& X ) - : Mat( X ) -{ - arma_extra_debug_sigprint(this); - access::rw(Mat::vec_state) = 1; -} - -template -template -inline Col::Col( const Rcpp::MatrixBase& X ) - : Mat( X ) -{ - arma_extra_debug_sigprint(this); - - arma_debug_check( (Mat::n_cols > 1), "Col(): incompatible dimensions" ); - - access::rw(Mat::vec_state) = 1; -} - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/internal/Col_proto.h b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/internal/Col_proto.h deleted file mode 100644 index dff4bfa11..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/internal/Col_proto.h +++ /dev/null @@ -1,33 +0,0 @@ -// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- -/* :tabSize=4:indentSize=4:noTabs=false:folding=explicit:collapseFolds=1: */ -// -// Col_proto.h: Rcpp/Armadillo glue -// -// Copyright (C) 2010 - 2013 Dirk Eddelbuettel, Romain Francois and Douglas Bates -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - - -#ifndef RCPPARMADILLO_COL_PROTO_H -#define RCPPARMADILLO_COL_PROTO_H - -template -inline Col( const Rcpp::VectorBase& X ) ; - -template -inline Col( const Rcpp::MatrixBase& X ) ; - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/internal/Mat_meat.h b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/internal/Mat_meat.h deleted file mode 100644 index ee69e897f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/internal/Mat_meat.h +++ /dev/null @@ -1,141 +0,0 @@ -// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- -/* :tabSize=4:indentSize=4:noTabs=false:folding=explicit:collapseFolds=1: */ -// -// Mat_meat.h: Rcpp/Armadillo glue -// -// Copyright (C) 2010 - 2013 Dirk Eddelbuettel, Romain Francois and Douglas Bates -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -#ifndef RCPPARMADILLO_MAT_MEAT_H -#define RCPPARMADILLO_MAT_MEAT_H - -namespace RcppArmadillo{ - - template - inline void check(){ -#if !defined(ARMA_USE_CXX11) - arma_type_check_cxx1998< is_same_type< eT, rcpp_type >::value == false >::apply(); -#else - static_assert( is_same_type< eT, rcpp_type >::value , "error: incorrect or unsupported type" ); -#endif - } - - template <> - inline void check< std::complex, Rcomplex >(){} - - - template - inline void fill_ptr__impl( eT* ptr, const Rcpp::VectorBase& X, u32 n_elem, ::Rcpp::traits::true_type ){ - for( u32 i=0; i::type, eT>( X[i] ) ; - } - } - - template - inline void fill_ptr__impl( eT* ptr, const Rcpp::VectorBase& X, u32 n_elem, ::Rcpp::traits::false_type ){ - for( u32 i=0; i - inline void fill_ptr( eT* ptr, const Rcpp::VectorBase& X, u32 n_elem ){ - return fill_ptr__impl( ptr, X, n_elem, - typename ::Rcpp::traits::r_sexptype_needscast() - ) ; - } - - - - - - template - inline void fill_ptr_matrix__impl( eT* ptr, const Rcpp::MatrixBase& X, u32 nr, u32 nc, ::Rcpp::traits::true_type ){ - u32 k, i_col, i_row ; - for( i_col=0, k=0 ; i_col < nc; ++i_col){ - for( i_row = 0; i_row < nr ; ++i_row, ++k ){ - ptr[k] = Rcpp::internal::caster< typename Rcpp::traits::storage_type::type, eT>( X(i_row,i_col)) ; - } - } - } - - template - inline void fill_ptr_matrix__impl( eT* ptr, const Rcpp::MatrixBase& X, u32 nr, u32 nc, ::Rcpp::traits::false_type ){ - u32 k, i_col, i_row ; - for( i_col=0, k=0 ; i_col < nc; ++i_col){ - for( i_row = 0; i_row < nr ; ++i_row, ++k ){ - ptr[k] = X(i_row,i_col) ; - } - } - } - - - - template - inline void fill_ptr_matrix( eT* ptr, const Rcpp::MatrixBase& X, u32 nr, u32 nc){ - return fill_ptr_matrix__impl( ptr, X, nr, nc, - typename ::Rcpp::traits::r_sexptype_needscast() - ) ; - } - -} - -template -template -inline Mat::Mat( const Rcpp::VectorBase& X ) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem(0) -{ - - arma_extra_debug_sigprint_this(this); - - RcppArmadillo::check::type >() ; - - set_size(X.size(), 1); - RcppArmadillo::fill_ptr( memptr(), X, n_elem ) ; -} - -template -template -inline Mat::Mat( const Rcpp::MatrixBase& X ) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem(0) -{ - - arma_extra_debug_sigprint_this(this); - - RcppArmadillo::check::type >() ; - - u32 nr = X.nrow(), nc = X.ncol() ; - set_size( nr, nc ) ; - - RcppArmadillo::fill_ptr_matrix( memptr(), X, nr, nc ); - -} - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/internal/Mat_proto.h b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/internal/Mat_proto.h deleted file mode 100644 index 3e1c91ba2..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/internal/Mat_proto.h +++ /dev/null @@ -1,33 +0,0 @@ -// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- -/* :tabSize=4:indentSize=4:noTabs=false:folding=explicit:collapseFolds=1: */ -// -// Mat_proto.h: Rcpp/Armadillo glue -// -// Copyright (C) 2010 - 2013 Dirk Eddelbuettel, Romain Francois and Douglas Bates -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - - -#ifndef RCPPARMADILLO_MAT_PROTO_H -#define RCPPARMADILLO_MAT_PROTO_H - -template -inline Mat( const Rcpp::VectorBase& X ) ; - -template -inline Mat( const Rcpp::MatrixBase& X ) ; - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/internal/Row_meat.h b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/internal/Row_meat.h deleted file mode 100644 index 3d97e3c22..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/internal/Row_meat.h +++ /dev/null @@ -1,47 +0,0 @@ -// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- -/* :tabSize=4:indentSize=4:noTabs=false:folding=explicit:collapseFolds=1: */ -// -// Row_meat.h: Rcpp/Armadillo glue -// -// Copyright (C) 2011 - 2013 Dirk Eddelbuettel, Romain Francois and Douglas Bates -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -#ifndef RCPPARMADILLO_ROW_MEAT_H -#define RCPPARMADILLO_ROW_MEAT_H - -template -template -inline Row::Row( const Rcpp::VectorBase& X ) - : Mat( X ) { - arma_extra_debug_sigprint(this); - std::swap( access::rw(Mat::n_rows), access::rw(Mat::n_cols) ); - access::rw(Mat::vec_state) = 2; -} - -template -template -inline Row::Row( const Rcpp::MatrixBase& X ) - : Mat( X ) { - - arma_extra_debug_sigprint(this); - - arma_debug_check( (Mat::n_rows > 1), "Row(): incompatible dimensions" ); - - access::rw(Mat::vec_state) = 2; -} - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/internal/Row_proto.h b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/internal/Row_proto.h deleted file mode 100644 index a9a38e636..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/internal/Row_proto.h +++ /dev/null @@ -1,33 +0,0 @@ -// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- -/* :tabSize=4:indentSize=4:noTabs=false:folding=explicit:collapseFolds=1: */ -// -// Row_proto.h: Rcpp/Armadillo glue -// -// Copyright (C) 2010 - 2013 Dirk Eddelbuettel, Romain Francois and Douglas Bates -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - - -#ifndef RCPPARMADILLO_ROW_PROTO_H -#define RCPPARMADILLO_ROW_PROTO_H - -template -inline Row( const Rcpp::VectorBase& X ) ; - -template -inline Row( const Rcpp::MatrixBase& X ) ; - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/rng/Alt_R_RNG.h b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/rng/Alt_R_RNG.h deleted file mode 100644 index 064db7e57..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadillo/rng/Alt_R_RNG.h +++ /dev/null @@ -1,151 +0,0 @@ -// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- -// -// Copyright (C) 2013-2014 Conrad Sanderson -// Copyright (C) 2013-2014 NICTA (www.nicta.com.au) -// -// This Source Code Form is subject to the terms of the Mozilla Public -// License, v. 2.0. If a copy of the MPL was not distributed with this -// file, You can obtain one at http://mozilla.org/MPL/2.0/. -// -// This file is based on Conrad's default generators and as such licensed under both -// the MPL 2.0 for his as well as the GNU GPL 2.0 or later for my modification to it. - -// Copyright (C) 2014 Dirk Eddelbuettel -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - - -// NB This files use R's uniform generator and can be compiled only when the R -// headers are available as is the case for RcppArmadillo. -// -// Also note that you MUST set / reset the R RNG state. When using RcppArmadillo -// via Rcpp Atttributes or the inline package, the RNGScope object is added which -// ensure this automatically. Should you build by hand, and omit both RNGScope as -// as manual calls to GetRNGState() and PutRNGState() you may get unstable results. -// -// See http://cran.r-project.org/doc/manuals/r-devel/R-exts.html#Random-numbers - -class arma_rng_alt { -public: - - typedef unsigned int seed_type; - - inline static void set_seed(const seed_type val); - - arma_inline static int randi_val(); - arma_inline static double randu_val(); - inline static double randn_val(); - - template - inline static void randn_dual_val(eT& out1, eT& out2); - - template - inline static void randi_fill(eT* mem, const uword N, const int a, const int b); - - inline static int randi_max_val(); -}; - -inline void arma_rng_alt::set_seed(const arma_rng_alt::seed_type val) { - // null-op, cannot set seed in R from C level code - // see http://cran.r-project.org/doc/manuals/r-devel/R-exts.html#Random-numbers - // - // std::srand(val); - (void) val; // to suppress a -Wunused warning - // - static int havewarned = 0; - if (havewarned++ == 0) { - ::Rf_warning("When called from R, the RNG seed has to be set at the R level via set.seed()"); - } -} - -arma_inline int arma_rng_alt::randi_val() { - return ::Rf_runif(0, RAND_MAX); //std::rand(); -} - -arma_inline double arma_rng_alt::randu_val() { - return double(::Rf_runif(0, 1)); - //return double( double(std::rand()) * ( double(1) / double(RAND_MAX) ) ); -} - -inline double arma_rng_alt::randn_val() { - // polar form of the Box-Muller transformation: - // http://en.wikipedia.org/wiki/Box-Muller_transformation - // http://en.wikipedia.org/wiki/Marsaglia_polar_method - - double tmp1; - double tmp2; - double w; - - do { - tmp1 = double(2) * double(::Rf_runif(0, 1)) - double(1); - tmp2 = double(2) * double(::Rf_runif(0, 1)) - double(1); - //tmp1 = double(2) * double(std::rand()) * (double(1) / double(RAND_MAX)) - double(1); - //tmp2 = double(2) * double(std::rand()) * (double(1) / double(RAND_MAX)) - double(1); - - w = tmp1*tmp1 + tmp2*tmp2; - } while ( w >= double(1) ); - - return double( tmp1 * std::sqrt( (double(-2) * std::log(w)) / w) ); -} - -template -inline void arma_rng_alt::randn_dual_val(eT& out1, eT& out2) { - // make sure we are internally using at least floats - typedef typename promote_type::result eTp; - - eTp tmp1; - eTp tmp2; - eTp w; - - do { - tmp1 = eTp(2) * eTp(::Rf_runif(0, RAND_MAX)) * (eTp(1) / eTp(RAND_MAX)) - eTp(1); - tmp2 = eTp(2) * eTp(::Rf_runif(0, RAND_MAX)) * (eTp(1) / eTp(RAND_MAX)) - eTp(1); - //tmp1 = eTp(2) * eTp(std::rand()) * (eTp(1) / eTp(RAND_MAX)) - eTp(1); - //tmp2 = eTp(2) * eTp(std::rand()) * (eTp(1) / eTp(RAND_MAX)) - eTp(1); - - w = tmp1*tmp1 + tmp2*tmp2; - } while ( w >= eTp(1) ); - - const eTp k = std::sqrt( (eTp(-2) * std::log(w)) / w); - - out1 = eT(tmp1*k); - out2 = eT(tmp2*k); -} - - - -template -inline void arma_rng_alt::randi_fill(eT* mem, const uword N, const int a, const int b) { - if( (a == 0) && (b == RAND_MAX) ) { - for(uword i=0; i. -#ifndef RCPPARMADILLO__EXTENSIONS__FIXPROB_H -#define RCPPARMADILLO__EXTENSIONS__FIXPROB_H - -#include -namespace Rcpp{ - namespace RcppArmadillo{ - - void FixProb(arma::vec &prob, const int size, const bool replace) { - // prob is modified in-place. - double sum = 0.0; - int ii, nPos = 0; - int nn = prob.size(); - for (ii = 0; ii < nn; ii++) { - // pop stack - double prob_value = prob(ii); - - if (!arma::is_finite(prob_value)) //does this work?? - throw std::range_error( "NAs not allowed in probability" ) ; - if (prob_value < 0.0) - throw std::range_error( "Negative probabilities not allowed" ) ; - if (prob_value > 0.0) { - nPos++; - sum += prob_value; - } - } - if (nPos == 0 || (!replace && size > nPos)) { - throw std::range_error("Not enough positive probabilities"); - } - prob = prob / sum; //sugar - } - } -} -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadilloExtensions/rmultinom.h b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadilloExtensions/rmultinom.h deleted file mode 100644 index a65ffc597..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadilloExtensions/rmultinom.h +++ /dev/null @@ -1,72 +0,0 @@ -// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- -/* :tabSize=4:indentSize=4:noTabs=false:folding=explicit:collapseFolds=1: */ -// -// rmultinom.h: Rcpp/Armadillo equivalent to R's stats::rmultinom(). -// This is intended for use in C++ functions, and should *not* be called from R. -// It should yield identical results to R. -// -// Copyright (C) 2014 Christian Gunning -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -#ifndef RCPPARMADILLO__EXTENSIONS__MULTINOM_H -#define RCPPARMADILLO__EXTENSIONS__MULTINOM_H - -#include -namespace Rcpp{ - namespace RcppArmadillo{ - - IntegerVector rmultinom(int size, NumericVector prob) { - // meaning of n, size, prob as in ?rmultinom - // opposite of sample() - n=number of draws - double pp; - int ii; - int probsize = prob.size(); - // Return object - IntegerVector draws(probsize); - if (size < 0 || size == NA_INTEGER) throw std::range_error( "Invalid size"); - long double p_tot = 0.; - p_tot = std::accumulate(prob.begin(), prob.end(), p_tot); - if (fabs((double)(p_tot - 1.)) > 1e-7) { - throw std::range_error("Probabilities don't sum to 1, please use FixProb"); - } - - // do as rbinom - if (size == 0 ) { - return draws; - } - //rmultinom(size, REAL(prob), k, &INTEGER(ans)[ik]); - // for each slot - for (ii = 0; ii < probsize-1; ii++) { /* (p_tot, n) are for "remaining binomial" */ - if (prob[ii]) { - pp = prob[ii] / p_tot; - // >= 1; > 1 happens because of rounding - draws[ii] = ((pp < 1.) ? (int) Rf_rbinom((double) size, pp) : size); - size -= draws[ii]; - } // else { ret[ii] = 0; } - // all done - if (size <= 0) return draws; - // i.e. p_tot = sum(prob[(k+1):K]) - p_tot -= prob[ii]; - } - // the rest go here - draws[probsize-1] = size; - return draws; - } - } -} - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadilloExtensions/sample.h b/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadilloExtensions/sample.h deleted file mode 100644 index 38d1f85d9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/RcppArmadilloExtensions/sample.h +++ /dev/null @@ -1,235 +0,0 @@ -// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- -/* :tabSize=4:indentSize=4:noTabs=false:folding=explicit:collapseFolds=1: */ -// -// sample.h: Rcpp/Armadillo equivalent to R's sample(). -// This is intended for use in C++ functions, and should *not* be called from R. -// It should yield identical results to R in most cases, -// and stop with errors when results are expected to differ. -// -// Copyright (C) 2012 - 2014 Christian Gunning -// Copyright (C) 2013 Romain Francois -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -#ifndef RCPPARMADILLO__EXTENSIONS__SAMPLE_H -#define RCPPARMADILLO__EXTENSIONS__SAMPLE_H - -#include - -namespace Rcpp{ - namespace RcppArmadillo{ - - template T sample_main(const T &x, const int size, const bool replace, const arma::vec &prob_); - void SampleNoReplace(arma::uvec &index, int nOrig, int size); - void SampleReplace(arma::uvec &index, int nOrig, int size); - void ProbSampleNoReplace(arma::uvec &index, int nOrig, int size, arma::vec &prob); - void ProbSampleReplace(arma::uvec &index, int nOrig, int size, arma::vec &prob); - void WalkerProbSampleReplace(arma::uvec &index, int nOrig, int size, arma::vec &prob); - - - // Setup default function calls for pre-exisiting dependencies that use NumericVector - - // No probabilities passed in - template - T sample(const T &x, const int size, const bool replace){ - // Creates a zero-size vector in arma (cannot directly call arma::vec(0)) - const arma::vec prob = arma::zeros(0); - return sample_main(x, size, replace, prob); - } - - // Convert from NumericVector to arma vector - template - T sample(const T &x, const int size, const bool replace, NumericVector prob_){ - const arma::vec prob(prob_.begin(), prob_.size(), false); - return sample_main(x, size, replace, prob); - } - - // Enables supplying an arma probability - template - T sample(const T &x, const int size, const bool replace, const arma::vec &prob_){ - return sample_main(x, size, replace, prob_); - } - - // ------ Main sampling logic - - // Supply any class - template - T sample_main(const T &x, const int size, const bool replace, const arma::vec &prob) { - // Templated sample -- should work on any Rcpp Vector - int ii, jj; - int nOrig = x.size(); - int probsize = prob.n_elem; - - // Create return object - T ret(size); - if ( size > nOrig && !replace) throw std::range_error( "Tried to sample more elements than in x without replacement" ) ; - if ( !replace && (probsize==0) && nOrig > 1e+07 && size <= nOrig/2) { - throw std::range_error( "R uses .Internal(sample2(n, size) for this case, which is not implemented." ) ; - } - - // Store the sample ids here, modify in-place - arma::uvec index(size); - if (probsize == 0) { // No probabilities given - if (replace) { - SampleReplace(index, nOrig, size); - } else { - SampleNoReplace(index, nOrig, size); - } - } else { - if (probsize != nOrig) throw std::range_error( "Number of probabilities must equal input vector length" ) ; - - // copy prob - // fprob will be modified in-place - // (and possibly clobbered by workers) - arma::vec fprob = prob; - FixProb(fprob, size, replace); - - // Reuse the values - if (replace) { - // check for walker alias conditions - int walker_test = sum( (fprob * nOrig) > 0.1); - if (walker_test > 200) { - WalkerProbSampleReplace(index, nOrig, size, fprob); - } else { - ProbSampleReplace(index, nOrig, size, fprob); - } - } else { - ProbSampleNoReplace(index, nOrig, size, fprob); - } - } - // copy the results into the return vector - for (ii=0; ii0.1 - void WalkerProbSampleReplace(arma::uvec &index, int nOrig, int size, arma::vec &prob){ - double rU; - int ii, jj, kk; // indices, ii for loops - // index tables, fill with zeros - arma::vec HL_dat(nOrig); - arma::vec alias_tab(nOrig); - arma::vec::iterator H, L, H0, L0; - //HL0 = HL_dat.begin(); - H0 = H = HL_dat.begin(); - L0 = L = HL_dat.end(); - //prob *= nOrig; // scale probability table - // fill HL_dat from beginning (small prob) and end (large prob) with indices - for (ii = 0; ii < nOrig; ii++) { - prob[ii] *= nOrig; - if( prob[ii] < 1.0) { - *(H++) = ii; - } else { - *(--L) = ii; - } - } - - // some of both large and small - if ( (H > H0) && (L < L0) ) { - for (kk = 0; kk < nOrig; kk++) { - ii = HL_dat[kk]; - jj = *L; - alias_tab[ii] = jj; - prob[jj] += (prob[ii] - 1); - if (prob[jj] < 1.) L++; - if(L == L0) break; // now all prob >= 1 - } - } - for (ii = 0; ii < nOrig; ii++) prob[ii] += ii; - /* generate sample */ - for (ii = 0; ii < size; ii++) { - rU = unif_rand() * nOrig; - kk = (int) rU; - index[ii] = (rU < prob[kk]) ? kk : alias_tab[kk]; - } - } - - // Unequal probability sampling without replacement - void ProbSampleNoReplace(arma::uvec &index, int nOrig, int size, arma::vec &prob){ - int ii, jj, kk; - int nOrig_1 = nOrig - 1; - double rT, mass, totalmass = 1.0; - arma::uvec perm = arma::sort_index(prob, "descend"); //descending sort of index - prob = arma::sort(prob, "descend"); // descending sort of prob - // compute the sample - for (ii = 0; ii < size; ii++, nOrig_1--) { - rT = totalmass * unif_rand(); - mass = 0; - for (jj = 0; jj < nOrig_1; jj++) { - mass += prob[jj]; - if (rT <= mass) - break; - } - index[ii] = perm[jj]; - totalmass -= prob[jj]; - for ( kk = jj; kk < nOrig_1; kk++) { - prob[kk] = prob[kk+1]; - perm[kk] = perm[kk+1]; - } - } - } - } -} - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo deleted file mode 100644 index da24cdf23..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo +++ /dev/null @@ -1,868 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -#ifndef ARMA_INCLUDES -#define ARMA_INCLUDES - -// WARNING: the documentation (docs.html) describes the public API (functions, classes, constants); -// WARNING: any functionality which is _not explicitly_ described in the documentation -// WARNING: is considered as internal implementation detail, and may be changed or removed without notice. - -#include "armadillo_bits/config.hpp" -#include "armadillo_bits/compiler_check.hpp" - -#include -#include -#include -#include -#include -#include -#include -#include - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#if defined(ARMA_USE_STD_MUTEX) - #include -#endif - -// #if defined(ARMA_HAVE_CXX17) -// #include -// #include -// #endif - -#if ( defined(__unix__) || defined(__unix) || defined(_POSIX_C_SOURCE) || (defined(__APPLE__) && defined(__MACH__)) ) && !defined(_WIN32) - #include -#endif - -#if defined(ARMA_USE_TBB_ALLOC) - #if defined(__has_include) - #if __has_include() - #include - #else - #undef ARMA_USE_TBB_ALLOC - #pragma message ("WARNING: use of TBB alloc disabled; tbb/scalable_allocator.h header not found") - #endif - #else - #include - #endif -#endif - -#if defined(ARMA_USE_MKL_ALLOC) - #if defined(__has_include) - #if __has_include() - #include - #else - #undef ARMA_USE_MKL_ALLOC - #pragma message ("WARNING: use of MKL alloc disabled; mkl_service.h header not found") - #endif - #else - #include - #endif -#endif - - -#include "armadillo_bits/compiler_setup.hpp" - - -#if defined(ARMA_USE_OPENMP) - #if defined(__has_include) - #if __has_include() - #include - #else - #undef ARMA_USE_OPENMP - #pragma message ("WARNING: use of OpenMP disabled; omp.h header not found") - #endif - #else - #include - #endif -#endif - - -#include "armadillo_bits/include_hdf5.hpp" -#include "armadillo_bits/include_superlu.hpp" - - -//! \namespace arma namespace for Armadillo classes and functions -namespace arma - { - - // preliminaries - - #include "armadillo_bits/arma_forward.hpp" - #include "armadillo_bits/arma_static_check.hpp" - #include "armadillo_bits/typedef_elem.hpp" - #include "armadillo_bits/typedef_elem_check.hpp" - #include "armadillo_bits/typedef_mat.hpp" - #include "armadillo_bits/arma_str.hpp" - #include "armadillo_bits/arma_version.hpp" - #include "armadillo_bits/arma_config.hpp" - #include "armadillo_bits/traits.hpp" - #include "armadillo_bits/promote_type.hpp" - #include "armadillo_bits/upgrade_val.hpp" - #include "armadillo_bits/restrictors.hpp" - #include "armadillo_bits/access.hpp" - #include "armadillo_bits/span.hpp" - #include "armadillo_bits/distr_param.hpp" - #include "armadillo_bits/constants.hpp" - #include "armadillo_bits/constants_old.hpp" - #include "armadillo_bits/mp_misc.hpp" - #include "armadillo_bits/arma_rel_comparators.hpp" - #include "armadillo_bits/fill.hpp" - - #if defined(ARMA_RNG_ALT) - #include ARMA_INCFILE_WRAP(ARMA_RNG_ALT) - #else - #include "armadillo_bits/arma_rng_cxx03.hpp" - #endif - - #include "armadillo_bits/arma_rng.hpp" - - - // - // class prototypes - - #include "armadillo_bits/Base_bones.hpp" - #include "armadillo_bits/BaseCube_bones.hpp" - #include "armadillo_bits/SpBase_bones.hpp" - - #include "armadillo_bits/def_blas.hpp" - #include "armadillo_bits/def_atlas.hpp" - #include "armadillo_bits/def_lapack.hpp" - #include "armadillo_bits/def_arpack.hpp" - #include "armadillo_bits/def_superlu.hpp" - #include "armadillo_bits/def_fftw3.hpp" - - #include "armadillo_bits/translate_blas.hpp" - #include "armadillo_bits/translate_atlas.hpp" - #include "armadillo_bits/translate_lapack.hpp" - #include "armadillo_bits/translate_arpack.hpp" - #include "armadillo_bits/translate_superlu.hpp" - #include "armadillo_bits/translate_fftw3.hpp" - - #include "armadillo_bits/cond_rel_bones.hpp" - #include "armadillo_bits/arrayops_bones.hpp" - #include "armadillo_bits/podarray_bones.hpp" - #include "armadillo_bits/auxlib_bones.hpp" - #include "armadillo_bits/sp_auxlib_bones.hpp" - - #include "armadillo_bits/injector_bones.hpp" - - #include "armadillo_bits/Mat_bones.hpp" - #include "armadillo_bits/Col_bones.hpp" - #include "armadillo_bits/Row_bones.hpp" - #include "armadillo_bits/Cube_bones.hpp" - #include "armadillo_bits/xvec_htrans_bones.hpp" - #include "armadillo_bits/xtrans_mat_bones.hpp" - #include "armadillo_bits/SizeMat_bones.hpp" - #include "armadillo_bits/SizeCube_bones.hpp" - - #include "armadillo_bits/SpValProxy_bones.hpp" - #include "armadillo_bits/SpMat_bones.hpp" - #include "armadillo_bits/SpCol_bones.hpp" - #include "armadillo_bits/SpRow_bones.hpp" - #include "armadillo_bits/SpSubview_bones.hpp" - #include "armadillo_bits/SpSubview_col_list_bones.hpp" - #include "armadillo_bits/spdiagview_bones.hpp" - #include "armadillo_bits/MapMat_bones.hpp" - - #include "armadillo_bits/typedef_mat_fixed.hpp" - - #include "armadillo_bits/field_bones.hpp" - #include "armadillo_bits/subview_bones.hpp" - #include "armadillo_bits/subview_elem1_bones.hpp" - #include "armadillo_bits/subview_elem2_bones.hpp" - #include "armadillo_bits/subview_field_bones.hpp" - #include "armadillo_bits/subview_cube_bones.hpp" - #include "armadillo_bits/diagview_bones.hpp" - #include "armadillo_bits/subview_each_bones.hpp" - #include "armadillo_bits/subview_cube_each_bones.hpp" - #include "armadillo_bits/subview_cube_slices_bones.hpp" - - #include "armadillo_bits/hdf5_name.hpp" - #include "armadillo_bits/csv_name.hpp" - #include "armadillo_bits/diskio_bones.hpp" - #include "armadillo_bits/wall_clock_bones.hpp" - #include "armadillo_bits/running_stat_bones.hpp" - #include "armadillo_bits/running_stat_vec_bones.hpp" - - #include "armadillo_bits/Op_bones.hpp" - #include "armadillo_bits/CubeToMatOp_bones.hpp" - #include "armadillo_bits/OpCube_bones.hpp" - #include "armadillo_bits/SpOp_bones.hpp" - #include "armadillo_bits/SpToDOp_bones.hpp" - #include "armadillo_bits/mtSpReduceOp_bones.hpp" - - #include "armadillo_bits/eOp_bones.hpp" - #include "armadillo_bits/eOpCube_bones.hpp" - - #include "armadillo_bits/mtOp_bones.hpp" - #include "armadillo_bits/mtOpCube_bones.hpp" - #include "armadillo_bits/mtSpOp_bones.hpp" - - #include "armadillo_bits/Glue_bones.hpp" - #include "armadillo_bits/eGlue_bones.hpp" - #include "armadillo_bits/mtGlue_bones.hpp" - #include "armadillo_bits/SpGlue_bones.hpp" - #include "armadillo_bits/mtSpGlue_bones.hpp" - #include "armadillo_bits/SpToDGlue_bones.hpp" - - #include "armadillo_bits/GlueCube_bones.hpp" - #include "armadillo_bits/eGlueCube_bones.hpp" - #include "armadillo_bits/mtGlueCube_bones.hpp" - - #include "armadillo_bits/eop_core_bones.hpp" - #include "armadillo_bits/eglue_core_bones.hpp" - - #include "armadillo_bits/Gen_bones.hpp" - #include "armadillo_bits/GenCube_bones.hpp" - - #include "armadillo_bits/op_diagmat_bones.hpp" - #include "armadillo_bits/op_diagvec_bones.hpp" - #include "armadillo_bits/op_dot_bones.hpp" - #include "armadillo_bits/op_det_bones.hpp" - #include "armadillo_bits/op_log_det_bones.hpp" - #include "armadillo_bits/op_inv_gen_bones.hpp" - #include "armadillo_bits/op_inv_spd_bones.hpp" - #include "armadillo_bits/op_htrans_bones.hpp" - #include "armadillo_bits/op_max_bones.hpp" - #include "armadillo_bits/op_min_bones.hpp" - #include "armadillo_bits/op_index_max_bones.hpp" - #include "armadillo_bits/op_index_min_bones.hpp" - #include "armadillo_bits/op_mean_bones.hpp" - #include "armadillo_bits/op_median_bones.hpp" - #include "armadillo_bits/op_sort_bones.hpp" - #include "armadillo_bits/op_sort_index_bones.hpp" - #include "armadillo_bits/op_sum_bones.hpp" - #include "armadillo_bits/op_stddev_bones.hpp" - #include "armadillo_bits/op_strans_bones.hpp" - #include "armadillo_bits/op_var_bones.hpp" - #include "armadillo_bits/op_repmat_bones.hpp" - #include "armadillo_bits/op_repelem_bones.hpp" - #include "armadillo_bits/op_reshape_bones.hpp" - #include "armadillo_bits/op_vectorise_bones.hpp" - #include "armadillo_bits/op_resize_bones.hpp" - #include "armadillo_bits/op_cov_bones.hpp" - #include "armadillo_bits/op_cor_bones.hpp" - #include "armadillo_bits/op_shift_bones.hpp" - #include "armadillo_bits/op_shuffle_bones.hpp" - #include "armadillo_bits/op_prod_bones.hpp" - #include "armadillo_bits/op_pinv_bones.hpp" - #include "armadillo_bits/op_dotext_bones.hpp" - #include "armadillo_bits/op_flip_bones.hpp" - #include "armadillo_bits/op_reverse_bones.hpp" - #include "armadillo_bits/op_princomp_bones.hpp" - #include "armadillo_bits/op_misc_bones.hpp" - #include "armadillo_bits/op_orth_null_bones.hpp" - #include "armadillo_bits/op_relational_bones.hpp" - #include "armadillo_bits/op_find_bones.hpp" - #include "armadillo_bits/op_find_unique_bones.hpp" - #include "armadillo_bits/op_chol_bones.hpp" - #include "armadillo_bits/op_cx_scalar_bones.hpp" - #include "armadillo_bits/op_trimat_bones.hpp" - #include "armadillo_bits/op_cumsum_bones.hpp" - #include "armadillo_bits/op_cumprod_bones.hpp" - #include "armadillo_bits/op_symmat_bones.hpp" - #include "armadillo_bits/op_hist_bones.hpp" - #include "armadillo_bits/op_unique_bones.hpp" - #include "armadillo_bits/op_toeplitz_bones.hpp" - #include "armadillo_bits/op_fft_bones.hpp" - #include "armadillo_bits/op_any_bones.hpp" - #include "armadillo_bits/op_all_bones.hpp" - #include "armadillo_bits/op_normalise_bones.hpp" - #include "armadillo_bits/op_clamp_bones.hpp" - #include "armadillo_bits/op_expmat_bones.hpp" - #include "armadillo_bits/op_nonzeros_bones.hpp" - #include "armadillo_bits/op_diff_bones.hpp" - #include "armadillo_bits/op_norm_bones.hpp" - #include "armadillo_bits/op_vecnorm_bones.hpp" - #include "armadillo_bits/op_norm2est_bones.hpp" - #include "armadillo_bits/op_sqrtmat_bones.hpp" - #include "armadillo_bits/op_logmat_bones.hpp" - #include "armadillo_bits/op_range_bones.hpp" - #include "armadillo_bits/op_chi2rnd_bones.hpp" - #include "armadillo_bits/op_wishrnd_bones.hpp" - #include "armadillo_bits/op_roots_bones.hpp" - #include "armadillo_bits/op_cond_bones.hpp" - #include "armadillo_bits/op_rcond_bones.hpp" - #include "armadillo_bits/op_powmat_bones.hpp" - #include "armadillo_bits/op_rank_bones.hpp" - #include "armadillo_bits/op_row_as_mat_bones.hpp" - #include "armadillo_bits/op_col_as_mat_bones.hpp" - #include "armadillo_bits/op_sp_plus_bones.hpp" - #include "armadillo_bits/op_sp_minus_bones.hpp" - #include "armadillo_bits/op_sp_sum_bones.hpp" - #include "armadillo_bits/op_sp_max_bones.hpp" - #include "armadillo_bits/op_sp_min_bones.hpp" - #include "armadillo_bits/op_sp_mean_bones.hpp" - #include "armadillo_bits/op_sp_var_bones.hpp" - #include "armadillo_bits/op_sp_stddev_bones.hpp" - #include "armadillo_bits/op_sp_vecnorm_bones.hpp" - #include "armadillo_bits/op_sp_diagvec_bones.hpp" - #include "armadillo_bits/op_sp_nonzeros_bones.hpp" - #include "armadillo_bits/op_sp_as_dense_bones.hpp" - - #include "armadillo_bits/glue_times_bones.hpp" - #include "armadillo_bits/glue_times_misc_bones.hpp" - #include "armadillo_bits/glue_mixed_bones.hpp" - #include "armadillo_bits/glue_cov_bones.hpp" - #include "armadillo_bits/glue_cor_bones.hpp" - #include "armadillo_bits/glue_kron_bones.hpp" - #include "armadillo_bits/glue_cross_bones.hpp" - #include "armadillo_bits/glue_join_bones.hpp" - #include "armadillo_bits/glue_relational_bones.hpp" - #include "armadillo_bits/glue_solve_bones.hpp" - #include "armadillo_bits/glue_conv_bones.hpp" - #include "armadillo_bits/glue_toeplitz_bones.hpp" - #include "armadillo_bits/glue_hist_bones.hpp" - #include "armadillo_bits/glue_histc_bones.hpp" - #include "armadillo_bits/glue_max_bones.hpp" - #include "armadillo_bits/glue_min_bones.hpp" - #include "armadillo_bits/glue_trapz_bones.hpp" - #include "armadillo_bits/glue_atan2_bones.hpp" - #include "armadillo_bits/glue_hypot_bones.hpp" - #include "armadillo_bits/glue_polyfit_bones.hpp" - #include "armadillo_bits/glue_polyval_bones.hpp" - #include "armadillo_bits/glue_intersect_bones.hpp" - #include "armadillo_bits/glue_affmul_bones.hpp" - #include "armadillo_bits/glue_mvnrnd_bones.hpp" - #include "armadillo_bits/glue_quantile_bones.hpp" - #include "armadillo_bits/glue_powext_bones.hpp" - - #include "armadillo_bits/gmm_misc_bones.hpp" - #include "armadillo_bits/gmm_diag_bones.hpp" - #include "armadillo_bits/gmm_full_bones.hpp" - - #include "armadillo_bits/spop_strans_bones.hpp" - #include "armadillo_bits/spop_htrans_bones.hpp" - #include "armadillo_bits/spop_misc_bones.hpp" - #include "armadillo_bits/spop_diagmat_bones.hpp" - #include "armadillo_bits/spop_trimat_bones.hpp" - #include "armadillo_bits/spop_symmat_bones.hpp" - #include "armadillo_bits/spop_normalise_bones.hpp" - #include "armadillo_bits/spop_reverse_bones.hpp" - #include "armadillo_bits/spop_repmat_bones.hpp" - #include "armadillo_bits/spop_vectorise_bones.hpp" - #include "armadillo_bits/spop_norm_bones.hpp" - #include "armadillo_bits/spop_shift_bones.hpp" - #include "armadillo_bits/spop_relational_bones.hpp" - - #include "armadillo_bits/spglue_plus_bones.hpp" - #include "armadillo_bits/spglue_minus_bones.hpp" - #include "armadillo_bits/spglue_schur_bones.hpp" - #include "armadillo_bits/spglue_times_bones.hpp" - #include "armadillo_bits/spglue_join_bones.hpp" - #include "armadillo_bits/spglue_kron_bones.hpp" - #include "armadillo_bits/spglue_min_bones.hpp" - #include "armadillo_bits/spglue_max_bones.hpp" - #include "armadillo_bits/spglue_merge_bones.hpp" - #include "armadillo_bits/spglue_relational_bones.hpp" - - #include "armadillo_bits/spsolve_factoriser_bones.hpp" - - #if defined(ARMA_USE_NEWARP) - #include "armadillo_bits/newarp_EigsSelect.hpp" - #include "armadillo_bits/newarp_DenseGenMatProd_bones.hpp" - #include "armadillo_bits/newarp_SparseGenMatProd_bones.hpp" - #include "armadillo_bits/newarp_SparseGenRealShiftSolve_bones.hpp" - #include "armadillo_bits/newarp_DoubleShiftQR_bones.hpp" - #include "armadillo_bits/newarp_GenEigsSolver_bones.hpp" - #include "armadillo_bits/newarp_SymEigsSolver_bones.hpp" - #include "armadillo_bits/newarp_SymEigsShiftSolver_bones.hpp" - #include "armadillo_bits/newarp_TridiagEigen_bones.hpp" - #include "armadillo_bits/newarp_UpperHessenbergEigen_bones.hpp" - #include "armadillo_bits/newarp_UpperHessenbergQR_bones.hpp" - #endif - - - // - // low-level debugging and memory handling functions - - #include "armadillo_bits/debug.hpp" - #include "armadillo_bits/memory.hpp" - - // - // wrappers for various cmath functions - - #include "armadillo_bits/arma_cmath.hpp" - - // - // classes that underlay metaprogramming - - #include "armadillo_bits/unwrap.hpp" - #include "armadillo_bits/unwrap_cube.hpp" - #include "armadillo_bits/unwrap_spmat.hpp" - - #include "armadillo_bits/Proxy.hpp" - #include "armadillo_bits/ProxyCube.hpp" - #include "armadillo_bits/SpProxy.hpp" - - #include "armadillo_bits/diagmat_proxy.hpp" - - #include "armadillo_bits/strip.hpp" - - #include "armadillo_bits/eop_aux.hpp" - - // - // ostream - - #include "armadillo_bits/arma_ostream_bones.hpp" - #include "armadillo_bits/arma_ostream_meat.hpp" - - // - // n_unique, which is used by some sparse operators - - #include "armadillo_bits/fn_n_unique.hpp" - - // - // operators - - #include "armadillo_bits/operator_plus.hpp" - #include "armadillo_bits/operator_minus.hpp" - #include "armadillo_bits/operator_times.hpp" - #include "armadillo_bits/operator_schur.hpp" - #include "armadillo_bits/operator_div.hpp" - #include "armadillo_bits/operator_relational.hpp" - - #include "armadillo_bits/operator_cube_plus.hpp" - #include "armadillo_bits/operator_cube_minus.hpp" - #include "armadillo_bits/operator_cube_times.hpp" - #include "armadillo_bits/operator_cube_schur.hpp" - #include "armadillo_bits/operator_cube_div.hpp" - #include "armadillo_bits/operator_cube_relational.hpp" - - #include "armadillo_bits/operator_ostream.hpp" - - // - // user accessible functions - - // the order of the fn_*.hpp include files matters, - // as some files require functionality given in preceding files - - #include "armadillo_bits/fn_conv_to.hpp" - #include "armadillo_bits/fn_max.hpp" - #include "armadillo_bits/fn_min.hpp" - #include "armadillo_bits/fn_index_max.hpp" - #include "armadillo_bits/fn_index_min.hpp" - #include "armadillo_bits/fn_accu.hpp" - #include "armadillo_bits/fn_sum.hpp" - #include "armadillo_bits/fn_diagmat.hpp" - #include "armadillo_bits/fn_diagvec.hpp" - #include "armadillo_bits/fn_inv.hpp" - #include "armadillo_bits/fn_inv_sympd.hpp" - #include "armadillo_bits/fn_trace.hpp" - #include "armadillo_bits/fn_trans.hpp" - #include "armadillo_bits/fn_det.hpp" - #include "armadillo_bits/fn_log_det.hpp" - #include "armadillo_bits/fn_eig_gen.hpp" - #include "armadillo_bits/fn_eig_sym.hpp" - #include "armadillo_bits/fn_eig_pair.hpp" - #include "armadillo_bits/fn_lu.hpp" - #include "armadillo_bits/fn_zeros.hpp" - #include "armadillo_bits/fn_ones.hpp" - #include "armadillo_bits/fn_eye.hpp" - #include "armadillo_bits/fn_misc.hpp" - #include "armadillo_bits/fn_orth_null.hpp" - #include "armadillo_bits/fn_regspace.hpp" - #include "armadillo_bits/fn_find.hpp" - #include "armadillo_bits/fn_find_unique.hpp" - #include "armadillo_bits/fn_elem.hpp" - #include "armadillo_bits/fn_approx_equal.hpp" - #include "armadillo_bits/fn_norm.hpp" - #include "armadillo_bits/fn_vecnorm.hpp" - #include "armadillo_bits/fn_dot.hpp" - #include "armadillo_bits/fn_randu.hpp" - #include "armadillo_bits/fn_randn.hpp" - #include "armadillo_bits/fn_trig.hpp" - #include "armadillo_bits/fn_mean.hpp" - #include "armadillo_bits/fn_median.hpp" - #include "armadillo_bits/fn_stddev.hpp" - #include "armadillo_bits/fn_var.hpp" - #include "armadillo_bits/fn_sort.hpp" - #include "armadillo_bits/fn_sort_index.hpp" - #include "armadillo_bits/fn_strans.hpp" - #include "armadillo_bits/fn_chol.hpp" - #include "armadillo_bits/fn_qr.hpp" - #include "armadillo_bits/fn_svd.hpp" - #include "armadillo_bits/fn_solve.hpp" - #include "armadillo_bits/fn_repmat.hpp" - #include "armadillo_bits/fn_repelem.hpp" - #include "armadillo_bits/fn_reshape.hpp" - #include "armadillo_bits/fn_vectorise.hpp" - #include "armadillo_bits/fn_resize.hpp" - #include "armadillo_bits/fn_cov.hpp" - #include "armadillo_bits/fn_cor.hpp" - #include "armadillo_bits/fn_shift.hpp" - #include "armadillo_bits/fn_shuffle.hpp" - #include "armadillo_bits/fn_prod.hpp" - #include "armadillo_bits/fn_eps.hpp" - #include "armadillo_bits/fn_pinv.hpp" - #include "armadillo_bits/fn_rank.hpp" - #include "armadillo_bits/fn_kron.hpp" - #include "armadillo_bits/fn_flip.hpp" - #include "armadillo_bits/fn_reverse.hpp" - #include "armadillo_bits/fn_as_scalar.hpp" - #include "armadillo_bits/fn_princomp.hpp" - #include "armadillo_bits/fn_cross.hpp" - #include "armadillo_bits/fn_join.hpp" - #include "armadillo_bits/fn_conv.hpp" - #include "armadillo_bits/fn_trunc_exp.hpp" - #include "armadillo_bits/fn_trunc_log.hpp" - #include "armadillo_bits/fn_toeplitz.hpp" - #include "armadillo_bits/fn_trimat.hpp" - #include "armadillo_bits/fn_trimat_ind.hpp" - #include "armadillo_bits/fn_cumsum.hpp" - #include "armadillo_bits/fn_cumprod.hpp" - #include "armadillo_bits/fn_symmat.hpp" - #include "armadillo_bits/fn_sylvester.hpp" - #include "armadillo_bits/fn_hist.hpp" - #include "armadillo_bits/fn_histc.hpp" - #include "armadillo_bits/fn_unique.hpp" - #include "armadillo_bits/fn_fft.hpp" - #include "armadillo_bits/fn_fft2.hpp" - #include "armadillo_bits/fn_any.hpp" - #include "armadillo_bits/fn_all.hpp" - #include "armadillo_bits/fn_size.hpp" - #include "armadillo_bits/fn_numel.hpp" - #include "armadillo_bits/fn_inplace_strans.hpp" - #include "armadillo_bits/fn_inplace_trans.hpp" - #include "armadillo_bits/fn_randi.hpp" - #include "armadillo_bits/fn_randg.hpp" - #include "armadillo_bits/fn_cond_rcond.hpp" - #include "armadillo_bits/fn_normalise.hpp" - #include "armadillo_bits/fn_clamp.hpp" - #include "armadillo_bits/fn_expmat.hpp" - #include "armadillo_bits/fn_nonzeros.hpp" - #include "armadillo_bits/fn_interp1.hpp" - #include "armadillo_bits/fn_interp2.hpp" - #include "armadillo_bits/fn_qz.hpp" - #include "armadillo_bits/fn_diff.hpp" - #include "armadillo_bits/fn_hess.hpp" - #include "armadillo_bits/fn_schur.hpp" - #include "armadillo_bits/fn_kmeans.hpp" - #include "armadillo_bits/fn_sqrtmat.hpp" - #include "armadillo_bits/fn_logmat.hpp" - #include "armadillo_bits/fn_trapz.hpp" - #include "armadillo_bits/fn_range.hpp" - #include "armadillo_bits/fn_polyfit.hpp" - #include "armadillo_bits/fn_polyval.hpp" - #include "armadillo_bits/fn_intersect.hpp" - #include "armadillo_bits/fn_normpdf.hpp" - #include "armadillo_bits/fn_log_normpdf.hpp" - #include "armadillo_bits/fn_normcdf.hpp" - #include "armadillo_bits/fn_mvnrnd.hpp" - #include "armadillo_bits/fn_chi2rnd.hpp" - #include "armadillo_bits/fn_wishrnd.hpp" - #include "armadillo_bits/fn_roots.hpp" - #include "armadillo_bits/fn_randperm.hpp" - #include "armadillo_bits/fn_quantile.hpp" - #include "armadillo_bits/fn_powmat.hpp" - #include "armadillo_bits/fn_powext.hpp" - #include "armadillo_bits/fn_diags_spdiags.hpp" - - #include "armadillo_bits/fn_speye.hpp" - #include "armadillo_bits/fn_spones.hpp" - #include "armadillo_bits/fn_sprandn.hpp" - #include "armadillo_bits/fn_sprandu.hpp" - #include "armadillo_bits/fn_eigs_sym.hpp" - #include "armadillo_bits/fn_eigs_gen.hpp" - #include "armadillo_bits/fn_spsolve.hpp" - #include "armadillo_bits/fn_svds.hpp" - - // - // misc stuff - - #include "armadillo_bits/hdf5_misc.hpp" - #include "armadillo_bits/fft_engine_kissfft.hpp" - #include "armadillo_bits/fft_engine_fftw3.hpp" - #include "armadillo_bits/band_helper.hpp" - #include "armadillo_bits/sym_helper.hpp" - #include "armadillo_bits/trimat_helper.hpp" - - // - // classes implementing various forms of dense matrix multiplication - - #include "armadillo_bits/mul_gemv.hpp" - #include "armadillo_bits/mul_gemm.hpp" - #include "armadillo_bits/mul_gemm_mixed.hpp" - #include "armadillo_bits/mul_syrk.hpp" - #include "armadillo_bits/mul_herk.hpp" - - // - // class meat - - #include "armadillo_bits/Op_meat.hpp" - #include "armadillo_bits/CubeToMatOp_meat.hpp" - #include "armadillo_bits/OpCube_meat.hpp" - #include "armadillo_bits/SpOp_meat.hpp" - #include "armadillo_bits/SpToDOp_meat.hpp" - - #include "armadillo_bits/mtOp_meat.hpp" - #include "armadillo_bits/mtOpCube_meat.hpp" - #include "armadillo_bits/mtSpOp_meat.hpp" - #include "armadillo_bits/mtSpReduceOp_meat.hpp" - - #include "armadillo_bits/Glue_meat.hpp" - #include "armadillo_bits/GlueCube_meat.hpp" - #include "armadillo_bits/SpGlue_meat.hpp" - #include "armadillo_bits/mtSpGlue_meat.hpp" - #include "armadillo_bits/SpToDGlue_meat.hpp" - - #include "armadillo_bits/eOp_meat.hpp" - #include "armadillo_bits/eOpCube_meat.hpp" - - #include "armadillo_bits/eGlue_meat.hpp" - #include "armadillo_bits/eGlueCube_meat.hpp" - - #include "armadillo_bits/mtGlue_meat.hpp" - #include "armadillo_bits/mtGlueCube_meat.hpp" - - #include "armadillo_bits/Base_meat.hpp" - #include "armadillo_bits/BaseCube_meat.hpp" - #include "armadillo_bits/SpBase_meat.hpp" - - #include "armadillo_bits/Gen_meat.hpp" - #include "armadillo_bits/GenCube_meat.hpp" - - #include "armadillo_bits/eop_core_meat.hpp" - #include "armadillo_bits/eglue_core_meat.hpp" - - #include "armadillo_bits/cond_rel_meat.hpp" - #include "armadillo_bits/arrayops_meat.hpp" - #include "armadillo_bits/podarray_meat.hpp" - #include "armadillo_bits/auxlib_meat.hpp" - #include "armadillo_bits/sp_auxlib_meat.hpp" - - #include "armadillo_bits/injector_meat.hpp" - - #include "armadillo_bits/Mat_meat.hpp" - #include "armadillo_bits/Col_meat.hpp" - #include "armadillo_bits/Row_meat.hpp" - #include "armadillo_bits/Cube_meat.hpp" - #include "armadillo_bits/xvec_htrans_meat.hpp" - #include "armadillo_bits/xtrans_mat_meat.hpp" - #include "armadillo_bits/SizeMat_meat.hpp" - #include "armadillo_bits/SizeCube_meat.hpp" - - #include "armadillo_bits/field_meat.hpp" - #include "armadillo_bits/subview_meat.hpp" - #include "armadillo_bits/subview_elem1_meat.hpp" - #include "armadillo_bits/subview_elem2_meat.hpp" - #include "armadillo_bits/subview_field_meat.hpp" - #include "armadillo_bits/subview_cube_meat.hpp" - #include "armadillo_bits/diagview_meat.hpp" - #include "armadillo_bits/subview_each_meat.hpp" - #include "armadillo_bits/subview_cube_each_meat.hpp" - #include "armadillo_bits/subview_cube_slices_meat.hpp" - - #include "armadillo_bits/SpValProxy_meat.hpp" - #include "armadillo_bits/SpMat_meat.hpp" - #include "armadillo_bits/SpMat_iterators_meat.hpp" - #include "armadillo_bits/SpCol_meat.hpp" - #include "armadillo_bits/SpRow_meat.hpp" - #include "armadillo_bits/SpSubview_meat.hpp" - #include "armadillo_bits/SpSubview_iterators_meat.hpp" - #include "armadillo_bits/SpSubview_col_list_meat.hpp" - #include "armadillo_bits/spdiagview_meat.hpp" - #include "armadillo_bits/MapMat_meat.hpp" - - #include "armadillo_bits/diskio_meat.hpp" - #include "armadillo_bits/wall_clock_meat.hpp" - #include "armadillo_bits/running_stat_meat.hpp" - #include "armadillo_bits/running_stat_vec_meat.hpp" - - #include "armadillo_bits/op_diagmat_meat.hpp" - #include "armadillo_bits/op_diagvec_meat.hpp" - #include "armadillo_bits/op_dot_meat.hpp" - #include "armadillo_bits/op_det_meat.hpp" - #include "armadillo_bits/op_log_det_meat.hpp" - #include "armadillo_bits/op_inv_gen_meat.hpp" - #include "armadillo_bits/op_inv_spd_meat.hpp" - #include "armadillo_bits/op_htrans_meat.hpp" - #include "armadillo_bits/op_max_meat.hpp" - #include "armadillo_bits/op_index_max_meat.hpp" - #include "armadillo_bits/op_index_min_meat.hpp" - #include "armadillo_bits/op_min_meat.hpp" - #include "armadillo_bits/op_mean_meat.hpp" - #include "armadillo_bits/op_median_meat.hpp" - #include "armadillo_bits/op_sort_meat.hpp" - #include "armadillo_bits/op_sort_index_meat.hpp" - #include "armadillo_bits/op_sum_meat.hpp" - #include "armadillo_bits/op_stddev_meat.hpp" - #include "armadillo_bits/op_strans_meat.hpp" - #include "armadillo_bits/op_var_meat.hpp" - #include "armadillo_bits/op_repmat_meat.hpp" - #include "armadillo_bits/op_repelem_meat.hpp" - #include "armadillo_bits/op_reshape_meat.hpp" - #include "armadillo_bits/op_vectorise_meat.hpp" - #include "armadillo_bits/op_resize_meat.hpp" - #include "armadillo_bits/op_cov_meat.hpp" - #include "armadillo_bits/op_cor_meat.hpp" - #include "armadillo_bits/op_shift_meat.hpp" - #include "armadillo_bits/op_shuffle_meat.hpp" - #include "armadillo_bits/op_prod_meat.hpp" - #include "armadillo_bits/op_pinv_meat.hpp" - #include "armadillo_bits/op_dotext_meat.hpp" - #include "armadillo_bits/op_flip_meat.hpp" - #include "armadillo_bits/op_reverse_meat.hpp" - #include "armadillo_bits/op_princomp_meat.hpp" - #include "armadillo_bits/op_misc_meat.hpp" - #include "armadillo_bits/op_orth_null_meat.hpp" - #include "armadillo_bits/op_relational_meat.hpp" - #include "armadillo_bits/op_find_meat.hpp" - #include "armadillo_bits/op_find_unique_meat.hpp" - #include "armadillo_bits/op_chol_meat.hpp" - #include "armadillo_bits/op_cx_scalar_meat.hpp" - #include "armadillo_bits/op_trimat_meat.hpp" - #include "armadillo_bits/op_cumsum_meat.hpp" - #include "armadillo_bits/op_cumprod_meat.hpp" - #include "armadillo_bits/op_symmat_meat.hpp" - #include "armadillo_bits/op_hist_meat.hpp" - #include "armadillo_bits/op_unique_meat.hpp" - #include "armadillo_bits/op_toeplitz_meat.hpp" - #include "armadillo_bits/op_fft_meat.hpp" - #include "armadillo_bits/op_any_meat.hpp" - #include "armadillo_bits/op_all_meat.hpp" - #include "armadillo_bits/op_normalise_meat.hpp" - #include "armadillo_bits/op_clamp_meat.hpp" - #include "armadillo_bits/op_expmat_meat.hpp" - #include "armadillo_bits/op_nonzeros_meat.hpp" - #include "armadillo_bits/op_diff_meat.hpp" - #include "armadillo_bits/op_norm_meat.hpp" - #include "armadillo_bits/op_vecnorm_meat.hpp" - #include "armadillo_bits/op_norm2est_meat.hpp" - #include "armadillo_bits/op_sqrtmat_meat.hpp" - #include "armadillo_bits/op_logmat_meat.hpp" - #include "armadillo_bits/op_range_meat.hpp" - #include "armadillo_bits/op_chi2rnd_meat.hpp" - #include "armadillo_bits/op_wishrnd_meat.hpp" - #include "armadillo_bits/op_roots_meat.hpp" - #include "armadillo_bits/op_cond_meat.hpp" - #include "armadillo_bits/op_rcond_meat.hpp" - #include "armadillo_bits/op_powmat_meat.hpp" - #include "armadillo_bits/op_rank_meat.hpp" - #include "armadillo_bits/op_row_as_mat_meat.hpp" - #include "armadillo_bits/op_col_as_mat_meat.hpp" - #include "armadillo_bits/op_sp_plus_meat.hpp" - #include "armadillo_bits/op_sp_minus_meat.hpp" - #include "armadillo_bits/op_sp_sum_meat.hpp" - #include "armadillo_bits/op_sp_max_meat.hpp" - #include "armadillo_bits/op_sp_min_meat.hpp" - #include "armadillo_bits/op_sp_mean_meat.hpp" - #include "armadillo_bits/op_sp_var_meat.hpp" - #include "armadillo_bits/op_sp_stddev_meat.hpp" - #include "armadillo_bits/op_sp_vecnorm_meat.hpp" - #include "armadillo_bits/op_sp_diagvec_meat.hpp" - #include "armadillo_bits/op_sp_nonzeros_meat.hpp" - #include "armadillo_bits/op_sp_as_dense_meat.hpp" - - #include "armadillo_bits/glue_times_meat.hpp" - #include "armadillo_bits/glue_times_misc_meat.hpp" - #include "armadillo_bits/glue_mixed_meat.hpp" - #include "armadillo_bits/glue_cov_meat.hpp" - #include "armadillo_bits/glue_cor_meat.hpp" - #include "armadillo_bits/glue_kron_meat.hpp" - #include "armadillo_bits/glue_cross_meat.hpp" - #include "armadillo_bits/glue_join_meat.hpp" - #include "armadillo_bits/glue_relational_meat.hpp" - #include "armadillo_bits/glue_solve_meat.hpp" - #include "armadillo_bits/glue_conv_meat.hpp" - #include "armadillo_bits/glue_toeplitz_meat.hpp" - #include "armadillo_bits/glue_hist_meat.hpp" - #include "armadillo_bits/glue_histc_meat.hpp" - #include "armadillo_bits/glue_max_meat.hpp" - #include "armadillo_bits/glue_min_meat.hpp" - #include "armadillo_bits/glue_trapz_meat.hpp" - #include "armadillo_bits/glue_atan2_meat.hpp" - #include "armadillo_bits/glue_hypot_meat.hpp" - #include "armadillo_bits/glue_polyfit_meat.hpp" - #include "armadillo_bits/glue_polyval_meat.hpp" - #include "armadillo_bits/glue_intersect_meat.hpp" - #include "armadillo_bits/glue_affmul_meat.hpp" - #include "armadillo_bits/glue_mvnrnd_meat.hpp" - #include "armadillo_bits/glue_quantile_meat.hpp" - #include "armadillo_bits/glue_powext_meat.hpp" - - #include "armadillo_bits/gmm_misc_meat.hpp" - #include "armadillo_bits/gmm_diag_meat.hpp" - #include "armadillo_bits/gmm_full_meat.hpp" - - #include "armadillo_bits/spop_strans_meat.hpp" - #include "armadillo_bits/spop_htrans_meat.hpp" - #include "armadillo_bits/spop_misc_meat.hpp" - #include "armadillo_bits/spop_diagmat_meat.hpp" - #include "armadillo_bits/spop_trimat_meat.hpp" - #include "armadillo_bits/spop_symmat_meat.hpp" - #include "armadillo_bits/spop_normalise_meat.hpp" - #include "armadillo_bits/spop_reverse_meat.hpp" - #include "armadillo_bits/spop_repmat_meat.hpp" - #include "armadillo_bits/spop_vectorise_meat.hpp" - #include "armadillo_bits/spop_norm_meat.hpp" - #include "armadillo_bits/spop_shift_meat.hpp" - #include "armadillo_bits/spop_relational_meat.hpp" - - #include "armadillo_bits/spglue_plus_meat.hpp" - #include "armadillo_bits/spglue_minus_meat.hpp" - #include "armadillo_bits/spglue_schur_meat.hpp" - #include "armadillo_bits/spglue_times_meat.hpp" - #include "armadillo_bits/spglue_join_meat.hpp" - #include "armadillo_bits/spglue_kron_meat.hpp" - #include "armadillo_bits/spglue_min_meat.hpp" - #include "armadillo_bits/spglue_max_meat.hpp" - #include "armadillo_bits/spglue_merge_meat.hpp" - #include "armadillo_bits/spglue_relational_meat.hpp" - - #include "armadillo_bits/spsolve_factoriser_meat.hpp" - - #if defined(ARMA_USE_NEWARP) - #include "armadillo_bits/newarp_cx_attrib.hpp" - #include "armadillo_bits/newarp_SortEigenvalue.hpp" - #include "armadillo_bits/newarp_DenseGenMatProd_meat.hpp" - #include "armadillo_bits/newarp_SparseGenMatProd_meat.hpp" - #include "armadillo_bits/newarp_SparseGenRealShiftSolve_meat.hpp" - #include "armadillo_bits/newarp_DoubleShiftQR_meat.hpp" - #include "armadillo_bits/newarp_GenEigsSolver_meat.hpp" - #include "armadillo_bits/newarp_SymEigsSolver_meat.hpp" - #include "armadillo_bits/newarp_SymEigsShiftSolver_meat.hpp" - #include "armadillo_bits/newarp_TridiagEigen_meat.hpp" - #include "armadillo_bits/newarp_UpperHessenbergEigen_meat.hpp" - #include "armadillo_bits/newarp_UpperHessenbergQR_meat.hpp" - #endif - } - - - -#include "armadillo_bits/compiler_setup_post.hpp" - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/BaseCube_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/BaseCube_bones.hpp deleted file mode 100644 index 15d6a4c8d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/BaseCube_bones.hpp +++ /dev/null @@ -1,86 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup BaseCube -//! @{ - - - -template -struct BaseCube_eval_Cube - { - arma_warn_unused arma_inline const derived& eval() const; - }; - - -template -struct BaseCube_eval_expr - { - arma_warn_unused inline Cube eval() const; //!< force the immediate evaluation of a delayed expression - }; - - -template -struct BaseCube_eval {}; - -template -struct BaseCube_eval { typedef BaseCube_eval_Cube result; }; - -template -struct BaseCube_eval { typedef BaseCube_eval_expr result; }; - - - -//! Analog of the Base class, intended for cubes -template -struct BaseCube - : public BaseCube_eval::value>::result - { - arma_inline const derived& get_ref() const; - - arma_cold inline void print( const std::string extra_text = "") const; - arma_cold inline void print(std::ostream& user_stream, const std::string extra_text = "") const; - - arma_cold inline void raw_print( const std::string extra_text = "") const; - arma_cold inline void raw_print(std::ostream& user_stream, const std::string extra_text = "") const; - - arma_cold inline void brief_print( const std::string extra_text = "") const; - arma_cold inline void brief_print(std::ostream& user_stream, const std::string extra_text = "") const; - - arma_warn_unused inline elem_type min() const; - arma_warn_unused inline elem_type max() const; - - arma_warn_unused inline uword index_min() const; - arma_warn_unused inline uword index_max() const; - - arma_warn_unused inline bool is_zero(const typename get_pod_type::result tol = 0) const; - - arma_warn_unused inline bool is_empty() const; - arma_warn_unused inline bool is_finite() const; - - arma_warn_unused inline bool has_inf() const; - arma_warn_unused inline bool has_nan() const; - arma_warn_unused inline bool has_nonfinite() const; - - arma_warn_unused inline const CubeToMatOp row_as_mat(const uword in_row) const; - arma_warn_unused inline const CubeToMatOp col_as_mat(const uword in_col) const; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/BaseCube_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/BaseCube_meat.hpp deleted file mode 100644 index 7fbf7f675..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/BaseCube_meat.hpp +++ /dev/null @@ -1,498 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup BaseCube -//! @{ - - - -template -arma_inline -const derived& -BaseCube::get_ref() const - { - return static_cast(*this); - } - - - -template -inline -void -BaseCube::print(const std::string extra_text) const - { - arma_debug_sigprint(); - - const unwrap_cube tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = get_cout_stream().width(); - - get_cout_stream() << extra_text << '\n'; - - get_cout_stream().width(orig_width); - } - - arma_ostream::print(get_cout_stream(), tmp.M, true); - } - - - -template -inline -void -BaseCube::print(std::ostream& user_stream, const std::string extra_text) const - { - arma_debug_sigprint(); - - const unwrap_cube tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = user_stream.width(); - - user_stream << extra_text << '\n'; - - user_stream.width(orig_width); - } - - arma_ostream::print(user_stream, tmp.M, true); - } - - - -template -inline -void -BaseCube::raw_print(const std::string extra_text) const - { - arma_debug_sigprint(); - - const unwrap_cube tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = get_cout_stream().width(); - - get_cout_stream() << extra_text << '\n'; - - get_cout_stream().width(orig_width); - } - - arma_ostream::print(get_cout_stream(), tmp.M, false); - } - - - -template -inline -void -BaseCube::raw_print(std::ostream& user_stream, const std::string extra_text) const - { - arma_debug_sigprint(); - - const unwrap_cube tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = user_stream.width(); - - user_stream << extra_text << '\n'; - - user_stream.width(orig_width); - } - - arma_ostream::print(user_stream, tmp.M, false); - } - - - -template -inline -void -BaseCube::brief_print(const std::string extra_text) const - { - arma_debug_sigprint(); - - const unwrap_cube tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = get_cout_stream().width(); - - get_cout_stream() << extra_text << '\n'; - - get_cout_stream().width(orig_width); - } - - arma_ostream::brief_print(get_cout_stream(), tmp.M); - } - - - -template -inline -void -BaseCube::brief_print(std::ostream& user_stream, const std::string extra_text) const - { - arma_debug_sigprint(); - - const unwrap_cube tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = user_stream.width(); - - user_stream << extra_text << '\n'; - - user_stream.width(orig_width); - } - - arma_ostream::brief_print(user_stream, tmp.M); - } - - - -template -inline -elem_type -BaseCube::min() const - { - return op_min::min( (*this).get_ref() ); - } - - - -template -inline -elem_type -BaseCube::max() const - { - return op_max::max( (*this).get_ref() ); - } - - - -template -inline -uword -BaseCube::index_min() const - { - const ProxyCube P( (*this).get_ref() ); - - uword index = 0; - - if(P.get_n_elem() == 0) - { - arma_conform_check(true, "index_min(): object has no elements"); - } - else - { - op_min::min_with_index(P, index); - } - - return index; - } - - - -template -inline -uword -BaseCube::index_max() const - { - const ProxyCube P( (*this).get_ref() ); - - uword index = 0; - - if(P.get_n_elem() == 0) - { - arma_conform_check(true, "index_max(): object has no elements"); - } - else - { - op_max::max_with_index(P, index); - } - - return index; - } - - - -template -inline -bool -BaseCube::is_zero(const typename get_pod_type::result tol) const - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - arma_conform_check( (tol < T(0)), "is_zero(): parameter 'tol' must be >= 0" ); - - if(ProxyCube::use_at || is_Cube::stored_type>::value) - { - const unwrap_cube U( (*this).get_ref() ); - - return arrayops::is_zero( U.M.memptr(), U.M.n_elem, tol ); - } - - const ProxyCube P( (*this).get_ref() ); - - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) { return false; } - - const typename ProxyCube::ea_type Pea = P.get_ea(); - - if(is_cx::yes) - { - for(uword i=0; i tol) { return false; } - if(eop_aux::arma_abs(val_imag) > tol) { return false; } - } - } - else // not complex - { - for(uword i=0; i < n_elem; ++i) - { - if(eop_aux::arma_abs(Pea[i]) > tol) { return false; } - } - } - - return true; - } - - - -template -inline -bool -BaseCube::is_empty() const - { - arma_debug_sigprint(); - - const ProxyCube P( (*this).get_ref() ); - - return (P.get_n_elem() == uword(0)); - } - - - -template -inline -bool -BaseCube::is_finite() const - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "is_finite(): detection of non-finite values is not reliable in fast math mode"); } - - if(is_Cube::stored_type>::value) - { - const unwrap_cube U( (*this).get_ref() ); - - return arrayops::is_finite( U.M.memptr(), U.M.n_elem ); - } - else - { - const ProxyCube P( (*this).get_ref() ); - - const uword n_r = P.get_n_rows(); - const uword n_c = P.get_n_cols(); - const uword n_s = P.get_n_slices(); - - for(uword s=0; s -inline -bool -BaseCube::has_inf() const - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "has_inf(): detection of non-finite values is not reliable in fast math mode"); } - - if(is_Cube::stored_type>::value) - { - const unwrap_cube U( (*this).get_ref() ); - - return arrayops::has_inf( U.M.memptr(), U.M.n_elem ); - } - else - { - const ProxyCube P( (*this).get_ref() ); - - const uword n_r = P.get_n_rows(); - const uword n_c = P.get_n_cols(); - const uword n_s = P.get_n_slices(); - - for(uword s=0; s -inline -bool -BaseCube::has_nan() const - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "has_nan(): detection of non-finite values is not reliable in fast math mode"); } - - if(is_Cube::stored_type>::value) - { - const unwrap_cube U( (*this).get_ref() ); - - return arrayops::has_nan( U.M.memptr(), U.M.n_elem ); - } - else - { - const ProxyCube P( (*this).get_ref() ); - - const uword n_r = P.get_n_rows(); - const uword n_c = P.get_n_cols(); - const uword n_s = P.get_n_slices(); - - for(uword s=0; s -inline -bool -BaseCube::has_nonfinite() const - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "has_nonfinite(): detection of non-finite values is not reliable in fast math mode"); } - - if(is_Cube::stored_type>::value) - { - const unwrap_cube U( (*this).get_ref() ); - - return (arrayops::is_finite( U.M.memptr(), U.M.n_elem ) == false); - } - else - { - const ProxyCube P( (*this).get_ref() ); - - const uword n_r = P.get_n_rows(); - const uword n_c = P.get_n_cols(); - const uword n_s = P.get_n_slices(); - - for(uword s=0; s -inline -const CubeToMatOp -BaseCube::row_as_mat(const uword in_row) const - { - return CubeToMatOp( (*this).get_ref(), in_row ); - } - - - -template -inline -const CubeToMatOp -BaseCube::col_as_mat(const uword in_col) const - { - return CubeToMatOp( (*this).get_ref(), in_col ); - } - - - -// -// extra functions defined in BaseCube_eval_Cube - -template -arma_inline -const derived& -BaseCube_eval_Cube::eval() const - { - arma_debug_sigprint(); - - return static_cast(*this); - } - - - -// -// extra functions defined in BaseCube_eval_expr - -template -inline -Cube -BaseCube_eval_expr::eval() const - { - arma_debug_sigprint(); - - return Cube( static_cast(*this) ); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Base_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Base_bones.hpp deleted file mode 100644 index ac947856b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Base_bones.hpp +++ /dev/null @@ -1,167 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup Base -//! @{ - - - -template -struct Base_extra_yes - { - arma_warn_unused inline const Op i() const; //!< matrix inverse - - arma_warn_unused inline bool is_sympd() const; - arma_warn_unused inline bool is_sympd(typename get_pod_type::result tol) const; - }; - - -template -struct Base_extra_no - { - }; - - -template -struct Base_extra {}; - -template -struct Base_extra { typedef Base_extra_yes result; }; - -template -struct Base_extra { typedef Base_extra_no result; }; - - - -template -struct Base_eval_Mat - { - arma_warn_unused arma_inline const derived& eval() const; - }; - - -template -struct Base_eval_expr - { - arma_warn_unused inline Mat eval() const; //!< force the immediate evaluation of a delayed expression - }; - - -template -struct Base_eval {}; - -template -struct Base_eval { typedef Base_eval_Mat result; }; - -template -struct Base_eval { typedef Base_eval_expr result; }; - - - -template -struct Base_trans_cx - { - arma_warn_unused arma_inline const Op t() const; - arma_warn_unused arma_inline const Op ht() const; - arma_warn_unused arma_inline const Op st() const; // simple transpose: no complex conjugates - }; - - -template -struct Base_trans_default - { - arma_warn_unused arma_inline const Op t() const; - arma_warn_unused arma_inline const Op ht() const; - arma_warn_unused arma_inline const Op st() const; // return op_htrans instead of op_strans, as it's handled better by matrix multiplication code - }; - - -template -struct Base_trans {}; - -template -struct Base_trans { typedef Base_trans_cx result; }; - -template -struct Base_trans { typedef Base_trans_default result; }; - - - -//! Class for static polymorphism, modelled after the "Curiously Recurring Template Pattern" (CRTP). -//! Used for type-safe downcasting in functions that restrict their input(s) to be classes that are -//! derived from Base (eg. Mat, Op, Glue, diagview, subview). -//! A Base object can be converted to a Mat object by the unwrap class. - -template -struct Base - : public Base_extra::value>::result - , public Base_eval::value>::result - , public Base_trans::value>::result - { - arma_inline const derived& get_ref() const; - - arma_cold inline void print( const std::string extra_text = "") const; - arma_cold inline void print(std::ostream& user_stream, const std::string extra_text = "") const; - - arma_cold inline void raw_print( const std::string extra_text = "") const; - arma_cold inline void raw_print(std::ostream& user_stream, const std::string extra_text = "") const; - - arma_cold inline void brief_print( const std::string extra_text = "") const; - arma_cold inline void brief_print(std::ostream& user_stream, const std::string extra_text = "") const; - - arma_warn_unused inline elem_type min() const; - arma_warn_unused inline elem_type max() const; - - inline elem_type min(uword& index_of_min_val) const; - inline elem_type max(uword& index_of_max_val) const; - - inline elem_type min(uword& row_of_min_val, uword& col_of_min_val) const; - inline elem_type max(uword& row_of_max_val, uword& col_of_max_val) const; - - arma_warn_unused inline uword index_min() const; - arma_warn_unused inline uword index_max() const; - - arma_warn_unused inline bool is_symmetric() const; - arma_warn_unused inline bool is_symmetric(const typename get_pod_type::result tol) const; - - arma_warn_unused inline bool is_hermitian() const; - arma_warn_unused inline bool is_hermitian(const typename get_pod_type::result tol) const; - - arma_warn_unused inline bool is_zero(const typename get_pod_type::result tol = 0) const; - - arma_warn_unused inline bool is_trimatu() const; - arma_warn_unused inline bool is_trimatl() const; - arma_warn_unused inline bool is_diagmat() const; - arma_warn_unused inline bool is_empty() const; - arma_warn_unused inline bool is_square() const; - arma_warn_unused inline bool is_vec() const; - arma_warn_unused inline bool is_colvec() const; - arma_warn_unused inline bool is_rowvec() const; - arma_warn_unused inline bool is_finite() const; - - arma_warn_unused inline bool has_inf() const; - arma_warn_unused inline bool has_nan() const; - arma_warn_unused inline bool has_nonfinite() const; - - arma_warn_unused inline const Op as_col() const; - arma_warn_unused inline const Op as_row() const; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Base_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Base_meat.hpp deleted file mode 100644 index bc48d363f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Base_meat.hpp +++ /dev/null @@ -1,1031 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup Base -//! @{ - - - -template -arma_inline -const derived& -Base::get_ref() const - { - return static_cast(*this); - } - - - -template -inline -void -Base::print(const std::string extra_text) const - { - arma_debug_sigprint(); - - const quasi_unwrap tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = get_cout_stream().width(); - - get_cout_stream() << extra_text << '\n'; - - get_cout_stream().width(orig_width); - } - - arma_ostream::print(get_cout_stream(), tmp.M, true); - } - - - -template -inline -void -Base::print(std::ostream& user_stream, const std::string extra_text) const - { - arma_debug_sigprint(); - - const quasi_unwrap tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = user_stream.width(); - - user_stream << extra_text << '\n'; - - user_stream.width(orig_width); - } - - arma_ostream::print(user_stream, tmp.M, true); - } - - - -template -inline -void -Base::raw_print(const std::string extra_text) const - { - arma_debug_sigprint(); - - const quasi_unwrap tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = get_cout_stream().width(); - - get_cout_stream() << extra_text << '\n'; - - get_cout_stream().width(orig_width); - } - - arma_ostream::print(get_cout_stream(), tmp.M, false); - } - - - -template -inline -void -Base::raw_print(std::ostream& user_stream, const std::string extra_text) const - { - arma_debug_sigprint(); - - const quasi_unwrap tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = user_stream.width(); - - user_stream << extra_text << '\n'; - - user_stream.width(orig_width); - } - - arma_ostream::print(user_stream, tmp.M, false); - } - - - -template -inline -void -Base::brief_print(const std::string extra_text) const - { - arma_debug_sigprint(); - - const quasi_unwrap tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = get_cout_stream().width(); - - get_cout_stream() << extra_text << '\n'; - - get_cout_stream().width(orig_width); - } - - arma_ostream::brief_print(get_cout_stream(), tmp.M); - } - - - -template -inline -void -Base::brief_print(std::ostream& user_stream, const std::string extra_text) const - { - arma_debug_sigprint(); - - const quasi_unwrap tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = user_stream.width(); - - user_stream << extra_text << '\n'; - - user_stream.width(orig_width); - } - - arma_ostream::brief_print(user_stream, tmp.M); - } - - - -template -inline -elem_type -Base::min() const - { - return op_min::min( (*this).get_ref() ); - } - - - -template -inline -elem_type -Base::max() const - { - return op_max::max( (*this).get_ref() ); - } - - - -template -inline -elem_type -Base::min(uword& index_of_min_val) const - { - const Proxy P( (*this).get_ref() ); - - return op_min::min_with_index(P, index_of_min_val); - } - - - -template -inline -elem_type -Base::max(uword& index_of_max_val) const - { - const Proxy P( (*this).get_ref() ); - - return op_max::max_with_index(P, index_of_max_val); - } - - - -template -inline -elem_type -Base::min(uword& row_of_min_val, uword& col_of_min_val) const - { - const Proxy P( (*this).get_ref() ); - - uword index = 0; - - const elem_type val = op_min::min_with_index(P, index); - - const uword local_n_rows = P.get_n_rows(); - - row_of_min_val = index % local_n_rows; - col_of_min_val = index / local_n_rows; - - return val; - } - - - -template -inline -elem_type -Base::max(uword& row_of_max_val, uword& col_of_max_val) const - { - const Proxy P( (*this).get_ref() ); - - uword index = 0; - - const elem_type val = op_max::max_with_index(P, index); - - const uword local_n_rows = P.get_n_rows(); - - row_of_max_val = index % local_n_rows; - col_of_max_val = index / local_n_rows; - - return val; - } - - - -template -inline -uword -Base::index_min() const - { - const Proxy P( (*this).get_ref() ); - - uword index = 0; - - if(P.get_n_elem() == 0) - { - arma_conform_check(true, "index_min(): object has no elements"); - } - else - { - op_min::min_with_index(P, index); - } - - return index; - } - - - -template -inline -uword -Base::index_max() const - { - const Proxy P( (*this).get_ref() ); - - uword index = 0; - - if(P.get_n_elem() == 0) - { - arma_conform_check(true, "index_max(): object has no elements"); - } - else - { - op_max::max_with_index(P, index); - } - - return index; - } - - - -template -inline -bool -Base::is_symmetric() const - { - arma_debug_sigprint(); - - const quasi_unwrap U( (*this).get_ref() ); - - const Mat& A = U.M; - - if(A.n_rows != A.n_cols) { return false; } - if(A.n_elem <= 1 ) { return true; } - - const uword N = A.n_rows; - const uword Nm1 = N-1; - - const elem_type* A_col = A.memptr(); - - for(uword j=0; j < Nm1; ++j) - { - const uword jp1 = j+1; - - const elem_type* A_row = &(A.at(j,jp1)); - - for(uword i=jp1; i < N; ++i) - { - if(A_col[i] != (*A_row)) { return false; } - - A_row += N; - } - - A_col += N; - } - - return true; - } - - - -template -inline -bool -Base::is_symmetric(const typename get_pod_type::result tol) const - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - if(tol == T(0)) { return (*this).is_symmetric(); } - - arma_conform_check( (tol < T(0)), "is_symmetric(): parameter 'tol' must be >= 0" ); - - const quasi_unwrap U( (*this).get_ref() ); - - const Mat& A = U.M; - - if(A.n_rows != A.n_cols) { return false; } - if(A.n_elem <= 1 ) { return true; } - - const T norm_A = as_scalar( arma::max(sum(abs(A), 1), 0) ); - - if(norm_A == T(0)) { return true; } - - const T norm_A_Ast = as_scalar( arma::max(sum(abs(A - A.st()), 1), 0) ); - - return ( (norm_A_Ast / norm_A) <= tol ); - } - - - -template -inline -bool -Base::is_hermitian() const - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const quasi_unwrap U( (*this).get_ref() ); - - const Mat& A = U.M; - - if(A.n_rows != A.n_cols) { return false; } - if(A.n_elem == 0 ) { return true; } - - const uword N = A.n_rows; - - const elem_type* A_col = A.memptr(); - - for(uword j=0; j < N; ++j) - { - if( access::tmp_imag(A_col[j]) != T(0) ) { return false; } - - A_col += N; - } - - A_col = A.memptr(); - - const uword Nm1 = N-1; - - for(uword j=0; j < Nm1; ++j) - { - const uword jp1 = j+1; - - const elem_type* A_row = &(A.at(j,jp1)); - - for(uword i=jp1; i < N; ++i) - { - if(A_col[i] != access::alt_conj(*A_row)) { return false; } - - A_row += N; - } - - A_col += N; - } - - return true; - } - - - -template -inline -bool -Base::is_hermitian(const typename get_pod_type::result tol) const - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - if(tol == T(0)) { return (*this).is_hermitian(); } - - arma_conform_check( (tol < T(0)), "is_hermitian(): parameter 'tol' must be >= 0" ); - - const quasi_unwrap U( (*this).get_ref() ); - - const Mat& A = U.M; - - if(A.n_rows != A.n_cols) { return false; } - if(A.n_elem == 0 ) { return true; } - - const T norm_A = as_scalar( arma::max(sum(abs(A), 1), 0) ); - - if(norm_A == T(0)) { return true; } - - const T norm_A_At = as_scalar( arma::max(sum(abs(A - A.t()), 1), 0) ); - - return ( (norm_A_At / norm_A) <= tol ); - } - - - -template -inline -bool -Base::is_zero(const typename get_pod_type::result tol) const - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - arma_conform_check( (tol < T(0)), "is_zero(): parameter 'tol' must be >= 0" ); - - if(Proxy::use_at || is_Mat::stored_type>::value) - { - const quasi_unwrap U( (*this).get_ref() ); - - return arrayops::is_zero( U.M.memptr(), U.M.n_elem, tol ); - } - - const Proxy P( (*this).get_ref() ); - - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) { return false; } - - const typename Proxy::ea_type Pea = P.get_ea(); - - if(is_cx::yes) - { - for(uword i=0; i tol) { return false; } - if(eop_aux::arma_abs(val_imag) > tol) { return false; } - } - } - else // not complex - { - for(uword i=0; i tol) { return false; } - } - } - - return true; - } - - - -template -inline -bool -Base::is_trimatu() const - { - arma_debug_sigprint(); - - const quasi_unwrap U( (*this).get_ref() ); - - if(U.M.n_rows != U.M.n_cols) { return false; } - - if(U.M.n_elem <= 1) { return true; } - - return trimat_helper::is_triu(U.M); - } - - - -template -inline -bool -Base::is_trimatl() const - { - arma_debug_sigprint(); - - const quasi_unwrap U( (*this).get_ref() ); - - if(U.M.n_rows != U.M.n_cols) { return false; } - - if(U.M.n_elem <= 1) { return true; } - - return trimat_helper::is_tril(U.M); - } - - - -template -inline -bool -Base::is_diagmat() const - { - arma_debug_sigprint(); - - const quasi_unwrap U( (*this).get_ref() ); - - const Mat& A = U.M; - - if(A.n_elem <= 1) { return true; } - - // NOTE: we're NOT assuming the matrix has a square size - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const elem_type* A_mem = A.memptr(); - - if(A_mem[1] != elem_type(0)) { return false; } - - // if we got to this point, do a thorough check - - for(uword A_col=0; A_col < A_n_cols; ++A_col) - { - for(uword A_row=0; A_row < A_n_rows; ++A_row) - { - if( (A_mem[A_row] != elem_type(0)) && (A_row != A_col) ) { return false; } - } - - A_mem += A_n_rows; - } - - return true; - } - - - -template -inline -bool -Base::is_empty() const - { - arma_debug_sigprint(); - - const Proxy P( (*this).get_ref() ); - - return (P.get_n_elem() == uword(0)); - } - - - -template -inline -bool -Base::is_square() const - { - arma_debug_sigprint(); - - const Proxy P( (*this).get_ref() ); - - return (P.get_n_rows() == P.get_n_cols()); - } - - - -template -inline -bool -Base::is_vec() const - { - arma_debug_sigprint(); - - if( (Proxy::is_row) || (Proxy::is_col) || (Proxy::is_xvec) ) { return true; } - - const Proxy P( (*this).get_ref() ); - - return ( (P.get_n_rows() == uword(1)) || (P.get_n_cols() == uword(1)) ); - } - - - -template -inline -bool -Base::is_colvec() const - { - arma_debug_sigprint(); - - if(Proxy::is_col) { return true; } - - const Proxy P( (*this).get_ref() ); - - return (P.get_n_cols() == uword(1)); - } - - - -template -inline -bool -Base::is_rowvec() const - { - arma_debug_sigprint(); - - if(Proxy::is_row) { return true; } - - const Proxy P( (*this).get_ref() ); - - return (P.get_n_rows() == uword(1)); - } - - - -template -inline -bool -Base::is_finite() const - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "is_finite(): detection of non-finite values is not reliable in fast math mode"); } - - if(is_Mat::stored_type>::value) - { - const quasi_unwrap U( (*this).get_ref() ); - - return arrayops::is_finite( U.M.memptr(), U.M.n_elem ); - } - else - { - const Proxy P( (*this).get_ref() ); - - if(Proxy::use_at == false) - { - const typename Proxy::ea_type Pea = P.get_ea(); - - const uword n_elem = P.get_n_elem(); - - for(uword i=0; i -inline -bool -Base::has_inf() const - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "has_inf(): detection of non-finite values is not reliable in fast math mode"); } - - if(is_Mat::stored_type>::value) - { - const quasi_unwrap U( (*this).get_ref() ); - - return arrayops::has_inf( U.M.memptr(), U.M.n_elem ); - } - else - { - const Proxy P( (*this).get_ref() ); - - if(Proxy::use_at == false) - { - const typename Proxy::ea_type Pea = P.get_ea(); - - const uword n_elem = P.get_n_elem(); - - for(uword i=0; i -inline -bool -Base::has_nan() const - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "has_nan(): detection of non-finite values is not reliable in fast math mode"); } - - if(is_Mat::stored_type>::value) - { - const quasi_unwrap U( (*this).get_ref() ); - - return arrayops::has_nan( U.M.memptr(), U.M.n_elem ); - } - else - { - const Proxy P( (*this).get_ref() ); - - if(Proxy::use_at == false) - { - const typename Proxy::ea_type Pea = P.get_ea(); - - const uword n_elem = P.get_n_elem(); - - for(uword i=0; i -inline -bool -Base::has_nonfinite() const - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "has_nonfinite(): detection of non-finite values is not reliable in fast math mode"); } - - if(is_Mat::stored_type>::value) - { - const quasi_unwrap U( (*this).get_ref() ); - - return (arrayops::is_finite( U.M.memptr(), U.M.n_elem ) == false); - } - else - { - const Proxy P( (*this).get_ref() ); - - if(Proxy::use_at == false) - { - const typename Proxy::ea_type Pea = P.get_ea(); - - const uword n_elem = P.get_n_elem(); - - for(uword i=0; i -inline -const Op -Base::as_col() const - { - return Op( (*this).get_ref() ); - } - - - -template -inline -const Op -Base::as_row() const - { - return Op( (*this).get_ref() ); - } - - - -// -// extra functions defined in Base_extra_yes - -template -inline -const Op -Base_extra_yes::i() const - { - return Op(static_cast(*this)); - } - - - -template -inline -bool -Base_extra_yes::is_sympd() const - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - Mat X = static_cast(*this); - - // default value for tol - const T tol = T(100) * std::numeric_limits::epsilon() * norm(X, "fro"); - - if(X.is_hermitian(tol) == false) { return false; } - - if(X.is_empty()) { return false; } - - X.diag() -= elem_type(tol); - - return auxlib::chol_simple(X); - } - - - -template -inline -bool -Base_extra_yes::is_sympd(typename get_pod_type::result tol) const - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - arma_conform_check( (tol < T(0)), "is_sympd(): parameter 'tol' must be >= 0" ); - - Mat X = static_cast(*this); - - if(X.is_hermitian(tol) == false) { return false; } - - if(X.is_empty()) { return false; } - - X.diag() -= elem_type(tol); - - return auxlib::chol_simple(X); - } - - - -// -// extra functions defined in Base_eval_Mat - -template -arma_inline -const derived& -Base_eval_Mat::eval() const - { - arma_debug_sigprint(); - - return static_cast(*this); - } - - - -// -// extra functions defined in Base_eval_expr - -template -inline -Mat -Base_eval_expr::eval() const - { - arma_debug_sigprint(); - - return Mat( static_cast(*this) ); - } - - - -// -// extra functions defined in Base_trans_cx - -template -arma_inline -const Op -Base_trans_cx::t() const - { - return Op( static_cast(*this) ); - } - - - -template -arma_inline -const Op -Base_trans_cx::ht() const - { - return Op( static_cast(*this) ); - } - - - -template -arma_inline -const Op -Base_trans_cx::st() const - { - return Op( static_cast(*this) ); - } - - - -// -// extra functions defined in Base_trans_default - -template -arma_inline -const Op -Base_trans_default::t() const - { - return Op( static_cast(*this) ); - } - - - -template -arma_inline -const Op -Base_trans_default::ht() const - { - return Op( static_cast(*this) ); - } - - - -template -arma_inline -const Op -Base_trans_default::st() const - { - return Op( static_cast(*this) ); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Col_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Col_bones.hpp deleted file mode 100644 index b3f0ab681..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Col_bones.hpp +++ /dev/null @@ -1,288 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup Col -//! @{ - -//! Class for column vectors (matrices with only one column) - -template -class Col : public Mat - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_col = true; - static constexpr bool is_row = false; - static constexpr bool is_xvec = false; - - inline Col(); - inline Col(const Col& X); - - inline explicit Col(const uword n_elem); - inline explicit Col(const uword in_rows, const uword in_cols); - inline explicit Col(const SizeMat& s); - - template inline explicit Col(const uword n_elem, const arma_initmode_indicator&); - template inline explicit Col(const uword in_rows, const uword in_cols, const arma_initmode_indicator&); - template inline explicit Col(const SizeMat& s, const arma_initmode_indicator&); - - template inline Col(const uword n_elem, const fill::fill_class& f); - template inline Col(const uword in_rows, const uword in_cols, const fill::fill_class& f); - template inline Col(const SizeMat& s, const fill::fill_class& f); - - inline Col(const uword N, const fill::scalar_holder f); - inline Col(const uword in_rows, const uword in_cols, const fill::scalar_holder f); - inline Col(const SizeMat& s, const fill::scalar_holder f); - - inline Col(const char* text); - inline Col& operator=(const char* text); - - inline Col(const std::string& text); - inline Col& operator=(const std::string& text); - - inline Col(const std::vector& x); - inline Col& operator=(const std::vector& x); - - inline Col(const std::initializer_list& list); - inline Col& operator=(const std::initializer_list& list); - - inline Col(Col&& m); - inline Col& operator=(Col&& m); - - // inline Col(Mat&& m); - // inline Col& operator=(Mat&& m); - - inline Col& operator=(const eT val); - inline Col& operator=(const Col& m); - - template inline Col(const Base& X); - template inline Col& operator=(const Base& X); - - template inline explicit Col(const SpBase& X); - template inline Col& operator=(const SpBase& X); - - inline Col( eT* aux_mem, const uword aux_length, const bool copy_aux_mem = true, const bool strict = false); - inline Col(const eT* aux_mem, const uword aux_length); - - template - inline explicit Col(const Base& A, const Base& B); - - template inline Col(const BaseCube& X); - template inline Col& operator=(const BaseCube& X); - - inline Col(const subview_cube& X); - inline Col& operator=(const subview_cube& X); - - arma_frown("use braced initialiser list instead") inline mat_injector operator<<(const eT val); - - arma_warn_unused arma_inline const Op,op_htrans> t() const; - arma_warn_unused arma_inline const Op,op_htrans> ht() const; - arma_warn_unused arma_inline const Op,op_strans> st() const; - - arma_warn_unused arma_inline const Op,op_strans> as_row() const; - - arma_inline subview_col row(const uword row_num); - arma_inline const subview_col row(const uword row_num) const; - - using Mat::rows; - using Mat::operator(); - - arma_inline subview_col rows(const uword in_row1, const uword in_row2); - arma_inline const subview_col rows(const uword in_row1, const uword in_row2) const; - - arma_inline subview_col subvec(const uword in_row1, const uword in_row2); - arma_inline const subview_col subvec(const uword in_row1, const uword in_row2) const; - - arma_inline subview_col rows(const span& row_span); - arma_inline const subview_col rows(const span& row_span) const; - - arma_inline subview_col subvec(const span& row_span); - arma_inline const subview_col subvec(const span& row_span) const; - - arma_inline subview_col operator()(const span& row_span); - arma_inline const subview_col operator()(const span& row_span) const; - - arma_inline subview_col subvec(const uword start_row, const SizeMat& s); - arma_inline const subview_col subvec(const uword start_row, const SizeMat& s) const; - - arma_inline subview_col head(const uword N); - arma_inline const subview_col head(const uword N) const; - - arma_inline subview_col tail(const uword N); - arma_inline const subview_col tail(const uword N) const; - - arma_inline subview_col head_rows(const uword N); - arma_inline const subview_col head_rows(const uword N) const; - - arma_inline subview_col tail_rows(const uword N); - arma_inline const subview_col tail_rows(const uword N) const; - - - inline void shed_row (const uword row_num); - inline void shed_rows(const uword in_row1, const uword in_row2); - - template inline void shed_rows(const Base& indices); - - arma_deprecated inline void insert_rows(const uword row_num, const uword N, const bool set_to_zero); - inline void insert_rows(const uword row_num, const uword N); - - template inline void insert_rows(const uword row_num, const Base& X); - - - arma_warn_unused arma_inline eT& at(const uword i); - arma_warn_unused arma_inline const eT& at(const uword i) const; - - arma_warn_unused arma_inline eT& at(const uword in_row, const uword in_col); - arma_warn_unused arma_inline const eT& at(const uword in_row, const uword in_col) const; - - - typedef eT* row_iterator; - typedef const eT* const_row_iterator; - - inline row_iterator begin_row(const uword row_num); - inline const_row_iterator begin_row(const uword row_num) const; - - inline row_iterator end_row (const uword row_num); - inline const_row_iterator end_row (const uword row_num) const; - - - template class fixed; - - - protected: - - inline Col(const arma_fixed_indicator&, const uword in_n_elem, const eT* in_mem); - - - public: - - #if defined(ARMA_EXTRA_COL_PROTO) - #include ARMA_INCFILE_WRAP(ARMA_EXTRA_COL_PROTO) - #endif - }; - - - -template -template -class Col::fixed : public Col - { - private: - - static constexpr bool use_extra = (fixed_n_elem > arma_config::mat_prealloc); - - arma_align_mem eT mem_local_extra[ (use_extra) ? fixed_n_elem : 1 ]; - - - public: - - typedef fixed Col_fixed_type; - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_col = true; - static constexpr bool is_row = false; - static constexpr bool is_xvec = false; - - static const uword n_rows; // value provided below the class definition - static const uword n_cols; // value provided below the class definition - static const uword n_elem; // value provided below the class definition - - arma_inline fixed(); - arma_inline fixed(const fixed& X); - inline fixed(const subview_cube& X); - - inline fixed(const fill::scalar_holder f); - template inline fixed(const fill::fill_class& f); - template inline fixed(const Base& A); - template inline fixed(const Base& A, const Base& B); - - inline fixed(const eT* aux_mem); - - inline fixed(const char* text); - inline fixed(const std::string& text); - - template inline Col& operator=(const Base& A); - - inline Col& operator=(const eT val); - inline Col& operator=(const char* text); - inline Col& operator=(const std::string& text); - inline Col& operator=(const subview_cube& X); - - using Col::operator(); - - inline fixed(const std::initializer_list& list); - inline Col& operator=(const std::initializer_list& list); - - arma_inline Col& operator=(const fixed& X); - - #if defined(ARMA_GOOD_COMPILER) - template inline Col& operator=(const eOp& X); - template inline Col& operator=(const eGlue& X); - #endif - - arma_warn_unused arma_inline const Op< Col_fixed_type, op_htrans > t() const; - arma_warn_unused arma_inline const Op< Col_fixed_type, op_htrans > ht() const; - arma_warn_unused arma_inline const Op< Col_fixed_type, op_strans > st() const; - - arma_warn_unused arma_inline const eT& at_alt (const uword i) const; - - arma_warn_unused arma_inline eT& operator[] (const uword i); - arma_warn_unused arma_inline const eT& operator[] (const uword i) const; - arma_warn_unused arma_inline eT& at (const uword i); - arma_warn_unused arma_inline const eT& at (const uword i) const; - arma_warn_unused arma_inline eT& operator() (const uword i); - arma_warn_unused arma_inline const eT& operator() (const uword i) const; - - arma_warn_unused arma_inline eT& at (const uword in_row, const uword in_col); - arma_warn_unused arma_inline const eT& at (const uword in_row, const uword in_col) const; - arma_warn_unused arma_inline eT& operator() (const uword in_row, const uword in_col); - arma_warn_unused arma_inline const eT& operator() (const uword in_row, const uword in_col) const; - - arma_warn_unused arma_inline eT* memptr(); - arma_warn_unused arma_inline const eT* memptr() const; - - inline const Col& fill(const eT val); - inline const Col& zeros(); - inline const Col& ones(); - }; - - - -// these definitions are outside of the class due to bizarre C++ rules; -// C++17 has inline variables to address this shortcoming - -template -template -const uword Col::fixed::n_rows = fixed_n_elem; - -template -template -const uword Col::fixed::n_cols = 1u; - -template -template -const uword Col::fixed::n_elem = fixed_n_elem; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Col_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Col_meat.hpp deleted file mode 100644 index bb07f9bb9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Col_meat.hpp +++ /dev/null @@ -1,1891 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup Col -//! @{ - - -//! construct an empty column vector -template -inline -Col::Col() - : Mat(arma_vec_indicator(), 1) - { - arma_debug_sigprint(); - } - - - -template -inline -Col::Col(const Col& X) - : Mat(arma_vec_indicator(), X.n_elem, 1, 1) - { - arma_debug_sigprint(); - - arrayops::copy((*this).memptr(), X.memptr(), X.n_elem); - } - - - -//! construct a column vector with the specified number of n_elem -template -inline -Col::Col(const uword in_n_elem) - : Mat(arma_vec_indicator(), in_n_elem, 1, 1) - { - arma_debug_sigprint(); - - arma_debug_print("Col::constructor: zeroing memory"); - - arrayops::fill_zeros(Mat::memptr(), Mat::n_elem); - } - - - -template -inline -Col::Col(const uword in_n_rows, const uword in_n_cols) - : Mat(arma_vec_indicator(), 0, 0, 1) - { - arma_debug_sigprint(); - - Mat::init_warm(in_n_rows, in_n_cols); - - arma_debug_print("Col::constructor: zeroing memory"); - - arrayops::fill_zeros(Mat::memptr(), Mat::n_elem); - } - - - -template -inline -Col::Col(const SizeMat& s) - : Mat(arma_vec_indicator(), 0, 0, 1) - { - arma_debug_sigprint(); - - Mat::init_warm(s.n_rows, s.n_cols); - - arma_debug_print("Col::constructor: zeroing memory"); - - arrayops::fill_zeros(Mat::memptr(), Mat::n_elem); - } - - - -//! internal use only -template -template -inline -Col::Col(const uword in_n_elem, const arma_initmode_indicator&) - : Mat(arma_vec_indicator(), in_n_elem, 1, 1) - { - arma_debug_sigprint(); - - if(do_zeros) - { - arma_debug_print("Col::constructor: zeroing memory"); - arrayops::fill_zeros(Mat::memptr(), Mat::n_elem); - } - else - { - arma_debug_print("Col::constructor: not zeroing memory"); - } - } - - - -//! internal use only -template -template -inline -Col::Col(const uword in_n_rows, const uword in_n_cols, const arma_initmode_indicator&) - : Mat(arma_vec_indicator(), 0, 0, 1) - { - arma_debug_sigprint(); - - Mat::init_warm(in_n_rows, in_n_cols); - - if(do_zeros) - { - arma_debug_print("Col::constructor: zeroing memory"); - arrayops::fill_zeros(Mat::memptr(), Mat::n_elem); - } - else - { - arma_debug_print("Col::constructor: not zeroing memory"); - } - } - - - -//! internal use only -template -template -inline -Col::Col(const SizeMat& s, const arma_initmode_indicator&) - : Mat(arma_vec_indicator(), 0, 0, 1) - { - arma_debug_sigprint(); - - Mat::init_warm(s.n_rows, s.n_cols); - - if(do_zeros) - { - arma_debug_print("Col::constructor: zeroing memory"); - arrayops::fill_zeros(Mat::memptr(), Mat::n_elem); - } - else - { - arma_debug_print("Col::constructor: not zeroing memory"); - } - } - - - -template -template -inline -Col::Col(const uword in_n_elem, const fill::fill_class& f) - : Mat(arma_vec_indicator(), in_n_elem, 1, 1) - { - arma_debug_sigprint(); - - (*this).fill(f); - } - - - -template -template -inline -Col::Col(const uword in_n_rows, const uword in_n_cols, const fill::fill_class& f) - : Mat(arma_vec_indicator(), 0, 0, 1) - { - arma_debug_sigprint(); - - Mat::init_warm(in_n_rows, in_n_cols); - - (*this).fill(f); - } - - - -template -template -inline -Col::Col(const SizeMat& s, const fill::fill_class& f) - : Mat(arma_vec_indicator(), 0, 0, 1) - { - arma_debug_sigprint(); - - Mat::init_warm(s.n_rows, s.n_cols); - - (*this).fill(f); - } - - - -template -inline -Col::Col(const uword in_n_elem, const fill::scalar_holder f) - : Mat(arma_vec_indicator(), in_n_elem, 1, 1) - { - arma_debug_sigprint(); - - (*this).fill(f.scalar); - } - - - -template -inline -Col::Col(const uword in_n_rows, const uword in_n_cols, const fill::scalar_holder f) - : Mat(arma_vec_indicator(), 0, 0, 1) - { - arma_debug_sigprint(); - - Mat::init_warm(in_n_rows, in_n_cols); - - (*this).fill(f.scalar); - } - - - -template -inline -Col::Col(const SizeMat& s, const fill::scalar_holder f) - : Mat(arma_vec_indicator(), 0, 0, 1) - { - arma_debug_sigprint(); - - Mat::init_warm(s.n_rows, s.n_cols); - - (*this).fill(f.scalar); - } - - - -template -inline -Col::Col(const char* text) - : Mat(arma_vec_indicator(), 1) - { - arma_debug_sigprint(); - - (*this).operator=(text); - } - - - -template -inline -Col& -Col::operator=(const char* text) - { - arma_debug_sigprint(); - - Mat tmp(text); - - arma_conform_check( ((tmp.n_elem > 0) && (tmp.is_vec() == false)), "Mat::init(): requested size is not compatible with column vector layout" ); - - access::rw(tmp.n_rows) = tmp.n_elem; - access::rw(tmp.n_cols) = 1; - - (*this).steal_mem(tmp); - - return *this; - } - - - -template -inline -Col::Col(const std::string& text) - : Mat(arma_vec_indicator(), 1) - { - arma_debug_sigprint(); - - (*this).operator=(text); - } - - - -template -inline -Col& -Col::operator=(const std::string& text) - { - arma_debug_sigprint(); - - Mat tmp(text); - - arma_conform_check( ((tmp.n_elem > 0) && (tmp.is_vec() == false)), "Mat::init(): requested size is not compatible with column vector layout" ); - - access::rw(tmp.n_rows) = tmp.n_elem; - access::rw(tmp.n_cols) = 1; - - (*this).steal_mem(tmp); - - return *this; - } - - - -//! create a column vector from std::vector -template -inline -Col::Col(const std::vector& x) - : Mat(arma_vec_indicator(), uword(x.size()), 1, 1) - { - arma_debug_sigprint_this(this); - - const uword N = uword(x.size()); - - if(N > 0) { arrayops::copy( Mat::memptr(), &(x[0]), N ); } - } - - - -//! create a column vector from std::vector -template -inline -Col& -Col::operator=(const std::vector& x) - { - arma_debug_sigprint(); - - const uword N = uword(x.size()); - - Mat::init_warm(N, 1); - - if(N > 0) { arrayops::copy( Mat::memptr(), &(x[0]), N ); } - - return *this; - } - - - -template -inline -Col::Col(const std::initializer_list& list) - : Mat(arma_vec_indicator(), uword(list.size()), 1, 1) - { - arma_debug_sigprint_this(this); - - const uword N = uword(list.size()); - - if(N > 0) { arrayops::copy( Mat::memptr(), list.begin(), N ); } - } - - - -template -inline -Col& -Col::operator=(const std::initializer_list& list) - { - arma_debug_sigprint(); - - const uword N = uword(list.size()); - - Mat::init_warm(N, 1); - - if(N > 0) { arrayops::copy( Mat::memptr(), list.begin(), N ); } - - return *this; - } - - - -template -inline -Col::Col(Col&& X) - : Mat(arma_vec_indicator(), 1) - { - arma_debug_sigprint(arma_str::format("this: %x; X: %x") % this % &X); - - access::rw(Mat::n_rows) = X.n_rows; - access::rw(Mat::n_cols) = 1; - access::rw(Mat::n_elem) = X.n_elem; - access::rw(Mat::n_alloc) = X.n_alloc; - - if( (X.n_alloc > arma_config::mat_prealloc) || (X.mem_state == 1) || (X.mem_state == 2) ) - { - access::rw(Mat::mem_state) = X.mem_state; - access::rw(Mat::mem) = X.mem; - - access::rw(X.n_rows) = 0; - access::rw(X.n_cols) = 1; - access::rw(X.n_elem) = 0; - access::rw(X.n_alloc) = 0; - access::rw(X.mem_state) = 0; - access::rw(X.mem) = nullptr; - } - else // condition: (X.n_alloc <= arma_config::mat_prealloc) || (X.mem_state == 0) || (X.mem_state == 3) - { - (*this).init_cold(); - - arrayops::copy( (*this).memptr(), X.mem, X.n_elem ); - - if( (X.mem_state == 0) && (X.n_alloc <= arma_config::mat_prealloc) ) - { - access::rw(X.n_rows) = 0; - access::rw(X.n_cols) = 1; - access::rw(X.n_elem) = 0; - access::rw(X.mem) = nullptr; - } - } - } - - - -template -inline -Col& -Col::operator=(Col&& X) - { - arma_debug_sigprint(arma_str::format("this: %x; X: %x") % this % &X); - - (*this).steal_mem(X, true); - - return *this; - } - - - -// template -// inline -// Col::Col(Mat&& X) -// : Mat(arma_vec_indicator(), 1) -// { -// arma_debug_sigprint(arma_str::format("this: %x; X: %x") % this % &X); -// -// if(X.n_cols != 1) { const Mat& XX = X; Mat::operator=(XX); return; } -// -// access::rw(Mat::n_rows) = X.n_rows; -// access::rw(Mat::n_cols) = 1; -// access::rw(Mat::n_elem) = X.n_elem; -// access::rw(Mat::n_alloc) = X.n_alloc; -// -// if( (X.n_alloc > arma_config::mat_prealloc) || (X.mem_state == 1) || (X.mem_state == 2) ) -// { -// access::rw(Mat::mem_state) = X.mem_state; -// access::rw(Mat::mem) = X.mem; -// -// access::rw(X.n_rows) = 0; -// access::rw(X.n_elem) = 0; -// access::rw(X.n_alloc) = 0; -// access::rw(X.mem_state) = 0; -// access::rw(X.mem) = nullptr; -// } -// else // condition: (X.n_alloc <= arma_config::mat_prealloc) || (X.mem_state == 0) || (X.mem_state == 3) -// { -// (*this).init_cold(); -// -// arrayops::copy( (*this).memptr(), X.mem, X.n_elem ); -// -// if( (X.mem_state == 0) && (X.n_alloc <= arma_config::mat_prealloc) ) -// { -// access::rw(X.n_rows) = 0; -// access::rw(X.n_elem) = 0; -// access::rw(X.mem) = nullptr; -// } -// } -// } -// -// -// -// template -// inline -// Col& -// Col::operator=(Mat&& X) -// { -// arma_debug_sigprint(arma_str::format("this: %x; X: %x") % this % &X); -// -// if(X.n_cols != 1) { const Mat& XX = X; Mat::operator=(XX); return *this; } -// -// (*this).steal_mem(X, true); -// -// return *this; -// } - - - -template -inline -Col& -Col::operator=(const eT val) - { - arma_debug_sigprint(); - - Mat::operator=(val); - - return *this; - } - - - -template -inline -Col& -Col::operator=(const Col& X) - { - arma_debug_sigprint(); - - Mat::operator=(X); - - return *this; - } - - - -template -template -inline -Col::Col(const Base& X) - : Mat(arma_vec_indicator(), 1) - { - arma_debug_sigprint(); - - Mat::operator=(X.get_ref()); - } - - - -template -template -inline -Col& -Col::operator=(const Base& X) - { - arma_debug_sigprint(); - - Mat::operator=(X.get_ref()); - - return *this; - } - - - -template -template -inline -Col::Col(const SpBase& X) - : Mat(arma_vec_indicator(), 1) - { - arma_debug_sigprint_this(this); - - Mat::operator=(X.get_ref()); - } - - - -template -template -inline -Col& -Col::operator=(const SpBase& X) - { - arma_debug_sigprint(); - - Mat::operator=(X.get_ref()); - - return *this; - } - - - -//! construct a column vector from a given auxiliary array of eTs -template -inline -Col::Col(eT* aux_mem, const uword aux_length, const bool copy_aux_mem, const bool strict) - : Mat(aux_mem, aux_length, 1, copy_aux_mem, strict) - { - arma_debug_sigprint(); - - access::rw(Mat::vec_state) = 1; - } - - - -//! construct a column vector from a given auxiliary array of eTs -template -inline -Col::Col(const eT* aux_mem, const uword aux_length) - : Mat(aux_mem, aux_length, 1) - { - arma_debug_sigprint(); - - access::rw(Mat::vec_state) = 1; - } - - - -template -template -inline -Col::Col - ( - const Base::pod_type, T1>& A, - const Base::pod_type, T2>& B - ) - { - arma_debug_sigprint(); - - access::rw(Mat::vec_state) = 1; - - Mat::init(A,B); - } - - - -template -template -inline -Col::Col(const BaseCube& X) - { - arma_debug_sigprint(); - - access::rw(Mat::vec_state) = 1; - - Mat::operator=(X); - } - - - -template -template -inline -Col& -Col::operator=(const BaseCube& X) - { - arma_debug_sigprint(); - - Mat::operator=(X); - - return *this; - } - - - -template -inline -Col::Col(const subview_cube& X) - { - arma_debug_sigprint(); - - access::rw(Mat::vec_state) = 1; - - Mat::operator=(X); - } - - - -template -inline -Col& -Col::operator=(const subview_cube& X) - { - arma_debug_sigprint(); - - Mat::operator=(X); - - return *this; - } - - - -template -inline -mat_injector< Col > -Col::operator<<(const eT val) - { - return mat_injector< Col >(*this, val); - } - - - -template -arma_inline -const Op,op_htrans> -Col::t() const - { - return Op,op_htrans>(*this); - } - - - -template -arma_inline -const Op,op_htrans> -Col::ht() const - { - return Op,op_htrans>(*this); - } - - - -template -arma_inline -const Op,op_strans> -Col::st() const - { - return Op,op_strans>(*this); - } - - - -template -arma_inline -const Op,op_strans> -Col::as_row() const - { - return Op,op_strans>(*this); - } - - - -template -arma_inline -subview_col -Col::row(const uword in_row1) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (in_row1 >= Mat::n_rows), "Col::row(): indices out of bounds or incorrectly used" ); - - return subview_col(*this, 0, in_row1, 1); - } - - - -template -arma_inline -const subview_col -Col::row(const uword in_row1) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (in_row1 >= Mat::n_rows), "Col::row(): indices out of bounds or incorrectly used" ); - - return subview_col(*this, 0, in_row1, 1); - } - - - -template -arma_inline -subview_col -Col::rows(const uword in_row1, const uword in_row2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( ( (in_row1 > in_row2) || (in_row2 >= Mat::n_rows) ), "Col::rows(): indices out of bounds or incorrectly used" ); - - const uword subview_n_rows = in_row2 - in_row1 + 1; - - return subview_col(*this, 0, in_row1, subview_n_rows); - } - - - -template -arma_inline -const subview_col -Col::rows(const uword in_row1, const uword in_row2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( ( (in_row1 > in_row2) || (in_row2 >= Mat::n_rows) ), "Col::rows(): indices out of bounds or incorrectly used" ); - - const uword subview_n_rows = in_row2 - in_row1 + 1; - - return subview_col(*this, 0, in_row1, subview_n_rows); - } - - - -template -arma_inline -subview_col -Col::subvec(const uword in_row1, const uword in_row2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( ( (in_row1 > in_row2) || (in_row2 >= Mat::n_rows) ), "Col::subvec(): indices out of bounds or incorrectly used" ); - - const uword subview_n_rows = in_row2 - in_row1 + 1; - - return subview_col(*this, 0, in_row1, subview_n_rows); - } - - - -template -arma_inline -const subview_col -Col::subvec(const uword in_row1, const uword in_row2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( ( (in_row1 > in_row2) || (in_row2 >= Mat::n_rows) ), "Col::subvec(): indices out of bounds or incorrectly used" ); - - const uword subview_n_rows = in_row2 - in_row1 + 1; - - return subview_col(*this, 0, in_row1, subview_n_rows); - } - - - -template -arma_inline -subview_col -Col::rows(const span& row_span) - { - arma_debug_sigprint(); - - return subvec(row_span); - } - - - -template -arma_inline -const subview_col -Col::rows(const span& row_span) const - { - arma_debug_sigprint(); - - return subvec(row_span); - } - - - -template -arma_inline -subview_col -Col::subvec(const span& row_span) - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - - const uword local_n_rows = Mat::n_rows; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword subvec_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - arma_conform_check_bounds( ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ), "Col::subvec(): indices out of bounds or incorrectly used" ); - - return subview_col(*this, 0, in_row1, subvec_n_rows); - } - - - -template -arma_inline -const subview_col -Col::subvec(const span& row_span) const - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - - const uword local_n_rows = Mat::n_rows; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword subvec_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - arma_conform_check_bounds( ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ), "Col::subvec(): indices out of bounds or incorrectly used" ); - - return subview_col(*this, 0, in_row1, subvec_n_rows); - } - - - -template -arma_inline -subview_col -Col::operator()(const span& row_span) - { - arma_debug_sigprint(); - - return subvec(row_span); - } - - - -template -arma_inline -const subview_col -Col::operator()(const span& row_span) const - { - arma_debug_sigprint(); - - return subvec(row_span); - } - - - -template -arma_inline -subview_col -Col::subvec(const uword start_row, const SizeMat& s) - { - arma_debug_sigprint(); - - arma_conform_check( (s.n_cols != 1), "Col::subvec(): given size does not specify a column vector" ); - - arma_conform_check_bounds( ( (start_row >= Mat::n_rows) || ((start_row + s.n_rows) > Mat::n_rows) ), "Col::subvec(): size out of bounds" ); - - return subview_col(*this, 0, start_row, s.n_rows); - } - - - -template -arma_inline -const subview_col -Col::subvec(const uword start_row, const SizeMat& s) const - { - arma_debug_sigprint(); - - arma_conform_check( (s.n_cols != 1), "Col::subvec(): given size does not specify a column vector" ); - - arma_conform_check_bounds( ( (start_row >= Mat::n_rows) || ((start_row + s.n_rows) > Mat::n_rows) ), "Col::subvec(): size out of bounds" ); - - return subview_col(*this, 0, start_row, s.n_rows); - } - - - -template -arma_inline -subview_col -Col::head(const uword N) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > Mat::n_rows), "Col::head(): size out of bounds" ); - - return subview_col(*this, 0, 0, N); - } - - - -template -arma_inline -const subview_col -Col::head(const uword N) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > Mat::n_rows), "Col::head(): size out of bounds" ); - - return subview_col(*this, 0, 0, N); - } - - - -template -arma_inline -subview_col -Col::tail(const uword N) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > Mat::n_rows), "Col::tail(): size out of bounds" ); - - const uword start_row = Mat::n_rows - N; - - return subview_col(*this, 0, start_row, N); - } - - - -template -arma_inline -const subview_col -Col::tail(const uword N) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > Mat::n_rows), "Col::tail(): size out of bounds" ); - - const uword start_row = Mat::n_rows - N; - - return subview_col(*this, 0, start_row, N); - } - - - -template -arma_inline -subview_col -Col::head_rows(const uword N) - { - arma_debug_sigprint(); - - return (*this).head(N); - } - - - -template -arma_inline -const subview_col -Col::head_rows(const uword N) const - { - arma_debug_sigprint(); - - return (*this).head(N); - } - - - -template -arma_inline -subview_col -Col::tail_rows(const uword N) - { - arma_debug_sigprint(); - - return (*this).tail(N); - } - - - -template -arma_inline -const subview_col -Col::tail_rows(const uword N) const - { - arma_debug_sigprint(); - - return (*this).tail(N); - } - - - -//! remove specified row -template -inline -void -Col::shed_row(const uword row_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( row_num >= Mat::n_rows, "Col::shed_row(): index out of bounds" ); - - shed_rows(row_num, row_num); - } - - - -//! remove specified rows -template -inline -void -Col::shed_rows(const uword in_row1, const uword in_row2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_row2 >= Mat::n_rows), - "Col::shed_rows(): indices out of bounds or incorrectly used" - ); - - const uword n_keep_front = in_row1; - const uword n_keep_back = Mat::n_rows - (in_row2 + 1); - - Col X(n_keep_front + n_keep_back, arma_nozeros_indicator()); - - eT* X_mem = X.memptr(); - const eT* t_mem = (*this).memptr(); - - if(n_keep_front > 0) - { - arrayops::copy( X_mem, t_mem, n_keep_front ); - } - - if(n_keep_back > 0) - { - arrayops::copy( &(X_mem[n_keep_front]), &(t_mem[in_row2+1]), n_keep_back); - } - - Mat::steal_mem(X); - } - - - -//! remove specified rows -template -template -inline -void -Col::shed_rows(const Base& indices) - { - arma_debug_sigprint(); - - Mat::shed_rows(indices); - } - - - -template -inline -void -Col::insert_rows(const uword row_num, const uword N, const bool set_to_zero) - { - arma_debug_sigprint(); - - arma_ignore(set_to_zero); - - (*this).insert_rows(row_num, N); - } - - - -template -inline -void -Col::insert_rows(const uword row_num, const uword N) - { - arma_debug_sigprint(); - - const uword t_n_rows = Mat::n_rows; - - const uword A_n_rows = row_num; - const uword B_n_rows = t_n_rows - row_num; - - // insertion at row_num == n_rows is in effect an append operation - arma_conform_check_bounds( (row_num > t_n_rows), "Col::insert_rows(): index out of bounds" ); - - if(N == 0) { return; } - - Col out(t_n_rows + N, arma_nozeros_indicator()); - - eT* out_mem = out.memptr(); - const eT* t_mem = (*this).memptr(); - - if(A_n_rows > 0) - { - arrayops::copy( out_mem, t_mem, A_n_rows ); - } - - if(B_n_rows > 0) - { - arrayops::copy( &(out_mem[row_num + N]), &(t_mem[row_num]), B_n_rows ); - } - - arrayops::fill_zeros( &(out_mem[row_num]), N ); - - Mat::steal_mem(out); - } - - - -//! insert the given object at the specified row position; -//! the given object must have one column -template -template -inline -void -Col::insert_rows(const uword row_num, const Base& X) - { - arma_debug_sigprint(); - - Mat::insert_rows(row_num, X); - } - - - -template -arma_inline -eT& -Col::at(const uword i) - { - return access::rw(Mat::mem[i]); - } - - - -template -arma_inline -const eT& -Col::at(const uword i) const - { - return Mat::mem[i]; - } - - - -template -arma_inline -eT& -Col::at(const uword in_row, const uword) - { - return access::rw( Mat::mem[in_row] ); - } - - - -template -arma_inline -const eT& -Col::at(const uword in_row, const uword) const - { - return Mat::mem[in_row]; - } - - - -template -inline -typename Col::row_iterator -Col::begin_row(const uword row_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (row_num >= Mat::n_rows), "Col::begin_row(): index out of bounds" ); - - return Mat::memptr() + row_num; - } - - - -template -inline -typename Col::const_row_iterator -Col::begin_row(const uword row_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (row_num >= Mat::n_rows), "Col::begin_row(): index out of bounds" ); - - return Mat::memptr() + row_num; - } - - - -template -inline -typename Col::row_iterator -Col::end_row(const uword row_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (row_num >= Mat::n_rows), "Col::end_row(): index out of bounds" ); - - return Mat::memptr() + row_num + 1; - } - - - -template -inline -typename Col::const_row_iterator -Col::end_row(const uword row_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (row_num >= Mat::n_rows), "Col::end_row(): index out of bounds" ); - - return Mat::memptr() + row_num + 1; - } - - - -template -template -arma_inline -Col::fixed::fixed() - : Col( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - arma_debug_print("Col::fixed::constructor: zeroing memory"); - - eT* mem_use = (use_extra) ? &(mem_local_extra[0]) : &(Mat::mem_local[0]); - - arrayops::inplace_set_fixed( mem_use, eT(0) ); - } - - - -template -template -arma_inline -Col::fixed::fixed(const fixed& X) - : Col( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - eT* dest = (use_extra) ? mem_local_extra : Mat::mem_local; - const eT* src = (use_extra) ? X.mem_local_extra : X.mem_local; - - arrayops::copy( dest, src, fixed_n_elem ); - } - - - -template -template -arma_inline -Col::fixed::fixed(const subview_cube& X) - : Col( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - Col::operator=(X); - } - - - -template -template -inline -Col::fixed::fixed(const fill::scalar_holder f) - : Col( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - (*this).fill(f.scalar); - } - - - -template -template -template -inline -Col::fixed::fixed(const fill::fill_class&) - : Col( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - if(is_same_type::yes) { (*this).zeros(); } - if(is_same_type::yes) { (*this).ones(); } - if(is_same_type::yes) { (*this).eye(); } - if(is_same_type::yes) { (*this).randu(); } - if(is_same_type::yes) { (*this).randn(); } - } - - - -template -template -template -arma_inline -Col::fixed::fixed(const Base& A) - : Col( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - Col::operator=(A.get_ref()); - } - - - -template -template -template -arma_inline -Col::fixed::fixed(const Base& A, const Base& B) - : Col( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - Col::init(A,B); - } - - - -template -template -inline -Col::fixed::fixed(const eT* aux_mem) - : Col( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - eT* dest = (use_extra) ? mem_local_extra : Mat::mem_local; - - arrayops::copy( dest, aux_mem, fixed_n_elem ); - } - - - -template -template -inline -Col::fixed::fixed(const char* text) - : Col( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - Col::operator=(text); - } - - - -template -template -inline -Col::fixed::fixed(const std::string& text) - : Col( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - Col::operator=(text); - } - - - -template -template -template -Col& -Col::fixed::operator=(const Base& A) - { - arma_debug_sigprint(); - - Col::operator=(A.get_ref()); - - return *this; - } - - - -template -template -Col& -Col::fixed::operator=(const eT val) - { - arma_debug_sigprint(); - - Col::operator=(val); - - return *this; - } - - - -template -template -Col& -Col::fixed::operator=(const char* text) - { - arma_debug_sigprint(); - - Col::operator=(text); - - return *this; - } - - - -template -template -Col& -Col::fixed::operator=(const std::string& text) - { - arma_debug_sigprint(); - - Col::operator=(text); - - return *this; - } - - - -template -template -Col& -Col::fixed::operator=(const subview_cube& X) - { - arma_debug_sigprint(); - - Col::operator=(X); - - return *this; - } - - - -template -template -inline -Col::fixed::fixed(const std::initializer_list& list) - : Col( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - (*this).operator=(list); - } - - - -template -template -inline -Col& -Col::fixed::operator=(const std::initializer_list& list) - { - arma_debug_sigprint(); - - const uword N = uword(list.size()); - - arma_conform_check( (N > fixed_n_elem), "Col::fixed: initialiser list is too long" ); - - eT* this_mem = (*this).memptr(); - - arrayops::copy( this_mem, list.begin(), N ); - - for(uword iq=N; iq < fixed_n_elem; ++iq) { this_mem[iq] = eT(0); } - - return *this; - } - - - -template -template -arma_inline -Col& -Col::fixed::operator=(const fixed& X) - { - arma_debug_sigprint(); - - if(this != &X) - { - eT* dest = (use_extra) ? mem_local_extra : Mat::mem_local; - const eT* src = (use_extra) ? X.mem_local_extra : X.mem_local; - - arrayops::copy( dest, src, fixed_n_elem ); - } - - return *this; - } - - - -#if defined(ARMA_GOOD_COMPILER) - - template - template - template - inline - Col& - Col::fixed::operator=(const eOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const bool bad_alias = (eOp::proxy_type::has_subview && X.P.is_alias(*this)); - - if(bad_alias == false) - { - arma_conform_assert_same_size(fixed_n_elem, uword(1), X.get_n_rows(), X.get_n_cols(), "Col::fixed::operator="); - - eop_type::apply(*this, X); - } - else - { - arma_debug_print("bad_alias = true"); - - Col tmp(X); - - (*this) = tmp; - } - - return *this; - } - - - - template - template - template - inline - Col& - Col::fixed::operator=(const eGlue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const bool bad_alias = - ( - (eGlue::proxy1_type::has_subview && X.P1.is_alias(*this)) - || - (eGlue::proxy2_type::has_subview && X.P2.is_alias(*this)) - ); - - if(bad_alias == false) - { - arma_conform_assert_same_size(fixed_n_elem, uword(1), X.get_n_rows(), X.get_n_cols(), "Col::fixed::operator="); - - eglue_type::apply(*this, X); - } - else - { - arma_debug_print("bad_alias = true"); - - Col tmp(X); - - (*this) = tmp; - } - - return *this; - } - -#endif - - - -template -template -arma_inline -const Op< typename Col::template fixed::Col_fixed_type, op_htrans > -Col::fixed::t() const - { - return Op< typename Col::template fixed::Col_fixed_type, op_htrans >(*this); - } - - - -template -template -arma_inline -const Op< typename Col::template fixed::Col_fixed_type, op_htrans > -Col::fixed::ht() const - { - return Op< typename Col::template fixed::Col_fixed_type, op_htrans >(*this); - } - - - -template -template -arma_inline -const Op< typename Col::template fixed::Col_fixed_type, op_strans > -Col::fixed::st() const - { - return Op< typename Col::template fixed::Col_fixed_type, op_strans >(*this); - } - - - -template -template -arma_inline -const eT& -Col::fixed::at_alt(const uword ii) const - { - #if defined(ARMA_HAVE_ALIGNED_ATTRIBUTE) - - return (use_extra) ? mem_local_extra[ii] : Mat::mem_local[ii]; - - #else - const eT* mem_aligned = (use_extra) ? mem_local_extra : Mat::mem_local; - - memory::mark_as_aligned(mem_aligned); - - return mem_aligned[ii]; - #endif - } - - - -template -template -arma_inline -eT& -Col::fixed::operator[] (const uword ii) - { - return (use_extra) ? mem_local_extra[ii] : Mat::mem_local[ii]; - } - - - -template -template -arma_inline -const eT& -Col::fixed::operator[] (const uword ii) const - { - return (use_extra) ? mem_local_extra[ii] : Mat::mem_local[ii]; - } - - - -template -template -arma_inline -eT& -Col::fixed::at(const uword ii) - { - return (use_extra) ? mem_local_extra[ii] : Mat::mem_local[ii]; - } - - - -template -template -arma_inline -const eT& -Col::fixed::at(const uword ii) const - { - return (use_extra) ? mem_local_extra[ii] : Mat::mem_local[ii]; - } - - - -template -template -arma_inline -eT& -Col::fixed::operator() (const uword ii) - { - arma_conform_check_bounds( (ii >= fixed_n_elem), "Col::operator(): index out of bounds" ); - - return (use_extra) ? mem_local_extra[ii] : Mat::mem_local[ii]; - } - - - -template -template -arma_inline -const eT& -Col::fixed::operator() (const uword ii) const - { - arma_conform_check_bounds( (ii >= fixed_n_elem), "Col::operator(): index out of bounds" ); - - return (use_extra) ? mem_local_extra[ii] : Mat::mem_local[ii]; - } - - - -template -template -arma_inline -eT& -Col::fixed::at(const uword in_row, const uword) - { - return (use_extra) ? mem_local_extra[in_row] : Mat::mem_local[in_row]; - } - - - -template -template -arma_inline -const eT& -Col::fixed::at(const uword in_row, const uword) const - { - return (use_extra) ? mem_local_extra[in_row] : Mat::mem_local[in_row]; - } - - - -template -template -arma_inline -eT& -Col::fixed::operator() (const uword in_row, const uword in_col) - { - arma_conform_check_bounds( ((in_row >= fixed_n_elem) || (in_col > 0)), "Col::operator(): index out of bounds" ); - - return (use_extra) ? mem_local_extra[in_row] : Mat::mem_local[in_row]; - } - - - -template -template -arma_inline -const eT& -Col::fixed::operator() (const uword in_row, const uword in_col) const - { - arma_conform_check_bounds( ((in_row >= fixed_n_elem) || (in_col > 0)), "Col::operator(): index out of bounds" ); - - return (use_extra) ? mem_local_extra[in_row] : Mat::mem_local[in_row]; - } - - - -template -template -arma_inline -eT* -Col::fixed::memptr() - { - return (use_extra) ? mem_local_extra : Mat::mem_local; - } - - - -template -template -arma_inline -const eT* -Col::fixed::memptr() const - { - return (use_extra) ? mem_local_extra : Mat::mem_local; - } - - - -template -template -inline -const Col& -Col::fixed::fill(const eT val) - { - arma_debug_sigprint(); - - eT* mem_use = (use_extra) ? &(mem_local_extra[0]) : &(Mat::mem_local[0]); - - arrayops::inplace_set_fixed( mem_use, val ); - - return *this; - } - - - -template -template -inline -const Col& -Col::fixed::zeros() - { - arma_debug_sigprint(); - - eT* mem_use = (use_extra) ? &(mem_local_extra[0]) : &(Mat::mem_local[0]); - - arrayops::inplace_set_fixed( mem_use, eT(0) ); - - return *this; - } - - - -template -template -inline -const Col& -Col::fixed::ones() - { - arma_debug_sigprint(); - - eT* mem_use = (use_extra) ? &(mem_local_extra[0]) : &(Mat::mem_local[0]); - - arrayops::inplace_set_fixed( mem_use, eT(1) ); - - return *this; - } - - - -template -inline -Col::Col(const arma_fixed_indicator&, const uword in_n_elem, const eT* in_mem) - : Mat(arma_fixed_indicator(), in_n_elem, 1, 1, in_mem) - { - arma_debug_sigprint_this(this); - } - - - -#if defined(ARMA_EXTRA_COL_MEAT) - #include ARMA_INCFILE_WRAP(ARMA_EXTRA_COL_MEAT) -#endif - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/CubeToMatOp_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/CubeToMatOp_bones.hpp deleted file mode 100644 index cd2ba5997..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/CubeToMatOp_bones.hpp +++ /dev/null @@ -1,46 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup CubeToMatOp -//! @{ - - - -template -class CubeToMatOp : public Base< typename T1::elem_type, CubeToMatOp > - { - public: - - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - - inline explicit CubeToMatOp(const T1& in_m); - inline CubeToMatOp(const T1& in_m, const uword in_aux_uword); - inline ~CubeToMatOp(); - - arma_aligned const T1& m; //!< the operand; must be derived from BaseCube - arma_aligned uword aux_uword; //!< auxiliary data, uword format - - static constexpr bool is_row = op_type::template traits::is_row; - static constexpr bool is_col = op_type::template traits::is_col; - static constexpr bool is_xvec = op_type::template traits::is_xvec; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/CubeToMatOp_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/CubeToMatOp_meat.hpp deleted file mode 100644 index d02b686c9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/CubeToMatOp_meat.hpp +++ /dev/null @@ -1,54 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup CubeToMatOp -//! @{ - - - -template -inline -CubeToMatOp::CubeToMatOp(const T1& in_m) - : m(in_m) - { - arma_debug_sigprint(); - } - - - -template -inline -CubeToMatOp::CubeToMatOp(const T1& in_m, const uword in_aux_uword) - : m(in_m) - , aux_uword(in_aux_uword) - { - arma_debug_sigprint(); - } - - - -template -inline -CubeToMatOp::~CubeToMatOp() - { - arma_debug_sigprint(); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Cube_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Cube_bones.hpp deleted file mode 100644 index 91449e185..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Cube_bones.hpp +++ /dev/null @@ -1,564 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup Cube -//! @{ - - - -struct Cube_prealloc - { - static constexpr uword mat_ptrs_size = 4; - static constexpr uword mem_n_elem = 64; - }; - - - -//! Dense cube class - -template -class Cube : public BaseCube< eT, Cube > - { - public: - - typedef eT elem_type; //!< the type of elements stored in the cube - typedef typename get_pod_type::result pod_type; //!< if eT is std::complex, pod_type is T; otherwise pod_type is eT - - const uword n_rows; //!< number of rows in each slice (read-only) - const uword n_cols; //!< number of columns in each slice (read-only) - const uword n_elem_slice; //!< number of elements in each slice (read-only) - const uword n_slices; //!< number of slices in the cube (read-only) - const uword n_elem; //!< number of elements in the cube (read-only) - const uword n_alloc; //!< number of allocated elements (read-only); NOTE: n_alloc can be 0, even if n_elem > 0 - const uword mem_state; - - // mem_state = 0: normal cube which manages its own memory - // mem_state = 1: use auxiliary memory until a size change - // mem_state = 2: use auxiliary memory and don't allow the number of elements to be changed - // mem_state = 3: fixed size (eg. via template based size specification) - - arma_aligned const eT* const mem; //!< pointer to the memory used for storing elements (memory is read-only) - - - protected: - - using mat_type = Mat; - - #if defined(ARMA_USE_OPENMP) - using raw_mat_ptr_type = mat_type*; - using atomic_mat_ptr_type = mat_type*; - #elif defined(ARMA_USE_STD_MUTEX) - using raw_mat_ptr_type = mat_type*; - using atomic_mat_ptr_type = std::atomic; - #else - using raw_mat_ptr_type = mat_type*; - using atomic_mat_ptr_type = mat_type*; - #endif - - atomic_mat_ptr_type* mat_ptrs = nullptr; - - #if defined(ARMA_USE_STD_MUTEX) - mutable std::mutex mat_mutex; // required for slice() - #endif - - arma_aligned atomic_mat_ptr_type mat_ptrs_local[ Cube_prealloc::mat_ptrs_size ]; - arma_align_mem eT mem_local[ Cube_prealloc::mem_n_elem ]; // local storage, for small cubes - - - public: - - inline ~Cube(); - inline Cube(); - - inline explicit Cube(const uword in_n_rows, const uword in_n_cols, const uword in_n_slices); - inline explicit Cube(const SizeCube& s); - - template inline explicit Cube(const uword in_n_rows, const uword in_n_cols, const uword in_n_slices, const arma_initmode_indicator&); - template inline explicit Cube(const SizeCube& s, const arma_initmode_indicator&); - - template inline Cube(const uword in_n_rows, const uword in_n_cols, const uword in_n_slices, const fill::fill_class& f); - template inline Cube(const SizeCube& s, const fill::fill_class& f); - - inline Cube(const uword in_rows, const uword in_cols, const uword in_slices, const fill::scalar_holder f); - inline Cube(const SizeCube& s, const fill::scalar_holder f); - - inline Cube(Cube&& m); - inline Cube& operator=(Cube&& m); - - inline Cube( eT* aux_mem, const uword aux_n_rows, const uword aux_n_cols, const uword aux_n_slices, const bool copy_aux_mem = true, const bool strict = false, const bool prealloc_mat = false); - inline Cube(const eT* aux_mem, const uword aux_n_rows, const uword aux_n_cols, const uword aux_n_slices); - - inline Cube& operator= (const eT val); - inline Cube& operator+=(const eT val); - inline Cube& operator-=(const eT val); - inline Cube& operator*=(const eT val); - inline Cube& operator/=(const eT val); - - inline Cube(const Cube& m); - inline Cube& operator= (const Cube& m); - inline Cube& operator+=(const Cube& m); - inline Cube& operator-=(const Cube& m); - inline Cube& operator%=(const Cube& m); - inline Cube& operator/=(const Cube& m); - - template - inline explicit Cube(const BaseCube& A, const BaseCube& B); - - inline Cube(const subview_cube& X); - inline Cube& operator= (const subview_cube& X); - inline Cube& operator+=(const subview_cube& X); - inline Cube& operator-=(const subview_cube& X); - inline Cube& operator%=(const subview_cube& X); - inline Cube& operator/=(const subview_cube& X); - - template inline Cube(const subview_cube_slices& X); - template inline Cube& operator= (const subview_cube_slices& X); - template inline Cube& operator+=(const subview_cube_slices& X); - template inline Cube& operator-=(const subview_cube_slices& X); - template inline Cube& operator%=(const subview_cube_slices& X); - template inline Cube& operator/=(const subview_cube_slices& X); - - arma_inline subview_cube row(const uword in_row); - arma_inline const subview_cube row(const uword in_row) const; - - arma_inline subview_cube col(const uword in_col); - arma_inline const subview_cube col(const uword in_col) const; - - inline Mat& slice(const uword in_slice); - inline const Mat& slice(const uword in_slice) const; - - arma_inline subview_cube rows(const uword in_row1, const uword in_row2); - arma_inline const subview_cube rows(const uword in_row1, const uword in_row2) const; - - arma_inline subview_cube cols(const uword in_col1, const uword in_col2); - arma_inline const subview_cube cols(const uword in_col1, const uword in_col2) const; - - arma_inline subview_cube slices(const uword in_slice1, const uword in_slice2); - arma_inline const subview_cube slices(const uword in_slice1, const uword in_slice2) const; - - arma_inline subview_cube subcube(const uword in_row1, const uword in_col1, const uword in_slice1, const uword in_row2, const uword in_col2, const uword in_slice2); - arma_inline const subview_cube subcube(const uword in_row1, const uword in_col1, const uword in_slice1, const uword in_row2, const uword in_col2, const uword in_slice2) const; - - inline subview_cube subcube(const uword in_row1, const uword in_col1, const uword in_slice1, const SizeCube& s); - inline const subview_cube subcube(const uword in_row1, const uword in_col1, const uword in_slice1, const SizeCube& s) const; - - inline subview_cube subcube(const span& row_span, const span& col_span, const span& slice_span); - inline const subview_cube subcube(const span& row_span, const span& col_span, const span& slice_span) const; - - inline subview_cube operator()(const span& row_span, const span& col_span, const span& slice_span); - inline const subview_cube operator()(const span& row_span, const span& col_span, const span& slice_span) const; - - inline subview_cube operator()(const uword in_row1, const uword in_col1, const uword in_slice1, const SizeCube& s); - inline const subview_cube operator()(const uword in_row1, const uword in_col1, const uword in_slice1, const SizeCube& s) const; - - arma_inline subview_cube tube(const uword in_row1, const uword in_col1); - arma_inline const subview_cube tube(const uword in_row1, const uword in_col1) const; - - arma_inline subview_cube tube(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2); - arma_inline const subview_cube tube(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2) const; - - arma_inline subview_cube tube(const uword in_row1, const uword in_col1, const SizeMat& s); - arma_inline const subview_cube tube(const uword in_row1, const uword in_col1, const SizeMat& s) const; - - inline subview_cube tube(const span& row_span, const span& col_span); - inline const subview_cube tube(const span& row_span, const span& col_span) const; - - inline subview_cube head_slices(const uword N); - inline const subview_cube head_slices(const uword N) const; - - inline subview_cube tail_slices(const uword N); - inline const subview_cube tail_slices(const uword N) const; - - template arma_inline subview_elem1 elem(const Base& a); - template arma_inline const subview_elem1 elem(const Base& a) const; - - template arma_inline subview_elem1 operator()(const Base& a); - template arma_inline const subview_elem1 operator()(const Base& a) const; - - - arma_inline subview_cube_each1 each_slice(); - arma_inline const subview_cube_each1 each_slice() const; - - template inline subview_cube_each2 each_slice(const Base& indices); - template inline const subview_cube_each2 each_slice(const Base& indices) const; - - inline Cube& each_slice(const std::function< void( Mat&) >& F); - inline const Cube& each_slice(const std::function< void(const Mat&) >& F) const; - - inline Cube& each_slice(const std::function< void( Mat&) >& F, const bool use_mp); - inline const Cube& each_slice(const std::function< void(const Mat&) >& F, const bool use_mp) const; - - - template arma_inline subview_cube_slices slices(const Base& indices); - template arma_inline const subview_cube_slices slices(const Base& indices) const; - - - inline void shed_row(const uword row_num); - inline void shed_col(const uword col_num); - inline void shed_slice(const uword slice_num); - - inline void shed_rows(const uword in_row1, const uword in_row2); - inline void shed_cols(const uword in_col1, const uword in_col2); - inline void shed_slices(const uword in_slice1, const uword in_slice2); - - template inline void shed_slices(const Base& indices); - - arma_deprecated inline void insert_rows(const uword row_num, const uword N, const bool set_to_zero); - arma_deprecated inline void insert_cols(const uword row_num, const uword N, const bool set_to_zero); - arma_deprecated inline void insert_slices(const uword slice_num, const uword N, const bool set_to_zero); - - inline void insert_rows(const uword row_num, const uword N); - inline void insert_cols(const uword row_num, const uword N); - inline void insert_slices(const uword slice_num, const uword N); - - template inline void insert_rows(const uword row_num, const BaseCube& X); - template inline void insert_cols(const uword col_num, const BaseCube& X); - template inline void insert_slices(const uword slice_num, const BaseCube& X); - template inline void insert_slices(const uword slice_num, const Base& X); - - - template inline Cube(const GenCube& X); - template inline Cube& operator= (const GenCube& X); - template inline Cube& operator+=(const GenCube& X); - template inline Cube& operator-=(const GenCube& X); - template inline Cube& operator%=(const GenCube& X); - template inline Cube& operator/=(const GenCube& X); - - template inline Cube(const OpCube& X); - template inline Cube& operator= (const OpCube& X); - template inline Cube& operator+=(const OpCube& X); - template inline Cube& operator-=(const OpCube& X); - template inline Cube& operator%=(const OpCube& X); - template inline Cube& operator/=(const OpCube& X); - - template inline Cube(const eOpCube& X); - template inline Cube& operator= (const eOpCube& X); - template inline Cube& operator+=(const eOpCube& X); - template inline Cube& operator-=(const eOpCube& X); - template inline Cube& operator%=(const eOpCube& X); - template inline Cube& operator/=(const eOpCube& X); - - template inline Cube(const mtOpCube& X); - template inline Cube& operator= (const mtOpCube& X); - template inline Cube& operator+=(const mtOpCube& X); - template inline Cube& operator-=(const mtOpCube& X); - template inline Cube& operator%=(const mtOpCube& X); - template inline Cube& operator/=(const mtOpCube& X); - - template inline Cube(const GlueCube& X); - template inline Cube& operator= (const GlueCube& X); - template inline Cube& operator+=(const GlueCube& X); - template inline Cube& operator-=(const GlueCube& X); - template inline Cube& operator%=(const GlueCube& X); - template inline Cube& operator/=(const GlueCube& X); - - template inline Cube(const eGlueCube& X); - template inline Cube& operator= (const eGlueCube& X); - template inline Cube& operator+=(const eGlueCube& X); - template inline Cube& operator-=(const eGlueCube& X); - template inline Cube& operator%=(const eGlueCube& X); - template inline Cube& operator/=(const eGlueCube& X); - - template inline Cube(const mtGlueCube& X); - template inline Cube& operator= (const mtGlueCube& X); - template inline Cube& operator+=(const mtGlueCube& X); - template inline Cube& operator-=(const mtGlueCube& X); - template inline Cube& operator%=(const mtGlueCube& X); - template inline Cube& operator/=(const mtGlueCube& X); - - - arma_warn_unused arma_inline const eT& at_alt (const uword i) const; - - arma_warn_unused arma_inline eT& operator[] (const uword i); - arma_warn_unused arma_inline const eT& operator[] (const uword i) const; - - arma_warn_unused arma_inline eT& at(const uword i); - arma_warn_unused arma_inline const eT& at(const uword i) const; - - arma_warn_unused arma_inline eT& operator() (const uword i); - arma_warn_unused arma_inline const eT& operator() (const uword i) const; - - #if defined(__cpp_multidimensional_subscript) - arma_warn_unused arma_inline eT& operator[] (const uword in_row, const uword in_col, const uword in_slice); - arma_warn_unused arma_inline const eT& operator[] (const uword in_row, const uword in_col, const uword in_slice) const; - #endif - - arma_warn_unused arma_inline eT& at (const uword in_row, const uword in_col, const uword in_slice); - arma_warn_unused arma_inline const eT& at (const uword in_row, const uword in_col, const uword in_slice) const; - - arma_warn_unused arma_inline eT& operator() (const uword in_row, const uword in_col, const uword in_slice); - arma_warn_unused arma_inline const eT& operator() (const uword in_row, const uword in_col, const uword in_slice) const; - - arma_inline const Cube& operator++(); - arma_inline void operator++(int); - - arma_inline const Cube& operator--(); - arma_inline void operator--(int); - - arma_warn_unused arma_inline bool is_empty() const; - - arma_warn_unused inline bool internal_is_finite() const; - arma_warn_unused inline bool internal_has_inf() const; - arma_warn_unused inline bool internal_has_nan() const; - arma_warn_unused inline bool internal_has_nonfinite() const; - - arma_warn_unused arma_inline bool in_range(const uword i) const; - arma_warn_unused arma_inline bool in_range(const span& x) const; - - arma_warn_unused arma_inline bool in_range(const uword in_row, const uword in_col, const uword in_slice) const; - arma_warn_unused inline bool in_range(const span& row_span, const span& col_span, const span& slice_span) const; - - arma_warn_unused inline bool in_range(const uword in_row, const uword in_col, const uword in_slice, const SizeCube& s) const; - - arma_warn_unused arma_inline eT* memptr(); - arma_warn_unused arma_inline const eT* memptr() const; - - arma_warn_unused arma_inline eT* slice_memptr(const uword slice); - arma_warn_unused arma_inline const eT* slice_memptr(const uword slice) const; - - arma_warn_unused arma_inline eT* slice_colptr(const uword in_slice, const uword in_col); - arma_warn_unused arma_inline const eT* slice_colptr(const uword in_slice, const uword in_col) const; - - inline Cube& set_size(const uword new_n_rows, const uword new_n_cols, const uword new_n_slices); - inline Cube& set_size(const SizeCube& s); - - inline Cube& reshape(const uword new_n_rows, const uword new_n_cols, const uword new_n_slices); - inline Cube& reshape(const SizeCube& s); - - inline Cube& resize(const uword new_n_rows, const uword new_n_cols, const uword new_n_slices); - inline Cube& resize(const SizeCube& s); - - - template inline Cube& copy_size(const Cube& m); - - template inline Cube& for_each(functor F); - template inline const Cube& for_each(functor F) const; - - template inline Cube& transform(functor F); - template inline Cube& imbue(functor F); - - inline Cube& replace(const eT old_val, const eT new_val); - - inline Cube& clean(const pod_type threshold); - - inline Cube& clamp(const eT min_val, const eT max_val); - - inline Cube& fill(const eT val); - - inline Cube& zeros(); - inline Cube& zeros(const uword new_n_rows, const uword new_n_cols, const uword new_n_slices); - inline Cube& zeros(const SizeCube& s); - - inline Cube& ones(); - inline Cube& ones(const uword new_n_rows, const uword new_n_cols, const uword new_n_slices); - inline Cube& ones(const SizeCube& s); - - inline Cube& randu(); - inline Cube& randu(const uword new_n_rows, const uword new_n_cols, const uword new_n_slices); - inline Cube& randu(const SizeCube& s); - - inline Cube& randn(); - inline Cube& randn(const uword new_n_rows, const uword new_n_cols, const uword new_n_slices); - inline Cube& randn(const SizeCube& s); - - inline void reset(); - inline void soft_reset(); - - - template inline void set_real(const BaseCube& X); - template inline void set_imag(const BaseCube& X); - - - arma_warn_unused inline eT min() const; - arma_warn_unused inline eT max() const; - - inline eT min(uword& index_of_min_val) const; - inline eT max(uword& index_of_max_val) const; - - inline eT min(uword& row_of_min_val, uword& col_of_min_val, uword& slice_of_min_val) const; - inline eT max(uword& row_of_max_val, uword& col_of_max_val, uword& slice_of_max_val) const; - - - arma_cold inline bool save(const std::string name, const file_type type = arma_binary) const; - arma_cold inline bool save(const hdf5_name& spec, const file_type type = hdf5_binary) const; - arma_cold inline bool save( std::ostream& os, const file_type type = arma_binary) const; - - arma_cold inline bool load(const std::string name, const file_type type = auto_detect); - arma_cold inline bool load(const hdf5_name& spec, const file_type type = hdf5_binary); - arma_cold inline bool load( std::istream& is, const file_type type = auto_detect); - - arma_deprecated inline bool quiet_save(const std::string name, const file_type type = arma_binary) const; - arma_deprecated inline bool quiet_save(const hdf5_name& spec, const file_type type = hdf5_binary) const; - arma_deprecated inline bool quiet_save( std::ostream& os, const file_type type = arma_binary) const; - - arma_deprecated inline bool quiet_load(const std::string name, const file_type type = auto_detect); - arma_deprecated inline bool quiet_load(const hdf5_name& spec, const file_type type = hdf5_binary); - arma_deprecated inline bool quiet_load( std::istream& is, const file_type type = auto_detect); - - - // iterators - - typedef eT* iterator; - typedef const eT* const_iterator; - - typedef eT* slice_iterator; - typedef const eT* const_slice_iterator; - - inline iterator begin(); - inline const_iterator begin() const; - inline const_iterator cbegin() const; - - inline iterator end(); - inline const_iterator end() const; - inline const_iterator cend() const; - - inline slice_iterator begin_slice(const uword slice_num); - inline const_slice_iterator begin_slice(const uword slice_num) const; - - inline slice_iterator end_slice(const uword slice_num); - inline const_slice_iterator end_slice(const uword slice_num) const; - - inline void clear(); - inline bool empty() const; - inline uword size() const; - - arma_warn_unused inline eT& front(); - arma_warn_unused inline const eT& front() const; - - arma_warn_unused inline eT& back(); - arma_warn_unused inline const eT& back() const; - - inline void swap(Cube& B); - - inline void steal_mem(Cube& X); //!< don't use this unless you're writing code internal to Armadillo - inline void steal_mem(Cube& X, const bool is_move); //!< don't use this unless you're writing code internal to Armadillo - - template class fixed; - - - protected: - - inline void init_cold(); - inline void init_warm(const uword in_n_rows, const uword in_n_cols, const uword in_n_slices); - - template - inline void init(const BaseCube& A, const BaseCube& B); - - inline void delete_mat(); - inline void create_mat(); - - inline Mat* create_mat_ptr(const uword in_slice) const; - inline Mat* get_mat_ptr(const uword in_slice) const; - - friend class glue_join; - friend class op_reshape; - friend class op_resize; - friend class subview_cube; - - - public: - - #if defined(ARMA_EXTRA_CUBE_PROTO) - #include ARMA_INCFILE_WRAP(ARMA_EXTRA_CUBE_PROTO) - #endif - }; - - - -template -template -class Cube::fixed : public Cube - { - private: - - static constexpr uword fixed_n_elem = fixed_n_rows * fixed_n_cols * fixed_n_slices; - static constexpr uword fixed_n_elem_slice = fixed_n_rows * fixed_n_cols; - - static constexpr bool use_extra = (fixed_n_elem > Cube_prealloc::mem_n_elem); - - arma_aligned atomic_mat_ptr_type mat_ptrs_local_extra[ (fixed_n_slices > Cube_prealloc::mat_ptrs_size) ? fixed_n_slices : 1 ]; - arma_align_mem eT mem_local_extra[ use_extra ? fixed_n_elem : 1 ]; - - arma_inline void mem_setup(); - - - public: - - inline fixed(); - inline fixed(const fixed& X); - - inline fixed(const fill::scalar_holder f); - template inline fixed(const fill::fill_class& f); - template inline fixed(const BaseCube& A); - template inline fixed(const BaseCube& A, const BaseCube& B); - - using Cube::operator=; - using Cube::operator(); - - inline Cube& operator=(const fixed& X); - - - arma_warn_unused arma_inline eT& operator[] (const uword i); - arma_warn_unused arma_inline const eT& operator[] (const uword i) const; - - arma_warn_unused arma_inline eT& at (const uword i); - arma_warn_unused arma_inline const eT& at (const uword i) const; - - arma_warn_unused arma_inline eT& operator() (const uword i); - arma_warn_unused arma_inline const eT& operator() (const uword i) const; - - #if defined(__cpp_multidimensional_subscript) - arma_warn_unused arma_inline eT& operator[] (const uword in_row, const uword in_col, const uword in_slice); - arma_warn_unused arma_inline const eT& operator[] (const uword in_row, const uword in_col, const uword in_slice) const; - #endif - - arma_warn_unused arma_inline eT& at (const uword in_row, const uword in_col, const uword in_slice); - arma_warn_unused arma_inline const eT& at (const uword in_row, const uword in_col, const uword in_slice) const; - - arma_warn_unused arma_inline eT& operator() (const uword in_row, const uword in_col, const uword in_slice); - arma_warn_unused arma_inline const eT& operator() (const uword in_row, const uword in_col, const uword in_slice) const; - }; - - - -class Cube_aux - { - public: - - template arma_inline static void prefix_pp(Cube& x); - template arma_inline static void prefix_pp(Cube< std::complex >& x); - - template arma_inline static void postfix_pp(Cube& x); - template arma_inline static void postfix_pp(Cube< std::complex >& x); - - template arma_inline static void prefix_mm(Cube& x); - template arma_inline static void prefix_mm(Cube< std::complex >& x); - - template arma_inline static void postfix_mm(Cube& x); - template arma_inline static void postfix_mm(Cube< std::complex >& x); - - template inline static void set_real(Cube& out, const BaseCube& X); - template inline static void set_imag(Cube& out, const BaseCube& X); - - template inline static void set_real(Cube< std::complex >& out, const BaseCube< T,T1>& X); - template inline static void set_imag(Cube< std::complex >& out, const BaseCube< T,T1>& X); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Cube_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Cube_meat.hpp deleted file mode 100644 index aa869bb43..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Cube_meat.hpp +++ /dev/null @@ -1,5921 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup Cube -//! @{ - - -template -inline -Cube::~Cube() - { - arma_debug_sigprint_this(this); - - delete_mat(); - - if( (mem_state == 0) && (n_alloc > 0) ) - { - arma_debug_print("Cube::destructor: releasing memory"); - memory::release( access::rw(mem) ); - } - - // try to expose buggy user code that accesses deleted objects - access::rw(mem) = nullptr; - - arma_type_check(( is_supported_elem_type::value == false )); - } - - - -template -inline -Cube::Cube() - : n_rows(0) - , n_cols(0) - , n_elem_slice(0) - , n_slices(0) - , n_elem(0) - , n_alloc(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - } - - - -//! construct the cube to have user specified dimensions -template -inline -Cube::Cube(const uword in_n_rows, const uword in_n_cols, const uword in_n_slices) - : n_rows(in_n_rows) - , n_cols(in_n_cols) - , n_elem_slice(in_n_rows*in_n_cols) - , n_slices(in_n_slices) - , n_elem(in_n_rows*in_n_cols*in_n_slices) - , n_alloc() - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - arma_debug_print("Cube::constructor: zeroing memory"); - - arrayops::fill_zeros(memptr(), n_elem); - } - - - -template -inline -Cube::Cube(const SizeCube& s) - : n_rows(s.n_rows) - , n_cols(s.n_cols) - , n_elem_slice(s.n_rows*s.n_cols) - , n_slices(s.n_slices) - , n_elem(s.n_rows*s.n_cols*s.n_slices) - , n_alloc() - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - arma_debug_print("Cube::constructor: zeroing memory"); - - arrayops::fill_zeros(memptr(), n_elem); - } - - - -//! internal use only -template -template -inline -Cube::Cube(const uword in_n_rows, const uword in_n_cols, const uword in_n_slices, const arma_initmode_indicator&) - : n_rows(in_n_rows) - , n_cols(in_n_cols) - , n_elem_slice(in_n_rows*in_n_cols) - , n_slices(in_n_slices) - , n_elem(in_n_rows*in_n_cols*in_n_slices) - , n_alloc() - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - if(do_zeros) - { - arma_debug_print("Cube::constructor: zeroing memory"); - arrayops::fill_zeros(memptr(), n_elem); - } - else - { - arma_debug_print("Cube::constructor: not zeroing memory"); - } - } - - - -//! internal use only -template -template -inline -Cube::Cube(const SizeCube& s, const arma_initmode_indicator&) - : n_rows(s.n_rows) - , n_cols(s.n_cols) - , n_elem_slice(s.n_rows*s.n_cols) - , n_slices(s.n_slices) - , n_elem(s.n_rows*s.n_cols*s.n_slices) - , n_alloc() - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - if(do_zeros) - { - arma_debug_print("Cube::constructor: zeroing memory"); - arrayops::fill_zeros(memptr(), n_elem); - } - else - { - arma_debug_print("Cube::constructor: not zeroing memory"); - } - } - - - -//! construct the cube to have user specified dimensions and fill with specified pattern -template -template -inline -Cube::Cube(const uword in_n_rows, const uword in_n_cols, const uword in_n_slices, const fill::fill_class&) - : n_rows(in_n_rows) - , n_cols(in_n_cols) - , n_elem_slice(in_n_rows*in_n_cols) - , n_slices(in_n_slices) - , n_elem(in_n_rows*in_n_cols*in_n_slices) - , n_alloc() - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - if(is_same_type::yes) { (*this).zeros(); } - if(is_same_type::yes) { (*this).ones(); } - if(is_same_type::yes) { (*this).randu(); } - if(is_same_type::yes) { (*this).randn(); } - - arma_static_check( (is_same_type::yes), "Cube::Cube(): unsupported fill type" ); - } - - - -template -template -inline -Cube::Cube(const SizeCube& s, const fill::fill_class&) - : n_rows(s.n_rows) - , n_cols(s.n_cols) - , n_elem_slice(s.n_rows*s.n_cols) - , n_slices(s.n_slices) - , n_elem(s.n_rows*s.n_cols*s.n_slices) - , n_alloc() - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - if(is_same_type::yes) { (*this).zeros(); } - if(is_same_type::yes) { (*this).ones(); } - if(is_same_type::yes) { (*this).randu(); } - if(is_same_type::yes) { (*this).randn(); } - - arma_static_check( (is_same_type::yes), "Cube::Cube(): unsupported fill type" ); - } - - - -//! construct the cube to have user specified dimensions and fill with specified value -template -inline -Cube::Cube(const uword in_n_rows, const uword in_n_cols, const uword in_n_slices, const fill::scalar_holder f) - : n_rows(in_n_rows) - , n_cols(in_n_cols) - , n_elem_slice(in_n_rows*in_n_cols) - , n_slices(in_n_slices) - , n_elem(in_n_rows*in_n_cols*in_n_slices) - , n_alloc() - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - (*this).fill(f.scalar); - } - - - -template -inline -Cube::Cube(const SizeCube& s, const fill::scalar_holder f) - : n_rows(s.n_rows) - , n_cols(s.n_cols) - , n_elem_slice(s.n_rows*s.n_cols) - , n_slices(s.n_slices) - , n_elem(s.n_rows*s.n_cols*s.n_slices) - , n_alloc() - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - (*this).fill(f.scalar); - } - - - -template -inline -Cube::Cube(Cube&& in_cube) - : n_rows(0) - , n_cols(0) - , n_elem_slice(0) - , n_slices(0) - , n_elem(0) - , n_alloc(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint(arma_str::format("this: %x; in_cube: %x") % this % &in_cube); - - (*this).steal_mem(in_cube, true); - } - - - -template -inline -Cube& -Cube::operator=(Cube&& in_cube) - { - arma_debug_sigprint(arma_str::format("this: %x; in_cube: %x") % this % &in_cube); - - (*this).steal_mem(in_cube, true); - - return *this; - } - - - -template -inline -void -Cube::init_cold() - { - arma_debug_sigprint( arma_str::format("n_rows: %u; n_cols: %u; n_slices: %u") % n_rows % n_cols % n_slices ); - - #if defined(ARMA_64BIT_WORD) - const char* error_message = "Cube::init(): requested size is too large"; - #else - const char* error_message = "Cube::init(): requested size is too large; suggest to enable ARMA_64BIT_WORD"; - #endif - - arma_conform_check - ( - ( - ( (n_rows > 0x0FFF) || (n_cols > 0x0FFF) || (n_slices > 0xFF) ) - ? ( (double(n_rows) * double(n_cols) * double(n_slices)) > double(ARMA_MAX_UWORD) ) - : false - ), - error_message - ); - - - if(n_elem <= Cube_prealloc::mem_n_elem) - { - if(n_elem > 0) { arma_debug_print("Cube::init(): using local memory"); } - - access::rw(mem) = (n_elem == 0) ? nullptr : mem_local; - access::rw(n_alloc) = 0; - } - else - { - arma_debug_print("Cube::init(): acquiring memory"); - - access::rw(mem) = memory::acquire(n_elem); - access::rw(n_alloc) = n_elem; - } - - create_mat(); - } - - - -template -inline -void -Cube::init_warm(const uword in_n_rows, const uword in_n_cols, const uword in_n_slices) - { - arma_debug_sigprint( arma_str::format("in_n_rows: %u; in_n_cols: %u; in_n_slices: %u") % in_n_rows % in_n_cols % in_n_slices ); - - if( (n_rows == in_n_rows) && (n_cols == in_n_cols) && (n_slices == in_n_slices) ) { return; } - - const uword t_mem_state = mem_state; - - bool err_state = false; - char* err_msg = nullptr; - - const char* error_message_1 = "Cube::init(): size is fixed and hence cannot be changed"; - - arma_conform_set_error( err_state, err_msg, (t_mem_state == 3), error_message_1 ); - - #if defined(ARMA_64BIT_WORD) - const char* error_message_2 = "Cube::init(): requested size is too large"; - #else - const char* error_message_2 = "Cube::init(): requested size is too large; suggest to enable ARMA_64BIT_WORD"; - #endif - - arma_conform_set_error - ( - err_state, - err_msg, - ( - ( (in_n_rows > 0x0FFF) || (in_n_cols > 0x0FFF) || (in_n_slices > 0xFF) ) - ? ( (double(in_n_rows) * double(in_n_cols) * double(in_n_slices)) > double(ARMA_MAX_UWORD) ) - : false - ), - error_message_2 - ); - - arma_conform_check(err_state, err_msg); - - const uword old_n_elem = n_elem; - const uword new_n_elem = in_n_rows * in_n_cols * in_n_slices; - - if(old_n_elem == new_n_elem) - { - arma_debug_print("Cube::init(): reusing memory"); - - delete_mat(); - - access::rw(n_rows) = in_n_rows; - access::rw(n_cols) = in_n_cols; - access::rw(n_elem_slice) = in_n_rows*in_n_cols; - access::rw(n_slices) = in_n_slices; - - create_mat(); - - return; - } - - arma_conform_check( (t_mem_state == 2), "Cube::init(): mismatch between size of auxiliary memory and requested size" ); - - delete_mat(); - - if(new_n_elem <= Cube_prealloc::mem_n_elem) - { - if(n_alloc > 0) - { - arma_debug_print("Cube::init(): releasing memory"); - memory::release( access::rw(mem) ); - } - - if(new_n_elem > 0) { arma_debug_print("Cube::init(): using local memory"); } - - access::rw(mem) = (new_n_elem == 0) ? nullptr : mem_local; - access::rw(n_alloc) = 0; - } - else // condition: new_n_elem > Cube_prealloc::mem_n_elem - { - if(new_n_elem > n_alloc) - { - if(n_alloc > 0) - { - arma_debug_print("Cube::init(): releasing memory"); - memory::release( access::rw(mem) ); - - // in case memory::acquire() throws an exception - access::rw(mem) = nullptr; - access::rw(n_rows) = 0; - access::rw(n_cols) = 0; - access::rw(n_elem_slice) = 0; - access::rw(n_slices) = 0; - access::rw(n_elem) = 0; - access::rw(n_alloc) = 0; - } - - arma_debug_print("Cube::init(): acquiring memory"); - access::rw(mem) = memory::acquire(new_n_elem); - access::rw(n_alloc) = new_n_elem; - } - else // condition: new_n_elem <= n_alloc - { - arma_debug_print("Cube::init(): reusing memory"); - } - } - - access::rw(n_rows) = in_n_rows; - access::rw(n_cols) = in_n_cols; - access::rw(n_elem_slice) = in_n_rows*in_n_cols; - access::rw(n_slices) = in_n_slices; - access::rw(n_elem) = new_n_elem; - access::rw(mem_state) = 0; - - create_mat(); - } - - - -//! for constructing a complex cube out of two non-complex cubes -template -template -inline -void -Cube::init - ( - const BaseCube::pod_type,T1>& X, - const BaseCube::pod_type,T2>& Y - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type T; - - arma_type_check(( is_cx::no )); //!< compile-time abort if eT is not std::complex - arma_type_check(( is_cx< T>::yes )); //!< compile-time abort if T is std::complex - - arma_type_check(( is_same_type< std::complex, eT >::no )); //!< compile-time abort if types are not compatible - - const ProxyCube PX(X.get_ref()); - const ProxyCube PY(Y.get_ref()); - - arma_conform_assert_same_size(PX, PY, "Cube()"); - - const uword local_n_rows = PX.get_n_rows(); - const uword local_n_cols = PX.get_n_cols(); - const uword local_n_slices = PX.get_n_slices(); - - init_warm(local_n_rows, local_n_cols, local_n_slices); - - eT* out_mem = (*this).memptr(); - - constexpr bool use_at = ( ProxyCube::use_at || ProxyCube::use_at ); - - if(use_at == false) - { - typedef typename ProxyCube::ea_type ea_type1; - typedef typename ProxyCube::ea_type ea_type2; - - const uword N = n_elem; - - ea_type1 A = PX.get_ea(); - ea_type2 B = PY.get_ea(); - - for(uword i=0; i(A[i], B[i]); - } - } - else - { - for(uword uslice = 0; uslice < local_n_slices; ++uslice) - for(uword ucol = 0; ucol < local_n_cols; ++ucol ) - for(uword urow = 0; urow < local_n_rows; ++urow ) - { - *out_mem = std::complex( PX.at(urow,ucol,uslice), PY.at(urow,ucol,uslice) ); - out_mem++; - } - } - } - - - -template -inline -void -Cube::delete_mat() - { - arma_debug_sigprint(); - - if((n_slices > 0) && (mat_ptrs != nullptr)) - { - for(uword s=0; s < n_slices; ++s) - { - raw_mat_ptr_type mat_ptr = raw_mat_ptr_type(mat_ptrs[s]); // explicit cast to indicate load from std::atomic*> - - if(mat_ptr != nullptr) - { - arma_debug_print( arma_str::format("Cube::delete_mat(): destroying matrix %u") % s ); - delete mat_ptr; - mat_ptrs[s] = nullptr; - } - } - - if( (mem_state <= 2) && (n_slices > Cube_prealloc::mat_ptrs_size) ) - { - arma_debug_print("Cube::delete_mat(): freeing mat_ptrs array"); - delete [] mat_ptrs; - mat_ptrs = nullptr; - } - } - } - - - -template -inline -void -Cube::create_mat() - { - arma_debug_sigprint(); - - if(n_slices == 0) { mat_ptrs = nullptr; return; } - - if(mem_state <= 2) - { - if(n_slices <= Cube_prealloc::mat_ptrs_size) - { - arma_debug_print("Cube::create_mat(): using local memory for mat_ptrs array"); - - mat_ptrs = mat_ptrs_local; - } - else - { - arma_debug_print("Cube::create_mat(): allocating mat_ptrs array"); - - mat_ptrs = new(std::nothrow) atomic_mat_ptr_type[n_slices]; - - arma_check_bad_alloc( (mat_ptrs == nullptr), "Cube::create_mat(): out of memory" ); - } - } - - for(uword s=0; s < n_slices; ++s) { mat_ptrs[s] = nullptr; } - } - - - -template -inline -Mat* -Cube::create_mat_ptr(const uword in_slice) const - { - arma_debug_sigprint(); - - arma_debug_print( arma_str::format("Cube::create_mat_ptr(): creating matrix %u") % in_slice ); - - const eT* mat_mem = (n_elem_slice > 0) ? slice_memptr(in_slice) : nullptr; - - Mat* mat_ptr = new(std::nothrow) Mat('j', mat_mem, n_rows, n_cols); - - return mat_ptr; - } - - - -template -inline -Mat* -Cube::get_mat_ptr(const uword in_slice) const - { - arma_debug_sigprint(); - - raw_mat_ptr_type mat_ptr = nullptr; - - #if defined(ARMA_USE_OPENMP) - { - #pragma omp atomic read - mat_ptr = mat_ptrs[in_slice]; - } - #elif defined(ARMA_USE_STD_MUTEX) - { - mat_ptr = mat_ptrs[in_slice].load(); - } - #else - { - mat_ptr = mat_ptrs[in_slice]; - } - #endif - - if(mat_ptr == nullptr) - { - #if defined(ARMA_USE_OPENMP) - { - #pragma omp critical (arma_Cube_mat_ptrs) - { - #pragma omp atomic read - mat_ptr = mat_ptrs[in_slice]; - - if(mat_ptr == nullptr) { mat_ptr = create_mat_ptr(in_slice); } - - #pragma omp atomic write - mat_ptrs[in_slice] = mat_ptr; - } - } - #elif defined(ARMA_USE_STD_MUTEX) - { - const std::lock_guard lock(mat_mutex); - - mat_ptr = mat_ptrs[in_slice].load(); - - if(mat_ptr == nullptr) { mat_ptr = create_mat_ptr(in_slice); } - - mat_ptrs[in_slice].store(mat_ptr); - } - #else - { - mat_ptr = create_mat_ptr(in_slice); - - mat_ptrs[in_slice] = mat_ptr; - } - #endif - - arma_check_bad_alloc( (mat_ptr == nullptr), "Cube::get_mat_ptr(): out of memory" ); - } - - return mat_ptr; - } - - - -//! Set the cube to be equal to the specified scalar. -//! NOTE: the size of the cube will be 1x1x1 -template -inline -Cube& -Cube::operator=(const eT val) - { - arma_debug_sigprint(); - - init_warm(1,1,1); - - access::rw(mem[0]) = val; - - return *this; - } - - - -//! In-place addition of a scalar to all elements of the cube -template -inline -Cube& -Cube::operator+=(const eT val) - { - arma_debug_sigprint(); - - arrayops::inplace_plus( memptr(), val, n_elem ); - - return *this; - } - - - -//! In-place subtraction of a scalar from all elements of the cube -template -inline -Cube& -Cube::operator-=(const eT val) - { - arma_debug_sigprint(); - - arrayops::inplace_minus( memptr(), val, n_elem ); - - return *this; - } - - - -//! In-place multiplication of all elements of the cube with a scalar -template -inline -Cube& -Cube::operator*=(const eT val) - { - arma_debug_sigprint(); - - arrayops::inplace_mul( memptr(), val, n_elem ); - - return *this; - } - - - -//! In-place division of all elements of the cube with a scalar -template -inline -Cube& -Cube::operator/=(const eT val) - { - arma_debug_sigprint(); - - arrayops::inplace_div( memptr(), val, n_elem ); - - return *this; - } - - - -//! construct a cube from a given cube -template -inline -Cube::Cube(const Cube& x) - : n_rows(x.n_rows) - , n_cols(x.n_cols) - , n_elem_slice(x.n_elem_slice) - , n_slices(x.n_slices) - , n_elem(x.n_elem) - , n_alloc() - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - arma_debug_sigprint(arma_str::format("this: %x; in_cube: %x") % this % &x); - - init_cold(); - - arrayops::copy( memptr(), x.mem, n_elem ); - } - - - -//! construct a cube from a given cube -template -inline -Cube& -Cube::operator=(const Cube& x) - { - arma_debug_sigprint(arma_str::format("this: %x; in_cube: %x") % this % &x); - - if(this != &x) - { - init_warm(x.n_rows, x.n_cols, x.n_slices); - - arrayops::copy( memptr(), x.mem, n_elem ); - } - - return *this; - } - - - -//! construct a cube from a given auxiliary array of eTs. -//! if copy_aux_mem is true, new memory is allocated and the array is copied. -//! if copy_aux_mem is false, the auxiliary array is used directly (without allocating memory and copying). -template -inline -Cube::Cube(eT* aux_mem, const uword aux_n_rows, const uword aux_n_cols, const uword aux_n_slices, const bool copy_aux_mem, const bool strict, const bool prealloc_mat) - : n_rows ( aux_n_rows ) - , n_cols ( aux_n_cols ) - , n_elem_slice( aux_n_rows*aux_n_cols ) - , n_slices ( aux_n_slices ) - , n_elem ( aux_n_rows*aux_n_cols*aux_n_slices ) - , n_alloc ( 0 ) - , mem_state ( copy_aux_mem ? 0 : (strict ? 2 : 1) ) - , mem ( copy_aux_mem ? nullptr : aux_mem ) - { - arma_debug_sigprint_this(this); - - arma_ignore(prealloc_mat); // kept only for compatibility with old user code - - if(copy_aux_mem) - { - init_cold(); - - arrayops::copy( memptr(), aux_mem, n_elem ); - } - else - { - create_mat(); - } - } - - - -//! construct a cube from a given auxiliary read-only array of eTs. -//! the array is copied. -template -inline -Cube::Cube(const eT* aux_mem, const uword aux_n_rows, const uword aux_n_cols, const uword aux_n_slices) - : n_rows(aux_n_rows) - , n_cols(aux_n_cols) - , n_elem_slice(aux_n_rows*aux_n_cols) - , n_slices(aux_n_slices) - , n_elem(aux_n_rows*aux_n_cols*aux_n_slices) - , n_alloc() - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - arrayops::copy( memptr(), aux_mem, n_elem ); - } - - - -//! in-place cube addition -template -inline -Cube& -Cube::operator+=(const Cube& m) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(*this, m, "addition"); - - arrayops::inplace_plus( memptr(), m.memptr(), n_elem ); - - return *this; - } - - - -//! in-place cube subtraction -template -inline -Cube& -Cube::operator-=(const Cube& m) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(*this, m, "subtraction"); - - arrayops::inplace_minus( memptr(), m.memptr(), n_elem ); - - return *this; - } - - - -//! in-place element-wise cube multiplication -template -inline -Cube& -Cube::operator%=(const Cube& m) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(*this, m, "element-wise multiplication"); - - arrayops::inplace_mul( memptr(), m.memptr(), n_elem ); - - return *this; - } - - - -//! in-place element-wise cube division -template -inline -Cube& -Cube::operator/=(const Cube& m) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(*this, m, "element-wise division"); - - arrayops::inplace_div( memptr(), m.memptr(), n_elem ); - - return *this; - } - - - -//! for constructing a complex cube out of two non-complex cubes -template -template -inline -Cube::Cube - ( - const BaseCube::pod_type,T1>& A, - const BaseCube::pod_type,T2>& B - ) - : n_rows(0) - , n_cols(0) - , n_elem_slice(0) - , n_slices(0) - , n_elem(0) - , n_alloc(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init(A,B); - } - - - -//! construct a cube from a subview_cube instance (eg. construct a cube from a delayed subcube operation) -template -inline -Cube::Cube(const subview_cube& X) - : n_rows(X.n_rows) - , n_cols(X.n_cols) - , n_elem_slice(X.n_elem_slice) - , n_slices(X.n_slices) - , n_elem(X.n_elem) - , n_alloc() - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - subview_cube::extract(*this, X); - } - - - -//! construct a cube from a subview_cube instance (eg. construct a cube from a delayed subcube operation) -template -inline -Cube& -Cube::operator=(const subview_cube& X) - { - arma_debug_sigprint(); - - const bool alias = (this == &(X.m)); - - if(alias == false) - { - init_warm(X.n_rows, X.n_cols, X.n_slices); - - subview_cube::extract(*this, X); - } - else - { - Cube tmp(X); - - steal_mem(tmp); - } - - return *this; - } - - - -//! in-place cube addition (using a subcube on the right-hand-side) -template -inline -Cube& -Cube::operator+=(const subview_cube& X) - { - arma_debug_sigprint(); - - subview_cube::plus_inplace(*this, X); - - return *this; - } - - - -//! in-place cube subtraction (using a subcube on the right-hand-side) -template -inline -Cube& -Cube::operator-=(const subview_cube& X) - { - arma_debug_sigprint(); - - subview_cube::minus_inplace(*this, X); - - return *this; - } - - - -//! in-place element-wise cube mutiplication (using a subcube on the right-hand-side) -template -inline -Cube& -Cube::operator%=(const subview_cube& X) - { - arma_debug_sigprint(); - - subview_cube::schur_inplace(*this, X); - - return *this; - } - - - -//! in-place element-wise cube division (using a subcube on the right-hand-side) -template -inline -Cube& -Cube::operator/=(const subview_cube& X) - { - arma_debug_sigprint(); - - subview_cube::div_inplace(*this, X); - - return *this; - } - - - -template -template -inline -Cube::Cube(const subview_cube_slices& X) - : n_rows(0) - , n_cols(0) - , n_elem_slice(0) - , n_slices(0) - , n_elem(0) - , n_alloc(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - subview_cube_slices::extract(*this, X); - } - - - -template -template -inline -Cube& -Cube::operator=(const subview_cube_slices& X) - { - arma_debug_sigprint(); - - const bool alias = (this == &(X.m)); - - if(alias == false) - { - subview_cube_slices::extract(*this, X); - } - else - { - Cube tmp(X); - - steal_mem(tmp); - } - - return *this; - } - - - -template -template -inline -Cube& -Cube::operator+=(const subview_cube_slices& X) - { - arma_debug_sigprint(); - - subview_cube_slices::plus_inplace(*this, X); - - return *this; - } - - - -template -template -inline -Cube& -Cube::operator-=(const subview_cube_slices& X) - { - arma_debug_sigprint(); - - subview_cube_slices::minus_inplace(*this, X); - - return *this; - } - - - -template -template -inline -Cube& -Cube::operator%=(const subview_cube_slices& X) - { - arma_debug_sigprint(); - - subview_cube_slices::schur_inplace(*this, X); - - return *this; - } - - - -template -template -inline -Cube& -Cube::operator/=(const subview_cube_slices& X) - { - arma_debug_sigprint(); - - subview_cube_slices::div_inplace(*this, X); - - return *this; - } - - - -//! creation of subview_cube (subcube comprised of specified row) -template -arma_inline -subview_cube -Cube::row(const uword in_row) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (in_row >= n_rows), "Cube::row(): index out of bounds" ); - - return (*this).rows(in_row, in_row); - } - - - -//! creation of subview_cube (subcube comprised of specified row) -template -arma_inline -const subview_cube -Cube::row(const uword in_row) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (in_row >= n_rows), "Cube::row(): index out of bounds" ); - - return (*this).rows(in_row, in_row); - } - - - -//! creation of subview_cube (subcube comprised of specified column) -template -arma_inline -subview_cube -Cube::col(const uword in_col) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (in_col >= n_cols), "Cube::col(): index out of bounds" ); - - return (*this).cols(in_col, in_col); - } - - - -//! creation of subview_cube (subcube comprised of specified column) -template -arma_inline -const subview_cube -Cube::col(const uword in_col) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (in_col >= n_cols), "Cube::col(): index out of bounds" ); - - return (*this).cols(in_col, in_col); - } - - - -//! provide the reference to the matrix representing a single slice -template -inline -Mat& -Cube::slice(const uword in_slice) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (in_slice >= n_slices), "Cube::slice(): index out of bounds" ); - - return *(get_mat_ptr(in_slice)); - } - - - -//! provide the reference to the matrix representing a single slice -template -inline -const Mat& -Cube::slice(const uword in_slice) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (in_slice >= n_slices), "Cube::slice(): index out of bounds" ); - - return *(get_mat_ptr(in_slice)); - } - - - -//! creation of subview_cube (subcube comprised of specified rows) -template -arma_inline -subview_cube -Cube::rows(const uword in_row1, const uword in_row2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_row2 >= n_rows), - "Cube::rows(): indices out of bounds or incorrectly used" - ); - - const uword subcube_n_rows = in_row2 - in_row1 + 1; - - return subview_cube(*this, in_row1, 0, 0, subcube_n_rows, n_cols, n_slices); - } - - - -//! creation of subview_cube (subcube comprised of specified rows) -template -arma_inline -const subview_cube -Cube::rows(const uword in_row1, const uword in_row2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_row2 >= n_rows), - "Cube::rows(): indices out of bounds or incorrectly used" - ); - - const uword subcube_n_rows = in_row2 - in_row1 + 1; - - return subview_cube(*this, in_row1, 0, 0, subcube_n_rows, n_cols, n_slices); - } - - - -//! creation of subview_cube (subcube comprised of specified columns) -template -arma_inline -subview_cube -Cube::cols(const uword in_col1, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_col1 > in_col2) || (in_col2 >= n_cols), - "Cube::cols(): indices out of bounds or incorrectly used" - ); - - const uword subcube_n_cols = in_col2 - in_col1 + 1; - - return subview_cube(*this, 0, in_col1, 0, n_rows, subcube_n_cols, n_slices); - } - - - -//! creation of subview_cube (subcube comprised of specified columns) -template -arma_inline -const subview_cube -Cube::cols(const uword in_col1, const uword in_col2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_col1 > in_col2) || (in_col2 >= n_cols), - "Cube::cols(): indices out of bounds or incorrectly used" - ); - - const uword subcube_n_cols = in_col2 - in_col1 + 1; - - return subview_cube(*this, 0, in_col1, 0, n_rows, subcube_n_cols, n_slices); - } - - - -//! creation of subview_cube (subcube comprised of specified slices) -template -arma_inline -subview_cube -Cube::slices(const uword in_slice1, const uword in_slice2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_slice1 > in_slice2) || (in_slice2 >= n_slices), - "Cube::slices(): indices out of bounds or incorrectly used" - ); - - const uword subcube_n_slices = in_slice2 - in_slice1 + 1; - - return subview_cube(*this, 0, 0, in_slice1, n_rows, n_cols, subcube_n_slices); - } - - - -//! creation of subview_cube (subcube comprised of specified slices) -template -arma_inline -const subview_cube -Cube::slices(const uword in_slice1, const uword in_slice2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_slice1 > in_slice2) || (in_slice2 >= n_slices), - "Cube::slices(): indices out of bounds or incorrectly used" - ); - - const uword subcube_n_slices = in_slice2 - in_slice1 + 1; - - return subview_cube(*this, 0, 0, in_slice1, n_rows, n_cols, subcube_n_slices); - } - - - -//! creation of subview_cube (generic subcube) -template -arma_inline -subview_cube -Cube::subcube(const uword in_row1, const uword in_col1, const uword in_slice1, const uword in_row2, const uword in_col2, const uword in_slice2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_col1 > in_col2) || (in_slice1 > in_slice2) || - (in_row2 >= n_rows) || (in_col2 >= n_cols) || (in_slice2 >= n_slices), - "Cube::subcube(): indices out of bounds or incorrectly used" - ); - - const uword subcube_n_rows = in_row2 - in_row1 + 1; - const uword subcube_n_cols = in_col2 - in_col1 + 1; - const uword subcube_n_slices = in_slice2 - in_slice1 + 1; - - return subview_cube(*this, in_row1, in_col1, in_slice1, subcube_n_rows, subcube_n_cols, subcube_n_slices); - } - - - -//! creation of subview_cube (generic subcube) -template -arma_inline -const subview_cube -Cube::subcube(const uword in_row1, const uword in_col1, const uword in_slice1, const uword in_row2, const uword in_col2, const uword in_slice2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_col1 > in_col2) || (in_slice1 > in_slice2) || - (in_row2 >= n_rows) || (in_col2 >= n_cols) || (in_slice2 >= n_slices), - "Cube::subcube(): indices out of bounds or incorrectly used" - ); - - const uword subcube_n_rows = in_row2 - in_row1 + 1; - const uword subcube_n_cols = in_col2 - in_col1 + 1; - const uword subcube_n_slices = in_slice2 - in_slice1 + 1; - - return subview_cube(*this, in_row1, in_col1, in_slice1, subcube_n_rows, subcube_n_cols, subcube_n_slices); - } - - - -//! creation of subview_cube (generic subcube) -template -inline -subview_cube -Cube::subcube(const uword in_row1, const uword in_col1, const uword in_slice1, const SizeCube& s) - { - arma_debug_sigprint(); - - const uword l_n_rows = n_rows; - const uword l_n_cols = n_cols; - const uword l_n_slices = n_slices; - - const uword s_n_rows = s.n_rows; - const uword s_n_cols = s.n_cols; - const uword s_n_slices = s.n_slices; - - arma_conform_check_bounds - ( - ( in_row1 >= l_n_rows) || ( in_col1 >= l_n_cols) || ( in_slice1 >= l_n_slices) - || ((in_row1 + s_n_rows) > l_n_rows) || ((in_col1 + s_n_cols) > l_n_cols) || ((in_slice1 + s_n_slices) > l_n_slices), - "Cube::subcube(): indices or size out of bounds" - ); - - return subview_cube(*this, in_row1, in_col1, in_slice1, s_n_rows, s_n_cols, s_n_slices); - } - - - -//! creation of subview_cube (generic subcube) -template -inline -const subview_cube -Cube::subcube(const uword in_row1, const uword in_col1, const uword in_slice1, const SizeCube& s) const - { - arma_debug_sigprint(); - - const uword l_n_rows = n_rows; - const uword l_n_cols = n_cols; - const uword l_n_slices = n_slices; - - const uword s_n_rows = s.n_rows; - const uword s_n_cols = s.n_cols; - const uword s_n_slices = s.n_slices; - - arma_conform_check_bounds - ( - ( in_row1 >= l_n_rows) || ( in_col1 >= l_n_cols) || ( in_slice1 >= l_n_slices) - || ((in_row1 + s_n_rows) > l_n_rows) || ((in_col1 + s_n_cols) > l_n_cols) || ((in_slice1 + s_n_slices) > l_n_slices), - "Cube::subcube(): indices or size out of bounds" - ); - - return subview_cube(*this, in_row1, in_col1, in_slice1, s_n_rows, s_n_cols, s_n_slices); - } - - - -//! creation of subview_cube (generic subcube) -template -inline -subview_cube -Cube::subcube(const span& row_span, const span& col_span, const span& slice_span) - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - const bool col_all = col_span.whole; - const bool slice_all = slice_span.whole; - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - const uword local_n_slices = n_slices; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword subcube_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword subcube_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - const uword in_slice1 = slice_all ? 0 : slice_span.a; - const uword in_slice2 = slice_span.b; - const uword subcube_n_slices = slice_all ? local_n_slices : in_slice2 - in_slice1 + 1; - - arma_conform_check_bounds - ( - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - || - ( slice_all ? false : ((in_slice1 > in_slice2) || (in_slice2 >= local_n_slices)) ) - , - "Cube::subcube(): indices out of bounds or incorrectly used" - ); - - return subview_cube(*this, in_row1, in_col1, in_slice1, subcube_n_rows, subcube_n_cols, subcube_n_slices); - } - - - -//! creation of subview_cube (generic subcube) -template -inline -const subview_cube -Cube::subcube(const span& row_span, const span& col_span, const span& slice_span) const - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - const bool col_all = col_span.whole; - const bool slice_all = slice_span.whole; - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - const uword local_n_slices = n_slices; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword subcube_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword subcube_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - const uword in_slice1 = slice_all ? 0 : slice_span.a; - const uword in_slice2 = slice_span.b; - const uword subcube_n_slices = slice_all ? local_n_slices : in_slice2 - in_slice1 + 1; - - arma_conform_check_bounds - ( - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - || - ( slice_all ? false : ((in_slice1 > in_slice2) || (in_slice2 >= local_n_slices)) ) - , - "Cube::subcube(): indices out of bounds or incorrectly used" - ); - - return subview_cube(*this, in_row1, in_col1, in_slice1, subcube_n_rows, subcube_n_cols, subcube_n_slices); - } - - - -template -inline -subview_cube -Cube::operator()(const span& row_span, const span& col_span, const span& slice_span) - { - arma_debug_sigprint(); - - return (*this).subcube(row_span, col_span, slice_span); - } - - - -template -inline -const subview_cube -Cube::operator()(const span& row_span, const span& col_span, const span& slice_span) const - { - arma_debug_sigprint(); - - return (*this).subcube(row_span, col_span, slice_span); - } - - - -template -inline -subview_cube -Cube::operator()(const uword in_row1, const uword in_col1, const uword in_slice1, const SizeCube& s) - { - arma_debug_sigprint(); - - return (*this).subcube(in_row1, in_col1, in_slice1, s); - } - - - -template -inline -const subview_cube -Cube::operator()(const uword in_row1, const uword in_col1, const uword in_slice1, const SizeCube& s) const - { - arma_debug_sigprint(); - - return (*this).subcube(in_row1, in_col1, in_slice1, s); - } - - - -template -arma_inline -subview_cube -Cube::tube(const uword in_row1, const uword in_col1) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - ((in_row1 >= n_rows) || (in_col1 >= n_cols)), - "Cube::tube(): indices out of bounds" - ); - - return subview_cube(*this, in_row1, in_col1, 0, 1, 1, n_slices); - } - - - -template -arma_inline -const subview_cube -Cube::tube(const uword in_row1, const uword in_col1) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - ((in_row1 >= n_rows) || (in_col1 >= n_cols)), - "Cube::tube(): indices out of bounds" - ); - - return subview_cube(*this, in_row1, in_col1, 0, 1, 1, n_slices); - } - - - -template -arma_inline -subview_cube -Cube::tube(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_col1 > in_col2) || - (in_row2 >= n_rows) || (in_col2 >= n_cols), - "Cube::tube(): indices out of bounds or incorrectly used" - ); - - const uword subcube_n_rows = in_row2 - in_row1 + 1; - const uword subcube_n_cols = in_col2 - in_col1 + 1; - - return subview_cube(*this, in_row1, in_col1, 0, subcube_n_rows, subcube_n_cols, n_slices); - } - - - -template -arma_inline -const subview_cube -Cube::tube(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_col1 > in_col2) || - (in_row2 >= n_rows) || (in_col2 >= n_cols), - "Cube::tube(): indices out of bounds or incorrectly used" - ); - - const uword subcube_n_rows = in_row2 - in_row1 + 1; - const uword subcube_n_cols = in_col2 - in_col1 + 1; - - return subview_cube(*this, in_row1, in_col1, 0, subcube_n_rows, subcube_n_cols, n_slices); - } - - - -template -arma_inline -subview_cube -Cube::tube(const uword in_row1, const uword in_col1, const SizeMat& s) - { - arma_debug_sigprint(); - - const uword l_n_rows = n_rows; - const uword l_n_cols = n_cols; - - const uword s_n_rows = s.n_rows; - const uword s_n_cols = s.n_cols; - - arma_conform_check_bounds - ( - ((in_row1 >= l_n_rows) || (in_col1 >= l_n_cols) || ((in_row1 + s_n_rows) > l_n_rows) || ((in_col1 + s_n_cols) > l_n_cols)), - "Cube::tube(): indices or size out of bounds" - ); - - return subview_cube(*this, in_row1, in_col1, 0, s_n_rows, s_n_cols, n_slices); - } - - - -template -arma_inline -const subview_cube -Cube::tube(const uword in_row1, const uword in_col1, const SizeMat& s) const - { - arma_debug_sigprint(); - - const uword l_n_rows = n_rows; - const uword l_n_cols = n_cols; - - const uword s_n_rows = s.n_rows; - const uword s_n_cols = s.n_cols; - - arma_conform_check_bounds - ( - ((in_row1 >= l_n_rows) || (in_col1 >= l_n_cols) || ((in_row1 + s_n_rows) > l_n_rows) || ((in_col1 + s_n_cols) > l_n_cols)), - "Cube::tube(): indices or size out of bounds" - ); - - return subview_cube(*this, in_row1, in_col1, 0, s_n_rows, s_n_cols, n_slices); - } - - - -template -inline -subview_cube -Cube::tube(const span& row_span, const span& col_span) - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - const bool col_all = col_span.whole; - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword subcube_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword subcube_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - arma_conform_check_bounds - ( - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - , - "Cube::tube(): indices out of bounds or incorrectly used" - ); - - return subview_cube(*this, in_row1, in_col1, 0, subcube_n_rows, subcube_n_cols, n_slices); - } - - - -template -inline -const subview_cube -Cube::tube(const span& row_span, const span& col_span) const - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - const bool col_all = col_span.whole; - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword subcube_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword subcube_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - arma_conform_check_bounds - ( - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - , - "Cube::tube(): indices out of bounds or incorrectly used" - ); - - return subview_cube(*this, in_row1, in_col1, 0, subcube_n_rows, subcube_n_cols, n_slices); - } - - - -template -inline -subview_cube -Cube::head_slices(const uword N) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > n_slices), "Cube::head_slices(): size out of bounds" ); - - return subview_cube(*this, 0, 0, 0, n_rows, n_cols, N); - } - - - -template -inline -const subview_cube -Cube::head_slices(const uword N) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > n_slices), "Cube::head_slices(): size out of bounds" ); - - return subview_cube(*this, 0, 0, 0, n_rows, n_cols, N); - } - - - -template -inline -subview_cube -Cube::tail_slices(const uword N) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > n_slices), "Cube::tail_slices(): size out of bounds" ); - - const uword start_slice = n_slices - N; - - return subview_cube(*this, 0, 0, start_slice, n_rows, n_cols, N); - } - - - -template -inline -const subview_cube -Cube::tail_slices(const uword N) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > n_slices), "Cube::tail_slices(): size out of bounds" ); - - const uword start_slice = n_slices - N; - - return subview_cube(*this, 0, 0, start_slice, n_rows, n_cols, N); - } - - - -template -template -arma_inline -subview_elem1 -Cube::elem(const Base& a) - { - arma_debug_sigprint(); - - return subview_elem1(*this, a); - } - - - -template -template -arma_inline -const subview_elem1 -Cube::elem(const Base& a) const - { - arma_debug_sigprint(); - - return subview_elem1(*this, a); - } - - - -template -template -arma_inline -subview_elem1 -Cube::operator()(const Base& a) - { - arma_debug_sigprint(); - - return subview_elem1(*this, a); - } - - - -template -template -arma_inline -const subview_elem1 -Cube::operator()(const Base& a) const - { - arma_debug_sigprint(); - - return subview_elem1(*this, a); - } - - - -template -arma_inline -subview_cube_each1 -Cube::each_slice() - { - arma_debug_sigprint(); - - return subview_cube_each1(*this); - } - - - -template -arma_inline -const subview_cube_each1 -Cube::each_slice() const - { - arma_debug_sigprint(); - - return subview_cube_each1(*this); - } - - - -template -template -inline -subview_cube_each2 -Cube::each_slice(const Base& indices) - { - arma_debug_sigprint(); - - return subview_cube_each2(*this, indices); - } - - - -template -template -inline -const subview_cube_each2 -Cube::each_slice(const Base& indices) const - { - arma_debug_sigprint(); - - return subview_cube_each2(*this, indices); - } - - - -//! apply a lambda function to each slice, where each slice is interpreted as a matrix -template -inline -Cube& -Cube::each_slice(const std::function< void(Mat&) >& F) - { - arma_debug_sigprint(); - - for(uword slice_id=0; slice_id < n_slices; ++slice_id) - { - Mat tmp('j', slice_memptr(slice_id), n_rows, n_cols); - - F(tmp); - } - - return *this; - } - - - -template -inline -const Cube& -Cube::each_slice(const std::function< void(const Mat&) >& F) const - { - arma_debug_sigprint(); - - for(uword slice_id=0; slice_id < n_slices; ++slice_id) - { - const Mat tmp('j', slice_memptr(slice_id), n_rows, n_cols); - - F(tmp); - } - - return *this; - } - - - -template -inline -Cube& -Cube::each_slice(const std::function< void(Mat&) >& F, const bool use_mp) - { - arma_debug_sigprint(); - - if((use_mp == false) || (arma_config::openmp == false)) - { - return (*this).each_slice(F); - } - - #if defined(ARMA_USE_OPENMP) - { - const uword local_n_slices = n_slices; - const int n_threads = mp_thread_limit::get(); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword slice_id=0; slice_id < local_n_slices; ++slice_id) - { - Mat tmp('j', slice_memptr(slice_id), n_rows, n_cols); - - F(tmp); - } - } - #endif - - return *this; - } - - - -template -inline -const Cube& -Cube::each_slice(const std::function< void(const Mat&) >& F, const bool use_mp) const - { - arma_debug_sigprint(); - - if((use_mp == false) || (arma_config::openmp == false)) - { - return (*this).each_slice(F); - } - - #if defined(ARMA_USE_OPENMP) - { - const uword local_n_slices = n_slices; - const int n_threads = mp_thread_limit::get(); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword slice_id=0; slice_id < local_n_slices; ++slice_id) - { - Mat tmp('j', slice_memptr(slice_id), n_rows, n_cols); - - F(tmp); - } - } - #endif - - return *this; - } - - - -template -template -inline -subview_cube_slices -Cube::slices(const Base& indices) - { - arma_debug_sigprint(); - - return subview_cube_slices(*this, indices); - } - - - -template -template -inline -const subview_cube_slices -Cube::slices(const Base& indices) const - { - arma_debug_sigprint(); - - return subview_cube_slices(*this, indices); - } - - - -//! remove specified row -template -inline -void -Cube::shed_row(const uword row_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( row_num >= n_rows, "Cube::shed_row(): index out of bounds" ); - - shed_rows(row_num, row_num); - } - - - -//! remove specified column -template -inline -void -Cube::shed_col(const uword col_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( col_num >= n_cols, "Cube::shed_col(): index out of bounds" ); - - shed_cols(col_num, col_num); - } - - - -//! remove specified slice -template -inline -void -Cube::shed_slice(const uword slice_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( slice_num >= n_slices, "Cube::shed_slice(): index out of bounds" ); - - shed_slices(slice_num, slice_num); - } - - - -//! remove specified rows -template -inline -void -Cube::shed_rows(const uword in_row1, const uword in_row2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_row2 >= n_rows), - "Cube::shed_rows(): indices out of bounds or incorrectly used" - ); - - const uword n_keep_front = in_row1; - const uword n_keep_back = n_rows - (in_row2 + 1); - - Cube X(n_keep_front + n_keep_back, n_cols, n_slices, arma_nozeros_indicator()); - - if(n_keep_front > 0) - { - X.rows( 0, (n_keep_front-1) ) = rows( 0, (in_row1-1) ); - } - - if(n_keep_back > 0) - { - X.rows( n_keep_front, (n_keep_front+n_keep_back-1) ) = rows( (in_row2+1), (n_rows-1) ); - } - - steal_mem(X); - } - - - -//! remove specified columns -template -inline -void -Cube::shed_cols(const uword in_col1, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_col1 > in_col2) || (in_col2 >= n_cols), - "Cube::shed_cols(): indices out of bounds or incorrectly used" - ); - - const uword n_keep_front = in_col1; - const uword n_keep_back = n_cols - (in_col2 + 1); - - Cube X(n_rows, n_keep_front + n_keep_back, n_slices, arma_nozeros_indicator()); - - if(n_keep_front > 0) - { - X.cols( 0, (n_keep_front-1) ) = cols( 0, (in_col1-1) ); - } - - if(n_keep_back > 0) - { - X.cols( n_keep_front, (n_keep_front+n_keep_back-1) ) = cols( (in_col2+1), (n_cols-1) ); - } - - steal_mem(X); - } - - - -//! remove specified slices -template -inline -void -Cube::shed_slices(const uword in_slice1, const uword in_slice2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_slice1 > in_slice2) || (in_slice2 >= n_slices), - "Cube::shed_slices(): indices out of bounds or incorrectly used" - ); - - const uword n_keep_front = in_slice1; - const uword n_keep_back = n_slices - (in_slice2 + 1); - - Cube X(n_rows, n_cols, n_keep_front + n_keep_back, arma_nozeros_indicator()); - - if(n_keep_front > 0) - { - X.slices( 0, (n_keep_front-1) ) = slices( 0, (in_slice1-1) ); - } - - if(n_keep_back > 0) - { - X.slices( n_keep_front, (n_keep_front+n_keep_back-1) ) = slices( (in_slice2+1), (n_slices-1) ); - } - - steal_mem(X); - } - - - -//! remove specified slices -template -template -inline -void -Cube::shed_slices(const Base& indices) - { - arma_debug_sigprint(); - - const quasi_unwrap U(indices.get_ref()); - const Mat& tmp1 = U.M; - - arma_conform_check( ((tmp1.is_vec() == false) && (tmp1.is_empty() == false)), "Cube::shed_slices(): list of indices must be a vector" ); - - if(tmp1.is_empty()) { return; } - - const Col tmp2(const_cast(tmp1.memptr()), tmp1.n_elem, false, false); - - const Col& slices_to_shed = (tmp2.is_sorted("strictascend") == false) - ? Col(unique(tmp2)) - : Col(const_cast(tmp2.memptr()), tmp2.n_elem, false, false); - - const uword* slices_to_shed_mem = slices_to_shed.memptr(); - const uword N = slices_to_shed.n_elem; - - if(arma_config::check_conform) - { - for(uword i=0; i= n_slices), "Cube::shed_slices(): indices out of bounds" ); - } - } - - Col tmp3(n_slices, arma_nozeros_indicator()); - - uword* tmp3_mem = tmp3.memptr(); - - uword i = 0; - uword count = 0; - - for(uword j=0; j < n_slices; ++j) - { - if(i < N) - { - if( j != slices_to_shed_mem[i] ) - { - tmp3_mem[count] = j; - ++count; - } - else - { - ++i; - } - } - else - { - tmp3_mem[count] = j; - ++count; - } - } - - const Col slices_to_keep(tmp3.memptr(), count, false, false); - - Cube X = (*this).slices(slices_to_keep); - - steal_mem(X); - } - - - -template -inline -void -Cube::insert_rows(const uword row_num, const uword N, const bool set_to_zero) - { - arma_debug_sigprint(); - - arma_ignore(set_to_zero); - - (*this).insert_rows(row_num, N); - } - - - -template -inline -void -Cube::insert_rows(const uword row_num, const uword N) - { - arma_debug_sigprint(); - - const uword t_n_rows = n_rows; - - const uword A_n_rows = row_num; - const uword B_n_rows = t_n_rows - row_num; - - // insertion at row_num == n_rows is in effect an append operation - arma_conform_check_bounds( (row_num > t_n_rows), "Cube::insert_rows(): index out of bounds" ); - - if(N == 0) { return; } - - Cube out(t_n_rows + N, n_cols, n_slices, arma_nozeros_indicator()); - - if(A_n_rows > 0) - { - out.rows(0, A_n_rows-1) = rows(0, A_n_rows-1); - } - - if(B_n_rows > 0) - { - out.rows(row_num + N, t_n_rows + N - 1) = rows(row_num, t_n_rows-1); - } - - out.rows(row_num, row_num + N - 1).zeros(); - - steal_mem(out); - } - - - -template -inline -void -Cube::insert_cols(const uword col_num, const uword N, const bool set_to_zero) - { - arma_debug_sigprint(); - - arma_ignore(set_to_zero); - - (*this).insert_cols(col_num, N); - } - - - -template -inline -void -Cube::insert_cols(const uword col_num, const uword N) - { - arma_debug_sigprint(); - - const uword t_n_cols = n_cols; - - const uword A_n_cols = col_num; - const uword B_n_cols = t_n_cols - col_num; - - // insertion at col_num == n_cols is in effect an append operation - arma_conform_check_bounds( (col_num > t_n_cols), "Cube::insert_cols(): index out of bounds" ); - - if(N == 0) { return; } - - Cube out(n_rows, t_n_cols + N, n_slices, arma_nozeros_indicator()); - - if(A_n_cols > 0) - { - out.cols(0, A_n_cols-1) = cols(0, A_n_cols-1); - } - - if(B_n_cols > 0) - { - out.cols(col_num + N, t_n_cols + N - 1) = cols(col_num, t_n_cols-1); - } - - out.cols(col_num, col_num + N - 1).zeros(); - - steal_mem(out); - } - - - -template -inline -void -Cube::insert_slices(const uword slice_num, const uword N, const bool set_to_zero) - { - arma_debug_sigprint(); - - arma_ignore(set_to_zero); - - (*this).insert_slices(slice_num, N); - } - - - -template -inline -void -Cube::insert_slices(const uword slice_num, const uword N) - { - arma_debug_sigprint(); - - const uword t_n_slices = n_slices; - - const uword A_n_slices = slice_num; - const uword B_n_slices = t_n_slices - slice_num; - - // insertion at slice_num == n_slices is in effect an append operation - arma_conform_check_bounds( (slice_num > t_n_slices), "Cube::insert_slices(): index out of bounds" ); - - if(N == 0) { return; } - - Cube out(n_rows, n_cols, t_n_slices + N, arma_nozeros_indicator()); - - if(A_n_slices > 0) - { - out.slices(0, A_n_slices-1) = slices(0, A_n_slices-1); - } - - if(B_n_slices > 0) - { - out.slices(slice_num + N, t_n_slices + N - 1) = slices(slice_num, t_n_slices-1); - } - - //out.slices(slice_num, slice_num + N - 1).zeros(); - - for(uword i=slice_num; i < (slice_num + N); ++i) - { - arrayops::fill_zeros(out.slice_memptr(i), out.n_elem_slice); - } - - steal_mem(out); - } - - - -template -template -inline -void -Cube::insert_rows(const uword row_num, const BaseCube& X) - { - arma_debug_sigprint(); - - const unwrap_cube tmp(X.get_ref()); - const Cube& C = tmp.M; - - const uword N = C.n_rows; - - const uword t_n_rows = n_rows; - - const uword A_n_rows = row_num; - const uword B_n_rows = t_n_rows - row_num; - - // insertion at row_num == n_rows is in effect an append operation - arma_conform_check_bounds( (row_num > t_n_rows), "Cube::insert_rows(): index out of bounds" ); - - arma_conform_check - ( - ( (C.n_cols != n_cols) || (C.n_slices != n_slices) ), - "Cube::insert_rows(): given object has incompatible dimensions" - ); - - if(N == 0) { return; } - - Cube out(t_n_rows + N, n_cols, n_slices, arma_nozeros_indicator()); - - if(A_n_rows > 0) - { - out.rows(0, A_n_rows-1) = rows(0, A_n_rows-1); - } - - if(B_n_rows > 0) - { - out.rows(row_num + N, t_n_rows + N - 1) = rows(row_num, t_n_rows - 1); - } - - out.rows(row_num, row_num + N - 1) = C; - - steal_mem(out); - } - - - -template -template -inline -void -Cube::insert_cols(const uword col_num, const BaseCube& X) - { - arma_debug_sigprint(); - - const unwrap_cube tmp(X.get_ref()); - const Cube& C = tmp.M; - - const uword N = C.n_cols; - - const uword t_n_cols = n_cols; - - const uword A_n_cols = col_num; - const uword B_n_cols = t_n_cols - col_num; - - // insertion at col_num == n_cols is in effect an append operation - arma_conform_check_bounds( (col_num > t_n_cols), "Cube::insert_cols(): index out of bounds" ); - - arma_conform_check - ( - ( (C.n_rows != n_rows) || (C.n_slices != n_slices) ), - "Cube::insert_cols(): given object has incompatible dimensions" - ); - - if(N == 0) { return; } - - Cube out(n_rows, t_n_cols + N, n_slices, arma_nozeros_indicator()); - - if(A_n_cols > 0) - { - out.cols(0, A_n_cols-1) = cols(0, A_n_cols-1); - } - - if(B_n_cols > 0) - { - out.cols(col_num + N, t_n_cols + N - 1) = cols(col_num, t_n_cols - 1); - } - - out.cols(col_num, col_num + N - 1) = C; - - steal_mem(out); - } - - - -//! insert the given object at the specified slice position; -//! the given object must have the same number of rows and columns as the cube -template -template -inline -void -Cube::insert_slices(const uword slice_num, const BaseCube& X) - { - arma_debug_sigprint(); - - const unwrap_cube tmp(X.get_ref()); - const Cube& C = tmp.M; - - const uword N = C.n_slices; - - const uword t_n_slices = n_slices; - - const uword A_n_slices = slice_num; - const uword B_n_slices = t_n_slices - slice_num; - - // insertion at slice_num == n_slices is in effect an append operation - arma_conform_check_bounds( (slice_num > t_n_slices), "Cube::insert_slices(): index out of bounds" ); - - arma_conform_check - ( - ( (C.n_rows != n_rows) || (C.n_cols != n_cols) ), - "Cube::insert_slices(): given object has incompatible dimensions" - ); - - if(N == 0) { return; } - - Cube out(n_rows, n_cols, t_n_slices + N, arma_nozeros_indicator()); - - if(A_n_slices > 0) - { - out.slices(0, A_n_slices-1) = slices(0, A_n_slices-1); - } - - if(B_n_slices > 0) - { - out.slices(slice_num + N, t_n_slices + N - 1) = slices(slice_num, t_n_slices - 1); - } - - out.slices(slice_num, slice_num + N - 1) = C; - - steal_mem(out); - } - - - -template -template -inline -void -Cube::insert_slices(const uword slice_num, const Base& X) - { - arma_debug_sigprint(); - - const quasi_unwrap U(X.get_ref()); - - const Cube C(const_cast(U.M.memptr()), U.M.n_rows, U.M.n_cols, uword(1), false, true); - - (*this).insert_slices(slice_num, C); - } - - - -//! create a cube from GenCube, ie. run the previously delayed element generation operations -template -template -inline -Cube::Cube(const GenCube& X) - : n_rows(X.n_rows) - , n_cols(X.n_cols) - , n_elem_slice(X.n_rows*X.n_cols) - , n_slices(X.n_slices) - , n_elem(X.n_rows*X.n_cols*X.n_slices) - , n_alloc() - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - X.apply(*this); - } - - - -template -template -inline -Cube& -Cube::operator=(const GenCube& X) - { - arma_debug_sigprint(); - - init_warm(X.n_rows, X.n_cols, X.n_slices); - - X.apply(*this); - - return *this; - } - - - -template -template -inline -Cube& -Cube::operator+=(const GenCube& X) - { - arma_debug_sigprint(); - - X.apply_inplace_plus(*this); - - return *this; - } - - - -template -template -inline -Cube& -Cube::operator-=(const GenCube& X) - { - arma_debug_sigprint(); - - X.apply_inplace_minus(*this); - - return *this; - } - - - -template -template -inline -Cube& -Cube::operator%=(const GenCube& X) - { - arma_debug_sigprint(); - - X.apply_inplace_schur(*this); - - return *this; - } - - - -template -template -inline -Cube& -Cube::operator/=(const GenCube& X) - { - arma_debug_sigprint(); - - X.apply_inplace_div(*this); - - return *this; - } - - - -//! create a cube from OpCube, ie. run the previously delayed unary operations -template -template -inline -Cube::Cube(const OpCube& X) - : n_rows(0) - , n_cols(0) - , n_elem_slice(0) - , n_slices(0) - , n_elem(0) - , n_alloc(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - op_type::apply(*this, X); - } - - - -//! create a cube from OpCube, ie. run the previously delayed unary operations -template -template -inline -Cube& -Cube::operator=(const OpCube& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - op_type::apply(*this, X); - - return *this; - } - - - -//! in-place cube addition, with the right-hand-side operand having delayed operations -template -template -inline -Cube& -Cube::operator+=(const OpCube& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const Cube m(X); - - return (*this).operator+=(m); - } - - - -//! in-place cube subtraction, with the right-hand-side operand having delayed operations -template -template -inline -Cube& -Cube::operator-=(const OpCube& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const Cube m(X); - - return (*this).operator-=(m); - } - - - -//! in-place cube element-wise multiplication, with the right-hand-side operand having delayed operations -template -template -inline -Cube& -Cube::operator%=(const OpCube& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const Cube m(X); - - return (*this).operator%=(m); - } - - - -//! in-place cube element-wise division, with the right-hand-side operand having delayed operations -template -template -inline -Cube& -Cube::operator/=(const OpCube& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const Cube m(X); - - return (*this).operator/=(m); - } - - - -//! create a cube from eOpCube, ie. run the previously delayed unary operations -template -template -inline -Cube::Cube(const eOpCube& X) - : n_rows(X.get_n_rows()) - , n_cols(X.get_n_cols()) - , n_elem_slice(X.get_n_elem_slice()) - , n_slices(X.get_n_slices()) - , n_elem(X.get_n_elem()) - , n_alloc() - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - init_cold(); - - eop_type::apply(*this, X); - } - - - -//! create a cube from eOpCube, ie. run the previously delayed unary operations -template -template -inline -Cube& -Cube::operator=(const eOpCube& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const bool bad_alias = ( X.P.has_subview && X.P.is_alias(*this) ); - - if(bad_alias) { Cube tmp(X); steal_mem(tmp); return *this; } - - init_warm(X.get_n_rows(), X.get_n_cols(), X.get_n_slices()); - - eop_type::apply(*this, X); - - return *this; - } - - - -//! in-place cube addition, with the right-hand-side operand having delayed operations -template -template -inline -Cube& -Cube::operator+=(const eOpCube& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const bool bad_alias = ( X.P.has_subview && X.P.is_alias(*this) ); - - if(bad_alias) { const Cube tmp(X); return (*this).operator+=(tmp); } - - eop_type::apply_inplace_plus(*this, X); - - return *this; - } - - - -//! in-place cube subtraction, with the right-hand-side operand having delayed operations -template -template -inline -Cube& -Cube::operator-=(const eOpCube& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const bool bad_alias = ( X.P.has_subview && X.P.is_alias(*this) ); - - if(bad_alias) { const Cube tmp(X); return (*this).operator-=(tmp); } - - eop_type::apply_inplace_minus(*this, X); - - return *this; - } - - - -//! in-place cube element-wise multiplication, with the right-hand-side operand having delayed operations -template -template -inline -Cube& -Cube::operator%=(const eOpCube& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const bool bad_alias = ( X.P.has_subview && X.P.is_alias(*this) ); - - if(bad_alias) { const Cube tmp(X); return (*this).operator%=(tmp); } - - eop_type::apply_inplace_schur(*this, X); - - return *this; - } - - - -//! in-place cube element-wise division, with the right-hand-side operand having delayed operations -template -template -inline -Cube& -Cube::operator/=(const eOpCube& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const bool bad_alias = ( X.P.has_subview && X.P.is_alias(*this) ); - - if(bad_alias) { const Cube tmp(X); return (*this).operator/=(tmp); } - - eop_type::apply_inplace_div(*this, X); - - return *this; - } - - - -template -template -inline -Cube::Cube(const mtOpCube& X) - : n_rows(0) - , n_cols(0) - , n_elem_slice(0) - , n_slices(0) - , n_elem(0) - , n_alloc(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - op_type::apply(*this, X); - } - - - -template -template -inline -Cube& -Cube::operator=(const mtOpCube& X) - { - arma_debug_sigprint(); - - op_type::apply(*this, X); - - return *this; - } - - - -template -template -inline -Cube& -Cube::operator+=(const mtOpCube& X) - { - arma_debug_sigprint(); - - const Cube m(X); - - return (*this).operator+=(m); - } - - - -template -template -inline -Cube& -Cube::operator-=(const mtOpCube& X) - { - arma_debug_sigprint(); - - const Cube m(X); - - return (*this).operator-=(m); - } - - - -template -template -inline -Cube& -Cube::operator%=(const mtOpCube& X) - { - arma_debug_sigprint(); - - const Cube m(X); - - return (*this).operator%=(m); - } - - - -template -template -inline -Cube& -Cube::operator/=(const mtOpCube& X) - { - arma_debug_sigprint(); - - const Cube m(X); - - return (*this).operator/=(m); - } - - - -//! create a cube from GlueCube, ie. run the previously delayed binary operations -template -template -inline -Cube::Cube(const GlueCube& X) - : n_rows(0) - , n_cols(0) - , n_elem_slice(0) - , n_slices(0) - , n_elem(0) - , n_alloc(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - this->operator=(X); - } - - - -//! create a cube from GlueCube, ie. run the previously delayed binary operations -template -template -inline -Cube& -Cube::operator=(const GlueCube& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - glue_type::apply(*this, X); - - return *this; - } - - -//! in-place cube addition, with the right-hand-side operands having delayed operations -template -template -inline -Cube& -Cube::operator+=(const GlueCube& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const Cube m(X); - - return (*this).operator+=(m); - } - - - -//! in-place cube subtraction, with the right-hand-side operands having delayed operations -template -template -inline -Cube& -Cube::operator-=(const GlueCube& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const Cube m(X); - - return (*this).operator-=(m); - } - - - -//! in-place cube element-wise multiplication, with the right-hand-side operands having delayed operations -template -template -inline -Cube& -Cube::operator%=(const GlueCube& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const Cube m(X); - - return (*this).operator%=(m); - } - - - -//! in-place cube element-wise division, with the right-hand-side operands having delayed operations -template -template -inline -Cube& -Cube::operator/=(const GlueCube& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const Cube m(X); - - return (*this).operator/=(m); - } - - - -//! create a cube from eGlueCube, ie. run the previously delayed binary operations -template -template -inline -Cube::Cube(const eGlueCube& X) - : n_rows(X.get_n_rows()) - , n_cols(X.get_n_cols()) - , n_elem_slice(X.get_n_elem_slice()) - , n_slices(X.get_n_slices()) - , n_elem(X.get_n_elem()) - , n_alloc() - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - init_cold(); - - eglue_type::apply(*this, X); - } - - - -//! create a cube from eGlueCube, ie. run the previously delayed binary operations -template -template -inline -Cube& -Cube::operator=(const eGlueCube& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const bool bad_alias = ( (X.P1.has_subview && X.P1.is_alias(*this)) || (X.P2.has_subview && X.P2.is_alias(*this)) ); - - if(bad_alias) { Cube tmp(X); steal_mem(tmp); return *this; } - - init_warm(X.get_n_rows(), X.get_n_cols(), X.get_n_slices()); - - eglue_type::apply(*this, X); - - return *this; - } - - - -//! in-place cube addition, with the right-hand-side operands having delayed operations -template -template -inline -Cube& -Cube::operator+=(const eGlueCube& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const bool bad_alias = ( (X.P1.has_subview && X.P1.is_alias(*this)) || (X.P2.has_subview && X.P2.is_alias(*this)) ); - - if(bad_alias) { const Cube tmp(X); return (*this).operator+=(tmp); } - - eglue_type::apply_inplace_plus(*this, X); - - return *this; - } - - - -//! in-place cube subtraction, with the right-hand-side operands having delayed operations -template -template -inline -Cube& -Cube::operator-=(const eGlueCube& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const bool bad_alias = ( (X.P1.has_subview && X.P1.is_alias(*this)) || (X.P2.has_subview && X.P2.is_alias(*this)) ); - - if(bad_alias) { const Cube tmp(X); return (*this).operator-=(tmp); } - - eglue_type::apply_inplace_minus(*this, X); - - return *this; - } - - - -//! in-place cube element-wise multiplication, with the right-hand-side operands having delayed operations -template -template -inline -Cube& -Cube::operator%=(const eGlueCube& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const bool bad_alias = ( (X.P1.has_subview && X.P1.is_alias(*this)) || (X.P2.has_subview && X.P2.is_alias(*this)) ); - - if(bad_alias) { const Cube tmp(X); return (*this).operator%=(tmp); } - - eglue_type::apply_inplace_schur(*this, X); - - return *this; - } - - - -//! in-place cube element-wise division, with the right-hand-side operands having delayed operations -template -template -inline -Cube& -Cube::operator/=(const eGlueCube& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const bool bad_alias = ( (X.P1.has_subview && X.P1.is_alias(*this)) || (X.P2.has_subview && X.P2.is_alias(*this)) ); - - if(bad_alias) { const Cube tmp(X); return (*this).operator/=(tmp); } - - eglue_type::apply_inplace_div(*this, X); - - return *this; - } - - - -template -template -inline -Cube::Cube(const mtGlueCube& X) - : n_rows(0) - , n_cols(0) - , n_elem_slice(0) - , n_slices(0) - , n_elem(0) - , n_alloc(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - glue_type::apply(*this, X); - } - - - -template -template -inline -Cube& -Cube::operator=(const mtGlueCube& X) - { - arma_debug_sigprint(); - - glue_type::apply(*this, X); - - return *this; - } - - - -template -template -inline -Cube& -Cube::operator+=(const mtGlueCube& X) - { - arma_debug_sigprint(); - - const Cube m(X); - - return (*this).operator+=(m); - } - - - -template -template -inline -Cube& -Cube::operator-=(const mtGlueCube& X) - { - arma_debug_sigprint(); - - const Cube m(X); - - return (*this).operator-=(m); - } - - - -template -template -inline -Cube& -Cube::operator%=(const mtGlueCube& X) - { - arma_debug_sigprint(); - - const Cube m(X); - - return (*this).operator%=(m); - } - - - -template -template -inline -Cube& -Cube::operator/=(const mtGlueCube& X) - { - arma_debug_sigprint(); - - const Cube m(X); - - return (*this).operator/=(m); - } - - - -//! linear element accessor (treats the cube as a vector); no bounds check; assumes memory is aligned -template -arma_inline -const eT& -Cube::at_alt(const uword i) const - { - const eT* mem_aligned = mem; - - memory::mark_as_aligned(mem_aligned); - - return mem_aligned[i]; - } - - - -//! linear element accessor (treats the cube as a vector); bounds checking not done when ARMA_NO_DEBUG is defined -template -arma_inline -eT& -Cube::operator() (const uword i) - { - arma_conform_check_bounds( (i >= n_elem), "Cube::operator(): index out of bounds" ); - - return access::rw(mem[i]); - } - - - -//! linear element accessor (treats the cube as a vector); bounds checking not done when ARMA_NO_DEBUG is defined -template -arma_inline -const eT& -Cube::operator() (const uword i) const - { - arma_conform_check_bounds( (i >= n_elem), "Cube::operator(): index out of bounds" ); - - return mem[i]; - } - - -//! linear element accessor (treats the cube as a vector); no bounds check. -template -arma_inline -eT& -Cube::operator[] (const uword i) - { - return access::rw(mem[i]); - } - - - -//! linear element accessor (treats the cube as a vector); no bounds check -template -arma_inline -const eT& -Cube::operator[] (const uword i) const - { - return mem[i]; - } - - - -//! linear element accessor (treats the cube as a vector); no bounds check. -template -arma_inline -eT& -Cube::at(const uword i) - { - return access::rw(mem[i]); - } - - - -//! linear element accessor (treats the cube as a vector); no bounds check -template -arma_inline -const eT& -Cube::at(const uword i) const - { - return mem[i]; - } - - - -//! element accessor; bounds checking not done when ARMA_NO_DEBUG is defined -template -arma_inline -eT& -Cube::operator() (const uword in_row, const uword in_col, const uword in_slice) - { - arma_conform_check_bounds - ( - (in_row >= n_rows) || - (in_col >= n_cols) || - (in_slice >= n_slices) - , - "Cube::operator(): index out of bounds" - ); - - return access::rw(mem[in_slice*n_elem_slice + in_col*n_rows + in_row]); - } - - - -//! element accessor; bounds checking not done when ARMA_NO_DEBUG is defined -template -arma_inline -const eT& -Cube::operator() (const uword in_row, const uword in_col, const uword in_slice) const - { - arma_conform_check_bounds - ( - (in_row >= n_rows) || - (in_col >= n_cols) || - (in_slice >= n_slices) - , - "Cube::operator(): index out of bounds" - ); - - return mem[in_slice*n_elem_slice + in_col*n_rows + in_row]; - } - - - -#if defined(__cpp_multidimensional_subscript) - - //! element accessor; no bounds check - template - arma_inline - eT& - Cube::operator[] (const uword in_row, const uword in_col, const uword in_slice) - { - return access::rw( mem[in_slice*n_elem_slice + in_col*n_rows + in_row] ); - } - - - - //! element accessor; no bounds check - template - arma_inline - const eT& - Cube::operator[] (const uword in_row, const uword in_col, const uword in_slice) const - { - return mem[in_slice*n_elem_slice + in_col*n_rows + in_row]; - } - -#endif - - - -//! element accessor; no bounds check -template -arma_inline -eT& -Cube::at(const uword in_row, const uword in_col, const uword in_slice) - { - return access::rw( mem[in_slice*n_elem_slice + in_col*n_rows + in_row] ); - } - - - -//! element accessor; no bounds check -template -arma_inline -const eT& -Cube::at(const uword in_row, const uword in_col, const uword in_slice) const - { - return mem[in_slice*n_elem_slice + in_col*n_rows + in_row]; - } - - - -//! prefix ++ -template -arma_inline -const Cube& -Cube::operator++() - { - Cube_aux::prefix_pp(*this); - - return *this; - } - - - -//! postfix ++ (must not return the object by reference) -template -arma_inline -void -Cube::operator++(int) - { - Cube_aux::postfix_pp(*this); - } - - - -//! prefix -- -template -arma_inline -const Cube& -Cube::operator--() - { - Cube_aux::prefix_mm(*this); - return *this; - } - - - -//! postfix -- (must not return the object by reference) -template -arma_inline -void -Cube::operator--(int) - { - Cube_aux::postfix_mm(*this); - } - - - -//! returns true if the cube has no elements -template -arma_inline -bool -Cube::is_empty() const - { - return (n_elem == 0); - } - - - -template -inline -bool -Cube::internal_is_finite() const - { - arma_debug_sigprint(); - - return arrayops::is_finite(memptr(), n_elem); - } - - - -template -inline -bool -Cube::internal_has_inf() const - { - arma_debug_sigprint(); - - return arrayops::has_inf(memptr(), n_elem); - } - - - -template -inline -bool -Cube::internal_has_nan() const - { - arma_debug_sigprint(); - - return arrayops::has_nan(memptr(), n_elem); - } - - - -template -inline -bool -Cube::internal_has_nonfinite() const - { - arma_debug_sigprint(); - - return (arrayops::is_finite(memptr(), n_elem) == false); - } - - - -//! returns true if the given index is currently in range -template -arma_inline -bool -Cube::in_range(const uword i) const - { - return (i < n_elem); - } - - - -//! returns true if the given start and end indices are currently in range -template -arma_inline -bool -Cube::in_range(const span& x) const - { - arma_debug_sigprint(); - - if(x.whole) - { - return true; - } - else - { - const uword a = x.a; - const uword b = x.b; - - return ( (a <= b) && (b < n_elem) ); - } - } - - - -//! returns true if the given location is currently in range -template -arma_inline -bool -Cube::in_range(const uword in_row, const uword in_col, const uword in_slice) const - { - return ( (in_row < n_rows) && (in_col < n_cols) && (in_slice < n_slices) ); - } - - - -template -inline -bool -Cube::in_range(const span& row_span, const span& col_span, const span& slice_span) const - { - arma_debug_sigprint(); - - const uword in_row1 = row_span.a; - const uword in_row2 = row_span.b; - - const uword in_col1 = col_span.a; - const uword in_col2 = col_span.b; - - const uword in_slice1 = slice_span.a; - const uword in_slice2 = slice_span.b; - - - const bool rows_ok = row_span.whole ? true : ( (in_row1 <= in_row2) && (in_row2 < n_rows) ); - const bool cols_ok = col_span.whole ? true : ( (in_col1 <= in_col2) && (in_col2 < n_cols) ); - const bool slices_ok = slice_span.whole ? true : ( (in_slice1 <= in_slice2) && (in_slice2 < n_slices) ); - - - return ( rows_ok && cols_ok && slices_ok ); - } - - - -template -inline -bool -Cube::in_range(const uword in_row, const uword in_col, const uword in_slice, const SizeCube& s) const - { - const uword l_n_rows = n_rows; - const uword l_n_cols = n_cols; - const uword l_n_slices = n_slices; - - if( - ( in_row >= l_n_rows) || ( in_col >= l_n_cols) || ( in_slice >= l_n_slices) - || ((in_row + s.n_rows) > l_n_rows) || ((in_col + s.n_cols) > l_n_cols) || ((in_slice + s.n_slices) > l_n_slices) - ) - { - return false; - } - else - { - return true; - } - } - - - -//! returns a pointer to array of eTs used by the cube -template -arma_inline -eT* -Cube::memptr() - { - return const_cast(mem); - } - - - -//! returns a pointer to array of eTs used by the cube -template -arma_inline -const eT* -Cube::memptr() const - { - return mem; - } - - - -//! returns a pointer to array of eTs used by the specified slice in the cube -template -arma_inline -eT* -Cube::slice_memptr(const uword uslice) - { - return const_cast( &mem[ uslice*n_elem_slice ] ); - } - - - -//! returns a pointer to array of eTs used by the specified slice in the cube -template -arma_inline -const eT* -Cube::slice_memptr(const uword uslice) const - { - return &mem[ uslice*n_elem_slice ]; - } - - - -//! returns a pointer to array of eTs used by the specified slice in the cube -template -arma_inline -eT* -Cube::slice_colptr(const uword uslice, const uword col) - { - return const_cast( &mem[ uslice*n_elem_slice + col*n_rows] ); - } - - - -//! returns a pointer to array of eTs used by the specified slice in the cube -template -arma_inline -const eT* -Cube::slice_colptr(const uword uslice, const uword col) const - { - return &mem[ uslice*n_elem_slice + col*n_rows ]; - } - - - -//! change the cube to have user specified dimensions (data is not preserved) -template -inline -Cube& -Cube::set_size(const uword new_n_rows, const uword new_n_cols, const uword new_n_slices) - { - arma_debug_sigprint(); - - init_warm(new_n_rows, new_n_cols, new_n_slices); - - return *this; - } - - - -//! change the cube to have user specified dimensions (data is preserved) -template -inline -Cube& -Cube::reshape(const uword new_n_rows, const uword new_n_cols, const uword new_n_slices) - { - arma_debug_sigprint(); - - op_reshape::apply_cube_inplace((*this), new_n_rows, new_n_cols, new_n_slices); - - return *this; - } - - - -//! change the cube to have user specified dimensions (data is preserved) -template -inline -Cube& -Cube::resize(const uword new_n_rows, const uword new_n_cols, const uword new_n_slices) - { - arma_debug_sigprint(); - - op_resize::apply_cube_inplace((*this), new_n_rows, new_n_cols, new_n_slices); - - return *this; - } - - - -template -inline -Cube& -Cube::set_size(const SizeCube& s) - { - arma_debug_sigprint(); - - init_warm(s.n_rows, s.n_cols, s.n_slices); - - return *this; - } - - - -template -inline -Cube& -Cube::reshape(const SizeCube& s) - { - arma_debug_sigprint(); - - op_reshape::apply_cube_inplace((*this), s.n_rows, s.n_cols, s.n_slices); - - return *this; - } - - - -template -inline -Cube& -Cube::resize(const SizeCube& s) - { - arma_debug_sigprint(); - - op_resize::apply_cube_inplace((*this), s.n_rows, s.n_cols, s.n_slices); - - return *this; - } - - - -//! change the cube (without preserving data) to have the same dimensions as the given cube -template -template -inline -Cube& -Cube::copy_size(const Cube& m) - { - arma_debug_sigprint(); - - init_warm(m.n_rows, m.n_cols, m.n_slices); - - return *this; - } - - - -//! apply a functor to each element -template -template -inline -Cube& -Cube::for_each(functor F) - { - arma_debug_sigprint(); - - eT* data = memptr(); - - const uword N = n_elem; - - uword ii, jj; - - for(ii=0, jj=1; jj < N; ii+=2, jj+=2) - { - F(data[ii]); - F(data[jj]); - } - - if(ii < N) - { - F(data[ii]); - } - - return *this; - } - - - -template -template -inline -const Cube& -Cube::for_each(functor F) const - { - arma_debug_sigprint(); - - const eT* data = memptr(); - - const uword N = n_elem; - - uword ii, jj; - - for(ii=0, jj=1; jj < N; ii+=2, jj+=2) - { - F(data[ii]); - F(data[jj]); - } - - if(ii < N) - { - F(data[ii]); - } - - return *this; - } - - - -//! transform each element in the cube using a functor -template -template -inline -Cube& -Cube::transform(functor F) - { - arma_debug_sigprint(); - - eT* out_mem = memptr(); - - const uword N = n_elem; - - uword ii, jj; - - for(ii=0, jj=1; jj < N; ii+=2, jj+=2) - { - eT tmp_ii = out_mem[ii]; - eT tmp_jj = out_mem[jj]; - - tmp_ii = eT( F(tmp_ii) ); - tmp_jj = eT( F(tmp_jj) ); - - out_mem[ii] = tmp_ii; - out_mem[jj] = tmp_jj; - } - - if(ii < N) - { - out_mem[ii] = eT( F(out_mem[ii]) ); - } - - return *this; - } - - - -//! imbue (fill) the cube with values provided by a functor -template -template -inline -Cube& -Cube::imbue(functor F) - { - arma_debug_sigprint(); - - eT* out_mem = memptr(); - - const uword N = n_elem; - - uword ii, jj; - - for(ii=0, jj=1; jj < N; ii+=2, jj+=2) - { - const eT tmp_ii = eT( F() ); - const eT tmp_jj = eT( F() ); - - out_mem[ii] = tmp_ii; - out_mem[jj] = tmp_jj; - } - - if(ii < N) - { - out_mem[ii] = eT( F() ); - } - - return *this; - } - - - -template -inline -Cube& -Cube::replace(const eT old_val, const eT new_val) - { - arma_debug_sigprint(); - - arrayops::replace(memptr(), n_elem, old_val, new_val); - - return *this; - } - - - -template -inline -Cube& -Cube::clean(const typename get_pod_type::result threshold) - { - arma_debug_sigprint(); - - arrayops::clean(memptr(), n_elem, threshold); - - return *this; - } - - - -template -inline -Cube& -Cube::clamp(const eT min_val, const eT max_val) - { - arma_debug_sigprint(); - - if(is_cx::no) - { - arma_conform_check( (access::tmp_real(min_val) > access::tmp_real(max_val)), "Cube::clamp(): min_val must be less than max_val" ); - } - else - { - arma_conform_check( (access::tmp_real(min_val) > access::tmp_real(max_val)), "Cube::clamp(): real(min_val) must be less than real(max_val)" ); - arma_conform_check( (access::tmp_imag(min_val) > access::tmp_imag(max_val)), "Cube::clamp(): imag(min_val) must be less than imag(max_val)" ); - } - - arrayops::clamp(memptr(), n_elem, min_val, max_val); - - return *this; - } - - - -//! fill the cube with the specified value -template -inline -Cube& -Cube::fill(const eT val) - { - arma_debug_sigprint(); - - arrayops::inplace_set( memptr(), val, n_elem ); - - return *this; - } - - - -template -inline -Cube& -Cube::zeros() - { - arma_debug_sigprint(); - - arrayops::fill_zeros(memptr(), n_elem); - - return *this; - } - - - -template -inline -Cube& -Cube::zeros(const uword new_n_rows, const uword new_n_cols, const uword new_n_slices) - { - arma_debug_sigprint(); - - set_size(new_n_rows, new_n_cols, new_n_slices); - - return (*this).zeros(); - } - - - -template -inline -Cube& -Cube::zeros(const SizeCube& s) - { - arma_debug_sigprint(); - - return (*this).zeros(s.n_rows, s.n_cols, s.n_slices); - } - - - -template -inline -Cube& -Cube::ones() - { - arma_debug_sigprint(); - - return (*this).fill(eT(1)); - } - - - -template -inline -Cube& -Cube::ones(const uword new_n_rows, const uword new_n_cols, const uword new_n_slices) - { - arma_debug_sigprint(); - - set_size(new_n_rows, new_n_cols, new_n_slices); - - return (*this).fill(eT(1)); - } - - - -template -inline -Cube& -Cube::ones(const SizeCube& s) - { - arma_debug_sigprint(); - - return (*this).ones(s.n_rows, s.n_cols, s.n_slices); - } - - - -template -inline -Cube& -Cube::randu() - { - arma_debug_sigprint(); - - arma_rng::randu::fill( memptr(), n_elem ); - - return *this; - } - - - -template -inline -Cube& -Cube::randu(const uword new_n_rows, const uword new_n_cols, const uword new_n_slices) - { - arma_debug_sigprint(); - - set_size(new_n_rows, new_n_cols, new_n_slices); - - return (*this).randu(); - } - - - -template -inline -Cube& -Cube::randu(const SizeCube& s) - { - arma_debug_sigprint(); - - return (*this).randu(s.n_rows, s.n_cols, s.n_slices); - } - - - -template -inline -Cube& -Cube::randn() - { - arma_debug_sigprint(); - - arma_rng::randn::fill( memptr(), n_elem ); - - return *this; - } - - - -template -inline -Cube& -Cube::randn(const uword new_n_rows, const uword new_n_cols, const uword new_n_slices) - { - arma_debug_sigprint(); - - set_size(new_n_rows, new_n_cols, new_n_slices); - - return (*this).randn(); - } - - - -template -inline -Cube& -Cube::randn(const SizeCube& s) - { - arma_debug_sigprint(); - - return (*this).randn(s.n_rows, s.n_cols, s.n_slices); - } - - - -template -inline -void -Cube::reset() - { - arma_debug_sigprint(); - - init_warm(0,0,0); - } - - - -template -inline -void -Cube::soft_reset() - { - arma_debug_sigprint(); - - // don't change the size if the cube has a fixed size - if(mem_state <= 1) - { - reset(); - } - else - { - zeros(); - } - } - - - -template -template -inline -void -Cube::set_real(const BaseCube::pod_type,T1>& X) - { - arma_debug_sigprint(); - - Cube_aux::set_real(*this, X); - } - - - -template -template -inline -void -Cube::set_imag(const BaseCube::pod_type,T1>& X) - { - arma_debug_sigprint(); - - Cube_aux::set_imag(*this, X); - } - - - -template -inline -eT -Cube::min() const - { - arma_debug_sigprint(); - - if(n_elem == 0) - { - arma_conform_check(true, "Cube::min(): object has no elements"); - - return Datum::nan; - } - - return op_min::direct_min(memptr(), n_elem); - } - - - -template -inline -eT -Cube::max() const - { - arma_debug_sigprint(); - - if(n_elem == 0) - { - arma_conform_check(true, "Cube::max(): object has no elements"); - - return Datum::nan; - } - - return op_max::direct_max(memptr(), n_elem); - } - - - -template -inline -eT -Cube::min(uword& index_of_min_val) const - { - arma_debug_sigprint(); - - if(n_elem == 0) - { - arma_conform_check(true, "Cube::min(): object has no elements"); - - index_of_min_val = uword(0); - - return Datum::nan; - } - - return op_min::direct_min(memptr(), n_elem, index_of_min_val); - } - - - -template -inline -eT -Cube::max(uword& index_of_max_val) const - { - arma_debug_sigprint(); - - if(n_elem == 0) - { - arma_conform_check(true, "Cube::max(): object has no elements"); - - index_of_max_val = uword(0); - - return Datum::nan; - } - - return op_max::direct_max(memptr(), n_elem, index_of_max_val); - } - - - -template -inline -eT -Cube::min(uword& row_of_min_val, uword& col_of_min_val, uword& slice_of_min_val) const - { - arma_debug_sigprint(); - - if(n_elem == 0) - { - arma_conform_check(true, "Cube::min(): object has no elements"); - - row_of_min_val = uword(0); - col_of_min_val = uword(0); - slice_of_min_val = uword(0); - - return Datum::nan; - } - - uword i; - - eT val = op_min::direct_min(memptr(), n_elem, i); - - const uword in_slice = i / n_elem_slice; - const uword offset = in_slice * n_elem_slice; - const uword j = i - offset; - - row_of_min_val = j % n_rows; - col_of_min_val = j / n_rows; - slice_of_min_val = in_slice; - - return val; - } - - - -template -inline -eT -Cube::max(uword& row_of_max_val, uword& col_of_max_val, uword& slice_of_max_val) const - { - arma_debug_sigprint(); - - if(n_elem == 0) - { - arma_conform_check(true, "Cube::max(): object has no elements"); - - row_of_max_val = uword(0); - col_of_max_val = uword(0); - slice_of_max_val = uword(0); - - return Datum::nan; - } - - uword i; - - eT val = op_max::direct_max(memptr(), n_elem, i); - - const uword in_slice = i / n_elem_slice; - const uword offset = in_slice * n_elem_slice; - const uword j = i - offset; - - row_of_max_val = j % n_rows; - col_of_max_val = j / n_rows; - slice_of_max_val = in_slice; - - return val; - } - - - -//! save the cube to a file -template -inline -bool -Cube::save(const std::string name, const file_type type) const - { - arma_debug_sigprint(); - - bool save_okay = false; - - switch(type) - { - case raw_ascii: - save_okay = diskio::save_raw_ascii(*this, name); - break; - - case arma_ascii: - save_okay = diskio::save_arma_ascii(*this, name); - break; - - case raw_binary: - save_okay = diskio::save_raw_binary(*this, name); - break; - - case arma_binary: - save_okay = diskio::save_arma_binary(*this, name); - break; - - case ppm_binary: - save_okay = diskio::save_ppm_binary(*this, name); - break; - - case hdf5_binary: - return (*this).save(hdf5_name(name)); - break; - - case hdf5_binary_trans: // kept for compatibility with earlier versions of Armadillo - return (*this).save(hdf5_name(name, std::string(), hdf5_opts::trans)); - break; - - default: - arma_warn(1, "Cube::save(): unsupported file type"); - save_okay = false; - } - - if(save_okay == false) { arma_warn(3, "Cube::save(): write failed; file: ", name); } - - return save_okay; - } - - - -template -inline -bool -Cube::save(const hdf5_name& spec, const file_type type) const - { - arma_debug_sigprint(); - - // handling of hdf5_binary_trans kept for compatibility with earlier versions of Armadillo - - if( (type != hdf5_binary) && (type != hdf5_binary_trans) ) - { - arma_stop_runtime_error("Cube::save(): unsupported file type for hdf5_name()"); - return false; - } - - const bool do_trans = bool(spec.opts.flags & hdf5_opts::flag_trans ) || (type == hdf5_binary_trans); - const bool append = bool(spec.opts.flags & hdf5_opts::flag_append ); - const bool replace = bool(spec.opts.flags & hdf5_opts::flag_replace); - - if(append && replace) - { - arma_stop_runtime_error("Cube::save(): only one of 'append' or 'replace' options can be used"); - return false; - } - - bool save_okay = false; - std::string err_msg; - - if(do_trans) - { - Cube tmp; - - op_strans_cube::apply_noalias(tmp, (*this)); - - save_okay = diskio::save_hdf5_binary(tmp, spec, err_msg); - } - else - { - save_okay = diskio::save_hdf5_binary(*this, spec, err_msg); - } - - if(save_okay == false) - { - if(err_msg.length() > 0) - { - arma_warn(3, "Cube::save(): ", err_msg, "; file: ", spec.filename); - } - else - { - arma_warn(3, "Cube::save(): write failed; file: ", spec.filename); - } - } - - return save_okay; - } - - - -//! save the cube to a stream -template -inline -bool -Cube::save(std::ostream& os, const file_type type) const - { - arma_debug_sigprint(); - - bool save_okay = false; - - switch(type) - { - case raw_ascii: - save_okay = diskio::save_raw_ascii(*this, os); - break; - - case arma_ascii: - save_okay = diskio::save_arma_ascii(*this, os); - break; - - case raw_binary: - save_okay = diskio::save_raw_binary(*this, os); - break; - - case arma_binary: - save_okay = diskio::save_arma_binary(*this, os); - break; - - case ppm_binary: - save_okay = diskio::save_ppm_binary(*this, os); - break; - - default: - arma_warn(1, "Cube::save(): unsupported file type"); - save_okay = false; - } - - if(save_okay == false) { arma_warn(3, "Cube::save(): stream write failed"); } - - return save_okay; - } - - - -//! load a cube from a file -template -inline -bool -Cube::load(const std::string name, const file_type type) - { - arma_debug_sigprint(); - - bool load_okay = false; - std::string err_msg; - - switch(type) - { - case auto_detect: - load_okay = diskio::load_auto_detect(*this, name, err_msg); - break; - - case raw_ascii: - load_okay = diskio::load_raw_ascii(*this, name, err_msg); - break; - - case arma_ascii: - load_okay = diskio::load_arma_ascii(*this, name, err_msg); - break; - - case raw_binary: - load_okay = diskio::load_raw_binary(*this, name, err_msg); - break; - - case arma_binary: - load_okay = diskio::load_arma_binary(*this, name, err_msg); - break; - - case ppm_binary: - load_okay = diskio::load_ppm_binary(*this, name, err_msg); - break; - - case hdf5_binary: - return (*this).load(hdf5_name(name)); - break; - - case hdf5_binary_trans: // kept for compatibility with earlier versions of Armadillo - return (*this).load(hdf5_name(name, std::string(), hdf5_opts::trans)); - break; - - default: - arma_warn(1, "Cube::load(): unsupported file type"); - load_okay = false; - } - - if(load_okay == false) - { - (*this).soft_reset(); - - if(err_msg.length() > 0) - { - arma_warn(3, "Cube::load(): ", err_msg, "; file: ", name); - } - else - { - arma_warn(3, "Cube::load(): read failed; file: ", name); - } - } - - return load_okay; - } - - - -template -inline -bool -Cube::load(const hdf5_name& spec, const file_type type) - { - arma_debug_sigprint(); - - if( (type != hdf5_binary) && (type != hdf5_binary_trans) ) - { - arma_stop_runtime_error("Cube::load(): unsupported file type for hdf5_name()"); - return false; - } - - bool load_okay = false; - std::string err_msg; - - const bool do_trans = bool(spec.opts.flags & hdf5_opts::flag_trans) || (type == hdf5_binary_trans); - - if(do_trans) - { - Cube tmp; - - load_okay = diskio::load_hdf5_binary(tmp, spec, err_msg); - - if(load_okay) { op_strans_cube::apply_noalias((*this), tmp); } - } - else - { - load_okay = diskio::load_hdf5_binary(*this, spec, err_msg); - } - - - if(load_okay == false) - { - (*this).soft_reset(); - - if(err_msg.length() > 0) - { - arma_warn(3, "Cube::load(): ", err_msg, "; file: ", spec.filename); - } - else - { - arma_warn(3, "Cube::load(): read failed; file: ", spec.filename); - } - } - - return load_okay; - } - - - -//! load a cube from a stream -template -inline -bool -Cube::load(std::istream& is, const file_type type) - { - arma_debug_sigprint(); - - bool load_okay = false; - std::string err_msg; - - switch(type) - { - case auto_detect: - load_okay = diskio::load_auto_detect(*this, is, err_msg); - break; - - case raw_ascii: - load_okay = diskio::load_raw_ascii(*this, is, err_msg); - break; - - case arma_ascii: - load_okay = diskio::load_arma_ascii(*this, is, err_msg); - break; - - case raw_binary: - load_okay = diskio::load_raw_binary(*this, is, err_msg); - break; - - case arma_binary: - load_okay = diskio::load_arma_binary(*this, is, err_msg); - break; - - case ppm_binary: - load_okay = diskio::load_ppm_binary(*this, is, err_msg); - break; - - default: - arma_warn(1, "Cube::load(): unsupported file type"); - load_okay = false; - } - - if(load_okay == false) - { - (*this).soft_reset(); - - if(err_msg.length() > 0) - { - arma_warn(3, "Cube::load(): ", err_msg); - } - else - { - arma_warn(3, "Cube::load(): stream read failed"); - } - } - - return load_okay; - } - - - -template -inline -bool -Cube::quiet_save(const std::string name, const file_type type) const - { - arma_debug_sigprint(); - - return (*this).save(name, type); - } - - - -template -inline -bool -Cube::quiet_save(const hdf5_name& spec, const file_type type) const - { - arma_debug_sigprint(); - - return (*this).save(spec, type); - } - - - -template -inline -bool -Cube::quiet_save(std::ostream& os, const file_type type) const - { - arma_debug_sigprint(); - - return (*this).save(os, type); - } - - - -template -inline -bool -Cube::quiet_load(const std::string name, const file_type type) - { - arma_debug_sigprint(); - - return (*this).load(name, type); - } - - - -template -inline -bool -Cube::quiet_load(const hdf5_name& spec, const file_type type) - { - arma_debug_sigprint(); - - return (*this).load(spec, type); - } - - - -template -inline -bool -Cube::quiet_load(std::istream& is, const file_type type) - { - arma_debug_sigprint(); - - return (*this).load(is, type); - } - - - -template -inline -typename Cube::iterator -Cube::begin() - { - arma_debug_sigprint(); - - return memptr(); - } - - - -template -inline -typename Cube::const_iterator -Cube::begin() const - { - arma_debug_sigprint(); - - return memptr(); - } - - - -template -inline -typename Cube::const_iterator -Cube::cbegin() const - { - arma_debug_sigprint(); - - return memptr(); - } - - - -template -inline -typename Cube::iterator -Cube::end() - { - arma_debug_sigprint(); - - return memptr() + n_elem; - } - - - -template -inline -typename Cube::const_iterator -Cube::end() const - { - arma_debug_sigprint(); - - return memptr() + n_elem; - } - - - -template -inline -typename Cube::const_iterator -Cube::cend() const - { - arma_debug_sigprint(); - - return memptr() + n_elem; - } - - - -template -inline -typename Cube::slice_iterator -Cube::begin_slice(const uword slice_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (slice_num >= n_slices), "begin_slice(): index out of bounds" ); - - return slice_memptr(slice_num); - } - - - -template -inline -typename Cube::const_slice_iterator -Cube::begin_slice(const uword slice_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (slice_num >= n_slices), "begin_slice(): index out of bounds" ); - - return slice_memptr(slice_num); - } - - - -template -inline -typename Cube::slice_iterator -Cube::end_slice(const uword slice_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (slice_num >= n_slices), "end_slice(): index out of bounds" ); - - return slice_memptr(slice_num) + n_elem_slice; - } - - - -template -inline -typename Cube::const_slice_iterator -Cube::end_slice(const uword slice_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (slice_num >= n_slices), "end_slice(): index out of bounds" ); - - return slice_memptr(slice_num) + n_elem_slice; - } - - - -//! resets this cube to an empty matrix -template -inline -void -Cube::clear() - { - reset(); - } - - - -//! returns true if the cube has no elements -template -inline -bool -Cube::empty() const - { - return (n_elem == 0); - } - - - -//! returns the number of elements in this cube -template -inline -uword -Cube::size() const - { - return n_elem; - } - - - -template -inline -eT& -Cube::front() - { - arma_conform_check( (n_elem == 0), "Cube::front(): cube is empty" ); - - return access::rw(mem[0]); - } - - - -template -inline -const eT& -Cube::front() const - { - arma_conform_check( (n_elem == 0), "Cube::front(): cube is empty" ); - - return mem[0]; - } - - - -template -inline -eT& -Cube::back() - { - arma_conform_check( (n_elem == 0), "Cube::back(): cube is empty" ); - - return access::rw(mem[n_elem-1]); - } - - - -template -inline -const eT& -Cube::back() const - { - arma_conform_check( (n_elem == 0), "Cube::back(): cube is empty" ); - - return mem[n_elem-1]; - } - - - -template -inline -void -Cube::swap(Cube& B) - { - Cube& A = (*this); - - arma_debug_sigprint(arma_str::format("A: %x; B: %x") % &A % &B); - - if( (A.mem_state == 0) && (B.mem_state == 0) && (A.n_elem > Cube_prealloc::mem_n_elem) && (B.n_elem > Cube_prealloc::mem_n_elem) ) - { - A.delete_mat(); - B.delete_mat(); - - std::swap( access::rw(A.n_rows), access::rw(B.n_rows) ); - std::swap( access::rw(A.n_cols), access::rw(B.n_cols) ); - std::swap( access::rw(A.n_elem_slice), access::rw(B.n_elem_slice) ); - std::swap( access::rw(A.n_slices), access::rw(B.n_slices) ); - std::swap( access::rw(A.n_elem), access::rw(B.n_elem) ); - std::swap( access::rw(A.mem), access::rw(B.mem) ); - - A.create_mat(); - B.create_mat(); - } - else - if( (A.mem_state == 0) && (B.mem_state == 0) && (A.n_elem <= Cube_prealloc::mem_n_elem) && (B.n_elem <= Cube_prealloc::mem_n_elem) ) - { - A.delete_mat(); - B.delete_mat(); - - std::swap( access::rw(A.n_rows), access::rw(B.n_rows) ); - std::swap( access::rw(A.n_cols), access::rw(B.n_cols) ); - std::swap( access::rw(A.n_elem_slice), access::rw(B.n_elem_slice) ); - std::swap( access::rw(A.n_slices), access::rw(B.n_slices) ); - std::swap( access::rw(A.n_elem), access::rw(B.n_elem) ); - - const uword N = (std::max)(A.n_elem, B.n_elem); - - eT* A_mem = A.memptr(); - eT* B_mem = B.memptr(); - - for(uword i=0; i C = A; - - A.steal_mem(B); - B.steal_mem(C); - } - else - { - Cube C = B; - - B.steal_mem(A); - A.steal_mem(C); - } - } - } - - - -//! try to steal the memory from a given cube; -//! if memory can't be stolen, copy the given cube -template -inline -void -Cube::steal_mem(Cube& x) - { - arma_debug_sigprint(); - - (*this).steal_mem(x, false); - } - - - -template -inline -void -Cube::steal_mem(Cube& x, const bool is_move) - { - arma_debug_sigprint(); - - if(this == &x) { return; } - - if( (mem_state <= 1) && ( (x.n_alloc > Cube_prealloc::mem_n_elem) || (x.mem_state == 1) || (is_move && (x.mem_state == 2)) ) ) - { - arma_debug_print("Cube::steal_mem(): stealing memory"); - - reset(); - - const uword x_n_slices = x.n_slices; - - access::rw(n_rows) = x.n_rows; - access::rw(n_cols) = x.n_cols; - access::rw(n_elem_slice) = x.n_elem_slice; - access::rw(n_slices) = x_n_slices; - access::rw(n_elem) = x.n_elem; - access::rw(n_alloc) = x.n_alloc; - access::rw(mem_state) = x.mem_state; - access::rw(mem) = x.mem; - - if(x_n_slices > Cube_prealloc::mat_ptrs_size) - { - arma_debug_print("Cube::steal_mem(): stealing mat_ptrs array"); - - mat_ptrs = x.mat_ptrs; - x.mat_ptrs = nullptr; - } - else - { - arma_debug_print("Cube::steal_mem(): copying mat_ptrs array"); - - mat_ptrs = mat_ptrs_local; - - for(uword i=0; i < x_n_slices; ++i) - { - mat_ptrs[i] = raw_mat_ptr_type(x.mat_ptrs[i]); // cast required by std::atomic - x.mat_ptrs[i] = nullptr; - } - } - - access::rw(x.n_rows) = 0; - access::rw(x.n_cols) = 0; - access::rw(x.n_elem_slice) = 0; - access::rw(x.n_slices) = 0; - access::rw(x.n_elem) = 0; - access::rw(x.n_alloc) = 0; - access::rw(x.mem_state) = 0; - access::rw(x.mem) = nullptr; - } - else - { - arma_debug_print("Cube::steal_mem(): copying memory"); - - (*this).operator=(x); - - if( (is_move) && (x.mem_state == 0) && (x.n_alloc <= Cube_prealloc::mem_n_elem) ) - { - x.reset(); - } - } - } - - - -// -// Cube::fixed - - - -template -template -arma_inline -void -Cube::fixed::mem_setup() - { - arma_debug_sigprint(); - - if(fixed_n_elem > 0) - { - access::rw(Cube::n_rows) = fixed_n_rows; - access::rw(Cube::n_cols) = fixed_n_cols; - access::rw(Cube::n_elem_slice) = fixed_n_rows * fixed_n_cols; - access::rw(Cube::n_slices) = fixed_n_slices; - access::rw(Cube::n_elem) = fixed_n_elem; - access::rw(Cube::n_alloc) = 0; - access::rw(Cube::mem_state) = 3; - access::rw(Cube::mem) = (fixed_n_elem > Cube_prealloc::mem_n_elem) ? mem_local_extra : mem_local; - Cube::mat_ptrs = (fixed_n_slices > Cube_prealloc::mat_ptrs_size) ? mat_ptrs_local_extra : mat_ptrs_local; - - create_mat(); - } - else - { - access::rw(Cube::n_rows) = 0; - access::rw(Cube::n_cols) = 0; - access::rw(Cube::n_elem_slice) = 0; - access::rw(Cube::n_slices) = 0; - access::rw(Cube::n_elem) = 0; - access::rw(Cube::n_alloc) = 0; - access::rw(Cube::mem_state) = 3; - access::rw(Cube::mem) = nullptr; - Cube::mat_ptrs = nullptr; - } - } - - - -template -template -inline -Cube::fixed::fixed() - { - arma_debug_sigprint_this(this); - - mem_setup(); - - arma_debug_print("Cube::fixed::constructor: zeroing memory"); - - eT* mem_use = (use_extra) ? &(mem_local_extra[0]) : &(mem_local[0]); - - arrayops::fill_zeros(mem_use, fixed_n_elem); - } - - - -template -template -inline -Cube::fixed::fixed(const fixed& X) - { - arma_debug_sigprint_this(this); - - mem_setup(); - - eT* dest = (use_extra) ? mem_local_extra : mem_local; - const eT* src = (use_extra) ? X.mem_local_extra : X.mem_local; - - arrayops::copy( dest, src, fixed_n_elem ); - } - - - -template -template -inline -Cube::fixed::fixed(const fill::scalar_holder f) - { - arma_debug_sigprint_this(this); - - mem_setup(); - - (*this).fill(f.scalar); - } - - - -template -template -template -inline -Cube::fixed::fixed(const fill::fill_class&) - { - arma_debug_sigprint_this(this); - - mem_setup(); - - if(is_same_type::yes) { (*this).zeros(); } - if(is_same_type::yes) { (*this).ones(); } - if(is_same_type::yes) { (*this).randu(); } - if(is_same_type::yes) { (*this).randn(); } - - arma_static_check( (is_same_type::yes), "Cube::fixed::fixed(): unsupported fill type" ); - } - - - -template -template -template -inline -Cube::fixed::fixed(const BaseCube& A) - { - arma_debug_sigprint_this(this); - - mem_setup(); - - Cube::operator=(A.get_ref()); - } - - - -template -template -template -inline -Cube::fixed::fixed(const BaseCube& A, const BaseCube& B) - { - arma_debug_sigprint_this(this); - - mem_setup(); - - Cube::init(A,B); - } - - - -template -template -inline -Cube& -Cube::fixed::operator=(const fixed& X) - { - arma_debug_sigprint(); - - eT* dest = (use_extra) ? mem_local_extra : mem_local; - const eT* src = (use_extra) ? X.mem_local_extra : X.mem_local; - - arrayops::copy( dest, src, fixed_n_elem ); - - return *this; - } - - - -template -template -arma_inline -eT& -Cube::fixed::operator[] (const uword i) - { - return (use_extra) ? mem_local_extra[i] : mem_local[i]; - } - - - -template -template -arma_inline -const eT& -Cube::fixed::operator[] (const uword i) const - { - return (use_extra) ? mem_local_extra[i] : mem_local[i]; - } - - - -template -template -arma_inline -eT& -Cube::fixed::at(const uword i) - { - return (use_extra) ? mem_local_extra[i] : mem_local[i]; - } - - - -template -template -arma_inline -const eT& -Cube::fixed::at(const uword i) const - { - return (use_extra) ? mem_local_extra[i] : mem_local[i]; - } - - - -template -template -arma_inline -eT& -Cube::fixed::operator() (const uword i) - { - arma_conform_check_bounds( (i >= fixed_n_elem), "Cube::operator(): index out of bounds" ); - - return (use_extra) ? mem_local_extra[i] : mem_local[i]; - } - - - -template -template -arma_inline -const eT& -Cube::fixed::operator() (const uword i) const - { - arma_conform_check_bounds( (i >= fixed_n_elem), "Cube::operator(): index out of bounds" ); - - return (use_extra) ? mem_local_extra[i] : mem_local[i]; - } - - - -#if defined(__cpp_multidimensional_subscript) - - template - template - arma_inline - eT& - Cube::fixed::operator[] (const uword in_row, const uword in_col, const uword in_slice) - { - const uword i = in_slice*fixed_n_elem_slice + in_col*fixed_n_rows + in_row; - - return (use_extra) ? mem_local_extra[i] : mem_local[i]; - } - - - - template - template - arma_inline - const eT& - Cube::fixed::operator[] (const uword in_row, const uword in_col, const uword in_slice) const - { - const uword i = in_slice*fixed_n_elem_slice + in_col*fixed_n_rows + in_row; - - return (use_extra) ? mem_local_extra[i] : mem_local[i]; - } - -#endif - - - -template -template -arma_inline -eT& -Cube::fixed::at(const uword in_row, const uword in_col, const uword in_slice) - { - const uword i = in_slice*fixed_n_elem_slice + in_col*fixed_n_rows + in_row; - - return (use_extra) ? mem_local_extra[i] : mem_local[i]; - } - - - -template -template -arma_inline -const eT& -Cube::fixed::at(const uword in_row, const uword in_col, const uword in_slice) const - { - const uword i = in_slice*fixed_n_elem_slice + in_col*fixed_n_rows + in_row; - - return (use_extra) ? mem_local_extra[i] : mem_local[i]; - } - - - -template -template -arma_inline -eT& -Cube::fixed::operator() (const uword in_row, const uword in_col, const uword in_slice) - { - arma_conform_check_bounds - ( - (in_row >= fixed_n_rows ) || - (in_col >= fixed_n_cols ) || - (in_slice >= fixed_n_slices) - , - "operator(): index out of bounds" - ); - - const uword i = in_slice*fixed_n_elem_slice + in_col*fixed_n_rows + in_row; - - return (use_extra) ? mem_local_extra[i] : mem_local[i]; - } - - - -template -template -arma_inline -const eT& -Cube::fixed::operator() (const uword in_row, const uword in_col, const uword in_slice) const - { - arma_conform_check_bounds - ( - (in_row >= fixed_n_rows ) || - (in_col >= fixed_n_cols ) || - (in_slice >= fixed_n_slices) - , - "Cube::operator(): index out of bounds" - ); - - const uword i = in_slice*fixed_n_elem_slice + in_col*fixed_n_rows + in_row; - - return (use_extra) ? mem_local_extra[i] : mem_local[i]; - } - - - -// -// Cube_aux - - - -//! prefix ++ -template -arma_inline -void -Cube_aux::prefix_pp(Cube& x) - { - eT* memptr = x.memptr(); - const uword n_elem = x.n_elem; - - uword i,j; - - for(i=0, j=1; j -arma_inline -void -Cube_aux::prefix_pp(Cube< std::complex >& x) - { - x += T(1); - } - - - -//! postfix ++ -template -arma_inline -void -Cube_aux::postfix_pp(Cube& x) - { - eT* memptr = x.memptr(); - const uword n_elem = x.n_elem; - - uword i,j; - - for(i=0, j=1; j -arma_inline -void -Cube_aux::postfix_pp(Cube< std::complex >& x) - { - x += T(1); - } - - - -//! prefix -- -template -arma_inline -void -Cube_aux::prefix_mm(Cube& x) - { - eT* memptr = x.memptr(); - const uword n_elem = x.n_elem; - - uword i,j; - - for(i=0, j=1; j -arma_inline -void -Cube_aux::prefix_mm(Cube< std::complex >& x) - { - x -= T(1); - } - - - -//! postfix -- -template -arma_inline -void -Cube_aux::postfix_mm(Cube& x) - { - eT* memptr = x.memptr(); - const uword n_elem = x.n_elem; - - uword i,j; - - for(i=0, j=1; j -arma_inline -void -Cube_aux::postfix_mm(Cube< std::complex >& x) - { - x -= T(1); - } - - - -template -inline -void -Cube_aux::set_real(Cube& out, const BaseCube& X) - { - arma_debug_sigprint(); - - const unwrap_cube tmp(X.get_ref()); - const Cube& A = tmp.M; - - arma_conform_assert_same_size( out, A, "Cube::set_real()" ); - - out = A; - } - - - -template -inline -void -Cube_aux::set_imag(Cube&, const BaseCube&) - { - arma_debug_sigprint(); - } - - - -template -inline -void -Cube_aux::set_real(Cube< std::complex >& out, const BaseCube& X) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const ProxyCube P(X.get_ref()); - - const uword local_n_rows = P.get_n_rows(); - const uword local_n_cols = P.get_n_cols(); - const uword local_n_slices = P.get_n_slices(); - - arma_conform_assert_same_size - ( - out.n_rows, out.n_cols, out.n_slices, - local_n_rows, local_n_cols, local_n_slices, - "Cube::set_real()" - ); - - eT* out_mem = out.memptr(); - - if(ProxyCube::use_at == false) - { - typedef typename ProxyCube::ea_type ea_type; - - ea_type A = P.get_ea(); - - const uword N = out.n_elem; - - for(uword i=0; i -inline -void -Cube_aux::set_imag(Cube< std::complex >& out, const BaseCube& X) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const ProxyCube P(X.get_ref()); - - const uword local_n_rows = P.get_n_rows(); - const uword local_n_cols = P.get_n_cols(); - const uword local_n_slices = P.get_n_slices(); - - arma_conform_assert_same_size - ( - out.n_rows, out.n_cols, out.n_slices, - local_n_rows, local_n_cols, local_n_slices, - "Cube::set_imag()" - ); - - eT* out_mem = out.memptr(); - - if(ProxyCube::use_at == false) - { - typedef typename ProxyCube::ea_type ea_type; - - ea_type A = P.get_ea(); - - const uword N = out.n_elem; - - for(uword i=0; i -class GenCube - : public BaseCube< eT, GenCube > - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool use_at = false; - static constexpr bool is_simple = (is_same_type::value) || (is_same_type::value); - - arma_aligned const uword n_rows; - arma_aligned const uword n_cols; - arma_aligned const uword n_slices; - - arma_inline GenCube(const uword in_n_rows, const uword in_n_cols, const uword in_n_slices); - arma_inline ~GenCube(); - - arma_inline eT operator[] (const uword i) const; - arma_inline eT at (const uword r, const uword c, const uword s) const; - arma_inline eT at_alt (const uword i) const; - - inline void apply (Cube& out) const; - inline void apply_inplace_plus (Cube& out) const; - inline void apply_inplace_minus(Cube& out) const; - inline void apply_inplace_schur(Cube& out) const; - inline void apply_inplace_div (Cube& out) const; - - inline void apply(subview_cube& out) const; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/GenCube_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/GenCube_meat.hpp deleted file mode 100644 index 0700da396..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/GenCube_meat.hpp +++ /dev/null @@ -1,188 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup GenCube -//! @{ - - - -template -arma_inline -GenCube::GenCube(const uword in_n_rows, const uword in_n_cols, const uword in_n_slices) - : n_rows (in_n_rows ) - , n_cols (in_n_cols ) - , n_slices(in_n_slices) - { - arma_debug_sigprint(); - } - - - -template -arma_inline -GenCube::~GenCube() - { - arma_debug_sigprint(); - } - - - -template -arma_inline -eT -GenCube::operator[](const uword) const - { - if(is_same_type::yes) { return eT(0); } - else if(is_same_type::yes) { return eT(1); } - - return eT(0); // prevent pedantic compiler warnings - } - - - -template -arma_inline -eT -GenCube::at(const uword, const uword, const uword) const - { - if(is_same_type::yes) { return eT(0); } - else if(is_same_type::yes) { return eT(1); } - - return eT(0); // prevent pedantic compiler warnings - } - - - -template -arma_inline -eT -GenCube::at_alt(const uword) const - { - if(is_same_type::yes) { return eT(0); } - else if(is_same_type::yes) { return eT(1); } - - return eT(0); // prevent pedantic compiler warnings - } - - - -template -inline -void -GenCube::apply(Cube& out) const - { - arma_debug_sigprint(); - - // NOTE: we're assuming that the cube has already been set to the correct size; - // this is done by either the Cube contructor or operator=() - - if(is_same_type::yes) { out.zeros(); } - else if(is_same_type::yes) { out.ones(); } - } - - - -template -inline -void -GenCube::apply_inplace_plus(Cube& out) const - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, out.n_slices, n_rows, n_cols, n_slices, "addition"); - - if(is_same_type::yes) - { - arrayops::inplace_plus(out.memptr(), eT(1), out.n_elem); - } - } - - - - -template -inline -void -GenCube::apply_inplace_minus(Cube& out) const - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, out.n_slices, n_rows, n_cols, n_slices, "subtraction"); - - if(is_same_type::yes) - { - arrayops::inplace_minus(out.memptr(), eT(1), out.n_elem); - } - } - - - - -template -inline -void -GenCube::apply_inplace_schur(Cube& out) const - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, out.n_slices, n_rows, n_cols, n_slices, "element-wise multiplication"); - - if(is_same_type::yes) - { - arrayops::inplace_mul(out.memptr(), eT(0), out.n_elem); - // NOTE: not using arrayops::fill_zeros(), as 'out' may have NaN elements - } - } - - - - -template -inline -void -GenCube::apply_inplace_div(Cube& out) const - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, out.n_slices, n_rows, n_cols, n_slices, "element-wise division"); - - if(is_same_type::yes) - { - arrayops::inplace_div(out.memptr(), eT(0), out.n_elem); - } - } - - - -template -inline -void -GenCube::apply(subview_cube& out) const - { - arma_debug_sigprint(); - - // NOTE: we're assuming that the subcube has the same dimensions as the GenCube object - // this is checked by subview_cube::operator=() - - if(is_same_type::yes) { out.zeros(); } - else if(is_same_type::yes) { out.ones(); } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Gen_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Gen_bones.hpp deleted file mode 100644 index 172e5b9c2..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Gen_bones.hpp +++ /dev/null @@ -1,61 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup Gen -//! @{ - - -//! support class for generator functions (zeros, ones, eye) -template -class Gen - : public Base< typename T1::elem_type, Gen > - { - public: - - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool use_at = (is_same_type::value); - static constexpr bool is_simple = (is_same_type::value) || (is_same_type::value); - - static constexpr bool is_row = T1::is_row; - static constexpr bool is_col = T1::is_col; - static constexpr bool is_xvec = T1::is_xvec; - - arma_aligned const uword n_rows; - arma_aligned const uword n_cols; - - arma_inline Gen(const uword in_n_rows, const uword in_n_cols); - arma_inline ~Gen(); - - arma_inline elem_type operator[] (const uword ii) const; - arma_inline elem_type at (const uword r, const uword c) const; - arma_inline elem_type at_alt (const uword ii) const; - - inline void apply (Mat& out) const; - inline void apply_inplace_plus (Mat& out) const; - inline void apply_inplace_minus(Mat& out) const; - inline void apply_inplace_schur(Mat& out) const; - inline void apply_inplace_div (Mat& out) const; - - inline void apply(subview& out) const; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Gen_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Gen_meat.hpp deleted file mode 100644 index 76562135c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Gen_meat.hpp +++ /dev/null @@ -1,232 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup Gen -//! @{ - - - -template -arma_inline -Gen::Gen(const uword in_n_rows, const uword in_n_cols) - : n_rows(in_n_rows) - , n_cols(in_n_cols) - { - arma_debug_sigprint(); - } - - - -template -arma_inline -Gen::~Gen() - { - arma_debug_sigprint(); - } - - - -template -arma_inline -typename T1::elem_type -Gen::operator[](const uword ii) const - { - typedef typename T1::elem_type eT; - - if(is_same_type::yes) { return eT(0); } - else if(is_same_type::yes) { return eT(1); } - else if(is_same_type::yes) { return ((ii % n_rows) == (ii / n_rows)) ? eT(1) : eT(0); } - - return eT(0); // prevent pedantic compiler warnings - } - - - -template -arma_inline -typename T1::elem_type -Gen::at(const uword r, const uword c) const - { - typedef typename T1::elem_type eT; - - if(is_same_type::yes) { return eT(0); } - else if(is_same_type::yes) { return eT(1); } - else if(is_same_type::yes) { return (r == c) ? eT(1) : eT(0); } - - return eT(0); // prevent pedantic compiler warnings - } - - - -template -arma_inline -typename T1::elem_type -Gen::at_alt(const uword ii) const - { - return operator[](ii); - } - - - -template -inline -void -Gen::apply(Mat& out) const - { - arma_debug_sigprint(); - - // NOTE: we're assuming that the matrix has already been set to the correct size; - // this is done by either the Mat contructor or operator=() - - if(is_same_type::yes) { out.zeros(); } - else if(is_same_type::yes) { out.ones(); } - else if(is_same_type::yes) { out.eye(); } - } - - - -template -inline -void -Gen::apply_inplace_plus(Mat& out) const - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, n_rows, n_cols, "addition"); - - typedef typename T1::elem_type eT; - - if(is_same_type::yes) - { - arrayops::inplace_plus(out.memptr(), eT(1), out.n_elem); - } - else - if(is_same_type::yes) - { - const uword N = (std::min)(n_rows, n_cols); - - for(uword ii=0; ii < N; ++ii) { out.at(ii,ii) += eT(1); } - } - } - - - - -template -inline -void -Gen::apply_inplace_minus(Mat& out) const - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, n_rows, n_cols, "subtraction"); - - typedef typename T1::elem_type eT; - - if(is_same_type::yes) - { - arrayops::inplace_minus(out.memptr(), eT(1), out.n_elem); - } - else - if(is_same_type::yes) - { - const uword N = (std::min)(n_rows, n_cols); - - for(uword ii=0; ii < N; ++ii) { out.at(ii,ii) -= eT(1); } - } - } - - - - -template -inline -void -Gen::apply_inplace_schur(Mat& out) const - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, n_rows, n_cols, "element-wise multiplication"); - - typedef typename T1::elem_type eT; - - if(is_same_type::yes) - { - arrayops::inplace_mul(out.memptr(), eT(0), out.n_elem); - // NOTE: not using arrayops::fill_zeros(), as 'out' may have NaN elements - } - else - if(is_same_type::yes) - { - for(uword c=0; c < n_cols; ++c) - for(uword r=0; r < n_rows; ++r) - { - if(r != c) { out.at(r,c) *= eT(0); } - } - } - } - - - - -template -inline -void -Gen::apply_inplace_div(Mat& out) const - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, n_rows, n_cols, "element-wise division"); - - typedef typename T1::elem_type eT; - - if(is_same_type::yes) - { - arrayops::inplace_div(out.memptr(), eT(0), out.n_elem); - } - else - if(is_same_type::yes) - { - for(uword c=0; c < n_cols; ++c) - for(uword r=0; r < n_rows; ++r) - { - if(r != c) { out.at(r,c) /= eT(0); } - } - } - } - - - -template -inline -void -Gen::apply(subview& out) const - { - arma_debug_sigprint(); - - // NOTE: we're assuming that the submatrix has the same dimensions as the Gen object - // this is checked by subview::operator=() - - if(is_same_type::yes) { out.zeros(); } - else if(is_same_type::yes) { out.ones(); } - else if(is_same_type::yes) { out.eye(); } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/GlueCube_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/GlueCube_bones.hpp deleted file mode 100644 index 75173ef9a..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/GlueCube_bones.hpp +++ /dev/null @@ -1,42 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup GlueCube -//! @{ - - - -//! analog of the Glue class, intended for Cube objects -template -class GlueCube : public BaseCube< typename T1::elem_type, GlueCube > - { - public: - - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - - inline GlueCube(const BaseCube& in_A, const BaseCube& in_B); - inline ~GlueCube(); - - const T1& A; //!< first operand; must be derived from BaseCube - const T2& B; //!< second operand; must be derived from BaseCube - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/GlueCube_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/GlueCube_meat.hpp deleted file mode 100644 index 5140e5467..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/GlueCube_meat.hpp +++ /dev/null @@ -1,44 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup GlueCube -//! @{ - - - -template -inline -GlueCube::GlueCube(const BaseCube& in_A, const BaseCube& in_B) - : A(in_A.get_ref()) - , B(in_B.get_ref()) - { - arma_debug_sigprint(); - } - - - -template -inline -GlueCube::~GlueCube() - { - arma_debug_sigprint(); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Glue_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Glue_bones.hpp deleted file mode 100644 index 197ae7464..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Glue_bones.hpp +++ /dev/null @@ -1,66 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup Glue -//! @{ - - - -template -struct Glue_traits {}; - - -template -struct Glue_traits - { - static constexpr bool is_row = glue_type::template traits::is_row; - static constexpr bool is_col = glue_type::template traits::is_col; - static constexpr bool is_xvec = glue_type::template traits::is_xvec; - }; - -template -struct Glue_traits - { - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - }; - - -template -class Glue - : public Base< typename T1::elem_type, Glue > - , public Glue_traits::value> - { - public: - - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - - inline Glue(const T1& in_A, const T2& in_B); - inline Glue(const T1& in_A, const T2& in_B, const uword in_aux_uword); - inline ~Glue(); - - const T1& A; //!< first operand; must be derived from Base - const T2& B; //!< second operand; must be derived from Base - uword aux_uword; //!< storage of auxiliary data, uword format - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Glue_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Glue_meat.hpp deleted file mode 100644 index cf4cfc68f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Glue_meat.hpp +++ /dev/null @@ -1,56 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup Glue -//! @{ - - - -template -inline -Glue::Glue(const T1& in_A, const T2& in_B) - : A(in_A) - , B(in_B) - { - arma_debug_sigprint(); - } - - - -template -inline -Glue::Glue(const T1& in_A, const T2& in_B, const uword in_aux_uword) - : A(in_A) - , B(in_B) - , aux_uword(in_aux_uword) - { - arma_debug_sigprint(); - } - - - -template -inline -Glue::~Glue() - { - arma_debug_sigprint(); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/MapMat_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/MapMat_bones.hpp deleted file mode 100644 index 7ab46b067..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/MapMat_bones.hpp +++ /dev/null @@ -1,247 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup MapMat -//! @{ - - - -// this class is for internal use only; subject to change and/or removal without notice -template -class MapMat - { - public: - - typedef eT elem_type; //!< the type of elements stored in the matrix - typedef typename get_pod_type::result pod_type; //!< if eT is std::complex, pod_type is T; otherwise pod_type is eT - - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - const uword n_rows; //!< number of rows (read-only) - const uword n_cols; //!< number of columns (read-only) - const uword n_elem; //!< number of elements (read-only) - - - private: - - typedef typename std::map map_type; - - arma_aligned map_type* map_ptr; - - - public: - - inline ~MapMat(); - inline MapMat(); - - inline explicit MapMat(const uword in_n_rows, const uword in_n_cols); - inline explicit MapMat(const SizeMat& s); - - inline MapMat(const MapMat& x); - inline void operator=(const MapMat& x); - - inline explicit MapMat(const SpMat& x); - inline void operator=(const SpMat& x); - - inline MapMat(MapMat&& x); - inline void operator=(MapMat&& x); - - inline void reset(); - inline void set_size(const uword in_n_rows); - inline void set_size(const uword in_n_rows, const uword in_n_cols); - inline void set_size(const SizeMat& s); - - inline void zeros(); - inline void zeros(const uword in_n_rows); - inline void zeros(const uword in_n_rows, const uword in_n_cols); - inline void zeros(const SizeMat& s); - - inline void eye(); - inline void eye(const uword in_n_rows, const uword in_n_cols); - inline void eye(const SizeMat& s); - - inline void speye(); - inline void speye(const uword in_n_rows, const uword in_n_cols); - inline void speye(const SizeMat& s); - - arma_warn_unused arma_inline MapMat_val operator[](const uword index); - arma_warn_unused inline eT operator[](const uword index) const; - - arma_warn_unused arma_inline MapMat_val operator()(const uword index); - arma_warn_unused inline eT operator()(const uword index) const; - - arma_warn_unused arma_inline MapMat_val at(const uword in_row, const uword in_col); - arma_warn_unused inline eT at(const uword in_row, const uword in_col) const; - - arma_warn_unused arma_inline MapMat_val operator()(const uword in_row, const uword in_col); - arma_warn_unused inline eT operator()(const uword in_row, const uword in_col) const; - - arma_warn_unused inline bool is_empty() const; - arma_warn_unused inline bool is_vec() const; - arma_warn_unused inline bool is_rowvec() const; - arma_warn_unused inline bool is_colvec() const; - arma_warn_unused inline bool is_square() const; - - - inline void sprandu(const uword in_n_rows, const uword in_n_cols, const double density); - - inline void print(const std::string& extra_text) const; - - inline uword get_n_nonzero() const; - inline void get_locval_format(umat& locs, Col& vals) const; - - - private: - - inline void init_cold(); - inline void init_warm(const uword in_n_rows, const uword in_n_cols); - - arma_inline void set_val(const uword index, const eT& in_val); - inline void erase_val(const uword index); - - - friend class SpMat; - friend class MapMat_val; - friend class SpMat_MapMat_val; - friend class SpSubview_MapMat_val; - }; - - - -template -class MapMat_val - { - private: - - arma_aligned MapMat& parent; - - arma_aligned const uword index; - - inline MapMat_val(MapMat& in_parent, const uword in_index); - - friend class MapMat; - - - public: - - arma_inline operator eT() const; - - arma_inline typename get_pod_type::result real() const; - arma_inline typename get_pod_type::result imag() const; - - arma_inline void operator= (const MapMat_val& x); - arma_inline void operator= (const eT in_val); - arma_inline void operator+=(const eT in_val); - arma_inline void operator-=(const eT in_val); - arma_inline void operator*=(const eT in_val); - arma_inline void operator/=(const eT in_val); - - arma_inline void operator++(); - arma_inline void operator++(int); - - arma_inline void operator--(); - arma_inline void operator--(int); - }; - - - -template -class SpMat_MapMat_val - { - private: - - arma_aligned SpMat& s_parent; - arma_aligned MapMat& m_parent; - - arma_aligned const uword row; - arma_aligned const uword col; - - inline SpMat_MapMat_val(SpMat& in_s_parent, MapMat& in_m_parent, const uword in_row, const uword in_col); - - friend class SpMat; - friend class MapMat; - friend class SpSubview_MapMat_val; - - - public: - - inline operator eT() const; - - inline typename get_pod_type::result real() const; - inline typename get_pod_type::result imag() const; - - inline SpMat_MapMat_val& operator= (const SpMat_MapMat_val& x); - - inline SpMat_MapMat_val& operator= (const eT in_val); - inline SpMat_MapMat_val& operator+=(const eT in_val); - inline SpMat_MapMat_val& operator-=(const eT in_val); - inline SpMat_MapMat_val& operator*=(const eT in_val); - inline SpMat_MapMat_val& operator/=(const eT in_val); - - inline SpMat_MapMat_val& operator++(); - arma_warn_unused inline eT operator++(int); - - inline SpMat_MapMat_val& operator--(); - arma_warn_unused inline eT operator--(int); - - inline void set(const eT in_val); - inline void add(const eT in_val); - inline void sub(const eT in_val); - inline void mul(const eT in_val); - inline void div(const eT in_val); - }; - - - -template -class SpSubview_MapMat_val : public SpMat_MapMat_val - { - private: - - arma_inline SpSubview_MapMat_val(SpSubview& in_sv_parent, MapMat& in_m_parent, const uword in_row, const uword in_col); - - arma_aligned SpSubview& sv_parent; - - friend class SpMat; - friend class MapMat; - friend class SpSubview; - friend class SpMat_MapMat_val; - - - public: - - inline SpSubview_MapMat_val& operator= (const SpSubview_MapMat_val& x); - - inline SpSubview_MapMat_val& operator= (const eT in_val); - inline SpSubview_MapMat_val& operator+=(const eT in_val); - inline SpSubview_MapMat_val& operator-=(const eT in_val); - inline SpSubview_MapMat_val& operator*=(const eT in_val); - inline SpSubview_MapMat_val& operator/=(const eT in_val); - - inline SpSubview_MapMat_val& operator++(); - arma_warn_unused inline eT operator++(int); - - inline SpSubview_MapMat_val& operator--(); - arma_warn_unused inline eT operator--(int); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/MapMat_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/MapMat_meat.hpp deleted file mode 100644 index 9311511ba..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/MapMat_meat.hpp +++ /dev/null @@ -1,1778 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup MapMat -//! @{ - - - -template -inline -MapMat::~MapMat() - { - arma_debug_sigprint_this(this); - - if(map_ptr) { (*map_ptr).clear(); delete map_ptr; } - - // try to expose buggy user code that accesses deleted objects - map_ptr = nullptr; - - arma_type_check(( is_supported_elem_type::value == false )); - } - - - -template -inline -MapMat::MapMat() - : n_rows (0) - , n_cols (0) - , n_elem (0) - , map_ptr(nullptr) - { - arma_debug_sigprint_this(this); - - init_cold(); - } - - - -template -inline -MapMat::MapMat(const uword in_n_rows, const uword in_n_cols) - : n_rows (in_n_rows) - , n_cols (in_n_cols) - , n_elem (in_n_rows * in_n_cols) - , map_ptr(nullptr) - { - arma_debug_sigprint_this(this); - - init_cold(); - } - - - -template -inline -MapMat::MapMat(const SizeMat& s) - : n_rows (s.n_rows) - , n_cols (s.n_cols) - , n_elem (s.n_rows * s.n_cols) - , map_ptr(nullptr) - { - arma_debug_sigprint_this(this); - - init_cold(); - } - - - -template -inline -MapMat::MapMat(const MapMat& x) - : n_rows (0) - , n_cols (0) - , n_elem (0) - , map_ptr(nullptr) - { - arma_debug_sigprint_this(this); - - init_cold(); - - (*this).operator=(x); - } - - - -template -inline -void -MapMat::operator=(const MapMat& x) - { - arma_debug_sigprint(); - - if(this == &x) { return; } - - access::rw(n_rows) = x.n_rows; - access::rw(n_cols) = x.n_cols; - access::rw(n_elem) = x.n_elem; - - (*map_ptr) = *(x.map_ptr); - } - - - -template -inline -MapMat::MapMat(const SpMat& x) - : n_rows (0) - , n_cols (0) - , n_elem (0) - , map_ptr(nullptr) - { - arma_debug_sigprint_this(this); - - init_cold(); - - (*this).operator=(x); - } - - - -template -inline -void -MapMat::operator=(const SpMat& x) - { - arma_debug_sigprint(); - - const uword x_n_rows = x.n_rows; - const uword x_n_cols = x.n_cols; - - (*this).zeros(x_n_rows, x_n_cols); - - if(x.n_nonzero == 0) { return; } - - const eT* x_values = x.values; - const uword* x_row_indices = x.row_indices; - const uword* x_col_ptrs = x.col_ptrs; - - map_type& map_ref = (*map_ptr); - - for(uword col = 0; col < x_n_cols; ++col) - { - const uword start = x_col_ptrs[col ]; - const uword end = x_col_ptrs[col + 1]; - - for(uword i = start; i < end; ++i) - { - const uword row = x_row_indices[i]; - const eT val = x_values[i]; - - const uword index = (x_n_rows * col) + row; - - map_ref.emplace_hint(map_ref.cend(), index, val); - } - } - } - - - -template -inline -MapMat::MapMat(MapMat&& x) - : n_rows (x.n_rows ) - , n_cols (x.n_cols ) - , n_elem (x.n_elem ) - , map_ptr(x.map_ptr) - { - arma_debug_sigprint_this(this); - - access::rw(x.n_rows) = 0; - access::rw(x.n_cols) = 0; - access::rw(x.n_elem) = 0; - access::rw(x.map_ptr) = nullptr; - } - - - -template -inline -void -MapMat::operator=(MapMat&& x) - { - arma_debug_sigprint(); - - if(this == &x) { return; } - - reset(); - - if(map_ptr) { delete map_ptr; } - - access::rw(n_rows) = x.n_rows; - access::rw(n_cols) = x.n_cols; - access::rw(n_elem) = x.n_elem; - access::rw(map_ptr) = x.map_ptr; - - access::rw(x.n_rows) = 0; - access::rw(x.n_cols) = 0; - access::rw(x.n_elem) = 0; - access::rw(x.map_ptr) = nullptr; - } - - - -template -inline -void -MapMat::reset() - { - arma_debug_sigprint(); - - access::rw(n_rows) = 0; - access::rw(n_cols) = 0; - access::rw(n_elem) = 0; - - if((*map_ptr).empty() == false) { (*map_ptr).clear(); } - } - - - -template -inline -void -MapMat::set_size(const uword in_n_rows) - { - arma_debug_sigprint(); - - init_warm(in_n_rows, 1); - } - - - -template -inline -void -MapMat::set_size(const uword in_n_rows, const uword in_n_cols) - { - arma_debug_sigprint(); - - init_warm(in_n_rows, in_n_cols); - } - - - -template -inline -void -MapMat::set_size(const SizeMat& s) - { - arma_debug_sigprint(); - - init_warm(s.n_rows, s.n_cols); - } - - - -template -inline -void -MapMat::zeros() - { - arma_debug_sigprint(); - - (*map_ptr).clear(); - } - - - -template -inline -void -MapMat::zeros(const uword in_n_rows) - { - arma_debug_sigprint(); - - init_warm(in_n_rows, 1); - - (*map_ptr).clear(); - } - - - -template -inline -void -MapMat::zeros(const uword in_n_rows, const uword in_n_cols) - { - arma_debug_sigprint(); - - init_warm(in_n_rows, in_n_cols); - - (*map_ptr).clear(); - } - - - -template -inline -void -MapMat::zeros(const SizeMat& s) - { - arma_debug_sigprint(); - - init_warm(s.n_rows, s.n_cols); - - (*map_ptr).clear(); - } - - - -template -inline -void -MapMat::eye() - { - arma_debug_sigprint(); - - (*this).eye(n_rows, n_cols); - } - - - -template -inline -void -MapMat::eye(const uword in_n_rows, const uword in_n_cols) - { - arma_debug_sigprint(); - - zeros(in_n_rows, in_n_cols); - - const uword N = (std::min)(in_n_rows, in_n_cols); - - map_type& map_ref = (*map_ptr); - - for(uword i=0; i -inline -void -MapMat::eye(const SizeMat& s) - { - arma_debug_sigprint(); - - (*this).eye(s.n_rows, s.n_cols); - } - - - -template -inline -void -MapMat::speye() - { - arma_debug_sigprint(); - - (*this).eye(); - } - - - -template -inline -void -MapMat::speye(const uword in_n_rows, const uword in_n_cols) - { - arma_debug_sigprint(); - - (*this).eye(in_n_rows, in_n_cols); - } - - - -template -inline -void -MapMat::speye(const SizeMat& s) - { - arma_debug_sigprint(); - - (*this).eye(s); - } - - - -template -arma_inline -MapMat_val -MapMat::operator[](const uword index) - { - return MapMat_val(*this, index); - } - - - -template -inline -eT -MapMat::operator[](const uword index) const - { - map_type& map_ref = (*map_ptr); - - typename map_type::const_iterator it = map_ref.find(index); - typename map_type::const_iterator it_end = map_ref.end(); - - return (it != it_end) ? eT((*it).second) : eT(0); - } - - - -template -arma_inline -MapMat_val -MapMat::operator()(const uword index) - { - arma_conform_check_bounds( (index >= n_elem), "MapMat::operator(): index out of bounds" ); - - return MapMat_val(*this, index); - } - - - -template -inline -eT -MapMat::operator()(const uword index) const - { - arma_conform_check_bounds( (index >= n_elem), "MapMat::operator(): index out of bounds" ); - - map_type& map_ref = (*map_ptr); - - typename map_type::const_iterator it = map_ref.find(index); - typename map_type::const_iterator it_end = map_ref.end(); - - return (it != it_end) ? eT((*it).second) : eT(0); - } - - - -template -arma_inline -MapMat_val -MapMat::at(const uword in_row, const uword in_col) - { - const uword index = (n_rows * in_col) + in_row; - - return MapMat_val(*this, index); - } - - - -template -inline -eT -MapMat::at(const uword in_row, const uword in_col) const - { - const uword index = (n_rows * in_col) + in_row; - - map_type& map_ref = (*map_ptr); - - typename map_type::const_iterator it = map_ref.find(index); - typename map_type::const_iterator it_end = map_ref.end(); - - return (it != it_end) ? eT((*it).second) : eT(0); - } - - - -template -arma_inline -MapMat_val -MapMat::operator()(const uword in_row, const uword in_col) - { - arma_conform_check_bounds( ((in_row >= n_rows) || (in_col >= n_cols)), "MapMat::operator(): index out of bounds" ); - - const uword index = (n_rows * in_col) + in_row; - - return MapMat_val(*this, index); - } - - - -template -inline -eT -MapMat::operator()(const uword in_row, const uword in_col) const - { - arma_conform_check_bounds( ((in_row >= n_rows) || (in_col >= n_cols)), "MapMat::operator(): index out of bounds" ); - - const uword index = (n_rows * in_col) + in_row; - - map_type& map_ref = (*map_ptr); - - typename map_type::const_iterator it = map_ref.find(index); - typename map_type::const_iterator it_end = map_ref.end(); - - return (it != it_end) ? eT((*it).second) : eT(0); - } - - - -template -inline -bool -MapMat::is_empty() const - { - return (n_elem == 0); - } - - - -template -inline -bool -MapMat::is_vec() const - { - return ( (n_rows == 1) || (n_cols == 1) ); - } - - - -template -inline -bool -MapMat::is_rowvec() const - { - return (n_rows == 1); - } - - - -//! returns true if the object can be interpreted as a column vector -template -inline -bool -MapMat::is_colvec() const - { - return (n_cols == 1); - } - - - -template -inline -bool -MapMat::is_square() const - { - return (n_rows == n_cols); - } - - - -// this function is for debugging purposes only -template -inline -void -MapMat::sprandu(const uword in_n_rows, const uword in_n_cols, const double density) - { - arma_debug_sigprint(); - - zeros(in_n_rows, in_n_cols); - - const uword N = uword(density * double(n_elem)); - - const Col vals(N, fill::randu); - const Col indx = linspace< Col >(0, ((n_elem > 0) ? uword(n_elem-1) : uword(0)) , N); - - const eT* vals_mem = vals.memptr(); - const uword* indx_mem = indx.memptr(); - - map_type& map_ref = (*map_ptr); - - for(uword i=0; i < N; ++i) - { - const uword index = indx_mem[i]; - const eT val = vals_mem[i]; - - map_ref.emplace_hint(map_ref.cend(), index, val); - } - } - - - -// this function is for debugging purposes only -template -inline -void -MapMat::print(const std::string& extra_text) const - { - arma_debug_sigprint(); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = get_cout_stream().width(); - - get_cout_stream() << extra_text << '\n'; - - get_cout_stream().width(orig_width); - } - - map_type& map_ref = (*map_ptr); - - const uword n_nonzero = uword(map_ref.size()); - - const double density = (n_elem > 0) ? ((double(n_nonzero) / double(n_elem))*double(100)) : double(0); - - get_cout_stream() - << "[matrix size: " << n_rows << 'x' << n_cols << "; n_nonzero: " << n_nonzero - << "; density: " << density << "%]\n\n"; - - if(n_nonzero > 0) - { - typename map_type::const_iterator it = map_ref.begin(); - - for(uword i=0; i < n_nonzero; ++i) - { - const std::pair& entry = (*it); - - const uword index = entry.first; - const eT val = entry.second; - - const uword row = index % n_rows; - const uword col = index / n_rows; - - get_cout_stream() << '(' << row << ", " << col << ") "; - get_cout_stream() << val << '\n'; - - ++it; - } - } - - get_cout_stream().flush(); - } - - - -template -inline -uword -MapMat::get_n_nonzero() const - { - arma_debug_sigprint(); - - return uword((*map_ptr).size()); - } - - - -template -inline -void -MapMat::get_locval_format(umat& locs, Col& vals) const - { - arma_debug_sigprint(); - - map_type& map_ref = (*map_ptr); - - typename map_type::const_iterator it = map_ref.begin(); - - const uword N = uword(map_ref.size()); - - locs.set_size(2,N); - vals.set_size(N); - - eT* vals_mem = vals.memptr(); - - for(uword i=0; i& entry = (*it); - - const uword index = entry.first; - const eT val = entry.second; - - const uword row = index % n_rows; - const uword col = index / n_rows; - - uword* locs_colptr = locs.colptr(i); - - locs_colptr[0] = row; - locs_colptr[1] = col; - - vals_mem[i] = val; - - ++it; - } - } - - - -template -inline -void -MapMat::init_cold() - { - arma_debug_sigprint(); - - // ensure that n_elem can hold the result of (n_rows * n_cols) - - #if defined(ARMA_64BIT_WORD) - const char* error_message = "MapMat(): requested size is too large"; - #else - const char* error_message = "MapMat(): requested size is too large; suggest to enable ARMA_64BIT_WORD"; - #endif - - arma_conform_check - ( - ( - ( (n_rows > ARMA_MAX_UHWORD) || (n_cols > ARMA_MAX_UHWORD) ) - ? ( (double(n_rows) * double(n_cols)) > double(ARMA_MAX_UWORD) ) - : false - ), - error_message - ); - - map_ptr = new (std::nothrow) map_type; - - arma_check_bad_alloc( (map_ptr == nullptr), "MapMat(): out of memory" ); - } - - - -template -inline -void -MapMat::init_warm(const uword in_n_rows, const uword in_n_cols) - { - arma_debug_sigprint(); - - if( (n_rows == in_n_rows) && (n_cols == in_n_cols)) { return; } - - // ensure that n_elem can hold the result of (n_rows * n_cols) - - #if defined(ARMA_64BIT_WORD) - const char* error_message = "MapMat(): requested size is too large"; - #else - const char* error_message = "MapMat(): requested size is too large; suggest to enable ARMA_64BIT_WORD"; - #endif - - arma_conform_check - ( - ( - ( (in_n_rows > ARMA_MAX_UHWORD) || (in_n_cols > ARMA_MAX_UHWORD) ) - ? ( (double(in_n_rows) * double(in_n_cols)) > double(ARMA_MAX_UWORD) ) - : false - ), - error_message - ); - - const uword new_n_elem = in_n_rows * in_n_cols; - - access::rw(n_rows) = in_n_rows; - access::rw(n_cols) = in_n_cols; - access::rw(n_elem) = new_n_elem; - - if(new_n_elem == 0) { (*map_ptr).clear(); } - } - - - -template -arma_inline -void -MapMat::set_val(const uword index, const eT& in_val) - { - arma_debug_sigprint(); - - if(in_val != eT(0)) - { - map_type& map_ref = (*map_ptr); - - if( (map_ref.empty() == false) && (index > uword(map_ref.crbegin()->first)) ) - { - map_ref.emplace_hint(map_ref.cend(), index, in_val); - } - else - { - map_ref.operator[](index) = in_val; - } - } - else - { - (*this).erase_val(index); - } - } - - - -template -inline -void -MapMat::erase_val(const uword index) - { - arma_debug_sigprint(); - - map_type& map_ref = (*map_ptr); - - typename map_type::iterator it = map_ref.find(index); - typename map_type::iterator it_end = map_ref.end(); - - if(it != it_end) { map_ref.erase(it); } - } - - - - - - -// MapMat_val - - - -template -arma_inline -MapMat_val::MapMat_val(MapMat& in_parent, const uword in_index) - : parent(in_parent) - , index (in_index ) - { - arma_debug_sigprint(); - } - - - -template -arma_inline -MapMat_val::operator eT() const - { - arma_debug_sigprint(); - - const MapMat& const_parent = parent; - - return const_parent.operator[](index); - } - - - -template -arma_inline -typename get_pod_type::result -MapMat_val::real() const - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const MapMat& const_parent = parent; - - return T( access::tmp_real( const_parent.operator[](index) ) ); - } - - - -template -arma_inline -typename get_pod_type::result -MapMat_val::imag() const - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const MapMat& const_parent = parent; - - return T( access::tmp_imag( const_parent.operator[](index) ) ); - } - - - -template -arma_inline -void -MapMat_val::operator=(const MapMat_val& x) - { - arma_debug_sigprint(); - - const eT in_val = eT(x); - - parent.set_val(index, in_val); - } - - - -template -arma_inline -void -MapMat_val::operator=(const eT in_val) - { - arma_debug_sigprint(); - - parent.set_val(index, in_val); - } - - - -template -arma_inline -void -MapMat_val::operator+=(const eT in_val) - { - arma_debug_sigprint(); - - typename MapMat::map_type& map_ref = *(parent.map_ptr); - - if(in_val != eT(0)) - { - eT& val = map_ref.operator[](index); // creates the element if it doesn't exist - - val += in_val; - - if(val == eT(0)) { map_ref.erase(index); } - } - } - - - -template -arma_inline -void -MapMat_val::operator-=(const eT in_val) - { - arma_debug_sigprint(); - - typename MapMat::map_type& map_ref = *(parent.map_ptr); - - if(in_val != eT(0)) - { - eT& val = map_ref.operator[](index); // creates the element if it doesn't exist - - val -= in_val; - - if(val == eT(0)) { map_ref.erase(index); } - } - } - - - -template -arma_inline -void -MapMat_val::operator*=(const eT in_val) - { - arma_debug_sigprint(); - - typename MapMat::map_type& map_ref = *(parent.map_ptr); - - typename MapMat::map_type::iterator it = map_ref.find(index); - typename MapMat::map_type::iterator it_end = map_ref.end(); - - if(it != it_end) - { - if(in_val != eT(0)) - { - eT& val = (*it).second; - - val *= in_val; - - if(val == eT(0)) { map_ref.erase(it); } - } - else - { - map_ref.erase(it); - } - } - } - - - -template -arma_inline -void -MapMat_val::operator/=(const eT in_val) - { - arma_debug_sigprint(); - - typename MapMat::map_type& map_ref = *(parent.map_ptr); - - typename MapMat::map_type::iterator it = map_ref.find(index); - typename MapMat::map_type::iterator it_end = map_ref.end(); - - if(it != it_end) - { - eT& val = (*it).second; - - val /= in_val; - - if(val == eT(0)) { map_ref.erase(it); } - } - else - { - // silly operation, but included for completness - - const eT val = eT(0) / in_val; - - if(val != eT(0)) { parent.set_val(index, val); } - } - } - - - -template -arma_inline -void -MapMat_val::operator++() - { - arma_debug_sigprint(); - - typename MapMat::map_type& map_ref = *(parent.map_ptr); - - eT& val = map_ref.operator[](index); // creates the element if it doesn't exist - - val += eT(1); // can't use ++, as eT can be std::complex - - if(val == eT(0)) { map_ref.erase(index); } - } - - - -template -arma_inline -void -MapMat_val::operator++(int) - { - arma_debug_sigprint(); - - (*this).operator++(); - } - - - -template -arma_inline -void -MapMat_val::operator--() - { - arma_debug_sigprint(); - - typename MapMat::map_type& map_ref = *(parent.map_ptr); - - eT& val = map_ref.operator[](index); // creates the element if it doesn't exist - - val -= eT(1); // can't use --, as eT can be std::complex - - if(val == eT(0)) { map_ref.erase(index); } - } - - - -template -arma_inline -void -MapMat_val::operator--(int) - { - arma_debug_sigprint(); - - (*this).operator--(); - } - - - - - -// SpMat_MapMat_val - - - -template -arma_inline -SpMat_MapMat_val::SpMat_MapMat_val(SpMat& in_s_parent, MapMat& in_m_parent, const uword in_row, const uword in_col) - : s_parent(in_s_parent) - , m_parent(in_m_parent) - , row (in_row ) - , col (in_col ) - { - arma_debug_sigprint(); - } - - - -template -inline -SpMat_MapMat_val::operator eT() const - { - arma_debug_sigprint(); - - const SpMat& const_s_parent = s_parent; // declare as const for clarity of intent - - return const_s_parent.get_value(row,col); - } - - - -template -inline -typename get_pod_type::result -SpMat_MapMat_val::real() const - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const SpMat& const_s_parent = s_parent; // declare as const for clarity of intent - - return T( access::tmp_real( const_s_parent.get_value(row,col) ) ); - } - - - -template -inline -typename get_pod_type::result -SpMat_MapMat_val::imag() const - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const SpMat& const_s_parent = s_parent; // declare as const for clarity of intent - - return T( access::tmp_imag( const_s_parent.get_value(row,col) ) ); - } - - - -template -inline -SpMat_MapMat_val& -SpMat_MapMat_val::operator=(const SpMat_MapMat_val& x) - { - arma_debug_sigprint(); - - const eT in_val = eT(x); - - return (*this).operator=(in_val); - } - - - -template -inline -SpMat_MapMat_val& -SpMat_MapMat_val::operator=(const eT in_val) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_OPENMP) - { - #pragma omp critical (arma_SpMat_cache) - { - (*this).set(in_val); - } - } - #elif defined(ARMA_USE_STD_MUTEX) - { - const std::lock_guard lock(s_parent.cache_mutex); - - (*this).set(in_val); - } - #else - { - (*this).set(in_val); - } - #endif - - return *this; - } - - - -template -inline -SpMat_MapMat_val& -SpMat_MapMat_val::operator+=(const eT in_val) - { - arma_debug_sigprint(); - - if(in_val == eT(0)) { return *this; } - - #if defined(ARMA_USE_OPENMP) - { - #pragma omp critical (arma_SpMat_cache) - { - (*this).add(in_val); - } - } - #elif defined(ARMA_USE_STD_MUTEX) - { - const std::lock_guard lock(s_parent.cache_mutex); - - (*this).add(in_val); - } - #else - { - (*this).add(in_val); - } - #endif - - return *this; - } - - - -template -inline -SpMat_MapMat_val& -SpMat_MapMat_val::operator-=(const eT in_val) - { - arma_debug_sigprint(); - - if(in_val == eT(0)) { return *this; } - - #if defined(ARMA_USE_OPENMP) - { - #pragma omp critical (arma_SpMat_cache) - { - (*this).sub(in_val); - } - } - #elif defined(ARMA_USE_STD_MUTEX) - { - const std::lock_guard lock(s_parent.cache_mutex); - - (*this).sub(in_val); - } - #else - { - (*this).sub(in_val); - } - #endif - - return *this; - } - - - -template -inline -SpMat_MapMat_val& -SpMat_MapMat_val::operator*=(const eT in_val) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_OPENMP) - { - #pragma omp critical (arma_SpMat_cache) - { - (*this).mul(in_val); - } - } - #elif defined(ARMA_USE_STD_MUTEX) - { - const std::lock_guard lock(s_parent.cache_mutex); - - (*this).mul(in_val); - } - #else - { - (*this).mul(in_val); - } - #endif - - return *this; - } - - - -template -inline -SpMat_MapMat_val& -SpMat_MapMat_val::operator/=(const eT in_val) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_OPENMP) - { - #pragma omp critical (arma_SpMat_cache) - { - (*this).div(in_val); - } - } - #elif defined(ARMA_USE_STD_MUTEX) - { - const std::lock_guard lock(s_parent.cache_mutex); - - (*this).div(in_val); - } - #else - { - (*this).div(in_val); - } - #endif - - return *this; - } - - - -template -inline -SpMat_MapMat_val& -SpMat_MapMat_val::operator++() - { - arma_debug_sigprint(); - - return (*this).operator+=( eT(1) ); - } - - - -template -inline -eT -SpMat_MapMat_val::operator++(int) - { - arma_debug_sigprint(); - - const eT old_val = eT(*this); - - (*this).operator+=( eT(1) ); - - return old_val; - } - - - -template -inline -SpMat_MapMat_val& -SpMat_MapMat_val::operator--() - { - arma_debug_sigprint(); - - return (*this).operator-=( eT(1) ); - } - - - -template -inline -eT -SpMat_MapMat_val::operator--(int) - { - arma_debug_sigprint(); - - const eT old_val = eT(*this); - - (*this).operator-=( eT(1) ); - - return old_val; - } - - - -template -inline -void -SpMat_MapMat_val::set(const eT in_val) - { - arma_debug_sigprint(); - - const bool done = (s_parent.sync_state == 0) ? s_parent.try_set_value_csc(row, col, in_val) : false; - - if(done == false) - { - s_parent.sync_cache_simple(); - - const uword index = (m_parent.n_rows * col) + row; - - m_parent.set_val(index, in_val); - - s_parent.sync_state = 1; - - access::rw(s_parent.n_nonzero) = m_parent.get_n_nonzero(); - } - } - - - -template -inline -void -SpMat_MapMat_val::add(const eT in_val) - { - arma_debug_sigprint(); - - const bool done = (s_parent.sync_state == 0) ? s_parent.try_add_value_csc(row, col, in_val) : false; - - if(done == false) - { - s_parent.sync_cache_simple(); - - const uword index = (m_parent.n_rows * col) + row; - - typename MapMat::map_type& map_ref = *(m_parent.map_ptr); - - eT& val = map_ref.operator[](index); // creates the element if it doesn't exist - - val += in_val; - - if(val == eT(0)) { map_ref.erase(index); } - - s_parent.sync_state = 1; - - access::rw(s_parent.n_nonzero) = m_parent.get_n_nonzero(); - } - } - - - -template -inline -void -SpMat_MapMat_val::sub(const eT in_val) - { - arma_debug_sigprint(); - - const bool done = (s_parent.sync_state == 0) ? s_parent.try_sub_value_csc(row, col, in_val) : false; - - if(done == false) - { - s_parent.sync_cache_simple(); - - const uword index = (m_parent.n_rows * col) + row; - - typename MapMat::map_type& map_ref = *(m_parent.map_ptr); - - eT& val = map_ref.operator[](index); // creates the element if it doesn't exist - - val -= in_val; - - if(val == eT(0)) { map_ref.erase(index); } - - s_parent.sync_state = 1; - - access::rw(s_parent.n_nonzero) = m_parent.get_n_nonzero(); - } - } - - - -template -inline -void -SpMat_MapMat_val::mul(const eT in_val) - { - arma_debug_sigprint(); - - const bool done = (s_parent.sync_state == 0) ? s_parent.try_mul_value_csc(row, col, in_val) : false; - - if(done == false) - { - s_parent.sync_cache_simple(); - - const uword index = (m_parent.n_rows * col) + row; - - typename MapMat::map_type& map_ref = *(m_parent.map_ptr); - - typename MapMat::map_type::iterator it = map_ref.find(index); - typename MapMat::map_type::iterator it_end = map_ref.end(); - - if(it != it_end) - { - if(in_val != eT(0)) - { - eT& val = (*it).second; - - val *= in_val; - - if(val == eT(0)) { map_ref.erase(it); } - } - else - { - map_ref.erase(it); - } - - s_parent.sync_state = 1; - - access::rw(s_parent.n_nonzero) = m_parent.get_n_nonzero(); - } - else - { - // element not found, ie. it's zero; zero multiplied by anything is zero, except for nan and inf - if(arma_isfinite(in_val) == false) - { - const eT result = eT(0) * in_val; - - if(result != eT(0)) // paranoia, in case compiling with -ffast-math - { - m_parent.set_val(index, result); - - s_parent.sync_state = 1; - - access::rw(s_parent.n_nonzero) = m_parent.get_n_nonzero(); - } - } - } - } - } - - - -template -inline -void -SpMat_MapMat_val::div(const eT in_val) - { - arma_debug_sigprint(); - - const bool done = (s_parent.sync_state == 0) ? s_parent.try_div_value_csc(row, col, in_val) : false; - - if(done == false) - { - s_parent.sync_cache_simple(); - - const uword index = (m_parent.n_rows * col) + row; - - typename MapMat::map_type& map_ref = *(m_parent.map_ptr); - - typename MapMat::map_type::iterator it = map_ref.find(index); - typename MapMat::map_type::iterator it_end = map_ref.end(); - - if(it != it_end) - { - eT& val = (*it).second; - - val /= in_val; - - if(val == eT(0)) { map_ref.erase(it); } - - s_parent.sync_state = 1; - - access::rw(s_parent.n_nonzero) = m_parent.get_n_nonzero(); - } - else - { - // element not found, ie. it's zero; zero divided by anything is zero, except for zero and nan - if( (in_val == eT(0)) || (arma_isnan(in_val)) ) - { - const eT result = eT(0) / in_val; - - if(result != eT(0)) // paranoia, in case compiling with -ffast-math - { - m_parent.set_val(index, result); - - s_parent.sync_state = 1; - - access::rw(s_parent.n_nonzero) = m_parent.get_n_nonzero(); - } - } - } - } - } - - - - -// SpSubview_MapMat_val - - - -template -arma_inline -SpSubview_MapMat_val::SpSubview_MapMat_val(SpSubview& in_sv_parent, MapMat& in_m_parent, const uword in_row, const uword in_col) - : SpMat_MapMat_val(access::rw(in_sv_parent.m), in_m_parent, in_row, in_col) - , sv_parent(in_sv_parent) - { - arma_debug_sigprint(); - } - - - -template -inline -SpSubview_MapMat_val& -SpSubview_MapMat_val::operator=(const SpSubview_MapMat_val& x) - { - arma_debug_sigprint(); - - const eT in_val = eT(x); - - return (*this).operator=(in_val); - } - - - -template -inline -SpSubview_MapMat_val& -SpSubview_MapMat_val::operator=(const eT in_val) - { - arma_debug_sigprint(); - - const uword old_n_nonzero = sv_parent.m.n_nonzero; - - SpMat_MapMat_val::operator=(in_val); - - if(sv_parent.m.n_nonzero > old_n_nonzero) { access::rw(sv_parent.n_nonzero)++; } - if(sv_parent.m.n_nonzero < old_n_nonzero) { access::rw(sv_parent.n_nonzero)--; } - - return *this; - } - - - -template -inline -SpSubview_MapMat_val& -SpSubview_MapMat_val::operator+=(const eT in_val) - { - arma_debug_sigprint(); - - const uword old_n_nonzero = sv_parent.m.n_nonzero; - - SpMat_MapMat_val::operator+=(in_val); - - if(sv_parent.m.n_nonzero > old_n_nonzero) { access::rw(sv_parent.n_nonzero)++; } - if(sv_parent.m.n_nonzero < old_n_nonzero) { access::rw(sv_parent.n_nonzero)--; } - - return *this; - } - - - -template -inline -SpSubview_MapMat_val& -SpSubview_MapMat_val::operator-=(const eT in_val) - { - arma_debug_sigprint(); - - const uword old_n_nonzero = sv_parent.m.n_nonzero; - - SpMat_MapMat_val::operator-=(in_val); - - if(sv_parent.m.n_nonzero > old_n_nonzero) { access::rw(sv_parent.n_nonzero)++; } - if(sv_parent.m.n_nonzero < old_n_nonzero) { access::rw(sv_parent.n_nonzero)--; } - - return *this; - } - - - -template -inline -SpSubview_MapMat_val& -SpSubview_MapMat_val::operator*=(const eT in_val) - { - arma_debug_sigprint(); - - const uword old_n_nonzero = sv_parent.m.n_nonzero; - - SpMat_MapMat_val::operator*=(in_val); - - if(sv_parent.m.n_nonzero > old_n_nonzero) { access::rw(sv_parent.n_nonzero)++; } - if(sv_parent.m.n_nonzero < old_n_nonzero) { access::rw(sv_parent.n_nonzero)--; } - - return *this; - } - - - -template -inline -SpSubview_MapMat_val& -SpSubview_MapMat_val::operator/=(const eT in_val) - { - arma_debug_sigprint(); - - const uword old_n_nonzero = sv_parent.m.n_nonzero; - - SpMat_MapMat_val::operator/=(in_val); - - if(sv_parent.m.n_nonzero > old_n_nonzero) { access::rw(sv_parent.n_nonzero)++; } - if(sv_parent.m.n_nonzero < old_n_nonzero) { access::rw(sv_parent.n_nonzero)--; } - - return *this; - } - - - -template -inline -SpSubview_MapMat_val& -SpSubview_MapMat_val::operator++() - { - arma_debug_sigprint(); - - const uword old_n_nonzero = sv_parent.m.n_nonzero; - - SpMat_MapMat_val::operator++(); - - if(sv_parent.m.n_nonzero > old_n_nonzero) { access::rw(sv_parent.n_nonzero)++; } - if(sv_parent.m.n_nonzero < old_n_nonzero) { access::rw(sv_parent.n_nonzero)--; } - - return *this; - } - - - -template -inline -eT -SpSubview_MapMat_val::operator++(int) - { - arma_debug_sigprint(); - - const uword old_n_nonzero = sv_parent.m.n_nonzero; - - const eT old_val = SpMat_MapMat_val::operator++(int(0)); - - if(sv_parent.m.n_nonzero > old_n_nonzero) { access::rw(sv_parent.n_nonzero)++; } - if(sv_parent.m.n_nonzero < old_n_nonzero) { access::rw(sv_parent.n_nonzero)--; } - - return old_val; - } - - - -template -inline -SpSubview_MapMat_val& -SpSubview_MapMat_val::operator--() - { - arma_debug_sigprint(); - - const uword old_n_nonzero = sv_parent.m.n_nonzero; - - SpMat_MapMat_val::operator--(); - - if(sv_parent.m.n_nonzero > old_n_nonzero) { access::rw(sv_parent.n_nonzero)++; } - if(sv_parent.m.n_nonzero < old_n_nonzero) { access::rw(sv_parent.n_nonzero)--; } - - return *this; - } - - - -template -inline -eT -SpSubview_MapMat_val::operator--(int) - { - arma_debug_sigprint(); - - const uword old_n_nonzero = sv_parent.m.n_nonzero; - - const eT old_val = SpMat_MapMat_val::operator--(int(0)); - - if(sv_parent.m.n_nonzero > old_n_nonzero) { access::rw(sv_parent.n_nonzero)++; } - if(sv_parent.m.n_nonzero < old_n_nonzero) { access::rw(sv_parent.n_nonzero)--; } - - return old_val; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Mat_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Mat_bones.hpp deleted file mode 100644 index 079c9f1ac..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Mat_bones.hpp +++ /dev/null @@ -1,955 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup Mat -//! @{ - - - -//! Dense matrix class - -template -class Mat : public Base< eT, Mat > - { - public: - - typedef eT elem_type; //!< the type of elements stored in the matrix - typedef typename get_pod_type::result pod_type; //!< if eT is std::complex, pod_type is T; otherwise pod_type is eT - - const uword n_rows; //!< number of rows (read-only) - const uword n_cols; //!< number of columns (read-only) - const uword n_elem; //!< number of elements (read-only) - const uword n_alloc; //!< number of allocated elements (read-only); NOTE: n_alloc can be 0, even if n_elem > 0 - const uhword vec_state; //!< 0: matrix layout; 1: column vector layout; 2: row vector layout - const uhword mem_state; - - // mem_state = 0: normal matrix which manages its own memory - // mem_state = 1: use auxiliary memory until a size change - // mem_state = 2: use auxiliary memory and don't allow the number of elements to be changed - // mem_state = 3: fixed size (eg. via template based size specification) - - arma_aligned const eT* const mem; //!< pointer to the memory used for storing elements (memory is read-only) - - - protected: - - arma_align_mem eT mem_local[ arma_config::mat_prealloc ]; // local storage, for small vectors and matrices - - - public: - - static constexpr bool is_col = false; - static constexpr bool is_row = false; - static constexpr bool is_xvec = false; - - inline ~Mat(); - inline Mat(); - - inline explicit Mat(const uword in_n_rows, const uword in_n_cols); - inline explicit Mat(const SizeMat& s); - - template inline explicit Mat(const uword in_n_rows, const uword in_n_cols, const arma_initmode_indicator&); - template inline explicit Mat(const SizeMat& s, const arma_initmode_indicator&); - - template inline Mat(const uword in_n_rows, const uword in_n_cols, const fill::fill_class& f); - template inline Mat(const SizeMat& s, const fill::fill_class& f); - - inline Mat(const uword in_n_rows, const uword in_n_cols, const fill::scalar_holder f); - inline Mat(const SizeMat& s, const fill::scalar_holder f); - - arma_cold inline Mat(const char* text); - arma_cold inline Mat& operator=(const char* text); - - arma_cold inline Mat(const std::string& text); - arma_cold inline Mat& operator=(const std::string& text); - - inline Mat(const std::vector& x); - inline Mat& operator=(const std::vector& x); - - inline Mat(const std::initializer_list& list); - inline Mat& operator=(const std::initializer_list& list); - - inline Mat(const std::initializer_list< std::initializer_list >& list); - inline Mat& operator=(const std::initializer_list< std::initializer_list >& list); - - inline Mat(Mat&& m); - inline Mat& operator=(Mat&& m); - - inline Mat( eT* aux_mem, const uword aux_n_rows, const uword aux_n_cols, const bool copy_aux_mem = true, const bool strict = false); - inline Mat(const eT* aux_mem, const uword aux_n_rows, const uword aux_n_cols); - - inline Mat& operator= (const eT val); - inline Mat& operator+=(const eT val); - inline Mat& operator-=(const eT val); - inline Mat& operator*=(const eT val); - inline Mat& operator/=(const eT val); - - inline Mat(const Mat& m); - inline Mat& operator= (const Mat& m); - inline Mat& operator+=(const Mat& m); - inline Mat& operator-=(const Mat& m); - inline Mat& operator*=(const Mat& m); - inline Mat& operator%=(const Mat& m); - inline Mat& operator/=(const Mat& m); - - template inline Mat(const BaseCube& X); - template inline Mat& operator= (const BaseCube& X); - template inline Mat& operator+=(const BaseCube& X); - template inline Mat& operator-=(const BaseCube& X); - template inline Mat& operator*=(const BaseCube& X); - template inline Mat& operator%=(const BaseCube& X); - template inline Mat& operator/=(const BaseCube& X); - - template - inline explicit Mat(const Base& A, const Base& B); - - inline explicit Mat(const subview& X, const bool use_colmem); // only to be used by the quasi_unwrap class - - inline Mat(const subview& X); - inline Mat& operator= (const subview& X); - inline Mat& operator+=(const subview& X); - inline Mat& operator-=(const subview& X); - inline Mat& operator*=(const subview& X); - inline Mat& operator%=(const subview& X); - inline Mat& operator/=(const subview& X); - - inline Mat(const subview_row_strans& X); // subview_row_strans can only be generated by the Proxy class - inline Mat(const subview_row_htrans& X); // subview_row_htrans can only be generated by the Proxy class - inline Mat(const xvec_htrans& X); // xvec_htrans can only be generated by the Proxy class - - template - inline Mat(const xtrans_mat& X); // xtrans_mat can only be generated by the Proxy class - - inline Mat(const subview_cube& X); - inline Mat& operator= (const subview_cube& X); - inline Mat& operator+=(const subview_cube& X); - inline Mat& operator-=(const subview_cube& X); - inline Mat& operator*=(const subview_cube& X); - inline Mat& operator%=(const subview_cube& X); - inline Mat& operator/=(const subview_cube& X); - - inline Mat(const diagview& X); - inline Mat& operator= (const diagview& X); - inline Mat& operator+=(const diagview& X); - inline Mat& operator-=(const diagview& X); - inline Mat& operator*=(const diagview& X); - inline Mat& operator%=(const diagview& X); - inline Mat& operator/=(const diagview& X); - - template inline Mat(const subview_elem1& X); - template inline Mat& operator= (const subview_elem1& X); - template inline Mat& operator+=(const subview_elem1& X); - template inline Mat& operator-=(const subview_elem1& X); - template inline Mat& operator*=(const subview_elem1& X); - template inline Mat& operator%=(const subview_elem1& X); - template inline Mat& operator/=(const subview_elem1& X); - - template inline Mat(const subview_elem2& X); - template inline Mat& operator= (const subview_elem2& X); - template inline Mat& operator+=(const subview_elem2& X); - template inline Mat& operator-=(const subview_elem2& X); - template inline Mat& operator*=(const subview_elem2& X); - template inline Mat& operator%=(const subview_elem2& X); - template inline Mat& operator/=(const subview_elem2& X); - - // Operators on sparse matrices (and subviews) - template inline explicit Mat(const SpBase& m); - template inline Mat& operator= (const SpBase& m); - template inline Mat& operator+=(const SpBase& m); - template inline Mat& operator-=(const SpBase& m); - template inline Mat& operator*=(const SpBase& m); - template inline Mat& operator%=(const SpBase& m); - template inline Mat& operator/=(const SpBase& m); - - inline explicit Mat(const SpSubview& X); - inline Mat& operator= (const SpSubview& X); - inline Mat& operator+=(const SpSubview& X); - inline Mat& operator-=(const SpSubview& X); - - inline explicit Mat(const spdiagview& X); - inline Mat& operator= (const spdiagview& X); - inline Mat& operator+=(const spdiagview& X); - inline Mat& operator-=(const spdiagview& X); - inline Mat& operator*=(const spdiagview& X); - inline Mat& operator%=(const spdiagview& X); - inline Mat& operator/=(const spdiagview& X); - - - arma_frown("use braced initialiser list instead") inline mat_injector operator<<(const eT val); - arma_frown("use braced initialiser list instead") inline mat_injector operator<<(const injector_end_of_row<>& x); - - - arma_inline subview_row row(const uword row_num); - arma_inline const subview_row row(const uword row_num) const; - - inline subview_row operator()(const uword row_num, const span& col_span); - inline const subview_row operator()(const uword row_num, const span& col_span) const; - - - arma_inline subview_col col(const uword col_num); - arma_inline const subview_col col(const uword col_num) const; - - inline subview_col operator()(const span& row_span, const uword col_num); - inline const subview_col operator()(const span& row_span, const uword col_num) const; - - inline Col unsafe_col(const uword col_num); - inline const Col unsafe_col(const uword col_num) const; - - - arma_inline subview rows(const uword in_row1, const uword in_row2); - arma_inline const subview rows(const uword in_row1, const uword in_row2) const; - - arma_inline subview_cols cols(const uword in_col1, const uword in_col2); - arma_inline const subview_cols cols(const uword in_col1, const uword in_col2) const; - - inline subview rows(const span& row_span); - inline const subview rows(const span& row_span) const; - - arma_inline subview_cols cols(const span& col_span); - arma_inline const subview_cols cols(const span& col_span) const; - - - arma_inline subview submat(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2); - arma_inline const subview submat(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2) const; - - arma_inline subview submat(const uword in_row1, const uword in_col1, const SizeMat& s); - arma_inline const subview submat(const uword in_row1, const uword in_col1, const SizeMat& s) const; - - inline subview submat (const span& row_span, const span& col_span); - inline const subview submat (const span& row_span, const span& col_span) const; - - inline subview operator()(const span& row_span, const span& col_span); - inline const subview operator()(const span& row_span, const span& col_span) const; - - inline subview operator()(const uword in_row1, const uword in_col1, const SizeMat& s); - inline const subview operator()(const uword in_row1, const uword in_col1, const SizeMat& s) const; - - inline subview head_rows(const uword N); - inline const subview head_rows(const uword N) const; - - inline subview tail_rows(const uword N); - inline const subview tail_rows(const uword N) const; - - inline subview_cols head_cols(const uword N); - inline const subview_cols head_cols(const uword N) const; - - inline subview_cols tail_cols(const uword N); - inline const subview_cols tail_cols(const uword N) const; - - template arma_inline subview_elem1 elem(const Base& a); - template arma_inline const subview_elem1 elem(const Base& a) const; - - template arma_inline subview_elem1 operator()(const Base& a); - template arma_inline const subview_elem1 operator()(const Base& a) const; - - - template arma_inline subview_elem2 elem(const Base& ri, const Base& ci); - template arma_inline const subview_elem2 elem(const Base& ri, const Base& ci) const; - - template arma_inline subview_elem2 submat(const Base& ri, const Base& ci); - template arma_inline const subview_elem2 submat(const Base& ri, const Base& ci) const; - - template arma_inline subview_elem2 operator()(const Base& ri, const Base& ci); - template arma_inline const subview_elem2 operator()(const Base& ri, const Base& ci) const; - - - template arma_inline subview_elem2 rows(const Base& ri); - template arma_inline const subview_elem2 rows(const Base& ri) const; - - template arma_inline subview_elem2 cols(const Base& ci); - template arma_inline const subview_elem2 cols(const Base& ci) const; - - - arma_inline subview_each1< Mat, 0 > each_col(); - arma_inline subview_each1< Mat, 1 > each_row(); - - arma_inline const subview_each1< Mat, 0 > each_col() const; - arma_inline const subview_each1< Mat, 1 > each_row() const; - - template inline subview_each2< Mat, 0, T1 > each_col(const Base& indices); - template inline subview_each2< Mat, 1, T1 > each_row(const Base& indices); - - template inline const subview_each2< Mat, 0, T1 > each_col(const Base& indices) const; - template inline const subview_each2< Mat, 1, T1 > each_row(const Base& indices) const; - - inline Mat& each_col(const std::function< void( Col&) >& F); - inline const Mat& each_col(const std::function< void(const Col&) >& F) const; - - inline Mat& each_row(const std::function< void( Row&) >& F); - inline const Mat& each_row(const std::function< void(const Row&) >& F) const; - - - arma_inline diagview diag(const sword in_id = 0); - arma_inline const diagview diag(const sword in_id = 0) const; - - - inline void swap_rows(const uword in_row1, const uword in_row2); - inline void swap_cols(const uword in_col1, const uword in_col2); - - inline void shed_row(const uword row_num); - inline void shed_col(const uword col_num); - - inline void shed_rows(const uword in_row1, const uword in_row2); - inline void shed_cols(const uword in_col1, const uword in_col2); - - template inline void shed_rows(const Base& indices); - template inline void shed_cols(const Base& indices); - - arma_frown("use insert_rows(row_num, N) instead") inline void insert_rows(const uword row_num, const uword N, const bool set_to_zero); - arma_frown("use insert_cols(col_num, N) instead") inline void insert_cols(const uword col_num, const uword N, const bool set_to_zero); - - inline void insert_rows(const uword row_num, const uword N); - inline void insert_cols(const uword col_num, const uword N); - - template inline void insert_rows(const uword row_num, const Base& X); - template inline void insert_cols(const uword col_num, const Base& X); - - - template inline Mat(const Gen& X); - template inline Mat& operator= (const Gen& X); - template inline Mat& operator+=(const Gen& X); - template inline Mat& operator-=(const Gen& X); - template inline Mat& operator*=(const Gen& X); - template inline Mat& operator%=(const Gen& X); - template inline Mat& operator/=(const Gen& X); - - template inline Mat(const Op& X); - template inline Mat& operator= (const Op& X); - template inline Mat& operator+=(const Op& X); - template inline Mat& operator-=(const Op& X); - template inline Mat& operator*=(const Op& X); - template inline Mat& operator%=(const Op& X); - template inline Mat& operator/=(const Op& X); - - template inline Mat(const eOp& X); - template inline Mat& operator= (const eOp& X); - template inline Mat& operator+=(const eOp& X); - template inline Mat& operator-=(const eOp& X); - template inline Mat& operator*=(const eOp& X); - template inline Mat& operator%=(const eOp& X); - template inline Mat& operator/=(const eOp& X); - - template inline Mat(const mtOp& X); - template inline Mat& operator= (const mtOp& X); - template inline Mat& operator+=(const mtOp& X); - template inline Mat& operator-=(const mtOp& X); - template inline Mat& operator*=(const mtOp& X); - template inline Mat& operator%=(const mtOp& X); - template inline Mat& operator/=(const mtOp& X); - - template inline Mat(const CubeToMatOp& X); - template inline Mat& operator= (const CubeToMatOp& X); - template inline Mat& operator+=(const CubeToMatOp& X); - template inline Mat& operator-=(const CubeToMatOp& X); - template inline Mat& operator*=(const CubeToMatOp& X); - template inline Mat& operator%=(const CubeToMatOp& X); - template inline Mat& operator/=(const CubeToMatOp& X); - - template inline Mat(const SpToDOp& X); - template inline Mat& operator= (const SpToDOp& X); - template inline Mat& operator+=(const SpToDOp& X); - template inline Mat& operator-=(const SpToDOp& X); - template inline Mat& operator*=(const SpToDOp& X); - template inline Mat& operator%=(const SpToDOp& X); - template inline Mat& operator/=(const SpToDOp& X); - - template inline explicit Mat(const mtSpReduceOp& X); - template inline Mat& operator= (const mtSpReduceOp& X); - template inline Mat& operator+=(const mtSpReduceOp& X); - template inline Mat& operator-=(const mtSpReduceOp& X); - template inline Mat& operator*=(const mtSpReduceOp& X); - template inline Mat& operator%=(const mtSpReduceOp& X); - template inline Mat& operator/=(const mtSpReduceOp& X); - - template inline Mat(const Glue& X); - template inline Mat& operator= (const Glue& X); - template inline Mat& operator+=(const Glue& X); - template inline Mat& operator-=(const Glue& X); - template inline Mat& operator*=(const Glue& X); - template inline Mat& operator%=(const Glue& X); - template inline Mat& operator/=(const Glue& X); - - template inline Mat& operator+=(const Glue& X); - template inline Mat& operator-=(const Glue& X); - - template inline Mat(const eGlue& X); - template inline Mat& operator= (const eGlue& X); - template inline Mat& operator+=(const eGlue& X); - template inline Mat& operator-=(const eGlue& X); - template inline Mat& operator*=(const eGlue& X); - template inline Mat& operator%=(const eGlue& X); - template inline Mat& operator/=(const eGlue& X); - - template inline Mat(const mtGlue& X); - template inline Mat& operator= (const mtGlue& X); - template inline Mat& operator+=(const mtGlue& X); - template inline Mat& operator-=(const mtGlue& X); - template inline Mat& operator*=(const mtGlue& X); - template inline Mat& operator%=(const mtGlue& X); - template inline Mat& operator/=(const mtGlue& X); - - template inline Mat(const SpToDGlue& X); - template inline Mat& operator= (const SpToDGlue& X); - template inline Mat& operator+=(const SpToDGlue& X); - template inline Mat& operator-=(const SpToDGlue& X); - template inline Mat& operator*=(const SpToDGlue& X); - template inline Mat& operator%=(const SpToDGlue& X); - template inline Mat& operator/=(const SpToDGlue& X); - - - arma_warn_unused arma_inline const eT& at_alt (const uword ii) const; - - arma_warn_unused arma_inline eT& operator[] (const uword ii); - arma_warn_unused arma_inline const eT& operator[] (const uword ii) const; - arma_warn_unused arma_inline eT& at (const uword ii); - arma_warn_unused arma_inline const eT& at (const uword ii) const; - arma_warn_unused arma_inline eT& operator() (const uword ii); - arma_warn_unused arma_inline const eT& operator() (const uword ii) const; - - #if defined(__cpp_multidimensional_subscript) - arma_warn_unused arma_inline eT& operator[] (const uword in_row, const uword in_col); - arma_warn_unused arma_inline const eT& operator[] (const uword in_row, const uword in_col) const; - #endif - - arma_warn_unused arma_inline eT& at (const uword in_row, const uword in_col); - arma_warn_unused arma_inline const eT& at (const uword in_row, const uword in_col) const; - arma_warn_unused arma_inline eT& operator() (const uword in_row, const uword in_col); - arma_warn_unused arma_inline const eT& operator() (const uword in_row, const uword in_col) const; - - arma_inline const Mat& operator++(); - arma_inline void operator++(int); - - arma_inline const Mat& operator--(); - arma_inline void operator--(int); - - arma_warn_unused arma_inline bool is_empty() const; - arma_warn_unused arma_inline bool is_vec() const; - arma_warn_unused arma_inline bool is_rowvec() const; - arma_warn_unused arma_inline bool is_colvec() const; - arma_warn_unused arma_inline bool is_square() const; - - arma_warn_unused inline bool internal_is_finite() const; - arma_warn_unused inline bool internal_has_inf() const; - arma_warn_unused inline bool internal_has_nan() const; - arma_warn_unused inline bool internal_has_nonfinite() const; - - arma_warn_unused inline bool is_sorted(const char* direction = "ascend") const; - arma_warn_unused inline bool is_sorted(const char* direction, const uword dim) const; - - template - arma_warn_unused inline bool is_sorted_helper(const comparator& comp, const uword dim) const; - - arma_warn_unused arma_inline bool in_range(const uword ii) const; - arma_warn_unused arma_inline bool in_range(const span& x ) const; - - arma_warn_unused arma_inline bool in_range(const uword in_row, const uword in_col) const; - arma_warn_unused arma_inline bool in_range(const span& row_span, const uword in_col) const; - arma_warn_unused arma_inline bool in_range(const uword in_row, const span& col_span) const; - arma_warn_unused arma_inline bool in_range(const span& row_span, const span& col_span) const; - - arma_warn_unused arma_inline bool in_range(const uword in_row, const uword in_col, const SizeMat& s) const; - - arma_warn_unused arma_inline eT* colptr(const uword in_col); - arma_warn_unused arma_inline const eT* colptr(const uword in_col) const; - - arma_warn_unused arma_inline eT* memptr(); - arma_warn_unused arma_inline const eT* memptr() const; - - - template - inline Mat& copy_size(const Base& X); - - inline Mat& set_size(const uword new_n_elem); - inline Mat& set_size(const uword new_n_rows, const uword new_n_cols); - inline Mat& set_size(const SizeMat& s); - - inline Mat& resize(const uword new_n_elem); - inline Mat& resize(const uword new_n_rows, const uword new_n_cols); - inline Mat& resize(const SizeMat& s); - - inline Mat& reshape(const uword new_n_rows, const uword new_n_cols); - inline Mat& reshape(const SizeMat& s); - - arma_frown("use reshape(n_rows, n_cols) instead") inline void reshape(const uword new_n_rows, const uword new_n_cols, const uword dim); //!< NOTE: don't use this form: it will be removed - - - template inline Mat& for_each(functor F); - template inline const Mat& for_each(functor F) const; - - template inline Mat& transform(functor F); - template inline Mat& imbue(functor F); - - - inline Mat& replace(const eT old_val, const eT new_val); - - inline Mat& clean(const pod_type threshold); - - inline Mat& clamp(const eT min_val, const eT max_val); - - inline Mat& fill(const eT val); - - template - inline Mat& fill(const fill::fill_class& f); - - inline Mat& zeros(); - inline Mat& zeros(const uword new_n_elem); - inline Mat& zeros(const uword new_n_rows, const uword new_n_cols); - inline Mat& zeros(const SizeMat& s); - - inline Mat& ones(); - inline Mat& ones(const uword new_n_elem); - inline Mat& ones(const uword new_n_rows, const uword new_n_cols); - inline Mat& ones(const SizeMat& s); - - inline Mat& randu(); - inline Mat& randu(const uword new_n_elem); - inline Mat& randu(const uword new_n_rows, const uword new_n_cols); - inline Mat& randu(const SizeMat& s); - - inline Mat& randn(); - inline Mat& randn(const uword new_n_elem); - inline Mat& randn(const uword new_n_rows, const uword new_n_cols); - inline Mat& randn(const SizeMat& s); - - inline Mat& eye(); - inline Mat& eye(const uword new_n_rows, const uword new_n_cols); - inline Mat& eye(const SizeMat& s); - - arma_cold inline void reset(); - arma_cold inline void soft_reset(); - - - template inline void set_real(const Base& X); - template inline void set_imag(const Base& X); - - - arma_warn_unused inline eT min() const; - arma_warn_unused inline eT max() const; - - inline eT min(uword& index_of_min_val) const; - inline eT max(uword& index_of_max_val) const; - - inline eT min(uword& row_of_min_val, uword& col_of_min_val) const; - inline eT max(uword& row_of_max_val, uword& col_of_max_val) const; - - - arma_cold inline bool save(const std::string name, const file_type type = arma_binary) const; - arma_cold inline bool save(const hdf5_name& spec, const file_type type = hdf5_binary) const; - arma_cold inline bool save(const csv_name& spec, const file_type type = csv_ascii) const; - arma_cold inline bool save( std::ostream& os, const file_type type = arma_binary) const; - - arma_cold inline bool load(const std::string name, const file_type type = auto_detect); - arma_cold inline bool load(const hdf5_name& spec, const file_type type = hdf5_binary); - arma_cold inline bool load(const csv_name& spec, const file_type type = csv_ascii); - arma_cold inline bool load( std::istream& is, const file_type type = auto_detect); - - arma_frown("use save() instead") inline bool quiet_save(const std::string name, const file_type type = arma_binary) const; - arma_frown("use save() instead") inline bool quiet_save(const hdf5_name& spec, const file_type type = hdf5_binary) const; - arma_frown("use save() instead") inline bool quiet_save(const csv_name& spec, const file_type type = csv_ascii) const; - arma_frown("use save() instead") inline bool quiet_save( std::ostream& os, const file_type type = arma_binary) const; - - arma_frown("use load() instead") inline bool quiet_load(const std::string name, const file_type type = auto_detect); - arma_frown("use load() instead") inline bool quiet_load(const hdf5_name& spec, const file_type type = hdf5_binary); - arma_frown("use load() instead") inline bool quiet_load(const csv_name& spec, const file_type type = csv_ascii); - arma_frown("use load() instead") inline bool quiet_load( std::istream& is, const file_type type = auto_detect); - - - // for container-like functionality - - typedef eT value_type; - typedef uword size_type; - - typedef eT* iterator; - typedef const eT* const_iterator; - - typedef eT* col_iterator; - typedef const eT* const_col_iterator; - - class const_row_iterator; - - class row_iterator - { - public: - - inline row_iterator(); - inline row_iterator(const row_iterator& X); - inline row_iterator(Mat& in_M, const uword in_row, const uword in_col); - - arma_warn_unused inline eT& operator* (); - - inline row_iterator& operator++(); - arma_warn_unused inline row_iterator operator++(int); - - inline row_iterator& operator--(); - arma_warn_unused inline row_iterator operator--(int); - - arma_warn_unused inline bool operator!=(const row_iterator& X) const; - arma_warn_unused inline bool operator==(const row_iterator& X) const; - arma_warn_unused inline bool operator!=(const const_row_iterator& X) const; - arma_warn_unused inline bool operator==(const const_row_iterator& X) const; - - typedef std::bidirectional_iterator_tag iterator_category; - typedef eT value_type; - typedef std::ptrdiff_t difference_type; // TODO: not certain on this one - typedef eT* pointer; - typedef eT& reference; - - arma_aligned Mat* M; - arma_aligned uword current_row; - arma_aligned uword current_col; - }; - - - class const_row_iterator - { - public: - - inline const_row_iterator(); - inline const_row_iterator(const row_iterator& X); - inline const_row_iterator(const const_row_iterator& X); - inline const_row_iterator(const Mat& in_M, const uword in_row, const uword in_col); - - arma_warn_unused inline const eT& operator*() const; - - inline const_row_iterator& operator++(); - arma_warn_unused inline const_row_iterator operator++(int); - - inline const_row_iterator& operator--(); - arma_warn_unused inline const_row_iterator operator--(int); - - arma_warn_unused inline bool operator!=(const row_iterator& X) const; - arma_warn_unused inline bool operator==(const row_iterator& X) const; - arma_warn_unused inline bool operator!=(const const_row_iterator& X) const; - arma_warn_unused inline bool operator==(const const_row_iterator& X) const; - - typedef std::bidirectional_iterator_tag iterator_category; - typedef eT value_type; - typedef std::ptrdiff_t difference_type; // TODO: not certain on this one - typedef const eT* pointer; - typedef const eT& reference; - - arma_aligned const Mat* M; - arma_aligned uword current_row; - arma_aligned uword current_col; - }; - - - class const_row_col_iterator; - - class row_col_iterator - { - public: - - inline row_col_iterator(); - inline row_col_iterator(const row_col_iterator& in_it); - inline row_col_iterator(Mat& in_M, const uword row = 0, const uword col = 0); - - arma_warn_unused inline eT& operator*(); - - inline row_col_iterator& operator++(); - arma_warn_unused inline row_col_iterator operator++(int); - - inline row_col_iterator& operator--(); - arma_warn_unused inline row_col_iterator operator--(int); - - arma_warn_unused inline uword row() const; - arma_warn_unused inline uword col() const; - - arma_warn_unused inline bool operator==(const row_col_iterator& rhs) const; - arma_warn_unused inline bool operator!=(const row_col_iterator& rhs) const; - arma_warn_unused inline bool operator==(const const_row_col_iterator& rhs) const; - arma_warn_unused inline bool operator!=(const const_row_col_iterator& rhs) const; - - typedef std::bidirectional_iterator_tag iterator_category; - typedef eT value_type; - typedef std::ptrdiff_t difference_type; // TODO: not certain on this one - typedef eT* pointer; - typedef eT& reference; - - arma_aligned Mat* M; - arma_aligned eT* current_ptr; - arma_aligned uword current_col; - arma_aligned uword current_row; - }; - - - class const_row_col_iterator - { - public: - - inline const_row_col_iterator(); - inline const_row_col_iterator(const row_col_iterator& in_it); - inline const_row_col_iterator(const const_row_col_iterator& in_it); - inline const_row_col_iterator(const Mat& in_M, const uword row = 0, const uword col = 0); - - arma_warn_unused inline const eT& operator*() const; - - inline const_row_col_iterator& operator++(); - arma_warn_unused inline const_row_col_iterator operator++(int); - - inline const_row_col_iterator& operator--(); - arma_warn_unused inline const_row_col_iterator operator--(int); - - arma_warn_unused inline uword row() const; - arma_warn_unused inline uword col() const; - - arma_warn_unused inline bool operator==(const const_row_col_iterator& rhs) const; - arma_warn_unused inline bool operator!=(const const_row_col_iterator& rhs) const; - arma_warn_unused inline bool operator==(const row_col_iterator& rhs) const; - arma_warn_unused inline bool operator!=(const row_col_iterator& rhs) const; - - // So that we satisfy the STL iterator types. - typedef std::bidirectional_iterator_tag iterator_category; - typedef eT value_type; - typedef std::ptrdiff_t difference_type; // TODO: not certain on this one - typedef const eT* pointer; - typedef const eT& reference; - - arma_aligned const Mat* M; - arma_aligned const eT* current_ptr; - arma_aligned uword current_col; - arma_aligned uword current_row; - }; - - - inline iterator begin(); - inline const_iterator begin() const; - inline const_iterator cbegin() const; - - inline iterator end(); - inline const_iterator end() const; - inline const_iterator cend() const; - - inline col_iterator begin_col(const uword col_num); - inline const_col_iterator begin_col(const uword col_num) const; - - inline col_iterator end_col (const uword col_num); - inline const_col_iterator end_col (const uword col_num) const; - - inline row_iterator begin_row(const uword row_num); - inline const_row_iterator begin_row(const uword row_num) const; - - inline row_iterator end_row (const uword row_num); - inline const_row_iterator end_row (const uword row_num) const; - - inline row_col_iterator begin_row_col(); - inline const_row_col_iterator begin_row_col() const; - - inline row_col_iterator end_row_col(); - inline const_row_col_iterator end_row_col() const; - - - inline void clear(); - inline bool empty() const; - inline uword size() const; - - arma_warn_unused inline eT& front(); - arma_warn_unused inline const eT& front() const; - - arma_warn_unused inline eT& back(); - arma_warn_unused inline const eT& back() const; - - inline void swap(Mat& B); - - inline void steal_mem(Mat& X); //!< don't use this unless you're writing code internal to Armadillo - inline void steal_mem(Mat& X, const bool is_move); //!< don't use this unless you're writing code internal to Armadillo - - inline void steal_mem_col(Mat& X, const uword max_n_rows); - - - template class fixed; - - - protected: - - inline void init_cold(); - inline void init_warm(uword in_n_rows, uword in_n_cols); - - arma_cold inline void init(const std::string& text); - - inline void init(const std::initializer_list& list); - inline void init(const std::initializer_list< std::initializer_list >& list); - - template - inline void init(const Base& A, const Base& B); - - inline Mat(const char junk, const eT* aux_mem, const uword aux_n_rows, const uword aux_n_cols); - - inline Mat(const arma_vec_indicator&, const uhword in_vec_state); - inline Mat(const arma_vec_indicator&, const uword in_n_rows, const uword in_n_cols, const uhword in_vec_state); - - inline Mat(const arma_fixed_indicator&, const uword in_n_rows, const uword in_n_cols, const uhword in_vec_state, const eT* in_mem); - - - friend class Cube; - friend class subview_cube; - friend class glue_join; - friend class op_strans; - friend class op_htrans; - friend class op_resize; - friend class op_mean; - friend class op_max; - friend class op_min; - - - public: - - #if defined(ARMA_EXTRA_MAT_PROTO) - #include ARMA_INCFILE_WRAP(ARMA_EXTRA_MAT_PROTO) - #endif - }; - - - -template -template -class Mat::fixed : public Mat - { - private: - - static constexpr uword fixed_n_elem = fixed_n_rows * fixed_n_cols; - static constexpr bool use_extra = (fixed_n_elem > arma_config::mat_prealloc); - - arma_align_mem eT mem_local_extra[ (use_extra) ? fixed_n_elem : 1 ]; - - - public: - - typedef fixed Mat_fixed_type; - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_col = (fixed_n_cols == 1); - static constexpr bool is_row = (fixed_n_rows == 1); - static constexpr bool is_xvec = false; - - static const uword n_rows; // value provided below the class definition - static const uword n_cols; // value provided below the class definition - static const uword n_elem; // value provided below the class definition - - arma_inline fixed(); - arma_inline fixed(const fixed& X); - - inline fixed(const fill::scalar_holder f); - template inline fixed(const fill::fill_class& f); - template inline fixed(const Base& A); - template inline fixed(const Base& A, const Base& B); - - inline fixed(const eT* aux_mem); - - inline fixed(const char* text); - inline fixed(const std::string& text); - - using Mat::operator=; - using Mat::operator(); - - inline fixed(const std::initializer_list& list); - inline Mat& operator=(const std::initializer_list& list); - - inline fixed(const std::initializer_list< std::initializer_list >& list); - inline Mat& operator=(const std::initializer_list< std::initializer_list >& list); - - arma_inline Mat& operator=(const fixed& X); - - #if defined(ARMA_GOOD_COMPILER) - template inline Mat& operator=(const eOp& X); - template inline Mat& operator=(const eGlue& X); - #endif - - arma_warn_unused arma_inline const Op< Mat_fixed_type, op_htrans > t() const; - arma_warn_unused arma_inline const Op< Mat_fixed_type, op_htrans > ht() const; - arma_warn_unused arma_inline const Op< Mat_fixed_type, op_strans > st() const; - - arma_warn_unused arma_inline const eT& at_alt (const uword i) const; - - arma_warn_unused arma_inline eT& operator[] (const uword i); - arma_warn_unused arma_inline const eT& operator[] (const uword i) const; - arma_warn_unused arma_inline eT& at (const uword i); - arma_warn_unused arma_inline const eT& at (const uword i) const; - arma_warn_unused arma_inline eT& operator() (const uword i); - arma_warn_unused arma_inline const eT& operator() (const uword i) const; - - #if defined(__cpp_multidimensional_subscript) - arma_warn_unused arma_inline eT& operator[] (const uword in_row, const uword in_col); - arma_warn_unused arma_inline const eT& operator[] (const uword in_row, const uword in_col) const; - #endif - - arma_warn_unused arma_inline eT& at (const uword in_row, const uword in_col); - arma_warn_unused arma_inline const eT& at (const uword in_row, const uword in_col) const; - arma_warn_unused arma_inline eT& operator() (const uword in_row, const uword in_col); - arma_warn_unused arma_inline const eT& operator() (const uword in_row, const uword in_col) const; - - arma_warn_unused arma_inline eT* colptr(const uword in_col); - arma_warn_unused arma_inline const eT* colptr(const uword in_col) const; - - arma_warn_unused arma_inline eT* memptr(); - arma_warn_unused arma_inline const eT* memptr() const; - - arma_warn_unused arma_inline bool is_vec() const; - - inline const Mat& fill(const eT val); - inline const Mat& zeros(); - inline const Mat& ones(); - }; - - - -// these definitions are outside of the class due to bizarre C++ rules; -// C++17 has inline variables to address this shortcoming - -template -template -const uword Mat::fixed::n_rows = fixed_n_rows; - -template -template -const uword Mat::fixed::n_cols = fixed_n_cols; - -template -template -const uword Mat::fixed::n_elem = fixed_n_rows * fixed_n_cols; - - - -class Mat_aux - { - public: - - template inline static void prefix_pp(Mat& x); - template inline static void prefix_pp(Mat< std::complex >& x); - - template inline static void postfix_pp(Mat& x); - template inline static void postfix_pp(Mat< std::complex >& x); - - template inline static void prefix_mm(Mat& x); - template inline static void prefix_mm(Mat< std::complex >& x); - - template inline static void postfix_mm(Mat& x); - template inline static void postfix_mm(Mat< std::complex >& x); - - template inline static void set_real(Mat& out, const Base& X); - template inline static void set_real(Mat< std::complex >& out, const Base< T,T1>& X); - - template inline static void set_imag(Mat& out, const Base& X); - template inline static void set_imag(Mat< std::complex >& out, const Base< T,T1>& X); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Mat_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Mat_meat.hpp deleted file mode 100644 index 0f785d5c6..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Mat_meat.hpp +++ /dev/null @@ -1,10355 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup Mat -//! @{ - - -template -inline -Mat::~Mat() - { - arma_debug_sigprint_this(this); - - if(n_alloc > 0) - { - arma_debug_print("Mat::destructor: releasing memory"); - memory::release( access::rw(mem) ); - } - - // try to expose buggy user code that accesses deleted objects - access::rw(mem) = nullptr; - - arma_type_check(( is_supported_elem_type::value == false )); - } - - - -template -inline -Mat::Mat() - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - } - - - -//! construct the matrix to have user specified dimensions -template -inline -Mat::Mat(const uword in_n_rows, const uword in_n_cols) - : n_rows(in_n_rows) - , n_cols(in_n_cols) - , n_elem(in_n_rows*in_n_cols) - , n_alloc() - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - arma_debug_print("Mat::constructor: zeroing memory"); - - arrayops::fill_zeros(memptr(), n_elem); - } - - - -template -inline -Mat::Mat(const SizeMat& s) - : n_rows(s.n_rows) - , n_cols(s.n_cols) - , n_elem(s.n_rows*s.n_cols) - , n_alloc() - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - arma_debug_print("Mat::constructor: zeroing memory"); - - arrayops::fill_zeros(memptr(), n_elem); - } - - - -//! internal use only -template -template -inline -Mat::Mat(const uword in_n_rows, const uword in_n_cols, const arma_initmode_indicator&) - : n_rows(in_n_rows) - , n_cols(in_n_cols) - , n_elem(in_n_rows*in_n_cols) - , n_alloc() - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - if(do_zeros) - { - arma_debug_print("Mat::constructor: zeroing memory"); - arrayops::fill_zeros(memptr(), n_elem); - } - else - { - arma_debug_print("Mat::constructor: not zeroing memory"); - } - } - - - -//! internal use only -template -template -inline -Mat::Mat(const SizeMat& s, const arma_initmode_indicator&) - : n_rows(s.n_rows) - , n_cols(s.n_cols) - , n_elem(s.n_rows*s.n_cols) - , n_alloc() - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - if(do_zeros) - { - arma_debug_print("Mat::constructor: zeroing memory"); - arrayops::fill_zeros(memptr(), n_elem); - } - else - { - arma_debug_print("Mat::constructor: not zeroing memory"); - } - } - - - -//! construct the matrix to have user specified dimensions and fill with specified pattern -template -template -inline -Mat::Mat(const uword in_n_rows, const uword in_n_cols, const fill::fill_class& f) - : n_rows(in_n_rows) - , n_cols(in_n_cols) - , n_elem(in_n_rows*in_n_cols) - , n_alloc() - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - (*this).fill(f); - } - - - -template -template -inline -Mat::Mat(const SizeMat& s, const fill::fill_class& f) - : n_rows(s.n_rows) - , n_cols(s.n_cols) - , n_elem(s.n_rows*s.n_cols) - , n_alloc() - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - (*this).fill(f); - } - - - -//! construct the matrix to have user specified dimensions and fill with specified value -template -inline -Mat::Mat(const uword in_n_rows, const uword in_n_cols, const fill::scalar_holder f) - : n_rows(in_n_rows) - , n_cols(in_n_cols) - , n_elem(in_n_rows*in_n_cols) - , n_alloc() - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - (*this).fill(f.scalar); - } - - - -template -inline -Mat::Mat(const SizeMat& s, const fill::scalar_holder f) - : n_rows(s.n_rows) - , n_cols(s.n_cols) - , n_elem(s.n_rows*s.n_cols) - , n_alloc() - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - (*this).fill(f.scalar); - } - - - -//! constructor used by Row and Col classes -template -inline -Mat::Mat(const arma_vec_indicator&, const uhword in_vec_state) - : n_rows( (in_vec_state == 2) ? 1 : 0 ) - , n_cols( (in_vec_state == 1) ? 1 : 0 ) - , n_elem(0) - , n_alloc(0) - , vec_state(in_vec_state) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - } - - - -//! constructor used by Row and Col classes -template -inline -Mat::Mat(const arma_vec_indicator&, const uword in_n_rows, const uword in_n_cols, const uhword in_vec_state) - : n_rows(in_n_rows) - , n_cols(in_n_cols) - , n_elem(in_n_rows*in_n_cols) - , n_alloc() - , vec_state(in_vec_state) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - } - - - -template -inline -Mat::Mat(const arma_fixed_indicator&, const uword in_n_rows, const uword in_n_cols, const uhword in_vec_state, const eT* in_mem) - : n_rows (in_n_rows) - , n_cols (in_n_cols) - , n_elem (in_n_rows*in_n_cols) - , n_alloc (0) - , vec_state (in_vec_state) - , mem_state (3) - , mem (in_mem) - { - arma_debug_sigprint_this(this); - } - - - -template -inline -void -Mat::init_cold() - { - arma_debug_sigprint( arma_str::format("n_rows: %u; n_cols: %u") % n_rows % n_cols ); - - // ensure that n_elem can hold the result of (n_rows * n_cols) - - #if defined(ARMA_64BIT_WORD) - const char* error_message = "Mat::init(): requested size is too large"; - #else - const char* error_message = "Mat::init(): requested size is too large; suggest to enable ARMA_64BIT_WORD"; - #endif - - arma_conform_check - ( - ( - ( (n_rows > ARMA_MAX_UHWORD) || (n_cols > ARMA_MAX_UHWORD) ) - ? ( (double(n_rows) * double(n_cols)) > double(ARMA_MAX_UWORD) ) - : false - ), - error_message - ); - - if(n_elem <= arma_config::mat_prealloc) - { - if(n_elem > 0) { arma_debug_print("Mat::init(): using local memory"); } - - access::rw(mem) = (n_elem == 0) ? nullptr : mem_local; - access::rw(n_alloc) = 0; - } - else - { - arma_debug_print("Mat::init(): acquiring memory"); - - access::rw(mem) = memory::acquire(n_elem); - access::rw(n_alloc) = n_elem; - } - } - - - -template -inline -void -Mat::init_warm(uword in_n_rows, uword in_n_cols) - { - arma_debug_sigprint( arma_str::format("in_n_rows: %u; in_n_cols: %u") % in_n_rows % in_n_cols ); - - if( (n_rows == in_n_rows) && (n_cols == in_n_cols) ) { return; } - - bool err_state = false; - char* err_msg = nullptr; - - const uhword t_vec_state = vec_state; - const uhword t_mem_state = mem_state; - - const char* error_message_1 = "Mat::init(): size is fixed and hence cannot be changed"; - const char* error_message_2 = "Mat::init(): requested size is not compatible with column vector layout"; - const char* error_message_3 = "Mat::init(): requested size is not compatible with row vector layout"; - - arma_conform_set_error( err_state, err_msg, (t_mem_state == 3), error_message_1 ); - - if(t_vec_state > 0) - { - if( (in_n_rows == 0) && (in_n_cols == 0) ) - { - if(t_vec_state == 1) { in_n_cols = 1; } - if(t_vec_state == 2) { in_n_rows = 1; } - } - else - { - if(t_vec_state == 1) { arma_conform_set_error( err_state, err_msg, (in_n_cols != 1), error_message_2 ); } // TODO: (in_n_cols > 1) ? - if(t_vec_state == 2) { arma_conform_set_error( err_state, err_msg, (in_n_rows != 1), error_message_3 ); } // TODO: (in_n_rows > 1) ? - } - } - - // ensure that n_elem can hold the result of (n_rows * n_cols) - - #if defined(ARMA_64BIT_WORD) - const char* error_message_4 = "Mat::init(): requested size is too large"; - #else - const char* error_message_4 = "Mat::init(): requested size is too large; suggest to enable ARMA_64BIT_WORD"; - #endif - - arma_conform_set_error - ( - err_state, - err_msg, - ( - ( (in_n_rows > ARMA_MAX_UHWORD) || (in_n_cols > ARMA_MAX_UHWORD) ) - ? ( (double(in_n_rows) * double(in_n_cols)) > double(ARMA_MAX_UWORD) ) - : false - ), - error_message_4 - ); - - arma_conform_check(err_state, err_msg); - - const uword old_n_elem = n_elem; - const uword new_n_elem = in_n_rows * in_n_cols; - - if(old_n_elem == new_n_elem) - { - arma_debug_print("Mat::init(): reusing memory"); - access::rw(n_rows) = in_n_rows; - access::rw(n_cols) = in_n_cols; - return; - } - - arma_conform_check( (t_mem_state == 2), "Mat::init(): mismatch between size of auxiliary memory and requested size" ); - - if(new_n_elem <= arma_config::mat_prealloc) - { - if(n_alloc > 0) - { - arma_debug_print("Mat::init(): releasing memory"); - memory::release( access::rw(mem) ); - } - - if(new_n_elem > 0) { arma_debug_print("Mat::init(): using local memory"); } - - access::rw(mem) = (new_n_elem == 0) ? nullptr : mem_local; - access::rw(n_alloc) = 0; - } - else // condition: new_n_elem > arma_config::mat_prealloc - { - if(new_n_elem > n_alloc) - { - if(n_alloc > 0) - { - arma_debug_print("Mat::init(): releasing memory"); - memory::release( access::rw(mem) ); - - // in case memory::acquire() throws an exception - access::rw(mem) = nullptr; - access::rw(n_rows) = 0; - access::rw(n_cols) = 0; - access::rw(n_elem) = 0; - access::rw(n_alloc) = 0; - } - - arma_debug_print("Mat::init(): acquiring memory"); - access::rw(mem) = memory::acquire(new_n_elem); - access::rw(n_alloc) = new_n_elem; - } - else // condition: new_n_elem <= n_alloc - { - arma_debug_print("Mat::init(): reusing memory"); - } - } - - access::rw(n_rows) = in_n_rows; - access::rw(n_cols) = in_n_cols; - access::rw(n_elem) = new_n_elem; - access::rw(mem_state) = 0; - } - - - -//! create the matrix from a textual description -template -inline -Mat::Mat(const char* text) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init( std::string(text) ); - } - - - -//! create the matrix from a textual description -template -inline -Mat& -Mat::operator=(const char* text) - { - arma_debug_sigprint(); - - init( std::string(text) ); - - return *this; - } - - - -//! create the matrix from a textual description -template -inline -Mat::Mat(const std::string& text) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init(text); - } - - - -//! create the matrix from a textual description -template -inline -Mat& -Mat::operator=(const std::string& text) - { - arma_debug_sigprint(); - - init(text); - - return *this; - } - - - -//! internal function to create the matrix from a textual description -template -inline -void -Mat::init(const std::string& text_orig) - { - arma_debug_sigprint(); - - const bool replace_commas = (is_cx::yes) ? false : ( text_orig.find(',') != std::string::npos ); - - std::string text_mod; - - if(replace_commas) { text_mod = text_orig; std::replace(text_mod.begin(), text_mod.end(), ',', ' '); } - - const std::string& text = (replace_commas) ? text_mod : text_orig; - - // - // work out the size - - uword t_n_rows = 0; - uword t_n_cols = 0; - - bool has_semicolon = false; - bool has_token = false; - - std::string token; - - std::string::size_type line_start = 0; - std::string::size_type line_end = 0; - std::string::size_type line_len = 0; - - std::stringstream line_stream; - - while( line_start < text.length() ) - { - line_end = text.find(';', line_start); - - if(line_end == std::string::npos) - { - has_semicolon = false; - line_end = text.length()-1; - line_len = line_end - line_start + 1; - } - else - { - has_semicolon = true; - line_len = line_end - line_start; // omit the ';' character - } - - line_stream.clear(); - line_stream.str( text.substr(line_start,line_len) ); - - has_token = false; - - uword line_n_cols = 0; - - while(line_stream >> token) { has_token = true; ++line_n_cols; } - - if(t_n_rows == 0) - { - t_n_cols = line_n_cols; - } - else - { - if(has_semicolon || has_token) { arma_check( (line_n_cols != t_n_cols), "Mat::init(): inconsistent number of columns in given string"); } - } - - ++t_n_rows; - - line_start = line_end+1; - } - - // if the last line was empty, ignore it - if( (has_semicolon == false) && (has_token == false) && (t_n_rows >= 1) ) { --t_n_rows; } - - Mat& x = (*this); - x.set_size(t_n_rows, t_n_cols); - - if(x.is_empty()) { return; } - - line_start = 0; - line_end = 0; - line_len = 0; - - uword urow = 0; - - while( line_start < text.length() ) - { - line_end = text.find(';', line_start); - - if(line_end == std::string::npos) - { - line_end = text.length()-1; - line_len = line_end - line_start + 1; - } - else - { - line_len = line_end - line_start; // omit the ';' character - } - - line_stream.clear(); - line_stream.str( text.substr(line_start,line_len) ); - - uword ucol = 0; - while(line_stream >> token) - { - diskio::convert_token( x.at(urow,ucol), token ); - ++ucol; - } - - ++urow; - line_start = line_end+1; - } - } - - - -//! create the matrix from std::vector -template -inline -Mat::Mat(const std::vector& x) - : n_rows(uword(x.size())) - , n_cols(1) - , n_elem(uword(x.size())) - , n_alloc() - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - if(n_elem > 0) { arrayops::copy( memptr(), &(x[0]), n_elem ); } - } - - - -//! create the matrix from std::vector -template -inline -Mat& -Mat::operator=(const std::vector& x) - { - arma_debug_sigprint(); - - init_warm(uword(x.size()), 1); - - if(x.size() > 0) { arrayops::copy( memptr(), &(x[0]), uword(x.size()) ); } - - return *this; - } - - - -template -inline -Mat::Mat(const std::initializer_list& list) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init(list); - } - - - -template -inline -Mat& -Mat::operator=(const std::initializer_list& list) - { - arma_debug_sigprint(); - - init(list); - - return *this; - } - - - -template -inline -Mat::Mat(const std::initializer_list< std::initializer_list >& list) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init(list); - } - - - -template -inline -Mat& -Mat::operator=(const std::initializer_list< std::initializer_list >& list) - { - arma_debug_sigprint(); - - init(list); - - return *this; - } - - - -template -inline -Mat::Mat(Mat&& X) - : n_rows (X.n_rows ) - , n_cols (X.n_cols ) - , n_elem (X.n_elem ) - , n_alloc (X.n_alloc) - , vec_state(0 ) - , mem_state(0 ) - , mem ( ) - { - arma_debug_sigprint(arma_str::format("this: %x; X: %x") % this % &X); - - if( (X.n_alloc > arma_config::mat_prealloc) || (X.mem_state == 1) || (X.mem_state == 2) ) - { - access::rw(mem_state) = X.mem_state; - access::rw(mem) = X.mem; - - access::rw(X.n_rows) = 0; - access::rw(X.n_cols) = 0; - access::rw(X.n_elem) = 0; - access::rw(X.n_alloc) = 0; - access::rw(X.mem_state) = 0; - access::rw(X.mem) = nullptr; - } - else // condition: (X.n_alloc <= arma_config::mat_prealloc) || (X.mem_state == 0) || (X.mem_state == 3) - { - init_cold(); - - arrayops::copy( memptr(), X.mem, X.n_elem ); - - if( (X.mem_state == 0) && (X.n_alloc <= arma_config::mat_prealloc) ) - { - access::rw(X.n_rows) = 0; - access::rw(X.n_cols) = 0; - access::rw(X.n_elem) = 0; - access::rw(X.mem) = nullptr; - } - } - } - - - -template -inline -Mat& -Mat::operator=(Mat&& X) - { - arma_debug_sigprint(arma_str::format("this: %x; X: %x") % this % &X); - - (*this).steal_mem(X, true); - - return *this; - } - - - -//! Set the matrix to be equal to the specified scalar. -//! NOTE: the size of the matrix will be 1x1 -template -inline -Mat& -Mat::operator=(const eT val) - { - arma_debug_sigprint(); - - init_warm(1,1); - - access::rw(mem[0]) = val; - - return *this; - } - - - -//! In-place addition of a scalar to all elements of the matrix -template -inline -Mat& -Mat::operator+=(const eT val) - { - arma_debug_sigprint(); - - arrayops::inplace_plus( memptr(), val, n_elem ); - - return *this; - } - - - -//! In-place subtraction of a scalar from all elements of the matrix -template -inline -Mat& -Mat::operator-=(const eT val) - { - arma_debug_sigprint(); - - arrayops::inplace_minus( memptr(), val, n_elem ); - - return *this; - } - - - -//! In-place multiplication of all elements of the matrix with a scalar -template -inline -Mat& -Mat::operator*=(const eT val) - { - arma_debug_sigprint(); - - arrayops::inplace_mul( memptr(), val, n_elem ); - - return *this; - } - - - -//! In-place division of all elements of the matrix with a scalar -template -inline -Mat& -Mat::operator/=(const eT val) - { - arma_debug_sigprint(); - - arrayops::inplace_div( memptr(), val, n_elem ); - - return *this; - } - - - -//! construct a matrix from a given matrix -template -inline -Mat::Mat(const Mat& in_mat) - : n_rows(in_mat.n_rows) - , n_cols(in_mat.n_cols) - , n_elem(in_mat.n_elem) - , n_alloc() - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint(arma_str::format("this: %x; in_mat: %x") % this % &in_mat); - - init_cold(); - - arrayops::copy( memptr(), in_mat.mem, in_mat.n_elem ); - } - - - -//! construct a matrix from a given matrix -template -inline -Mat& -Mat::operator=(const Mat& in_mat) - { - arma_debug_sigprint(arma_str::format("this: %x; in_mat: %x") % this % &in_mat); - - if(this != &in_mat) - { - init_warm(in_mat.n_rows, in_mat.n_cols); - - arrayops::copy( memptr(), in_mat.mem, in_mat.n_elem ); - } - - return *this; - } - - - -template -inline -void -Mat::init(const std::initializer_list& list) - { - arma_debug_sigprint(); - - const uword N = uword(list.size()); - - set_size(1, N); - - if(N > 0) { arrayops::copy( memptr(), list.begin(), N ); } - } - - - -template -inline -void -Mat::init(const std::initializer_list< std::initializer_list >& list) - { - arma_debug_sigprint(); - - uword x_n_rows = uword(list.size()); - uword x_n_cols = 0; - uword x_n_elem = 0; - - auto it = list.begin(); - auto it_end = list.end(); - - for(; it != it_end; ++it) - { - const uword x_n_cols_new = uword((*it).size()); - - x_n_elem += x_n_cols_new; - - x_n_cols = (std::max)(x_n_cols, x_n_cols_new); - } - - Mat& t = (*this); - - if(t.mem_state == 3) - { - arma_conform_check( ((x_n_rows != t.n_rows) || (x_n_cols != t.n_cols)), "Mat::init(): size mismatch between fixed size matrix and initialiser list" ); - } - else - { - t.set_size(x_n_rows, x_n_cols); - } - - // if the inner lists have varying number of elements, treat missing elements as zeros - if(t.n_elem != x_n_elem) { t.zeros(); } - - uword row_num = 0; - - auto row_it = list.begin(); - auto row_it_end = list.end(); - - for(; row_it != row_it_end; ++row_it) - { - uword col_num = 0; - - auto col_it = (*row_it).begin(); - auto col_it_end = (*row_it).end(); - - for(; col_it != col_it_end; ++col_it) - { - t.at(row_num, col_num) = (*col_it); - ++col_num; - } - - ++row_num; - } - } - - - -//! for constructing a complex matrix out of two non-complex matrices -template -template -inline -void -Mat::init - ( - const Base::pod_type, T1>& X, - const Base::pod_type, T2>& Y - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type T; - - arma_type_check(( is_cx::no )); //!< compile-time abort if eT is not std::complex - arma_type_check(( is_cx< T>::yes )); //!< compile-time abort if T is std::complex - - arma_type_check(( is_same_type< std::complex, eT >::no )); //!< compile-time abort if types are not compatible - - const Proxy PX(X.get_ref()); - const Proxy PY(Y.get_ref()); - - arma_conform_assert_same_size(PX, PY, "Mat()"); - - const uword local_n_rows = PX.get_n_rows(); - const uword local_n_cols = PX.get_n_cols(); - - init_warm(local_n_rows, local_n_cols); - - eT* out_mem = (*this).memptr(); - - constexpr bool use_at = ( Proxy::use_at || Proxy::use_at ); - - if(use_at == false) - { - typedef typename Proxy::ea_type ea_type1; - typedef typename Proxy::ea_type ea_type2; - - const uword N = n_elem; - - ea_type1 A = PX.get_ea(); - ea_type2 B = PY.get_ea(); - - for(uword ii=0; ii < N; ++ii) - { - out_mem[ii] = std::complex(A[ii], B[ii]); - } - } - else - { - for(uword ucol=0; ucol < local_n_cols; ++ucol) - for(uword urow=0; urow < local_n_rows; ++urow) - { - *out_mem = std::complex(PX.at(urow,ucol), PY.at(urow,ucol)); - out_mem++; - } - } - } - - - -//! swap the contents of this matrix, denoted as matrix A, with given matrix B -template -inline -void -Mat::swap(Mat& B) - { - Mat& A = (*this); - - arma_debug_sigprint(arma_str::format("A: %x; B: %x") % &A % &B); - - bool layout_ok = false; - - if(A.vec_state == B.vec_state) - { - layout_ok = true; - } - else - { - const uhword A_vec_state = A.vec_state; - const uhword B_vec_state = B.vec_state; - - const bool A_absorbs_B = (A_vec_state == 0) || ( (A_vec_state == 1) && (B.n_cols == 1) ) || ( (A_vec_state == 2) && (B.n_rows == 1) ); - const bool B_absorbs_A = (B_vec_state == 0) || ( (B_vec_state == 1) && (A.n_cols == 1) ) || ( (B_vec_state == 2) && (A.n_rows == 1) ); - - layout_ok = A_absorbs_B && B_absorbs_A; - } - - const uhword A_mem_state = A.mem_state; - const uhword B_mem_state = B.mem_state; - - if( (A_mem_state == 0) && (B_mem_state == 0) && layout_ok ) - { - const uword A_n_elem = A.n_elem; - const uword B_n_elem = B.n_elem; - - const bool A_use_local_mem = (A.n_alloc <= arma_config::mat_prealloc); - const bool B_use_local_mem = (B.n_alloc <= arma_config::mat_prealloc); - - if( (A_use_local_mem == false) && (B_use_local_mem == false) ) - { - std::swap( access::rw(A.mem), access::rw(B.mem) ); - } - else - if( (A_use_local_mem == true) && (B_use_local_mem == true) ) - { - eT* A_mem_local = &(A.mem_local[0]); - eT* B_mem_local = &(B.mem_local[0]); - - access::rw(A.mem) = A_mem_local; - access::rw(B.mem) = B_mem_local; - - const uword N = (std::max)(A_n_elem, B_n_elem); - - for(uword ii=0; ii < N; ++ii) { std::swap( A_mem_local[ii], B_mem_local[ii] ); } - } - else - if( (A_use_local_mem == true) && (B_use_local_mem == false) ) - { - eT* A_mem_local = &(A.mem_local[0]); - eT* B_mem_local = &(B.mem_local[0]); - - arrayops::copy(B_mem_local, A_mem_local, A_n_elem); - - access::rw(A.mem) = B.mem; - access::rw(B.mem) = B_mem_local; - } - else - if( (A_use_local_mem == false) && (B_use_local_mem == true) ) - { - eT* A_mem_local = &(A.mem_local[0]); - eT* B_mem_local = &(B.mem_local[0]); - - arrayops::copy(A_mem_local, B_mem_local, B_n_elem); - - access::rw(B.mem) = A.mem; - access::rw(A.mem) = A_mem_local; - } - - std::swap( access::rw(A.n_rows), access::rw(B.n_rows) ); - std::swap( access::rw(A.n_cols), access::rw(B.n_cols) ); - std::swap( access::rw(A.n_elem), access::rw(B.n_elem) ); - std::swap( access::rw(A.n_alloc), access::rw(B.n_alloc) ); - } - else - if( (A_mem_state <= 2) && (B_mem_state <= 2) && (A.n_elem == B.n_elem) && layout_ok ) - { - std::swap( access::rw(A.n_rows), access::rw(B.n_rows) ); - std::swap( access::rw(A.n_cols), access::rw(B.n_cols) ); - - const uword N = A.n_elem; - - eT* A_mem = A.memptr(); - eT* B_mem = B.memptr(); - - for(uword ii=0; ii < N; ++ii) { std::swap(A_mem[ii], B_mem[ii]); } - } - else - if( (A.n_rows == B.n_rows) && (A.n_cols == B.n_cols) ) - { - const uword N = A.n_elem; - - eT* A_mem = A.memptr(); - eT* B_mem = B.memptr(); - - for(uword ii=0; ii < N; ++ii) { std::swap(A_mem[ii], B_mem[ii]); } - } - else - { - // generic swap to handle remaining cases - - if(A.n_elem <= B.n_elem) - { - Mat C = A; - - A.steal_mem(B); - B.steal_mem(C); - } - else - { - Mat C = B; - - B.steal_mem(A); - A.steal_mem(C); - } - } - } - - - -//! try to steal the memory from a given matrix; -//! if memory can't be stolen, copy the given matrix -template -inline -void -Mat::steal_mem(Mat& x) - { - arma_debug_sigprint(); - - (*this).steal_mem(x, false); - } - - - -template -inline -void -Mat::steal_mem(Mat& x, const bool is_move) - { - arma_debug_sigprint(); - - if(this == &x) { return; } - - const uword x_n_rows = x.n_rows; - const uword x_n_cols = x.n_cols; - const uword x_n_elem = x.n_elem; - const uword x_n_alloc = x.n_alloc; - const uhword x_vec_state = x.vec_state; - const uhword x_mem_state = x.mem_state; - - const uhword t_vec_state = vec_state; - const uhword t_mem_state = mem_state; - - const bool layout_ok = (t_vec_state == x_vec_state) || ((t_vec_state == 1) && (x_n_cols == 1)) || ((t_vec_state == 2) && (x_n_rows == 1)); - - if( layout_ok && (t_mem_state <= 1) && ( (x_n_alloc > arma_config::mat_prealloc) || (x_mem_state == 1) || (is_move && (x_mem_state == 2)) ) ) - { - arma_debug_print("Mat::steal_mem(): stealing memory"); - - reset(); - - access::rw(n_rows) = x_n_rows; - access::rw(n_cols) = x_n_cols; - access::rw(n_elem) = x_n_elem; - access::rw(n_alloc) = x_n_alloc; - access::rw(mem_state) = x_mem_state; - access::rw(mem) = x.mem; - - access::rw(x.n_rows) = (x_vec_state == 2) ? 1 : 0; - access::rw(x.n_cols) = (x_vec_state == 1) ? 1 : 0; - access::rw(x.n_elem) = 0; - access::rw(x.n_alloc) = 0; - access::rw(x.mem_state) = 0; - access::rw(x.mem) = nullptr; - } - else - { - arma_debug_print("Mat::steal_mem(): copying memory"); - - (*this).operator=(x); - - if( (is_move) && (x_mem_state == 0) && (x_n_alloc <= arma_config::mat_prealloc) ) - { - access::rw(x.n_rows) = (x_vec_state == 2) ? 1 : 0; - access::rw(x.n_cols) = (x_vec_state == 1) ? 1 : 0; - access::rw(x.n_elem) = 0; - access::rw(x.mem) = nullptr; - } - } - } - - - -template -inline -void -Mat::steal_mem_col(Mat& x, const uword max_n_rows) - { - arma_debug_sigprint(); - - const uword x_n_elem = x.n_elem; - const uword x_n_alloc = x.n_alloc; - const uhword x_mem_state = x.mem_state; - - const uhword t_vec_state = vec_state; - const uhword t_mem_state = mem_state; - - const uword alt_n_rows = (std::min)(x.n_rows, max_n_rows); - - if((x_n_elem == 0) || (alt_n_rows == 0)) - { - (*this).set_size(0,1); - - return; - } - - if( (this != &x) && (t_vec_state <= 1) && (t_mem_state <= 1) && (x_mem_state <= 1) ) - { - if( (x_mem_state == 0) && ((x_n_alloc <= arma_config::mat_prealloc) || (alt_n_rows <= arma_config::mat_prealloc)) ) - { - (*this).set_size(alt_n_rows, uword(1)); - - arrayops::copy( (*this).memptr(), x.memptr(), alt_n_rows ); - } - else - { - reset(); - - access::rw(n_rows) = alt_n_rows; - access::rw(n_cols) = 1; - access::rw(n_elem) = alt_n_rows; - access::rw(n_alloc) = x_n_alloc; - access::rw(mem_state) = x_mem_state; - access::rw(mem) = x.mem; - - access::rw(x.n_rows) = 0; - access::rw(x.n_cols) = 0; - access::rw(x.n_elem) = 0; - access::rw(x.n_alloc) = 0; - access::rw(x.mem_state) = 0; - access::rw(x.mem) = nullptr; - } - } - else - { - Mat tmp(alt_n_rows, 1, arma_nozeros_indicator()); - - arrayops::copy( tmp.memptr(), x.memptr(), alt_n_rows ); - - steal_mem(tmp); - } - } - - - -//! construct a matrix from a given auxiliary array of eTs. -//! if copy_aux_mem is true, new memory is allocated and the array is copied. -//! if copy_aux_mem is false, the auxiliary array is used directly (without allocating memory and copying). -//! the default is to copy the array. - -template -inline -Mat::Mat(eT* aux_mem, const uword aux_n_rows, const uword aux_n_cols, const bool copy_aux_mem, const bool strict) - : n_rows ( aux_n_rows ) - , n_cols ( aux_n_cols ) - , n_elem ( aux_n_rows*aux_n_cols ) - , n_alloc ( 0 ) - , vec_state( 0 ) - , mem_state( copy_aux_mem ? 0 : ( strict ? 2 : 1 ) ) - , mem ( copy_aux_mem ? nullptr : aux_mem ) - { - arma_debug_sigprint_this(this); - - if(copy_aux_mem) - { - init_cold(); - - arrayops::copy( memptr(), aux_mem, n_elem ); - } - } - - - -//! construct a matrix from a given auxiliary read-only array of eTs. -//! the array is copied. -template -inline -Mat::Mat(const eT* aux_mem, const uword aux_n_rows, const uword aux_n_cols) - : n_rows(aux_n_rows) - , n_cols(aux_n_cols) - , n_elem(aux_n_rows*aux_n_cols) - , n_alloc() - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - arrayops::copy( memptr(), aux_mem, n_elem ); - } - - - -//! DANGEROUS! Construct a temporary matrix, using auxiliary memory. -//! This constructor is NOT intended for usage by user code. -//! Its sole purpose is to be used by the Cube class. - -template -inline -Mat::Mat(const char junk, const eT* aux_mem, const uword aux_n_rows, const uword aux_n_cols) - : n_rows (aux_n_rows ) - , n_cols (aux_n_cols ) - , n_elem (aux_n_rows*aux_n_cols) - , n_alloc (0 ) - , vec_state(0 ) - , mem_state(3 ) - , mem (aux_mem ) - { - arma_debug_sigprint_this(this); - - arma_ignore(junk); - } - - - -//! in-place matrix addition -template -inline -Mat& -Mat::operator+=(const Mat& m) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(*this, m, "addition"); - - arrayops::inplace_plus( memptr(), m.memptr(), n_elem ); - - return *this; - } - - - -//! in-place matrix subtraction -template -inline -Mat& -Mat::operator-=(const Mat& m) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(*this, m, "subtraction"); - - arrayops::inplace_minus( memptr(), m.memptr(), n_elem ); - - return *this; - } - - - -//! in-place matrix multiplication -template -inline -Mat& -Mat::operator*=(const Mat& m) - { - arma_debug_sigprint(); - - glue_times::apply_inplace(*this, m); - - return *this; - } - - - -//! in-place element-wise matrix multiplication -template -inline -Mat& -Mat::operator%=(const Mat& m) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(*this, m, "element-wise multiplication"); - - arrayops::inplace_mul( memptr(), m.memptr(), n_elem ); - - return *this; - } - - - -//! in-place element-wise matrix division -template -inline -Mat& -Mat::operator/=(const Mat& m) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(*this, m, "element-wise division"); - - arrayops::inplace_div( memptr(), m.memptr(), n_elem ); - - return *this; - } - - - -template -template -inline -Mat::Mat(const BaseCube& X) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - (*this).operator=(X); - } - - - -template -template -inline -Mat& -Mat::operator=(const BaseCube& X) - { - arma_debug_sigprint(); - - Mat& out = *this; - - const unwrap_cube tmp(X.get_ref()); - const Cube& in = tmp.M; - - arma_conform_assert_cube_as_mat(out, in, "copy into matrix", false); - - const uword in_n_rows = in.n_rows; - const uword in_n_cols = in.n_cols; - const uword in_n_slices = in.n_slices; - - const uword out_vec_state = out.vec_state; - - if(in_n_slices == 1) - { - out.set_size(in_n_rows, in_n_cols); - - for(uword ucol=0; ucol < in_n_cols; ++ucol) - { - arrayops::copy( out.colptr(ucol), in.slice_colptr(0, ucol), in_n_rows ); - } - } - else - { - if(out_vec_state == 0) - { - if(in_n_cols == 1) - { - out.set_size(in_n_rows, in_n_slices); - - for(uword i=0; i < in_n_slices; ++i) - { - arrayops::copy( out.colptr(i), in.slice_colptr(i, 0), in_n_rows ); - } - } - else - if(in_n_rows == 1) - { - out.set_size(in_n_cols, in_n_slices); - - for(uword slice=0; slice < in_n_slices; ++slice) - { - eT* out_colptr = out.colptr(slice); - - uword i,j; - for(i=0, j=1; j < in_n_cols; i+=2, j+=2) - { - const eT tmp_i = in.at(0, i, slice); - const eT tmp_j = in.at(0, j, slice); - - out_colptr[i] = tmp_i; - out_colptr[j] = tmp_j; - } - - if(i < in_n_cols) - { - out_colptr[i] = in.at(0, i, slice); - } - } - } - } - else - { - out.set_size(in_n_slices); - - eT* out_mem = out.memptr(); - - for(uword i=0; i -template -inline -Mat& -Mat::operator+=(const BaseCube& X) - { - arma_debug_sigprint(); - - Mat& out = *this; - - const unwrap_cube tmp(X.get_ref()); - const Cube& in = tmp.M; - - arma_conform_assert_cube_as_mat(out, in, "addition", true); - - const uword in_n_rows = in.n_rows; - const uword in_n_cols = in.n_cols; - const uword in_n_slices = in.n_slices; - - const uword out_n_rows = out.n_rows; - const uword out_n_cols = out.n_cols; - const uword out_vec_state = out.vec_state; - - if(in_n_slices == 1) - { - for(uword ucol=0; ucol < in_n_cols; ++ucol) - { - arrayops::inplace_plus( out.colptr(ucol), in.slice_colptr(0, ucol), in_n_rows ); - } - } - else - { - if(out_vec_state == 0) - { - if( (in_n_rows == out_n_rows) && (in_n_cols == 1) && (in_n_slices == out_n_cols) ) - { - for(uword i=0; i < in_n_slices; ++i) - { - arrayops::inplace_plus( out.colptr(i), in.slice_colptr(i, 0), in_n_rows ); - } - } - else - if( (in_n_rows == 1) && (in_n_cols == out_n_rows) && (in_n_slices == out_n_cols) ) - { - for(uword slice=0; slice < in_n_slices; ++slice) - { - eT* out_colptr = out.colptr(slice); - - uword i,j; - for(i=0, j=1; j < in_n_cols; i+=2, j+=2) - { - const eT tmp_i = in.at(0, i, slice); - const eT tmp_j = in.at(0, j, slice); - - out_colptr[i] += tmp_i; - out_colptr[j] += tmp_j; - } - - if(i < in_n_cols) - { - out_colptr[i] += in.at(0, i, slice); - } - } - } - } - else - { - eT* out_mem = out.memptr(); - - for(uword i=0; i -template -inline -Mat& -Mat::operator-=(const BaseCube& X) - { - arma_debug_sigprint(); - - Mat& out = *this; - - const unwrap_cube tmp(X.get_ref()); - const Cube& in = tmp.M; - - arma_conform_assert_cube_as_mat(out, in, "subtraction", true); - - const uword in_n_rows = in.n_rows; - const uword in_n_cols = in.n_cols; - const uword in_n_slices = in.n_slices; - - const uword out_n_rows = out.n_rows; - const uword out_n_cols = out.n_cols; - const uword out_vec_state = out.vec_state; - - if(in_n_slices == 1) - { - for(uword ucol=0; ucol < in_n_cols; ++ucol) - { - arrayops::inplace_minus( out.colptr(ucol), in.slice_colptr(0, ucol), in_n_rows ); - } - } - else - { - if(out_vec_state == 0) - { - if( (in_n_rows == out_n_rows) && (in_n_cols == 1) && (in_n_slices == out_n_cols) ) - { - for(uword i=0; i < in_n_slices; ++i) - { - arrayops::inplace_minus( out.colptr(i), in.slice_colptr(i, 0), in_n_rows ); - } - } - else - if( (in_n_rows == 1) && (in_n_cols == out_n_rows) && (in_n_slices == out_n_cols) ) - { - for(uword slice=0; slice < in_n_slices; ++slice) - { - eT* out_colptr = out.colptr(slice); - - uword i,j; - for(i=0, j=1; j < in_n_cols; i+=2, j+=2) - { - const eT tmp_i = in.at(0, i, slice); - const eT tmp_j = in.at(0, j, slice); - - out_colptr[i] -= tmp_i; - out_colptr[j] -= tmp_j; - } - - if(i < in_n_cols) - { - out_colptr[i] -= in.at(0, i, slice); - } - } - } - } - else - { - eT* out_mem = out.memptr(); - - for(uword i=0; i -template -inline -Mat& -Mat::operator*=(const BaseCube& X) - { - arma_debug_sigprint(); - - const Mat B(X); - - (*this).operator*=(B); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator%=(const BaseCube& X) - { - arma_debug_sigprint(); - - Mat& out = *this; - - const unwrap_cube tmp(X.get_ref()); - const Cube& in = tmp.M; - - arma_conform_assert_cube_as_mat(out, in, "element-wise multiplication", true); - - const uword in_n_rows = in.n_rows; - const uword in_n_cols = in.n_cols; - const uword in_n_slices = in.n_slices; - - const uword out_n_rows = out.n_rows; - const uword out_n_cols = out.n_cols; - const uword out_vec_state = out.vec_state; - - if(in_n_slices == 1) - { - for(uword ucol=0; ucol < in_n_cols; ++ucol) - { - arrayops::inplace_mul( out.colptr(ucol), in.slice_colptr(0, ucol), in_n_rows ); - } - } - else - { - if(out_vec_state == 0) - { - if( (in_n_rows == out_n_rows) && (in_n_cols == 1) && (in_n_slices == out_n_cols) ) - { - for(uword i=0; i < in_n_slices; ++i) - { - arrayops::inplace_mul( out.colptr(i), in.slice_colptr(i, 0), in_n_rows ); - } - } - else - if( (in_n_rows == 1) && (in_n_cols == out_n_rows) && (in_n_slices == out_n_cols) ) - { - for(uword slice=0; slice < in_n_slices; ++slice) - { - eT* out_colptr = out.colptr(slice); - - uword i,j; - for(i=0, j=1; j < in_n_cols; i+=2, j+=2) - { - const eT tmp_i = in.at(0, i, slice); - const eT tmp_j = in.at(0, j, slice); - - out_colptr[i] *= tmp_i; - out_colptr[j] *= tmp_j; - } - - if(i < in_n_cols) - { - out_colptr[i] *= in.at(0, i, slice); - } - } - } - } - else - { - eT* out_mem = out.memptr(); - - for(uword i=0; i -template -inline -Mat& -Mat::operator/=(const BaseCube& X) - { - arma_debug_sigprint(); - - Mat& out = *this; - - const unwrap_cube tmp(X.get_ref()); - const Cube& in = tmp.M; - - arma_conform_assert_cube_as_mat(out, in, "element-wise division", true); - - const uword in_n_rows = in.n_rows; - const uword in_n_cols = in.n_cols; - const uword in_n_slices = in.n_slices; - - const uword out_n_rows = out.n_rows; - const uword out_n_cols = out.n_cols; - const uword out_vec_state = out.vec_state; - - if(in_n_slices == 1) - { - for(uword ucol=0; ucol < in_n_cols; ++ucol) - { - arrayops::inplace_div( out.colptr(ucol), in.slice_colptr(0, ucol), in_n_rows ); - } - } - else - { - if(out_vec_state == 0) - { - if( (in_n_rows == out_n_rows) && (in_n_cols == 1) && (in_n_slices == out_n_cols) ) - { - for(uword i=0; i < in_n_slices; ++i) - { - arrayops::inplace_div( out.colptr(i), in.slice_colptr(i, 0), in_n_rows ); - } - } - else - if( (in_n_rows == 1) && (in_n_cols == out_n_rows) && (in_n_slices == out_n_cols) ) - { - for(uword slice=0; slice < in_n_slices; ++slice) - { - eT* out_colptr = out.colptr(slice); - - uword i,j; - for(i=0, j=1; j < in_n_cols; i+=2, j+=2) - { - const eT tmp_i = in.at(0, i, slice); - const eT tmp_j = in.at(0, j, slice); - - out_colptr[i] /= tmp_i; - out_colptr[j] /= tmp_j; - } - - if(i < in_n_cols) - { - out_colptr[i] /= in.at(0, i, slice); - } - } - } - } - else - { - eT* out_mem = out.memptr(); - - for(uword i=0; i -template -inline -Mat::Mat - ( - const Base::pod_type,T1>& A, - const Base::pod_type,T2>& B - ) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init(A,B); - } - - - -template -inline -Mat::Mat(const subview& X, const bool use_colmem) - : n_rows(X.n_rows) - , n_cols(X.n_cols) - , n_elem(X.n_elem) - , n_alloc(0) - , vec_state(0) - , mem_state(use_colmem ? 3 : 0) - , mem (use_colmem ? X.colptr(0) : nullptr) - { - arma_debug_sigprint_this(this); - - if(use_colmem) - { - arma_debug_print("Mat::Mat(): using existing memory in a submatrix"); - } - else - { - init_cold(); - - subview::extract(*this, X); - } - } - - - -//! construct a matrix from subview (eg. construct a matrix from a delayed submatrix operation) -template -inline -Mat::Mat(const subview& X) - : n_rows(X.n_rows) - , n_cols(X.n_cols) - , n_elem(X.n_elem) - , n_alloc() - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - subview::extract(*this, X); - } - - - -//! construct a matrix from subview (eg. construct a matrix from a delayed submatrix operation) -template -inline -Mat& -Mat::operator=(const subview& X) - { - arma_debug_sigprint(); - - const bool alias = (this == &(X.m)); - - if(alias == false) - { - init_warm(X.n_rows, X.n_cols); - - subview::extract(*this, X); - } - else - { - Mat tmp(X); - - steal_mem(tmp); - } - - return *this; - } - - -//! in-place matrix addition (using a submatrix on the right-hand-side) -template -inline -Mat& -Mat::operator+=(const subview& X) - { - arma_debug_sigprint(); - - subview::plus_inplace(*this, X); - - return *this; - } - - -//! in-place matrix subtraction (using a submatrix on the right-hand-side) -template -inline -Mat& -Mat::operator-=(const subview& X) - { - arma_debug_sigprint(); - - subview::minus_inplace(*this, X); - - return *this; - } - - - -//! in-place matrix mutiplication (using a submatrix on the right-hand-side) -template -inline -Mat& -Mat::operator*=(const subview& X) - { - arma_debug_sigprint(); - - glue_times::apply_inplace(*this, X); - - return *this; - } - - - -//! in-place element-wise matrix mutiplication (using a submatrix on the right-hand-side) -template -inline -Mat& -Mat::operator%=(const subview& X) - { - arma_debug_sigprint(); - - subview::schur_inplace(*this, X); - - return *this; - } - - - -//! in-place element-wise matrix division (using a submatrix on the right-hand-side) -template -inline -Mat& -Mat::operator/=(const subview& X) - { - arma_debug_sigprint(); - - subview::div_inplace(*this, X); - - return *this; - } - - - -template -inline -Mat::Mat(const subview_row_strans& X) - : n_rows(X.n_rows) - , n_cols(X.n_cols) - , n_elem(X.n_elem) - , n_alloc() - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - X.extract(*this); - } - - - -template -inline -Mat::Mat(const subview_row_htrans& X) - : n_rows(X.n_rows) - , n_cols(X.n_cols) - , n_elem(X.n_elem) - , n_alloc() - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - X.extract(*this); - } - - - -template -inline -Mat::Mat(const xvec_htrans& X) - : n_rows(X.n_rows) - , n_cols(X.n_cols) - , n_elem(X.n_elem) - , n_alloc() - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - X.extract(*this); - } - - - -template -template -inline -Mat::Mat(const xtrans_mat& X) - : n_rows(X.n_rows) - , n_cols(X.n_cols) - , n_elem(X.n_elem) - , n_alloc() - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - X.extract(*this); - } - - - -//! construct a matrix from a subview_cube instance -template -inline -Mat::Mat(const subview_cube& x) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - this->operator=(x); - } - - - -//! construct a matrix from a subview_cube instance -template -inline -Mat& -Mat::operator=(const subview_cube& X) - { - arma_debug_sigprint(); - - subview_cube::extract(*this, X); - - return *this; - } - - - -//! in-place matrix addition (using a single-slice subcube on the right-hand-side) -template -inline -Mat& -Mat::operator+=(const subview_cube& X) - { - arma_debug_sigprint(); - - subview_cube::plus_inplace(*this, X); - - return *this; - } - - - -//! in-place matrix subtraction (using a single-slice subcube on the right-hand-side) -template -inline -Mat& -Mat::operator-=(const subview_cube& X) - { - arma_debug_sigprint(); - - subview_cube::minus_inplace(*this, X); - - return *this; - } - - - -//! in-place matrix mutiplication (using a single-slice subcube on the right-hand-side) -template -inline -Mat& -Mat::operator*=(const subview_cube& X) - { - arma_debug_sigprint(); - - const Mat tmp(X); - - glue_times::apply_inplace(*this, tmp); - - return *this; - } - - - -//! in-place element-wise matrix mutiplication (using a single-slice subcube on the right-hand-side) -template -inline -Mat& -Mat::operator%=(const subview_cube& X) - { - arma_debug_sigprint(); - - subview_cube::schur_inplace(*this, X); - - return *this; - } - - - -//! in-place element-wise matrix division (using a single-slice subcube on the right-hand-side) -template -inline -Mat& -Mat::operator/=(const subview_cube& X) - { - arma_debug_sigprint(); - - subview_cube::div_inplace(*this, X); - - return *this; - } - - - -//! construct a matrix from diagview (eg. construct a matrix from a delayed diag operation) -template -inline -Mat::Mat(const diagview& X) - : n_rows(X.n_rows) - , n_cols(X.n_cols) - , n_elem(X.n_elem) - , n_alloc() - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - diagview::extract(*this, X); - } - - - -//! construct a matrix from diagview (eg. construct a matrix from a delayed diag operation) -template -inline -Mat& -Mat::operator=(const diagview& X) - { - arma_debug_sigprint(); - - const bool alias = (this == &(X.m)); - - if(alias == false) - { - init_warm(X.n_rows, X.n_cols); - - diagview::extract(*this, X); - } - else - { - Mat tmp(X); - - steal_mem(tmp); - } - - return *this; - } - - - -//! in-place matrix addition (using a diagview on the right-hand-side) -template -inline -Mat& -Mat::operator+=(const diagview& X) - { - arma_debug_sigprint(); - - diagview::plus_inplace(*this, X); - - return *this; - } - - - -//! in-place matrix subtraction (using a diagview on the right-hand-side) -template -inline -Mat& -Mat::operator-=(const diagview& X) - { - arma_debug_sigprint(); - - diagview::minus_inplace(*this, X); - - return *this; - } - - - -//! in-place matrix mutiplication (using a diagview on the right-hand-side) -template -inline -Mat& -Mat::operator*=(const diagview& X) - { - arma_debug_sigprint(); - - glue_times::apply_inplace(*this, X); - - return *this; - } - - - -//! in-place element-wise matrix mutiplication (using a diagview on the right-hand-side) -template -inline -Mat& -Mat::operator%=(const diagview& X) - { - arma_debug_sigprint(); - - diagview::schur_inplace(*this, X); - - return *this; - } - - - -//! in-place element-wise matrix division (using a diagview on the right-hand-side) -template -inline -Mat& -Mat::operator/=(const diagview& X) - { - arma_debug_sigprint(); - - diagview::div_inplace(*this, X); - - return *this; - } - - - -template -template -inline -Mat::Mat(const subview_elem1& X) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - this->operator=(X); - } - - - -template -template -inline -Mat& -Mat::operator=(const subview_elem1& X) - { - arma_debug_sigprint(); - - subview_elem1::extract(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator+=(const subview_elem1& X) - { - arma_debug_sigprint(); - - subview_elem1::plus_inplace(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator-=(const subview_elem1& X) - { - arma_debug_sigprint(); - - subview_elem1::minus_inplace(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator*=(const subview_elem1& X) - { - arma_debug_sigprint(); - - glue_times::apply_inplace(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator%=(const subview_elem1& X) - { - arma_debug_sigprint(); - - subview_elem1::schur_inplace(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator/=(const subview_elem1& X) - { - arma_debug_sigprint(); - - subview_elem1::div_inplace(*this, X); - - return *this; - } - - - -template -template -inline -Mat::Mat(const subview_elem2& X) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - this->operator=(X); - } - - - -template -template -inline -Mat& -Mat::operator=(const subview_elem2& X) - { - arma_debug_sigprint(); - - subview_elem2::extract(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator+=(const subview_elem2& X) - { - arma_debug_sigprint(); - - subview_elem2::plus_inplace(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator-=(const subview_elem2& X) - { - arma_debug_sigprint(); - - subview_elem2::minus_inplace(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator*=(const subview_elem2& X) - { - arma_debug_sigprint(); - - glue_times::apply_inplace(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator%=(const subview_elem2& X) - { - arma_debug_sigprint(); - - subview_elem2::schur_inplace(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator/=(const subview_elem2& X) - { - arma_debug_sigprint(); - - subview_elem2::div_inplace(*this, X); - - return *this; - } - - - -template -template -inline -Mat::Mat(const SpBase& m) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - (*this).operator=(m); - } - - - -template -template -inline -Mat& -Mat::operator=(const SpBase& m) - { - arma_debug_sigprint(); - - const unwrap_spmat U(m.get_ref()); - const SpMat& x = U.M; - - const uword x_n_cols = x.n_cols; - - (*this).zeros(x.n_rows, x_n_cols); - - if(x.n_nonzero == 0) { return *this; } - - const eT* x_values = x.values; - const uword* x_row_indices = x.row_indices; - const uword* x_col_ptrs = x.col_ptrs; - - for(uword x_col = 0; x_col < x_n_cols; ++x_col) - { - const uword start = x_col_ptrs[x_col ]; - const uword end = x_col_ptrs[x_col + 1]; - - for(uword i = start; i < end; ++i) - { - const uword x_row = x_row_indices[i]; - const eT x_val = x_values[i]; - - at(x_row, x_col) = x_val; - } - } - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator+=(const SpBase& m) - { - arma_debug_sigprint(); - - const SpProxy p(m.get_ref()); - - arma_conform_assert_same_size(n_rows, n_cols, p.get_n_rows(), p.get_n_cols(), "addition"); - - typename SpProxy::const_iterator_type it = p.begin(); - typename SpProxy::const_iterator_type it_end = p.end(); - - for(; it != it_end; ++it) { at(it.row(), it.col()) += (*it); } - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator-=(const SpBase& m) - { - arma_debug_sigprint(); - - const SpProxy p(m.get_ref()); - - arma_conform_assert_same_size(n_rows, n_cols, p.get_n_rows(), p.get_n_cols(), "subtraction"); - - typename SpProxy::const_iterator_type it = p.begin(); - typename SpProxy::const_iterator_type it_end = p.end(); - - for(; it != it_end; ++it) { at(it.row(), it.col()) -= (*it); } - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator*=(const SpBase& m) - { - arma_debug_sigprint(); - - Mat z = (*this) * m.get_ref(); - - steal_mem(z); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator%=(const SpBase& m) - { - arma_debug_sigprint(); - - const SpProxy p(m.get_ref()); - - arma_conform_assert_same_size(n_rows, n_cols, p.get_n_rows(), p.get_n_cols(), "element-wise multiplication"); - - if(p.get_n_nonzero() == 0) { return (*this).zeros(); } - - typename SpProxy::const_iterator_type it = p.begin(); - typename SpProxy::const_iterator_type it_end = p.end(); - - // We have to zero everything that isn't being used. - arrayops::fill_zeros(memptr(), (it.col() * n_rows) + it.row()); - - while(it != it_end) - { - const uword cur_loc = (it.col() * n_rows) + it.row(); - - access::rw(mem[cur_loc]) *= (*it); - - ++it; - - const uword next_loc = (it == it_end) - ? (p.get_n_cols() * n_rows) - : (it.col() * n_rows) + it.row(); - - arrayops::fill_zeros(memptr() + cur_loc + 1, (next_loc - cur_loc - 1)); - } - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator/=(const SpBase& m) - { - arma_debug_sigprint(); - - // NOTE: use of this function is not advised; it is implemented only for completeness - - const SpProxy p(m.get_ref()); - - arma_conform_assert_same_size(n_rows, n_cols, p.get_n_rows(), p.get_n_cols(), "element-wise division"); - - for(uword c = 0; c < n_cols; ++c) - for(uword r = 0; r < n_rows; ++r) - { - at(r, c) /= p.at(r, c); - } - - return *this; - } - - - -template -inline -Mat::Mat(const SpSubview& X) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - (*this).operator=(X); - } - - - -template -inline -Mat& -Mat::operator=(const SpSubview& X) - { - arma_debug_sigprint(); - - (*this).zeros(X.n_rows, X.n_cols); - - if(X.n_nonzero == 0) { return *this; } - - if(X.n_rows == X.m.n_rows) - { - X.m.sync(); - - const uword sv_col_start = X.aux_col1; - const uword sv_col_end = X.aux_col1 + X.n_cols - 1; - - const eT* m_values = X.m.values; - const uword* m_row_indices = X.m.row_indices; - const uword* m_col_ptrs = X.m.col_ptrs; - - for(uword m_col = sv_col_start; m_col <= sv_col_end; ++m_col) - { - const uword m_col_adjusted = m_col - sv_col_start; - - const uword start = m_col_ptrs[m_col ]; - const uword end = m_col_ptrs[m_col + 1]; - - for(uword ii = start; ii < end; ++ii) - { - const uword m_row = m_row_indices[ii]; - const eT m_val = m_values[ii]; - - at(m_row, m_col_adjusted) = m_val; - } - } - } - else - { - typename SpSubview::const_iterator it = X.begin(); - typename SpSubview::const_iterator it_end = X.end(); - - for(; it != it_end; ++it) { at(it.row(), it.col()) = (*it); } - } - - return *this; - } - - - -template -inline -Mat& -Mat::operator+=(const SpSubview& X) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(n_rows, n_cols, X.n_rows, X.n_cols, "addition"); - - if(X.n_nonzero == 0) { return *this; } - - if(X.n_rows == X.m.n_rows) - { - X.m.sync(); - - const uword sv_col_start = X.aux_col1; - const uword sv_col_end = X.aux_col1 + X.n_cols - 1; - - const eT* m_values = X.m.values; - const uword* m_row_indices = X.m.row_indices; - const uword* m_col_ptrs = X.m.col_ptrs; - - for(uword m_col = sv_col_start; m_col <= sv_col_end; ++m_col) - { - const uword m_col_adjusted = m_col - sv_col_start; - - const uword start = m_col_ptrs[m_col ]; - const uword end = m_col_ptrs[m_col + 1]; - - for(uword ii = start; ii < end; ++ii) - { - const uword m_row = m_row_indices[ii]; - const eT m_val = m_values[ii]; - - at(m_row, m_col_adjusted) += m_val; - } - } - } - else - { - typename SpSubview::const_iterator it = X.begin(); - typename SpSubview::const_iterator it_end = X.end(); - - for(; it != it_end; ++it) { at(it.row(), it.col()) += (*it); } - } - - return *this; - } - - - -template -inline -Mat& -Mat::operator-=(const SpSubview& X) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(n_rows, n_cols, X.n_rows, X.n_cols, "subtraction"); - - if(X.n_nonzero == 0) { return *this; } - - if(X.n_rows == X.m.n_rows) - { - X.m.sync(); - - const uword sv_col_start = X.aux_col1; - const uword sv_col_end = X.aux_col1 + X.n_cols - 1; - - const eT* m_values = X.m.values; - const uword* m_row_indices = X.m.row_indices; - const uword* m_col_ptrs = X.m.col_ptrs; - - for(uword m_col = sv_col_start; m_col <= sv_col_end; ++m_col) - { - const uword m_col_adjusted = m_col - sv_col_start; - - const uword start = m_col_ptrs[m_col ]; - const uword end = m_col_ptrs[m_col + 1]; - - for(uword ii = start; ii < end; ++ii) - { - const uword m_row = m_row_indices[ii]; - const eT m_val = m_values[ii]; - - at(m_row, m_col_adjusted) -= m_val; - } - } - } - else - { - typename SpSubview::const_iterator it = X.begin(); - typename SpSubview::const_iterator it_end = X.end(); - - for(; it != it_end; ++it) { at(it.row(), it.col()) -= (*it); } - } - - return *this; - } - - - -template -inline -Mat::Mat(const spdiagview& X) - : n_rows(X.n_rows) - , n_cols(X.n_cols) - , n_elem(X.n_elem) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - init_cold(); - - spdiagview::extract(*this, X); - } - - - -template -inline -Mat& -Mat::operator=(const spdiagview& X) - { - arma_debug_sigprint(); - - init_warm(X.n_rows, X.n_cols); - - spdiagview::extract(*this, X); - - return *this; - } - - - -template -inline -Mat& -Mat::operator+=(const spdiagview& X) - { - arma_debug_sigprint(); - - const Mat tmp(X); - - return (*this).operator+=(tmp); - } - - - -template -inline -Mat& -Mat::operator-=(const spdiagview& X) - { - arma_debug_sigprint(); - - const Mat tmp(X); - - return (*this).operator-=(tmp); - } - - - -template -inline -Mat& -Mat::operator*=(const spdiagview& X) - { - arma_debug_sigprint(); - - const Mat tmp(X); - - return (*this).operator*=(tmp); - } - - - -template -inline -Mat& -Mat::operator%=(const spdiagview& X) - { - arma_debug_sigprint(); - - const Mat tmp(X); - - return (*this).operator%=(tmp); - } - - - -template -inline -Mat& -Mat::operator/=(const spdiagview& X) - { - arma_debug_sigprint(); - - const Mat tmp(X); - - return (*this).operator/=(tmp); - } - - - -template -inline -mat_injector< Mat > -Mat::operator<<(const eT val) - { - return mat_injector< Mat >(*this, val); - } - - - -template -inline -mat_injector< Mat > -Mat::operator<<(const injector_end_of_row<>& x) - { - return mat_injector< Mat >(*this, x); - } - - - -//! creation of subview (row vector) -template -arma_inline -subview_row -Mat::row(const uword row_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( row_num >= n_rows, "Mat::row(): index out of bounds" ); - - return subview_row(*this, row_num); - } - - - -//! creation of subview (row vector) -template -arma_inline -const subview_row -Mat::row(const uword row_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( row_num >= n_rows, "Mat::row(): index out of bounds" ); - - return subview_row(*this, row_num); - } - - - -template -inline -subview_row -Mat::operator()(const uword row_num, const span& col_span) - { - arma_debug_sigprint(); - - const bool col_all = col_span.whole; - - const uword local_n_cols = n_cols; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword submat_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - arma_conform_check_bounds - ( - (row_num >= n_rows) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - , - "Mat::operator(): indices out of bounds or incorrectly used" - ); - - return subview_row(*this, row_num, in_col1, submat_n_cols); - } - - - -template -inline -const subview_row -Mat::operator()(const uword row_num, const span& col_span) const - { - arma_debug_sigprint(); - - const bool col_all = col_span.whole; - - const uword local_n_cols = n_cols; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword submat_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - arma_conform_check_bounds - ( - (row_num >= n_rows) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - , - "Mat::operator(): indices out of bounds or incorrectly used" - ); - - return subview_row(*this, row_num, in_col1, submat_n_cols); - } - - - -//! creation of subview (column vector) -template -arma_inline -subview_col -Mat::col(const uword col_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( col_num >= n_cols, "Mat::col(): index out of bounds" ); - - return subview_col(*this, col_num); - } - - - -//! creation of subview (column vector) -template -arma_inline -const subview_col -Mat::col(const uword col_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( col_num >= n_cols, "Mat::col(): index out of bounds" ); - - return subview_col(*this, col_num); - } - - - -template -inline -subview_col -Mat::operator()(const span& row_span, const uword col_num) - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - - const uword local_n_rows = n_rows; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword submat_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - arma_conform_check_bounds - ( - (col_num >= n_cols) - || - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - , - "Mat::operator(): indices out of bounds or incorrectly used" - ); - - return subview_col(*this, col_num, in_row1, submat_n_rows); - } - - - -template -inline -const subview_col -Mat::operator()(const span& row_span, const uword col_num) const - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - - const uword local_n_rows = n_rows; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword submat_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - arma_conform_check_bounds - ( - (col_num >= n_cols) - || - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - , - "Mat::operator(): indices out of bounds or incorrectly used" - ); - - return subview_col(*this, col_num, in_row1, submat_n_rows); - } - - - -//! create a Col object which uses memory from an existing matrix object. -//! this approach is currently not alias safe -//! and does not take into account that the parent matrix object could be deleted. -//! if deleted memory is accessed by the created Col object, -//! it will cause memory corruption and/or a crash -template -inline -Col -Mat::unsafe_col(const uword col_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( col_num >= n_cols, "Mat::unsafe_col(): index out of bounds" ); - - return Col(colptr(col_num), n_rows, false, true); - } - - - -//! create a Col object which uses memory from an existing matrix object. -//! this approach is currently not alias safe -//! and does not take into account that the parent matrix object could be deleted. -//! if deleted memory is accessed by the created Col object, -//! it will cause memory corruption and/or a crash -template -inline -const Col -Mat::unsafe_col(const uword col_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( col_num >= n_cols, "Mat::unsafe_col(): index out of bounds" ); - - typedef const Col out_type; - - return out_type(const_cast(colptr(col_num)), n_rows, false, true); - } - - - -//! creation of subview (submatrix comprised of specified row vectors) -template -arma_inline -subview -Mat::rows(const uword in_row1, const uword in_row2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_row2 >= n_rows), - "Mat::rows(): indices out of bounds or incorrectly used" - ); - - const uword subview_n_rows = in_row2 - in_row1 + 1; - - return subview(*this, in_row1, 0, subview_n_rows, n_cols ); - } - - - -//! creation of subview (submatrix comprised of specified row vectors) -template -arma_inline -const subview -Mat::rows(const uword in_row1, const uword in_row2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_row2 >= n_rows), - "Mat::rows(): indices out of bounds or incorrectly used" - ); - - const uword subview_n_rows = in_row2 - in_row1 + 1; - - return subview(*this, in_row1, 0, subview_n_rows, n_cols ); - } - - - -//! creation of subview (submatrix comprised of specified column vectors) -template -arma_inline -subview_cols -Mat::cols(const uword in_col1, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_col1 > in_col2) || (in_col2 >= n_cols), - "Mat::cols(): indices out of bounds or incorrectly used" - ); - - const uword subview_n_cols = in_col2 - in_col1 + 1; - - return subview_cols(*this, in_col1, subview_n_cols); - } - - - -//! creation of subview (submatrix comprised of specified column vectors) -template -arma_inline -const subview_cols -Mat::cols(const uword in_col1, const uword in_col2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_col1 > in_col2) || (in_col2 >= n_cols), - "Mat::cols(): indices out of bounds or incorrectly used" - ); - - const uword subview_n_cols = in_col2 - in_col1 + 1; - - return subview_cols(*this, in_col1, subview_n_cols); - } - - - -//! creation of subview (submatrix comprised of specified row vectors) -template -inline -subview -Mat::rows(const span& row_span) - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - - const uword local_n_rows = n_rows; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword submat_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - arma_conform_check_bounds - ( - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - , - "Mat::rows(): indices out of bounds or incorrectly used" - ); - - return subview(*this, in_row1, 0, submat_n_rows, n_cols); - } - - - -//! creation of subview (submatrix comprised of specified row vectors) -template -inline -const subview -Mat::rows(const span& row_span) const - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - - const uword local_n_rows = n_rows; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword submat_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - arma_conform_check_bounds - ( - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - , - "Mat::rows(): indices out of bounds or incorrectly used" - ); - - return subview(*this, in_row1, 0, submat_n_rows, n_cols); - } - - - -//! creation of subview (submatrix comprised of specified column vectors) -template -arma_inline -subview_cols -Mat::cols(const span& col_span) - { - arma_debug_sigprint(); - - const bool col_all = col_span.whole; - - const uword local_n_cols = n_cols; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword submat_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - arma_conform_check_bounds - ( - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - , - "Mat::cols(): indices out of bounds or incorrectly used" - ); - - return subview_cols(*this, in_col1, submat_n_cols); - } - - - -//! creation of subview (submatrix comprised of specified column vectors) -template -arma_inline -const subview_cols -Mat::cols(const span& col_span) const - { - arma_debug_sigprint(); - - const bool col_all = col_span.whole; - - const uword local_n_cols = n_cols; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword submat_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - arma_conform_check_bounds - ( - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - , - "Mat::cols(): indices out of bounds or incorrectly used" - ); - - return subview_cols(*this, in_col1, submat_n_cols); - } - - - -//! creation of subview (submatrix) -template -arma_inline -subview -Mat::submat(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_col1 > in_col2) || (in_row2 >= n_rows) || (in_col2 >= n_cols), - "Mat::submat(): indices out of bounds or incorrectly used" - ); - - const uword subview_n_rows = in_row2 - in_row1 + 1; - const uword subview_n_cols = in_col2 - in_col1 + 1; - - return subview(*this, in_row1, in_col1, subview_n_rows, subview_n_cols); - } - - - -//! creation of subview (generic submatrix) -template -arma_inline -const subview -Mat::submat(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_col1 > in_col2) || (in_row2 >= n_rows) || (in_col2 >= n_cols), - "Mat::submat(): indices out of bounds or incorrectly used" - ); - - const uword subview_n_rows = in_row2 - in_row1 + 1; - const uword subview_n_cols = in_col2 - in_col1 + 1; - - return subview(*this, in_row1, in_col1, subview_n_rows, subview_n_cols); - } - - - -//! creation of subview (submatrix) -template -arma_inline -subview -Mat::submat(const uword in_row1, const uword in_col1, const SizeMat& s) - { - arma_debug_sigprint(); - - const uword l_n_rows = n_rows; - const uword l_n_cols = n_cols; - - const uword s_n_rows = s.n_rows; - const uword s_n_cols = s.n_cols; - - arma_conform_check_bounds - ( - ((in_row1 >= l_n_rows) || (in_col1 >= l_n_cols) || ((in_row1 + s_n_rows) > l_n_rows) || ((in_col1 + s_n_cols) > l_n_cols)), - "Mat::submat(): indices or size out of bounds" - ); - - return subview(*this, in_row1, in_col1, s_n_rows, s_n_cols); - } - - - -//! creation of subview (submatrix) -template -arma_inline -const subview -Mat::submat(const uword in_row1, const uword in_col1, const SizeMat& s) const - { - arma_debug_sigprint(); - - const uword l_n_rows = n_rows; - const uword l_n_cols = n_cols; - - const uword s_n_rows = s.n_rows; - const uword s_n_cols = s.n_cols; - - arma_conform_check_bounds - ( - ((in_row1 >= l_n_rows) || (in_col1 >= l_n_cols) || ((in_row1 + s_n_rows) > l_n_rows) || ((in_col1 + s_n_cols) > l_n_cols)), - "Mat::submat(): indices or size out of bounds" - ); - - return subview(*this, in_row1, in_col1, s_n_rows, s_n_cols); - } - - - -//! creation of subview (submatrix) -template -inline -subview -Mat::submat(const span& row_span, const span& col_span) - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - const bool col_all = col_span.whole; - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword submat_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword submat_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - arma_conform_check_bounds - ( - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - , - "Mat::submat(): indices out of bounds or incorrectly used" - ); - - return subview(*this, in_row1, in_col1, submat_n_rows, submat_n_cols); - } - - - -//! creation of subview (generic submatrix) -template -inline -const subview -Mat::submat(const span& row_span, const span& col_span) const - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - const bool col_all = col_span.whole; - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword submat_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword submat_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - arma_conform_check_bounds - ( - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - , - "Mat::submat(): indices out of bounds or incorrectly used" - ); - - return subview(*this, in_row1, in_col1, submat_n_rows, submat_n_cols); - } - - - -template -inline -subview -Mat::operator()(const span& row_span, const span& col_span) - { - arma_debug_sigprint(); - - return (*this).submat(row_span, col_span); - } - - - -template -inline -const subview -Mat::operator()(const span& row_span, const span& col_span) const - { - arma_debug_sigprint(); - - return (*this).submat(row_span, col_span); - } - - - -template -inline -subview -Mat::operator()(const uword in_row1, const uword in_col1, const SizeMat& s) - { - arma_debug_sigprint(); - - return (*this).submat(in_row1, in_col1, s); - } - - - -template -inline -const subview -Mat::operator()(const uword in_row1, const uword in_col1, const SizeMat& s) const - { - arma_debug_sigprint(); - - return (*this).submat(in_row1, in_col1, s); - } - - - -template -inline -subview -Mat::head_rows(const uword N) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > n_rows), "Mat::head_rows(): size out of bounds" ); - - return subview(*this, 0, 0, N, n_cols); - } - - - -template -inline -const subview -Mat::head_rows(const uword N) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > n_rows), "Mat::head_rows(): size out of bounds" ); - - return subview(*this, 0, 0, N, n_cols); - } - - - -template -inline -subview -Mat::tail_rows(const uword N) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > n_rows), "Mat::tail_rows(): size out of bounds" ); - - const uword start_row = n_rows - N; - - return subview(*this, start_row, 0, N, n_cols); - } - - - -template -inline -const subview -Mat::tail_rows(const uword N) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > n_rows), "Mat::tail_rows(): size out of bounds" ); - - const uword start_row = n_rows - N; - - return subview(*this, start_row, 0, N, n_cols); - } - - - -template -inline -subview_cols -Mat::head_cols(const uword N) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > n_cols), "Mat::head_cols(): size out of bounds" ); - - return subview_cols(*this, 0, N); - } - - - -template -inline -const subview_cols -Mat::head_cols(const uword N) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > n_cols), "Mat::head_cols(): size out of bounds" ); - - return subview_cols(*this, 0, N); - } - - - -template -inline -subview_cols -Mat::tail_cols(const uword N) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > n_cols), "Mat::tail_cols(): size out of bounds" ); - - const uword start_col = n_cols - N; - - return subview_cols(*this, start_col, N); - } - - - -template -inline -const subview_cols -Mat::tail_cols(const uword N) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > n_cols), "Mat::tail_cols(): size out of bounds" ); - - const uword start_col = n_cols - N; - - return subview_cols(*this, start_col, N); - } - - - -template -template -arma_inline -subview_elem1 -Mat::elem(const Base& a) - { - arma_debug_sigprint(); - - return subview_elem1(*this, a); - } - - - -template -template -arma_inline -const subview_elem1 -Mat::elem(const Base& a) const - { - arma_debug_sigprint(); - - return subview_elem1(*this, a); - } - - - -template -template -arma_inline -subview_elem1 -Mat::operator()(const Base& a) - { - arma_debug_sigprint(); - - return subview_elem1(*this, a); - } - - - -template -template -arma_inline -const subview_elem1 -Mat::operator()(const Base& a) const - { - arma_debug_sigprint(); - - return subview_elem1(*this, a); - } - - - -template -template -arma_inline -subview_elem2 -Mat::elem(const Base& ri, const Base& ci) - { - arma_debug_sigprint(); - - return subview_elem2(*this, ri, ci, false, false); - } - - - -template -template -arma_inline -const subview_elem2 -Mat::elem(const Base& ri, const Base& ci) const - { - arma_debug_sigprint(); - - return subview_elem2(*this, ri, ci, false, false); - } - - - -template -template -arma_inline -subview_elem2 -Mat::submat(const Base& ri, const Base& ci) - { - arma_debug_sigprint(); - - return subview_elem2(*this, ri, ci, false, false); - } - - - -template -template -arma_inline -const subview_elem2 -Mat::submat(const Base& ri, const Base& ci) const - { - arma_debug_sigprint(); - - return subview_elem2(*this, ri, ci, false, false); - } - - - -template -template -arma_inline -subview_elem2 -Mat::operator()(const Base& ri, const Base& ci) - { - arma_debug_sigprint(); - - return subview_elem2(*this, ri, ci, false, false); - } - - - -template -template -arma_inline -const subview_elem2 -Mat::operator()(const Base& ri, const Base& ci) const - { - arma_debug_sigprint(); - - return subview_elem2(*this, ri, ci, false, false); - } - - - -template -template -arma_inline -subview_elem2 -Mat::rows(const Base& ri) - { - arma_debug_sigprint(); - - return subview_elem2(*this, ri, ri, false, true); - } - - - -template -template -arma_inline -const subview_elem2 -Mat::rows(const Base& ri) const - { - arma_debug_sigprint(); - - return subview_elem2(*this, ri, ri, false, true); - } - - - -template -template -arma_inline -subview_elem2 -Mat::cols(const Base& ci) - { - arma_debug_sigprint(); - - return subview_elem2(*this, ci, ci, true, false); - } - - - -template -template -arma_inline -const subview_elem2 -Mat::cols(const Base& ci) const - { - arma_debug_sigprint(); - - return subview_elem2(*this, ci, ci, true, false); - } - - - -template -arma_inline -subview_each1< Mat, 0 > -Mat::each_col() - { - arma_debug_sigprint(); - - return subview_each1< Mat, 0>(*this); - } - - - -template -arma_inline -subview_each1< Mat, 1 > -Mat::each_row() - { - arma_debug_sigprint(); - - return subview_each1< Mat, 1>(*this); - } - - - -template -arma_inline -const subview_each1< Mat, 0 > -Mat::each_col() const - { - arma_debug_sigprint(); - - return subview_each1< Mat, 0>(*this); - } - - - -template -arma_inline -const subview_each1< Mat, 1 > -Mat::each_row() const - { - arma_debug_sigprint(); - - return subview_each1< Mat, 1>(*this); - } - - - -template -template -inline -subview_each2< Mat, 0, T1 > -Mat::each_col(const Base& indices) - { - arma_debug_sigprint(); - - return subview_each2< Mat, 0, T1 >(*this, indices); - } - - - -template -template -inline -subview_each2< Mat, 1, T1 > -Mat::each_row(const Base& indices) - { - arma_debug_sigprint(); - - return subview_each2< Mat, 1, T1 >(*this, indices); - } - - - -template -template -inline -const subview_each2< Mat, 0, T1 > -Mat::each_col(const Base& indices) const - { - arma_debug_sigprint(); - - return subview_each2< Mat, 0, T1 >(*this, indices); - } - - - -template -template -inline -const subview_each2< Mat, 1, T1 > -Mat::each_row(const Base& indices) const - { - arma_debug_sigprint(); - - return subview_each2< Mat, 1, T1 >(*this, indices); - } - - - -//! apply a lambda function to each column, where each column is interpreted as a column vector -template -inline -Mat& -Mat::each_col(const std::function< void(Col&) >& F) - { - arma_debug_sigprint(); - - for(uword ii=0; ii < n_cols; ++ii) - { - Col tmp(colptr(ii), n_rows, false, true); - F(tmp); - } - - return *this; - } - - - -template -inline -const Mat& -Mat::each_col(const std::function< void(const Col&) >& F) const - { - arma_debug_sigprint(); - - for(uword ii=0; ii < n_cols; ++ii) - { - const Col tmp(const_cast(colptr(ii)), n_rows, false, true); - F(tmp); - } - - return *this; - } - - - -//! apply a lambda function to each row, where each row is interpreted as a row vector -template -inline -Mat& -Mat::each_row(const std::function< void(Row&) >& F) - { - arma_debug_sigprint(); - - podarray array1(n_cols); - podarray array2(n_cols); - - Row tmp1( array1.memptr(), n_cols, false, true ); - Row tmp2( array2.memptr(), n_cols, false, true ); - - eT* tmp1_mem = tmp1.memptr(); - eT* tmp2_mem = tmp2.memptr(); - - uword ii, jj; - - for(ii=0, jj=1; jj < n_rows; ii+=2, jj+=2) - { - for(uword col_id = 0; col_id < n_cols; ++col_id) - { - const eT* col_mem = colptr(col_id); - - tmp1_mem[col_id] = col_mem[ii]; - tmp2_mem[col_id] = col_mem[jj]; - } - - F(tmp1); - F(tmp2); - - for(uword col_id = 0; col_id < n_cols; ++col_id) - { - eT* col_mem = colptr(col_id); - - col_mem[ii] = tmp1_mem[col_id]; - col_mem[jj] = tmp2_mem[col_id]; - } - } - - if(ii < n_rows) - { - tmp1 = (*this).row(ii); - - F(tmp1); - - (*this).row(ii) = tmp1; - } - - return *this; - } - - - -template -inline -const Mat& -Mat::each_row(const std::function< void(const Row&) >& F) const - { - arma_debug_sigprint(); - - podarray array1(n_cols); - podarray array2(n_cols); - - Row tmp1( array1.memptr(), n_cols, false, true ); - Row tmp2( array2.memptr(), n_cols, false, true ); - - eT* tmp1_mem = tmp1.memptr(); - eT* tmp2_mem = tmp2.memptr(); - - uword ii, jj; - - for(ii=0, jj=1; jj < n_rows; ii+=2, jj+=2) - { - for(uword col_id = 0; col_id < n_cols; ++col_id) - { - const eT* col_mem = colptr(col_id); - - tmp1_mem[col_id] = col_mem[ii]; - tmp2_mem[col_id] = col_mem[jj]; - } - - F(tmp1); - F(tmp2); - } - - if(ii < n_rows) - { - tmp1 = (*this).row(ii); - - F(tmp1); - } - - return *this; - } - - - -//! creation of diagview (diagonal) -template -arma_inline -diagview -Mat::diag(const sword in_id) - { - arma_debug_sigprint(); - - const uword row_offset = (in_id < 0) ? uword(-in_id) : 0; - const uword col_offset = (in_id > 0) ? uword( in_id) : 0; - - arma_conform_check_bounds - ( - ((row_offset > 0) && (row_offset >= n_rows)) || ((col_offset > 0) && (col_offset >= n_cols)), - "Mat::diag(): requested diagonal out of bounds" - ); - - const uword len = (std::min)(n_rows - row_offset, n_cols - col_offset); - - return diagview(*this, row_offset, col_offset, len); - } - - - -//! creation of diagview (diagonal) -template -arma_inline -const diagview -Mat::diag(const sword in_id) const - { - arma_debug_sigprint(); - - const uword row_offset = uword( (in_id < 0) ? -in_id : 0 ); - const uword col_offset = uword( (in_id > 0) ? in_id : 0 ); - - arma_conform_check_bounds - ( - ((row_offset > 0) && (row_offset >= n_rows)) || ((col_offset > 0) && (col_offset >= n_cols)), - "Mat::diag(): requested diagonal out of bounds" - ); - - const uword len = (std::min)(n_rows - row_offset, n_cols - col_offset); - - return diagview(*this, row_offset, col_offset, len); - } - - - -template -inline -void -Mat::swap_rows(const uword in_row1, const uword in_row2) - { - arma_debug_sigprint(); - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - - arma_conform_check_bounds - ( - (in_row1 >= local_n_rows) || (in_row2 >= local_n_rows), - "Mat::swap_rows(): index out of bounds" - ); - - if(n_elem > 0) - { - for(uword ucol=0; ucol < local_n_cols; ++ucol) - { - const uword offset = ucol * local_n_rows; - const uword pos1 = in_row1 + offset; - const uword pos2 = in_row2 + offset; - - std::swap( access::rw(mem[pos1]), access::rw(mem[pos2]) ); - } - } - } - - - -template -inline -void -Mat::swap_cols(const uword in_colA, const uword in_colB) - { - arma_debug_sigprint(); - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - - arma_conform_check_bounds - ( - (in_colA >= local_n_cols) || (in_colB >= local_n_cols), - "Mat::swap_cols(): index out of bounds" - ); - - if(n_elem > 0) - { - eT* ptrA = colptr(in_colA); - eT* ptrB = colptr(in_colB); - - eT tmp_i; - eT tmp_j; - - uword iq,jq; - for(iq=0, jq=1; jq < local_n_rows; iq+=2, jq+=2) - { - tmp_i = ptrA[iq]; - tmp_j = ptrA[jq]; - - ptrA[iq] = ptrB[iq]; - ptrA[jq] = ptrB[jq]; - - ptrB[iq] = tmp_i; - ptrB[jq] = tmp_j; - } - - if(iq < local_n_rows) - { - std::swap( ptrA[iq], ptrB[iq] ); - } - } - } - - - -//! remove specified row -template -inline -void -Mat::shed_row(const uword row_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( row_num >= n_rows, "Mat::shed_row(): index out of bounds" ); - - shed_rows(row_num, row_num); - } - - - -//! remove specified column -template -inline -void -Mat::shed_col(const uword col_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( col_num >= n_cols, "Mat::shed_col(): index out of bounds" ); - - shed_cols(col_num, col_num); - } - - - -//! remove specified rows -template -inline -void -Mat::shed_rows(const uword in_row1, const uword in_row2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_row2 >= n_rows), - "Mat::shed_rows(): indices out of bounds or incorrectly used" - ); - - const uword n_keep_front = in_row1; - const uword n_keep_back = n_rows - (in_row2 + 1); - - Mat X(n_keep_front + n_keep_back, n_cols, arma_nozeros_indicator()); - - if(n_keep_front > 0) - { - X.rows( 0, (n_keep_front-1) ) = rows( 0, (in_row1-1) ); - } - - if(n_keep_back > 0) - { - X.rows( n_keep_front, (n_keep_front+n_keep_back-1) ) = rows( (in_row2+1), (n_rows-1) ); - } - - steal_mem(X); - } - - - -//! remove specified columns -template -inline -void -Mat::shed_cols(const uword in_col1, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_col1 > in_col2) || (in_col2 >= n_cols), - "Mat::shed_cols(): indices out of bounds or incorrectly used" - ); - - const uword n_keep_front = in_col1; - const uword n_keep_back = n_cols - (in_col2 + 1); - - Mat X(n_rows, n_keep_front + n_keep_back, arma_nozeros_indicator()); - - if(n_keep_front > 0) - { - X.cols( 0, (n_keep_front-1) ) = cols( 0, (in_col1-1) ); - } - - if(n_keep_back > 0) - { - X.cols( n_keep_front, (n_keep_front+n_keep_back-1) ) = cols( (in_col2+1), (n_cols-1) ); - } - - steal_mem(X); - } - - - -//! remove specified rows -template -template -inline -void -Mat::shed_rows(const Base& indices) - { - arma_debug_sigprint(); - - const unwrap_check_mixed U(indices.get_ref(), *this); - const Mat& tmp1 = U.M; - - arma_conform_check( ((tmp1.is_vec() == false) && (tmp1.is_empty() == false)), "Mat::shed_rows(): list of indices must be a vector" ); - - if(tmp1.is_empty()) { return; } - - const Col tmp2(const_cast(tmp1.memptr()), tmp1.n_elem, false, false); - - const Col& rows_to_shed = (tmp2.is_sorted("strictascend") == false) - ? Col(unique(tmp2)) - : Col(const_cast(tmp2.memptr()), tmp2.n_elem, false, false); - - const uword* rows_to_shed_mem = rows_to_shed.memptr(); - const uword N = rows_to_shed.n_elem; - - if(arma_config::check_conform) - { - for(uword i=0; i= n_rows), "Mat::shed_rows(): indices out of bounds" ); - } - } - - Col tmp3(n_rows, arma_nozeros_indicator()); - - uword* tmp3_mem = tmp3.memptr(); - - uword i = 0; - uword count = 0; - - for(uword j=0; j < n_rows; ++j) - { - if(i < N) - { - if( j != rows_to_shed_mem[i] ) - { - tmp3_mem[count] = j; - ++count; - } - else - { - ++i; - } - } - else - { - tmp3_mem[count] = j; - ++count; - } - } - - const Col rows_to_keep(tmp3.memptr(), count, false, false); - - Mat X = (*this).rows(rows_to_keep); - - steal_mem(X); - } - - - -//! remove specified columns -template -template -inline -void -Mat::shed_cols(const Base& indices) - { - arma_debug_sigprint(); - - const unwrap_check_mixed U(indices.get_ref(), *this); - const Mat& tmp1 = U.M; - - arma_conform_check( ((tmp1.is_vec() == false) && (tmp1.is_empty() == false)), "Mat::shed_cols(): list of indices must be a vector" ); - - if(tmp1.is_empty()) { return; } - - const Col tmp2(const_cast(tmp1.memptr()), tmp1.n_elem, false, false); - - const Col& cols_to_shed = (tmp2.is_sorted("strictascend") == false) - ? Col(unique(tmp2)) - : Col(const_cast(tmp2.memptr()), tmp2.n_elem, false, false); - - const uword* cols_to_shed_mem = cols_to_shed.memptr(); - const uword N = cols_to_shed.n_elem; - - if(arma_config::check_conform) - { - for(uword i=0; i= n_cols), "Mat::shed_cols(): indices out of bounds" ); - } - } - - Col tmp3(n_cols, arma_nozeros_indicator()); - - uword* tmp3_mem = tmp3.memptr(); - - uword i = 0; - uword count = 0; - - for(uword j=0; j < n_cols; ++j) - { - if(i < N) - { - if( j != cols_to_shed_mem[i] ) - { - tmp3_mem[count] = j; - ++count; - } - else - { - ++i; - } - } - else - { - tmp3_mem[count] = j; - ++count; - } - } - - const Col cols_to_keep(tmp3.memptr(), count, false, false); - - Mat X = (*this).cols(cols_to_keep); - - steal_mem(X); - } - - - -template -inline -void -Mat::insert_rows(const uword row_num, const uword N, const bool set_to_zero) - { - arma_debug_sigprint(); - - arma_ignore(set_to_zero); - - (*this).insert_rows(row_num, N); - } - - - -template -inline -void -Mat::insert_rows(const uword row_num, const uword N) - { - arma_debug_sigprint(); - - const uword t_n_rows = n_rows; - const uword t_n_cols = n_cols; - - const uword A_n_rows = row_num; - const uword B_n_rows = t_n_rows - row_num; - - // insertion at row_num == n_rows is in effect an append operation - arma_conform_check_bounds( (row_num > t_n_rows), "Mat::insert_rows(): index out of bounds" ); - - if(N == 0) { return; } - - Mat out(t_n_rows + N, t_n_cols, arma_nozeros_indicator()); - - if(A_n_rows > 0) - { - out.rows(0, A_n_rows-1) = rows(0, A_n_rows-1); - } - - if(B_n_rows > 0) - { - out.rows(row_num + N, t_n_rows + N - 1) = rows(row_num, t_n_rows-1); - } - - out.rows(row_num, row_num + N - 1).zeros(); - - steal_mem(out); - } - - - -template -inline -void -Mat::insert_cols(const uword col_num, const uword N, const bool set_to_zero) - { - arma_debug_sigprint(); - - arma_ignore(set_to_zero); - - (*this).insert_cols(col_num, N); - } - - - -template -inline -void -Mat::insert_cols(const uword col_num, const uword N) - { - arma_debug_sigprint(); - - const uword t_n_rows = n_rows; - const uword t_n_cols = n_cols; - - const uword A_n_cols = col_num; - const uword B_n_cols = t_n_cols - col_num; - - // insertion at col_num == n_cols is in effect an append operation - arma_conform_check_bounds( (col_num > t_n_cols), "Mat::insert_cols(): index out of bounds" ); - - if(N == 0) { return; } - - Mat out(t_n_rows, t_n_cols + N, arma_nozeros_indicator()); - - if(A_n_cols > 0) - { - out.cols(0, A_n_cols-1) = cols(0, A_n_cols-1); - } - - if(B_n_cols > 0) - { - out.cols(col_num + N, t_n_cols + N - 1) = cols(col_num, t_n_cols-1); - } - - out.cols(col_num, col_num + N - 1).zeros(); - - steal_mem(out); - } - - - -//! insert the given object at the specified row position; -//! the given object must have the same number of columns as the matrix -template -template -inline -void -Mat::insert_rows(const uword row_num, const Base& X) - { - arma_debug_sigprint(); - - const unwrap tmp(X.get_ref()); - const Mat& C = tmp.M; - - const uword C_n_rows = C.n_rows; - const uword C_n_cols = C.n_cols; - - const uword t_n_rows = n_rows; - const uword t_n_cols = n_cols; - - const uword A_n_rows = row_num; - const uword B_n_rows = t_n_rows - row_num; - - bool err_state = false; - char* err_msg = nullptr; - - const char* error_message_1 = "Mat::insert_rows(): index out of bounds"; - const char* error_message_2 = "Mat::insert_rows(): given object has an incompatible number of columns"; - - // insertion at row_num == n_rows is in effect an append operation - - arma_conform_set_error - ( - err_state, - err_msg, - (row_num > t_n_rows), - error_message_1 - ); - - arma_conform_set_error - ( - err_state, - err_msg, - ( (C_n_cols != t_n_cols) && ( (t_n_rows > 0) || (t_n_cols > 0) ) && ( (C_n_rows > 0) || (C_n_cols > 0) ) ), - error_message_2 - ); - - arma_conform_check_bounds(err_state, err_msg); - - if(C_n_rows > 0) - { - Mat out( t_n_rows + C_n_rows, (std::max)(t_n_cols, C_n_cols), arma_nozeros_indicator() ); - - if(t_n_cols > 0) - { - if(A_n_rows > 0) - { - out.rows(0, A_n_rows-1) = rows(0, A_n_rows-1); - } - - if( (t_n_cols > 0) && (B_n_rows > 0) ) - { - out.rows(row_num + C_n_rows, t_n_rows + C_n_rows - 1) = rows(row_num, t_n_rows - 1); - } - } - - if(C_n_cols > 0) - { - out.rows(row_num, row_num + C_n_rows - 1) = C; - } - - steal_mem(out); - } - } - - - -//! insert the given object at the specified column position; -//! the given object must have the same number of rows as the matrix -template -template -inline -void -Mat::insert_cols(const uword col_num, const Base& X) - { - arma_debug_sigprint(); - - const unwrap tmp(X.get_ref()); - const Mat& C = tmp.M; - - const uword C_n_rows = C.n_rows; - const uword C_n_cols = C.n_cols; - - const uword t_n_rows = n_rows; - const uword t_n_cols = n_cols; - - const uword A_n_cols = col_num; - const uword B_n_cols = t_n_cols - col_num; - - bool err_state = false; - char* err_msg = nullptr; - - const char* error_message_1 = "Mat::insert_cols(): index out of bounds"; - const char* error_message_2 = "Mat::insert_cols(): given object has an incompatible number of rows"; - - // insertion at col_num == n_cols is in effect an append operation - - arma_conform_set_error - ( - err_state, - err_msg, - (col_num > t_n_cols), - error_message_1 - ); - - arma_conform_set_error - ( - err_state, - err_msg, - ( (C_n_rows != t_n_rows) && ( (t_n_rows > 0) || (t_n_cols > 0) ) && ( (C_n_rows > 0) || (C_n_cols > 0) ) ), - error_message_2 - ); - - arma_conform_check_bounds(err_state, err_msg); - - if(C_n_cols > 0) - { - Mat out( (std::max)(t_n_rows, C_n_rows), t_n_cols + C_n_cols, arma_nozeros_indicator() ); - - if(t_n_rows > 0) - { - if(A_n_cols > 0) - { - out.cols(0, A_n_cols-1) = cols(0, A_n_cols-1); - } - - if(B_n_cols > 0) - { - out.cols(col_num + C_n_cols, t_n_cols + C_n_cols - 1) = cols(col_num, t_n_cols - 1); - } - } - - if(C_n_rows > 0) - { - out.cols(col_num, col_num + C_n_cols - 1) = C; - } - - steal_mem(out); - } - } - - - -template -template -inline -Mat::Mat(const Gen& X) - : n_rows(X.n_rows) - , n_cols(X.n_cols) - , n_elem(n_rows*n_cols) - , n_alloc() - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - init_cold(); - - X.apply(*this); - } - - - -template -template -inline -Mat& -Mat::operator=(const Gen& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - init_warm(X.n_rows, X.n_cols); - - X.apply(*this); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator+=(const Gen& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - X.apply_inplace_plus(*this); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator-=(const Gen& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - X.apply_inplace_minus(*this); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator*=(const Gen& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const Mat tmp(X); - - return (*this).operator*=(tmp); - } - - - -template -template -inline -Mat& -Mat::operator%=(const Gen& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - X.apply_inplace_schur(*this); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator/=(const Gen& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - X.apply_inplace_div(*this); - - return *this; - } - - - -//! create a matrix from Op, ie. run the previously delayed unary operations -template -template -inline -Mat::Mat(const Op& X) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - op_type::apply(*this, X); - } - - - -//! create a matrix from Op, ie. run the previously delayed unary operations -template -template -inline -Mat& -Mat::operator=(const Op& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - op_type::apply(*this, X); - - return *this; - } - - - -//! in-place matrix addition, with the right-hand-side operand having delayed operations -template -template -inline -Mat& -Mat::operator+=(const Op& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const Mat m(X); - - return (*this).operator+=(m); - } - - - -//! in-place matrix subtraction, with the right-hand-side operand having delayed operations -template -template -inline -Mat& -Mat::operator-=(const Op& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const Mat m(X); - - return (*this).operator-=(m); - } - - - -//! in-place matrix multiplication, with the right-hand-side operand having delayed operations -template -template -inline -Mat& -Mat::operator*=(const Op& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - glue_times::apply_inplace(*this, X); - - return *this; - } - - - -//! in-place matrix element-wise multiplication, with the right-hand-side operand having delayed operations -template -template -inline -Mat& -Mat::operator%=(const Op& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const Mat m(X); - - return (*this).operator%=(m); - } - - - -//! in-place matrix element-wise division, with the right-hand-side operand having delayed operations -template -template -inline -Mat& -Mat::operator/=(const Op& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const Mat m(X); - - return (*this).operator/=(m); - } - - - -//! create a matrix from eOp, ie. run the previously delayed unary operations -template -template -inline -Mat::Mat(const eOp& X) - : n_rows(X.get_n_rows()) - , n_cols(X.get_n_cols()) - , n_elem(X.get_n_elem()) - , n_alloc() - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - init_cold(); - - eop_type::apply(*this, X); - } - - - -//! create a matrix from eOp, ie. run the previously delayed unary operations -template -template -inline -Mat& -Mat::operator=(const eOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const bool bad_alias = (eOp::proxy_type::has_subview && X.P.is_alias(*this)); - - if(bad_alias) { Mat tmp(X); steal_mem(tmp); return *this; } - - init_warm(X.get_n_rows(), X.get_n_cols()); - - eop_type::apply(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator+=(const eOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const bool bad_alias = (eOp::proxy_type::has_subview && X.P.is_alias(*this)); - - if(bad_alias) { const Mat tmp(X); return (*this).operator+=(tmp); } - - eop_type::apply_inplace_plus(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator-=(const eOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const bool bad_alias = (eOp::proxy_type::has_subview && X.P.is_alias(*this)); - - if(bad_alias) { const Mat tmp(X); return (*this).operator-=(tmp); } - - eop_type::apply_inplace_minus(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator*=(const eOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - glue_times::apply_inplace(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator%=(const eOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const bool bad_alias = (eOp::proxy_type::has_subview && X.P.is_alias(*this)); - - if(bad_alias) { const Mat tmp(X); return (*this).operator%=(tmp); } - - eop_type::apply_inplace_schur(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator/=(const eOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const bool bad_alias = (eOp::proxy_type::has_subview && X.P.is_alias(*this)); - - if(bad_alias) { const Mat tmp(X); return (*this).operator/=(tmp); } - - eop_type::apply_inplace_div(*this, X); - - return *this; - } - - - -template -template -inline -Mat::Mat(const mtOp& X) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - op_type::apply(*this, X); - } - - - -template -template -inline -Mat& -Mat::operator=(const mtOp& X) - { - arma_debug_sigprint(); - - op_type::apply(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator+=(const mtOp& X) - { - arma_debug_sigprint(); - - const Mat m(X); - - return (*this).operator+=(m); - } - - - -template -template -inline -Mat& -Mat::operator-=(const mtOp& X) - { - arma_debug_sigprint(); - - const Mat m(X); - - return (*this).operator-=(m); - } - - - -template -template -inline -Mat& -Mat::operator*=(const mtOp& X) - { - arma_debug_sigprint(); - - const Mat m(X); - - return (*this).operator*=(m); - } - - - -template -template -inline -Mat& -Mat::operator%=(const mtOp& X) - { - arma_debug_sigprint(); - - const Mat m(X); - - return (*this).operator%=(m); - } - - - -template -template -inline -Mat& -Mat::operator/=(const mtOp& X) - { - arma_debug_sigprint(); - - const Mat m(X); - - return (*this).operator/=(m); - } - - - -template -template -inline -Mat::Mat(const CubeToMatOp& X) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - op_type::apply(*this, X); - } - - - -template -template -inline -Mat& -Mat::operator=(const CubeToMatOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - op_type::apply(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator+=(const CubeToMatOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - (*this) = (*this) + X; - - return (*this); - } - - - -template -template -inline -Mat& -Mat::operator-=(const CubeToMatOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - (*this) = (*this) - X; - - return (*this); - } - - - -template -template -inline -Mat& -Mat::operator*=(const CubeToMatOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - glue_times::apply_inplace(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator%=(const CubeToMatOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - (*this) = (*this) % X; - - return (*this); - } - - - -template -template -inline -Mat& -Mat::operator/=(const CubeToMatOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - (*this) = (*this) / X; - - return (*this); - } - - - -template -template -inline -Mat::Mat(const SpToDOp& X) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - op_type::apply(*this, X); - } - - - -//! create a matrix from an SpToDOp, ie. run the previously delayed unary operations -template -template -inline -Mat& -Mat::operator=(const SpToDOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - op_type::apply(*this, X); - - return *this; - } - - - -//! in-place matrix addition, with the right-hand-side operand having delayed operations -template -template -inline -Mat& -Mat::operator+=(const SpToDOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const Mat m(X); - - return (*this).operator+=(m); - } - - - -//! in-place matrix subtraction, with the right-hand-side operand having delayed operations -template -template -inline -Mat& -Mat::operator-=(const SpToDOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const Mat m(X); - - return (*this).operator-=(m); - } - - - -//! in-place matrix multiplication, with the right-hand-side operand having delayed operations -template -template -inline -Mat& -Mat::operator*=(const SpToDOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - glue_times::apply_inplace(*this, X); - - return *this; - } - - - -//! in-place matrix element-wise multiplication, with the right-hand-side operand having delayed operations -template -template -inline -Mat& -Mat::operator%=(const SpToDOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const Mat m(X); - - return (*this).operator%=(m); - } - - - -//! in-place matrix element-wise division, with the right-hand-side operand having delayed operations -template -template -inline -Mat& -Mat::operator/=(const SpToDOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const Mat m(X); - - return (*this).operator/=(m); - } - - - -template -template -inline -Mat::Mat(const mtSpReduceOp& X) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - op_type::apply(*this, X); - } - - - -template -template -inline -Mat& -Mat::operator=(const mtSpReduceOp& X) - { - arma_debug_sigprint(); - - op_type::apply(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator+=(const mtSpReduceOp& X) - { - arma_debug_sigprint(); - - const Mat m(X); - - return (*this).operator+=(m); - } - - - -template -template -inline -Mat& -Mat::operator-=(const mtSpReduceOp& X) - { - arma_debug_sigprint(); - - const Mat m(X); - - return (*this).operator-=(m); - } - - - -template -template -inline -Mat& -Mat::operator*=(const mtSpReduceOp& X) - { - arma_debug_sigprint(); - - glue_times::apply_inplace(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator%=(const mtSpReduceOp& X) - { - arma_debug_sigprint(); - - const Mat m(X); - - return (*this).operator%=(m); - } - - - -template -template -inline -Mat& -Mat::operator/=(const mtSpReduceOp& X) - { - arma_debug_sigprint(); - - const Mat m(X); - - return (*this).operator/=(m); - } - - - -//! create a matrix from Glue, ie. run the previously delayed binary operations -template -template -inline -Mat::Mat(const Glue& X) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - glue_type::apply(*this, X); - } - - - -//! create a matrix from Glue, ie. run the previously delayed binary operations -template -template -inline -Mat& -Mat::operator=(const Glue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - glue_type::apply(*this, X); - - return *this; - } - - - -//! in-place matrix addition, with the right-hand-side operands having delayed operations -template -template -inline -Mat& -Mat::operator+=(const Glue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const Mat m(X); - - return (*this).operator+=(m); - } - - - -//! in-place matrix subtraction, with the right-hand-side operands having delayed operations -template -template -inline -Mat& -Mat::operator-=(const Glue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const Mat m(X); - - return (*this).operator-=(m); - } - - - -//! in-place matrix multiplications, with the right-hand-side operands having delayed operations -template -template -inline -Mat& -Mat::operator*=(const Glue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - glue_times::apply_inplace(*this, X); - - return *this; - } - - - -//! in-place matrix element-wise multiplication, with the right-hand-side operands having delayed operations -template -template -inline -Mat& -Mat::operator%=(const Glue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const Mat m(X); - - return (*this).operator%=(m); - } - - - -//! in-place matrix element-wise division, with the right-hand-side operands having delayed operations -template -template -inline -Mat& -Mat::operator/=(const Glue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const Mat m(X); - - return (*this).operator/=(m); - } - - - -template -template -inline -Mat& -Mat::operator+=(const Glue& X) - { - arma_debug_sigprint(); - - glue_times::apply_inplace_plus(*this, X, sword(+1)); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator-=(const Glue& X) - { - arma_debug_sigprint(); - - glue_times::apply_inplace_plus(*this, X, sword(-1)); - - return *this; - } - - - -//! create a matrix from eGlue, ie. run the previously delayed binary operations -template -template -inline -Mat::Mat(const eGlue& X) - : n_rows(X.get_n_rows()) - , n_cols(X.get_n_cols()) - , n_elem(X.get_n_elem()) - , n_alloc() - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - init_cold(); - - eglue_type::apply(*this, X); - } - - - -//! create a matrix from eGlue, ie. run the previously delayed binary operations -template -template -inline -Mat& -Mat::operator=(const eGlue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const bool bad_alias = - ( - (eGlue::proxy1_type::has_subview && X.P1.is_alias(*this)) - || - (eGlue::proxy2_type::has_subview && X.P2.is_alias(*this)) - ); - - if(bad_alias) { Mat tmp(X); steal_mem(tmp); return *this; } - - init_warm(X.get_n_rows(), X.get_n_cols()); - - eglue_type::apply(*this, X); - - return *this; - } - - - -//! in-place matrix addition, with the right-hand-side operands having delayed operations -template -template -inline -Mat& -Mat::operator+=(const eGlue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const bool bad_alias = - ( - (eGlue::proxy1_type::has_subview && X.P1.is_alias(*this)) - || - (eGlue::proxy2_type::has_subview && X.P2.is_alias(*this)) - ); - - if(bad_alias) { const Mat tmp(X); return (*this).operator+=(tmp); } - - eglue_type::apply_inplace_plus(*this, X); - - return *this; - } - - - -//! in-place matrix subtraction, with the right-hand-side operands having delayed operations -template -template -inline -Mat& -Mat::operator-=(const eGlue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const bool bad_alias = - ( - (eGlue::proxy1_type::has_subview && X.P1.is_alias(*this)) - || - (eGlue::proxy2_type::has_subview && X.P2.is_alias(*this)) - ); - - if(bad_alias) { const Mat tmp(X); return (*this).operator-=(tmp); } - - eglue_type::apply_inplace_minus(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator*=(const eGlue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - glue_times::apply_inplace(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator%=(const eGlue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const bool bad_alias = - ( - (eGlue::proxy1_type::has_subview && X.P1.is_alias(*this)) - || - (eGlue::proxy2_type::has_subview && X.P2.is_alias(*this)) - ); - - if(bad_alias) { const Mat tmp(X); return (*this).operator%=(tmp); } - - eglue_type::apply_inplace_schur(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator/=(const eGlue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const bool bad_alias = - ( - (eGlue::proxy1_type::has_subview && X.P1.is_alias(*this)) - || - (eGlue::proxy2_type::has_subview && X.P2.is_alias(*this)) - ); - - if(bad_alias) { const Mat tmp(X); return (*this).operator/=(tmp); } - - eglue_type::apply_inplace_div(*this, X); - - return *this; - } - - - -template -template -inline -Mat::Mat(const mtGlue& X) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - glue_type::apply(*this, X); - } - - - -template -template -inline -Mat& -Mat::operator=(const mtGlue& X) - { - arma_debug_sigprint(); - - glue_type::apply(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator+=(const mtGlue& X) - { - arma_debug_sigprint(); - - const Mat m(X); - - return (*this).operator+=(m); - } - - - -template -template -inline -Mat& -Mat::operator-=(const mtGlue& X) - { - arma_debug_sigprint(); - - const Mat m(X); - - return (*this).operator-=(m); - } - - - -template -template -inline -Mat& -Mat::operator*=(const mtGlue& X) - { - arma_debug_sigprint(); - - const Mat m(X); - - glue_times::apply_inplace(*this, m); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator%=(const mtGlue& X) - { - arma_debug_sigprint(); - - const Mat m(X); - - return (*this).operator%=(m); - } - - - -template -template -inline -Mat& -Mat::operator/=(const mtGlue& X) - { - arma_debug_sigprint(); - - const Mat m(X); - - return (*this).operator/=(m); - } - - - -template -template -inline -Mat::Mat(const SpToDGlue& X) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_alloc(0) - , vec_state(0) - , mem_state(0) - , mem() - { - arma_debug_sigprint_this(this); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - glue_type::apply(*this, X); - } - - - -template -template -inline -Mat& -Mat::operator=(const SpToDGlue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - glue_type::apply(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator+=(const SpToDGlue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const Mat m(X); - - return (*this).operator+=(m); - } - - - -template -template -inline -Mat& -Mat::operator-=(const SpToDGlue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const Mat m(X); - - return (*this).operator-=(m); - } - - - -template -template -inline -Mat& -Mat::operator*=(const SpToDGlue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - glue_times::apply_inplace(*this, X); - - return *this; - } - - - -template -template -inline -Mat& -Mat::operator%=(const SpToDGlue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const Mat m(X); - - return (*this).operator%=(m); - } - - - -template -template -inline -Mat& -Mat::operator/=(const SpToDGlue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const Mat m(X); - - return (*this).operator/=(m); - } - - - -//! linear element accessor (treats the matrix as a vector); no bounds check; assumes memory is aligned -template -arma_inline -const eT& -Mat::at_alt(const uword ii) const - { - const eT* mem_aligned = mem; - - memory::mark_as_aligned(mem_aligned); - - return mem_aligned[ii]; - } - - - -//! linear element accessor (treats the matrix as a vector); bounds checking not done when ARMA_NO_DEBUG is defined -template -arma_inline -eT& -Mat::operator() (const uword ii) - { - arma_conform_check_bounds( (ii >= n_elem), "Mat::operator(): index out of bounds" ); - - return access::rw(mem[ii]); - } - - - -//! linear element accessor (treats the matrix as a vector); bounds checking not done when ARMA_NO_DEBUG is defined -template -arma_inline -const eT& -Mat::operator() (const uword ii) const - { - arma_conform_check_bounds( (ii >= n_elem), "Mat::operator(): index out of bounds" ); - - return mem[ii]; - } - - -//! linear element accessor (treats the matrix as a vector); no bounds check. -template -arma_inline -eT& -Mat::operator[] (const uword ii) - { - return access::rw(mem[ii]); - } - - - -//! linear element accessor (treats the matrix as a vector); no bounds check -template -arma_inline -const eT& -Mat::operator[] (const uword ii) const - { - return mem[ii]; - } - - - -//! linear element accessor (treats the matrix as a vector); no bounds check. -template -arma_inline -eT& -Mat::at(const uword ii) - { - return access::rw(mem[ii]); - } - - - -//! linear element accessor (treats the matrix as a vector); no bounds check -template -arma_inline -const eT& -Mat::at(const uword ii) const - { - return mem[ii]; - } - - - -//! element accessor; bounds checking not done when ARMA_NO_DEBUG is defined -template -arma_inline -eT& -Mat::operator() (const uword in_row, const uword in_col) - { - arma_conform_check_bounds( ((in_row >= n_rows) || (in_col >= n_cols)), "Mat::operator(): index out of bounds" ); - - return access::rw(mem[in_row + in_col*n_rows]); - } - - - -//! element accessor; bounds checking not done when ARMA_NO_DEBUG is defined -template -arma_inline -const eT& -Mat::operator() (const uword in_row, const uword in_col) const - { - arma_conform_check_bounds( ((in_row >= n_rows) || (in_col >= n_cols)), "Mat::operator(): index out of bounds" ); - - return mem[in_row + in_col*n_rows]; - } - - - -//! element accessor; no bounds check -template -arma_inline -eT& -Mat::at(const uword in_row, const uword in_col) - { - return access::rw( mem[in_row + in_col*n_rows] ); - } - - - -//! element accessor; no bounds check -template -arma_inline -const eT& -Mat::at(const uword in_row, const uword in_col) const - { - return mem[in_row + in_col*n_rows]; - } - - - -#if defined(__cpp_multidimensional_subscript) - - //! element accessor; no bounds check - template - arma_inline - eT& - Mat::operator[] (const uword in_row, const uword in_col) - { - return access::rw( mem[in_row + in_col*n_rows] ); - } - - - - //! element accessor; no bounds check - template - arma_inline - const eT& - Mat::operator[] (const uword in_row, const uword in_col) const - { - return mem[in_row + in_col*n_rows]; - } - -#endif - - - -//! prefix ++ -template -arma_inline -const Mat& -Mat::operator++() - { - Mat_aux::prefix_pp(*this); - - return *this; - } - - - -//! postfix ++ (must not return the object by reference) -template -arma_inline -void -Mat::operator++(int) - { - Mat_aux::postfix_pp(*this); - } - - - -//! prefix -- -template -arma_inline -const Mat& -Mat::operator--() - { - Mat_aux::prefix_mm(*this); - - return *this; - } - - - -//! postfix -- (must not return the object by reference) -template -arma_inline -void -Mat::operator--(int) - { - Mat_aux::postfix_mm(*this); - } - - - -//! returns true if the matrix has no elements -template -arma_inline -bool -Mat::is_empty() const - { - return (n_elem == 0); - } - - - -//! returns true if the object can be interpreted as a column or row vector -template -arma_inline -bool -Mat::is_vec() const - { - return ( (n_rows == 1) || (n_cols == 1) ); - } - - - -//! returns true if the object can be interpreted as a row vector -template -arma_inline -bool -Mat::is_rowvec() const - { - return (n_rows == 1); - } - - - -//! returns true if the object can be interpreted as a column vector -template -arma_inline -bool -Mat::is_colvec() const - { - return (n_cols == 1); - } - - - -//! returns true if the object has the same number of non-zero rows and columnns -template -arma_inline -bool -Mat::is_square() const - { - return (n_rows == n_cols); - } - - - -template -inline -bool -Mat::internal_is_finite() const - { - arma_debug_sigprint(); - - return arrayops::is_finite(memptr(), n_elem); - } - - - -template -inline -bool -Mat::internal_has_inf() const - { - arma_debug_sigprint(); - - return arrayops::has_inf(memptr(), n_elem); - } - - - -template -inline -bool -Mat::internal_has_nan() const - { - arma_debug_sigprint(); - - return arrayops::has_nan(memptr(), n_elem); - } - - - -template -inline -bool -Mat::internal_has_nonfinite() const - { - arma_debug_sigprint(); - - return (arrayops::is_finite(memptr(), n_elem) == false); - } - - - -template -inline -bool -Mat::is_sorted(const char* direction) const - { - arma_debug_sigprint(); - - return (*this).is_sorted(direction, (((vec_state == 2) || (n_rows == 1)) ? uword(1) : uword(0))); - } - - - -template -inline -bool -Mat::is_sorted(const char* direction, const uword dim) const - { - arma_debug_sigprint(); - - const char sig1 = (direction != nullptr) ? direction[0] : char(0); - - // direction is one of: - // "ascend" - // "descend" - // "strictascend" - // "strictdescend" - - arma_conform_check( ((sig1 != 'a') && (sig1 != 'd') && (sig1 != 's')), "Mat::is_sorted(): unknown sort direction" ); - - // "strictascend" - // "strictdescend" - // 0123456 - - const char sig2 = (sig1 == 's') ? direction[6] : char(0); - - if(sig1 == 's') { arma_conform_check( ((sig2 != 'a') && (sig2 != 'd')), "Mat::is_sorted(): unknown sort direction" ); } - - arma_conform_check( (dim > 1), "Mat::is_sorted(): parameter 'dim' must be 0 or 1" ); - - if(sig1 == 'a') - { - // case: ascend - - // deliberately using the opposite direction comparator, - // as we need to handle the case of two elements being equal - - arma_gt_comparator comparator; - - return (*this).is_sorted_helper(comparator, dim); - } - else - if(sig1 == 'd') - { - // case: descend - - // deliberately using the opposite direction comparator, - // as we need to handle the case of two elements being equal - - arma_lt_comparator comparator; - - return (*this).is_sorted_helper(comparator, dim); - } - else - if((sig1 == 's') && (sig2 == 'a')) - { - // case: strict ascend - - arma_geq_comparator comparator; - - return (*this).is_sorted_helper(comparator, dim); - } - else - if((sig1 == 's') && (sig2 == 'd')) - { - // case: strict descend - - arma_leq_comparator comparator; - - return (*this).is_sorted_helper(comparator, dim); - } - - return true; - } - - - -template -template -inline -bool -Mat::is_sorted_helper(const comparator& comp, const uword dim) const - { - arma_debug_sigprint(); - - if(n_elem <= 1) { return true; } - - const uword local_n_cols = n_cols; - const uword local_n_rows = n_rows; - - if(dim == 0) - { - if(local_n_rows <= 1u) { return true; } - - const uword local_n_rows_m1 = local_n_rows - 1; - - for(uword c=0; c < local_n_cols; ++c) - { - const eT* coldata = colptr(c); - - for(uword r=0; r < local_n_rows_m1; ++r) - { - const eT val1 = (*coldata); coldata++; - const eT val2 = (*coldata); - - if(comp(val1,val2)) { return false; } - } - } - } - else - if(dim == 1) - { - if(local_n_cols <= 1u) { return true; } - - const uword local_n_cols_m1 = local_n_cols - 1; - - if(local_n_rows == 1) - { - const eT* rowdata = memptr(); - - for(uword c=0; c < local_n_cols_m1; ++c) - { - const eT val1 = (*rowdata); rowdata++; - const eT val2 = (*rowdata); - - if(comp(val1,val2)) { return false; } - } - } - else - { - for(uword r=0; r < local_n_rows; ++r) - for(uword c=0; c < local_n_cols_m1; ++c) - { - const eT val1 = at(r,c ); - const eT val2 = at(r,c+1); - - if(comp(val1,val2)) { return false; } - } - } - } - - return true; - } - - - -//! returns true if the given index is currently in range -template -arma_inline -bool -Mat::in_range(const uword ii) const - { - return (ii < n_elem); - } - - - -//! returns true if the given start and end indices are currently in range -template -arma_inline -bool -Mat::in_range(const span& x) const - { - arma_debug_sigprint(); - - if(x.whole) - { - return true; - } - else - { - const uword a = x.a; - const uword b = x.b; - - return ( (a <= b) && (b < n_elem) ); - } - } - - - -//! returns true if the given location is currently in range -template -arma_inline -bool -Mat::in_range(const uword in_row, const uword in_col) const - { - return ( (in_row < n_rows) && (in_col < n_cols) ); - } - - - -template -arma_inline -bool -Mat::in_range(const span& row_span, const uword in_col) const - { - arma_debug_sigprint(); - - if(row_span.whole) - { - return (in_col < n_cols); - } - else - { - const uword in_row1 = row_span.a; - const uword in_row2 = row_span.b; - - return ( (in_row1 <= in_row2) && (in_row2 < n_rows) && (in_col < n_cols) ); - } - } - - - -template -arma_inline -bool -Mat::in_range(const uword in_row, const span& col_span) const - { - arma_debug_sigprint(); - - if(col_span.whole) - { - return (in_row < n_rows); - } - else - { - const uword in_col1 = col_span.a; - const uword in_col2 = col_span.b; - - return ( (in_row < n_rows) && (in_col1 <= in_col2) && (in_col2 < n_cols) ); - } - } - - - -template -arma_inline -bool -Mat::in_range(const span& row_span, const span& col_span) const - { - arma_debug_sigprint(); - - const uword in_row1 = row_span.a; - const uword in_row2 = row_span.b; - - const uword in_col1 = col_span.a; - const uword in_col2 = col_span.b; - - const bool rows_ok = row_span.whole ? true : ( (in_row1 <= in_row2) && (in_row2 < n_rows) ); - const bool cols_ok = col_span.whole ? true : ( (in_col1 <= in_col2) && (in_col2 < n_cols) ); - - return ( rows_ok && cols_ok ); - } - - - -template -arma_inline -bool -Mat::in_range(const uword in_row, const uword in_col, const SizeMat& s) const - { - const uword l_n_rows = n_rows; - const uword l_n_cols = n_cols; - - if( (in_row >= l_n_rows) || (in_col >= l_n_cols) || ((in_row + s.n_rows) > l_n_rows) || ((in_col + s.n_cols) > l_n_cols) ) - { - return false; - } - else - { - return true; - } - } - - - -//! returns a pointer to array of eTs for a specified column; no bounds check -template -arma_inline -eT* -Mat::colptr(const uword in_col) - { - return & access::rw(mem[in_col*n_rows]); - } - - - -//! returns a pointer to array of eTs for a specified column; no bounds check -template -arma_inline -const eT* -Mat::colptr(const uword in_col) const - { - return & mem[in_col*n_rows]; - } - - - -//! returns a pointer to array of eTs used by the matrix -template -arma_inline -eT* -Mat::memptr() - { - return const_cast(mem); - } - - - -//! returns a pointer to array of eTs used by the matrix -template -arma_inline -const eT* -Mat::memptr() const - { - return mem; - } - - - -//! change the matrix to have user specified dimensions (data is not preserved) -template -inline -Mat& -Mat::set_size(const uword new_n_elem) - { - arma_debug_sigprint(); - - const uword new_n_rows = (vec_state == 2) ? uword(1 ) : uword(new_n_elem); - const uword new_n_cols = (vec_state == 2) ? uword(new_n_elem) : uword(1 ); - - init_warm(new_n_rows, new_n_cols); - - return *this; - } - - - -//! change the matrix to have user specified dimensions (data is not preserved) -template -inline -Mat& -Mat::set_size(const uword new_n_rows, const uword new_n_cols) - { - arma_debug_sigprint(); - - init_warm(new_n_rows, new_n_cols); - - return *this; - } - - - -template -inline -Mat& -Mat::set_size(const SizeMat& s) - { - arma_debug_sigprint(); - - init_warm(s.n_rows, s.n_cols); - - return *this; - } - - - -//! change the matrix to have user specified dimensions (data is preserved) -template -inline -Mat& -Mat::resize(const uword new_n_elem) - { - arma_debug_sigprint(); - - const uword new_n_rows = (vec_state == 2) ? uword(1 ) : uword(new_n_elem); - const uword new_n_cols = (vec_state == 2) ? uword(new_n_elem) : uword(1 ); - - return (*this).resize(new_n_rows, new_n_cols); - } - - - -//! change the matrix to have user specified dimensions (data is preserved) -template -inline -Mat& -Mat::resize(const uword new_n_rows, const uword new_n_cols) - { - arma_debug_sigprint(); - - op_resize::apply_mat_inplace((*this), new_n_rows, new_n_cols); - - return *this; - } - - - -template -inline -Mat& -Mat::resize(const SizeMat& s) - { - arma_debug_sigprint(); - - op_resize::apply_mat_inplace((*this), s.n_rows, s.n_cols); - - return *this; - } - - - -//! change the matrix to have user specified dimensions (data is preserved) -template -inline -Mat& -Mat::reshape(const uword new_n_rows, const uword new_n_cols) - { - arma_debug_sigprint(); - - op_reshape::apply_mat_inplace((*this), new_n_rows, new_n_cols); - - return *this; - } - - - -template -inline -Mat& -Mat::reshape(const SizeMat& s) - { - arma_debug_sigprint(); - - op_reshape::apply_mat_inplace((*this), s.n_rows, s.n_cols); - - return *this; - } - - - -//! NOTE: don't use this form; it's deprecated and will be removed -template -inline -void -Mat::reshape(const uword new_n_rows, const uword new_n_cols, const uword dim) - { - arma_debug_sigprint(); - - arma_conform_check( (dim > 1), "reshape(): parameter 'dim' must be 0 or 1" ); - - if(dim == 0) - { - op_reshape::apply_mat_inplace((*this), new_n_rows, new_n_cols); - } - else - if(dim == 1) - { - Mat tmp; - - op_strans::apply_mat_noalias(tmp, (*this)); - - op_reshape::apply_mat_noalias((*this), tmp, new_n_rows, new_n_cols); - } - } - - - -//! change the matrix (without preserving data) to have the same dimensions as the given expression -template -template -inline -Mat& -Mat::copy_size(const Base& X) - { - arma_debug_sigprint(); - - const Proxy P(X.get_ref()); - - const uword X_n_rows = P.get_n_rows(); - const uword X_n_cols = P.get_n_cols(); - - init_warm(X_n_rows, X_n_cols); - - return *this; - } - - - -//! apply a functor to each element -template -template -inline -Mat& -Mat::for_each(functor F) - { - arma_debug_sigprint(); - - eT* data = memptr(); - - const uword N = n_elem; - - uword ii, jj; - - for(ii=0, jj=1; jj < N; ii+=2, jj+=2) - { - F(data[ii]); - F(data[jj]); - } - - if(ii < N) - { - F(data[ii]); - } - - return *this; - } - - - -template -template -inline -const Mat& -Mat::for_each(functor F) const - { - arma_debug_sigprint(); - - const eT* data = memptr(); - - const uword N = n_elem; - - uword ii, jj; - - for(ii=0, jj=1; jj < N; ii+=2, jj+=2) - { - F(data[ii]); - F(data[jj]); - } - - if(ii < N) - { - F(data[ii]); - } - - return *this; - } - - - -//! transform each element in the matrix using a functor -template -template -inline -Mat& -Mat::transform(functor F) - { - arma_debug_sigprint(); - - eT* out_mem = memptr(); - - const uword N = n_elem; - - uword ii, jj; - - for(ii=0, jj=1; jj < N; ii+=2, jj+=2) - { - eT tmp_ii = out_mem[ii]; - eT tmp_jj = out_mem[jj]; - - tmp_ii = eT( F(tmp_ii) ); - tmp_jj = eT( F(tmp_jj) ); - - out_mem[ii] = tmp_ii; - out_mem[jj] = tmp_jj; - } - - if(ii < N) - { - out_mem[ii] = eT( F(out_mem[ii]) ); - } - - return *this; - } - - - -//! imbue (fill) the matrix with values provided by a functor -template -template -inline -Mat& -Mat::imbue(functor F) - { - arma_debug_sigprint(); - - eT* out_mem = memptr(); - - const uword N = n_elem; - - uword ii, jj; - - for(ii=0, jj=1; jj < N; ii+=2, jj+=2) - { - const eT tmp_ii = eT( F() ); - const eT tmp_jj = eT( F() ); - - out_mem[ii] = tmp_ii; - out_mem[jj] = tmp_jj; - } - - if(ii < N) - { - out_mem[ii] = eT( F() ); - } - - return *this; - } - - - -template -inline -Mat& -Mat::replace(const eT old_val, const eT new_val) - { - arma_debug_sigprint(); - - arrayops::replace(memptr(), n_elem, old_val, new_val); - - return *this; - } - - - -template -inline -Mat& -Mat::clean(const typename get_pod_type::result threshold) - { - arma_debug_sigprint(); - - arrayops::clean(memptr(), n_elem, threshold); - - return *this; - } - - - -template -inline -Mat& -Mat::clamp(const eT min_val, const eT max_val) - { - arma_debug_sigprint(); - - if(is_cx::no) - { - arma_conform_check( (access::tmp_real(min_val) > access::tmp_real(max_val)), "Mat::clamp(): min_val must be less than max_val" ); - } - else - { - arma_conform_check( (access::tmp_real(min_val) > access::tmp_real(max_val)), "Mat::clamp(): real(min_val) must be less than real(max_val)" ); - arma_conform_check( (access::tmp_imag(min_val) > access::tmp_imag(max_val)), "Mat::clamp(): imag(min_val) must be less than imag(max_val)" ); - } - - arrayops::clamp(memptr(), n_elem, min_val, max_val); - - return *this; - } - - - -//! fill the matrix with the specified value -template -inline -Mat& -Mat::fill(const eT val) - { - arma_debug_sigprint(); - - arrayops::inplace_set( memptr(), val, n_elem ); - - return *this; - } - - - -//! fill the matrix with the specified pattern -template -template -inline -Mat& -Mat::fill(const fill::fill_class&) - { - arma_debug_sigprint(); - - if(is_same_type::yes) { (*this).zeros(); } - if(is_same_type::yes) { (*this).ones(); } - if(is_same_type::yes) { (*this).eye(); } - if(is_same_type::yes) { (*this).randu(); } - if(is_same_type::yes) { (*this).randn(); } - - return *this; - } - - - -template -inline -Mat& -Mat::zeros() - { - arma_debug_sigprint(); - - arrayops::fill_zeros(memptr(), n_elem); - - return *this; - } - - - -template -inline -Mat& -Mat::zeros(const uword new_n_elem) - { - arma_debug_sigprint(); - - set_size(new_n_elem); - - return (*this).zeros(); - } - - - -template -inline -Mat& -Mat::zeros(const uword new_n_rows, const uword new_n_cols) - { - arma_debug_sigprint(); - - set_size(new_n_rows, new_n_cols); - - return (*this).zeros(); - } - - - -template -inline -Mat& -Mat::zeros(const SizeMat& s) - { - arma_debug_sigprint(); - - return (*this).zeros(s.n_rows, s.n_cols); - } - - - -template -inline -Mat& -Mat::ones() - { - arma_debug_sigprint(); - - return fill(eT(1)); - } - - - -template -inline -Mat& -Mat::ones(const uword new_n_elem) - { - arma_debug_sigprint(); - - set_size(new_n_elem); - - return fill(eT(1)); - } - - - -template -inline -Mat& -Mat::ones(const uword new_n_rows, const uword new_n_cols) - { - arma_debug_sigprint(); - - set_size(new_n_rows, new_n_cols); - - return fill(eT(1)); - } - - - -template -inline -Mat& -Mat::ones(const SizeMat& s) - { - arma_debug_sigprint(); - - return (*this).ones(s.n_rows, s.n_cols); - } - - - -template -inline -Mat& -Mat::randu() - { - arma_debug_sigprint(); - - arma_rng::randu::fill( memptr(), n_elem ); - - return *this; - } - - - -template -inline -Mat& -Mat::randu(const uword new_n_elem) - { - arma_debug_sigprint(); - - set_size(new_n_elem); - - return (*this).randu(); - } - - - -template -inline -Mat& -Mat::randu(const uword new_n_rows, const uword new_n_cols) - { - arma_debug_sigprint(); - - set_size(new_n_rows, new_n_cols); - - return (*this).randu(); - } - - - -template -inline -Mat& -Mat::randu(const SizeMat& s) - { - arma_debug_sigprint(); - - return (*this).randu(s.n_rows, s.n_cols); - } - - - -template -inline -Mat& -Mat::randn() - { - arma_debug_sigprint(); - - arma_rng::randn::fill( memptr(), n_elem ); - - return *this; - } - - - -template -inline -Mat& -Mat::randn(const uword new_n_elem) - { - arma_debug_sigprint(); - - set_size(new_n_elem); - - return (*this).randn(); - } - - - -template -inline -Mat& -Mat::randn(const uword new_n_rows, const uword new_n_cols) - { - arma_debug_sigprint(); - - set_size(new_n_rows, new_n_cols); - - return (*this).randn(); - } - - - -template -inline -Mat& -Mat::randn(const SizeMat& s) - { - arma_debug_sigprint(); - - return (*this).randn(s.n_rows, s.n_cols); - } - - - -template -inline -Mat& -Mat::eye() - { - arma_debug_sigprint(); - - (*this).zeros(); - - const uword N = (std::min)(n_rows, n_cols); - - for(uword ii=0; ii -inline -Mat& -Mat::eye(const uword new_n_rows, const uword new_n_cols) - { - arma_debug_sigprint(); - - set_size(new_n_rows, new_n_cols); - - return (*this).eye(); - } - - - -template -inline -Mat& -Mat::eye(const SizeMat& s) - { - arma_debug_sigprint(); - - return (*this).eye(s.n_rows, s.n_cols); - } - - - -template -inline -void -Mat::reset() - { - arma_debug_sigprint(); - - const uword new_n_rows = (vec_state == 2) ? 1 : 0; - const uword new_n_cols = (vec_state == 1) ? 1 : 0; - - init_warm(new_n_rows, new_n_cols); - } - - - -template -inline -void -Mat::soft_reset() - { - arma_debug_sigprint(); - - // don't change the size if the matrix has a fixed size or is a cube slice - if(mem_state <= 1) - { - reset(); - } - else - { - zeros(); - } - } - - - -template -template -inline -void -Mat::set_real(const Base::pod_type,T1>& X) - { - arma_debug_sigprint(); - - Mat_aux::set_real(*this, X); - } - - - -template -template -inline -void -Mat::set_imag(const Base::pod_type,T1>& X) - { - arma_debug_sigprint(); - - Mat_aux::set_imag(*this, X); - } - - - -template -inline -eT -Mat::min() const - { - arma_debug_sigprint(); - - if(n_elem == 0) - { - arma_conform_check(true, "Mat::min(): object has no elements"); - - return Datum::nan; - } - - return op_min::direct_min(memptr(), n_elem); - } - - - -template -inline -eT -Mat::max() const - { - arma_debug_sigprint(); - - if(n_elem == 0) - { - arma_conform_check(true, "Mat::max(): object has no elements"); - - return Datum::nan; - } - - return op_max::direct_max(memptr(), n_elem); - } - - - -template -inline -eT -Mat::min(uword& index_of_min_val) const - { - arma_debug_sigprint(); - - if(n_elem == 0) - { - arma_conform_check(true, "Mat::min(): object has no elements"); - - index_of_min_val = uword(0); - - return Datum::nan; - } - - return op_min::direct_min(memptr(), n_elem, index_of_min_val); - } - - - -template -inline -eT -Mat::max(uword& index_of_max_val) const - { - arma_debug_sigprint(); - - if(n_elem == 0) - { - arma_conform_check(true, "Mat::max(): object has no elements"); - - index_of_max_val = uword(0); - - return Datum::nan; - } - - return op_max::direct_max(memptr(), n_elem, index_of_max_val); - } - - - -template -inline -eT -Mat::min(uword& row_of_min_val, uword& col_of_min_val) const - { - arma_debug_sigprint(); - - if(n_elem == 0) - { - arma_conform_check(true, "Mat::min(): object has no elements"); - - row_of_min_val = uword(0); - col_of_min_val = uword(0); - - return Datum::nan; - } - - uword iq; - - eT val = op_min::direct_min(memptr(), n_elem, iq); - - row_of_min_val = iq % n_rows; - col_of_min_val = iq / n_rows; - - return val; - } - - - -template -inline -eT -Mat::max(uword& row_of_max_val, uword& col_of_max_val) const - { - arma_debug_sigprint(); - - if(n_elem == 0) - { - arma_conform_check(true, "Mat::max(): object has no elements"); - - row_of_max_val = uword(0); - col_of_max_val = uword(0); - - return Datum::nan; - } - - uword iq; - - eT val = op_max::direct_max(memptr(), n_elem, iq); - - row_of_max_val = iq % n_rows; - col_of_max_val = iq / n_rows; - - return val; - } - - - -//! save the matrix to a file -template -inline -bool -Mat::save(const std::string name, const file_type type) const - { - arma_debug_sigprint(); - - bool save_okay = false; - - switch(type) - { - case raw_ascii: - save_okay = diskio::save_raw_ascii(*this, name); - break; - - case arma_ascii: - save_okay = diskio::save_arma_ascii(*this, name); - break; - - case csv_ascii: - return (*this).save(csv_name(name), type); - break; - - case ssv_ascii: - return (*this).save(csv_name(name), type); - break; - - case coord_ascii: - save_okay = diskio::save_coord_ascii(*this, name); - break; - - case raw_binary: - save_okay = diskio::save_raw_binary(*this, name); - break; - - case arma_binary: - save_okay = diskio::save_arma_binary(*this, name); - break; - - case pgm_binary: - save_okay = diskio::save_pgm_binary(*this, name); - break; - - case hdf5_binary: - return (*this).save(hdf5_name(name)); - break; - - case hdf5_binary_trans: // kept for compatibility with earlier versions of Armadillo - return (*this).save(hdf5_name(name, std::string(), hdf5_opts::trans)); - break; - - default: - arma_warn(1, "Mat::save(): unsupported file type"); - save_okay = false; - } - - if(save_okay == false) { arma_warn(3, "Mat::save(): write failed; file: ", name); } - - return save_okay; - } - - - -template -inline -bool -Mat::save(const hdf5_name& spec, const file_type type) const - { - arma_debug_sigprint(); - - // handling of hdf5_binary_trans kept for compatibility with earlier versions of Armadillo - - if( (type != hdf5_binary) && (type != hdf5_binary_trans) ) - { - arma_stop_runtime_error("Mat::save(): unsupported file type for hdf5_name()"); - return false; - } - - const bool do_trans = bool(spec.opts.flags & hdf5_opts::flag_trans ) || (type == hdf5_binary_trans); - const bool append = bool(spec.opts.flags & hdf5_opts::flag_append ); - const bool replace = bool(spec.opts.flags & hdf5_opts::flag_replace); - - if(append && replace) - { - arma_stop_runtime_error("Mat::save(): only one of 'append' or 'replace' options can be used"); - return false; - } - - bool save_okay = false; - - std::string err_msg; - - if(do_trans) - { - Mat tmp; - - op_strans::apply_mat_noalias(tmp, *this); - - save_okay = diskio::save_hdf5_binary(tmp, spec, err_msg); - } - else - { - save_okay = diskio::save_hdf5_binary(*this, spec, err_msg); - } - - if(save_okay == false) - { - if(err_msg.length() > 0) - { - arma_warn(3, "Mat::save(): ", err_msg, "; file: ", spec.filename); - } - else - { - arma_warn(3, "Mat::save(): write failed; file: ", spec.filename); - } - } - - return save_okay; - } - - - -template -inline -bool -Mat::save(const csv_name& spec, const file_type type) const - { - arma_debug_sigprint(); - - if( (type != csv_ascii) && (type != ssv_ascii) ) - { - arma_stop_runtime_error("Mat::save(): unsupported file type for csv_name()"); - return false; - } - - const bool do_trans = bool(spec.opts.flags & csv_opts::flag_trans ); - const bool no_header = bool(spec.opts.flags & csv_opts::flag_no_header ); - const bool with_header = bool(spec.opts.flags & csv_opts::flag_with_header) && (no_header == false); - const bool use_semicolon = bool(spec.opts.flags & csv_opts::flag_semicolon ) || (type == ssv_ascii); - - arma_debug_print("Mat::save(csv_name): enabled flags:"); - - if(do_trans ) { arma_debug_print("trans"); } - if(no_header ) { arma_debug_print("no_header"); } - if(with_header ) { arma_debug_print("with_header"); } - if(use_semicolon) { arma_debug_print("semicolon"); } - - const char separator = (use_semicolon) ? char(';') : char(','); - - if(with_header) - { - if( (spec.header_ro.n_cols != 1) && (spec.header_ro.n_rows != 1) ) - { - arma_warn(1, "Mat::save(): given header must have a vector layout"); - return false; - } - - for(uword i=0; i < spec.header_ro.n_elem; ++i) - { - const std::string& token = spec.header_ro.at(i); - - if(token.find(separator) != std::string::npos) - { - arma_warn(1, "Mat::save(): token within the header contains the separator character: '", token, "'"); - return false; - } - } - - const uword save_n_cols = (do_trans) ? (*this).n_rows : (*this).n_cols; - - if(spec.header_ro.n_elem != save_n_cols) - { - arma_warn(1, "Mat::save(): size mismatch between header and matrix"); - return false; - } - } - - bool save_okay = false; - - if(do_trans) - { - const Mat tmp = (*this).st(); - - save_okay = diskio::save_csv_ascii(tmp, spec.filename, spec.header_ro, with_header, separator); - } - else - { - save_okay = diskio::save_csv_ascii(*this, spec.filename, spec.header_ro, with_header, separator); - } - - if(save_okay == false) { arma_warn(3, "Mat::save(): write failed; file: ", spec.filename); } - - return save_okay; - } - - - -//! save the matrix to a stream -template -inline -bool -Mat::save(std::ostream& os, const file_type type) const - { - arma_debug_sigprint(); - - bool save_okay = false; - - switch(type) - { - case raw_ascii: - save_okay = diskio::save_raw_ascii(*this, os); - break; - - case arma_ascii: - save_okay = diskio::save_arma_ascii(*this, os); - break; - - case csv_ascii: - save_okay = diskio::save_csv_ascii(*this, os, char(',')); - break; - - case ssv_ascii: - save_okay = diskio::save_csv_ascii(*this, os, char(';')); - break; - - case coord_ascii: - save_okay = diskio::save_coord_ascii(*this, os); - break; - - case raw_binary: - save_okay = diskio::save_raw_binary(*this, os); - break; - - case arma_binary: - save_okay = diskio::save_arma_binary(*this, os); - break; - - case pgm_binary: - save_okay = diskio::save_pgm_binary(*this, os); - break; - - default: - arma_warn(1, "Mat::save(): unsupported file type"); - save_okay = false; - } - - if(save_okay == false) { arma_warn(3, "Mat::save(): stream write failed"); } - - return save_okay; - } - - - -//! load a matrix from a file -template -inline -bool -Mat::load(const std::string name, const file_type type) - { - arma_debug_sigprint(); - - bool load_okay = false; - std::string err_msg; - - switch(type) - { - case auto_detect: - load_okay = diskio::load_auto_detect(*this, name, err_msg); - break; - - case raw_ascii: - load_okay = diskio::load_raw_ascii(*this, name, err_msg); - break; - - case arma_ascii: - load_okay = diskio::load_arma_ascii(*this, name, err_msg); - break; - - case csv_ascii: - return (*this).load(csv_name(name), type); - break; - - case ssv_ascii: - return (*this).load(csv_name(name), type); - break; - - case coord_ascii: - load_okay = diskio::load_coord_ascii(*this, name, err_msg); - break; - - case raw_binary: - load_okay = diskio::load_raw_binary(*this, name, err_msg); - break; - - case arma_binary: - load_okay = diskio::load_arma_binary(*this, name, err_msg); - break; - - case pgm_binary: - load_okay = diskio::load_pgm_binary(*this, name, err_msg); - break; - - case hdf5_binary: - return (*this).load(hdf5_name(name)); - break; - - case hdf5_binary_trans: // kept for compatibility with earlier versions of Armadillo - return (*this).load(hdf5_name(name, std::string(), hdf5_opts::trans)); - break; - - default: - arma_warn(1, "Mat::load(): unsupported file type"); - load_okay = false; - } - - if(load_okay == false) - { - if(err_msg.length() > 0) - { - arma_warn(3, "Mat::load(): ", err_msg, "; file: ", name); - } - else - { - arma_warn(3, "Mat::load(): read failed; file: ", name); - } - } - - if(load_okay == false) { (*this).soft_reset(); } - - return load_okay; - } - - - -template -inline -bool -Mat::load(const hdf5_name& spec, const file_type type) - { - arma_debug_sigprint(); - - if( (type != hdf5_binary) && (type != hdf5_binary_trans) ) - { - arma_stop_runtime_error("Mat::load(): unsupported file type for hdf5_name()"); - return false; - } - - bool load_okay = false; - std::string err_msg; - - const bool do_trans = bool(spec.opts.flags & hdf5_opts::flag_trans) || (type == hdf5_binary_trans); - - if(do_trans) - { - Mat tmp; - - load_okay = diskio::load_hdf5_binary(tmp, spec, err_msg); - - if(load_okay) { op_strans::apply_mat_noalias(*this, tmp); } - } - else - { - load_okay = diskio::load_hdf5_binary(*this, spec, err_msg); - } - - - if(load_okay == false) - { - if(err_msg.length() > 0) - { - arma_warn(3, "Mat::load(): ", err_msg, "; file: ", spec.filename); - } - else - { - arma_warn(3, "Mat::load(): read failed; file: ", spec.filename); - } - } - - if(load_okay == false) { (*this).soft_reset(); } - - return load_okay; - } - - - -template -inline -bool -Mat::load(const csv_name& spec, const file_type type) - { - arma_debug_sigprint(); - - if( (type != csv_ascii) && (type != ssv_ascii) ) - { - arma_stop_runtime_error("Mat::load(): unsupported file type for csv_name()"); - return false; - } - - const bool do_trans = bool(spec.opts.flags & csv_opts::flag_trans ); - const bool no_header = bool(spec.opts.flags & csv_opts::flag_no_header ); - const bool with_header = bool(spec.opts.flags & csv_opts::flag_with_header) && (no_header == false); - const bool use_semicolon = bool(spec.opts.flags & csv_opts::flag_semicolon ) || (type == ssv_ascii); - const bool strict = bool(spec.opts.flags & csv_opts::flag_strict ); - - arma_debug_print("Mat::load(csv_name): enabled flags:"); - - if(do_trans ) { arma_debug_print("trans"); } - if(no_header ) { arma_debug_print("no_header"); } - if(with_header ) { arma_debug_print("with_header"); } - if(use_semicolon) { arma_debug_print("semicolon"); } - if(strict ) { arma_debug_print("strict"); } - - const char separator = (use_semicolon) ? char(';') : char(','); - - bool load_okay = false; - std::string err_msg; - - if(do_trans) - { - Mat tmp_mat; - - load_okay = diskio::load_csv_ascii(tmp_mat, spec.filename, err_msg, spec.header_rw, with_header, separator, strict); - - if(load_okay) - { - (*this) = tmp_mat.st(); - - if(with_header) - { - // field::set_size() preserves data if the number of elements hasn't changed - spec.header_rw.set_size(spec.header_rw.n_elem, 1); - } - } - } - else - { - load_okay = diskio::load_csv_ascii(*this, spec.filename, err_msg, spec.header_rw, with_header, separator, strict); - } - - if(load_okay == false) - { - if(err_msg.length() > 0) - { - arma_warn(3, "Mat::load(): ", err_msg, "; file: ", spec.filename); - } - else - { - arma_warn(3, "Mat::load(): read failed; file: ", spec.filename); - } - } - else - { - const uword load_n_cols = (do_trans) ? (*this).n_rows : (*this).n_cols; - - if(with_header && (spec.header_rw.n_elem != load_n_cols)) - { - arma_warn(3, "Mat::load(): size mismatch between header and matrix"); - } - } - - if(load_okay == false) - { - (*this).soft_reset(); - - if(with_header) { spec.header_rw.reset(); } - } - - return load_okay; - } - - - -//! load a matrix from a stream -template -inline -bool -Mat::load(std::istream& is, const file_type type) - { - arma_debug_sigprint(); - - bool load_okay = false; - std::string err_msg; - - switch(type) - { - case auto_detect: - load_okay = diskio::load_auto_detect(*this, is, err_msg); - break; - - case raw_ascii: - load_okay = diskio::load_raw_ascii(*this, is, err_msg); - break; - - case arma_ascii: - load_okay = diskio::load_arma_ascii(*this, is, err_msg); - break; - - case csv_ascii: - load_okay = diskio::load_csv_ascii(*this, is, err_msg, char(','), false); - break; - - case ssv_ascii: - load_okay = diskio::load_csv_ascii(*this, is, err_msg, char(';'), false); - break; - - case coord_ascii: - load_okay = diskio::load_coord_ascii(*this, is, err_msg); - break; - - case raw_binary: - load_okay = diskio::load_raw_binary(*this, is, err_msg); - break; - - case arma_binary: - load_okay = diskio::load_arma_binary(*this, is, err_msg); - break; - - case pgm_binary: - load_okay = diskio::load_pgm_binary(*this, is, err_msg); - break; - - default: - arma_warn(1, "Mat::load(): unsupported file type"); - load_okay = false; - } - - if(load_okay == false) - { - if(err_msg.length() > 0) - { - arma_warn(3, "Mat::load(): ", err_msg); - } - else - { - arma_warn(3, "Mat::load(): stream read failed"); - } - } - - if(load_okay == false) { (*this).soft_reset(); } - - return load_okay; - } - - - -template -inline -bool -Mat::quiet_save(const std::string name, const file_type type) const - { - arma_debug_sigprint(); - - return (*this).save(name, type); - } - - - -template -inline -bool -Mat::quiet_save(const hdf5_name& spec, const file_type type) const - { - arma_debug_sigprint(); - - return (*this).save(spec, type); - } - - - -template -inline -bool -Mat::quiet_save(const csv_name& spec, const file_type type) const - { - arma_debug_sigprint(); - - return (*this).save(spec, type); - } - - - -template -inline -bool -Mat::quiet_save(std::ostream& os, const file_type type) const - { - arma_debug_sigprint(); - - return (*this).save(os, type); - } - - - -template -inline -bool -Mat::quiet_load(const std::string name, const file_type type) - { - arma_debug_sigprint(); - - return (*this).load(name, type); - } - - - -template -inline -bool -Mat::quiet_load(const hdf5_name& spec, const file_type type) - { - arma_debug_sigprint(); - - return (*this).load(spec, type); - } - - - -template -inline -bool -Mat::quiet_load(const csv_name& spec, const file_type type) - { - arma_debug_sigprint(); - - return (*this).load(spec, type); - } - - - -template -inline -bool -Mat::quiet_load(std::istream& is, const file_type type) - { - arma_debug_sigprint(); - - return (*this).load(is, type); - } - - - -template -inline -Mat::row_iterator::row_iterator() - : M (nullptr) - , current_row(0 ) - , current_col(0 ) - { - arma_debug_sigprint(); - - // NOTE: this instance of row_iterator is invalid (it does not point to a valid element) - } - - - -template -inline -Mat::row_iterator::row_iterator(const row_iterator& X) - : M (X.M ) - , current_row(X.current_row) - , current_col(X.current_col) - { - arma_debug_sigprint(); - } - - - -template -inline -Mat::row_iterator::row_iterator(Mat& in_M, const uword in_row, const uword in_col) - : M (&in_M ) - , current_row(in_row) - , current_col(in_col) - { - arma_debug_sigprint(); - } - - - -template -inline -eT& -Mat::row_iterator::operator*() - { - return M->at(current_row,current_col); - } - - - -template -inline -typename Mat::row_iterator& -Mat::row_iterator::operator++() - { - current_col++; - - if(current_col == M->n_cols) - { - current_col = 0; - current_row++; - } - - return *this; - } - - - -template -inline -typename Mat::row_iterator -Mat::row_iterator::operator++(int) - { - typename Mat::row_iterator temp(*this); - - ++(*this); - - return temp; - } - - - -template -inline -typename Mat::row_iterator& -Mat::row_iterator::operator--() - { - if(current_col > 0) - { - current_col--; - } - else - { - if(current_row > 0) - { - current_col = M->n_cols - 1; - current_row--; - } - } - - return *this; - } - - - -template -inline -typename Mat::row_iterator -Mat::row_iterator::operator--(int) - { - typename Mat::row_iterator temp(*this); - - --(*this); - - return temp; - } - - - -template -inline -bool -Mat::row_iterator::operator!=(const typename Mat::row_iterator& X) const - { - return ( (current_row != X.current_row) || (current_col != X.current_col) ); - } - - - -template -inline -bool -Mat::row_iterator::operator==(const typename Mat::row_iterator& X) const - { - return ( (current_row == X.current_row) && (current_col == X.current_col) ); - } - - - -template -inline -bool -Mat::row_iterator::operator!=(const typename Mat::const_row_iterator& X) const - { - return ( (current_row != X.current_row) || (current_col != X.current_col) ); - } - - - -template -inline -bool -Mat::row_iterator::operator==(const typename Mat::const_row_iterator& X) const - { - return ( (current_row == X.current_row) && (current_col == X.current_col) ); - } - - - -template -inline -Mat::const_row_iterator::const_row_iterator() - : M (nullptr) - , current_row(0 ) - , current_col(0 ) - { - arma_debug_sigprint(); - - // NOTE: this instance of const_row_iterator is invalid (it does not point to a valid element) - } - - - -template -inline -Mat::const_row_iterator::const_row_iterator(const typename Mat::row_iterator& X) - : M (X.M ) - , current_row(X.current_row) - , current_col(X.current_col) - { - arma_debug_sigprint(); - } - - - -template -inline -Mat::const_row_iterator::const_row_iterator(const typename Mat::const_row_iterator& X) - : M (X.M ) - , current_row(X.current_row) - , current_col(X.current_col) - { - arma_debug_sigprint(); - } - - - -template -inline -Mat::const_row_iterator::const_row_iterator(const Mat& in_M, const uword in_row, const uword in_col) - : M (&in_M ) - , current_row(in_row) - , current_col(in_col) - { - arma_debug_sigprint(); - } - - - -template -inline -const eT& -Mat::const_row_iterator::operator*() const - { - return M->at(current_row,current_col); - } - - - -template -inline -typename Mat::const_row_iterator& -Mat::const_row_iterator::operator++() - { - current_col++; - - if(current_col == M->n_cols) - { - current_col = 0; - current_row++; - } - - return *this; - } - - - -template -inline -typename Mat::const_row_iterator -Mat::const_row_iterator::operator++(int) - { - typename Mat::const_row_iterator temp(*this); - - ++(*this); - - return temp; - } - - - -template -inline -typename Mat::const_row_iterator& -Mat::const_row_iterator::operator--() - { - if(current_col > 0) - { - current_col--; - } - else - { - if(current_row > 0) - { - current_col = M->n_cols - 1; - current_row--; - } - } - - return *this; - } - - - -template -inline -typename Mat::const_row_iterator -Mat::const_row_iterator::operator--(int) - { - typename Mat::const_row_iterator temp(*this); - - --(*this); - - return temp; - } - - - -template -inline -bool -Mat::const_row_iterator::operator!=(const typename Mat::row_iterator& X) const - { - return ( (current_row != X.current_row) || (current_col != X.current_col) ); - } - - - -template -inline -bool -Mat::const_row_iterator::operator==(const typename Mat::row_iterator& X) const - { - return ( (current_row == X.current_row) && (current_col == X.current_col) ); - } - - - -template -inline -bool -Mat::const_row_iterator::operator!=(const typename Mat::const_row_iterator& X) const - { - return ( (current_row != X.current_row) || (current_col != X.current_col) ); - } - - - -template -inline -bool -Mat::const_row_iterator::operator==(const typename Mat::const_row_iterator& X) const - { - return ( (current_row == X.current_row) && (current_col == X.current_col) ); - } - - - -template -inline -Mat::row_col_iterator::row_col_iterator() - : M (nullptr) - , current_ptr(nullptr) - , current_col(0 ) - , current_row(0 ) - { - arma_debug_sigprint(); - // Technically this iterator is invalid (it does not point to a valid element) - } - - - -template -inline -Mat::row_col_iterator::row_col_iterator(const row_col_iterator& in_it) - : M (in_it.M ) - , current_ptr(in_it.current_ptr) - , current_col(in_it.current_col) - , current_row(in_it.current_row) - { - arma_debug_sigprint(); - } - - - -template -inline -Mat::row_col_iterator::row_col_iterator(Mat& in_M, const uword in_row, const uword in_col) - : M (&in_M ) - , current_ptr(&in_M.at(in_row,in_col)) - , current_col(in_col ) - , current_row(in_row ) - { - arma_debug_sigprint(); - } - - - -template -inline -eT& -Mat::row_col_iterator::operator*() - { - return *current_ptr; - } - - - -template -inline -typename Mat::row_col_iterator& -Mat::row_col_iterator::operator++() - { - if(current_col < M->n_cols) - { - current_ptr++; - current_row++; - - // Check to see if we moved a column. - if(current_row == M->n_rows) - { - current_col++; - current_row = 0; - } - } - - return *this; - } - - - -template -inline -typename Mat::row_col_iterator -Mat::row_col_iterator::operator++(int) - { - typename Mat::row_col_iterator temp(*this); - - ++(*this); - - return temp; - } - - - -template -inline typename Mat::row_col_iterator& -Mat::row_col_iterator::operator--() - { - if(current_row > 0) - { - current_ptr--; - current_row--; - } - else - if(current_col > 0) - { - current_ptr--; - current_col--; - current_row = M->n_rows - 1; - } - - return *this; - } - - - -template -inline -typename Mat::row_col_iterator -Mat::row_col_iterator::operator--(int) - { - typename Mat::row_col_iterator temp(*this); - - --(*this); - - return temp; - } - - - -template -inline -uword -Mat::row_col_iterator::row() const - { - return current_row; - } - - - -template -inline -uword -Mat::row_col_iterator::col() const - { - return current_col; - } - - - -template -inline -bool -Mat::row_col_iterator::operator==(const row_col_iterator& rhs) const - { - return (current_ptr == rhs.current_ptr); - } - - - -template -inline -bool -Mat::row_col_iterator::operator!=(const row_col_iterator& rhs) const - { - return (current_ptr != rhs.current_ptr); - } - - - -template -inline -bool -Mat::row_col_iterator::operator==(const const_row_col_iterator& rhs) const - { - return (current_ptr == rhs.current_ptr); - } - - - -template -inline -bool -Mat::row_col_iterator::operator!=(const const_row_col_iterator& rhs) const - { - return (current_ptr != rhs.current_ptr); - } - - - -template -inline -Mat::const_row_col_iterator::const_row_col_iterator() - : M (nullptr) - , current_ptr(nullptr) - , current_col(0 ) - , current_row(0 ) - { - arma_debug_sigprint(); - // Technically this iterator is invalid (it does not point to a valid element) - } - - - -template -inline -Mat::const_row_col_iterator::const_row_col_iterator(const row_col_iterator& in_it) - : M (in_it.M ) - , current_ptr(in_it.current_ptr) - , current_col(in_it.col() ) - , current_row(in_it.row() ) - { - arma_debug_sigprint(); - } - - - -template -inline -Mat::const_row_col_iterator::const_row_col_iterator(const const_row_col_iterator& in_it) - : M (in_it.M ) - , current_ptr(in_it.current_ptr) - , current_col(in_it.col() ) - , current_row(in_it.row() ) - { - arma_debug_sigprint(); - } - - - -template -inline -Mat::const_row_col_iterator::const_row_col_iterator(const Mat& in_M, const uword in_row, const uword in_col) - : M (&in_M ) - , current_ptr(&in_M.at(in_row,in_col)) - , current_col(in_col ) - , current_row(in_row ) - { - arma_debug_sigprint(); - } - - - -template -inline -const eT& -Mat::const_row_col_iterator::operator*() const - { - return *current_ptr; - } - - - -template -inline -typename Mat::const_row_col_iterator& -Mat::const_row_col_iterator::operator++() - { - if(current_col < M->n_cols) - { - current_ptr++; - current_row++; - - // Check to see if we moved a column. - if(current_row == M->n_rows) - { - current_col++; - current_row = 0; - } - } - - return *this; - } - - - -template -inline -typename Mat::const_row_col_iterator -Mat::const_row_col_iterator::operator++(int) - { - typename Mat::const_row_col_iterator temp(*this); - - ++(*this); - - return temp; - } - - - -template -inline -typename Mat::const_row_col_iterator& -Mat::const_row_col_iterator::operator--() - { - if(current_row > 0) - { - current_ptr--; - current_row--; - } - else - if(current_col > 0) - { - current_ptr--; - current_col--; - current_row = M->n_rows - 1; - } - - return *this; - } - - - -template -inline -typename Mat::const_row_col_iterator -Mat::const_row_col_iterator::operator--(int) - { - typename Mat::const_row_col_iterator temp(*this); - - --(*this); - - return temp; - } - - - -template -inline -uword -Mat::const_row_col_iterator::row() const - { - return current_row; - } - - - -template -inline -uword -Mat::const_row_col_iterator::col() const - { - return current_col; - } - - - -template -inline -bool -Mat::const_row_col_iterator::operator==(const const_row_col_iterator& rhs) const - { - return (current_ptr == rhs.current_ptr); - } - - - -template -inline -bool -Mat::const_row_col_iterator::operator!=(const const_row_col_iterator& rhs) const - { - return (current_ptr != rhs.current_ptr); - } - - - -template -inline -bool -Mat::const_row_col_iterator::operator==(const row_col_iterator& rhs) const - { - return (current_ptr == rhs.current_ptr); - } - - - -template -inline -bool -Mat::const_row_col_iterator::operator!=(const row_col_iterator& rhs) const - { - return (current_ptr != rhs.current_ptr); - } - - - -template -inline -typename Mat::iterator -Mat::begin() - { - arma_debug_sigprint(); - - return memptr(); - } - - - -template -inline -typename Mat::const_iterator -Mat::begin() const - { - arma_debug_sigprint(); - - return memptr(); - } - - - -template -inline -typename Mat::const_iterator -Mat::cbegin() const - { - arma_debug_sigprint(); - - return memptr(); - } - - - -template -inline -typename Mat::iterator -Mat::end() - { - arma_debug_sigprint(); - - return memptr() + n_elem; - } - - - -template -inline -typename Mat::const_iterator -Mat::end() const - { - arma_debug_sigprint(); - - return memptr() + n_elem; - } - - - -template -inline -typename Mat::const_iterator -Mat::cend() const - { - arma_debug_sigprint(); - - return memptr() + n_elem; - } - - - -template -inline -typename Mat::col_iterator -Mat::begin_col(const uword col_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (col_num >= n_cols), "Mat::begin_col(): index out of bounds" ); - - return colptr(col_num); - } - - - -template -inline -typename Mat::const_col_iterator -Mat::begin_col(const uword col_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (col_num >= n_cols), "Mat::begin_col(): index out of bounds" ); - - return colptr(col_num); - } - - - -template -inline -typename Mat::col_iterator -Mat::end_col(const uword col_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (col_num >= n_cols), "Mat::end_col(): index out of bounds" ); - - return colptr(col_num) + n_rows; - } - - - -template -inline -typename Mat::const_col_iterator -Mat::end_col(const uword col_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (col_num >= n_cols), "Mat::end_col(): index out of bounds" ); - - return colptr(col_num) + n_rows; - } - - - -template -inline -typename Mat::row_iterator -Mat::begin_row(const uword row_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (row_num >= n_rows), "Mat::begin_row(): index out of bounds" ); - - return typename Mat::row_iterator(*this, row_num, uword(0)); - } - - - -template -inline -typename Mat::const_row_iterator -Mat::begin_row(const uword row_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (row_num >= n_rows), "Mat::begin_row(): index out of bounds" ); - - return typename Mat::const_row_iterator(*this, row_num, uword(0)); - } - - - -template -inline -typename Mat::row_iterator -Mat::end_row(const uword row_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (row_num >= n_rows), "Mat::end_row(): index out of bounds" ); - - return typename Mat::row_iterator(*this, (row_num + uword(1)), 0); - } - - - -template -inline -typename Mat::const_row_iterator -Mat::end_row(const uword row_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (row_num >= n_rows), "Mat::end_row(): index out of bounds" ); - - return typename Mat::const_row_iterator(*this, (row_num + uword(1)), 0); - } - - - -template -inline -typename Mat::row_col_iterator -Mat::begin_row_col() - { - return row_col_iterator(*this); - } - - - -template -inline -typename Mat::const_row_col_iterator -Mat::begin_row_col() const - { - return const_row_col_iterator(*this); - } - - - -template -inline typename Mat::row_col_iterator -Mat::end_row_col() - { - return row_col_iterator(*this, 0, n_cols); - } - - - -template -inline typename Mat::const_row_col_iterator -Mat::end_row_col() const - { - return const_row_col_iterator(*this, 0, n_cols); - } - - - -//! resets this matrix to an empty matrix -template -inline -void -Mat::clear() - { - reset(); - } - - - -//! returns true if the matrix has no elements -template -inline -bool -Mat::empty() const - { - return (n_elem == 0); - } - - - -//! returns the number of elements in this matrix -template -inline -uword -Mat::size() const - { - return n_elem; - } - - - -template -inline -eT& -Mat::front() - { - arma_conform_check( (n_elem == 0), "Mat::front(): matrix is empty" ); - - return access::rw(mem[0]); - } - - - -template -inline -const eT& -Mat::front() const - { - arma_conform_check( (n_elem == 0), "Mat::front(): matrix is empty" ); - - return mem[0]; - } - - - -template -inline -eT& -Mat::back() - { - arma_conform_check( (n_elem == 0), "Mat::back(): matrix is empty" ); - - return access::rw(mem[n_elem-1]); - } - - - -template -inline -const eT& -Mat::back() const - { - arma_conform_check( (n_elem == 0), "Mat::back(): matrix is empty" ); - - return mem[n_elem-1]; - } - - - -template -template -arma_inline -Mat::fixed::fixed() - : Mat( arma_fixed_indicator(), fixed_n_rows, fixed_n_cols, 0, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - arma_debug_print("Mat::fixed::constructor: zeroing memory"); - - eT* mem_use = (use_extra) ? &(mem_local_extra[0]) : &(mem_local[0]); - - arrayops::inplace_set_fixed( mem_use, eT(0) ); - } - - - -template -template -arma_inline -Mat::fixed::fixed(const fixed& X) - : Mat( arma_fixed_indicator(), fixed_n_rows, fixed_n_cols, 0, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - eT* dest = (use_extra) ? mem_local_extra : mem_local; - const eT* src = (use_extra) ? X.mem_local_extra : X.mem_local; - - arrayops::copy( dest, src, fixed_n_elem ); - } - - - -template -template -inline -Mat::fixed::fixed(const fill::scalar_holder f) - : Mat( arma_fixed_indicator(), fixed_n_rows, fixed_n_cols, 0, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - (*this).fill(f.scalar); - } - - - -template -template -template -inline -Mat::fixed::fixed(const fill::fill_class&) - : Mat( arma_fixed_indicator(), fixed_n_rows, fixed_n_cols, 0, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - if(is_same_type::yes) { (*this).zeros(); } - if(is_same_type::yes) { (*this).ones(); } - if(is_same_type::yes) { (*this).eye(); } - if(is_same_type::yes) { (*this).randu(); } - if(is_same_type::yes) { (*this).randn(); } - } - - - -template -template -template -inline -Mat::fixed::fixed(const Base& A) - : Mat( arma_fixed_indicator(), fixed_n_rows, fixed_n_cols, 0, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - Mat::operator=(A.get_ref()); - } - - - -template -template -template -inline -Mat::fixed::fixed(const Base& A, const Base& B) - : Mat( arma_fixed_indicator(), fixed_n_rows, fixed_n_cols, 0, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - Mat::init(A,B); - } - - - -template -template -inline -Mat::fixed::fixed(const eT* aux_mem) - : Mat( arma_fixed_indicator(), fixed_n_rows, fixed_n_cols, 0, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - eT* dest = (use_extra) ? mem_local_extra : mem_local; - - arrayops::copy( dest, aux_mem, fixed_n_elem ); - } - - - -template -template -inline -Mat::fixed::fixed(const char* text) - : Mat( arma_fixed_indicator(), fixed_n_rows, fixed_n_cols, 0, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - Mat::operator=(text); - } - - - -template -template -inline -Mat::fixed::fixed(const std::string& text) - : Mat( arma_fixed_indicator(), fixed_n_rows, fixed_n_cols, 0, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - Mat::operator=(text); - } - - - -template -template -inline -Mat::fixed::fixed(const std::initializer_list& list) - : Mat( arma_fixed_indicator(), fixed_n_rows, fixed_n_cols, 0, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - (*this).operator=(list); - } - - - -template -template -inline -Mat& -Mat::fixed::operator=(const std::initializer_list& list) - { - arma_debug_sigprint(); - - const uword N = uword(list.size()); - - arma_conform_check( (N > fixed_n_elem), "Mat::fixed: initialiser list is too long" ); - - eT* this_mem = (*this).memptr(); - - arrayops::copy( this_mem, list.begin(), N ); - - for(uword iq=N; iq < fixed_n_elem; ++iq) { this_mem[iq] = eT(0); } - - return *this; - } - - - -template -template -inline -Mat::fixed::fixed(const std::initializer_list< std::initializer_list >& list) - : Mat( arma_fixed_indicator(), fixed_n_rows, fixed_n_cols, 0, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - Mat::init(list); - } - - - -template -template -inline -Mat& -Mat::fixed::operator=(const std::initializer_list< std::initializer_list >& list) - { - arma_debug_sigprint(); - - Mat::init(list); - - return *this; - } - - - -template -template -arma_inline -Mat& -Mat::fixed::operator=(const fixed& X) - { - arma_debug_sigprint(); - - if(this != &X) - { - eT* dest = (use_extra) ? mem_local_extra : mem_local; - const eT* src = (use_extra) ? X.mem_local_extra : X.mem_local; - - arrayops::copy( dest, src, fixed_n_elem ); - } - - return *this; - } - - - -#if defined(ARMA_GOOD_COMPILER) - - template - template - template - inline - Mat& - Mat::fixed::operator=(const eOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const bool bad_alias = (eOp::proxy_type::has_subview && X.P.is_alias(*this)); - - if(bad_alias) { const Mat tmp(X); (*this) = tmp; return *this; } - - arma_conform_assert_same_size(fixed_n_rows, fixed_n_cols, X.get_n_rows(), X.get_n_cols(), "Mat::fixed::operator="); - - eop_type::apply(*this, X); - - return *this; - } - - - - template - template - template - inline - Mat& - Mat::fixed::operator=(const eGlue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const bool bad_alias = - ( - (eGlue::proxy1_type::has_subview && X.P1.is_alias(*this)) - || - (eGlue::proxy2_type::has_subview && X.P2.is_alias(*this)) - ); - - if(bad_alias) { const Mat tmp(X); (*this) = tmp; return *this; } - - arma_conform_assert_same_size(fixed_n_rows, fixed_n_cols, X.get_n_rows(), X.get_n_cols(), "Mat::fixed::operator="); - - eglue_type::apply(*this, X); - - return *this; - } - -#endif - - - -template -template -arma_inline -const Op< typename Mat::template fixed::Mat_fixed_type, op_htrans > -Mat::fixed::t() const - { - return Op< typename Mat::template fixed::Mat_fixed_type, op_htrans >(*this); - } - - - -template -template -arma_inline -const Op< typename Mat::template fixed::Mat_fixed_type, op_htrans > -Mat::fixed::ht() const - { - return Op< typename Mat::template fixed::Mat_fixed_type, op_htrans >(*this); - } - - - -template -template -arma_inline -const Op< typename Mat::template fixed::Mat_fixed_type, op_strans > -Mat::fixed::st() const - { - return Op< typename Mat::template fixed::Mat_fixed_type, op_strans >(*this); - } - - - -template -template -arma_inline -const eT& -Mat::fixed::at_alt(const uword ii) const - { - #if defined(ARMA_HAVE_ALIGNED_ATTRIBUTE) - - return (use_extra) ? mem_local_extra[ii] : mem_local[ii]; - - #else - const eT* mem_aligned = (use_extra) ? mem_local_extra : mem_local; - - memory::mark_as_aligned(mem_aligned); - - return mem_aligned[ii]; - #endif - } - - - -template -template -arma_inline -eT& -Mat::fixed::operator[] (const uword ii) - { - return (use_extra) ? mem_local_extra[ii] : mem_local[ii]; - } - - - -template -template -arma_inline -const eT& -Mat::fixed::operator[] (const uword ii) const - { - return (use_extra) ? mem_local_extra[ii] : mem_local[ii]; - } - - - -template -template -arma_inline -eT& -Mat::fixed::at(const uword ii) - { - return (use_extra) ? mem_local_extra[ii] : mem_local[ii]; - } - - - -template -template -arma_inline -const eT& -Mat::fixed::at(const uword ii) const - { - return (use_extra) ? mem_local_extra[ii] : mem_local[ii]; - } - - - -template -template -arma_inline -eT& -Mat::fixed::operator() (const uword ii) - { - arma_conform_check_bounds( (ii >= fixed_n_elem), "Mat::operator(): index out of bounds" ); - - return (use_extra) ? mem_local_extra[ii] : mem_local[ii]; - } - - - -template -template -arma_inline -const eT& -Mat::fixed::operator() (const uword ii) const - { - arma_conform_check_bounds( (ii >= fixed_n_elem), "Mat::operator(): index out of bounds" ); - - return (use_extra) ? mem_local_extra[ii] : mem_local[ii]; - } - - - -#if defined(__cpp_multidimensional_subscript) - - template - template - arma_inline - eT& - Mat::fixed::operator[] (const uword in_row, const uword in_col) - { - const uword iq = in_row + in_col*fixed_n_rows; - - return (use_extra) ? mem_local_extra[iq] : mem_local[iq]; - } - - - - template - template - arma_inline - const eT& - Mat::fixed::operator[] (const uword in_row, const uword in_col) const - { - const uword iq = in_row + in_col*fixed_n_rows; - - return (use_extra) ? mem_local_extra[iq] : mem_local[iq]; - } - -#endif - - - -template -template -arma_inline -eT& -Mat::fixed::at(const uword in_row, const uword in_col) - { - const uword iq = in_row + in_col*fixed_n_rows; - - return (use_extra) ? mem_local_extra[iq] : mem_local[iq]; - } - - - -template -template -arma_inline -const eT& -Mat::fixed::at(const uword in_row, const uword in_col) const - { - const uword iq = in_row + in_col*fixed_n_rows; - - return (use_extra) ? mem_local_extra[iq] : mem_local[iq]; - } - - - -template -template -arma_inline -eT& -Mat::fixed::operator() (const uword in_row, const uword in_col) - { - arma_conform_check_bounds( ((in_row >= fixed_n_rows) || (in_col >= fixed_n_cols)), "Mat::operator(): index out of bounds" ); - - const uword iq = in_row + in_col*fixed_n_rows; - - return (use_extra) ? mem_local_extra[iq] : mem_local[iq]; - } - - - -template -template -arma_inline -const eT& -Mat::fixed::operator() (const uword in_row, const uword in_col) const - { - arma_conform_check_bounds( ((in_row >= fixed_n_rows) || (in_col >= fixed_n_cols)), "Mat::operator(): index out of bounds" ); - - const uword iq = in_row + in_col*fixed_n_rows; - - return (use_extra) ? mem_local_extra[iq] : mem_local[iq]; - } - - - -template -template -arma_inline -eT* -Mat::fixed::colptr(const uword in_col) - { - eT* mem_actual = (use_extra) ? mem_local_extra : mem_local; - - return & access::rw(mem_actual[in_col*fixed_n_rows]); - } - - - -template -template -arma_inline -const eT* -Mat::fixed::colptr(const uword in_col) const - { - const eT* mem_actual = (use_extra) ? mem_local_extra : mem_local; - - return & mem_actual[in_col*fixed_n_rows]; - } - - - -template -template -arma_inline -eT* -Mat::fixed::memptr() - { - return (use_extra) ? mem_local_extra : mem_local; - } - - - -template -template -arma_inline -const eT* -Mat::fixed::memptr() const - { - return (use_extra) ? mem_local_extra : mem_local; - } - - - -template -template -arma_inline -bool -Mat::fixed::is_vec() const - { - return ( (fixed_n_rows == 1) || (fixed_n_cols == 1) ); - } - - - -template -template -inline -const Mat& -Mat::fixed::fill(const eT val) - { - arma_debug_sigprint(); - - eT* mem_use = (use_extra) ? &(mem_local_extra[0]) : &(mem_local[0]); - - arrayops::inplace_set_fixed( mem_use, val ); - - return *this; - } - - - -template -template -inline -const Mat& -Mat::fixed::zeros() - { - arma_debug_sigprint(); - - eT* mem_use = (use_extra) ? &(mem_local_extra[0]) : &(mem_local[0]); - - arrayops::inplace_set_fixed( mem_use, eT(0) ); - - return *this; - } - - - -template -template -inline -const Mat& -Mat::fixed::ones() - { - arma_debug_sigprint(); - - eT* mem_use = (use_extra) ? &(mem_local_extra[0]) : &(mem_local[0]); - - arrayops::inplace_set_fixed( mem_use, eT(1) ); - - return *this; - } - - - -//! prefix ++ -template -inline -void -Mat_aux::prefix_pp(Mat& x) - { - eT* memptr = x.memptr(); - const uword n_elem = x.n_elem; - - uword i,j; - - for(i=0, j=1; j -inline -void -Mat_aux::prefix_pp(Mat< std::complex >& x) - { - x += T(1); - } - - - -//! postfix ++ -template -inline -void -Mat_aux::postfix_pp(Mat& x) - { - eT* memptr = x.memptr(); - const uword n_elem = x.n_elem; - - uword i,j; - - for(i=0, j=1; j -inline -void -Mat_aux::postfix_pp(Mat< std::complex >& x) - { - x += T(1); - } - - - -//! prefix -- -template -inline -void -Mat_aux::prefix_mm(Mat& x) - { - eT* memptr = x.memptr(); - const uword n_elem = x.n_elem; - - uword i,j; - - for(i=0, j=1; j -inline -void -Mat_aux::prefix_mm(Mat< std::complex >& x) - { - x -= T(1); - } - - - -//! postfix -- -template -inline -void -Mat_aux::postfix_mm(Mat& x) - { - eT* memptr = x.memptr(); - const uword n_elem = x.n_elem; - - uword i,j; - - for(i=0, j=1; j -inline -void -Mat_aux::postfix_mm(Mat< std::complex >& x) - { - x -= T(1); - } - - - -template -inline -void -Mat_aux::set_real(Mat& out, const Base& X) - { - arma_debug_sigprint(); - - const unwrap tmp(X.get_ref()); - const Mat& A = tmp.M; - - arma_conform_assert_same_size( out, A, "Mat::set_real()" ); - - out = A; - } - - - -template -inline -void -Mat_aux::set_imag(Mat&, const Base&) - { - arma_debug_sigprint(); - } - - - -template -inline -void -Mat_aux::set_real(Mat< std::complex >& out, const Base& X) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const Proxy P(X.get_ref()); - - const uword local_n_rows = P.get_n_rows(); - const uword local_n_cols = P.get_n_cols(); - - arma_conform_assert_same_size( out.n_rows, out.n_cols, local_n_rows, local_n_cols, "Mat::set_real()" ); - - eT* out_mem = out.memptr(); - - if(Proxy::use_at == false) - { - typedef typename Proxy::ea_type ea_type; - - ea_type A = P.get_ea(); - - const uword N = out.n_elem; - - for(uword i=0; i -inline -void -Mat_aux::set_imag(Mat< std::complex >& out, const Base& X) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const Proxy P(X.get_ref()); - - const uword local_n_rows = P.get_n_rows(); - const uword local_n_cols = P.get_n_cols(); - - arma_conform_assert_same_size( out.n_rows, out.n_cols, local_n_rows, local_n_cols, "Mat::set_imag()" ); - - eT* out_mem = out.memptr(); - - if(Proxy::use_at == false) - { - typedef typename Proxy::ea_type ea_type; - - ea_type A = P.get_ea(); - - const uword N = out.n_elem; - - for(uword i=0; i -class OpCube : public BaseCube< typename T1::elem_type, OpCube > - { - public: - - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - - inline explicit OpCube(const BaseCube& in_m); - inline OpCube(const BaseCube& in_m, const elem_type in_aux); - inline OpCube(const BaseCube& in_m, const elem_type in_aux, const uword in_aux_uword_a, const uword in_aux_uword_b, const uword in_aux_uword_c); - inline OpCube(const BaseCube& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b); - inline OpCube(const BaseCube& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b, const uword in_aux_uword_c); - inline ~OpCube(); - - arma_aligned const T1& m; //!< the operand; must be derived from BaseCube - arma_aligned elem_type aux; //!< auxiliary data, using the element type as used by T1 - arma_aligned uword aux_uword_a; //!< auxiliary data, uword format - arma_aligned uword aux_uword_b; //!< auxiliary data, uword format - arma_aligned uword aux_uword_c; //!< auxiliary data, uword format - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/OpCube_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/OpCube_meat.hpp deleted file mode 100644 index 3dc4d45e1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/OpCube_meat.hpp +++ /dev/null @@ -1,87 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup OpCube -//! @{ - - - -template -OpCube::OpCube(const BaseCube& in_m) - : m(in_m.get_ref()) - { - arma_debug_sigprint(); - } - - - -template -OpCube::OpCube(const BaseCube& in_m, const typename T1::elem_type in_aux) - : m(in_m.get_ref()) - , aux(in_aux) - { - arma_debug_sigprint(); - } - - -template -OpCube::OpCube(const BaseCube& in_m, const typename T1::elem_type in_aux, const uword in_aux_uword_a, const uword in_aux_uword_b, const uword in_aux_uword_c) - : m(in_m.get_ref()) - , aux(in_aux) - , aux_uword_a(in_aux_uword_a) - , aux_uword_b(in_aux_uword_b) - , aux_uword_c(in_aux_uword_c) - { - arma_debug_sigprint(); - } - - - - -template -OpCube::OpCube(const BaseCube& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b) - : m(in_m.get_ref()) - , aux_uword_a(in_aux_uword_a) - , aux_uword_b(in_aux_uword_b) - { - arma_debug_sigprint(); - } - - - -template -OpCube::OpCube(const BaseCube& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b, const uword in_aux_uword_c) - : m(in_m.get_ref()) - , aux_uword_a(in_aux_uword_a) - , aux_uword_b(in_aux_uword_b) - , aux_uword_c(in_aux_uword_c) - { - arma_debug_sigprint(); - } - - - -template -OpCube::~OpCube() - { - arma_debug_sigprint(); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Op_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Op_bones.hpp deleted file mode 100644 index fa8c3efd8..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Op_bones.hpp +++ /dev/null @@ -1,69 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup Op -//! @{ - - - -template -struct Op_traits {}; - - -template -struct Op_traits - { - static constexpr bool is_row = op_type::template traits::is_row; - static constexpr bool is_col = op_type::template traits::is_col; - static constexpr bool is_xvec = op_type::template traits::is_xvec; - }; - -template -struct Op_traits - { - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - }; - - -template -class Op - : public Base< typename T1::elem_type, Op > - , public Op_traits::value> - { - public: - - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - - inline explicit Op(const T1& in_m); - inline Op(const T1& in_m, const elem_type in_aux); - inline Op(const T1& in_m, const elem_type in_aux, const uword in_aux_uword_a, const uword in_aux_uword_b); - inline Op(const T1& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b); - inline ~Op(); - - arma_aligned const T1& m; //!< the operand; must be derived from Base - arma_aligned elem_type aux; //!< auxiliary data, using the element type as used by T1 - arma_aligned uword aux_uword_a; //!< auxiliary data, uword format - arma_aligned uword aux_uword_b; //!< auxiliary data, uword format - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Op_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Op_meat.hpp deleted file mode 100644 index 66fbaba6b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Op_meat.hpp +++ /dev/null @@ -1,79 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup Op -//! @{ - - - -template -inline -Op::Op(const T1& in_m) - : m(in_m) - { - arma_debug_sigprint(); - } - - - -template -inline -Op::Op(const T1& in_m, const typename T1::elem_type in_aux) - : m(in_m) - , aux(in_aux) - { - arma_debug_sigprint(); - } - - - -template -inline -Op::Op(const T1& in_m, const typename T1::elem_type in_aux, const uword in_aux_uword_a, const uword in_aux_uword_b) - : m(in_m) - , aux(in_aux) - , aux_uword_a(in_aux_uword_a) - , aux_uword_b(in_aux_uword_b) - { - arma_debug_sigprint(); - } - - - -template -inline -Op::Op(const T1& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b) - : m(in_m) - , aux_uword_a(in_aux_uword_a) - , aux_uword_b(in_aux_uword_b) - { - arma_debug_sigprint(); - } - - - -template -inline -Op::~Op() - { - arma_debug_sigprint(); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Proxy.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Proxy.hpp deleted file mode 100644 index a51580ddc..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Proxy.hpp +++ /dev/null @@ -1,2537 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup Proxy -//! @{ - - -// within each specialisation of the Proxy class: -// -// elem_type = type of the elements obtained from object Q -// pod_type = underlying type of elements if elem_type is std::complex -// stored_type = type of Q object -// ea_type = type of object that provides access to elements via operator[i] -// aligned_ea_type = type of object that provides access to elements via at_alt(i) -// -// use_at = boolean to indicate at(row,col) must be used to get elements -// use_mp = boolean to indicate OpenMP can be used while processing elements -// has_subview = boolean to indicate Q object has a subview -// -// is_row = boolean to indicate Q object can be treated a row vector -// is_col = boolean to indicate Q object can be treated a column vector -// is_xvec = boolean to indicate Q object is a vector with unknown orientation -// -// Q = object that can be unwrapped via unwrap family of classes (ie. Q must be convertible to Mat) -// -// get_n_rows() = return number of rows in Q -// get_n_cols() = return number of columns in Q -// get_n_elem() = return number of elements in Q -// -// operator[i] = linear element accessor; valid only if 'use_at' boolean is false -// at(row,col) = access elements via (row,col); valid only if 'use_at' boolean is true -// at_alt(i) = aligned linear element accessor; valid only if 'use_at' boolean is false and is_aligned() returns true -// -// get_ea() = return object that provides linear access to elements via operator[i] -// get_aligned_ea() = return object that provides linear access to elements via at_alt(i); valid only if is_aligned() returns true -// -// is_alias(X) = return true/false to indicate Q object aliases matrix X -// has_overlap(X) = return true/false to indicate Q object has overlap with subview X -// is_aligned() = return true/false to indicate Q object has aligned memory - - - -template -struct Proxy_default - { - inline Proxy_default(const T1&) - { - arma_type_check(( is_arma_type::value == false )); - } - }; - - - -template -struct Proxy_fixed - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef T1 stored_type; - typedef const elem_type* ea_type; - typedef const T1& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - static constexpr bool is_row = T1::is_row; - static constexpr bool is_col = T1::is_col; - static constexpr bool is_xvec = T1::is_xvec; - - arma_aligned const T1& Q; - - inline explicit Proxy_fixed(const T1& A) - : Q(A) - { - arma_debug_sigprint(); - } - - //// this may require T1::n_elem etc to be declared as static constexpr inline variables (C++17) - //// see also the notes in Mat::fixed - //// https://en.cppreference.com/w/cpp/language/static - //// https://en.cppreference.com/w/cpp/language/inline - // - // static constexpr uword get_n_rows() { return T1::n_rows; } - // static constexpr uword get_n_cols() { return T1::n_cols; } - // static constexpr uword get_n_elem() { return T1::n_elem; } - - arma_inline uword get_n_rows() const { return is_row ? 1 : T1::n_rows; } - arma_inline uword get_n_cols() const { return is_col ? 1 : T1::n_cols; } - arma_inline uword get_n_elem() const { return T1::n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c) const { return Q.at(r, c); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&Q) == void_ptr(&X)); } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - - arma_inline bool is_aligned() const - { - #if defined(ARMA_HAVE_ALIGNED_ATTRIBUTE) - return true; - #else - return memory::is_aligned(Q.memptr()); - #endif - } - }; - - - -template -struct Proxy_redirect {}; - -template -struct Proxy_redirect { typedef Proxy_default result; }; - -template -struct Proxy_redirect { typedef Proxy_fixed result; }; - - - -template -struct Proxy : public Proxy_redirect::value>::result - { - inline Proxy(const T1& A) - : Proxy_redirect::value>::result(A) - { - } - }; - - - -template -struct Proxy< Mat > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef Mat stored_type; - typedef const eT* ea_type; - typedef const Mat& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - arma_aligned const Mat& Q; - - inline explicit Proxy(const Mat& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c) const { return Q.at(r, c); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return (is_same_type::value) ? (void_ptr(&Q) == void_ptr(&X)) : false; } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct Proxy< Col > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef Col stored_type; - typedef const eT* ea_type; - typedef const Col& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const Col& Q; - - inline explicit Proxy(const Col& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - constexpr uword get_n_cols() const { return 1; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword) const { return Q[r]; } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return (is_same_type::value) ? (void_ptr(&Q) == void_ptr(&X)) : false; } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct Proxy< Row > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef Row stored_type; - typedef const eT* ea_type; - typedef const Row& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - static constexpr bool is_row = true; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - arma_aligned const Row& Q; - - inline explicit Proxy(const Row& A) - : Q(A) - { - arma_debug_sigprint(); - } - - constexpr uword get_n_rows() const { return 1; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword, const uword c) const { return Q[c]; } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return (is_same_type::value) ? (void_ptr(&Q) == void_ptr(&X)) : false; } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct Proxy< Gen > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef Gen stored_type; - typedef const Gen& ea_type; - typedef const Gen& aligned_ea_type; - - static constexpr bool use_at = Gen::use_at; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - static constexpr bool is_row = Gen::is_row; - static constexpr bool is_col = Gen::is_col; - static constexpr bool is_xvec = Gen::is_xvec; - - arma_aligned const Gen& Q; - - inline explicit Proxy(const Gen& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return (is_row ? 1 : Q.n_rows); } - arma_inline uword get_n_cols() const { return (is_col ? 1 : Q.n_cols); } - arma_inline uword get_n_elem() const { return (is_row ? 1 : Q.n_rows) * (is_col ? 1 : Q.n_cols); } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c) const { return Q.at(r, c); } - arma_inline elem_type at_alt (const uword i) const { return Q[i]; } - - arma_inline ea_type get_ea() const { return Q; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - template - constexpr bool has_overlap(const subview&) const { return false; } - - constexpr bool is_aligned() const { return Gen::is_simple; } - }; - - - -template -struct Proxy< eOp > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef eOp stored_type; - typedef const eOp& ea_type; - typedef const eOp& aligned_ea_type; - - static constexpr bool use_at = eOp::use_at; - static constexpr bool use_mp = eOp::use_mp; - static constexpr bool has_subview = eOp::has_subview; - - static constexpr bool is_row = eOp::is_row; - static constexpr bool is_col = eOp::is_col; - static constexpr bool is_xvec = eOp::is_xvec; - - arma_aligned const eOp& Q; - - inline explicit Proxy(const eOp& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return is_row ? 1 : Q.get_n_rows(); } - arma_inline uword get_n_cols() const { return is_col ? 1 : Q.get_n_cols(); } - arma_inline uword get_n_elem() const { return Q.get_n_elem(); } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c) const { return Q.at(r, c); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return Q.P.is_alias(X); } - - template - arma_inline bool has_overlap(const subview& X) const { return Q.P.has_overlap(X); } - - arma_inline bool is_aligned() const { return Q.P.is_aligned(); } - }; - - - -template -struct Proxy< eGlue > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef eGlue stored_type; - typedef const eGlue& ea_type; - typedef const eGlue& aligned_ea_type; - - static constexpr bool use_at = eGlue::use_at; - static constexpr bool use_mp = eGlue::use_mp; - static constexpr bool has_subview = eGlue::has_subview; - - static constexpr bool is_row = eGlue::is_row; - static constexpr bool is_col = eGlue::is_col; - static constexpr bool is_xvec = eGlue::is_xvec; - - arma_aligned const eGlue& Q; - - inline explicit Proxy(const eGlue& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return is_row ? 1 : Q.get_n_rows(); } - arma_inline uword get_n_cols() const { return is_col ? 1 : Q.get_n_cols(); } - arma_inline uword get_n_elem() const { return Q.get_n_elem(); } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c) const { return Q.at(r, c); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return (Q.P1.is_alias(X) || Q.P2.is_alias(X)); } - - template - arma_inline bool has_overlap(const subview& X) const { return (Q.P1.has_overlap(X) || Q.P2.has_overlap(X)); } - - arma_inline bool is_aligned() const { return (Q.P1.is_aligned() && Q.P2.is_aligned()); } - }; - - - -template -struct Proxy< Op > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef Mat stored_type; - typedef const elem_type* ea_type; - typedef const Mat& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - static constexpr bool is_row = Op::is_row; - static constexpr bool is_col = Op::is_col; - static constexpr bool is_xvec = Op::is_xvec; - - arma_aligned const Mat Q; - - inline explicit Proxy(const Op& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return is_row ? 1 : Q.n_rows; } - arma_inline uword get_n_cols() const { return is_col ? 1 : Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c) const { return Q.at(r, c); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - template - constexpr bool has_overlap(const subview&) const { return false; } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct Proxy< Glue > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef Mat stored_type; - typedef const elem_type* ea_type; - typedef const Mat& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - static constexpr bool is_row = Glue::is_row; - static constexpr bool is_col = Glue::is_col; - static constexpr bool is_xvec = Glue::is_xvec; - - arma_aligned const Mat Q; - - inline explicit Proxy(const Glue& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return is_row ? 1 : Q.n_rows; } - arma_inline uword get_n_cols() const { return is_col ? 1 : Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c) const { return Q.at(r, c); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - template - constexpr bool has_overlap(const subview&) const { return false; } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct Proxy< Glue > - { - typedef Glue this_Glue_type; - typedef Proxy< Glue > this_Proxy_type; - - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef this_Glue_type stored_type; - typedef const this_Proxy_type& ea_type; - typedef const this_Proxy_type& aligned_ea_type; - - static constexpr bool use_at = (Proxy::use_at || Proxy::use_at ); - static constexpr bool use_mp = (Proxy::use_mp || Proxy::use_mp ); - static constexpr bool has_subview = (Proxy::has_subview || Proxy::has_subview); - - static constexpr bool is_row = this_Glue_type::is_row; - static constexpr bool is_col = this_Glue_type::is_col; - static constexpr bool is_xvec = this_Glue_type::is_xvec; - - arma_aligned const this_Glue_type& Q; - arma_aligned const Proxy P1; - arma_aligned const Proxy P2; - - arma_lt_comparator comparator; - - inline explicit Proxy(const this_Glue_type& X) - : Q (X ) - , P1(X.A) - , P2(X.B) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(P1, P2, "element-wise min()"); - } - - arma_inline uword get_n_rows() const { return is_row ? 1 : P1.get_n_rows(); } - arma_inline uword get_n_cols() const { return is_col ? 1 : P1.get_n_cols(); } - arma_inline uword get_n_elem() const { return P1.get_n_elem(); } - - arma_inline elem_type operator[] (const uword i) const { const elem_type A = P1[i]; const elem_type B = P2[i]; return comparator(A,B) ? A : B; } - arma_inline elem_type at (const uword r, const uword c) const { const elem_type A = P1.at(r,c); const elem_type B = P2.at(r,c); return comparator(A,B) ? A : B; } - arma_inline elem_type at_alt (const uword i) const { const elem_type A = P1.at_alt(i); const elem_type B = P2.at_alt(i); return comparator(A,B) ? A : B; } - - arma_inline ea_type get_ea() const { return *this; } - arma_inline aligned_ea_type get_aligned_ea() const { return *this; } - - template - arma_inline bool is_alias(const Mat& X) const { return (P1.is_alias(X) || P2.is_alias(X)); } - - template - arma_inline bool has_overlap(const subview& X) const { return (P1.has_overlap(X) || P2.has_overlap(X)); } - - arma_inline bool is_aligned() const { return (P1.is_aligned() && P2.is_aligned()); } - }; - - - -template -struct Proxy< Glue > - { - typedef Glue this_Glue_type; - typedef Proxy< Glue > this_Proxy_type; - - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef this_Glue_type stored_type; - typedef const this_Proxy_type& ea_type; - typedef const this_Proxy_type& aligned_ea_type; - - static constexpr bool use_at = (Proxy::use_at || Proxy::use_at ); - static constexpr bool use_mp = (Proxy::use_mp || Proxy::use_mp ); - static constexpr bool has_subview = (Proxy::has_subview || Proxy::has_subview); - - static constexpr bool is_row = this_Glue_type::is_row; - static constexpr bool is_col = this_Glue_type::is_col; - static constexpr bool is_xvec = this_Glue_type::is_xvec; - - arma_aligned const this_Glue_type& Q; - arma_aligned const Proxy P1; - arma_aligned const Proxy P2; - - arma_gt_comparator comparator; - - inline explicit Proxy(const this_Glue_type& X) - : Q (X ) - , P1(X.A) - , P2(X.B) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(P1, P2, "element-wise max()"); - } - - arma_inline uword get_n_rows() const { return is_row ? 1 : P1.get_n_rows(); } - arma_inline uword get_n_cols() const { return is_col ? 1 : P1.get_n_cols(); } - arma_inline uword get_n_elem() const { return P1.get_n_elem(); } - - arma_inline elem_type operator[] (const uword i) const { const elem_type A = P1[i]; const elem_type B = P2[i]; return comparator(A,B) ? A : B; } - arma_inline elem_type at (const uword r, const uword c) const { const elem_type A = P1.at(r,c); const elem_type B = P2.at(r,c); return comparator(A,B) ? A : B; } - arma_inline elem_type at_alt (const uword i) const { const elem_type A = P1.at_alt(i); const elem_type B = P2.at_alt(i); return comparator(A,B) ? A : B; } - - arma_inline ea_type get_ea() const { return *this; } - arma_inline aligned_ea_type get_aligned_ea() const { return *this; } - - template - arma_inline bool is_alias(const Mat& X) const { return (P1.is_alias(X) || P2.is_alias(X)); } - - template - arma_inline bool has_overlap(const subview& X) const { return (P1.has_overlap(X) || P2.has_overlap(X)); } - - arma_inline bool is_aligned() const { return (P1.is_aligned() && P2.is_aligned()); } - }; - - - -template -struct Proxy< mtOp > - { - typedef out_eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef Mat stored_type; - typedef const elem_type* ea_type; - typedef const Mat& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - static constexpr bool is_row = mtOp::is_row; - static constexpr bool is_col = mtOp::is_col; - static constexpr bool is_xvec = mtOp::is_xvec; - - arma_aligned const Mat Q; - - inline explicit Proxy(const mtOp& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return is_row ? 1 : Q.n_rows; } - arma_inline uword get_n_cols() const { return is_col ? 1 : Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c) const { return Q.at(r,c); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - template - constexpr bool has_overlap(const subview&) const { return false; } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct Proxy< mtGlue > - { - typedef out_eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef Mat stored_type; - typedef const elem_type* ea_type; - typedef const Mat& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - static constexpr bool is_row = mtGlue::is_row; - static constexpr bool is_col = mtGlue::is_col; - static constexpr bool is_xvec = mtGlue::is_xvec; - - arma_aligned const Mat Q; - - inline explicit Proxy(const mtGlue& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return is_row ? 1 : Q.n_rows; } - arma_inline uword get_n_cols() const { return is_col ? 1 : Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c) const { return Q.at(r,c); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - template - constexpr bool has_overlap(const subview&) const { return false; } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct Proxy< CubeToMatOp > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef Mat stored_type; - typedef const elem_type* ea_type; - typedef const Mat& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - static constexpr bool is_row = CubeToMatOp::is_row; - static constexpr bool is_col = CubeToMatOp::is_col; - static constexpr bool is_xvec = CubeToMatOp::is_xvec; - - arma_aligned const Mat Q; - - inline explicit Proxy(const CubeToMatOp& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return is_row ? 1 : Q.n_rows; } - arma_inline uword get_n_cols() const { return is_col ? 1 : Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c) const { return Q.at(r, c); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - template - constexpr bool has_overlap(const subview&) const { return false; } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct Proxy< CubeToMatOp > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef Mat stored_type; - typedef const elem_type* ea_type; - typedef const Mat& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = true; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const unwrap_cube U; - arma_aligned const Mat Q; - - inline explicit Proxy(const CubeToMatOp& A) - : U(A.m) - , Q(const_cast(U.M.memptr()), U.M.n_elem, 1, false, true) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - constexpr uword get_n_cols() const { return 1; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword) const { return Q[r]; } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - template - constexpr bool has_overlap(const subview&) const { return false; } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct Proxy< SpToDOp > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef Mat stored_type; - typedef const elem_type* ea_type; - typedef const Mat& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - static constexpr bool is_row = SpToDOp::is_row; - static constexpr bool is_col = SpToDOp::is_col; - static constexpr bool is_xvec = SpToDOp::is_xvec; - - arma_aligned const Mat Q; - - inline explicit Proxy(const SpToDOp& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return is_row ? 1 : Q.n_rows; } - arma_inline uword get_n_cols() const { return is_col ? 1 : Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c) const { return Q.at(r, c); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - template - constexpr bool has_overlap(const subview&) const { return false; } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct Proxy< SpToDOp, op_sp_nonzeros> > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef Mat stored_type; - typedef const elem_type* ea_type; - typedef const Mat& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = true; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const SpMat& R; - arma_aligned const Mat Q; - - inline explicit Proxy(const SpToDOp, op_sp_nonzeros>& A) - : R(A.m) - , Q(const_cast(R.values), R.n_nonzero, 1, false, true) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - constexpr uword get_n_cols() const { return 1; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword) const { return Q[r]; } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - template - constexpr bool has_overlap(const subview&) const { return false; } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct Proxy< SpToDGlue > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef Mat stored_type; - typedef const elem_type* ea_type; - typedef const Mat& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - static constexpr bool is_row = SpToDGlue::is_row; - static constexpr bool is_col = SpToDGlue::is_col; - static constexpr bool is_xvec = SpToDGlue::is_xvec; - - arma_aligned const Mat Q; - - inline explicit Proxy(const SpToDGlue& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return is_row ? 1 : Q.n_rows; } - arma_inline uword get_n_cols() const { return is_col ? 1 : Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c) const { return Q.at(r, c); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - template - constexpr bool has_overlap(const subview&) const { return false; } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct Proxy< subview > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef subview stored_type; - typedef const subview& ea_type; - typedef const subview& aligned_ea_type; - - static constexpr bool use_at = true; - static constexpr bool use_mp = false; - static constexpr bool has_subview = true; - - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - arma_aligned const subview& Q; - - inline explicit Proxy(const subview& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c) const { return Q.at(r, c); } - arma_inline elem_type at_alt (const uword i) const { return Q[i]; } - - arma_inline ea_type get_ea() const { return Q; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return (is_same_type::value) ? (void_ptr(&(Q.m)) == void_ptr(&X)) : false; } - - template - arma_inline bool has_overlap(const subview& X) const { return Q.check_overlap(X); } - - constexpr bool is_aligned() const { return false; } - }; - - - -template -struct Proxy< subview_col > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef subview_col stored_type; - typedef const eT* ea_type; - typedef const subview_col& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = true; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const subview_col& Q; - - inline explicit Proxy(const subview_col& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - constexpr uword get_n_cols() const { return 1; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword) const { return Q[r]; } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.colmem; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return (is_same_type::value) ? (void_ptr(&(Q.m)) == void_ptr(&X)) : false; } - - template - arma_inline bool has_overlap(const subview& X) const { return Q.check_overlap(X); } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.colmem); } - }; - - - -template -struct Proxy< subview_cols > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef Mat stored_type; - typedef const eT* ea_type; - typedef const Mat& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = true; - - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - arma_aligned const subview_cols& sv; - arma_aligned const Mat Q; - - inline explicit Proxy(const subview_cols& A) - : sv(A) - , Q ( const_cast( A.colptr(0) ), A.n_rows, A.n_cols, false, false ) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c) const { return Q.at(r,c); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return (is_same_type::value) ? (void_ptr(&(sv.m)) == void_ptr(&X)) : false; } - - template - arma_inline bool has_overlap(const subview& X) const { return sv.check_overlap(X); } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct Proxy< subview_row > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef subview_row stored_type; - typedef const subview_row& ea_type; - typedef const subview_row& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = true; - - static constexpr bool is_row = true; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - arma_aligned const subview_row& Q; - - inline explicit Proxy(const subview_row& A) - : Q(A) - { - arma_debug_sigprint(); - } - - constexpr uword get_n_rows() const { return 1; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword, const uword c) const { return Q[c]; } - arma_inline elem_type at_alt (const uword i) const { return Q[i]; } - - arma_inline ea_type get_ea() const { return Q; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return (is_same_type::value) ? (void_ptr(&(Q.m)) == void_ptr(&X)) : false; } - - template - arma_inline bool has_overlap(const subview& X) const { return Q.check_overlap(X); } - - constexpr bool is_aligned() const { return false; } - }; - - - -template -struct Proxy< subview_elem1 > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef subview_elem1 stored_type; - typedef const Proxy< subview_elem1 >& ea_type; - typedef const Proxy< subview_elem1 >& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = true; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const subview_elem1& Q; - arma_aligned const Proxy R; - - inline explicit Proxy(const subview_elem1& A) - : Q(A) - , R(A.a.get_ref()) - { - arma_debug_sigprint(); - - const bool R_is_vec = ((R.get_n_rows() == 1) || (R.get_n_cols() == 1)); - const bool R_is_empty = (R.get_n_elem() == 0); - - arma_conform_check( ((R_is_vec == false) && (R_is_empty == false)), "Mat::elem(): given object must be a vector" ); - } - - arma_inline uword get_n_rows() const { return R.get_n_elem(); } - constexpr uword get_n_cols() const { return 1; } - arma_inline uword get_n_elem() const { return R.get_n_elem(); } - - arma_inline elem_type operator[] (const uword i) const { const uword ii = (Proxy::use_at) ? R.at(i,0) : R[i]; arma_conform_check_bounds( (ii >= Q.m.n_elem), "Mat::elem(): index out of bounds" ); return Q.m[ii]; } - arma_inline elem_type at (const uword r, const uword) const { const uword ii = (Proxy::use_at) ? R.at(r,0) : R[r]; arma_conform_check_bounds( (ii >= Q.m.n_elem), "Mat::elem(): index out of bounds" ); return Q.m[ii]; } - arma_inline elem_type at_alt (const uword i) const { const uword ii = (Proxy::use_at) ? R.at(i,0) : R[i]; arma_conform_check_bounds( (ii >= Q.m.n_elem), "Mat::elem(): index out of bounds" ); return Q.m[ii]; } - - arma_inline ea_type get_ea() const { return (*this); } - arma_inline aligned_ea_type get_aligned_ea() const { return (*this); } - - template - arma_inline bool is_alias(const Mat& X) const { return ( (void_ptr(&X) == void_ptr(&(Q.m))) || (R.is_alias(X)) ); } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - - constexpr bool is_aligned() const { return false; } - }; - - - -template -struct Proxy< subview_elem2 > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef Mat stored_type; - typedef const eT* ea_type; - typedef const Mat& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - arma_aligned const Mat Q; - - inline explicit Proxy(const subview_elem2& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c) const { return Q.at(r, c); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - template - constexpr bool has_overlap(const subview&) const { return false; } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct Proxy< diagview > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef diagview stored_type; - typedef const diagview& ea_type; - typedef const diagview& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = true; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const diagview& Q; - - inline explicit Proxy(const diagview& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - constexpr uword get_n_cols() const { return 1; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword) const { return Q.at(r, 0); } - arma_inline elem_type at_alt (const uword i) const { return Q[i]; } - - arma_inline ea_type get_ea() const { return Q; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return (is_same_type::value) ? (void_ptr(&(Q.m)) == void_ptr(&X)) : false; } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - - constexpr bool is_aligned() const { return false; } - }; - - - -template -struct Proxy_diagvec_mat - { - inline Proxy_diagvec_mat(const T1&) {} - }; - - - -template -struct Proxy_diagvec_mat< Op > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef diagview stored_type; - typedef const diagview& ea_type; - typedef const diagview& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = true; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const Mat& R; - arma_aligned const diagview Q; - - inline explicit Proxy_diagvec_mat(const Op& A) - : R(A.m), Q( R.diag() ) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - constexpr uword get_n_cols() const { return 1; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword) const { return Q.at(r, 0); } - arma_inline elem_type at_alt (const uword i) const { return Q[i]; } - - arma_inline ea_type get_ea() const { return Q; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&R) == void_ptr(&X)); } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - - constexpr bool is_aligned() const { return false; } - }; - - - -template -struct Proxy_diagvec_expr - { - inline Proxy_diagvec_expr(const T1&) {} - }; - - - -template -struct Proxy_diagvec_expr< Op > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef Mat stored_type; - typedef const elem_type* ea_type; - typedef const Mat& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const Mat Q; - - inline explicit Proxy_diagvec_expr(const Op& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - constexpr uword get_n_cols() const { return 1; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword) const { return Q.at(r, 0); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - template - constexpr bool has_overlap(const subview&) const { return false; } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct Proxy_diagvec_redirect {}; - -template -struct Proxy_diagvec_redirect< Op, true > { typedef Proxy_diagvec_mat < Op > result; }; - -template -struct Proxy_diagvec_redirect< Op, false> { typedef Proxy_diagvec_expr< Op > result; }; - - - -template -struct Proxy< Op > - : public Proxy_diagvec_redirect< Op, is_Mat::value >::result - { - typedef typename Proxy_diagvec_redirect< Op, is_Mat::value >::result Proxy_diagvec; - - inline explicit Proxy(const Op& A) - : Proxy_diagvec(A) - { - arma_debug_sigprint(); - } - }; - - - -template -struct Proxy< Op > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef Mat stored_type; - typedef const elem_type* ea_type; - typedef const Mat& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const Mat Q; - - inline explicit Proxy(const Op& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - constexpr uword get_n_cols() const { return 1; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword) const { return Q.at(r, 0); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - template - constexpr bool has_overlap(const subview&) const { return false; } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct Proxy_xtrans_default - { - inline Proxy_xtrans_default(const T1&) {} - }; - - - -template -struct Proxy_xtrans_default< Op > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef xtrans_mat stored_type; - typedef const xtrans_mat& ea_type; - typedef const xtrans_mat& aligned_ea_type; - - static constexpr bool use_at = true; - static constexpr bool use_mp = false; - static constexpr bool has_subview = true; - - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - const unwrap U; - const xtrans_mat Q; - - inline explicit Proxy_xtrans_default(const Op& A) - : U(A.m) - , Q(U.M) - { - arma_debug_sigprint(); - } - - arma_inline ea_type get_ea() const { return Q; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return void_ptr(&(U.M)) == void_ptr(&X); } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - - constexpr bool is_aligned() const { return false; } - }; - - - -template -struct Proxy_xtrans_default< Op > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef xtrans_mat stored_type; - typedef const xtrans_mat& ea_type; - typedef const xtrans_mat& aligned_ea_type; - - static constexpr bool use_at = true; - static constexpr bool use_mp = false; - static constexpr bool has_subview = true; - - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - const unwrap U; - const xtrans_mat Q; - - inline explicit Proxy_xtrans_default(const Op& A) - : U(A.m) - , Q(U.M) - { - arma_debug_sigprint(); - } - - arma_inline ea_type get_ea() const { return Q; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return void_ptr(&(U.M)) == void_ptr(&X); } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - - constexpr bool is_aligned() const { return false; } - }; - - - -template -struct Proxy_xtrans_vector - { - inline Proxy_xtrans_vector(const T1&) {} - }; - - - -template -struct Proxy_xtrans_vector< Op > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef Mat stored_type; - typedef const elem_type* ea_type; - typedef const Mat& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = quasi_unwrap::has_subview; - - // NOTE: the Op class takes care of swapping row and col for op_htrans - static constexpr bool is_row = Op::is_row; - static constexpr bool is_col = Op::is_col; - static constexpr bool is_xvec = Op::is_xvec; - - arma_aligned const quasi_unwrap U; // avoid copy if T1 is a Row, Col or subview_col - arma_aligned const Mat Q; - - inline Proxy_xtrans_vector(const Op& A) - : U(A.m) - , Q(const_cast(U.M.memptr()), U.M.n_cols, U.M.n_rows, false, false) - { - arma_debug_sigprint(); - } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return U.is_alias(X); } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct Proxy_xtrans_vector< Op > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef Mat stored_type; - typedef const elem_type* ea_type; - typedef const Mat& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = quasi_unwrap::has_subview; - - // NOTE: the Op class takes care of swapping row and col for op_strans - static constexpr bool is_row = Op::is_row; - static constexpr bool is_col = Op::is_col; - static constexpr bool is_xvec = Op::is_xvec; - - arma_aligned const quasi_unwrap U; // avoid copy if T1 is a Row, Col or subview_col - arma_aligned const Mat Q; - - inline Proxy_xtrans_vector(const Op& A) - : U(A.m) - , Q(const_cast(U.M.memptr()), U.M.n_cols, U.M.n_rows, false, false) - { - arma_debug_sigprint(); - } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return U.is_alias(X); } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct Proxy_xtrans_redirect {}; - -template -struct Proxy_xtrans_redirect { typedef Proxy_xtrans_default result; }; - -template -struct Proxy_xtrans_redirect { typedef Proxy_xtrans_vector result; }; - - - -template -struct Proxy< Op > - : public - Proxy_xtrans_redirect - < - Op, - ((is_cx::no) && ((Op::is_row) || (Op::is_col)) ) - >::result - { - typedef - typename - Proxy_xtrans_redirect - < - Op, - ((is_cx::no) && ((Op::is_row) || (Op::is_col)) ) - >::result - Proxy_xtrans; - - typedef typename Proxy_xtrans::elem_type elem_type; - typedef typename Proxy_xtrans::pod_type pod_type; - typedef typename Proxy_xtrans::stored_type stored_type; - typedef typename Proxy_xtrans::ea_type ea_type; - typedef typename Proxy_xtrans::aligned_ea_type aligned_ea_type; - - static constexpr bool use_at = Proxy_xtrans::use_at; - static constexpr bool use_mp = Proxy_xtrans::use_mp; - static constexpr bool has_subview = Proxy_xtrans::has_subview; - - static constexpr bool is_row = Proxy_xtrans::is_row; - static constexpr bool is_col = Proxy_xtrans::is_col; - static constexpr bool is_xvec = Proxy_xtrans::is_xvec; - - using Proxy_xtrans::Q; - - inline explicit Proxy(const Op& A) - : Proxy_xtrans(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return is_row ? 1 : Q.n_rows; } - arma_inline uword get_n_cols() const { return is_col ? 1 : Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c) const { return Q.at(r, c); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Proxy_xtrans::get_ea(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Proxy_xtrans::get_aligned_ea(); } - - template - arma_inline bool is_alias(const Mat& X) const { return Proxy_xtrans::is_alias(X); } - - template - arma_inline bool has_overlap(const subview& X) const { return Proxy_xtrans::has_overlap(X); } - - arma_inline bool is_aligned() const { return Proxy_xtrans::is_aligned(); } - }; - - - -template -struct Proxy< Op > - : public - Proxy_xtrans_redirect - < - Op, - ( (Op::is_row) || (Op::is_col) ) - >::result - { - typedef - typename - Proxy_xtrans_redirect - < - Op, - ( (Op::is_row) || (Op::is_col) ) - >::result - Proxy_xtrans; - - typedef typename Proxy_xtrans::elem_type elem_type; - typedef typename Proxy_xtrans::pod_type pod_type; - typedef typename Proxy_xtrans::stored_type stored_type; - typedef typename Proxy_xtrans::ea_type ea_type; - typedef typename Proxy_xtrans::aligned_ea_type aligned_ea_type; - - static constexpr bool use_at = Proxy_xtrans::use_at; - static constexpr bool use_mp = Proxy_xtrans::use_mp; - static constexpr bool has_subview = Proxy_xtrans::has_subview; - - static constexpr bool is_row = Proxy_xtrans::is_row; - static constexpr bool is_col = Proxy_xtrans::is_col; - static constexpr bool is_xvec = Proxy_xtrans::is_xvec; - - using Proxy_xtrans::Q; - - inline explicit Proxy(const Op& A) - : Proxy_xtrans(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return is_row ? 1 : Q.n_rows; } - arma_inline uword get_n_cols() const { return is_col ? 1 : Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c) const { return Q.at(r, c); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Proxy_xtrans::get_ea(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Proxy_xtrans::get_aligned_ea(); } - - template - arma_inline bool is_alias(const Mat& X) const { return Proxy_xtrans::is_alias(X); } - - template - arma_inline bool has_overlap(const subview& X) const { return Proxy_xtrans::has_overlap(X); } - - arma_inline bool is_aligned() const { return Proxy_xtrans::is_aligned(); } - }; - - - -template -struct Proxy_subview_row_htrans_cx - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef subview_row_htrans stored_type; - typedef const subview_row_htrans& ea_type; - typedef const subview_row_htrans& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = true; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const subview_row_htrans Q; - - inline explicit Proxy_subview_row_htrans_cx(const Op, op_htrans>& A) - : Q(A.m) - { - arma_debug_sigprint(); - } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&(Q.sv_row.m)) == void_ptr(&X)); } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - }; - - - -template -struct Proxy_subview_row_htrans_non_cx - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef subview_row_strans stored_type; - typedef const subview_row_strans& ea_type; - typedef const subview_row_strans& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = true; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const subview_row_strans Q; - - inline explicit Proxy_subview_row_htrans_non_cx(const Op, op_htrans>& A) - : Q(A.m) - { - arma_debug_sigprint(); - } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&(Q.sv_row.m)) == void_ptr(&X)); } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - }; - - - -template -struct Proxy_subview_row_htrans_redirect {}; - -template -struct Proxy_subview_row_htrans_redirect { typedef Proxy_subview_row_htrans_cx result; }; - -template -struct Proxy_subview_row_htrans_redirect { typedef Proxy_subview_row_htrans_non_cx result; }; - - - -template -struct Proxy< Op, op_htrans> > - : public - Proxy_subview_row_htrans_redirect - < - eT, - is_cx::yes - >::result - { - typedef - typename - Proxy_subview_row_htrans_redirect - < - eT, - is_cx::yes - >::result - Proxy_sv_row_ht; - - typedef typename Proxy_sv_row_ht::elem_type elem_type; - typedef typename Proxy_sv_row_ht::pod_type pod_type; - typedef typename Proxy_sv_row_ht::stored_type stored_type; - typedef typename Proxy_sv_row_ht::ea_type ea_type; - typedef typename Proxy_sv_row_ht::ea_type aligned_ea_type; - - static constexpr bool use_at = Proxy_sv_row_ht::use_at; - static constexpr bool use_mp = Proxy_sv_row_ht::use_mp; - static constexpr bool has_subview = Proxy_sv_row_ht::has_subview; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - using Proxy_sv_row_ht::Q; - - inline explicit Proxy(const Op, op_htrans>& A) - : Proxy_sv_row_ht(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - constexpr uword get_n_cols() const { return 1; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword) const { return Q[r]; } - arma_inline elem_type at_alt (const uword i) const { return Q[i]; } - - arma_inline ea_type get_ea() const { return Q; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return Proxy_sv_row_ht::is_alias(X); } - - template - arma_inline bool has_overlap(const subview& X) const { return Proxy_sv_row_ht::has_overlap(X); } - - constexpr bool is_aligned() const { return false; } - }; - - - -template -struct Proxy< Op, op_strans> > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef subview_row_strans stored_type; - typedef const subview_row_strans& ea_type; - typedef const subview_row_strans& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = true; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const subview_row_strans Q; - - inline explicit Proxy(const Op, op_strans>& A) - : Q(A.m) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - constexpr uword get_n_cols() const { return 1; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword) const { return Q[r]; } - arma_inline elem_type at_alt (const uword i) const { return Q[i]; } - - arma_inline ea_type get_ea() const { return Q; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&(Q.sv_row.m)) == void_ptr(&X)); } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - - constexpr bool is_aligned() const { return false; } - }; - - - -template -struct Proxy< Op< Row< std::complex >, op_htrans> > - { - typedef typename std::complex eT; - - typedef typename std::complex elem_type; - typedef T pod_type; - typedef xvec_htrans stored_type; - typedef const xvec_htrans& ea_type; - typedef const xvec_htrans& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - const xvec_htrans Q; - const Row& src; - - inline explicit Proxy(const Op< Row< std::complex >, op_htrans>& A) - : Q (A.m.memptr(), A.m.n_rows, A.m.n_cols) - , src(A.m) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - constexpr uword get_n_cols() const { return 1; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword) const { return Q[r]; } - arma_inline elem_type at_alt (const uword i) const { return Q[i]; } - - arma_inline ea_type get_ea() const { return Q; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return void_ptr(&src) == void_ptr(&X); } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - - constexpr bool is_aligned() const { return false; } - }; - - - -template -struct Proxy< Op< Col< std::complex >, op_htrans> > - { - typedef typename std::complex eT; - - typedef typename std::complex elem_type; - typedef T pod_type; - typedef xvec_htrans stored_type; - typedef const xvec_htrans& ea_type; - typedef const xvec_htrans& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - static constexpr bool is_row = true; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - const xvec_htrans Q; - const Col& src; - - inline explicit Proxy(const Op< Col< std::complex >, op_htrans>& A) - : Q (A.m.memptr(), A.m.n_rows, A.m.n_cols) - , src(A.m) - { - arma_debug_sigprint(); - } - - constexpr uword get_n_rows() const { return 1; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword, const uword c) const { return Q[c]; } - arma_inline elem_type at_alt (const uword i) const { return Q[i]; } - - arma_inline ea_type get_ea() const { return Q; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return void_ptr(&src) == void_ptr(&X); } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - - constexpr bool is_aligned() const { return false; } - }; - - - -template -struct Proxy< Op< subview_col< std::complex >, op_htrans> > - { - typedef typename std::complex eT; - - typedef typename std::complex elem_type; - typedef T pod_type; - typedef xvec_htrans stored_type; - typedef const xvec_htrans& ea_type; - typedef const xvec_htrans& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = true; - - static constexpr bool is_row = true; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - const xvec_htrans Q; - const subview_col& src; - - inline explicit Proxy(const Op< subview_col< std::complex >, op_htrans>& A) - : Q (A.m.colptr(0), A.m.n_rows, A.m.n_cols) - , src(A.m) - { - arma_debug_sigprint(); - } - - constexpr uword get_n_rows() const { return 1; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword, const uword c) const { return Q[c]; } - arma_inline elem_type at_alt (const uword i) const { return Q[i]; } - - arma_inline ea_type get_ea() const { return Q; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return void_ptr(&src.m) == void_ptr(&X); } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - - constexpr bool is_aligned() const { return false; } - }; - - - -template -struct Proxy< Op > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef eOp< Op, eop_scalar_times> stored_type; - typedef const eOp< Op, eop_scalar_times>& ea_type; - typedef const eOp< Op, eop_scalar_times>& aligned_ea_type; - - static constexpr bool use_at = eOp< Op, eop_scalar_times>::use_at; - static constexpr bool use_mp = eOp< Op, eop_scalar_times>::use_mp; - static constexpr bool has_subview = eOp< Op, eop_scalar_times>::has_subview; - - // NOTE: the Op class takes care of swapping row and col for op_htrans - static constexpr bool is_row = eOp< Op, eop_scalar_times>::is_row; - static constexpr bool is_col = eOp< Op, eop_scalar_times>::is_col; - static constexpr bool is_xvec = eOp< Op, eop_scalar_times>::is_xvec; - - arma_aligned const Op R; - arma_aligned const eOp< Op, eop_scalar_times > Q; - - inline explicit Proxy(const Op& A) - : R(A.m) - , Q(R, A.aux) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return is_row ? 1 : Q.get_n_rows(); } - arma_inline uword get_n_cols() const { return is_col ? 1 : Q.get_n_cols(); } - arma_inline uword get_n_elem() const { return Q.get_n_elem(); } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c) const { return Q.at(r, c); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return Q.P.is_alias(X); } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - - arma_inline bool is_aligned() const { return Q.P.is_aligned(); } - }; - - - -template -struct Proxy< subview_row_strans > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef subview_row_strans stored_type; - typedef const subview_row_strans& ea_type; - typedef const subview_row_strans& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = true; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const subview_row_strans& Q; - - inline explicit Proxy(const subview_row_strans& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - constexpr uword get_n_cols() const { return 1; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword) const { return Q[r]; } - arma_inline elem_type at_alt (const uword i) const { return Q[i]; } - - arma_inline ea_type get_ea() const { return Q; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&(Q.sv_row.m)) == void_ptr(&X)); } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - - constexpr bool is_aligned() const { return false; } - }; - - - -template -struct Proxy< subview_row_htrans > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef subview_row_htrans stored_type; - typedef const subview_row_htrans& ea_type; - typedef const subview_row_htrans& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = true; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const subview_row_htrans& Q; - - inline explicit Proxy(const subview_row_htrans& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - constexpr uword get_n_cols() const { return 1; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword) const { return Q[r]; } - arma_inline elem_type at_alt (const uword i) const { return Q[i]; } - - arma_inline ea_type get_ea() const { return Q; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&(Q.sv_row.m)) == void_ptr(&X)); } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - - constexpr bool is_aligned() const { return false; } - }; - - - -template -struct Proxy< xtrans_mat > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef Mat stored_type; - typedef const eT* ea_type; - typedef const Mat& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - arma_aligned const Mat Q; - - inline explicit Proxy(const xtrans_mat& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c) const { return Q.at(r,c); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - template - constexpr bool has_overlap(const subview&) const { return false; } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct Proxy< xvec_htrans > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef Mat stored_type; - typedef const eT* ea_type; - typedef const Mat& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = true; - - arma_aligned const Mat Q; - - inline explicit Proxy(const xvec_htrans& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c) const { return Q.at(r,c); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - template - constexpr bool has_overlap(const subview&) const { return false; } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct Proxy_vectorise_col_mat - { - inline Proxy_vectorise_col_mat(const T1&) {} - }; - - - -template -struct Proxy_vectorise_col_mat< Op > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef Mat stored_type; - typedef const elem_type* ea_type; - typedef const Mat& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = true; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const unwrap U; - arma_aligned const Mat Q; - - inline explicit Proxy_vectorise_col_mat(const Op& A) - : U(A.m) - , Q(const_cast(U.M.memptr()), U.M.n_elem, 1, false, false) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - constexpr uword get_n_cols() const { return 1; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword) const { return Q[r]; } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Mat& X) const { return ( void_ptr(&X) == void_ptr(&(U.M)) ); } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct Proxy_vectorise_col_expr - { - inline Proxy_vectorise_col_expr(const T1&) {} - }; - - - -template -struct Proxy_vectorise_col_expr< Op > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef Op stored_type; - typedef typename Proxy::ea_type ea_type; - typedef typename Proxy::aligned_ea_type aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = Proxy::use_mp; - static constexpr bool has_subview = Proxy::has_subview; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const Op& Q; - arma_aligned const Proxy R; - - inline explicit Proxy_vectorise_col_expr(const Op& A) - : Q(A) - , R(A.m) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return R.get_n_elem(); } - constexpr uword get_n_cols() const { return 1; } - arma_inline uword get_n_elem() const { return R.get_n_elem(); } - - arma_inline elem_type operator[] (const uword i) const { return R[i]; } - arma_inline elem_type at (const uword r, const uword) const { return R.at(r, 0); } - arma_inline elem_type at_alt (const uword i) const { return R.at_alt(i); } - - arma_inline ea_type get_ea() const { return R.get_ea(); } - arma_inline aligned_ea_type get_aligned_ea() const { return R.get_aligned_ea(); } - - template - arma_inline bool is_alias(const Mat& X) const { return R.is_alias(X); } - - template - arma_inline bool has_overlap(const subview& X) const { return is_alias(X.m); } - - arma_inline bool is_aligned() const { return R.is_aligned(); } - }; - - - -template -struct Proxy_vectorise_col_redirect {}; - -template -struct Proxy_vectorise_col_redirect< Op, true > { typedef Proxy_vectorise_col_mat < Op > result; }; - -template -struct Proxy_vectorise_col_redirect< Op, false> { typedef Proxy_vectorise_col_expr< Op > result; }; - - - -template -struct Proxy< Op > - : public Proxy_vectorise_col_redirect< Op, (Proxy::use_at) >::result - { - typedef typename Proxy_vectorise_col_redirect< Op, (Proxy::use_at) >::result Proxy_vectorise_col; - - inline explicit Proxy(const Op& A) - : Proxy_vectorise_col(A) - { - arma_debug_sigprint(); - } - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/ProxyCube.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/ProxyCube.hpp deleted file mode 100644 index 7f7cc0e0d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/ProxyCube.hpp +++ /dev/null @@ -1,488 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup ProxyCube -//! @{ - - - -template -struct ProxyCube - { - inline ProxyCube(const T1&) - { - arma_type_check(( is_arma_cube_type::value == false )); - } - }; - - - -// ea_type is the "element accessor" type, -// which can provide access to elements via operator[] - -template -struct ProxyCube< Cube > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef Cube stored_type; - typedef const eT* ea_type; - typedef const Cube& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - arma_aligned const Cube& Q; - - inline explicit ProxyCube(const Cube& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem_slice() const { return Q.n_elem_slice; } - arma_inline uword get_n_slices() const { return Q.n_slices; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c, const uword s) const { return Q.at(r, c, s); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Cube& X) const { return (void_ptr(&Q) == void_ptr(&X)); } - - template - arma_inline bool has_overlap(const subview_cube& X) const { return is_alias(X.m); } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct ProxyCube< GenCube > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef GenCube stored_type; - typedef const GenCube& ea_type; - typedef const GenCube& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - arma_aligned const GenCube& Q; - - inline explicit ProxyCube(const GenCube& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem_slice() const { return Q.n_rows*Q.n_cols; } - arma_inline uword get_n_slices() const { return Q.n_slices; } - arma_inline uword get_n_elem() const { return Q.n_rows*Q.n_cols*Q.n_slices; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c, const uword s) const { return Q.at(r, c, s); } - arma_inline elem_type at_alt (const uword i) const { return Q[i]; } - - arma_inline ea_type get_ea() const { return Q; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - constexpr bool is_alias(const Cube&) const { return false; } - - template - constexpr bool has_overlap(const subview_cube&) const { return false; } - - constexpr bool is_aligned() const { return GenCube::is_simple; } - }; - - - -template -struct ProxyCube< OpCube > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef Cube stored_type; - typedef const elem_type* ea_type; - typedef const Cube& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - arma_aligned const Cube Q; - - inline explicit ProxyCube(const OpCube& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem_slice() const { return Q.n_elem_slice; } - arma_inline uword get_n_slices() const { return Q.n_slices; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c, const uword s) const { return Q.at(r, c, s); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - constexpr bool is_alias(const Cube&) const { return false; } - - template - constexpr bool has_overlap(const subview_cube&) const { return false; } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct ProxyCube< GlueCube > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef Cube stored_type; - typedef const elem_type* ea_type; - typedef const Cube& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - arma_aligned const Cube Q; - - inline explicit ProxyCube(const GlueCube& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem_slice() const { return Q.n_elem_slice; } - arma_inline uword get_n_slices() const { return Q.n_slices; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c, const uword s) const { return Q.at(r, c, s); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - constexpr bool is_alias(const Cube&) const { return false; } - - template - constexpr bool has_overlap(const subview_cube&) const { return false; } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct ProxyCube< subview_cube > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef subview_cube stored_type; - typedef const subview_cube& ea_type; - typedef const subview_cube& aligned_ea_type; - - static constexpr bool use_at = true; - static constexpr bool use_mp = false; - static constexpr bool has_subview = true; - - arma_aligned const subview_cube& Q; - - inline explicit ProxyCube(const subview_cube& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem_slice() const { return Q.n_elem_slice; } - arma_inline uword get_n_slices() const { return Q.n_slices; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c, const uword s) const { return Q.at(r, c, s); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Cube& X) const { return (void_ptr(&(Q.m)) == void_ptr(&X)); } - - template - arma_inline bool has_overlap(const subview_cube& X) const { return Q.check_overlap(X); } - - constexpr bool is_aligned() const { return false; } - }; - - - -template -struct ProxyCube< subview_cube_slices > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef Cube stored_type; - typedef const eT* ea_type; - typedef const Cube& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - arma_aligned const Cube Q; - - inline explicit ProxyCube(const subview_cube_slices& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem_slice() const { return Q.n_elem_slice; } - arma_inline uword get_n_slices() const { return Q.n_slices; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c, const uword s) const { return Q.at(r, c, s); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - constexpr bool is_alias(const Cube&) const { return false; } - - template - constexpr bool has_overlap(const subview_cube&) const { return false; } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct ProxyCube< eOpCube > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef eOpCube stored_type; - typedef const eOpCube& ea_type; - typedef const eOpCube& aligned_ea_type; - - static constexpr bool use_at = eOpCube::use_at; - static constexpr bool use_mp = eOpCube::use_mp; - static constexpr bool has_subview = eOpCube::has_subview; - - arma_aligned const eOpCube& Q; - - inline explicit ProxyCube(const eOpCube& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.get_n_rows(); } - arma_inline uword get_n_cols() const { return Q.get_n_cols(); } - arma_inline uword get_n_elem_slice() const { return Q.get_n_elem_slice(); } - arma_inline uword get_n_slices() const { return Q.get_n_slices(); } - arma_inline uword get_n_elem() const { return Q.get_n_elem(); } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c, const uword s) const { return Q.at(r, c, s); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Cube& X) const { return Q.P.is_alias(X); } - - template - arma_inline bool has_overlap(const subview_cube& X) const { return Q.P.has_overlap(X); } - - arma_inline bool is_aligned() const { return Q.P.is_aligned(); } - }; - - - -template -struct ProxyCube< eGlueCube > - { - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef eGlueCube stored_type; - typedef const eGlueCube& ea_type; - typedef const eGlueCube& aligned_ea_type; - - static constexpr bool use_at = eGlueCube::use_at; - static constexpr bool use_mp = eGlueCube::use_mp; - static constexpr bool has_subview = eGlueCube::has_subview; - - arma_aligned const eGlueCube& Q; - - inline explicit ProxyCube(const eGlueCube& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.get_n_rows(); } - arma_inline uword get_n_cols() const { return Q.get_n_cols(); } - arma_inline uword get_n_elem_slice() const { return Q.get_n_elem_slice(); } - arma_inline uword get_n_slices() const { return Q.get_n_slices(); } - arma_inline uword get_n_elem() const { return Q.get_n_elem(); } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c, const uword s) const { return Q.at(r, c, s); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q; } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - arma_inline bool is_alias(const Cube& X) const { return (Q.P1.is_alias(X) || Q.P2.is_alias(X)); } - - template - arma_inline bool has_overlap(const subview_cube& X) const { return (Q.P1.has_overlap(X) || Q.P2.has_overlap(X)); } - - arma_inline bool is_aligned() const { return Q.P1.is_aligned() && Q.P2.is_aligned(); } - }; - - - -template -struct ProxyCube< mtOpCube > - { - typedef out_eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef Cube stored_type; - typedef const elem_type* ea_type; - typedef const Cube& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - arma_aligned const Cube Q; - - inline explicit ProxyCube(const mtOpCube& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem_slice() const { return Q.n_elem_slice; } - arma_inline uword get_n_slices() const { return Q.n_slices; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c, const uword s) const { return Q.at(r, c, s); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - constexpr bool is_alias(const Cube&) const { return false; } - - template - constexpr bool has_overlap(const subview_cube&) const { return false; } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -template -struct ProxyCube< mtGlueCube > - { - typedef out_eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef Cube stored_type; - typedef const elem_type* ea_type; - typedef const Cube& aligned_ea_type; - - static constexpr bool use_at = false; - static constexpr bool use_mp = false; - static constexpr bool has_subview = false; - - arma_aligned const Cube Q; - - inline explicit ProxyCube(const mtGlueCube& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem_slice() const { return Q.n_elem_slice; } - arma_inline uword get_n_slices() const { return Q.n_slices; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - - arma_inline elem_type operator[] (const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword r, const uword c, const uword s) const { return Q.at(r, c, s); } - arma_inline elem_type at_alt (const uword i) const { return Q.at_alt(i); } - - arma_inline ea_type get_ea() const { return Q.memptr(); } - arma_inline aligned_ea_type get_aligned_ea() const { return Q; } - - template - constexpr bool is_alias(const Cube&) const { return false; } - - template - constexpr bool has_overlap(const subview_cube&) const { return false; } - - arma_inline bool is_aligned() const { return memory::is_aligned(Q.memptr()); } - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Row_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Row_bones.hpp deleted file mode 100644 index 96dff225f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Row_bones.hpp +++ /dev/null @@ -1,288 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup Row -//! @{ - -//! Class for row vectors (matrices with only one row) - -template -class Row : public Mat - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_col = false; - static constexpr bool is_row = true; - static constexpr bool is_xvec = false; - - inline Row(); - inline Row(const Row& X); - - inline explicit Row(const uword N); - inline explicit Row(const uword in_rows, const uword in_cols); - inline explicit Row(const SizeMat& s); - - template inline explicit Row(const uword N, const arma_initmode_indicator&); - template inline explicit Row(const uword in_rows, const uword in_cols, const arma_initmode_indicator&); - template inline explicit Row(const SizeMat& s, const arma_initmode_indicator&); - - template inline Row(const uword n_elem, const fill::fill_class& f); - template inline Row(const uword in_rows, const uword in_cols, const fill::fill_class& f); - template inline Row(const SizeMat& s, const fill::fill_class& f); - - inline Row(const uword N, const fill::scalar_holder f); - inline Row(const uword in_rows, const uword in_cols, const fill::scalar_holder f); - inline Row(const SizeMat& s, const fill::scalar_holder f); - - inline Row(const char* text); - inline Row& operator=(const char* text); - - inline Row(const std::string& text); - inline Row& operator=(const std::string& text); - - inline Row(const std::vector& x); - inline Row& operator=(const std::vector& x); - - inline Row(const std::initializer_list& list); - inline Row& operator=(const std::initializer_list& list); - - inline Row(Row&& m); - inline Row& operator=(Row&& m); - - // inline Row(Mat&& m); - // inline Row& operator=(Mat&& m); - - inline Row& operator=(const eT val); - inline Row& operator=(const Row& X); - - template inline Row(const Base& X); - template inline Row& operator=(const Base& X); - - template inline explicit Row(const SpBase& X); - template inline Row& operator=(const SpBase& X); - - inline Row( eT* aux_mem, const uword aux_length, const bool copy_aux_mem = true, const bool strict = false); - inline Row(const eT* aux_mem, const uword aux_length); - - template - inline explicit Row(const Base& A, const Base& B); - - template inline Row(const BaseCube& X); - template inline Row& operator=(const BaseCube& X); - - inline Row(const subview_cube& X); - inline Row& operator=(const subview_cube& X); - - arma_frown("use braced initialiser list instead") inline mat_injector operator<<(const eT val); - - arma_warn_unused arma_inline const Op,op_htrans> t() const; - arma_warn_unused arma_inline const Op,op_htrans> ht() const; - arma_warn_unused arma_inline const Op,op_strans> st() const; - - arma_warn_unused arma_inline const Op,op_strans> as_col() const; - - arma_inline subview_row col(const uword col_num); - arma_inline const subview_row col(const uword col_num) const; - - using Mat::cols; - using Mat::operator(); - - arma_inline subview_row cols(const uword in_col1, const uword in_col2); - arma_inline const subview_row cols(const uword in_col1, const uword in_col2) const; - - arma_inline subview_row subvec(const uword in_col1, const uword in_col2); - arma_inline const subview_row subvec(const uword in_col1, const uword in_col2) const; - - arma_inline subview_row cols(const span& col_span); - arma_inline const subview_row cols(const span& col_span) const; - - arma_inline subview_row subvec(const span& col_span); - arma_inline const subview_row subvec(const span& col_span) const; - - arma_inline subview_row operator()(const span& col_span); - arma_inline const subview_row operator()(const span& col_span) const; - - arma_inline subview_row subvec(const uword start_col, const SizeMat& s); - arma_inline const subview_row subvec(const uword start_col, const SizeMat& s) const; - - arma_inline subview_row head(const uword N); - arma_inline const subview_row head(const uword N) const; - - arma_inline subview_row tail(const uword N); - arma_inline const subview_row tail(const uword N) const; - - arma_inline subview_row head_cols(const uword N); - arma_inline const subview_row head_cols(const uword N) const; - - arma_inline subview_row tail_cols(const uword N); - arma_inline const subview_row tail_cols(const uword N) const; - - - inline void shed_col (const uword col_num); - inline void shed_cols(const uword in_col1, const uword in_col2); - - template inline void shed_cols(const Base& indices); - - arma_deprecated inline void insert_cols(const uword col_num, const uword N, const bool set_to_zero); - inline void insert_cols(const uword col_num, const uword N); - - template inline void insert_cols(const uword col_num, const Base& X); - - - arma_warn_unused arma_inline eT& at(const uword i); - arma_warn_unused arma_inline const eT& at(const uword i) const; - - arma_warn_unused arma_inline eT& at(const uword in_row, const uword in_col); - arma_warn_unused arma_inline const eT& at(const uword in_row, const uword in_col) const; - - - typedef eT* row_iterator; - typedef const eT* const_row_iterator; - - inline row_iterator begin_row(const uword row_num); - inline const_row_iterator begin_row(const uword row_num) const; - - inline row_iterator end_row (const uword row_num); - inline const_row_iterator end_row (const uword row_num) const; - - - template class fixed; - - - protected: - - inline Row(const arma_fixed_indicator&, const uword in_n_elem, const eT* in_mem); - - - public: - - #if defined(ARMA_EXTRA_ROW_PROTO) - #include ARMA_INCFILE_WRAP(ARMA_EXTRA_ROW_PROTO) - #endif - }; - - - -template -template -class Row::fixed : public Row - { - private: - - static constexpr bool use_extra = (fixed_n_elem > arma_config::mat_prealloc); - - arma_align_mem eT mem_local_extra[ (use_extra) ? fixed_n_elem : 1 ]; - - - public: - - typedef fixed Row_fixed_type; - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_col = false; - static constexpr bool is_row = true; - static constexpr bool is_xvec = false; - - static const uword n_rows; // value provided below the class definition - static const uword n_cols; // value provided below the class definition - static const uword n_elem; // value provided below the class definition - - arma_inline fixed(); - arma_inline fixed(const fixed& X); - inline fixed(const subview_cube& X); - - inline fixed(const fill::scalar_holder f); - template inline fixed(const fill::fill_class& f); - template inline fixed(const Base& A); - template inline fixed(const Base& A, const Base& B); - - inline fixed(const eT* aux_mem); - - inline fixed(const char* text); - inline fixed(const std::string& text); - - template inline Row& operator=(const Base& A); - - inline Row& operator=(const eT val); - inline Row& operator=(const char* text); - inline Row& operator=(const std::string& text); - inline Row& operator=(const subview_cube& X); - - using Row::operator(); - - inline fixed(const std::initializer_list& list); - inline Row& operator=(const std::initializer_list& list); - - arma_inline Row& operator=(const fixed& X); - - #if defined(ARMA_GOOD_COMPILER) - template inline Row& operator=(const eOp& X); - template inline Row& operator=(const eGlue& X); - #endif - - arma_warn_unused arma_inline const Op< Row_fixed_type, op_htrans > t() const; - arma_warn_unused arma_inline const Op< Row_fixed_type, op_htrans > ht() const; - arma_warn_unused arma_inline const Op< Row_fixed_type, op_strans > st() const; - - arma_warn_unused arma_inline const eT& at_alt (const uword i) const; - - arma_warn_unused arma_inline eT& operator[] (const uword i); - arma_warn_unused arma_inline const eT& operator[] (const uword i) const; - arma_warn_unused arma_inline eT& at (const uword i); - arma_warn_unused arma_inline const eT& at (const uword i) const; - arma_warn_unused arma_inline eT& operator() (const uword i); - arma_warn_unused arma_inline const eT& operator() (const uword i) const; - - arma_warn_unused arma_inline eT& at (const uword in_row, const uword in_col); - arma_warn_unused arma_inline const eT& at (const uword in_row, const uword in_col) const; - arma_warn_unused arma_inline eT& operator() (const uword in_row, const uword in_col); - arma_warn_unused arma_inline const eT& operator() (const uword in_row, const uword in_col) const; - - arma_warn_unused arma_inline eT* memptr(); - arma_warn_unused arma_inline const eT* memptr() const; - - inline const Row& fill(const eT val); - inline const Row& zeros(); - inline const Row& ones(); - }; - - - -// these definitions are outside of the class due to bizarre C++ rules; -// C++17 has inline variables to address this shortcoming - -template -template -const uword Row::fixed::n_rows = 1u; - -template -template -const uword Row::fixed::n_cols = fixed_n_elem; - -template -template -const uword Row::fixed::n_elem = fixed_n_elem; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Row_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Row_meat.hpp deleted file mode 100644 index 17ff05b86..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/Row_meat.hpp +++ /dev/null @@ -1,1891 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup Row -//! @{ - - -//! construct an empty row vector -template -inline -Row::Row() - : Mat(arma_vec_indicator(), 2) - { - arma_debug_sigprint(); - } - - - -template -inline -Row::Row(const Row& X) - : Mat(arma_vec_indicator(), 1, X.n_elem, 2) - { - arma_debug_sigprint(); - - arrayops::copy((*this).memptr(), X.memptr(), X.n_elem); - } - - - -//! construct a row vector with the specified number of n_elem -template -inline -Row::Row(const uword in_n_elem) - : Mat(arma_vec_indicator(), 1, in_n_elem, 2) - { - arma_debug_sigprint(); - - arma_debug_print("Row::constructor: zeroing memory"); - - arrayops::fill_zeros(Mat::memptr(), Mat::n_elem); - } - - - -template -inline -Row::Row(const uword in_n_rows, const uword in_n_cols) - : Mat(arma_vec_indicator(), 0, 0, 2) - { - arma_debug_sigprint(); - - Mat::init_warm(in_n_rows, in_n_cols); - - arma_debug_print("Row::constructor: zeroing memory"); - - arrayops::fill_zeros(Mat::memptr(), Mat::n_elem); - } - - - -template -inline -Row::Row(const SizeMat& s) - : Mat(arma_vec_indicator(), 0, 0, 2) - { - arma_debug_sigprint(); - - Mat::init_warm(s.n_rows, s.n_cols); - - arma_debug_print("Row::constructor: zeroing memory"); - - arrayops::fill_zeros(Mat::memptr(), Mat::n_elem); - } - - - -//! internal use only -template -template -inline -Row::Row(const uword in_n_elem, const arma_initmode_indicator&) - : Mat(arma_vec_indicator(), 1, in_n_elem, 2) - { - arma_debug_sigprint(); - - if(do_zeros) - { - arma_debug_print("Row::constructor: zeroing memory"); - arrayops::fill_zeros(Mat::memptr(), Mat::n_elem); - } - else - { - arma_debug_print("Row::constructor: not zeroing memory"); - } - } - - - -//! internal use only -template -template -inline -Row::Row(const uword in_n_rows, const uword in_n_cols, const arma_initmode_indicator&) - : Mat(arma_vec_indicator(), 0, 0, 2) - { - arma_debug_sigprint(); - - Mat::init_warm(in_n_rows, in_n_cols); - - if(do_zeros) - { - arma_debug_print("Row::constructor: zeroing memory"); - arrayops::fill_zeros(Mat::memptr(), Mat::n_elem); - } - else - { - arma_debug_print("Row::constructor: not zeroing memory"); - } - } - - - -//! internal use only -template -template -inline -Row::Row(const SizeMat& s, const arma_initmode_indicator&) - : Mat(arma_vec_indicator(), 0, 0, 2) - { - arma_debug_sigprint(); - - Mat::init_warm(s.n_rows, s.n_cols); - - if(do_zeros) - { - arma_debug_print("Row::constructor: zeroing memory"); - arrayops::fill_zeros(Mat::memptr(), Mat::n_elem); - } - else - { - arma_debug_print("Row::constructor: not zeroing memory"); - } - } - - - -template -template -inline -Row::Row(const uword in_n_elem, const fill::fill_class& f) - : Mat(arma_vec_indicator(), 1, in_n_elem, 2) - { - arma_debug_sigprint(); - - (*this).fill(f); - } - - - -template -template -inline -Row::Row(const uword in_n_rows, const uword in_n_cols, const fill::fill_class& f) - : Mat(arma_vec_indicator(), 0, 0, 2) - { - arma_debug_sigprint(); - - Mat::init_warm(in_n_rows, in_n_cols); - - (*this).fill(f); - } - - - -template -template -inline -Row::Row(const SizeMat& s, const fill::fill_class& f) - : Mat(arma_vec_indicator(), 0, 0, 2) - { - arma_debug_sigprint(); - - Mat::init_warm(s.n_rows, s.n_cols); - - (*this).fill(f); - } - - - -template -inline -Row::Row(const uword in_n_elem, const fill::scalar_holder f) - : Mat(arma_vec_indicator(), 1, in_n_elem, 2) - { - arma_debug_sigprint(); - - (*this).fill(f.scalar); - } - - - -template -inline -Row::Row(const uword in_n_rows, const uword in_n_cols, const fill::scalar_holder f) - : Mat(arma_vec_indicator(), 0, 0, 2) - { - arma_debug_sigprint(); - - Mat::init_warm(in_n_rows, in_n_cols); - - (*this).fill(f.scalar); - } - - - -template -inline -Row::Row(const SizeMat& s, const fill::scalar_holder f) - : Mat(arma_vec_indicator(), 0, 0, 2) - { - arma_debug_sigprint(); - - Mat::init_warm(s.n_rows, s.n_cols); - - (*this).fill(f.scalar); - } - - - -template -inline -Row::Row(const char* text) - : Mat(arma_vec_indicator(), 2) - { - arma_debug_sigprint(); - - (*this).operator=(text); - } - - - -template -inline -Row& -Row::operator=(const char* text) - { - arma_debug_sigprint(); - - Mat tmp(text); - - arma_conform_check( ((tmp.n_elem > 0) && (tmp.is_vec() == false)), "Mat::init(): requested size is not compatible with row vector layout" ); - - access::rw(tmp.n_rows) = 1; - access::rw(tmp.n_cols) = tmp.n_elem; - - (*this).steal_mem(tmp); - - return *this; - } - - - -template -inline -Row::Row(const std::string& text) - : Mat(arma_vec_indicator(), 2) - { - arma_debug_sigprint(); - - (*this).operator=(text); - } - - - -template -inline -Row& -Row::operator=(const std::string& text) - { - arma_debug_sigprint(); - - Mat tmp(text); - - arma_conform_check( ((tmp.n_elem > 0) && (tmp.is_vec() == false)), "Mat::init(): requested size is not compatible with row vector layout" ); - - access::rw(tmp.n_rows) = 1; - access::rw(tmp.n_cols) = tmp.n_elem; - - (*this).steal_mem(tmp); - - return *this; - } - - - -//! create a row vector from std::vector -template -inline -Row::Row(const std::vector& x) - : Mat(arma_vec_indicator(), 1, uword(x.size()), 2) - { - arma_debug_sigprint_this(this); - - const uword N = uword(x.size()); - - if(N > 0) { arrayops::copy( Mat::memptr(), &(x[0]), N ); } - } - - - -//! create a row vector from std::vector -template -inline -Row& -Row::operator=(const std::vector& x) - { - arma_debug_sigprint(); - - const uword N = uword(x.size()); - - Mat::init_warm(1, N); - - if(N > 0) { arrayops::copy( Mat::memptr(), &(x[0]), N ); } - - return *this; - } - - - -template -inline -Row::Row(const std::initializer_list& list) - : Mat(arma_vec_indicator(), 1, uword(list.size()), 2) - { - arma_debug_sigprint_this(this); - - const uword N = uword(list.size()); - - if(N > 0) { arrayops::copy( Mat::memptr(), list.begin(), N ); } - } - - - -template -inline -Row& -Row::operator=(const std::initializer_list& list) - { - arma_debug_sigprint(); - - const uword N = uword(list.size()); - - Mat::init_warm(1, N); - - if(N > 0) { arrayops::copy( Mat::memptr(), list.begin(), N ); } - - return *this; - } - - - -template -inline -Row::Row(Row&& X) - : Mat(arma_vec_indicator(), 2) - { - arma_debug_sigprint(arma_str::format("this: %x; X: %x") % this % &X); - - access::rw(Mat::n_rows) = 1; - access::rw(Mat::n_cols) = X.n_cols; - access::rw(Mat::n_elem) = X.n_elem; - access::rw(Mat::n_alloc) = X.n_alloc; - - if( (X.n_alloc > arma_config::mat_prealloc) || (X.mem_state == 1) || (X.mem_state == 2) ) - { - access::rw(Mat::mem_state) = X.mem_state; - access::rw(Mat::mem) = X.mem; - - access::rw(X.n_rows) = 1; - access::rw(X.n_cols) = 0; - access::rw(X.n_elem) = 0; - access::rw(X.n_alloc) = 0; - access::rw(X.mem_state) = 0; - access::rw(X.mem) = nullptr; - } - else // condition: (X.n_alloc <= arma_config::mat_prealloc) || (X.mem_state == 0) || (X.mem_state == 3) - { - (*this).init_cold(); - - arrayops::copy( (*this).memptr(), X.mem, X.n_elem ); - - if( (X.mem_state == 0) && (X.n_alloc <= arma_config::mat_prealloc) ) - { - access::rw(X.n_rows) = 1; - access::rw(X.n_cols) = 0; - access::rw(X.n_elem) = 0; - access::rw(X.mem) = nullptr; - } - } - } - - - -template -inline -Row& -Row::operator=(Row&& X) - { - arma_debug_sigprint(arma_str::format("this: %x; X: %x") % this % &X); - - (*this).steal_mem(X, true); - - return *this; - } - - - -// template -// inline -// Row::Row(Mat&& X) -// : Mat(arma_vec_indicator(), 2) -// { -// arma_debug_sigprint(arma_str::format("this: %x; X: %x") % this % &X); -// -// if(X.n_rows != 1) { const Mat& XX = X; Mat::operator=(XX); return; } -// -// access::rw(Mat::n_rows) = 1; -// access::rw(Mat::n_cols) = X.n_cols; -// access::rw(Mat::n_elem) = X.n_elem; -// access::rw(Mat::n_alloc) = X.n_alloc; -// -// if( (X.n_alloc > arma_config::mat_prealloc) || (X.mem_state == 1) || (X.mem_state == 2) ) -// { -// access::rw(Mat::mem_state) = X.mem_state; -// access::rw(Mat::mem) = X.mem; -// -// access::rw(X.n_cols) = 0; -// access::rw(X.n_elem) = 0; -// access::rw(X.n_alloc) = 0; -// access::rw(X.mem_state) = 0; -// access::rw(X.mem) = nullptr; -// } -// else // condition: (X.n_alloc <= arma_config::mat_prealloc) || (X.mem_state == 0) || (X.mem_state == 3) -// { -// (*this).init_cold(); -// -// arrayops::copy( (*this).memptr(), X.mem, X.n_elem ); -// -// if( (X.mem_state == 0) && (X.n_alloc <= arma_config::mat_prealloc) ) -// { -// access::rw(X.n_cols) = 0; -// access::rw(X.n_elem) = 0; -// access::rw(X.mem) = nullptr; -// } -// } -// } -// -// -// -// template -// inline -// Row& -// Row::operator=(Mat&& X) -// { -// arma_debug_sigprint(arma_str::format("this: %x; X: %x") % this % &X); -// -// if(X.n_rows != 1) { const Mat& XX = X; Mat::operator=(XX); return *this; } -// -// (*this).steal_mem(X, true); -// -// return *this; -// } - - - -template -inline -Row& -Row::operator=(const eT val) - { - arma_debug_sigprint(); - - Mat::operator=(val); - - return *this; - } - - - -template -inline -Row& -Row::operator=(const Row& X) - { - arma_debug_sigprint(); - - Mat::operator=(X); - - return *this; - } - - - -template -template -inline -Row::Row(const Base& X) - : Mat(arma_vec_indicator(), 2) - { - arma_debug_sigprint(); - - Mat::operator=(X.get_ref()); - } - - - -template -template -inline -Row& -Row::operator=(const Base& X) - { - arma_debug_sigprint(); - - Mat::operator=(X.get_ref()); - - return *this; - } - - - -template -template -inline -Row::Row(const SpBase& X) - : Mat(arma_vec_indicator(), 2) - { - arma_debug_sigprint(); - - Mat::operator=(X.get_ref()); - } - - - -template -template -inline -Row& -Row::operator=(const SpBase& X) - { - arma_debug_sigprint(); - - Mat::operator=(X.get_ref()); - - return *this; - } - - - -//! construct a row vector from a given auxiliary array -template -inline -Row::Row(eT* aux_mem, const uword aux_length, const bool copy_aux_mem, const bool strict) - : Mat(aux_mem, 1, aux_length, copy_aux_mem, strict) - { - arma_debug_sigprint(); - - access::rw(Mat::vec_state) = 2; - } - - - -//! construct a row vector from a given auxiliary array -template -inline -Row::Row(const eT* aux_mem, const uword aux_length) - : Mat(aux_mem, 1, aux_length) - { - arma_debug_sigprint(); - - access::rw(Mat::vec_state) = 2; - } - - - -template -template -inline -Row::Row - ( - const Base::pod_type, T1>& A, - const Base::pod_type, T2>& B - ) - { - arma_debug_sigprint(); - - access::rw(Mat::vec_state) = 2; - - Mat::init(A,B); - } - - - -template -template -inline -Row::Row(const BaseCube& X) - { - arma_debug_sigprint(); - - access::rw(Mat::vec_state) = 2; - - Mat::operator=(X); - } - - - -template -template -inline -Row& -Row::operator=(const BaseCube& X) - { - arma_debug_sigprint(); - - Mat::operator=(X); - - return *this; - } - - - -template -inline -Row::Row(const subview_cube& X) - { - arma_debug_sigprint(); - - access::rw(Mat::vec_state) = 2; - - Mat::operator=(X); - } - - - -template -inline -Row& -Row::operator=(const subview_cube& X) - { - arma_debug_sigprint(); - - Mat::operator=(X); - - return *this; - } - - - -template -inline -mat_injector< Row > -Row::operator<<(const eT val) - { - return mat_injector< Row >(*this, val); - } - - - -template -arma_inline -const Op,op_htrans> -Row::t() const - { - return Op,op_htrans>(*this); - } - - - -template -arma_inline -const Op,op_htrans> -Row::ht() const - { - return Op,op_htrans>(*this); - } - - - -template -arma_inline -const Op,op_strans> -Row::st() const - { - return Op,op_strans>(*this); - } - - - -template -arma_inline -const Op,op_strans> -Row::as_col() const - { - return Op,op_strans>(*this); - } - - - -template -arma_inline -subview_row -Row::col(const uword in_col1) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (in_col1 >= Mat::n_cols), "Row::col(): indices out of bounds or incorrectly used" ); - - return subview_row(*this, 0, in_col1, 1); - } - - - -template -arma_inline -const subview_row -Row::col(const uword in_col1) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (in_col1 >= Mat::n_cols), "Row::col(): indices out of bounds or incorrectly used" ); - - return subview_row(*this, 0, in_col1, 1); - } - - - -template -arma_inline -subview_row -Row::cols(const uword in_col1, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( ( (in_col1 > in_col2) || (in_col2 >= Mat::n_cols) ), "Row::cols(): indices out of bounds or incorrectly used" ); - - const uword subview_n_cols = in_col2 - in_col1 + 1; - - return subview_row(*this, 0, in_col1, subview_n_cols); - } - - - -template -arma_inline -const subview_row -Row::cols(const uword in_col1, const uword in_col2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( ( (in_col1 > in_col2) || (in_col2 >= Mat::n_cols) ), "Row::cols(): indices out of bounds or incorrectly used" ); - - const uword subview_n_cols = in_col2 - in_col1 + 1; - - return subview_row(*this, 0, in_col1, subview_n_cols); - } - - - -template -arma_inline -subview_row -Row::subvec(const uword in_col1, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( ( (in_col1 > in_col2) || (in_col2 >= Mat::n_cols) ), "Row::subvec(): indices out of bounds or incorrectly used" ); - - const uword subview_n_cols = in_col2 - in_col1 + 1; - - return subview_row(*this, 0, in_col1, subview_n_cols); - } - - - -template -arma_inline -const subview_row -Row::subvec(const uword in_col1, const uword in_col2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( ( (in_col1 > in_col2) || (in_col2 >= Mat::n_cols) ), "Row::subvec(): indices out of bounds or incorrectly used" ); - - const uword subview_n_cols = in_col2 - in_col1 + 1; - - return subview_row(*this, 0, in_col1, subview_n_cols); - } - - - -template -arma_inline -subview_row -Row::cols(const span& col_span) - { - arma_debug_sigprint(); - - return subvec(col_span); - } - - - -template -arma_inline -const subview_row -Row::cols(const span& col_span) const - { - arma_debug_sigprint(); - - return subvec(col_span); - } - - - -template -arma_inline -subview_row -Row::subvec(const span& col_span) - { - arma_debug_sigprint(); - - const bool col_all = col_span.whole; - - const uword local_n_cols = Mat::n_cols; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword subvec_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - arma_conform_check_bounds( ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ), "Row::subvec(): indices out of bounds or incorrectly used" ); - - return subview_row(*this, 0, in_col1, subvec_n_cols); - } - - - -template -arma_inline -const subview_row -Row::subvec(const span& col_span) const - { - arma_debug_sigprint(); - - const bool col_all = col_span.whole; - - const uword local_n_cols = Mat::n_cols; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword subvec_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - arma_conform_check_bounds( ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ), "Row::subvec(): indices out of bounds or incorrectly used" ); - - return subview_row(*this, 0, in_col1, subvec_n_cols); - } - - - -template -arma_inline -subview_row -Row::operator()(const span& col_span) - { - arma_debug_sigprint(); - - return subvec(col_span); - } - - - -template -arma_inline -const subview_row -Row::operator()(const span& col_span) const - { - arma_debug_sigprint(); - - return subvec(col_span); - } - - - -template -arma_inline -subview_row -Row::subvec(const uword start_col, const SizeMat& s) - { - arma_debug_sigprint(); - - arma_conform_check( (s.n_rows != 1), "Row::subvec(): given size does not specify a row vector" ); - - arma_conform_check_bounds( ( (start_col >= Mat::n_cols) || ((start_col + s.n_cols) > Mat::n_cols) ), "Row::subvec(): size out of bounds" ); - - return subview_row(*this, 0, start_col, s.n_cols); - } - - - -template -arma_inline -const subview_row -Row::subvec(const uword start_col, const SizeMat& s) const - { - arma_debug_sigprint(); - - arma_conform_check( (s.n_rows != 1), "Row::subvec(): given size does not specify a row vector" ); - - arma_conform_check_bounds( ( (start_col >= Mat::n_cols) || ((start_col + s.n_cols) > Mat::n_cols) ), "Row::subvec(): size out of bounds" ); - - return subview_row(*this, 0, start_col, s.n_cols); - } - - - -template -arma_inline -subview_row -Row::head(const uword N) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > Mat::n_cols), "Row::head(): size out of bounds" ); - - return subview_row(*this, 0, 0, N); - } - - - -template -arma_inline -const subview_row -Row::head(const uword N) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > Mat::n_cols), "Row::head(): size out of bounds" ); - - return subview_row(*this, 0, 0, N); - } - - - -template -arma_inline -subview_row -Row::tail(const uword N) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > Mat::n_cols), "Row::tail(): size out of bounds" ); - - const uword start_col = Mat::n_cols - N; - - return subview_row(*this, 0, start_col, N); - } - - - -template -arma_inline -const subview_row -Row::tail(const uword N) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > Mat::n_cols), "Row::tail(): size out of bounds" ); - - const uword start_col = Mat::n_cols - N; - - return subview_row(*this, 0, start_col, N); - } - - - -template -arma_inline -subview_row -Row::head_cols(const uword N) - { - arma_debug_sigprint(); - - return (*this).head(N); - } - - - -template -arma_inline -const subview_row -Row::head_cols(const uword N) const - { - arma_debug_sigprint(); - - return (*this).head(N); - } - - - -template -arma_inline -subview_row -Row::tail_cols(const uword N) - { - arma_debug_sigprint(); - - return (*this).tail(N); - } - - - -template -arma_inline -const subview_row -Row::tail_cols(const uword N) const - { - arma_debug_sigprint(); - - return (*this).tail(N); - } - - - -//! remove specified columns -template -inline -void -Row::shed_col(const uword col_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( col_num >= Mat::n_cols, "Row::shed_col(): index out of bounds" ); - - shed_cols(col_num, col_num); - } - - - -//! remove specified columns -template -inline -void -Row::shed_cols(const uword in_col1, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_col1 > in_col2) || (in_col2 >= Mat::n_cols), - "Row::shed_cols(): indices out of bounds or incorrectly used" - ); - - const uword n_keep_front = in_col1; - const uword n_keep_back = Mat::n_cols - (in_col2 + 1); - - Row X(n_keep_front + n_keep_back, arma_nozeros_indicator()); - - eT* X_mem = X.memptr(); - const eT* t_mem = (*this).memptr(); - - if(n_keep_front > 0) - { - arrayops::copy( X_mem, t_mem, n_keep_front ); - } - - if(n_keep_back > 0) - { - arrayops::copy( &(X_mem[n_keep_front]), &(t_mem[in_col2+1]), n_keep_back); - } - - Mat::steal_mem(X); - } - - - -//! remove specified columns -template -template -inline -void -Row::shed_cols(const Base& indices) - { - arma_debug_sigprint(); - - Mat::shed_cols(indices); - } - - - -template -inline -void -Row::insert_cols(const uword col_num, const uword N, const bool set_to_zero) - { - arma_debug_sigprint(); - - arma_ignore(set_to_zero); - - (*this).insert_cols(col_num, N); - } - - - -template -inline -void -Row::insert_cols(const uword col_num, const uword N) - { - arma_debug_sigprint(); - - const uword t_n_cols = Mat::n_cols; - - const uword A_n_cols = col_num; - const uword B_n_cols = t_n_cols - col_num; - - // insertion at col_num == n_cols is in effect an append operation - arma_conform_check_bounds( (col_num > t_n_cols), "Row::insert_cols(): index out of bounds" ); - - if(N == 0) { return; } - - Row out(t_n_cols + N, arma_nozeros_indicator()); - - eT* out_mem = out.memptr(); - const eT* t_mem = (*this).memptr(); - - if(A_n_cols > 0) - { - arrayops::copy( out_mem, t_mem, A_n_cols ); - } - - if(B_n_cols > 0) - { - arrayops::copy( &(out_mem[col_num + N]), &(t_mem[col_num]), B_n_cols ); - } - - arrayops::fill_zeros( &(out_mem[col_num]), N ); - - Mat::steal_mem(out); - } - - - -//! insert the given object at the specified col position; -//! the given object must have one row -template -template -inline -void -Row::insert_cols(const uword col_num, const Base& X) - { - arma_debug_sigprint(); - - Mat::insert_cols(col_num, X); - } - - - -template -arma_inline -eT& -Row::at(const uword i) - { - return access::rw(Mat::mem[i]); - } - - - -template -arma_inline -const eT& -Row::at(const uword i) const - { - return Mat::mem[i]; - } - - - -template -arma_inline -eT& -Row::at(const uword, const uword in_col) - { - return access::rw( Mat::mem[in_col] ); - } - - - -template -arma_inline -const eT& -Row::at(const uword, const uword in_col) const - { - return Mat::mem[in_col]; - } - - - -template -inline -typename Row::row_iterator -Row::begin_row(const uword row_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (row_num >= Mat::n_rows), "Row::begin_row(): index out of bounds" ); - - return Mat::memptr(); - } - - - -template -inline -typename Row::const_row_iterator -Row::begin_row(const uword row_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (row_num >= Mat::n_rows), "Row::begin_row(): index out of bounds" ); - - return Mat::memptr(); - } - - - -template -inline -typename Row::row_iterator -Row::end_row(const uword row_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (row_num >= Mat::n_rows), "Row::end_row(): index out of bounds" ); - - return Mat::memptr() + Mat::n_cols; - } - - - -template -inline -typename Row::const_row_iterator -Row::end_row(const uword row_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (row_num >= Mat::n_rows), "Row::end_row(): index out of bounds" ); - - return Mat::memptr() + Mat::n_cols; - } - - - -template -template -arma_inline -Row::fixed::fixed() - : Row( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - arma_debug_print("Row::fixed::constructor: zeroing memory"); - - eT* mem_use = (use_extra) ? &(mem_local_extra[0]) : &(Mat::mem_local[0]); - - arrayops::inplace_set_fixed( mem_use, eT(0) ); - } - - - -template -template -arma_inline -Row::fixed::fixed(const fixed& X) - : Row( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - eT* dest = (use_extra) ? mem_local_extra : Mat::mem_local; - const eT* src = (use_extra) ? X.mem_local_extra : X.mem_local; - - arrayops::copy( dest, src, fixed_n_elem ); - } - - - -template -template -arma_inline -Row::fixed::fixed(const subview_cube& X) - : Row( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - Row::operator=(X); - } - - - -template -template -inline -Row::fixed::fixed(const fill::scalar_holder f) - : Row( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - (*this).fill(f.scalar); - } - - - -template -template -template -inline -Row::fixed::fixed(const fill::fill_class&) - : Row( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - if(is_same_type::yes) { (*this).zeros(); } - if(is_same_type::yes) { (*this).ones(); } - if(is_same_type::yes) { (*this).eye(); } - if(is_same_type::yes) { (*this).randu(); } - if(is_same_type::yes) { (*this).randn(); } - } - - - -template -template -template -arma_inline -Row::fixed::fixed(const Base& A) - : Row( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - Row::operator=(A.get_ref()); - } - - - -template -template -template -arma_inline -Row::fixed::fixed(const Base& A, const Base& B) - : Row( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - Row::init(A,B); - } - - - -template -template -inline -Row::fixed::fixed(const eT* aux_mem) - : Row( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - eT* dest = (use_extra) ? mem_local_extra : Mat::mem_local; - - arrayops::copy( dest, aux_mem, fixed_n_elem ); - } - - - -template -template -inline -Row::fixed::fixed(const char* text) - : Row( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - Row::operator=(text); - } - - - -template -template -inline -Row::fixed::fixed(const std::string& text) - : Row( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - Row::operator=(text); - } - - - -template -template -template -Row& -Row::fixed::operator=(const Base& A) - { - arma_debug_sigprint(); - - Row::operator=(A.get_ref()); - - return *this; - } - - - -template -template -Row& -Row::fixed::operator=(const eT val) - { - arma_debug_sigprint(); - - Row::operator=(val); - - return *this; - } - - - -template -template -Row& -Row::fixed::operator=(const char* text) - { - arma_debug_sigprint(); - - Row::operator=(text); - - return *this; - } - - - -template -template -Row& -Row::fixed::operator=(const std::string& text) - { - arma_debug_sigprint(); - - Row::operator=(text); - - return *this; - } - - - -template -template -Row& -Row::fixed::operator=(const subview_cube& X) - { - arma_debug_sigprint(); - - Row::operator=(X); - - return *this; - } - - - -template -template -inline -Row::fixed::fixed(const std::initializer_list& list) - : Row( arma_fixed_indicator(), fixed_n_elem, ((use_extra) ? mem_local_extra : Mat::mem_local) ) - { - arma_debug_sigprint_this(this); - - (*this).operator=(list); - } - - - -template -template -inline -Row& -Row::fixed::operator=(const std::initializer_list& list) - { - arma_debug_sigprint(); - - const uword N = uword(list.size()); - - arma_conform_check( (N > fixed_n_elem), "Row::fixed: initialiser list is too long" ); - - eT* this_mem = (*this).memptr(); - - arrayops::copy( this_mem, list.begin(), N ); - - for(uword iq=N; iq < fixed_n_elem; ++iq) { this_mem[iq] = eT(0); } - - return *this; - } - - - -template -template -arma_inline -Row& -Row::fixed::operator=(const fixed& X) - { - arma_debug_sigprint(); - - if(this != &X) - { - eT* dest = (use_extra) ? mem_local_extra : Mat::mem_local; - const eT* src = (use_extra) ? X.mem_local_extra : X.mem_local; - - arrayops::copy( dest, src, fixed_n_elem ); - } - - return *this; - } - - - -#if defined(ARMA_GOOD_COMPILER) - - template - template - template - inline - Row& - Row::fixed::operator=(const eOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const bool bad_alias = (eOp::proxy_type::has_subview && X.P.is_alias(*this)); - - if(bad_alias == false) - { - arma_conform_assert_same_size(uword(1), fixed_n_elem, X.get_n_rows(), X.get_n_cols(), "Row::fixed::operator="); - - eop_type::apply(*this, X); - } - else - { - arma_debug_print("bad_alias = true"); - - Row tmp(X); - - (*this) = tmp; - } - - return *this; - } - - - - template - template - template - inline - Row& - Row::fixed::operator=(const eGlue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - arma_type_check(( is_same_type< eT, typename T2::elem_type >::no )); - - const bool bad_alias = - ( - (eGlue::proxy1_type::has_subview && X.P1.is_alias(*this)) - || - (eGlue::proxy2_type::has_subview && X.P2.is_alias(*this)) - ); - - if(bad_alias == false) - { - arma_conform_assert_same_size(uword(1), fixed_n_elem, X.get_n_rows(), X.get_n_cols(), "Row::fixed::operator="); - - eglue_type::apply(*this, X); - } - else - { - arma_debug_print("bad_alias = true"); - - Row tmp(X); - - (*this) = tmp; - } - - return *this; - } - -#endif - - - -template -template -arma_inline -const Op< typename Row::template fixed::Row_fixed_type, op_htrans > -Row::fixed::t() const - { - return Op< typename Row::template fixed::Row_fixed_type, op_htrans >(*this); - } - - - -template -template -arma_inline -const Op< typename Row::template fixed::Row_fixed_type, op_htrans > -Row::fixed::ht() const - { - return Op< typename Row::template fixed::Row_fixed_type, op_htrans >(*this); - } - - - -template -template -arma_inline -const Op< typename Row::template fixed::Row_fixed_type, op_strans > -Row::fixed::st() const - { - return Op< typename Row::template fixed::Row_fixed_type, op_strans >(*this); - } - - - -template -template -arma_inline -const eT& -Row::fixed::at_alt(const uword ii) const - { - #if defined(ARMA_HAVE_ALIGNED_ATTRIBUTE) - - return (use_extra) ? mem_local_extra[ii] : Mat::mem_local[ii]; - - #else - const eT* mem_aligned = (use_extra) ? mem_local_extra : Mat::mem_local; - - memory::mark_as_aligned(mem_aligned); - - return mem_aligned[ii]; - #endif - } - - - -template -template -arma_inline -eT& -Row::fixed::operator[] (const uword ii) - { - return (use_extra) ? mem_local_extra[ii] : Mat::mem_local[ii]; - } - - - -template -template -arma_inline -const eT& -Row::fixed::operator[] (const uword ii) const - { - return (use_extra) ? mem_local_extra[ii] : Mat::mem_local[ii]; - } - - - -template -template -arma_inline -eT& -Row::fixed::at(const uword ii) - { - return (use_extra) ? mem_local_extra[ii] : Mat::mem_local[ii]; - } - - - -template -template -arma_inline -const eT& -Row::fixed::at(const uword ii) const - { - return (use_extra) ? mem_local_extra[ii] : Mat::mem_local[ii]; - } - - - -template -template -arma_inline -eT& -Row::fixed::operator() (const uword ii) - { - arma_conform_check_bounds( (ii >= fixed_n_elem), "Row::operator(): index out of bounds" ); - - return (use_extra) ? mem_local_extra[ii] : Mat::mem_local[ii]; - } - - - -template -template -arma_inline -const eT& -Row::fixed::operator() (const uword ii) const - { - arma_conform_check_bounds( (ii >= fixed_n_elem), "Row::operator(): index out of bounds" ); - - return (use_extra) ? mem_local_extra[ii] : Mat::mem_local[ii]; - } - - - -template -template -arma_inline -eT& -Row::fixed::at(const uword, const uword in_col) - { - return (use_extra) ? mem_local_extra[in_col] : Mat::mem_local[in_col]; - } - - - -template -template -arma_inline -const eT& -Row::fixed::at(const uword, const uword in_col) const - { - return (use_extra) ? mem_local_extra[in_col] : Mat::mem_local[in_col]; - } - - - -template -template -arma_inline -eT& -Row::fixed::operator() (const uword in_row, const uword in_col) - { - arma_conform_check_bounds( ((in_row > 0) || (in_col >= fixed_n_elem)), "Row::operator(): index out of bounds" ); - - return (use_extra) ? mem_local_extra[in_col] : Mat::mem_local[in_col]; - } - - - -template -template -arma_inline -const eT& -Row::fixed::operator() (const uword in_row, const uword in_col) const - { - arma_conform_check_bounds( ((in_row > 0) || (in_col >= fixed_n_elem)), "Row::operator(): index out of bounds" ); - - return (use_extra) ? mem_local_extra[in_col] : Mat::mem_local[in_col]; - } - - - -template -template -arma_inline -eT* -Row::fixed::memptr() - { - return (use_extra) ? mem_local_extra : Mat::mem_local; - } - - - -template -template -arma_inline -const eT* -Row::fixed::memptr() const - { - return (use_extra) ? mem_local_extra : Mat::mem_local; - } - - - -template -template -inline -const Row& -Row::fixed::fill(const eT val) - { - arma_debug_sigprint(); - - eT* mem_use = (use_extra) ? &(mem_local_extra[0]) : &(Mat::mem_local[0]); - - arrayops::inplace_set_fixed( mem_use, val ); - - return *this; - } - - - -template -template -inline -const Row& -Row::fixed::zeros() - { - arma_debug_sigprint(); - - eT* mem_use = (use_extra) ? &(mem_local_extra[0]) : &(Mat::mem_local[0]); - - arrayops::inplace_set_fixed( mem_use, eT(0) ); - - return *this; - } - - - -template -template -inline -const Row& -Row::fixed::ones() - { - arma_debug_sigprint(); - - eT* mem_use = (use_extra) ? &(mem_local_extra[0]) : &(Mat::mem_local[0]); - - arrayops::inplace_set_fixed( mem_use, eT(1) ); - - return *this; - } - - - -template -inline -Row::Row(const arma_fixed_indicator&, const uword in_n_elem, const eT* in_mem) - : Mat(arma_fixed_indicator(), 1, in_n_elem, 2, in_mem) - { - arma_debug_sigprint_this(this); - } - - - -#if defined(ARMA_EXTRA_ROW_MEAT) - #include ARMA_INCFILE_WRAP(ARMA_EXTRA_ROW_MEAT) -#endif - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SizeCube_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SizeCube_bones.hpp deleted file mode 100644 index 96b26af67..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SizeCube_bones.hpp +++ /dev/null @@ -1,52 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SizeCube -//! @{ - - - -class SizeCube - { - public: - - const uword n_rows; - const uword n_cols; - const uword n_slices; - - inline explicit SizeCube(const uword in_n_rows, const uword in_n_cols, const uword in_n_slices); - - inline uword operator[](const uword dim) const; - inline uword operator()(const uword dim) const; - - inline bool operator==(const SizeCube& s) const; - inline bool operator!=(const SizeCube& s) const; - - inline SizeCube operator+(const SizeCube& s) const; - inline SizeCube operator-(const SizeCube& s) const; - - inline SizeCube operator+(const uword val) const; - inline SizeCube operator-(const uword val) const; - - inline SizeCube operator*(const uword val) const; - inline SizeCube operator/(const uword val) const; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SizeCube_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SizeCube_meat.hpp deleted file mode 100644 index e54540e59..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SizeCube_meat.hpp +++ /dev/null @@ -1,155 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SizeCube -//! @{ - - - -inline -SizeCube::SizeCube(const uword in_n_rows, const uword in_n_cols, const uword in_n_slices) - : n_rows (in_n_rows ) - , n_cols (in_n_cols ) - , n_slices(in_n_slices) - { - arma_debug_sigprint(); - } - - - -inline -uword -SizeCube::operator[](const uword dim) const - { - if(dim == 0) { return n_rows; } - if(dim == 1) { return n_cols; } - if(dim == 2) { return n_slices; } - - return uword(1); - } - - - -inline -uword -SizeCube::operator()(const uword dim) const - { - if(dim == 0) { return n_rows; } - if(dim == 1) { return n_cols; } - if(dim == 2) { return n_slices; } - - arma_conform_check_bounds(true, "size(): index out of bounds"); - - return uword(1); - } - - - -inline -bool -SizeCube::operator==(const SizeCube& s) const - { - if(n_rows != s.n_rows ) { return false; } - - if(n_cols != s.n_cols ) { return false; } - - if(n_slices != s.n_slices) { return false; } - - return true; - } - - - -inline -bool -SizeCube::operator!=(const SizeCube& s) const - { - if(n_rows != s.n_rows ) { return true; } - - if(n_cols != s.n_cols ) { return true; } - - if(n_slices != s.n_slices) { return true; } - - return false; - } - - - -inline -SizeCube -SizeCube::operator+(const SizeCube& s) const - { - return SizeCube( (n_rows + s.n_rows), (n_cols + s.n_cols), (n_slices + s.n_slices) ); - } - - - -inline -SizeCube -SizeCube::operator-(const SizeCube& s) const - { - const uword out_n_rows = (n_rows > s.n_rows ) ? (n_rows - s.n_rows ) : uword(0); - const uword out_n_cols = (n_cols > s.n_cols ) ? (n_cols - s.n_cols ) : uword(0); - const uword out_n_slices = (n_slices > s.n_slices) ? (n_slices - s.n_slices) : uword(0); - - return SizeCube(out_n_rows, out_n_cols, out_n_slices); - } - - - -inline -SizeCube -SizeCube::operator+(const uword val) const - { - return SizeCube( (n_rows + val), (n_cols + val), (n_slices + val) ); - } - - - -inline -SizeCube -SizeCube::operator-(const uword val) const - { - const uword out_n_rows = (n_rows > val) ? (n_rows - val) : uword(0); - const uword out_n_cols = (n_cols > val) ? (n_cols - val) : uword(0); - const uword out_n_slices = (n_slices > val) ? (n_slices - val) : uword(0); - - return SizeCube(out_n_rows, out_n_cols, out_n_slices); - } - - - -inline -SizeCube -SizeCube::operator*(const uword val) const - { - return SizeCube( (n_rows * val), (n_cols * val), (n_slices * val) ); - } - - - -inline -SizeCube -SizeCube::operator/(const uword val) const - { - return SizeCube( (n_rows / val), (n_cols / val), (n_slices / val) ); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SizeMat_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SizeMat_bones.hpp deleted file mode 100644 index 6139d3366..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SizeMat_bones.hpp +++ /dev/null @@ -1,51 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SizeMat -//! @{ - - - -class SizeMat - { - public: - - const uword n_rows; - const uword n_cols; - - inline explicit SizeMat(const uword in_n_rows, const uword in_n_cols); - - inline uword operator[](const uword dim) const; - inline uword operator()(const uword dim) const; - - inline bool operator==(const SizeMat& s) const; - inline bool operator!=(const SizeMat& s) const; - - inline SizeMat operator+(const SizeMat& s) const; - inline SizeMat operator-(const SizeMat& s) const; - - inline SizeMat operator+(const uword val) const; - inline SizeMat operator-(const uword val) const; - - inline SizeMat operator*(const uword val) const; - inline SizeMat operator/(const uword val) const; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SizeMat_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SizeMat_meat.hpp deleted file mode 100644 index f6f21ddad..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SizeMat_meat.hpp +++ /dev/null @@ -1,146 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SizeMat -//! @{ - - - -inline -SizeMat::SizeMat(const uword in_n_rows, const uword in_n_cols) - : n_rows(in_n_rows) - , n_cols(in_n_cols) - { - arma_debug_sigprint(); - } - - - -inline -uword -SizeMat::operator[](const uword dim) const - { - if(dim == 0) { return n_rows; } - if(dim == 1) { return n_cols; } - - return uword(1); - } - - - -inline -uword -SizeMat::operator()(const uword dim) const - { - if(dim == 0) { return n_rows; } - if(dim == 1) { return n_cols; } - - arma_conform_check_bounds(true, "size(): index out of bounds"); - - return uword(1); - } - - - -inline -bool -SizeMat::operator==(const SizeMat& s) const - { - if(n_rows != s.n_rows) { return false; } - - if(n_cols != s.n_cols) { return false; } - - return true; - } - - - -inline -bool -SizeMat::operator!=(const SizeMat& s) const - { - if(n_rows != s.n_rows) { return true; } - - if(n_cols != s.n_cols) { return true; } - - return false; - } - - - -inline -SizeMat -SizeMat::operator+(const SizeMat& s) const - { - return SizeMat( (n_rows + s.n_rows), (n_cols + s.n_cols) ); - } - - - -inline -SizeMat -SizeMat::operator-(const SizeMat& s) const - { - const uword out_n_rows = (n_rows > s.n_rows) ? (n_rows - s.n_rows) : uword(0); - const uword out_n_cols = (n_cols > s.n_cols) ? (n_cols - s.n_cols) : uword(0); - - return SizeMat(out_n_rows, out_n_cols); - } - - - -inline -SizeMat -SizeMat::operator+(const uword val) const - { - return SizeMat( (n_rows + val), (n_cols + val) ); - } - - - -inline -SizeMat -SizeMat::operator-(const uword val) const - { - const uword out_n_rows = (n_rows > val) ? (n_rows - val) : uword(0); - const uword out_n_cols = (n_cols > val) ? (n_cols - val) : uword(0); - - return SizeMat(out_n_rows, out_n_cols); - } - - - -inline -SizeMat -SizeMat::operator*(const uword val) const - { - return SizeMat( (n_rows * val), (n_cols * val) ); - } - - - -inline -SizeMat -SizeMat::operator/(const uword val) const - { - return SizeMat( (n_rows / val), (n_cols / val) ); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpBase_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpBase_bones.hpp deleted file mode 100644 index cc53e93b9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpBase_bones.hpp +++ /dev/null @@ -1,118 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpBase -//! @{ - - - -template -struct SpBase_eval_SpMat - { - arma_warn_unused inline const derived& eval() const; - }; - - -template -struct SpBase_eval_expr - { - arma_warn_unused inline SpMat eval() const; //!< force the immediate evaluation of a delayed expression - }; - - -template -struct SpBase_eval {}; - -template -struct SpBase_eval { typedef SpBase_eval_SpMat result; }; - -template -struct SpBase_eval { typedef SpBase_eval_expr result; }; - - - -template -struct SpBase - : public SpBase_eval::value>::result - { - arma_inline const derived& get_ref() const; - - arma_inline bool is_alias(const SpMat& X) const; - - arma_warn_unused inline const SpOp t() const; //!< Hermitian transpose - arma_warn_unused inline const SpOp ht() const; //!< Hermitian transpose - arma_warn_unused inline const SpOp st() const; //!< simple transpose - - arma_cold inline void print( const std::string extra_text = "") const; - arma_cold inline void print(std::ostream& user_stream, const std::string extra_text = "") const; - - arma_cold inline void raw_print( const std::string extra_text = "") const; - arma_cold inline void raw_print(std::ostream& user_stream, const std::string extra_text = "") const; - - arma_cold inline void print_dense( const std::string extra_text = "") const; - arma_cold inline void print_dense(std::ostream& user_stream, const std::string extra_text = "") const; - - arma_cold inline void raw_print_dense( const std::string extra_text = "") const; - arma_cold inline void raw_print_dense(std::ostream& user_stream, const std::string extra_text = "") const; - - arma_cold inline void brief_print( const std::string extra_text = "") const; - arma_cold inline void brief_print(std::ostream& user_stream, const std::string extra_text = "") const; - - arma_warn_unused inline elem_type min() const; - arma_warn_unused inline elem_type max() const; - - inline elem_type min(uword& index_of_min_val) const; - inline elem_type max(uword& index_of_max_val) const; - - inline elem_type min(uword& row_of_min_val, uword& col_of_min_val) const; - inline elem_type max(uword& row_of_max_val, uword& col_of_max_val) const; - - arma_warn_unused inline uword index_min() const; - arma_warn_unused inline uword index_max() const; - - arma_warn_unused inline bool is_symmetric() const; - arma_warn_unused inline bool is_symmetric(const typename get_pod_type::result tol) const; - - arma_warn_unused inline bool is_hermitian() const; - arma_warn_unused inline bool is_hermitian(const typename get_pod_type::result tol) const; - - arma_warn_unused inline bool is_zero(const typename get_pod_type::result tol = 0) const; - - arma_warn_unused inline bool is_trimatu() const; - arma_warn_unused inline bool is_trimatl() const; - arma_warn_unused inline bool is_diagmat() const; - arma_warn_unused inline bool is_empty() const; - arma_warn_unused inline bool is_square() const; - arma_warn_unused inline bool is_vec() const; - arma_warn_unused inline bool is_colvec() const; - arma_warn_unused inline bool is_rowvec() const; - arma_warn_unused inline bool is_finite() const; - - arma_warn_unused inline bool has_inf() const; - arma_warn_unused inline bool has_nan() const; - arma_warn_unused inline bool has_nonfinite() const; - - arma_warn_unused inline const SpOp as_col() const; - arma_warn_unused inline const SpOp as_row() const; - - arma_warn_unused inline const SpToDOp as_dense() const; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpBase_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpBase_meat.hpp deleted file mode 100644 index d96cd051e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpBase_meat.hpp +++ /dev/null @@ -1,893 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpBase -//! @{ - - - -template -arma_inline -const derived& -SpBase::get_ref() const - { - return static_cast(*this); - } - - - -template -arma_inline -bool -SpBase::is_alias(const SpMat& X) const - { - return (*this).get_ref().is_alias(X); - } - - - -template -inline -const SpOp -SpBase::t() const - { - return SpOp( (*this).get_ref() ); - } - - -template -inline -const SpOp -SpBase::ht() const - { - return SpOp( (*this).get_ref() ); - } - - - -template -inline -const SpOp -SpBase::st() const - { - return SpOp( (*this).get_ref() ); - } - - - -template -inline -void -SpBase::print(const std::string extra_text) const - { - arma_debug_sigprint(); - - const unwrap_spmat tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = get_cout_stream().width(); - - get_cout_stream() << extra_text << '\n'; - - get_cout_stream().width(orig_width); - } - - arma_ostream::print(get_cout_stream(), tmp.M, true); - } - - - -template -inline -void -SpBase::print(std::ostream& user_stream, const std::string extra_text) const - { - arma_debug_sigprint(); - - const unwrap_spmat tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = user_stream.width(); - - user_stream << extra_text << '\n'; - - user_stream.width(orig_width); - } - - arma_ostream::print(user_stream, tmp.M, true); - } - - - -template -inline -void -SpBase::raw_print(const std::string extra_text) const - { - arma_debug_sigprint(); - - const unwrap_spmat tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = get_cout_stream().width(); - - get_cout_stream() << extra_text << '\n'; - - get_cout_stream().width(orig_width); - } - - arma_ostream::print(get_cout_stream(), tmp.M, false); - } - - - -template -inline -void -SpBase::raw_print(std::ostream& user_stream, const std::string extra_text) const - { - arma_debug_sigprint(); - - const unwrap_spmat tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = user_stream.width(); - - user_stream << extra_text << '\n'; - - user_stream.width(orig_width); - } - - arma_ostream::print(user_stream, tmp.M, false); - } - - - -template -inline -void -SpBase::print_dense(const std::string extra_text) const - { - arma_debug_sigprint(); - - const unwrap_spmat tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = get_cout_stream().width(); - - get_cout_stream() << extra_text << '\n'; - - get_cout_stream().width(orig_width); - } - - arma_ostream::print_dense(get_cout_stream(), tmp.M, true); - } - - - -template -inline -void -SpBase::print_dense(std::ostream& user_stream, const std::string extra_text) const - { - arma_debug_sigprint(); - - const unwrap_spmat tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = user_stream.width(); - - user_stream << extra_text << '\n'; - - user_stream.width(orig_width); - } - - arma_ostream::print_dense(user_stream, tmp.M, true); - } - - - -template -inline -void -SpBase::raw_print_dense(const std::string extra_text) const - { - arma_debug_sigprint(); - - const unwrap_spmat tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = get_cout_stream().width(); - - get_cout_stream() << extra_text << '\n'; - - get_cout_stream().width(orig_width); - } - - arma_ostream::print_dense(get_cout_stream(), tmp.M, false); - } - - - -template -inline -void -SpBase::raw_print_dense(std::ostream& user_stream, const std::string extra_text) const - { - arma_debug_sigprint(); - - const unwrap_spmat tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = user_stream.width(); - - user_stream << extra_text << '\n'; - - user_stream.width(orig_width); - } - - arma_ostream::print_dense(user_stream, tmp.M, false); - } - - - -template -inline -void -SpBase::brief_print(const std::string extra_text) const - { - arma_debug_sigprint(); - - const unwrap_spmat tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = get_cout_stream().width(); - - get_cout_stream() << extra_text << '\n'; - - get_cout_stream().width(orig_width); - } - - arma_ostream::brief_print(get_cout_stream(), tmp.M); - } - - - -template -inline -void -SpBase::brief_print(std::ostream& user_stream, const std::string extra_text) const - { - arma_debug_sigprint(); - - const unwrap_spmat tmp( (*this).get_ref() ); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = user_stream.width(); - - user_stream << extra_text << '\n'; - - user_stream.width(orig_width); - } - - arma_ostream::brief_print(user_stream, tmp.M); - } - - - -// -// extra functions defined in SpBase_eval_SpMat - -template -inline -const derived& -SpBase_eval_SpMat::eval() const - { - arma_debug_sigprint(); - - return static_cast(*this); - } - - - -// -// extra functions defined in SpBase_eval_expr - -template -inline -SpMat -SpBase_eval_expr::eval() const - { - arma_debug_sigprint(); - - return SpMat( static_cast(*this) ); - } - - - -template -inline -elem_type -SpBase::min() const - { - return op_sp_min::min( (*this).get_ref() ); - } - - - -template -inline -elem_type -SpBase::max() const - { - return op_sp_max::max( (*this).get_ref() ); - } - - - -template -inline -elem_type -SpBase::min(uword& index_of_min_val) const - { - const SpProxy P( (*this).get_ref() ); - - return op_sp_min::min_with_index(P, index_of_min_val); - } - - - -template -inline -elem_type -SpBase::max(uword& index_of_max_val) const - { - const SpProxy P( (*this).get_ref() ); - - return op_sp_max::max_with_index(P, index_of_max_val); - } - - - -template -inline -elem_type -SpBase::min(uword& row_of_min_val, uword& col_of_min_val) const - { - const SpProxy P( (*this).get_ref() ); - - uword index = 0; - - const elem_type val = op_sp_min::min_with_index(P, index); - - const uword local_n_rows = P.get_n_rows(); - - row_of_min_val = index % local_n_rows; - col_of_min_val = index / local_n_rows; - - return val; - } - - - -template -inline -elem_type -SpBase::max(uword& row_of_max_val, uword& col_of_max_val) const - { - const SpProxy P( (*this).get_ref() ); - - uword index = 0; - - const elem_type val = op_sp_max::max_with_index(P, index); - - const uword local_n_rows = P.get_n_rows(); - - row_of_max_val = index % local_n_rows; - col_of_max_val = index / local_n_rows; - - return val; - } - - - -template -inline -uword -SpBase::index_min() const - { - const SpProxy P( (*this).get_ref() ); - - uword index = 0; - - if(P.get_n_elem() == 0) - { - arma_conform_check(true, "index_min(): object has no elements"); - } - else - { - op_sp_min::min_with_index(P, index); - } - - return index; - } - - - -template -inline -uword -SpBase::index_max() const - { - const SpProxy P( (*this).get_ref() ); - - uword index = 0; - - if(P.get_n_elem() == 0) - { - arma_conform_check(true, "index_max(): object has no elements"); - } - else - { - op_sp_max::max_with_index(P, index); - } - - return index; - } - - - -template -inline -bool -SpBase::is_symmetric() const - { - arma_debug_sigprint(); - - const unwrap_spmat tmp( (*this).get_ref() ); - - return tmp.M.is_symmetric(); - } - - - -template -inline -bool -SpBase::is_symmetric(const typename get_pod_type::result tol) const - { - arma_debug_sigprint(); - - const unwrap_spmat tmp( (*this).get_ref() ); - - return tmp.M.is_symmetric(tol); - } - - - -template -inline -bool -SpBase::is_hermitian() const - { - arma_debug_sigprint(); - - const unwrap_spmat tmp( (*this).get_ref() ); - - return tmp.M.is_hermitian(); - } - - - -template -inline -bool -SpBase::is_hermitian(const typename get_pod_type::result tol) const - { - arma_debug_sigprint(); - - const unwrap_spmat tmp( (*this).get_ref() ); - - return tmp.M.is_hermitian(tol); - } - - - -template -inline -bool -SpBase::is_zero(const typename get_pod_type::result tol) const - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - arma_conform_check( (tol < T(0)), "is_zero(): parameter 'tol' must be >= 0" ); - - const SpProxy P( (*this).get_ref() ); - - if(P.get_n_elem() == 0) { return false; } - - if(P.get_n_nonzero() == 0) { return true; } - - if(is_SpMat::stored_type>::value) - { - const unwrap_spmat::stored_type> U(P.Q); - - return arrayops::is_zero(U.M.values, U.M.n_nonzero, tol); - } - - typename SpProxy::const_iterator_type it = P.begin(); - typename SpProxy::const_iterator_type it_end = P.end(); - - if(is_cx::yes) - { - while(it != it_end) - { - const elem_type val = (*it); - - const T val_real = access::tmp_real(val); - const T val_imag = access::tmp_imag(val); - - if(eop_aux::arma_abs(val_real) > tol) { return false; } - if(eop_aux::arma_abs(val_imag) > tol) { return false; } - - ++it; - } - } - else // not complex - { - while(it != it_end) - { - if(eop_aux::arma_abs(*it) > tol) { return false; } - - ++it; - } - } - - return true; - } - - - -template -inline -bool -SpBase::is_trimatu() const - { - arma_debug_sigprint(); - - const SpProxy P( (*this).get_ref() ); - - if(P.get_n_rows() != P.get_n_cols()) { return false; } - - typename SpProxy::const_iterator_type it = P.begin(); - typename SpProxy::const_iterator_type it_end = P.end(); - - while(it != it_end) - { - if(it.row() > it.col()) { return false; } - ++it; - } - - return true; - } - - - -template -inline -bool -SpBase::is_trimatl() const - { - arma_debug_sigprint(); - - const SpProxy P( (*this).get_ref() ); - - if(P.get_n_rows() != P.get_n_cols()) { return false; } - - typename SpProxy::const_iterator_type it = P.begin(); - typename SpProxy::const_iterator_type it_end = P.end(); - - while(it != it_end) - { - if(it.row() < it.col()) { return false; } - ++it; - } - - return true; - } - - - -template -inline -bool -SpBase::is_diagmat() const - { - arma_debug_sigprint(); - - const SpProxy P( (*this).get_ref() ); - - typename SpProxy::const_iterator_type it = P.begin(); - typename SpProxy::const_iterator_type it_end = P.end(); - - while(it != it_end) - { - if(it.row() != it.col()) { return false; } - ++it; - } - - return true; - } - - - -template -inline -bool -SpBase::is_empty() const - { - arma_debug_sigprint(); - - const SpProxy P( (*this).get_ref() ); - - return (P.get_n_elem() == uword(0)); - } - - - -template -inline -bool -SpBase::is_square() const - { - arma_debug_sigprint(); - - const SpProxy P( (*this).get_ref() ); - - return (P.get_n_rows() == P.get_n_cols()); - } - - - -template -inline -bool -SpBase::is_vec() const - { - arma_debug_sigprint(); - - if( (SpProxy::is_row) || (SpProxy::is_col) || (SpProxy::is_xvec) ) { return true; } - - const SpProxy P( (*this).get_ref() ); - - return ( (P.get_n_rows() == uword(1)) || (P.get_n_cols() == uword(1)) ); - } - - - -template -inline -bool -SpBase::is_colvec() const - { - arma_debug_sigprint(); - - if(SpProxy::is_col) { return true; } - - const SpProxy P( (*this).get_ref() ); - - return (P.get_n_cols() == uword(1)); - } - - - -template -inline -bool -SpBase::is_rowvec() const - { - arma_debug_sigprint(); - - if(SpProxy::is_row) { return true; } - - const SpProxy P( (*this).get_ref() ); - - return (P.get_n_rows() == uword(1)); - } - - - -template -inline -bool -SpBase::is_finite() const - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "is_finite(): detection of non-finite values is not reliable in fast math mode"); } - - if(is_SpMat::stored_type>::value) - { - const unwrap_spmat U( (*this).get_ref() ); - - return U.M.internal_is_finite(); - } - else - { - const SpProxy P( (*this).get_ref() ); - - typename SpProxy::const_iterator_type it = P.begin(); - typename SpProxy::const_iterator_type it_end = P.end(); - - while(it != it_end) - { - if(arma_isfinite(*it) == false) { return false; } - ++it; - } - } - - return true; - } - - - -template -inline -bool -SpBase::has_inf() const - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "has_inf(): detection of non-finite values is not reliable in fast math mode"); } - - if(is_SpMat::stored_type>::value) - { - const unwrap_spmat U( (*this).get_ref() ); - - return U.M.internal_has_inf(); - } - else - { - const SpProxy P( (*this).get_ref() ); - - typename SpProxy::const_iterator_type it = P.begin(); - typename SpProxy::const_iterator_type it_end = P.end(); - - while(it != it_end) - { - if(arma_isinf(*it)) { return true; } - ++it; - } - } - - return false; - } - - - -template -inline -bool -SpBase::has_nan() const - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "has_nan(): detection of non-finite values is not reliable in fast math mode"); } - - if(is_SpMat::stored_type>::value) - { - const unwrap_spmat U( (*this).get_ref() ); - - return U.M.internal_has_nan(); - } - else - { - const SpProxy P( (*this).get_ref() ); - - typename SpProxy::const_iterator_type it = P.begin(); - typename SpProxy::const_iterator_type it_end = P.end(); - - while(it != it_end) - { - if(arma_isnan(*it)) { return true; } - ++it; - } - } - - return false; - } - - - -template -inline -bool -SpBase::has_nonfinite() const - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "has_nonfinite(): detection of non-finite values is not reliable in fast math mode"); } - - if(is_SpMat::stored_type>::value) - { - const unwrap_spmat U( (*this).get_ref() ); - - return U.M.internal_has_nonfinite(); - } - else - { - const SpProxy P( (*this).get_ref() ); - - typename SpProxy::const_iterator_type it = P.begin(); - typename SpProxy::const_iterator_type it_end = P.end(); - - while(it != it_end) - { - if(arma_isfinite(*it) == false) { return true; } - ++it; - } - } - - return false; - } - - - -template -inline -const SpOp -SpBase::as_col() const - { - return SpOp( (*this).get_ref() ); - } - - - -template -inline -const SpOp -SpBase::as_row() const - { - return SpOp( (*this).get_ref() ); - } - - - -template -inline -const SpToDOp -SpBase::as_dense() const - { - return SpToDOp( (*this).get_ref() ); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpCol_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpCol_bones.hpp deleted file mode 100644 index 03b4b5fa8..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpCol_bones.hpp +++ /dev/null @@ -1,86 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpCol -//! @{ - - -//! Class for sparse column vectors (matrices with only one column) -template -class SpCol : public SpMat - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - - inline SpCol(); - inline explicit SpCol(const uword n_elem); - inline explicit SpCol(const uword in_rows, const uword in_cols); - inline explicit SpCol(const SizeMat& s); - - inline SpCol(const char* text); - inline SpCol& operator=(const char* text); - - inline SpCol(const std::string& text); - inline SpCol& operator=(const std::string& text); - - inline SpCol& operator=(const eT val); - - inline SpCol(const Col& X); // for backwards compatibility - - template inline explicit SpCol(const Base& X); - template inline SpCol& operator=(const Base& X); - - template inline SpCol(const SpBase& X); - template inline SpCol& operator=(const SpBase& X); - - template - inline explicit SpCol(const SpBase& A, const SpBase& B); - - arma_warn_unused inline const SpOp,spop_htrans> t() const; - arma_warn_unused inline const SpOp,spop_htrans> ht() const; - arma_warn_unused inline const SpOp,spop_strans> st() const; - - arma_warn_unused inline const SpToDOp,op_sp_as_dense> as_dense() const; - - inline void shed_row (const uword row_num); - inline void shed_rows(const uword in_row1, const uword in_row2); - - // inline void insert_rows(const uword row_num, const uword N, const bool set_to_zero = true); - - - typedef typename SpMat::iterator row_iterator; - typedef typename SpMat::const_iterator const_row_iterator; - - inline row_iterator begin_row(const uword row_num = 0); - inline const_row_iterator begin_row(const uword row_num = 0) const; - - inline row_iterator end_row (const uword row_num = 0); - inline const_row_iterator end_row (const uword row_num = 0) const; - - - #if defined(ARMA_EXTRA_SPCOL_PROTO) - #include ARMA_INCFILE_WRAP(ARMA_EXTRA_SPCOL_PROTO) - #endif - }; diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpCol_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpCol_meat.hpp deleted file mode 100644 index 9ff3bf23d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpCol_meat.hpp +++ /dev/null @@ -1,454 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpCol -//! @{ - - - -template -inline -SpCol::SpCol() - : SpMat(arma_vec_indicator(), 1) - { - arma_debug_sigprint(); - } - - - -template -inline -SpCol::SpCol(const uword in_n_elem) - : SpMat(arma_vec_indicator(), in_n_elem, 1, 1) - { - arma_debug_sigprint(); - } - - - -template -inline -SpCol::SpCol(const uword in_n_rows, const uword in_n_cols) - : SpMat(arma_vec_indicator(), in_n_rows, in_n_cols, 1) - { - arma_debug_sigprint(); - } - - - -template -inline -SpCol::SpCol(const SizeMat& s) - : SpMat(arma_vec_indicator(), 0, 0, 1) - { - arma_debug_sigprint(); - - SpMat::init(s.n_rows, s.n_cols); - } - - - -template -inline -SpCol::SpCol(const char* text) - : SpMat(arma_vec_indicator(), 1) - { - arma_debug_sigprint(); - - SpMat::init(std::string(text)); - } - - - -template -inline -SpCol& -SpCol::operator=(const char* text) - { - arma_debug_sigprint(); - - SpMat::init(std::string(text)); - - return *this; - } - - - -template -inline -SpCol::SpCol(const std::string& text) - : SpMat(arma_vec_indicator(), 1) - { - arma_debug_sigprint(); - - SpMat::init(text); - } - - - -template -inline -SpCol& -SpCol::operator=(const std::string& text) - { - arma_debug_sigprint(); - - SpMat::init(text); - - return *this; - } - - - -template -inline -SpCol& -SpCol::operator=(const eT val) - { - arma_debug_sigprint(); - - SpMat::operator=(val); - - return *this; - } - - - -template -template -inline -SpCol::SpCol(const Base& X) - : SpMat(arma_vec_indicator(), 1) - { - arma_debug_sigprint(); - - SpMat::operator=(X.get_ref()); - } - - - -template -inline -SpCol::SpCol(const Col& X) - : SpMat(arma_vec_indicator(), 1) - { - arma_debug_sigprint(); - - SpMat::operator=(X); - } - - - -template -template -inline -SpCol& -SpCol::operator=(const Base& X) - { - arma_debug_sigprint(); - - SpMat::operator=(X.get_ref()); - - return *this; - } - - - -template -template -inline -SpCol::SpCol(const SpBase& X) - : SpMat(arma_vec_indicator(), 1) - { - arma_debug_sigprint(); - - SpMat::operator=(X.get_ref()); - } - - - -template -template -inline -SpCol& -SpCol::operator=(const SpBase& X) - { - arma_debug_sigprint(); - - SpMat::operator=(X.get_ref()); - - return *this; - } - - - -template -template -inline -SpCol::SpCol - ( - const SpBase::pod_type, T1>& A, - const SpBase::pod_type, T2>& B - ) - : SpMat(arma_vec_indicator(), 1) - { - arma_debug_sigprint(); - - SpMat::init(A,B); - } - - - -template -inline -const SpOp,spop_htrans> -SpCol::t() const - { - return SpOp,spop_htrans>(*this); - } - - - -template -inline -const SpOp,spop_htrans> -SpCol::ht() const - { - return SpOp,spop_htrans>(*this); - } - - - -template -inline -const SpOp,spop_strans> -SpCol::st() const - { - return SpOp,spop_strans>(*this); - } - - - -template -inline -const SpToDOp,op_sp_as_dense> -SpCol::as_dense() const - { - return SpToDOp,op_sp_as_dense>(*this); - } - - - -//! remove specified row -template -inline -void -SpCol::shed_row(const uword row_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( row_num >= SpMat::n_rows, "SpCol::shed_row(): out of bounds" ); - - shed_rows(row_num, row_num); - } - - - -//! remove specified rows -template -inline -void -SpCol::shed_rows(const uword in_row1, const uword in_row2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_row2 >= SpMat::n_rows), - "SpCol::shed_rows(): indices out of bounds or incorrectly used" - ); - - SpMat::sync_csc(); - - const uword diff = (in_row2 - in_row1 + 1); - - // This is easy because everything is in one column. - uword start = 0, end = 0; - bool start_found = false, end_found = false; - for(uword i = 0; i < SpMat::n_nonzero; ++i) - { - // Start position found? - if(SpMat::row_indices[i] >= in_row1 && !start_found) - { - start = i; - start_found = true; - } - - // End position found? - if(SpMat::row_indices[i] > in_row2) - { - end = i; - end_found = true; - break; - } - } - - if(!end_found) - { - end = SpMat::n_nonzero; - } - - // Now we can make the copy. - if(start != end) - { - const uword elem_diff = end - start; - - eT* new_values = memory::acquire (SpMat::n_nonzero - elem_diff); - uword* new_row_indices = memory::acquire(SpMat::n_nonzero - elem_diff); - - // Copy before the section we are dropping (if it exists). - if(start > 0) - { - arrayops::copy(new_values, SpMat::values, start); - arrayops::copy(new_row_indices, SpMat::row_indices, start); - } - - // Copy after the section we are dropping (if it exists). - if(end != SpMat::n_nonzero) - { - arrayops::copy(new_values + start, SpMat::values + end, (SpMat::n_nonzero - end)); - arrayops::copy(new_row_indices + start, SpMat::row_indices + end, (SpMat::n_nonzero - end)); - arrayops::inplace_minus(new_row_indices + start, diff, (SpMat::n_nonzero - end)); - } - - memory::release(SpMat::values); - memory::release(SpMat::row_indices); - - access::rw(SpMat::values) = new_values; - access::rw(SpMat::row_indices) = new_row_indices; - - access::rw(SpMat::n_nonzero) -= elem_diff; - access::rw(SpMat::col_ptrs[1]) -= elem_diff; - } - - access::rw(SpMat::n_rows) -= diff; - access::rw(SpMat::n_elem) -= diff; - - SpMat::invalidate_cache(); - } - - - -// //! insert N rows at the specified row position, -// //! optionally setting the elements of the inserted rows to zero -// template -// inline -// void -// SpCol::insert_rows(const uword row_num, const uword N, const bool set_to_zero) -// { -// arma_debug_sigprint(); -// -// arma_conform_check(set_to_zero == false, "SpCol::insert_rows(): cannot set nonzero values"); -// -// arma_conform_check_bounds((row_num > SpMat::n_rows), "SpCol::insert_rows(): out of bounds"); -// -// for(uword row = 0; row < SpMat::n_rows; ++row) -// { -// if(SpMat::row_indices[row] >= row_num) -// { -// access::rw(SpMat::row_indices[row]) += N; -// } -// } -// -// access::rw(SpMat::n_rows) += N; -// access::rw(SpMat::n_elem) += N; -// } - - - -template -inline -typename SpCol::row_iterator -SpCol::begin_row(const uword row_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (row_num >= SpMat::n_rows), "SpCol::begin_row(): index out of bounds" ); - - SpMat::sync_csc(); - - return row_iterator(*this, row_num, 0); - } - - - -template -inline -typename SpCol::const_row_iterator -SpCol::begin_row(const uword row_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (row_num >= SpMat::n_rows), "SpCol::begin_row(): index out of bounds" ); - - SpMat::sync_csc(); - - return const_row_iterator(*this, row_num, 0); - } - - - -template -inline -typename SpCol::row_iterator -SpCol::end_row(const uword row_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (row_num >= SpMat::n_rows), "SpCol::end_row(): index out of bounds" ); - - SpMat::sync_csc(); - - return row_iterator(*this, row_num + 1, 0); - } - - - -template -inline -typename SpCol::const_row_iterator -SpCol::end_row(const uword row_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (row_num >= SpMat::n_rows), "SpCol::end_row(): index out of bounds" ); - - SpMat::sync_csc(); - - return const_row_iterator(*this, row_num + 1, 0); - } - - - -#if defined(ARMA_EXTRA_SPCOL_MEAT) - #include ARMA_INCFILE_WRAP(ARMA_EXTRA_SPCOL_MEAT) -#endif - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpGlue_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpGlue_bones.hpp deleted file mode 100644 index 3c5432d8e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpGlue_bones.hpp +++ /dev/null @@ -1,49 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpGlue -//! @{ - - - -template -class SpGlue : public SpBase< typename T1::elem_type, SpGlue > - { - public: - - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_row = spglue_type::template traits::is_row; - static constexpr bool is_col = spglue_type::template traits::is_col; - static constexpr bool is_xvec = spglue_type::template traits::is_xvec; - - inline SpGlue(const T1& in_A, const T2& in_B); - inline SpGlue(const T1& in_A, const T2& in_B, const elem_type in_aux); - inline ~SpGlue(); - - arma_inline bool is_alias(const SpMat& X) const; - - const T1& A; //!< first operand; must be derived from SpBase - const T2& B; //!< second operand; must be derived from SpBase - elem_type aux; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpGlue_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpGlue_meat.hpp deleted file mode 100644 index 5cf5bbd20..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpGlue_meat.hpp +++ /dev/null @@ -1,66 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpGlue -//! @{ - - - -template -inline -SpGlue::SpGlue(const T1& in_A, const T2& in_B) - : A(in_A) - , B(in_B) - { - arma_debug_sigprint(); - } - - - -template -inline -SpGlue::SpGlue(const T1& in_A, const T2& in_B, const typename T1::elem_type in_aux) - : A(in_A) - , B(in_B) - , aux(in_aux) - { - arma_debug_sigprint(); - } - - - -template -inline -SpGlue::~SpGlue() - { - arma_debug_sigprint(); - } - - - -template -arma_inline -bool -SpGlue::is_alias(const SpMat& X) const - { - return (A.is_alias(X) || B.is_alias(X)); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpMat_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpMat_bones.hpp deleted file mode 100644 index 34b7d81b5..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpMat_bones.hpp +++ /dev/null @@ -1,748 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpMat -//! @{ - - -//! Sparse matrix class, with data stored in compressed sparse column (CSC) format -template -class SpMat : public SpBase< eT, SpMat > - { - public: - - typedef eT elem_type; //!< the type of elements stored in the matrix - typedef typename get_pod_type::result pod_type; //!< if eT is std::complex, pod_type is T; otherwise pod_type is eT - - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - const uword n_rows; //!< number of rows (read-only) - const uword n_cols; //!< number of columns (read-only) - const uword n_elem; //!< number of elements (read-only) - const uword n_nonzero; //!< number of nonzero elements (read-only) - const uword vec_state; //!< 0: matrix; 1: column vector; 2: row vector - - - // The memory used to store the values of the matrix. - // In accordance with the CSC format, this stores only the actual values. - // The correct locations of the values are assembled from the row indices and column pointers. - // - // The length of this array is (n_nonzero + 1). - // The final value values[n_nonzero] must be zero to ensure integrity of iterators. - // Use mem_resize(new_n_nonzero) to resize this array. - // - // WARNING: the 'values' array is only valid after sync() is called; - // WARNING: there is a separate cache for fast element insertion - - arma_aligned const eT* const values; - - - // The row indices of each value. row_indices[i] is the row of values[i]. - // - // The length of this array is (n_nonzero + 1). - // The final value row_indices[n_nonzero] must be zero to ensure integrity of iterators. - // Use mem_resize(new_n_nonzero) to resize this array. - // - // WARNING: the 'row_indices' array is only valid after sync() is called; - // WARNING: there is a separate cache for fast element insertion - - arma_aligned const uword* const row_indices; - - - // The column pointers. This stores the index of the first item in column i. - // That is, values[col_ptrs[i]] is the first value in column i, - // and it is in the row indicated by row_indices[col_ptrs[i]]. - // - // The length of this array is (n_cols + 2). - // The element col_ptrs[n_cols] must be equal to n_nonzero. - // The element col_ptrs[n_cols + 1] must be an invalid very large value to ensure integrity of iterators. - // - // The col_ptrs array is set by the init() function - // (which is called by constructors, set_size() and other functions that change the matrix size). - // - // WARNING: the 'col_ptrs' array is only valid after sync() is called; - // WARNING: there is a separate cache for fast element insertion - - arma_aligned const uword* const col_ptrs; - - inline SpMat(); - inline ~SpMat(); - - inline explicit SpMat(const uword in_rows, const uword in_cols); - inline explicit SpMat(const SizeMat& s); - - inline SpMat(const char* text); - inline SpMat& operator=(const char* text); - inline SpMat(const std::string& text); - inline SpMat& operator=(const std::string& text); - inline SpMat(const SpMat& x); - - inline SpMat(SpMat&& m); - inline SpMat& operator=(SpMat&& m); - - inline explicit SpMat(const MapMat& x); - inline SpMat& operator= (const MapMat& x); - - template - inline SpMat(const Base& rowind, const Base& colptr, const Base& values, const uword n_rows, const uword n_cols, const bool check_for_zeros = true); - - template - inline SpMat(const Base& locations, const Base& values, const bool sort_locations = true); - - template - inline SpMat(const Base& locations, const Base& values, const uword n_rows, const uword n_cols, const bool sort_locations = true, const bool check_for_zeros = true); - - template - inline SpMat(const bool add_values, const Base& locations, const Base& values, const uword n_rows, const uword n_cols, const bool sort_locations = true, const bool check_for_zeros = true); - - inline SpMat& operator= (const eT val); //! sets size to 1x1 - inline SpMat& operator*=(const eT val); - inline SpMat& operator/=(const eT val); - // operator+=(val) and operator-=(val) are not defined as they don't make sense for sparse matrices - - inline SpMat& operator= (const SpMat& m); - inline SpMat& operator+=(const SpMat& m); - inline SpMat& operator-=(const SpMat& m); - inline SpMat& operator*=(const SpMat& m); - inline SpMat& operator%=(const SpMat& m); - inline SpMat& operator/=(const SpMat& m); - - template inline explicit SpMat(const Base& m); - template inline SpMat& operator= (const Base& m); - template inline SpMat& operator+=(const Base& m); - template inline SpMat& operator-=(const Base& m); - template inline SpMat& operator*=(const Base& m); - template inline SpMat& operator/=(const Base& m); - template inline SpMat& operator%=(const Base& m); - - template inline explicit SpMat(const Op& expr); - template inline SpMat& operator= (const Op& expr); - template inline SpMat& operator+=(const Op& expr); - template inline SpMat& operator-=(const Op& expr); - template inline SpMat& operator*=(const Op& expr); - template inline SpMat& operator/=(const Op& expr); - template inline SpMat& operator%=(const Op& expr); - - //! construction of complex matrix out of two non-complex matrices - template - inline explicit SpMat(const SpBase& A, const SpBase& B); - - inline SpMat(const SpSubview& X); - inline SpMat& operator= (const SpSubview& X); - inline SpMat& operator+=(const SpSubview& X); - inline SpMat& operator-=(const SpSubview& X); - inline SpMat& operator*=(const SpSubview& X); - inline SpMat& operator%=(const SpSubview& X); - inline SpMat& operator/=(const SpSubview& X); - - template inline SpMat(const SpSubview_col_list& X); - template inline SpMat& operator= (const SpSubview_col_list& X); - template inline SpMat& operator+=(const SpSubview_col_list& X); - template inline SpMat& operator-=(const SpSubview_col_list& X); - template inline SpMat& operator*=(const SpSubview_col_list& X); - template inline SpMat& operator%=(const SpSubview_col_list& X); - template inline SpMat& operator/=(const SpSubview_col_list& X); - - inline SpMat(const spdiagview& X); - inline SpMat& operator= (const spdiagview& X); - inline SpMat& operator+=(const spdiagview& X); - inline SpMat& operator-=(const spdiagview& X); - inline SpMat& operator*=(const spdiagview& X); - inline SpMat& operator%=(const spdiagview& X); - inline SpMat& operator/=(const spdiagview& X); - - template inline SpMat(const SpOp& X); - template inline SpMat& operator= (const SpOp& X); - template inline SpMat& operator+=(const SpOp& X); - template inline SpMat& operator-=(const SpOp& X); - template inline SpMat& operator*=(const SpOp& X); - template inline SpMat& operator%=(const SpOp& X); - template inline SpMat& operator/=(const SpOp& X); - - template inline SpMat(const SpGlue& X); - template inline SpMat& operator= (const SpGlue& X); - template inline SpMat& operator+=(const SpGlue& X); - template inline SpMat& operator-=(const SpGlue& X); - template inline SpMat& operator*=(const SpGlue& X); - template inline SpMat& operator%=(const SpGlue& X); - template inline SpMat& operator/=(const SpGlue& X); - - template inline SpMat(const mtSpOp& X); - template inline SpMat& operator= (const mtSpOp& X); - template inline SpMat& operator+=(const mtSpOp& X); - template inline SpMat& operator-=(const mtSpOp& X); - template inline SpMat& operator*=(const mtSpOp& X); - template inline SpMat& operator%=(const mtSpOp& X); - template inline SpMat& operator/=(const mtSpOp& X); - - template inline SpMat(const mtSpGlue& X); - template inline SpMat& operator= (const mtSpGlue& X); - template inline SpMat& operator+=(const mtSpGlue& X); - template inline SpMat& operator-=(const mtSpGlue& X); - template inline SpMat& operator*=(const mtSpGlue& X); - template inline SpMat& operator%=(const mtSpGlue& X); - template inline SpMat& operator/=(const mtSpGlue& X); - - template inline SpMat(const mtSpReduceOp& X); - template inline SpMat& operator= (const mtSpReduceOp& X); - template inline SpMat& operator+=(const mtSpReduceOp& X); - template inline SpMat& operator-=(const mtSpReduceOp& X); - template inline SpMat& operator*=(const mtSpReduceOp& X); - template inline SpMat& operator%=(const mtSpReduceOp& X); - template inline SpMat& operator/=(const mtSpReduceOp& X); - - - arma_inline SpSubview_row row(const uword row_num); - arma_inline const SpSubview_row row(const uword row_num) const; - - inline SpSubview_row operator()(const uword row_num, const span& col_span); - inline const SpSubview_row operator()(const uword row_num, const span& col_span) const; - - arma_inline SpSubview_col col(const uword col_num); - arma_inline const SpSubview_col col(const uword col_num) const; - - inline SpSubview_col operator()(const span& row_span, const uword col_num); - inline const SpSubview_col operator()(const span& row_span, const uword col_num) const; - - arma_inline SpSubview rows(const uword in_row1, const uword in_row2); - arma_inline const SpSubview rows(const uword in_row1, const uword in_row2) const; - - arma_inline SpSubview cols(const uword in_col1, const uword in_col2); - arma_inline const SpSubview cols(const uword in_col1, const uword in_col2) const; - - arma_inline SpSubview submat(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2); - arma_inline const SpSubview submat(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2) const; - - arma_inline SpSubview submat(const uword in_row1, const uword in_col1, const SizeMat& s); - arma_inline const SpSubview submat(const uword in_row1, const uword in_col1, const SizeMat& s) const; - - inline SpSubview submat (const span& row_span, const span& col_span); - inline const SpSubview submat (const span& row_span, const span& col_span) const; - - inline SpSubview operator()(const span& row_span, const span& col_span); - inline const SpSubview operator()(const span& row_span, const span& col_span) const; - - arma_inline SpSubview operator()(const uword in_row1, const uword in_col1, const SizeMat& s); - arma_inline const SpSubview operator()(const uword in_row1, const uword in_col1, const SizeMat& s) const; - - - inline SpSubview head_rows(const uword N); - inline const SpSubview head_rows(const uword N) const; - - inline SpSubview tail_rows(const uword N); - inline const SpSubview tail_rows(const uword N) const; - - inline SpSubview head_cols(const uword N); - inline const SpSubview head_cols(const uword N) const; - - inline SpSubview tail_cols(const uword N); - inline const SpSubview tail_cols(const uword N) const; - - - template arma_inline SpSubview_col_list cols(const Base& ci); - template arma_inline const SpSubview_col_list cols(const Base& ci) const; - - - inline spdiagview diag(const sword in_id = 0); - inline const spdiagview diag(const sword in_id = 0) const; - - - inline void swap_rows(const uword in_row1, const uword in_row2); - inline void swap_cols(const uword in_col1, const uword in_col2); - - inline void shed_row(const uword row_num); - inline void shed_col(const uword col_num); - - inline void shed_rows(const uword in_row1, const uword in_row2); - inline void shed_cols(const uword in_col1, const uword in_col2); - - - // access the i-th element; if there is nothing at element i, 0 is returned - arma_warn_unused arma_inline SpMat_MapMat_val operator[] (const uword i); - arma_warn_unused arma_inline eT operator[] (const uword i) const; - - arma_warn_unused arma_inline SpMat_MapMat_val at (const uword i); - arma_warn_unused arma_inline eT at (const uword i) const; - - arma_warn_unused arma_inline SpMat_MapMat_val operator() (const uword i); - arma_warn_unused arma_inline eT operator() (const uword i) const; - - // access the element at the given row and column; if there is nothing at that position, 0 is returned - #if defined(__cpp_multidimensional_subscript) - arma_warn_unused arma_inline SpMat_MapMat_val operator[] (const uword in_row, const uword in_col); - arma_warn_unused arma_inline eT operator[] (const uword in_row, const uword in_col) const; - #endif - - arma_warn_unused arma_inline SpMat_MapMat_val at (const uword in_row, const uword in_col); - arma_warn_unused arma_inline eT at (const uword in_row, const uword in_col) const; - - arma_warn_unused arma_inline SpMat_MapMat_val operator() (const uword in_row, const uword in_col); - arma_warn_unused arma_inline eT operator() (const uword in_row, const uword in_col) const; - - - arma_warn_unused arma_inline bool is_empty() const; - arma_warn_unused arma_inline bool is_vec() const; - arma_warn_unused arma_inline bool is_rowvec() const; - arma_warn_unused arma_inline bool is_colvec() const; - arma_warn_unused arma_inline bool is_square() const; - - arma_warn_unused inline bool is_symmetric() const; - arma_warn_unused inline bool is_symmetric(const typename get_pod_type::result tol) const; - - arma_warn_unused inline bool is_hermitian() const; - arma_warn_unused inline bool is_hermitian(const typename get_pod_type::result tol) const; - - arma_warn_unused inline bool internal_is_finite() const; - arma_warn_unused inline bool internal_has_inf() const; - arma_warn_unused inline bool internal_has_nan() const; - arma_warn_unused inline bool internal_has_nonfinite() const; - - arma_warn_unused arma_inline bool in_range(const uword i) const; - arma_warn_unused arma_inline bool in_range(const span& x) const; - - arma_warn_unused arma_inline bool in_range(const uword in_row, const uword in_col) const; - arma_warn_unused arma_inline bool in_range(const span& row_span, const uword in_col) const; - arma_warn_unused arma_inline bool in_range(const uword in_row, const span& col_span) const; - arma_warn_unused arma_inline bool in_range(const span& row_span, const span& col_span) const; - - arma_warn_unused arma_inline bool in_range(const uword in_row, const uword in_col, const SizeMat& s) const; - - - template inline SpMat& copy_size(const SpMat& m); - template inline SpMat& copy_size(const Mat& m); - - inline SpMat& set_size(const uword in_elem); - inline SpMat& set_size(const uword in_rows, const uword in_cols); - inline SpMat& set_size(const SizeMat& s); - - inline SpMat& resize(const uword in_rows, const uword in_cols); - inline SpMat& resize(const SizeMat& s); - - inline SpMat& reshape(const uword in_rows, const uword in_cols); - inline SpMat& reshape(const SizeMat& s); - - inline void reshape_helper_generic(const uword in_rows, const uword in_cols); //! internal use only - inline void reshape_helper_intovec(); //! internal use only - - template inline SpMat& for_each(functor F); - template inline const SpMat& for_each(functor F) const; - - template inline SpMat& transform(functor F); - - inline SpMat& replace(const eT old_val, const eT new_val); - - inline SpMat& clean(const pod_type threshold); - - inline SpMat& clamp(const eT min_val, const eT max_val); - - inline SpMat& zeros(); - inline SpMat& zeros(const uword in_elem); - inline SpMat& zeros(const uword in_rows, const uword in_cols); - inline SpMat& zeros(const SizeMat& s); - - inline SpMat& eye(); - inline SpMat& eye(const uword in_rows, const uword in_cols); - inline SpMat& eye(const SizeMat& s); - - inline SpMat& speye(); - inline SpMat& speye(const uword in_rows, const uword in_cols); - inline SpMat& speye(const SizeMat& s); - - inline SpMat& sprandu(const uword in_rows, const uword in_cols, const double density); - inline SpMat& sprandu(const SizeMat& s, const double density); - - inline SpMat& sprandn(const uword in_rows, const uword in_cols, const double density); - inline SpMat& sprandn(const SizeMat& s, const double density); - - inline void reset(); - inline void reset_cache(); - - //! don't use this unless you're writing internal Armadillo code - inline void reserve(const uword in_rows, const uword in_cols, const uword new_n_nonzero); - - //! don't use this unless you're writing internal Armadillo code - inline SpMat(const arma_reserve_indicator&, const uword in_rows, const uword in_cols, const uword new_n_nonzero); - - //! don't use this unless you're writing internal Armadillo code - template - inline SpMat(const arma_layout_indicator&, const SpMat& x); - - template inline void set_real(const SpBase& X); - template inline void set_imag(const SpBase& X); - - - // saving and loading - // TODO: implement auto_detect for sparse matrices - - arma_cold inline bool save(const std::string name, const file_type type = arma_binary) const; - arma_cold inline bool save(const csv_name& spec, const file_type type = csv_ascii) const; - arma_cold inline bool save( std::ostream& os, const file_type type = arma_binary) const; - - arma_cold inline bool load(const std::string name, const file_type type = arma_binary); - arma_cold inline bool load(const csv_name& spec, const file_type type = csv_ascii); - arma_cold inline bool load( std::istream& is, const file_type type = arma_binary); - - arma_frown("use save() instead") inline bool quiet_save(const std::string name, const file_type type = arma_binary) const; - arma_frown("use save() instead") inline bool quiet_save( std::ostream& os, const file_type type = arma_binary) const; - - arma_frown("use load() instead") inline bool quiet_load(const std::string name, const file_type type = arma_binary); - arma_frown("use load() instead") inline bool quiet_load( std::istream& is, const file_type type = arma_binary); - - - - // necessary forward declarations - class iterator_base; - class iterator; - class const_iterator; - class row_iterator; - class const_row_iterator; - - // iterator_base provides basic operators but not how to compare or how to iterate - class iterator_base - { - public: - - inline iterator_base(); - inline iterator_base(const SpMat& in_M); - inline iterator_base(const SpMat& in_M, const uword col, const uword pos); - - arma_inline eT operator*() const; - - // don't hold location internally; call "dummy" methods to get that information - arma_inline uword row() const { return M->row_indices[internal_pos]; } - arma_inline uword col() const { return internal_col; } - arma_inline uword pos() const { return internal_pos; } - - arma_aligned const SpMat* M; - arma_aligned uword internal_col; - arma_aligned uword internal_pos; - - typedef std::bidirectional_iterator_tag iterator_category; - typedef eT value_type; - typedef std::ptrdiff_t difference_type; // TODO: not certain on this one - typedef const eT* pointer; - typedef const eT& reference; - }; - - class const_iterator : public iterator_base - { - public: - - inline const_iterator(); - - inline const_iterator(const SpMat& in_M, uword initial_pos = 0); // assumes initial_pos is valid - inline const_iterator(const SpMat& in_M, uword in_row, uword in_col); // iterator will be at the first nonzero value after the given position (using forward columnwise traversal) - inline const_iterator(const SpMat& in_M, uword in_row, uword in_col, uword in_pos); // if the exact position of the iterator is known; in_row is a dummy argument - - inline const_iterator(const const_iterator& other); - inline const_iterator& operator= (const const_iterator& other) = default; - - arma_hot inline const_iterator& operator++(); - arma_warn_unused inline const_iterator operator++(int); - - arma_hot inline const_iterator& operator--(); - arma_warn_unused inline const_iterator operator--(int); - - arma_hot inline bool operator==(const const_iterator& rhs) const; - arma_hot inline bool operator!=(const const_iterator& rhs) const; - - arma_hot inline bool operator==(const typename SpSubview::const_iterator& rhs) const; - arma_hot inline bool operator!=(const typename SpSubview::const_iterator& rhs) const; - - arma_hot inline bool operator==(const const_row_iterator& rhs) const; - arma_hot inline bool operator!=(const const_row_iterator& rhs) const; - - arma_hot inline bool operator==(const typename SpSubview::const_row_iterator& rhs) const; - arma_hot inline bool operator!=(const typename SpSubview::const_row_iterator& rhs) const; - }; - - /** - * So that we can iterate over nonzero values, we need an iterator implementation. - * This can't be as simple as for Mat, which is just a pointer to an eT. - * If a value is set to 0 using this iterator, the iterator is no longer valid! - */ - class iterator : public const_iterator - { - public: - - inline iterator() : const_iterator() { } - - inline iterator(SpMat& in_M, uword initial_pos = 0) : const_iterator(in_M, initial_pos) { } - inline iterator(SpMat& in_M, uword in_row, uword in_col) : const_iterator(in_M, in_row, in_col) { } - inline iterator(SpMat& in_M, uword in_row, uword in_col, uword in_pos) : const_iterator(in_M, in_row, in_col, in_pos) { } - - inline iterator (const iterator& other) : const_iterator(other) { } - inline iterator& operator=(const iterator& other) = default; - - arma_hot inline SpValProxy< SpMat > operator*(); - - // overloads needed for return type correctness - arma_hot inline iterator& operator++(); - arma_warn_unused inline iterator operator++(int); - - arma_hot inline iterator& operator--(); - arma_warn_unused inline iterator operator--(int); - - // this has a different value_type than iterator_base - typedef SpValProxy< SpMat > value_type; - typedef const SpValProxy< SpMat >* pointer; - typedef const SpValProxy< SpMat >& reference; - }; - - class const_row_iterator : public iterator_base - { - public: - - inline const_row_iterator(); - inline const_row_iterator(const SpMat& in_M, uword initial_pos = 0); - inline const_row_iterator(const SpMat& in_M, uword in_row, uword in_col); - - inline const_row_iterator(const const_row_iterator& other); - inline const_row_iterator& operator= (const const_row_iterator& other) = default; - - arma_hot inline const_row_iterator& operator++(); - arma_warn_unused inline const_row_iterator operator++(int); - - arma_hot inline const_row_iterator& operator--(); - arma_warn_unused inline const_row_iterator operator--(int); - - uword internal_row; // hold row internally - uword actual_pos; // hold the true position we are at in the matrix, as column-major indexing - - arma_inline eT operator*() const { return iterator_base::M->values[actual_pos]; } - - arma_inline uword row() const { return internal_row; } - - arma_hot inline bool operator==(const const_iterator& rhs) const; - arma_hot inline bool operator!=(const const_iterator& rhs) const; - - arma_hot inline bool operator==(const typename SpSubview::const_iterator& rhs) const; - arma_hot inline bool operator!=(const typename SpSubview::const_iterator& rhs) const; - - arma_hot inline bool operator==(const const_row_iterator& rhs) const; - arma_hot inline bool operator!=(const const_row_iterator& rhs) const; - - arma_hot inline bool operator==(const typename SpSubview::const_row_iterator& rhs) const; - arma_hot inline bool operator!=(const typename SpSubview::const_row_iterator& rhs) const; - }; - - class row_iterator : public const_row_iterator - { - public: - - inline row_iterator() : const_row_iterator() {} - - inline row_iterator(SpMat& in_M, uword initial_pos = 0) : const_row_iterator(in_M, initial_pos) { } - inline row_iterator(SpMat& in_M, uword in_row, uword in_col) : const_row_iterator(in_M, in_row, in_col) { } - - inline row_iterator(const row_iterator& other) : const_row_iterator(other) { } - inline row_iterator& operator= (const row_iterator& other) = default; - - arma_hot inline SpValProxy< SpMat > operator*(); - - // overloads required for return type correctness - arma_hot inline row_iterator& operator++(); - arma_warn_unused inline row_iterator operator++(int); - - arma_hot inline row_iterator& operator--(); - arma_warn_unused inline row_iterator operator--(int); - - // this has a different value_type than iterator_base - typedef SpValProxy< SpMat > value_type; - typedef const SpValProxy< SpMat >* pointer; - typedef const SpValProxy< SpMat >& reference; - }; - - - typedef iterator col_iterator; - typedef const_iterator const_col_iterator; - - typedef iterator row_col_iterator; - typedef const_iterator const_row_col_iterator; - - - inline iterator begin(); - inline const_iterator begin() const; - inline const_iterator cbegin() const; - - inline iterator end(); - inline const_iterator end() const; - inline const_iterator cend() const; - - inline col_iterator begin_col(const uword col_num); - inline const_col_iterator begin_col(const uword col_num) const; - - inline col_iterator begin_col_no_sync(const uword col_num); - inline const_col_iterator begin_col_no_sync(const uword col_num) const; - - inline col_iterator end_col(const uword col_num); - inline const_col_iterator end_col(const uword col_num) const; - - inline col_iterator end_col_no_sync(const uword col_num); - inline const_col_iterator end_col_no_sync(const uword col_num) const; - - inline row_iterator begin_row(const uword row_num = 0); - inline const_row_iterator begin_row(const uword row_num = 0) const; - - inline row_iterator end_row(); - inline const_row_iterator end_row() const; - - inline row_iterator end_row(const uword row_num); - inline const_row_iterator end_row(const uword row_num) const; - - inline row_col_iterator begin_row_col(); - inline const_row_col_iterator begin_row_col() const; - - inline row_col_iterator end_row_col(); - inline const_row_col_iterator end_row_col() const; - - - inline void clear(); - inline bool empty() const; - inline uword size() const; - - arma_warn_unused arma_inline SpMat_MapMat_val front(); - arma_warn_unused arma_inline eT front() const; - - arma_warn_unused arma_inline SpMat_MapMat_val back(); - arma_warn_unused arma_inline eT back() const; - - // Resize memory. - // If the new size is larger, the column pointers and new memory still need to be correctly set. - // If the new size is smaller, the first new_n_nonzero elements will be copied. - // n_nonzero is updated. - inline void mem_resize(const uword new_n_nonzero); - - //! synchronise CSC from cache - inline void sync() const; - - //! don't use this unless you're writing internal Armadillo code - inline void remove_zeros(); - - //! don't use this unless you're writing internal Armadillo code - inline void steal_mem(SpMat& X); - - //! don't use this unless you're writing internal Armadillo code - inline void steal_mem_simple(SpMat& X); - - //! don't use this unless you're writing internal Armadillo code - template< typename T1, typename Functor> inline void init_xform (const SpBase& x, const Functor& func); - template inline void init_xform_mt(const SpBase& x, const Functor& func); - - //! don't use this unless you're writing internal Armadillo code - arma_inline bool is_alias(const SpMat& X) const; - - - protected: - - inline void init(uword in_rows, uword in_cols, const uword new_n_nonzero = 0); - arma_cold inline void init_cold(uword in_rows, uword in_cols, const uword new_n_nonzero = 0); - - inline void init(const std::string& text); - inline void init(const SpMat& x); - inline void init(const MapMat& x); - - inline void init_simple(const SpMat& x); - - inline void init_batch_std(const Mat& locations, const Mat& values, const bool sort_locations); - inline void init_batch_add(const Mat& locations, const Mat& values, const bool sort_locations); - - inline SpMat(const arma_vec_indicator&, const uword in_vec_state); - inline SpMat(const arma_vec_indicator&, const uword in_n_rows, const uword in_n_cols, const uword in_vec_state); - - - private: - - arma_warn_unused arma_hot inline const eT* find_value_csc(const uword in_row, const uword in_col) const; - - arma_warn_unused arma_hot inline eT get_value(const uword i ) const; - arma_warn_unused arma_hot inline eT get_value(const uword in_row, const uword in_col) const; - - arma_warn_unused arma_hot inline eT get_value_csc(const uword i ) const; - arma_warn_unused arma_hot inline eT get_value_csc(const uword in_row, const uword in_col) const; - - arma_warn_unused arma_hot inline bool try_set_value_csc(const uword in_row, const uword in_col, const eT in_val); - arma_warn_unused arma_hot inline bool try_add_value_csc(const uword in_row, const uword in_col, const eT in_val); - arma_warn_unused arma_hot inline bool try_sub_value_csc(const uword in_row, const uword in_col, const eT in_val); - arma_warn_unused arma_hot inline bool try_mul_value_csc(const uword in_row, const uword in_col, const eT in_val); - arma_warn_unused arma_hot inline bool try_div_value_csc(const uword in_row, const uword in_col, const eT in_val); - - arma_warn_unused inline eT& insert_element(const uword in_row, const uword in_col, const eT in_val = eT(0)); - inline void delete_element(const uword in_row, const uword in_col); - - - // cache related - - arma_aligned mutable MapMat cache; - arma_aligned mutable state_type sync_state; - // 0: cache needs to be updated from CSC (ie. CSC has more recent data) - // 1: CSC needs to be updated from cache (ie. cache has more recent data) - // 2: no update required (ie. CSC and cache contain the same data) - - #if defined(ARMA_USE_STD_MUTEX) - arma_aligned mutable std::mutex cache_mutex; - #endif - - arma_inline void invalidate_cache() const; - arma_inline void invalidate_csc() const; - - inline void sync_cache() const; - inline void sync_cache_simple() const; - inline void sync_csc() const; - inline void sync_csc_simple() const; - - - friend class SpValProxy< SpMat >; // allow SpValProxy to call insert_element() and delete_element() - friend class SpSubview; - friend class SpRow; - friend class SpCol; - friend class SpMat_MapMat_val; - friend class SpSubview_MapMat_val; - friend class spdiagview; - - template friend class SpSubview_col_list; - - public: - - #if defined(ARMA_EXTRA_SPMAT_PROTO) - #include ARMA_INCFILE_WRAP(ARMA_EXTRA_SPMAT_PROTO) - #endif - }; - - - -class SpMat_aux - { - public: - - template inline static void set_real(SpMat& out, const SpBase& X); - template inline static void set_real(SpMat< std::complex >& out, const SpBase< T,T1>& X); - - template inline static void set_imag(SpMat& out, const SpBase& X); - template inline static void set_imag(SpMat< std::complex >& out, const SpBase< T,T1>& X); - }; - - - -#define ARMA_HAS_SPMAT - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpMat_iterators_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpMat_iterators_meat.hpp deleted file mode 100644 index ed29640d7..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpMat_iterators_meat.hpp +++ /dev/null @@ -1,964 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpMat -//! @{ - - -/////////////////////////////////////////////////////////////////////////////// -// SpMat::iterator_base implementation // -/////////////////////////////////////////////////////////////////////////////// - - -template -inline -SpMat::iterator_base::iterator_base() - : M(nullptr) - , internal_col(0) - , internal_pos(0) - { - // Technically this iterator is invalid (it does not point to a valid element) - } - - - -template -inline -SpMat::iterator_base::iterator_base(const SpMat& in_M) - : M(&in_M) - , internal_col(0) - , internal_pos(0) - { - // Technically this iterator is invalid (it may not point to a valid element) - } - - - -template -inline -SpMat::iterator_base::iterator_base(const SpMat& in_M, const uword in_col, const uword in_pos) - : M(&in_M) - , internal_col(in_col) - , internal_pos(in_pos) - { - // Nothing to do. - } - - - -template -arma_inline -eT -SpMat::iterator_base::operator*() const - { - return M->values[internal_pos]; - } - - - -/////////////////////////////////////////////////////////////////////////////// -// SpMat::const_iterator implementation // -/////////////////////////////////////////////////////////////////////////////// - -template -inline -SpMat::const_iterator::const_iterator() - : iterator_base() - { - } - - - -template -inline -SpMat::const_iterator::const_iterator(const SpMat& in_M, uword initial_pos) - : iterator_base(in_M, 0, initial_pos) - { - // Corner case for empty matrices. - if(in_M.n_nonzero == 0) - { - iterator_base::internal_col = in_M.n_cols; - return; - } - - // Determine which column we should be in. - while(iterator_base::M->col_ptrs[iterator_base::internal_col + 1] <= iterator_base::internal_pos) - { - iterator_base::internal_col++; - } - } - - - -template -inline -SpMat::const_iterator::const_iterator(const SpMat& in_M, uword in_row, uword in_col) - : iterator_base(in_M, in_col, 0) - { - // So we have a position we want to be right after. Skip to the column. - iterator_base::internal_pos = iterator_base::M->col_ptrs[iterator_base::internal_col]; - - // Now we have to make sure that is the right column. - while(iterator_base::M->col_ptrs[iterator_base::internal_col + 1] <= iterator_base::internal_pos) - { - iterator_base::internal_col++; - } - - // Now we have to get to the right row. - while((iterator_base::M->row_indices[iterator_base::internal_pos] < in_row) && (iterator_base::internal_col == in_col)) - { - ++(*this); // Increment iterator. - } - } - - - -template -inline -SpMat::const_iterator::const_iterator(const SpMat& in_M, const uword /* in_row */, const uword in_col, const uword in_pos) - : iterator_base(in_M, in_col, in_pos) - { - // Nothing to do. - } - - - -template -inline -SpMat::const_iterator::const_iterator(const typename SpMat::const_iterator& other) - : iterator_base(*other.M, other.internal_col, other.internal_pos) - { - // Nothing to do. - } - - - -template -inline -typename SpMat::const_iterator& -SpMat::const_iterator::operator++() - { - ++iterator_base::internal_pos; - - if(iterator_base::internal_pos == iterator_base::M->n_nonzero) - { - iterator_base::internal_col = iterator_base::M->n_cols; - return *this; - } - - // Check to see if we moved a column. - while(iterator_base::M->col_ptrs[iterator_base::internal_col + 1] <= iterator_base::internal_pos) - { - ++iterator_base::internal_col; - } - - return *this; - } - - - -template -inline -typename SpMat::const_iterator -SpMat::const_iterator::operator++(int) - { - typename SpMat::const_iterator tmp(*this); - - ++(*this); - - return tmp; - } - - - -template -inline -typename SpMat::const_iterator& -SpMat::const_iterator::operator--() - { - --iterator_base::internal_pos; - - // First, see if we moved back a column. - while(iterator_base::internal_pos < iterator_base::M->col_ptrs[iterator_base::internal_col]) - { - --iterator_base::internal_col; - } - - return *this; - } - - - -template -inline -typename SpMat::const_iterator -SpMat::const_iterator::operator--(int) - { - typename SpMat::const_iterator tmp(*this); - - --(*this); - - return tmp; - } - - - -template -inline -bool -SpMat::const_iterator::operator==(const const_iterator& rhs) const - { - return (rhs.row() == (*this).row()) && (rhs.col() == iterator_base::internal_col); - } - - - -template -inline -bool -SpMat::const_iterator::operator!=(const const_iterator& rhs) const - { - return (rhs.row() != (*this).row()) || (rhs.col() != iterator_base::internal_col); - } - - - -template -inline -bool -SpMat::const_iterator::operator==(const typename SpSubview::const_iterator& rhs) const - { - return (rhs.row() == (*this).row()) && (rhs.col() == iterator_base::internal_col); - } - - - -template -inline -bool -SpMat::const_iterator::operator!=(const typename SpSubview::const_iterator& rhs) const - { - return (rhs.row() != (*this).row()) || (rhs.col() != iterator_base::internal_col); - } - - - -template -inline -bool -SpMat::const_iterator::operator==(const const_row_iterator& rhs) const - { - return (rhs.row() == (*this).row()) && (rhs.col() == iterator_base::internal_col); - } - - - -template -inline -bool -SpMat::const_iterator::operator!=(const const_row_iterator& rhs) const - { - return (rhs.row() != (*this).row()) || (rhs.col() != iterator_base::internal_col); - } - - - -template -inline -bool -SpMat::const_iterator::operator==(const typename SpSubview::const_row_iterator& rhs) const - { - return (rhs.row() == (*this).row()) && (rhs.col() == iterator_base::internal_col); - } - - - -template -inline -bool -SpMat::const_iterator::operator!=(const typename SpSubview::const_row_iterator& rhs) const - { - return (rhs.row() != (*this).row()) || (rhs.col() != iterator_base::internal_col); - } - - - -/////////////////////////////////////////////////////////////////////////////// -// SpMat::iterator implementation // -/////////////////////////////////////////////////////////////////////////////// - -template -inline -SpValProxy< SpMat > -SpMat::iterator::operator*() - { - return SpValProxy< SpMat >( - iterator_base::M->row_indices[iterator_base::internal_pos], - iterator_base::internal_col, - access::rw(*iterator_base::M), - &access::rw(iterator_base::M->values[iterator_base::internal_pos])); - } - - - -template -inline -typename SpMat::iterator& -SpMat::iterator::operator++() - { - const_iterator::operator++(); - - return *this; - } - - - -template -inline -typename SpMat::iterator -SpMat::iterator::operator++(int) - { - typename SpMat::iterator tmp(*this); - - const_iterator::operator++(); - - return tmp; - } - - - -template -inline -typename SpMat::iterator& -SpMat::iterator::operator--() - { - const_iterator::operator--(); - - return *this; - } - - - -template -inline -typename SpMat::iterator -SpMat::iterator::operator--(int) - { - typename SpMat::iterator tmp(*this); - - const_iterator::operator--(); - - return tmp; - } - - - -/////////////////////////////////////////////////////////////////////////////// -// SpMat::const_row_iterator implementation // -/////////////////////////////////////////////////////////////////////////////// - -/** - * Initialize the const_row_iterator. - */ - -template -inline -SpMat::const_row_iterator::const_row_iterator() - : iterator_base() - , internal_row(0) - , actual_pos(0) - { - } - - - -template -inline -SpMat::const_row_iterator::const_row_iterator(const SpMat& in_M, uword initial_pos) - : iterator_base(in_M, 0, initial_pos) - , internal_row(0) - , actual_pos(0) - { - // Corner case for the end of a matrix. - if(initial_pos == in_M.n_nonzero) - { - iterator_base::internal_col = 0; - internal_row = in_M.n_rows; - actual_pos = in_M.n_nonzero; - iterator_base::internal_pos = in_M.n_nonzero; - - return; - } - - // We don't count zeros in our position count, so we have to find the nonzero - // value corresponding to the given initial position. We assume initial_pos - // is valid. - - // This is irritating because we don't know where the elements are in each row. - // What we will do is loop across all columns looking for elements in row 0 - // (and add to our sum), then in row 1, and so forth, until we get to the desired position. - uword cur_pos = std::numeric_limits::max(); // Invalid value. - uword cur_actual_pos = 0; - - for(uword row = 0; row < iterator_base::M->n_rows; ++row) - { - for(uword col = 0; col < iterator_base::M->n_cols; ++col) - { - // Find the first element with row greater than or equal to in_row. - const uword col_offset = iterator_base::M->col_ptrs[col ]; - const uword next_col_offset = iterator_base::M->col_ptrs[col + 1]; - - const uword* start_ptr = &iterator_base::M->row_indices[ col_offset]; - const uword* end_ptr = &iterator_base::M->row_indices[next_col_offset]; - - if(start_ptr != end_ptr) - { - const uword* pos_ptr = std::lower_bound(start_ptr, end_ptr, row); - - // This is the number of elements in the column with row index less than in_row. - const uword offset = uword(pos_ptr - start_ptr); - - if(iterator_base::M->row_indices[col_offset + offset] == row) - { - cur_actual_pos = col_offset + offset; - - // Increment position portably. - if(cur_pos == std::numeric_limits::max()) - { cur_pos = 0; } - else - { ++cur_pos; } - - // Do we terminate? - if(cur_pos == initial_pos) - { - internal_row = row; - iterator_base::internal_col = col; - iterator_base::internal_pos = cur_pos; - actual_pos = cur_actual_pos; - - return; - } - } - } - } - } - - // If we got to here, then we have gone past the end of the matrix. - // This shouldn't happen... - iterator_base::internal_pos = iterator_base::M->n_nonzero; - iterator_base::internal_col = 0; - internal_row = iterator_base::M->n_rows; - actual_pos = iterator_base::M->n_nonzero; - } - - - -template -inline -SpMat::const_row_iterator::const_row_iterator(const SpMat& in_M, uword in_row, uword in_col) - : iterator_base(in_M, in_col, 0) - , internal_row(0) - , actual_pos(0) - { - // Start our search in the given row. We need to find two things: - // - // 1. The first nonzero element (iterating by rows) after (in_row, in_col). - // 2. The number of nonzero elements (iterating by rows) that come before - // (in_row, in_col). - // - // We'll find these simultaneously, though we will have to loop over all - // columns. - - // This will hold the total number of points with rows less than in_row. - uword cur_pos = 0; - uword cur_min_row = iterator_base::M->n_rows; - uword cur_min_col = 0; - uword cur_actual_pos = 0; - - for(uword col = 0; col < iterator_base::M->n_cols; ++col) - { - // Find the first element with row greater than or equal to in_row. - const uword col_offset = iterator_base::M->col_ptrs[col ]; - const uword next_col_offset = iterator_base::M->col_ptrs[col + 1]; - - const uword* start_ptr = &iterator_base::M->row_indices[ col_offset]; - const uword* end_ptr = &iterator_base::M->row_indices[next_col_offset]; - - if(start_ptr != end_ptr) - { - const uword* pos_ptr = std::lower_bound(start_ptr, end_ptr, in_row); - - // This is the number of elements in the column with row index less than in_row. - const uword offset = uword(pos_ptr - start_ptr); - - cur_pos += offset; - - if(pos_ptr != end_ptr) - { - // This is the row index of the first element in the column with row index - // greater than or equal to in_row. - if((*pos_ptr) < cur_min_row) - { - // If we are in the desired row but before the desired column, - // we can't take this. - if(col >= in_col) - { - cur_min_row = (*pos_ptr); - cur_min_col = col; - cur_actual_pos = col_offset + offset; - } - } - } - } - } - - // Now we know what the minimum row is. - internal_row = cur_min_row; - iterator_base::internal_col = cur_min_col; - iterator_base::internal_pos = cur_pos; - actual_pos = cur_actual_pos; - } - - - -/** - * Initialize the const_row_iterator from another const_row_iterator. - */ -template -inline -SpMat::const_row_iterator::const_row_iterator(const typename SpMat::const_row_iterator& other) - : iterator_base(*other.M, other.internal_col, other.internal_pos) - , internal_row(other.internal_row) - , actual_pos(other.actual_pos) - { - // Nothing to do. - } - - - -/** - * Increment the row_iterator. - */ -template -inline -typename SpMat::const_row_iterator& -SpMat::const_row_iterator::operator++() - { - // We just need to find the next nonzero element. - iterator_base::internal_pos++; - - if(iterator_base::internal_pos == iterator_base::M->n_nonzero) - { - internal_row = iterator_base::M->n_rows; - iterator_base::internal_col = 0; - - return *this; - } - - // Otherwise, we need to search. We can start in the next column and use - // lower_bound() to find the next element. - uword next_min_row = iterator_base::M->n_rows; - uword next_min_col = iterator_base::M->n_cols; - uword next_actual_pos = 0; - - // Search from the current column to the end of the matrix. - for(uword col = iterator_base::internal_col + 1; col < iterator_base::M->n_cols; ++col) - { - // Find the first element with row greater than or equal to in_row. - const uword col_offset = iterator_base::M->col_ptrs[col ]; - const uword next_col_offset = iterator_base::M->col_ptrs[col + 1]; - - const uword* start_ptr = &iterator_base::M->row_indices[ col_offset]; - const uword* end_ptr = &iterator_base::M->row_indices[next_col_offset]; - - if(start_ptr != end_ptr) - { - // Find the first element in the column with row greater than or equal to - // the current row. - const uword* pos_ptr = std::lower_bound(start_ptr, end_ptr, internal_row); - - if(pos_ptr != end_ptr) - { - // We found something in the column, but is the row index correct? - if((*pos_ptr) == internal_row) - { - // Exact match---so we are done. - iterator_base::internal_col = col; - actual_pos = col_offset + (pos_ptr - start_ptr); - return *this; - } - else if((*pos_ptr) < next_min_row) - { - // The first element in this column is in a subsequent row, but it's - // the minimum row we've seen so far. - next_min_row = (*pos_ptr); - next_min_col = col; - next_actual_pos = col_offset + (pos_ptr - start_ptr); - } - else if((*pos_ptr) == next_min_row && col < next_min_col) - { - // The first element in this column is in a subsequent row that we - // already have another element for, but the column index is less so - // this element will come first. - next_min_col = col; - next_actual_pos = col_offset + (pos_ptr - start_ptr); - } - } - } - } - - // Restart the search in the next row. - for(uword col = 0; col <= iterator_base::internal_col; ++col) - { - // Find the first element with row greater than or equal to in_row + 1. - const uword col_offset = iterator_base::M->col_ptrs[col ]; - const uword next_col_offset = iterator_base::M->col_ptrs[col + 1]; - - const uword* start_ptr = &iterator_base::M->row_indices[ col_offset]; - const uword* end_ptr = &iterator_base::M->row_indices[next_col_offset]; - - if(start_ptr != end_ptr) - { - const uword* pos_ptr = std::lower_bound(start_ptr, end_ptr, internal_row + 1); - - if(pos_ptr != end_ptr) - { - // We found something in the column, but is the row index correct? - if((*pos_ptr) == internal_row + 1) - { - // Exact match---so we are done. - iterator_base::internal_col = col; - internal_row++; - actual_pos = col_offset + (pos_ptr - start_ptr); - return *this; - } - else if((*pos_ptr) < next_min_row) - { - // The first element in this column is in a subsequent row, - // but it's the minimum row we've seen so far. - next_min_row = (*pos_ptr); - next_min_col = col; - next_actual_pos = col_offset + (pos_ptr - start_ptr); - } - else if((*pos_ptr) == next_min_row && col < next_min_col) - { - // The first element in this column is in a subsequent row that we - // already have another element for, but the column index is less so - // this element will come first. - next_min_col = col; - next_actual_pos = col_offset + (pos_ptr - start_ptr); - } - } - } - } - - iterator_base::internal_col = next_min_col; - internal_row = next_min_row; - actual_pos = next_actual_pos; - - return *this; // Now we are done. - } - - - -/** - * Increment the row_iterator (but do not return anything. - */ -template -inline -typename SpMat::const_row_iterator -SpMat::const_row_iterator::operator++(int) - { - typename SpMat::const_row_iterator tmp(*this); - - ++(*this); - - return tmp; - } - - - -/** - * Decrement the row_iterator. - */ -template -inline -typename SpMat::const_row_iterator& -SpMat::const_row_iterator::operator--() - { - if(iterator_base::internal_pos == 0) - { - // Do nothing; we are already at the beginning. - return *this; - } - - iterator_base::internal_pos--; - - // We have to search backwards. We'll do this by going backwards over columns - // and seeing if we find an element in the same row. - uword max_row = 0; - uword max_col = 0; - uword next_actual_pos = 0; - - //for(uword col = iterator_base::internal_col; col > 1; --col) - for(uword col = iterator_base::internal_col; col >= 1; --col) - { - // Find the first element with row greater than or equal to in_row + 1. - const uword col_offset = iterator_base::M->col_ptrs[col - 1]; - const uword next_col_offset = iterator_base::M->col_ptrs[col ]; - - const uword* start_ptr = &iterator_base::M->row_indices[ col_offset]; - const uword* end_ptr = &iterator_base::M->row_indices[next_col_offset]; - - if(start_ptr != end_ptr) - { - // There are elements in this column. - const uword* pos_ptr = std::lower_bound(start_ptr, end_ptr, internal_row + 1); - - if(pos_ptr != start_ptr) - { - // The element before pos_ptr is the one we are interested in. - if(*(pos_ptr - 1) > max_row) - { - max_row = *(pos_ptr - 1); - max_col = col - 1; - next_actual_pos = col_offset + (pos_ptr - 1 - start_ptr); - } - else if(*(pos_ptr - 1) == max_row && (col - 1) > max_col) - { - max_col = col - 1; - next_actual_pos = col_offset + (pos_ptr - 1 - start_ptr); - } - } - } - } - - // Now loop around to the columns at the end of the matrix. - for(uword col = iterator_base::M->n_cols - 1; col >= iterator_base::internal_col; --col) - { - // Find the first element with row greater than or equal to in_row + 1. - const uword col_offset = iterator_base::M->col_ptrs[col ]; - const uword next_col_offset = iterator_base::M->col_ptrs[col + 1]; - - const uword* start_ptr = &iterator_base::M->row_indices[ col_offset]; - const uword* end_ptr = &iterator_base::M->row_indices[next_col_offset]; - - if(start_ptr != end_ptr) - { - // There are elements in this column. - const uword* pos_ptr = std::lower_bound(start_ptr, end_ptr, internal_row); - - if(pos_ptr != start_ptr) - { - // There are elements in this column with row index < internal_row. - if(*(pos_ptr - 1) > max_row) - { - max_row = *(pos_ptr - 1); - max_col = col; - next_actual_pos = col_offset + (pos_ptr - 1 - start_ptr); - } - else if(*(pos_ptr - 1) == max_row && col > max_col) - { - max_col = col; - next_actual_pos = col_offset + (pos_ptr - 1 - start_ptr); - } - } - } - - if(col == 0) // Catch edge case that the loop termination condition won't. - { - break; - } - } - - iterator_base::internal_col = max_col; - internal_row = max_row; - actual_pos = next_actual_pos; - - return *this; - } - - - -/** - * Decrement the row_iterator. - */ -template -inline -typename SpMat::const_row_iterator -SpMat::const_row_iterator::operator--(int) - { - typename SpMat::const_row_iterator tmp(*this); - - --(*this); - - return tmp; - } - - - -template -inline -bool -SpMat::const_row_iterator::operator==(const const_iterator& rhs) const - { - return (rhs.row() == row()) && (rhs.col() == iterator_base::internal_col); - } - - - -template -inline -bool -SpMat::const_row_iterator::operator!=(const const_iterator& rhs) const - { - return (rhs.row() != row()) || (rhs.col() != iterator_base::internal_col); - } - - - -template -inline -bool -SpMat::const_row_iterator::operator==(const typename SpSubview::const_iterator& rhs) const - { - return (rhs.row() == row()) && (rhs.col() == iterator_base::internal_col); - } - - - -template -inline -bool -SpMat::const_row_iterator::operator!=(const typename SpSubview::const_iterator& rhs) const - { - return (rhs.row() != row()) || (rhs.col() != iterator_base::internal_col); - } - - - -template -inline -bool -SpMat::const_row_iterator::operator==(const const_row_iterator& rhs) const - { - return (rhs.row() == row()) && (rhs.col() == iterator_base::internal_col); - } - - - -template -inline -bool -SpMat::const_row_iterator::operator!=(const const_row_iterator& rhs) const - { - return (rhs.row() != row()) || (rhs.col() != iterator_base::internal_col); - } - - - -template -inline -bool -SpMat::const_row_iterator::operator==(const typename SpSubview::const_row_iterator& rhs) const - { - return (rhs.row() == row()) && (rhs.col() == iterator_base::internal_col); - } - - - -template -inline -bool -SpMat::const_row_iterator::operator!=(const typename SpSubview::const_row_iterator& rhs) const - { - return (rhs.row() != row()) || (rhs.col() != iterator_base::internal_col); - } - - - -/////////////////////////////////////////////////////////////////////////////// -// SpMat::row_iterator implementation // -/////////////////////////////////////////////////////////////////////////////// - -template -inline -SpValProxy< SpMat > -SpMat::row_iterator::operator*() - { - return SpValProxy< SpMat >( - const_row_iterator::internal_row, - iterator_base::internal_col, - access::rw(*iterator_base::M), - &access::rw(iterator_base::M->values[const_row_iterator::actual_pos])); - } - - - -template -inline -typename SpMat::row_iterator& -SpMat::row_iterator::operator++() - { - const_row_iterator::operator++(); - - return *this; - } - - - -template -inline -typename SpMat::row_iterator -SpMat::row_iterator::operator++(int) - { - typename SpMat::row_iterator tmp(*this); - - const_row_iterator::operator++(); - - return tmp; - } - - - -template -inline -typename SpMat::row_iterator& -SpMat::row_iterator::operator--() - { - const_row_iterator::operator--(); - - return *this; - } - - - -template -inline -typename SpMat::row_iterator -SpMat::row_iterator::operator--(int) - { - typename SpMat::row_iterator tmp(*this); - - const_row_iterator::operator--(); - - return tmp; - } - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpMat_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpMat_meat.hpp deleted file mode 100644 index eb0bbce8d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpMat_meat.hpp +++ /dev/null @@ -1,6923 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpMat -//! @{ - - -/** - * Initialize a sparse matrix with size 0x0 (empty). - */ -template -inline -SpMat::SpMat() - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - init_cold(0,0); - } - - - -/** - * Clean up the memory of a sparse matrix and destruct it. - */ -template -inline -SpMat::~SpMat() - { - arma_debug_sigprint_this(this); - - if(values ) { memory::release(access::rw(values)); } - if(row_indices) { memory::release(access::rw(row_indices)); } - if(col_ptrs ) { memory::release(access::rw(col_ptrs)); } - } - - - -/** - * Constructor with size given. - */ -template -inline -SpMat::SpMat(const uword in_rows, const uword in_cols) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - init_cold(in_rows, in_cols); - } - - - -template -inline -SpMat::SpMat(const SizeMat& s) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - init_cold(s.n_rows, s.n_cols); - } - - - -template -inline -SpMat::SpMat(const arma_reserve_indicator&, const uword in_rows, const uword in_cols, const uword new_n_nonzero) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - init_cold(in_rows, in_cols, new_n_nonzero); - } - - - -template -template -inline -SpMat::SpMat(const arma_layout_indicator&, const SpMat& x) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - init_cold(x.n_rows, x.n_cols, x.n_nonzero); - - if(x.n_nonzero == 0) { return; } - - if(x.row_indices) { arrayops::copy(access::rwp(row_indices), x.row_indices, x.n_nonzero + 1); } - if(x.col_ptrs ) { arrayops::copy(access::rwp(col_ptrs), x.col_ptrs, x.n_cols + 1); } - - // NOTE: 'values' array is not initialised - } - - - -/** - * Assemble from text. - */ -template -inline -SpMat::SpMat(const char* text) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - init(std::string(text)); - } - - - -template -inline -SpMat& -SpMat::operator=(const char* text) - { - arma_debug_sigprint(); - - init(std::string(text)); - - return *this; - } - - - -template -inline -SpMat::SpMat(const std::string& text) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint(); - - init(text); - } - - - -template -inline -SpMat& -SpMat::operator=(const std::string& text) - { - arma_debug_sigprint(); - - init(text); - - return *this; - } - - - -template -inline -SpMat::SpMat(const SpMat& x) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - init(x); - } - - - -template -inline -SpMat::SpMat(SpMat&& in_mat) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - arma_debug_sigprint(arma_str::format("this: %x; in_mat: %x") % this % &in_mat); - - (*this).steal_mem(in_mat); - } - - - -template -inline -SpMat& -SpMat::operator=(SpMat&& in_mat) - { - arma_debug_sigprint(arma_str::format("this: %x; in_mat: %x") % this % &in_mat); - - (*this).steal_mem(in_mat); - - return *this; - } - - - -template -inline -SpMat::SpMat(const MapMat& x) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - init(x); - } - - - -template -inline -SpMat& -SpMat::operator=(const MapMat& x) - { - arma_debug_sigprint(); - - init(x); - - return *this; - } - - - -//! Insert a large number of values at once. -//! locations.row[0] should be row indices, locations.row[1] should be column indices, -//! and values should be the corresponding values. -//! If sort_locations is false, then it is assumed that the locations and values -//! are already sorted in column-major ordering. -template -template -inline -SpMat::SpMat(const Base& locations_expr, const Base& vals_expr, const bool sort_locations) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - const quasi_unwrap locs_tmp( locations_expr.get_ref() ); - const quasi_unwrap vals_tmp( vals_expr.get_ref() ); - - const Mat& locs = locs_tmp.M; - const Mat& vals = vals_tmp.M; - - arma_conform_check( (vals.is_vec() == false), "SpMat::SpMat(): given 'values' object must be a vector" ); - arma_conform_check( (locs.n_rows != 2), "SpMat::SpMat(): locations matrix must have two rows" ); - arma_conform_check( (locs.n_cols != vals.n_elem), "SpMat::SpMat(): number of locations is different than number of values" ); - - // If there are no elements in the list, max() will fail. - if(locs.n_cols == 0) { init_cold(0, 0); return; } - - // Automatically determine size before pruning zeros. - uvec bounds = arma::max(locs, 1); - init_cold(bounds[0] + 1, bounds[1] + 1); - - // Ensure that there are no zeros - const uword N_old = vals.n_elem; - uword N_new = 0; - - for(uword i=0; i < N_old; ++i) { N_new += (vals[i] != eT(0)) ? uword(1) : uword(0); } - - if(N_new != N_old) - { - Col filtered_vals( N_new, arma_nozeros_indicator()); - Mat filtered_locs(2, N_new, arma_nozeros_indicator()); - - uword index = 0; - for(uword i = 0; i < N_old; ++i) - { - if(vals[i] != eT(0)) - { - filtered_vals[index] = vals[i]; - - filtered_locs.at(0, index) = locs.at(0, i); - filtered_locs.at(1, index) = locs.at(1, i); - - ++index; - } - } - - init_batch_std(filtered_locs, filtered_vals, sort_locations); - } - else - { - init_batch_std(locs, vals, sort_locations); - } - } - - - -//! Insert a large number of values at once. -//! locations.row[0] should be row indices, locations.row[1] should be column indices, -//! and values should be the corresponding values. -//! If sort_locations is false, then it is assumed that the locations and values -//! are already sorted in column-major ordering. -//! In this constructor the size is explicitly given. -template -template -inline -SpMat::SpMat(const Base& locations_expr, const Base& vals_expr, const uword in_n_rows, const uword in_n_cols, const bool sort_locations, const bool check_for_zeros) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - const quasi_unwrap locs_tmp( locations_expr.get_ref() ); - const quasi_unwrap vals_tmp( vals_expr.get_ref() ); - - const Mat& locs = locs_tmp.M; - const Mat& vals = vals_tmp.M; - - arma_conform_check( (vals.is_vec() == false), "SpMat::SpMat(): given 'values' object must be a vector" ); - arma_conform_check( (locs.n_rows != 2), "SpMat::SpMat(): locations matrix must have two rows" ); - arma_conform_check( (locs.n_cols != vals.n_elem), "SpMat::SpMat(): number of locations is different than number of values" ); - - init_cold(in_n_rows, in_n_cols); - - // Ensure that there are no zeros, unless the user asked not to. - if(check_for_zeros) - { - const uword N_old = vals.n_elem; - uword N_new = 0; - - for(uword i=0; i < N_old; ++i) { N_new += (vals[i] != eT(0)) ? uword(1) : uword(0); } - - if(N_new != N_old) - { - Col filtered_vals( N_new, arma_nozeros_indicator()); - Mat filtered_locs(2, N_new, arma_nozeros_indicator()); - - uword index = 0; - for(uword i = 0; i < N_old; ++i) - { - if(vals[i] != eT(0)) - { - filtered_vals[index] = vals[i]; - - filtered_locs.at(0, index) = locs.at(0, i); - filtered_locs.at(1, index) = locs.at(1, i); - - ++index; - } - } - - init_batch_std(filtered_locs, filtered_vals, sort_locations); - } - else - { - init_batch_std(locs, vals, sort_locations); - } - } - else - { - init_batch_std(locs, vals, sort_locations); - } - } - - - -template -template -inline -SpMat::SpMat(const bool add_values, const Base& locations_expr, const Base& vals_expr, const uword in_n_rows, const uword in_n_cols, const bool sort_locations, const bool check_for_zeros) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - const quasi_unwrap locs_tmp( locations_expr.get_ref() ); - const quasi_unwrap vals_tmp( vals_expr.get_ref() ); - - const Mat& locs = locs_tmp.M; - const Mat& vals = vals_tmp.M; - - arma_conform_check( (vals.is_vec() == false), "SpMat::SpMat(): given 'values' object must be a vector" ); - arma_conform_check( (locs.n_rows != 2), "SpMat::SpMat(): locations matrix must have two rows" ); - arma_conform_check( (locs.n_cols != vals.n_elem), "SpMat::SpMat(): number of locations is different than number of values" ); - - init_cold(in_n_rows, in_n_cols); - - // Ensure that there are no zeros, unless the user asked not to. - if(check_for_zeros) - { - const uword N_old = vals.n_elem; - uword N_new = 0; - - for(uword i=0; i < N_old; ++i) { N_new += (vals[i] != eT(0)) ? uword(1) : uword(0); } - - if(N_new != N_old) - { - Col filtered_vals( N_new, arma_nozeros_indicator()); - Mat filtered_locs(2, N_new, arma_nozeros_indicator()); - - uword index = 0; - for(uword i = 0; i < N_old; ++i) - { - if(vals[i] != eT(0)) - { - filtered_vals[index] = vals[i]; - - filtered_locs.at(0, index) = locs.at(0, i); - filtered_locs.at(1, index) = locs.at(1, i); - - ++index; - } - } - - add_values ? init_batch_add(filtered_locs, filtered_vals, sort_locations) : init_batch_std(filtered_locs, filtered_vals, sort_locations); - } - else - { - add_values ? init_batch_add(locs, vals, sort_locations) : init_batch_std(locs, vals, sort_locations); - } - } - else - { - add_values ? init_batch_add(locs, vals, sort_locations) : init_batch_std(locs, vals, sort_locations); - } - } - - - -//! Insert a large number of values at once. -//! Per CSC format, rowind_expr should be row indices, -//! colptr_expr should column ptr indices locations, -//! and values should be the corresponding values. -//! In this constructor the size is explicitly given. -//! Values are assumed to be sorted, and the size -//! information is trusted -template -template -inline -SpMat::SpMat - ( - const Base& rowind_expr, - const Base& colptr_expr, - const Base& values_expr, - const uword in_n_rows, - const uword in_n_cols, - const bool check_for_zeros - ) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - const quasi_unwrap rowind_tmp( rowind_expr.get_ref() ); - const quasi_unwrap colptr_tmp( colptr_expr.get_ref() ); - const quasi_unwrap vals_tmp( values_expr.get_ref() ); - - const Mat& rowind = rowind_tmp.M; - const Mat& colptr = colptr_tmp.M; - const Mat& vals = vals_tmp.M; - - arma_conform_check( (rowind.is_vec() == false), "SpMat::SpMat(): given 'rowind' object must be a vector" ); - arma_conform_check( (colptr.is_vec() == false), "SpMat::SpMat(): given 'colptr' object must be a vector" ); - arma_conform_check( (vals.is_vec() == false), "SpMat::SpMat(): given 'values' object must be a vector" ); - - // Resize to correct number of elements (this also sets n_nonzero) - init_cold(in_n_rows, in_n_cols, vals.n_elem); - - arma_conform_check( (rowind.n_elem != vals.n_elem), "SpMat::SpMat(): number of row indices is not equal to number of values" ); - arma_conform_check( (colptr.n_elem != (n_cols+1) ), "SpMat::SpMat(): number of column pointers is not equal to n_cols+1" ); - - // copy supplied values into sparse matrix -- not checked for consistency - arrayops::copy(access::rwp(row_indices), rowind.memptr(), rowind.n_elem ); - arrayops::copy(access::rwp(col_ptrs), colptr.memptr(), colptr.n_elem ); - arrayops::copy(access::rwp(values), vals.memptr(), vals.n_elem ); - - // important: set the sentinel as well - access::rw(col_ptrs[n_cols + 1]) = std::numeric_limits::max(); - - // make sure no zeros are stored - if(check_for_zeros) { remove_zeros(); } - } - - - -template -inline -SpMat& -SpMat::operator=(const eT val) - { - arma_debug_sigprint(); - - if(val != eT(0)) - { - // Resize to 1x1 then set that to the right value. - init(1, 1, 1); // Sets col_ptrs to 0. - - // Manually set element. - access::rw(values[0]) = val; - access::rw(row_indices[0]) = 0; - access::rw(col_ptrs[1]) = 1; - } - else - { - init(0, 0); - } - - return *this; - } - - - -template -inline -SpMat& -SpMat::operator*=(const eT val) - { - arma_debug_sigprint(); - - if(val != eT(0)) - { - sync_csc(); - invalidate_cache(); - - const uword n_nz = n_nonzero; - - eT* vals = access::rwp(values); - - bool has_zero = false; - - for(uword i=0; i -inline -SpMat& -SpMat::operator/=(const eT val) - { - arma_debug_sigprint(); - - arma_conform_check( (val == eT(0)), "element-wise division: division by zero" ); - - sync_csc(); - invalidate_cache(); - - const uword n_nz = n_nonzero; - - eT* vals = access::rwp(values); - - bool has_zero = false; - - for(uword i=0; i -inline -SpMat& -SpMat::operator=(const SpMat& x) - { - arma_debug_sigprint(); - - init(x); - - return *this; - } - - - -template -inline -SpMat& -SpMat::operator+=(const SpMat& x) - { - arma_debug_sigprint(); - - sync_csc(); - - SpMat out = (*this) + x; - - steal_mem(out); - - return *this; - } - - - -template -inline -SpMat& -SpMat::operator-=(const SpMat& x) - { - arma_debug_sigprint(); - - sync_csc(); - - SpMat out = (*this) - x; - - steal_mem(out); - - return *this; - } - - - -template -inline -SpMat& -SpMat::operator*=(const SpMat& y) - { - arma_debug_sigprint(); - - sync_csc(); - - SpMat z = (*this) * y; - - steal_mem(z); - - return *this; - } - - - -// This is in-place element-wise matrix multiplication. -template -inline -SpMat& -SpMat::operator%=(const SpMat& y) - { - arma_debug_sigprint(); - - sync_csc(); - - SpMat z = (*this) % y; - - steal_mem(z); - - return *this; - } - - - -template -inline -SpMat& -SpMat::operator/=(const SpMat& x) - { - arma_debug_sigprint(); - - // NOTE: use of this function is not advised; it is implemented only for completeness - - arma_conform_assert_same_size(n_rows, n_cols, x.n_rows, x.n_cols, "element-wise division"); - - for(uword c = 0; c < n_cols; ++c) - for(uword r = 0; r < n_rows; ++r) - { - at(r, c) /= x.at(r, c); - } - - return *this; - } - - - -// Construct a complex matrix out of two non-complex matrices -template -template -inline -SpMat::SpMat - ( - const SpBase::pod_type, T1>& A, - const SpBase::pod_type, T2>& B - ) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type T; - - // Make sure eT is complex and T is not (compile-time check). - arma_type_check(( is_cx::no )); - arma_type_check(( is_cx< T>::yes )); - - // Compile-time abort if types are not compatible. - arma_type_check(( is_same_type< std::complex, eT >::no )); - - const unwrap_spmat tmp1(A.get_ref()); - const unwrap_spmat tmp2(B.get_ref()); - - const SpMat& X = tmp1.M; - const SpMat& Y = tmp2.M; - - arma_conform_assert_same_size(X.n_rows, X.n_cols, Y.n_rows, Y.n_cols, "SpMat()"); - - const uword l_n_rows = X.n_rows; - const uword l_n_cols = X.n_cols; - - // Set size of matrix correctly. - init_cold(l_n_rows, l_n_cols, n_unique(X, Y, op_n_unique_count())); - - // Now on a second iteration, fill it. - typename SpMat::const_iterator x_it = X.begin(); - typename SpMat::const_iterator x_end = X.end(); - - typename SpMat::const_iterator y_it = Y.begin(); - typename SpMat::const_iterator y_end = Y.end(); - - uword cur_pos = 0; - - while((x_it != x_end) || (y_it != y_end)) - { - if(x_it == y_it) // if we are at the same place - { - access::rw(values[cur_pos]) = std::complex((T) *x_it, (T) *y_it); - access::rw(row_indices[cur_pos]) = x_it.row(); - ++access::rw(col_ptrs[x_it.col() + 1]); - - ++x_it; - ++y_it; - } - else - { - if((x_it.col() < y_it.col()) || ((x_it.col() == y_it.col()) && (x_it.row() < y_it.row()))) // if y is closer to the end - { - access::rw(values[cur_pos]) = std::complex((T) *x_it, T(0)); - access::rw(row_indices[cur_pos]) = x_it.row(); - ++access::rw(col_ptrs[x_it.col() + 1]); - - ++x_it; - } - else // x is closer to the end - { - access::rw(values[cur_pos]) = std::complex(T(0), (T) *y_it); - access::rw(row_indices[cur_pos]) = y_it.row(); - ++access::rw(col_ptrs[y_it.col() + 1]); - - ++y_it; - } - } - - ++cur_pos; - } - - // Now fix the column pointers; they are supposed to be a sum. - for(uword c = 1; c <= n_cols; ++c) - { - access::rw(col_ptrs[c]) += col_ptrs[c - 1]; - } - - } - - - -template -template -inline -SpMat::SpMat(const Base& x) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - (*this).operator=(x); - } - - - -template -template -inline -SpMat& -SpMat::operator=(const Base& expr) - { - arma_debug_sigprint(); - - if(is_same_type< T1, Gen, gen_zeros> >::yes) - { - const Proxy P(expr.get_ref()); - - (*this).zeros( P.get_n_rows(), P.get_n_cols() ); - - return *this; - } - - if(is_same_type< T1, Gen, gen_eye> >::yes) - { - const Proxy P(expr.get_ref()); - - (*this).eye( P.get_n_rows(), P.get_n_cols() ); - - return *this; - } - - const quasi_unwrap tmp(expr.get_ref()); - const Mat& x = tmp.M; - - const uword x_n_rows = x.n_rows; - const uword x_n_cols = x.n_cols; - const uword x_n_elem = x.n_elem; - - // Count number of nonzero elements in base object. - uword n = 0; - - const eT* x_mem = x.memptr(); - - for(uword i=0; i < x_n_elem; ++i) { n += (x_mem[i] != eT(0)) ? uword(1) : uword(0); } - - init(x_n_rows, x_n_cols, n); - - if(n == 0) { return *this; } - - // Now the memory is resized correctly; set nonzero elements. - n = 0; - for(uword j = 0; j < x_n_cols; ++j) - for(uword i = 0; i < x_n_rows; ++i) - { - const eT val = (*x_mem); x_mem++; - - if(val != eT(0)) - { - access::rw(values[n]) = val; - access::rw(row_indices[n]) = i; - access::rw(col_ptrs[j + 1])++; - ++n; - } - } - - // Sum column counts to be column pointers. - for(uword c = 1; c <= n_cols; ++c) - { - access::rw(col_ptrs[c]) += col_ptrs[c - 1]; - } - - return *this; - } - - - -template -template -inline -SpMat& -SpMat::operator+=(const Base& x) - { - arma_debug_sigprint(); - - sync_csc(); - - return (*this).operator=( (*this) + x.get_ref() ); - } - - - -template -template -inline -SpMat& -SpMat::operator-=(const Base& x) - { - arma_debug_sigprint(); - - sync_csc(); - - return (*this).operator=( (*this) - x.get_ref() ); - } - - - -template -template -inline -SpMat& -SpMat::operator*=(const Base& x) - { - arma_debug_sigprint(); - - sync_csc(); - - return (*this).operator=( (*this) * x.get_ref() ); - } - - - -// NOTE: use of this function is not advised; it is implemented only for completeness -template -template -inline -SpMat& -SpMat::operator/=(const Base& x) - { - arma_debug_sigprint(); - - sync_csc(); - - SpMat tmp = (*this) / x.get_ref(); - - steal_mem(tmp); - - return *this; - } - - - -template -template -inline -SpMat& -SpMat::operator%=(const Base& x) - { - arma_debug_sigprint(); - - const quasi_unwrap U(x.get_ref()); - const Mat& B = U.M; - - arma_conform_assert_same_size(n_rows, n_cols, B.n_rows, B.n_cols, "element-wise multiplication"); - - sync_csc(); - invalidate_cache(); - - constexpr eT zero = eT(0); - - bool has_zero = false; - - for(uword c=0; c < n_cols; ++c) - { - const uword index_start = col_ptrs[c ]; - const uword index_end = col_ptrs[c + 1]; - - for(uword i=index_start; i < index_end; ++i) - { - const uword r = row_indices[i]; - - eT& val = access::rw(values[i]); - - const eT result = val * B.at(r,c); - - val = result; - - if(result == zero) { has_zero = true; } - } - } - - if(has_zero) { remove_zeros(); } - - return *this; - } - - - -template -template -inline -SpMat::SpMat(const Op& expr) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - (*this).operator=(expr); - } - - - -template -template -inline -SpMat& -SpMat::operator=(const Op& expr) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const diagmat_proxy P(expr.m); - - const uword max_n_nonzero = (std::min)(P.n_rows, P.n_cols); - - // resize memory to upper bound - init(P.n_rows, P.n_cols, max_n_nonzero); - - uword count = 0; - - for(uword i=0; i < max_n_nonzero; ++i) - { - const eT val = P[i]; - - if(val != eT(0)) - { - access::rw(values[count]) = val; - access::rw(row_indices[count]) = i; - access::rw(col_ptrs[i + 1])++; - ++count; - } - } - - // fix column pointers to be cumulative - for(uword i = 1; i < n_cols + 1; ++i) - { - access::rw(col_ptrs[i]) += col_ptrs[i - 1]; - } - - // quick resize without reallocating memory and copying data - access::rw( n_nonzero) = count; - access::rw( values[count]) = eT(0); - access::rw(row_indices[count]) = uword(0); - - return *this; - } - - - -template -template -inline -SpMat& -SpMat::operator+=(const Op& expr) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const SpMat tmp(expr); - - return (*this).operator+=(tmp); - } - - - -template -template -inline -SpMat& -SpMat::operator-=(const Op& expr) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const SpMat tmp(expr); - - return (*this).operator-=(tmp); - } - - - -template -template -inline -SpMat& -SpMat::operator*=(const Op& expr) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const SpMat tmp(expr); - - return (*this).operator*=(tmp); - } - - - -template -template -inline -SpMat& -SpMat::operator/=(const Op& expr) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const SpMat tmp(expr); - - return (*this).operator/=(tmp); - } - - - -template -template -inline -SpMat& -SpMat::operator%=(const Op& expr) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - const SpMat tmp(expr); - - return (*this).operator%=(tmp); - } - - - -/** - * Functions on subviews. - */ -template -inline -SpMat::SpMat(const SpSubview& X) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - (*this).operator=(X); - } - - - -template -inline -SpMat& -SpMat::operator=(const SpSubview& X) - { - arma_debug_sigprint(); - - if(X.n_nonzero == 0) { zeros(X.n_rows, X.n_cols); return *this; } - - X.m.sync_csc(); - - const bool alias = (this == &(X.m)); - - if(alias) - { - SpMat tmp(X); - - steal_mem(tmp); - } - else - { - init(X.n_rows, X.n_cols, X.n_nonzero); - - if(X.n_rows == X.m.n_rows) - { - const uword sv_col_start = X.aux_col1; - const uword sv_col_end = X.aux_col1 + X.n_cols - 1; - - typename SpMat::const_col_iterator m_it = X.m.begin_col_no_sync(sv_col_start); - typename SpMat::const_col_iterator m_it_end = X.m.end_col_no_sync(sv_col_end); - - uword count = 0; - - while(m_it != m_it_end) - { - const uword m_it_col_adjusted = m_it.col() - sv_col_start; - - access::rw(row_indices[count]) = m_it.row(); - access::rw(values[count]) = (*m_it); - ++access::rw(col_ptrs[m_it_col_adjusted + 1]); - - count++; - - ++m_it; - } - } - else - { - typename SpSubview::const_iterator it = X.begin(); - typename SpSubview::const_iterator it_end = X.end(); - - while(it != it_end) - { - const uword it_pos = it.pos(); - - access::rw(row_indices[it_pos]) = it.row(); - access::rw(values[it_pos]) = (*it); - ++access::rw(col_ptrs[it.col() + 1]); - ++it; - } - } - - // Now sum column pointers. - for(uword c = 1; c <= n_cols; ++c) - { - access::rw(col_ptrs[c]) += col_ptrs[c - 1]; - } - } - - return *this; - } - - - -template -inline -SpMat& -SpMat::operator+=(const SpSubview& X) - { - arma_debug_sigprint(); - - sync_csc(); - - SpMat tmp = (*this) + X; - - steal_mem(tmp); - - return *this; - } - - - -template -inline -SpMat& -SpMat::operator-=(const SpSubview& X) - { - arma_debug_sigprint(); - - sync_csc(); - - SpMat tmp = (*this) - X; - - steal_mem(tmp); - - return *this; - } - - - -template -inline -SpMat& -SpMat::operator*=(const SpSubview& y) - { - arma_debug_sigprint(); - - sync_csc(); - - SpMat z = (*this) * y; - - steal_mem(z); - - return *this; - } - - - -template -inline -SpMat& -SpMat::operator%=(const SpSubview& x) - { - arma_debug_sigprint(); - - sync_csc(); - - SpMat tmp = (*this) % x; - - steal_mem(tmp); - - return *this; - } - - - -template -inline -SpMat& -SpMat::operator/=(const SpSubview& x) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(n_rows, n_cols, x.n_rows, x.n_cols, "element-wise division"); - - // There is no pretty way to do this. - for(uword elem = 0; elem < n_elem; elem++) - { - at(elem) /= x(elem); - } - - return *this; - } - - - -template -template -inline -SpMat::SpMat(const SpSubview_col_list& X) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - SpSubview_col_list::extract(*this, X); - } - - - -template -template -inline -SpMat& -SpMat::operator=(const SpSubview_col_list& X) - { - arma_debug_sigprint(); - - const bool alias = (this == &(X.m)); - - if(alias == false) - { - SpSubview_col_list::extract(*this, X); - } - else - { - SpMat tmp(X); - - steal_mem(tmp); - } - - return *this; - } - - - -template -template -inline -SpMat& -SpMat::operator+=(const SpSubview_col_list& X) - { - arma_debug_sigprint(); - - SpSubview_col_list::plus_inplace(*this, X); - - return *this; - } - - - -template -template -inline -SpMat& -SpMat::operator-=(const SpSubview_col_list& X) - { - arma_debug_sigprint(); - - SpSubview_col_list::minus_inplace(*this, X); - - return *this; - } - - - -template -template -inline -SpMat& -SpMat::operator*=(const SpSubview_col_list& X) - { - arma_debug_sigprint(); - - sync_csc(); - - SpMat z = (*this) * X; - - steal_mem(z); - - return *this; - } - - - -template -template -inline -SpMat& -SpMat::operator%=(const SpSubview_col_list& X) - { - arma_debug_sigprint(); - - SpSubview_col_list::schur_inplace(*this, X); - - return *this; - } - - - -template -template -inline -SpMat& -SpMat::operator/=(const SpSubview_col_list& X) - { - arma_debug_sigprint(); - - SpSubview_col_list::div_inplace(*this, X); - - return *this; - } - - - -template -inline -SpMat::SpMat(const spdiagview& X) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - spdiagview::extract(*this, X); - } - - - -template -inline -SpMat& -SpMat::operator=(const spdiagview& X) - { - arma_debug_sigprint(); - - spdiagview::extract(*this, X); - - return *this; - } - - - -template -inline -SpMat& -SpMat::operator+=(const spdiagview& X) - { - arma_debug_sigprint(); - - const SpMat tmp(X); - - return (*this).operator+=(tmp); - } - - - -template -inline -SpMat& -SpMat::operator-=(const spdiagview& X) - { - arma_debug_sigprint(); - - const SpMat tmp(X); - - return (*this).operator-=(tmp); - } - - - -template -inline -SpMat& -SpMat::operator*=(const spdiagview& X) - { - arma_debug_sigprint(); - - const SpMat tmp(X); - - return (*this).operator*=(tmp); - } - - - -template -inline -SpMat& -SpMat::operator%=(const spdiagview& X) - { - arma_debug_sigprint(); - - const SpMat tmp(X); - - return (*this).operator%=(tmp); - } - - - -template -inline -SpMat& -SpMat::operator/=(const spdiagview& X) - { - arma_debug_sigprint(); - - const SpMat tmp(X); - - return (*this).operator/=(tmp); - } - - - -template -template -inline -SpMat::SpMat(const SpOp& X) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) // set in application of sparse operation - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - spop_type::apply(*this, X); - - sync_csc(); // in case apply() used element accessors - invalidate_cache(); // in case apply() modified the CSC representation - } - - - -template -template -inline -SpMat& -SpMat::operator=(const SpOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - spop_type::apply(*this, X); - - sync_csc(); // in case apply() used element accessors - invalidate_cache(); // in case apply() modified the CSC representation - - return *this; - } - - - -template -template -inline -SpMat& -SpMat::operator+=(const SpOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - sync_csc(); - - const SpMat m(X); - - return (*this).operator+=(m); - } - - - -template -template -inline -SpMat& -SpMat::operator-=(const SpOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - sync_csc(); - - const SpMat m(X); - - return (*this).operator-=(m); - } - - - -template -template -inline -SpMat& -SpMat::operator*=(const SpOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - sync_csc(); - - const SpMat m(X); - - return (*this).operator*=(m); - } - - - -template -template -inline -SpMat& -SpMat::operator%=(const SpOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - sync_csc(); - - const SpMat m(X); - - return (*this).operator%=(m); - } - - - -template -template -inline -SpMat& -SpMat::operator/=(const SpOp& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - sync_csc(); - - const SpMat m(X); - - return (*this).operator/=(m); - } - - - -template -template -inline -SpMat::SpMat(const SpGlue& X) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - spglue_type::apply(*this, X); - - sync_csc(); // in case apply() used element accessors - invalidate_cache(); // in case apply() modified the CSC representation - } - - - -template -template -inline -SpMat& -SpMat::operator=(const SpGlue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - spglue_type::apply(*this, X); - - sync_csc(); // in case apply() used element accessors - invalidate_cache(); // in case apply() modified the CSC representation - - return *this; - } - - - -template -template -inline -SpMat& -SpMat::operator+=(const SpGlue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - sync_csc(); - - const SpMat m(X); - - return (*this).operator+=(m); - } - - - -template -template -inline -SpMat& -SpMat::operator-=(const SpGlue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - sync_csc(); - - const SpMat m(X); - - return (*this).operator-=(m); - } - - - -template -template -inline -SpMat& -SpMat::operator*=(const SpGlue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - sync_csc(); - - const SpMat m(X); - - return (*this).operator*=(m); - } - - - -template -template -inline -SpMat& -SpMat::operator%=(const SpGlue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - sync_csc(); - - const SpMat m(X); - - return (*this).operator%=(m); - } - - - -template -template -inline -SpMat& -SpMat::operator/=(const SpGlue& X) - { - arma_debug_sigprint(); - - arma_type_check(( is_same_type< eT, typename T1::elem_type >::no )); - - sync_csc(); - - const SpMat m(X); - - return (*this).operator/=(m); - } - - - -template -template -inline -SpMat::SpMat(const mtSpOp& X) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - spop_type::apply(*this, X); - - sync_csc(); // in case apply() used element accessors - invalidate_cache(); // in case apply() modified the CSC representation - } - - - -template -template -inline -SpMat& -SpMat::operator=(const mtSpOp& X) - { - arma_debug_sigprint(); - - spop_type::apply(*this, X); - - sync_csc(); // in case apply() used element accessors - invalidate_cache(); // in case apply() modified the CSC representation - - return *this; - } - - - -template -template -inline -SpMat& -SpMat::operator+=(const mtSpOp& X) - { - arma_debug_sigprint(); - - sync_csc(); - - const SpMat m(X); - - return (*this).operator+=(m); - } - - - -template -template -inline -SpMat& -SpMat::operator-=(const mtSpOp& X) - { - arma_debug_sigprint(); - - sync_csc(); - - const SpMat m(X); - - return (*this).operator-=(m); - } - - - -template -template -inline -SpMat& -SpMat::operator*=(const mtSpOp& X) - { - arma_debug_sigprint(); - - sync_csc(); - - const SpMat m(X); - - return (*this).operator*=(m); - } - - - -template -template -inline -SpMat& -SpMat::operator%=(const mtSpOp& X) - { - arma_debug_sigprint(); - - sync_csc(); - - const SpMat m(X); - - return (*this).operator%=(m); - } - - - -template -template -inline -SpMat& -SpMat::operator/=(const mtSpOp& X) - { - arma_debug_sigprint(); - - sync_csc(); - - const SpMat m(X); - - return (*this).operator/=(m); - } - - - -template -template -inline -SpMat::SpMat(const mtSpGlue& X) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - spglue_type::apply(*this, X); - - sync_csc(); // in case apply() used element accessors - invalidate_cache(); // in case apply() modified the CSC representation - } - - - -template -template -inline -SpMat& -SpMat::operator=(const mtSpGlue& X) - { - arma_debug_sigprint(); - - spglue_type::apply(*this, X); - - sync_csc(); // in case apply() used element accessors - invalidate_cache(); // in case apply() modified the CSC representation - - return *this; - } - - - -template -template -inline -SpMat& -SpMat::operator+=(const mtSpGlue& X) - { - arma_debug_sigprint(); - - sync_csc(); - - const SpMat m(X); - - return (*this).operator+=(m); - } - - - -template -template -inline -SpMat& -SpMat::operator-=(const mtSpGlue& X) - { - arma_debug_sigprint(); - - sync_csc(); - - const SpMat m(X); - - return (*this).operator-=(m); - } - - - -template -template -inline -SpMat& -SpMat::operator*=(const mtSpGlue& X) - { - arma_debug_sigprint(); - - sync_csc(); - - const SpMat m(X); - - return (*this).operator*=(m); - } - - - -template -template -inline -SpMat& -SpMat::operator%=(const mtSpGlue& X) - { - arma_debug_sigprint(); - - sync_csc(); - - const SpMat m(X); - - return (*this).operator%=(m); - } - - - -template -template -inline -SpMat& -SpMat::operator/=(const mtSpGlue& X) - { - arma_debug_sigprint(); - - sync_csc(); - - const SpMat m(X); - - return (*this).operator/=(m); - } - - - -template -template -inline -SpMat::SpMat(const mtSpReduceOp& X) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(0) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - const Mat tmp(X); - - (*this).operator=(tmp); - } - - - -template -template -inline -SpMat& -SpMat::operator=(const mtSpReduceOp& X) - { - arma_debug_sigprint(); - - const Mat tmp(X); - - return (*this).operator=(tmp); - } - - - -template -template -inline -SpMat& -SpMat::operator+=(const mtSpReduceOp& X) - { - arma_debug_sigprint(); - - const Mat tmp(X); - - return (*this).operator+=(tmp); - } - - - -template -template -inline -SpMat& -SpMat::operator-=(const mtSpReduceOp& X) - { - arma_debug_sigprint(); - - const Mat tmp(X); - - return (*this).operator-=(tmp); - } - - - -template -template -inline -SpMat& -SpMat::operator*=(const mtSpReduceOp& X) - { - arma_debug_sigprint(); - - const Mat tmp(X); - - return (*this).operator*=(tmp); - } - - - -template -template -inline -SpMat& -SpMat::operator%=(const mtSpReduceOp& X) - { - arma_debug_sigprint(); - - const Mat tmp(X); - - return (*this).operator%=(tmp); - } - - - -template -template -inline -SpMat& -SpMat::operator/=(const mtSpReduceOp& X) - { - arma_debug_sigprint(); - - const Mat tmp(X); - - return (*this).operator/=(tmp); - } - - - -template -arma_inline -SpSubview_row -SpMat::row(const uword row_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds(row_num >= n_rows, "SpMat::row(): out of bounds"); - - return SpSubview_row(*this, row_num); - } - - - -template -arma_inline -const SpSubview_row -SpMat::row(const uword row_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds(row_num >= n_rows, "SpMat::row(): out of bounds"); - - return SpSubview_row(*this, row_num); - } - - - -template -inline -SpSubview_row -SpMat::operator()(const uword row_num, const span& col_span) - { - arma_debug_sigprint(); - - const bool col_all = col_span.whole; - - const uword local_n_cols = n_cols; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword submat_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - arma_conform_check_bounds - ( - (row_num >= n_rows) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - , - "SpMat::operator(): indices out of bounds or incorrectly used" - ); - - return SpSubview_row(*this, row_num, in_col1, submat_n_cols); - } - - - -template -inline -const SpSubview_row -SpMat::operator()(const uword row_num, const span& col_span) const - { - arma_debug_sigprint(); - - const bool col_all = col_span.whole; - - const uword local_n_cols = n_cols; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword submat_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - arma_conform_check_bounds - ( - (row_num >= n_rows) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - , - "SpMat::operator(): indices out of bounds or incorrectly used" - ); - - return SpSubview_row(*this, row_num, in_col1, submat_n_cols); - } - - - -template -arma_inline -SpSubview_col -SpMat::col(const uword col_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds(col_num >= n_cols, "SpMat::col(): out of bounds"); - - return SpSubview_col(*this, col_num); - } - - - -template -arma_inline -const SpSubview_col -SpMat::col(const uword col_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds(col_num >= n_cols, "SpMat::col(): out of bounds"); - - return SpSubview_col(*this, col_num); - } - - - -template -inline -SpSubview_col -SpMat::operator()(const span& row_span, const uword col_num) - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - - const uword local_n_rows = n_rows; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword submat_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - arma_conform_check_bounds - ( - (col_num >= n_cols) - || - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - , - "SpMat::operator(): indices out of bounds or incorrectly used" - ); - - return SpSubview_col(*this, col_num, in_row1, submat_n_rows); - } - - - -template -inline -const SpSubview_col -SpMat::operator()(const span& row_span, const uword col_num) const - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - - const uword local_n_rows = n_rows; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword submat_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - arma_conform_check_bounds - ( - (col_num >= n_cols) - || - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - , - "SpMat::operator(): indices out of bounds or incorrectly used" - ); - - return SpSubview_col(*this, col_num, in_row1, submat_n_rows); - } - - - -template -arma_inline -SpSubview -SpMat::rows(const uword in_row1, const uword in_row2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_row2 >= n_rows), - "SpMat::rows(): indices out of bounds or incorrectly used" - ); - - const uword subview_n_rows = in_row2 - in_row1 + 1; - - return SpSubview(*this, in_row1, 0, subview_n_rows, n_cols); - } - - - -template -arma_inline -const SpSubview -SpMat::rows(const uword in_row1, const uword in_row2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_row2 >= n_rows), - "SpMat::rows(): indices out of bounds or incorrectly used" - ); - - const uword subview_n_rows = in_row2 - in_row1 + 1; - - return SpSubview(*this, in_row1, 0, subview_n_rows, n_cols); - } - - - -template -arma_inline -SpSubview -SpMat::cols(const uword in_col1, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_col1 > in_col2) || (in_col2 >= n_cols), - "SpMat::cols(): indices out of bounds or incorrectly used" - ); - - const uword subview_n_cols = in_col2 - in_col1 + 1; - - return SpSubview(*this, 0, in_col1, n_rows, subview_n_cols); - } - - - -template -arma_inline -const SpSubview -SpMat::cols(const uword in_col1, const uword in_col2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_col1 > in_col2) || (in_col2 >= n_cols), - "SpMat::cols(): indices out of bounds or incorrectly used" - ); - - const uword subview_n_cols = in_col2 - in_col1 + 1; - - return SpSubview(*this, 0, in_col1, n_rows, subview_n_cols); - } - - - -template -arma_inline -SpSubview -SpMat::submat(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_col1 > in_col2) || (in_row2 >= n_rows) || (in_col2 >= n_cols), - "SpMat::submat(): indices out of bounds or incorrectly used" - ); - - const uword subview_n_rows = in_row2 - in_row1 + 1; - const uword subview_n_cols = in_col2 - in_col1 + 1; - - return SpSubview(*this, in_row1, in_col1, subview_n_rows, subview_n_cols); - } - - - -template -arma_inline -const SpSubview -SpMat::submat(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_col1 > in_col2) || (in_row2 >= n_rows) || (in_col2 >= n_cols), - "SpMat::submat(): indices out of bounds or incorrectly used" - ); - - const uword subview_n_rows = in_row2 - in_row1 + 1; - const uword subview_n_cols = in_col2 - in_col1 + 1; - - return SpSubview(*this, in_row1, in_col1, subview_n_rows, subview_n_cols); - } - - - -template -arma_inline -SpSubview -SpMat::submat(const uword in_row1, const uword in_col1, const SizeMat& s) - { - arma_debug_sigprint(); - - const uword l_n_rows = n_rows; - const uword l_n_cols = n_cols; - - const uword s_n_rows = s.n_rows; - const uword s_n_cols = s.n_cols; - - arma_conform_check_bounds - ( - ((in_row1 >= l_n_rows) || (in_col1 >= l_n_cols) || ((in_row1 + s_n_rows) > l_n_rows) || ((in_col1 + s_n_cols) > l_n_cols)), - "SpMat::submat(): indices or size out of bounds" - ); - - return SpSubview(*this, in_row1, in_col1, s_n_rows, s_n_cols); - } - - - -template -arma_inline -const SpSubview -SpMat::submat(const uword in_row1, const uword in_col1, const SizeMat& s) const - { - arma_debug_sigprint(); - - const uword l_n_rows = n_rows; - const uword l_n_cols = n_cols; - - const uword s_n_rows = s.n_rows; - const uword s_n_cols = s.n_cols; - - arma_conform_check_bounds - ( - ((in_row1 >= l_n_rows) || (in_col1 >= l_n_cols) || ((in_row1 + s_n_rows) > l_n_rows) || ((in_col1 + s_n_cols) > l_n_cols)), - "SpMat::submat(): indices or size out of bounds" - ); - - return SpSubview(*this, in_row1, in_col1, s_n_rows, s_n_cols); - } - - - -template -inline -SpSubview -SpMat::submat(const span& row_span, const span& col_span) - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - const bool col_all = col_span.whole; - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword submat_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword submat_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - arma_conform_check_bounds - ( - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - , - "SpMat::submat(): indices out of bounds or incorrectly used" - ); - - return SpSubview(*this, in_row1, in_col1, submat_n_rows, submat_n_cols); - } - - - -template -inline -const SpSubview -SpMat::submat(const span& row_span, const span& col_span) const - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - const bool col_all = col_span.whole; - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword submat_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword submat_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - arma_conform_check_bounds - ( - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - , - "SpMat::submat(): indices out of bounds or incorrectly used" - ); - - return SpSubview(*this, in_row1, in_col1, submat_n_rows, submat_n_cols); - } - - - -template -inline -SpSubview -SpMat::operator()(const span& row_span, const span& col_span) - { - arma_debug_sigprint(); - - return submat(row_span, col_span); - } - - - -template -inline -const SpSubview -SpMat::operator()(const span& row_span, const span& col_span) const - { - arma_debug_sigprint(); - - return submat(row_span, col_span); - } - - - -template -arma_inline -SpSubview -SpMat::operator()(const uword in_row1, const uword in_col1, const SizeMat& s) - { - arma_debug_sigprint(); - - return (*this).submat(in_row1, in_col1, s); - } - - - -template -arma_inline -const SpSubview -SpMat::operator()(const uword in_row1, const uword in_col1, const SizeMat& s) const - { - arma_debug_sigprint(); - - return (*this).submat(in_row1, in_col1, s); - } - - - -template -inline -SpSubview -SpMat::head_rows(const uword N) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > n_rows), "SpMat::head_rows(): size out of bounds" ); - - return SpSubview(*this, 0, 0, N, n_cols); - } - - - -template -inline -const SpSubview -SpMat::head_rows(const uword N) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > n_rows), "SpMat::head_rows(): size out of bounds" ); - - return SpSubview(*this, 0, 0, N, n_cols); - } - - - -template -inline -SpSubview -SpMat::tail_rows(const uword N) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > n_rows), "SpMat::tail_rows(): size out of bounds" ); - - const uword start_row = n_rows - N; - - return SpSubview(*this, start_row, 0, N, n_cols); - } - - - -template -inline -const SpSubview -SpMat::tail_rows(const uword N) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > n_rows), "SpMat::tail_rows(): size out of bounds" ); - - const uword start_row = n_rows - N; - - return SpSubview(*this, start_row, 0, N, n_cols); - } - - - -template -inline -SpSubview -SpMat::head_cols(const uword N) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > n_cols), "SpMat::head_cols(): size out of bounds" ); - - return SpSubview(*this, 0, 0, n_rows, N); - } - - - -template -inline -const SpSubview -SpMat::head_cols(const uword N) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > n_cols), "SpMat::head_cols(): size out of bounds" ); - - return SpSubview(*this, 0, 0, n_rows, N); - } - - - -template -inline -SpSubview -SpMat::tail_cols(const uword N) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > n_cols), "SpMat::tail_cols(): size out of bounds" ); - - const uword start_col = n_cols - N; - - return SpSubview(*this, 0, start_col, n_rows, N); - } - - - -template -inline -const SpSubview -SpMat::tail_cols(const uword N) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > n_cols), "SpMat::tail_cols(): size out of bounds" ); - - const uword start_col = n_cols - N; - - return SpSubview(*this, 0, start_col, n_rows, N); - } - - - -template -template -arma_inline -SpSubview_col_list -SpMat::cols(const Base& indices) - { - arma_debug_sigprint(); - - return SpSubview_col_list(*this, indices); - } - - - -template -template -arma_inline -const SpSubview_col_list -SpMat::cols(const Base& indices) const - { - arma_debug_sigprint(); - - return SpSubview_col_list(*this, indices); - } - - - -//! creation of spdiagview (diagonal) -template -inline -spdiagview -SpMat::diag(const sword in_id) - { - arma_debug_sigprint(); - - const uword row_offset = (in_id < 0) ? uword(-in_id) : 0; - const uword col_offset = (in_id > 0) ? uword( in_id) : 0; - - arma_conform_check_bounds - ( - ((row_offset > 0) && (row_offset >= n_rows)) || ((col_offset > 0) && (col_offset >= n_cols)), - "SpMat::diag(): requested diagonal out of bounds" - ); - - const uword len = (std::min)(n_rows - row_offset, n_cols - col_offset); - - return spdiagview(*this, row_offset, col_offset, len); - } - - - -//! creation of spdiagview (diagonal) -template -inline -const spdiagview -SpMat::diag(const sword in_id) const - { - arma_debug_sigprint(); - - const uword row_offset = uword( (in_id < 0) ? -in_id : 0 ); - const uword col_offset = uword( (in_id > 0) ? in_id : 0 ); - - arma_conform_check_bounds - ( - ((row_offset > 0) && (row_offset >= n_rows)) || ((col_offset > 0) && (col_offset >= n_cols)), - "SpMat::diag(): requested diagonal out of bounds" - ); - - const uword len = (std::min)(n_rows - row_offset, n_cols - col_offset); - - return spdiagview(*this, row_offset, col_offset, len); - } - - - -template -inline -void -SpMat::swap_rows(const uword in_row1, const uword in_row2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( ((in_row1 >= n_rows) || (in_row2 >= n_rows)), "SpMat::swap_rows(): out of bounds" ); - - if(in_row1 == in_row2) { return; } - - sync_csc(); - invalidate_cache(); - - // The easier way to do this, instead of collecting all the elements in one row and then swapping with the other, will be - // to iterate over each column of the matrix (since we store in column-major format) and then swap the two elements in the two rows at that time. - // We will try to avoid using the at() call since it is expensive, instead preferring to use an iterator to track our position. - uword col1 = (in_row1 < in_row2) ? in_row1 : in_row2; - uword col2 = (in_row1 < in_row2) ? in_row2 : in_row1; - - for(uword lcol = 0; lcol < n_cols; lcol++) - { - // If there is nothing in this column we can ignore it. - if(col_ptrs[lcol] == col_ptrs[lcol + 1]) - { - continue; - } - - // These will represent the positions of the items themselves. - uword loc1 = n_nonzero + 1; - uword loc2 = n_nonzero + 1; - - for(uword search_pos = col_ptrs[lcol]; search_pos < col_ptrs[lcol + 1]; search_pos++) - { - if(row_indices[search_pos] == col1) - { - loc1 = search_pos; - } - - if(row_indices[search_pos] == col2) - { - loc2 = search_pos; - break; // No need to look any further. - } - } - - // There are four cases: we found both elements; we found one element (loc1); we found one element (loc2); we found zero elements. - // If we found zero elements no work needs to be done and we can continue to the next column. - if((loc1 != (n_nonzero + 1)) && (loc2 != (n_nonzero + 1))) - { - // This is an easy case: just swap the values. No index modifying necessary. - eT tmp = values[loc1]; - access::rw(values[loc1]) = values[loc2]; - access::rw(values[loc2]) = tmp; - } - else if(loc1 != (n_nonzero + 1)) // We only found loc1 and not loc2. - { - // We need to find the correct place to move our value to. It will be forward (not backwards) because in_row2 > in_row1. - // Each iteration of the loop swaps the current value (loc1) with (loc1 + 1); in this manner we move our value down to where it should be. - while(((loc1 + 1) < col_ptrs[lcol + 1]) && (row_indices[loc1 + 1] < in_row2)) - { - // Swap both the values and the indices. The column should not change. - eT tmp = values[loc1]; - access::rw(values[loc1]) = values[loc1 + 1]; - access::rw(values[loc1 + 1]) = tmp; - - uword tmp_index = row_indices[loc1]; - access::rw(row_indices[loc1]) = row_indices[loc1 + 1]; - access::rw(row_indices[loc1 + 1]) = tmp_index; - - loc1++; // And increment the counter. - } - - // Now set the row index correctly. - access::rw(row_indices[loc1]) = in_row2; - - } - else if(loc2 != (n_nonzero + 1)) - { - // We need to find the correct place to move our value to. It will be backwards (not forwards) because in_row1 < in_row2. - // Each iteration of the loop swaps the current value (loc2) with (loc2 - 1); in this manner we move our value up to where it should be. - while(((loc2 - 1) >= col_ptrs[lcol]) && (row_indices[loc2 - 1] > in_row1)) - { - // Swap both the values and the indices. The column should not change. - eT tmp = values[loc2]; - access::rw(values[loc2]) = values[loc2 - 1]; - access::rw(values[loc2 - 1]) = tmp; - - uword tmp_index = row_indices[loc2]; - access::rw(row_indices[loc2]) = row_indices[loc2 - 1]; - access::rw(row_indices[loc2 - 1]) = tmp_index; - - loc2--; // And decrement the counter. - } - - // Now set the row index correctly. - access::rw(row_indices[loc2]) = in_row1; - - } - /* else: no need to swap anything; both values are zero */ - } - } - - - -template -inline -void -SpMat::swap_cols(const uword in_col1, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( ((in_col1 >= n_cols) || (in_col2 >= n_cols)), "SpMat::swap_cols(): out of bounds" ); - - if(in_col1 == in_col2) { return; } - - // TODO: this is a rudimentary implementation - - const SpMat tmp1 = (*this).col(in_col1); - const SpMat tmp2 = (*this).col(in_col2); - - (*this).col(in_col2) = tmp1; - (*this).col(in_col1) = tmp2; - - // for(uword lrow = 0; lrow < n_rows; ++lrow) - // { - // const eT tmp = at(lrow, in_col1); - // at(lrow, in_col1) = eT( at(lrow, in_col2) ); - // at(lrow, in_col2) = tmp; - // } - } - - - -template -inline -void -SpMat::shed_row(const uword row_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds(row_num >= n_rows, "SpMat::shed_row(): out of bounds"); - - shed_rows (row_num, row_num); - } - - - -template -inline -void -SpMat::shed_col(const uword col_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds(col_num >= n_cols, "SpMat::shed_col(): out of bounds"); - - shed_cols(col_num, col_num); - } - - - -template -inline -void -SpMat::shed_rows(const uword in_row1, const uword in_row2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_row2 >= n_rows), - "SpMat::shed_rows(): indices out of bounds or incorectly used" - ); - - sync_csc(); - - SpMat newmat(n_rows - (in_row2 - in_row1 + 1), n_cols); - - // First, count the number of elements we will be removing. - uword removing = 0; - for(uword i = 0; i < n_nonzero; ++i) - { - const uword lrow = row_indices[i]; - if(lrow >= in_row1 && lrow <= in_row2) - { - ++removing; - } - } - - // Obtain counts of the number of points in each column and store them as the - // (invalid) column pointers of the new matrix. - for(uword i = 1; i < n_cols + 1; ++i) - { - access::rw(newmat.col_ptrs[i]) = col_ptrs[i] - col_ptrs[i - 1]; - } - - // Now initialize memory for the new matrix. - newmat.mem_resize(n_nonzero - removing); - - // Now, copy over the elements. - // i is the index in the old matrix; j is the index in the new matrix. - const_iterator it = cbegin(); - const_iterator it_end = cend(); - - uword j = 0; // The index in the new matrix. - while(it != it_end) - { - const uword lrow = it.row(); - const uword lcol = it.col(); - - if(lrow >= in_row1 && lrow <= in_row2) - { - // This element is being removed. Subtract it from the column counts. - --access::rw(newmat.col_ptrs[lcol + 1]); - } - else - { - // This element is being kept. We may need to map the row index, - // if it is past the section of rows we are removing. - if(lrow > in_row2) - { - access::rw(newmat.row_indices[j]) = lrow - (in_row2 - in_row1 + 1); - } - else - { - access::rw(newmat.row_indices[j]) = lrow; - } - - access::rw(newmat.values[j]) = (*it); - ++j; // Increment index in new matrix. - } - - ++it; - } - - // Finally, sum the column counts so they are correct column pointers. - for(uword i = 1; i < n_cols + 1; ++i) - { - access::rw(newmat.col_ptrs[i]) += newmat.col_ptrs[i - 1]; - } - - // Now steal the memory of the new matrix. - steal_mem(newmat); - } - - - -template -inline -void -SpMat::shed_cols(const uword in_col1, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_col1 > in_col2) || (in_col2 >= n_cols), - "SpMat::shed_cols(): indices out of bounds or incorrectly used" - ); - - sync_csc(); - invalidate_cache(); - - // First we find the locations in values and row_indices for the column entries. - uword col_beg = col_ptrs[in_col1]; - uword col_end = col_ptrs[in_col2 + 1]; - - // Then we find the number of entries in the column. - uword diff = col_end - col_beg; - - if(diff > 0) - { - eT* new_values = memory::acquire (n_nonzero + 1 - diff); - uword* new_row_indices = memory::acquire(n_nonzero + 1 - diff); - - // Copy first part. - if(col_beg != 0) - { - arrayops::copy(new_values, values, col_beg); - arrayops::copy(new_row_indices, row_indices, col_beg); - } - - // Copy second part. - if(col_end != n_nonzero) - { - arrayops::copy(new_values + col_beg, values + col_end, n_nonzero - col_end); - arrayops::copy(new_row_indices + col_beg, row_indices + col_end, n_nonzero - col_end); - } - - // Copy sentry element. - new_values[n_nonzero - diff] = values[n_nonzero]; - new_row_indices[n_nonzero - diff] = row_indices[n_nonzero]; - - if(values) { memory::release(access::rw(values)); } - if(row_indices) { memory::release(access::rw(row_indices)); } - - access::rw(values) = new_values; - access::rw(row_indices) = new_row_indices; - - // Update counts and such. - access::rw(n_nonzero) -= diff; - } - - // Update column pointers. - const uword new_n_cols = n_cols - ((in_col2 - in_col1) + 1); - - uword* new_col_ptrs = memory::acquire(new_n_cols + 2); - new_col_ptrs[new_n_cols + 1] = std::numeric_limits::max(); - - // Copy first set of columns (no manipulation required). - if(in_col1 != 0) - { - arrayops::copy(new_col_ptrs, col_ptrs, in_col1); - } - - // Copy second set of columns (manipulation required). - uword cur_col = in_col1; - for(uword i = in_col2 + 1; i <= n_cols; ++i, ++cur_col) - { - new_col_ptrs[cur_col] = col_ptrs[i] - diff; - } - - if(col_ptrs) { memory::release(access::rw(col_ptrs)); } - access::rw(col_ptrs) = new_col_ptrs; - - // We update the element and column counts, and we're done. - access::rw(n_cols) = new_n_cols; - access::rw(n_elem) = n_cols * n_rows; - } - - - -/** - * Element access; acces the i'th element (works identically to the Mat accessors). - * If there is nothing at element i, 0 is returned. - */ - -template -arma_inline -SpMat_MapMat_val -SpMat::operator[](const uword i) - { - const uword in_col = i / n_rows; - const uword in_row = i % n_rows; - - return SpMat_MapMat_val((*this), cache, in_row, in_col); - } - - - -template -arma_inline -eT -SpMat::operator[](const uword i) const - { - return get_value(i); - } - - - -template -arma_inline -SpMat_MapMat_val -SpMat::at(const uword i) - { - const uword in_col = i / n_rows; - const uword in_row = i % n_rows; - - return SpMat_MapMat_val((*this), cache, in_row, in_col); - } - - - -template -arma_inline -eT -SpMat::at(const uword i) const - { - return get_value(i); - } - - - -template -arma_inline -SpMat_MapMat_val -SpMat::operator()(const uword i) - { - arma_conform_check_bounds( (i >= n_elem), "SpMat::operator(): out of bounds" ); - - const uword in_col = i / n_rows; - const uword in_row = i % n_rows; - - return SpMat_MapMat_val((*this), cache, in_row, in_col); - } - - - -template -arma_inline -eT -SpMat::operator()(const uword i) const - { - arma_conform_check_bounds( (i >= n_elem), "SpMat::operator(): out of bounds" ); - - return get_value(i); - } - - - -/** - * Element access; access the element at row in_rows and column in_col. - * If there is nothing at that position, 0 is returned. - */ - -#if defined(__cpp_multidimensional_subscript) - - template - arma_inline - SpMat_MapMat_val - SpMat::operator[] (const uword in_row, const uword in_col) - { - return SpMat_MapMat_val((*this), cache, in_row, in_col); - } - - - - template - arma_inline - eT - SpMat::operator[] (const uword in_row, const uword in_col) const - { - return get_value(in_row, in_col); - } - -#endif - - - -template -arma_inline -SpMat_MapMat_val -SpMat::at(const uword in_row, const uword in_col) - { - return SpMat_MapMat_val((*this), cache, in_row, in_col); - } - - - -template -arma_inline -eT -SpMat::at(const uword in_row, const uword in_col) const - { - return get_value(in_row, in_col); - } - - - -template -arma_inline -SpMat_MapMat_val -SpMat::operator()(const uword in_row, const uword in_col) - { - arma_conform_check_bounds( ((in_row >= n_rows) || (in_col >= n_cols)), "SpMat::operator(): out of bounds" ); - - return SpMat_MapMat_val((*this), cache, in_row, in_col); - } - - - -template -arma_inline -eT -SpMat::operator()(const uword in_row, const uword in_col) const - { - arma_conform_check_bounds( ((in_row >= n_rows) || (in_col >= n_cols)), "SpMat::operator(): out of bounds" ); - - return get_value(in_row, in_col); - } - - - -/** - * Check if matrix is empty (no size, no values). - */ -template -arma_inline -bool -SpMat::is_empty() const - { - return (n_elem == 0); - } - - - -//! returns true if the object can be interpreted as a column or row vector -template -arma_inline -bool -SpMat::is_vec() const - { - return ( (n_rows == 1) || (n_cols == 1) ); - } - - - -//! returns true if the object can be interpreted as a row vector -template -arma_inline -bool -SpMat::is_rowvec() const - { - return (n_rows == 1); - } - - - -//! returns true if the object can be interpreted as a column vector -template -arma_inline -bool -SpMat::is_colvec() const - { - return (n_cols == 1); - } - - - -//! returns true if the object has the same number of non-zero rows and columnns -template -arma_inline -bool -SpMat::is_square() const - { - return (n_rows == n_cols); - } - - - -template -inline -bool -SpMat::is_symmetric() const - { - arma_debug_sigprint(); - - const SpMat& A = (*this); - - if(A.n_rows != A.n_cols) { return false; } - - const SpMat tmp = A - A.st(); - - return (tmp.n_nonzero == uword(0)); - } - - - -template -inline -bool -SpMat::is_symmetric(const typename get_pod_type::result tol) const - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - if(tol == T(0)) { return (*this).is_symmetric(); } - - arma_conform_check( (tol < T(0)), "is_symmetric(): parameter 'tol' must be >= 0" ); - - const SpMat& A = (*this); - - if(A.n_rows != A.n_cols) { return false; } - - const T norm_A = as_scalar( arma::max(sum(abs(A), 1), 0) ); - - if(norm_A == T(0)) { return true; } - - const T norm_A_Ast = as_scalar( arma::max(sum(abs(A - A.st()), 1), 0) ); - - return ( (norm_A_Ast / norm_A) <= tol ); - } - - - -template -inline -bool -SpMat::is_hermitian() const - { - arma_debug_sigprint(); - - const SpMat& A = (*this); - - if(A.n_rows != A.n_cols) { return false; } - - const SpMat tmp = A - A.t(); - - return (tmp.n_nonzero == uword(0)); - } - - - -template -inline -bool -SpMat::is_hermitian(const typename get_pod_type::result tol) const - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - if(tol == T(0)) { return (*this).is_hermitian(); } - - arma_conform_check( (tol < T(0)), "is_hermitian(): parameter 'tol' must be >= 0" ); - - const SpMat& A = (*this); - - if(A.n_rows != A.n_cols) { return false; } - - const T norm_A = as_scalar( arma::max(sum(abs(A), 1), 0) ); - - if(norm_A == T(0)) { return true; } - - const T norm_A_At = as_scalar( arma::max(sum(abs(A - A.t()), 1), 0) ); - - return ( (norm_A_At / norm_A) <= tol ); - } - - - -template -inline -bool -SpMat::internal_is_finite() const - { - arma_debug_sigprint(); - - sync_csc(); - - return arrayops::is_finite(values, n_nonzero); - } - - - -template -inline -bool -SpMat::internal_has_inf() const - { - arma_debug_sigprint(); - - sync_csc(); - - return arrayops::has_inf(values, n_nonzero); - } - - - -template -inline -bool -SpMat::internal_has_nan() const - { - arma_debug_sigprint(); - - sync_csc(); - - return arrayops::has_nan(values, n_nonzero); - } - - - -template -inline -bool -SpMat::internal_has_nonfinite() const - { - arma_debug_sigprint(); - - sync_csc(); - - return (arrayops::is_finite(values, n_nonzero) == false); - } - - - -//! returns true if the given index is currently in range -template -arma_inline -bool -SpMat::in_range(const uword i) const - { - return (i < n_elem); - } - - -//! returns true if the given start and end indices are currently in range -template -arma_inline -bool -SpMat::in_range(const span& x) const - { - arma_debug_sigprint(); - - if(x.whole) - { - return true; - } - else - { - const uword a = x.a; - const uword b = x.b; - - return ( (a <= b) && (b < n_elem) ); - } - } - - - -//! returns true if the given location is currently in range -template -arma_inline -bool -SpMat::in_range(const uword in_row, const uword in_col) const - { - return ( (in_row < n_rows) && (in_col < n_cols) ); - } - - - -template -arma_inline -bool -SpMat::in_range(const span& row_span, const uword in_col) const - { - arma_debug_sigprint(); - - if(row_span.whole) - { - return (in_col < n_cols); - } - else - { - const uword in_row1 = row_span.a; - const uword in_row2 = row_span.b; - - return ( (in_row1 <= in_row2) && (in_row2 < n_rows) && (in_col < n_cols) ); - } - } - - - -template -arma_inline -bool -SpMat::in_range(const uword in_row, const span& col_span) const - { - arma_debug_sigprint(); - - if(col_span.whole) - { - return (in_row < n_rows); - } - else - { - const uword in_col1 = col_span.a; - const uword in_col2 = col_span.b; - - return ( (in_row < n_rows) && (in_col1 <= in_col2) && (in_col2 < n_cols) ); - } - } - - - -template -arma_inline -bool -SpMat::in_range(const span& row_span, const span& col_span) const - { - arma_debug_sigprint(); - - const uword in_row1 = row_span.a; - const uword in_row2 = row_span.b; - - const uword in_col1 = col_span.a; - const uword in_col2 = col_span.b; - - const bool rows_ok = row_span.whole ? true : ( (in_row1 <= in_row2) && (in_row2 < n_rows) ); - const bool cols_ok = col_span.whole ? true : ( (in_col1 <= in_col2) && (in_col2 < n_cols) ); - - return ( rows_ok && cols_ok ); - } - - - -template -arma_inline -bool -SpMat::in_range(const uword in_row, const uword in_col, const SizeMat& s) const - { - const uword l_n_rows = n_rows; - const uword l_n_cols = n_cols; - - if( (in_row >= l_n_rows) || (in_col >= l_n_cols) || ((in_row + s.n_rows) > l_n_rows) || ((in_col + s.n_cols) > l_n_cols) ) - { - return false; - } - else - { - return true; - } - } - - - -//! Set the size to the size of another matrix. -template -template -inline -SpMat& -SpMat::copy_size(const SpMat& m) - { - arma_debug_sigprint(); - - return set_size(m.n_rows, m.n_cols); - } - - - -template -template -inline -SpMat& -SpMat::copy_size(const Mat& m) - { - arma_debug_sigprint(); - - return set_size(m.n_rows, m.n_cols); - } - - - -template -inline -SpMat& -SpMat::set_size(const uword new_n_elem) - { - arma_debug_sigprint(); - - const uword new_n_rows = (vec_state == 2) ? uword(1 ) : uword(new_n_elem); - const uword new_n_cols = (vec_state == 2) ? uword(new_n_elem) : uword(1 ); - - return set_size(new_n_rows, new_n_cols); - } - - - -template -inline -SpMat& -SpMat::set_size(const uword in_rows, const uword in_cols) - { - arma_debug_sigprint(); - - invalidate_cache(); // placed here, as set_size() is used during matrix modification - - if( (n_rows == in_rows) && (n_cols == in_cols) ) { return *this; } - - init(in_rows, in_cols); - - return *this; - } - - - -template -inline -SpMat& -SpMat::set_size(const SizeMat& s) - { - arma_debug_sigprint(); - - return (*this).set_size(s.n_rows, s.n_cols); - } - - - -template -inline -SpMat& -SpMat::resize(const uword in_rows, const uword in_cols) - { - arma_debug_sigprint(); - - if( (n_rows == in_rows) && (n_cols == in_cols) ) { return *this; } - - if( (n_elem == 0) || (n_nonzero == 0) ) { return set_size(in_rows, in_cols); } - - SpMat tmp(in_rows, in_cols); - - if(tmp.n_elem > 0) - { - sync_csc(); - - const uword last_row = (std::min)(in_rows, n_rows) - 1; - const uword last_col = (std::min)(in_cols, n_cols) - 1; - - tmp.submat(0, 0, last_row, last_col) = (*this).submat(0, 0, last_row, last_col); - } - - steal_mem(tmp); - - return *this; - } - - - -template -inline -SpMat& -SpMat::resize(const SizeMat& s) - { - arma_debug_sigprint(); - - return (*this).resize(s.n_rows, s.n_cols); - } - - - -template -inline -SpMat& -SpMat::reshape(const uword in_rows, const uword in_cols) - { - arma_debug_sigprint(); - - arma_check( ((in_rows*in_cols) != n_elem), "SpMat::reshape(): changing the number of elements in a sparse matrix is currently not supported" ); - - if( (n_rows == in_rows) && (n_cols == in_cols) ) { return *this; } - - if(vec_state == 1) { arma_conform_check( (in_cols != 1), "SpMat::reshape(): object is a column vector; requested size is not compatible" ); } - if(vec_state == 2) { arma_conform_check( (in_rows != 1), "SpMat::reshape(): object is a row vector; requested size is not compatible" ); } - - if(n_nonzero == 0) { return (*this).zeros(in_rows, in_cols); } - - if(in_cols == 1) - { - (*this).reshape_helper_intovec(); - } - else - { - (*this).reshape_helper_generic(in_rows, in_cols); - } - - return *this; - } - - - -template -inline -SpMat& -SpMat::reshape(const SizeMat& s) - { - arma_debug_sigprint(); - - return (*this).reshape(s.n_rows, s.n_cols); - } - - - -template -inline -void -SpMat::reshape_helper_generic(const uword in_rows, const uword in_cols) - { - arma_debug_sigprint(); - - sync_csc(); - invalidate_cache(); - - // We have to modify all of the relevant row indices and the relevant column pointers. - // Iterate over all the points to do this. We won't be deleting any points, but we will be modifying - // columns and rows. We'll have to store a new set of column vectors. - uword* new_col_ptrs = memory::acquire(in_cols + 2); - new_col_ptrs[in_cols + 1] = std::numeric_limits::max(); - - uword* new_row_indices = memory::acquire(n_nonzero + 1); - access::rw(new_row_indices[n_nonzero]) = 0; - - arrayops::fill_zeros(new_col_ptrs, in_cols + 1); - - const_iterator it = cbegin(); - const_iterator it_end = cend(); - - for(; it != it_end; ++it) - { - uword vector_position = (it.col() * n_rows) + it.row(); - new_row_indices[it.pos()] = vector_position % in_rows; - ++new_col_ptrs[vector_position / in_rows + 1]; - } - - // Now sum the column counts to get the new column pointers. - for(uword i = 1; i <= in_cols; i++) - { - access::rw(new_col_ptrs[i]) += new_col_ptrs[i - 1]; - } - - // Copy the new row indices. - if(row_indices) { memory::release(access::rw(row_indices)); } - if(col_ptrs) { memory::release(access::rw(col_ptrs)); } - - access::rw(row_indices) = new_row_indices; - access::rw(col_ptrs) = new_col_ptrs; - - // Now set the size. - access::rw(n_rows) = in_rows; - access::rw(n_cols) = in_cols; - } - - - -template -inline -void -SpMat::reshape_helper_intovec() - { - arma_debug_sigprint(); - - sync_csc(); - invalidate_cache(); - - const_iterator it = cbegin(); - - const uword t_n_rows = n_rows; - const uword t_n_nonzero = n_nonzero; - - for(uword i=0; i < t_n_nonzero; ++i) - { - const uword t_index = (it.col() * t_n_rows) + it.row(); - - // ensure the iterator is pointing to the next element - // before we overwrite the row index of the current element - ++it; - - access::rw(row_indices[i]) = t_index; - } - - access::rw(row_indices[n_nonzero]) = 0; - - access::rw(col_ptrs[0]) = 0; - access::rw(col_ptrs[1]) = n_nonzero; - access::rw(col_ptrs[2]) = std::numeric_limits::max(); - - access::rw(n_rows) = (n_rows * n_cols); - access::rw(n_cols) = 1; - } - - - -//! apply a functor to each non-zero element -template -template -inline -SpMat& -SpMat::for_each(functor F) - { - arma_debug_sigprint(); - - sync_csc(); - - const uword N = (*this).n_nonzero; - - eT* rw_values = access::rwp(values); - - bool modified = false; - bool has_zero = false; - - for(uword i=0; i < N; ++i) - { - eT& new_value = rw_values[i]; - const eT old_value = new_value; - - F(new_value); - - if(new_value != old_value) { modified = true; } - if(new_value == eT(0) ) { has_zero = true; } - } - - if(modified) { invalidate_cache(); } - if(has_zero) { remove_zeros(); } - - return *this; - } - - - -template -template -inline -const SpMat& -SpMat::for_each(functor F) const - { - arma_debug_sigprint(); - - sync_csc(); - - const uword N = (*this).n_nonzero; - - for(uword i=0; i < N; ++i) { F(values[i]); } - - return *this; - } - - - -//! transform each non-zero element using a functor -template -template -inline -SpMat& -SpMat::transform(functor F) - { - arma_debug_sigprint(); - - sync_csc(); - invalidate_cache(); - - const uword N = (*this).n_nonzero; - - eT* rw_values = access::rwp(values); - - bool has_zero = false; - - for(uword i=0; i < N; ++i) - { - eT& rw_values_i = rw_values[i]; - - rw_values_i = eT( F(rw_values_i) ); - - if(rw_values_i == eT(0)) { has_zero = true; } - } - - if(has_zero) { remove_zeros(); } - - return *this; - } - - - -template -inline -SpMat& -SpMat::replace(const eT old_val, const eT new_val) - { - arma_debug_sigprint(); - - if(old_val == eT(0)) - { - arma_warn(1, "SpMat::replace(): replacement not done, as old_val = 0"); - } - else - { - sync_csc(); - invalidate_cache(); - - arrayops::replace(access::rwp(values), n_nonzero, old_val, new_val); - - if(new_val == eT(0)) { remove_zeros(); } - } - - return *this; - } - - - -template -inline -SpMat& -SpMat::clean(const typename get_pod_type::result threshold) - { - arma_debug_sigprint(); - - if(n_nonzero == 0) { return *this; } - - sync_csc(); - invalidate_cache(); - - arrayops::clean(access::rwp(values), n_nonzero, threshold); - - remove_zeros(); - - return *this; - } - - - -template -inline -SpMat& -SpMat::clamp(const eT min_val, const eT max_val) - { - arma_debug_sigprint(); - - if(is_cx::no) - { - arma_conform_check( (access::tmp_real(min_val) > access::tmp_real(max_val)), "SpMat::clamp(): min_val must be less than max_val" ); - } - else - { - arma_conform_check( (access::tmp_real(min_val) > access::tmp_real(max_val)), "SpMat::clamp(): real(min_val) must be less than real(max_val)" ); - arma_conform_check( (access::tmp_imag(min_val) > access::tmp_imag(max_val)), "SpMat::clamp(): imag(min_val) must be less than imag(max_val)" ); - } - - if(n_nonzero == 0) { return *this; } - - sync_csc(); - invalidate_cache(); - - arrayops::clamp(access::rwp(values), n_nonzero, min_val, max_val); - - if( (min_val == eT(0)) || (max_val == eT(0)) ) { remove_zeros(); } - - return *this; - } - - - -template -inline -SpMat& -SpMat::zeros() - { - arma_debug_sigprint(); - - if((n_nonzero == 0) && (values != nullptr)) - { - invalidate_cache(); - } - else - { - init(n_rows, n_cols); - } - - return *this; - } - - - -template -inline -SpMat& -SpMat::zeros(const uword new_n_elem) - { - arma_debug_sigprint(); - - const uword new_n_rows = (vec_state == 2) ? uword(1 ) : uword(new_n_elem); - const uword new_n_cols = (vec_state == 2) ? uword(new_n_elem) : uword(1 ); - - return zeros(new_n_rows, new_n_cols); - } - - - -template -inline -SpMat& -SpMat::zeros(const uword in_rows, const uword in_cols) - { - arma_debug_sigprint(); - - if((n_nonzero == 0) && (n_rows == in_rows) && (n_cols == in_cols) && (values != nullptr)) - { - invalidate_cache(); - } - else - { - init(in_rows, in_cols); - } - - return *this; - } - - - -template -inline -SpMat& -SpMat::zeros(const SizeMat& s) - { - arma_debug_sigprint(); - - return (*this).zeros(s.n_rows, s.n_cols); - } - - - -template -inline -SpMat& -SpMat::eye() - { - arma_debug_sigprint(); - - return (*this).eye(n_rows, n_cols); - } - - - -template -inline -SpMat& -SpMat::eye(const uword in_rows, const uword in_cols) - { - arma_debug_sigprint(); - - const uword N = (std::min)(in_rows, in_cols); - - init(in_rows, in_cols, N); - - arrayops::inplace_set(access::rwp(values), eT(1), N); - - for(uword i = 0; i < N; ++i) { access::rw(row_indices[i]) = i; } - - for(uword i = 0; i <= N; ++i) { access::rw(col_ptrs[i]) = i; } - - // take into account non-square matrices - for(uword i = (N+1); i <= in_cols; ++i) { access::rw(col_ptrs[i]) = N; } - - access::rw(n_nonzero) = N; - - return *this; - } - - - -template -inline -SpMat& -SpMat::eye(const SizeMat& s) - { - arma_debug_sigprint(); - - return (*this).eye(s.n_rows, s.n_cols); - } - - - -template -inline -SpMat& -SpMat::speye() - { - arma_debug_sigprint(); - - return (*this).eye(n_rows, n_cols); - } - - - -template -inline -SpMat& -SpMat::speye(const uword in_n_rows, const uword in_n_cols) - { - arma_debug_sigprint(); - - return (*this).eye(in_n_rows, in_n_cols); - } - - - -template -inline -SpMat& -SpMat::speye(const SizeMat& s) - { - arma_debug_sigprint(); - - return (*this).eye(s.n_rows, s.n_cols); - } - - - -template -inline -SpMat& -SpMat::sprandu(const uword in_rows, const uword in_cols, const double density) - { - arma_debug_sigprint(); - - arma_conform_check( ( (density < double(0)) || (density > double(1)) ), "sprandu(): density must be in the [0,1] interval" ); - - const uword new_n_nonzero = uword(density * double(in_rows) * double(in_cols) + 0.5); - - init(in_rows, in_cols, new_n_nonzero); - - if(new_n_nonzero == 0) { return *this; } - - arma_rng::randu::fill( access::rwp(values), new_n_nonzero ); - - uvec indices = linspace( 0u, in_rows*in_cols-1, new_n_nonzero ); - - // perturb the indices - for(uword i=1; i < new_n_nonzero-1; ++i) - { - const uword index_left = indices[i-1]; - const uword index_right = indices[i+1]; - - const uword center = (index_left + index_right) / 2; - - const uword delta1 = center - index_left - 1; - const uword delta2 = index_right - center - 1; - - const uword min_delta = (std::min)(delta1, delta2); - - uword index_new = uword( double(center) + double(min_delta) * (2.0*randu()-1.0) ); - - // paranoia, but better be safe than sorry - if( (index_left < index_new) && (index_new < index_right) ) - { - indices[i] = index_new; - } - } - - for(uword i=0; i -inline -SpMat& -SpMat::sprandu(const SizeMat& s, const double density) - { - arma_debug_sigprint(); - - return (*this).sprandu(s.n_rows, s.n_cols, density); - } - - - -template -inline -SpMat& -SpMat::sprandn(const uword in_rows, const uword in_cols, const double density) - { - arma_debug_sigprint(); - - arma_conform_check( ( (density < double(0)) || (density > double(1)) ), "sprandn(): density must be in the [0,1] interval" ); - - const uword new_n_nonzero = uword(density * double(in_rows) * double(in_cols) + 0.5); - - init(in_rows, in_cols, new_n_nonzero); - - if(new_n_nonzero == 0) { return *this; } - - arma_rng::randn::fill( access::rwp(values), new_n_nonzero ); - - uvec indices = linspace( 0u, in_rows*in_cols-1, new_n_nonzero ); - - // perturb the indices - for(uword i=1; i < new_n_nonzero-1; ++i) - { - const uword index_left = indices[i-1]; - const uword index_right = indices[i+1]; - - const uword center = (index_left + index_right) / 2; - - const uword delta1 = center - index_left - 1; - const uword delta2 = index_right - center - 1; - - const uword min_delta = (std::min)(delta1, delta2); - - uword index_new = uword( double(center) + double(min_delta) * (2.0*randu()-1.0) ); - - // paranoia, but better be safe than sorry - if( (index_left < index_new) && (index_new < index_right) ) - { - indices[i] = index_new; - } - } - - for(uword i=0; i -inline -SpMat& -SpMat::sprandn(const SizeMat& s, const double density) - { - arma_debug_sigprint(); - - return (*this).sprandn(s.n_rows, s.n_cols, density); - } - - - -template -inline -void -SpMat::reset() - { - arma_debug_sigprint(); - - const uword new_n_rows = (vec_state == 2) ? 1 : 0; - const uword new_n_cols = (vec_state == 1) ? 1 : 0; - - init(new_n_rows, new_n_cols); - } - - - -template -inline -void -SpMat::reset_cache() - { - arma_debug_sigprint(); - - sync_csc(); - - #if defined(ARMA_USE_OPENMP) - { - #pragma omp critical (arma_SpMat_cache) - { - cache.reset(); - - sync_state = 0; - } - } - #elif defined(ARMA_USE_STD_MUTEX) - { - const std::lock_guard lock(cache_mutex); - - cache.reset(); - - sync_state = 0; - } - #else - { - cache.reset(); - - sync_state = 0; - } - #endif - } - - - -template -inline -void -SpMat::reserve(const uword in_rows, const uword in_cols, const uword new_n_nonzero) - { - arma_debug_sigprint(); - - init(in_rows, in_cols, new_n_nonzero); - } - - - -template -template -inline -void -SpMat::set_real(const SpBase::pod_type,T1>& X) - { - arma_debug_sigprint(); - - SpMat_aux::set_real(*this, X); - } - - - -template -template -inline -void -SpMat::set_imag(const SpBase::pod_type,T1>& X) - { - arma_debug_sigprint(); - - SpMat_aux::set_imag(*this, X); - } - - - -//! save the matrix to a file -template -inline -bool -SpMat::save(const std::string name, const file_type type) const - { - arma_debug_sigprint(); - - sync_csc(); - - bool save_okay; - - switch(type) - { - case csv_ascii: - return (*this).save(csv_name(name), type); - break; - - case ssv_ascii: - return (*this).save(csv_name(name), type); - break; - - case arma_binary: - save_okay = diskio::save_arma_binary(*this, name); - break; - - case coord_ascii: - save_okay = diskio::save_coord_ascii(*this, name); - break; - - default: - arma_warn(1, "SpMat::save(): unsupported file type"); - save_okay = false; - } - - if(save_okay == false) { arma_warn(3, "SpMat::save(): write failed; file: ", name); } - - return save_okay; - } - - - -template -inline -bool -SpMat::save(const csv_name& spec, const file_type type) const - { - arma_debug_sigprint(); - - if( (type != csv_ascii) && (type != ssv_ascii) ) - { - arma_stop_runtime_error("SpMat::save(): unsupported file type for csv_name()"); - return false; - } - - const bool do_trans = bool(spec.opts.flags & csv_opts::flag_trans ); - const bool no_header = bool(spec.opts.flags & csv_opts::flag_no_header ); - const bool with_header = bool(spec.opts.flags & csv_opts::flag_with_header) && (no_header == false); - const bool use_semicolon = bool(spec.opts.flags & csv_opts::flag_semicolon ) || (type == ssv_ascii); - - arma_debug_print("SpMat::save(csv_name): enabled flags:"); - - if(do_trans ) { arma_debug_print("trans"); } - if(no_header ) { arma_debug_print("no_header"); } - if(with_header ) { arma_debug_print("with_header"); } - if(use_semicolon) { arma_debug_print("semicolon"); } - - const char separator = (use_semicolon) ? char(';') : char(','); - - if(with_header) - { - if( (spec.header_ro.n_cols != 1) && (spec.header_ro.n_rows != 1) ) - { - arma_warn(1, "SpMat::save(): given header must have a vector layout"); - return false; - } - - for(uword i=0; i < spec.header_ro.n_elem; ++i) - { - const std::string& token = spec.header_ro.at(i); - - if(token.find(separator) != std::string::npos) - { - arma_warn(1, "SpMat::save(): token within the header contains the separator character: '", token, "'"); - return false; - } - } - - const uword save_n_cols = (do_trans) ? (*this).n_rows : (*this).n_cols; - - if(spec.header_ro.n_elem != save_n_cols) - { - arma_warn(1, "SpMat::save(): size mismatch between header and matrix"); - return false; - } - } - - bool save_okay = false; - - if(do_trans) - { - const SpMat tmp = (*this).st(); - - save_okay = diskio::save_csv_ascii(tmp, spec.filename, spec.header_ro, with_header, separator); - } - else - { - save_okay = diskio::save_csv_ascii(*this, spec.filename, spec.header_ro, with_header, separator); - } - - if(save_okay == false) { arma_warn(3, "SpMat::save(): write failed; file: ", spec.filename); } - - return save_okay; - } - - - -//! save the matrix to a stream -template -inline -bool -SpMat::save(std::ostream& os, const file_type type) const - { - arma_debug_sigprint(); - - sync_csc(); - - bool save_okay; - - switch(type) - { - case csv_ascii: - save_okay = diskio::save_csv_ascii(*this, os, char(',')); - break; - - case ssv_ascii: - save_okay = diskio::save_csv_ascii(*this, os, char(';')); - break; - - case arma_binary: - save_okay = diskio::save_arma_binary(*this, os); - break; - - case coord_ascii: - save_okay = diskio::save_coord_ascii(*this, os); - break; - - default: - arma_warn(1, "SpMat::save(): unsupported file type"); - save_okay = false; - } - - if(save_okay == false) { arma_warn(3, "SpMat::save(): stream write failed"); } - - return save_okay; - } - - - -//! load a matrix from a file -template -inline -bool -SpMat::load(const std::string name, const file_type type) - { - arma_debug_sigprint(); - - invalidate_cache(); - - bool load_okay; - std::string err_msg; - - switch(type) - { - // case auto_detect: - // load_okay = diskio::load_auto_detect(*this, name, err_msg); - // break; - - case csv_ascii: - return (*this).load(csv_name(name), type); - break; - - case ssv_ascii: - return (*this).load(csv_name(name), type); - break; - - case arma_binary: - load_okay = diskio::load_arma_binary(*this, name, err_msg); - break; - - case coord_ascii: - load_okay = diskio::load_coord_ascii(*this, name, err_msg); - break; - - default: - arma_warn(1, "SpMat::load(): unsupported file type"); - load_okay = false; - } - - if(load_okay == false) - { - if(err_msg.length() > 0) - { - arma_warn(3, "SpMat::load(): ", err_msg, "; file: ", name); - } - else - { - arma_warn(3, "SpMat::load(): read failed; file: ", name); - } - } - - if(load_okay == false) { (*this).reset(); } - - return load_okay; - } - - - -template -inline -bool -SpMat::load(const csv_name& spec, const file_type type) - { - arma_debug_sigprint(); - - if( (type != csv_ascii) && (type != ssv_ascii) ) - { - arma_stop_runtime_error("SpMat::load(): unsupported file type for csv_name()"); - return false; - } - - const bool do_trans = bool(spec.opts.flags & csv_opts::flag_trans ); - const bool no_header = bool(spec.opts.flags & csv_opts::flag_no_header ); - const bool with_header = bool(spec.opts.flags & csv_opts::flag_with_header) && (no_header == false); - const bool use_semicolon = bool(spec.opts.flags & csv_opts::flag_semicolon ) || (type == ssv_ascii); - const bool strict = bool(spec.opts.flags & csv_opts::flag_strict ); - - arma_debug_print("SpMat::load(csv_name): enabled flags:"); - - if(do_trans ) { arma_debug_print("trans"); } - if(no_header ) { arma_debug_print("no_header"); } - if(with_header ) { arma_debug_print("with_header"); } - if(use_semicolon) { arma_debug_print("semicolon"); } - if(strict ) { arma_debug_print("strict"); } - - if(strict) { arma_warn(1, "SpMat::load(): option 'strict' not implemented for sparse matrices"); } - - const char separator = (use_semicolon) ? char(';') : char(','); - - bool load_okay = false; - std::string err_msg; - - if(do_trans) - { - SpMat tmp_mat; - - load_okay = diskio::load_csv_ascii(tmp_mat, spec.filename, err_msg, spec.header_rw, with_header, separator); - - if(load_okay) - { - (*this) = tmp_mat.st(); - - if(with_header) - { - // field::set_size() preserves data if the number of elements hasn't changed - spec.header_rw.set_size(spec.header_rw.n_elem, 1); - } - } - } - else - { - load_okay = diskio::load_csv_ascii(*this, spec.filename, err_msg, spec.header_rw, with_header, separator); - } - - if(load_okay == false) - { - if(err_msg.length() > 0) - { - arma_warn(3, "SpMat::load(): ", err_msg, "; file: ", spec.filename); - } - else - { - arma_warn(3, "SpMat::load(): read failed; file: ", spec.filename); - } - } - else - { - const uword load_n_cols = (do_trans) ? (*this).n_rows : (*this).n_cols; - - if(with_header && (spec.header_rw.n_elem != load_n_cols)) - { - arma_warn(3, "SpMat::load(): size mismatch between header and matrix"); - } - } - - if(load_okay == false) - { - (*this).reset(); - - if(with_header) { spec.header_rw.reset(); } - } - - return load_okay; - } - - - -//! load a matrix from a stream -template -inline -bool -SpMat::load(std::istream& is, const file_type type) - { - arma_debug_sigprint(); - - invalidate_cache(); - - bool load_okay; - std::string err_msg; - - switch(type) - { - // case auto_detect: - // load_okay = diskio::load_auto_detect(*this, is, err_msg); - // break; - - case csv_ascii: - load_okay = diskio::load_csv_ascii(*this, is, err_msg, char(',')); - break; - - case ssv_ascii: - load_okay = diskio::load_csv_ascii(*this, is, err_msg, char(';')); - break; - - case arma_binary: - load_okay = diskio::load_arma_binary(*this, is, err_msg); - break; - - case coord_ascii: - load_okay = diskio::load_coord_ascii(*this, is, err_msg); - break; - - default: - arma_warn(1, "SpMat::load(): unsupported file type"); - load_okay = false; - } - - if(load_okay == false) - { - if(err_msg.length() > 0) - { - arma_warn(3, "SpMat::load(): ", err_msg); - } - else - { - arma_warn(3, "SpMat::load(): stream read failed"); - } - } - - if(load_okay == false) { (*this).reset(); } - - return load_okay; - } - - - -template -inline -bool -SpMat::quiet_save(const std::string name, const file_type type) const - { - arma_debug_sigprint(); - - return (*this).save(name, type); - } - - - -template -inline -bool -SpMat::quiet_save(std::ostream& os, const file_type type) const - { - arma_debug_sigprint(); - - return (*this).save(os, type); - } - - - -template -inline -bool -SpMat::quiet_load(const std::string name, const file_type type) - { - arma_debug_sigprint(); - - return (*this).load(name, type); - } - - - -template -inline -bool -SpMat::quiet_load(std::istream& is, const file_type type) - { - arma_debug_sigprint(); - - return (*this).load(is, type); - } - - - -/** - * Initialize the matrix to the specified size. Data is not preserved, so the matrix is assumed to be entirely sparse (empty). - */ -template -inline -void -SpMat::init(uword in_rows, uword in_cols, const uword new_n_nonzero) - { - arma_debug_sigprint(); - - invalidate_cache(); // placed here, as init() is used during matrix modification - - // Clean out the existing memory. - if(values ) { memory::release(access::rw(values)); } - if(row_indices) { memory::release(access::rw(row_indices)); } - if(col_ptrs ) { memory::release(access::rw(col_ptrs)); } - - // in case init_cold() throws an exception - access::rw(n_rows) = 0; - access::rw(n_cols) = 0; - access::rw(n_elem) = 0; - access::rw(n_nonzero) = 0; - access::rw(values) = nullptr; - access::rw(row_indices) = nullptr; - access::rw(col_ptrs) = nullptr; - - init_cold(in_rows, in_cols, new_n_nonzero); - } - - - -template -inline -void -SpMat::init_cold(uword in_rows, uword in_cols, const uword new_n_nonzero) - { - arma_debug_sigprint(); - - // Verify that we are allowed to do this. - if(vec_state > 0) - { - if((in_rows == 0) && (in_cols == 0)) - { - if(vec_state == 1) { in_cols = 1; } - if(vec_state == 2) { in_rows = 1; } - } - else - { - if(vec_state == 1) { arma_conform_check( (in_cols != 1), "SpMat::init(): object is a column vector; requested size is not compatible" ); } - if(vec_state == 2) { arma_conform_check( (in_rows != 1), "SpMat::init(): object is a row vector; requested size is not compatible" ); } - } - } - - #if defined(ARMA_64BIT_WORD) - const char* error_message = "SpMat::init(): requested size is too large"; - #else - const char* error_message = "SpMat::init(): requested size is too large; suggest to enable ARMA_64BIT_WORD"; - #endif - - // Ensure that n_elem can hold the result of (n_rows * n_cols) - arma_conform_check - ( - ( - ( (in_rows > ARMA_MAX_UHWORD) || (in_cols > ARMA_MAX_UHWORD) ) - ? ( (double(in_rows) * double(in_cols)) > double(ARMA_MAX_UWORD) ) - : false - ), - error_message - ); - - access::rw(col_ptrs) = memory::acquire(in_cols + 2); - access::rw(values) = memory::acquire (new_n_nonzero + 1); - access::rw(row_indices) = memory::acquire(new_n_nonzero + 1); - - // fill column pointers with 0, - // except for the last element which contains the maximum possible element - // (so iterators terminate correctly). - arrayops::fill_zeros(access::rwp(col_ptrs), in_cols + 1); - - access::rw(col_ptrs[in_cols + 1]) = std::numeric_limits::max(); - - access::rw( values[new_n_nonzero]) = 0; - access::rw(row_indices[new_n_nonzero]) = 0; - - // Set the new size accordingly. - access::rw(n_rows) = in_rows; - access::rw(n_cols) = in_cols; - access::rw(n_elem) = (in_rows * in_cols); - access::rw(n_nonzero) = new_n_nonzero; - } - - - -template -inline -void -SpMat::init(const std::string& text) - { - arma_debug_sigprint(); - - Mat tmp(text); - - if(vec_state == 1) - { - if((tmp.n_elem > 0) && tmp.is_vec()) - { - access::rw(tmp.n_rows) = tmp.n_elem; - access::rw(tmp.n_cols) = 1; - } - } - - if(vec_state == 2) - { - if((tmp.n_elem > 0) && tmp.is_vec()) - { - access::rw(tmp.n_rows) = 1; - access::rw(tmp.n_cols) = tmp.n_elem; - } - } - - (*this).operator=(tmp); - } - - - -template -inline -void -SpMat::init(const SpMat& x) - { - arma_debug_sigprint(); - - if(this == &x) { return; } - - bool init_done = false; - - #if defined(ARMA_USE_OPENMP) - if(x.sync_state == 1) - { - #pragma omp critical (arma_SpMat_init) - if(x.sync_state == 1) - { - (*this).init(x.cache); - init_done = true; - } - } - #elif defined(ARMA_USE_STD_MUTEX) - if(x.sync_state == 1) - { - const std::lock_guard lock(x.cache_mutex); - - if(x.sync_state == 1) - { - (*this).init(x.cache); - init_done = true; - } - } - #else - if(x.sync_state == 1) - { - (*this).init(x.cache); - init_done = true; - } - #endif - - if(init_done == false) - { - (*this).init_simple(x); - } - } - - - -template -inline -void -SpMat::init(const MapMat& x) - { - arma_debug_sigprint(); - - const uword x_n_rows = x.n_rows; - const uword x_n_cols = x.n_cols; - const uword x_n_nz = x.get_n_nonzero(); - - init(x_n_rows, x_n_cols, x_n_nz); - - if(x_n_nz == 0) { return; } - - typename MapMat::map_type& x_map_ref = *(x.map_ptr); - - typename MapMat::map_type::const_iterator x_it = x_map_ref.begin(); - - uword x_col = 0; - uword x_col_index_start = 0; - uword x_col_index_endp1 = x_n_rows; - - for(uword i=0; i < x_n_nz; ++i) - { - const std::pair& x_entry = (*x_it); - - const uword x_index = x_entry.first; - const eT x_val = x_entry.second; - - // have we gone past the curent column? - if(x_index >= x_col_index_endp1) - { - x_col = x_index / x_n_rows; - - x_col_index_start = x_col * x_n_rows; - x_col_index_endp1 = x_col_index_start + x_n_rows; - } - - const uword x_row = x_index - x_col_index_start; - - // // sanity check - // - // const uword tmp_x_row = x_index % x_n_rows; - // const uword tmp_x_col = x_index / x_n_rows; - // - // if(x_row != tmp_x_row) { cout << "x_row != tmp_x_row" << endl; exit(-1); } - // if(x_col != tmp_x_col) { cout << "x_col != tmp_x_col" << endl; exit(-1); } - - access::rw(values[i]) = x_val; - access::rw(row_indices[i]) = x_row; - - access::rw(col_ptrs[ x_col + 1 ])++; - - ++x_it; - } - - - for(uword i = 0; i < x_n_cols; ++i) - { - access::rw(col_ptrs[i + 1]) += col_ptrs[i]; - } - - - // // OLD METHOD - // - // for(uword i=0; i < x_n_nz; ++i) - // { - // const std::pair& x_entry = (*x_it); - // - // const uword x_index = x_entry.first; - // const eT x_val = x_entry.second; - // - // const uword x_row = x_index % x_n_rows; - // const uword x_col = x_index / x_n_rows; - // - // access::rw(values[i]) = x_val; - // access::rw(row_indices[i]) = x_row; - // - // access::rw(col_ptrs[ x_col + 1 ])++; - // - // ++x_it; - // } - // - // - // for(uword i = 0; i < x_n_cols; ++i) - // { - // access::rw(col_ptrs[i + 1]) += col_ptrs[i]; - // } - } - - - -template -inline -void -SpMat::init_simple(const SpMat& x) - { - arma_debug_sigprint(); - - if(this == &x) { return; } - - if((x.n_nonzero == 0) && (n_nonzero == 0) && (n_rows == x.n_rows) && (n_cols == x.n_cols) && (values != nullptr)) - { - invalidate_cache(); - } - else - { - init(x.n_rows, x.n_cols, x.n_nonzero); - } - - if(x.n_nonzero != 0) - { - if(x.values ) { arrayops::copy(access::rwp(values), x.values, x.n_nonzero + 1); } - if(x.row_indices) { arrayops::copy(access::rwp(row_indices), x.row_indices, x.n_nonzero + 1); } - if(x.col_ptrs ) { arrayops::copy(access::rwp(col_ptrs), x.col_ptrs, x.n_cols + 1); } - } - } - - - -template -inline -void -SpMat::init_batch_std(const Mat& locs, const Mat& vals, const bool sort_locations) - { - arma_debug_sigprint(); - - // Resize to correct number of elements. - mem_resize(vals.n_elem); - - // Reset column pointers to zero. - arrayops::fill_zeros(access::rwp(col_ptrs), n_cols + 1); - - bool actually_sorted = true; - - if(sort_locations) - { - // check if we really need a time consuming sort - - const uword locs_n_cols = locs.n_cols; - - for(uword i = 1; i < locs_n_cols; ++i) - { - const uword* locs_i = locs.colptr(i ); - const uword* locs_im1 = locs.colptr(i-1); - - const uword row_i = locs_i[0]; - const uword col_i = locs_i[1]; - - const uword row_im1 = locs_im1[0]; - const uword col_im1 = locs_im1[1]; - - if( (col_i < col_im1) || ((col_i == col_im1) && (row_i <= row_im1)) ) - { - actually_sorted = false; - break; - } - } - - if(actually_sorted == false) - { - // see op_sort_index_bones.hpp for the definition of arma_sort_index_packet and arma_sort_index_helper_ascend - - std::vector< arma_sort_index_packet > packet_vec(locs_n_cols); - - const uword* locs_mem = locs.memptr(); - - for(uword i = 0; i < locs_n_cols; ++i) - { - const uword row = (*locs_mem); locs_mem++; - const uword col = (*locs_mem); locs_mem++; - - packet_vec[i].val = (col * n_rows) + row; - packet_vec[i].index = i; - } - - arma_sort_index_helper_ascend comparator; - - std::sort( packet_vec.begin(), packet_vec.end(), comparator ); - - // insert the elements in the sorted order - for(uword i = 0; i < locs_n_cols; ++i) - { - const uword index = packet_vec[i].index; - - const uword* locs_i = locs.colptr(index); - - const uword row_i = locs_i[0]; - const uword col_i = locs_i[1]; - - arma_conform_check( ( (row_i >= n_rows) || (col_i >= n_cols) ), "SpMat::SpMat(): invalid row or column index" ); - - if(i > 0) - { - const uword prev_index = packet_vec[i-1].index; - - const uword* locs_im1 = locs.colptr(prev_index); - - const uword row_im1 = locs_im1[0]; - const uword col_im1 = locs_im1[1]; - - arma_conform_check( ( (row_i == row_im1) && (col_i == col_im1) ), "SpMat::SpMat(): detected identical locations" ); - } - - access::rw(values[i]) = vals[index]; - access::rw(row_indices[i]) = row_i; - - access::rw(col_ptrs[ col_i + 1 ])++; - } - } - } - - if( (sort_locations == false) || (actually_sorted == true) ) - { - // Now set the values and row indices correctly. - // Increment the column pointers in each column (so they are column "counts"). - - const uword locs_n_cols = locs.n_cols; - - for(uword i=0; i < locs_n_cols; ++i) - { - const uword* locs_i = locs.colptr(i); - - const uword row_i = locs_i[0]; - const uword col_i = locs_i[1]; - - arma_conform_check( ( (row_i >= n_rows) || (col_i >= n_cols) ), "SpMat::SpMat(): invalid row or column index" ); - - if(i > 0) - { - const uword* locs_im1 = locs.colptr(i-1); - - const uword row_im1 = locs_im1[0]; - const uword col_im1 = locs_im1[1]; - - arma_conform_check - ( - ( (col_i < col_im1) || ((col_i == col_im1) && (row_i < row_im1)) ), - "SpMat::SpMat(): out of order points; either pass sort_locations = true, or sort points in column-major ordering" - ); - - arma_conform_check( ( (col_i == col_im1) && (row_i == row_im1) ), "SpMat::SpMat(): detected identical locations" ); - } - - access::rw(values[i]) = vals[i]; - access::rw(row_indices[i]) = row_i; - - access::rw(col_ptrs[ col_i + 1 ])++; - } - } - - // Now fix the column pointers. - for(uword i = 0; i < n_cols; ++i) - { - access::rw(col_ptrs[i + 1]) += col_ptrs[i]; - } - } - - - -template -inline -void -SpMat::init_batch_add(const Mat& locs, const Mat& vals, const bool sort_locations) - { - arma_debug_sigprint(); - - if(locs.n_cols < 2) - { - init_batch_std(locs, vals, false); - return; - } - - // Reset column pointers to zero. - arrayops::fill_zeros(access::rwp(col_ptrs), n_cols + 1); - - bool actually_sorted = true; - - if(sort_locations) - { - // sort_index() uses std::sort() which may use quicksort... so we better - // make sure it's not already sorted before taking an O(N^2) sort penalty. - for(uword i = 1; i < locs.n_cols; ++i) - { - const uword* locs_i = locs.colptr(i ); - const uword* locs_im1 = locs.colptr(i-1); - - if( (locs_i[1] < locs_im1[1]) || (locs_i[1] == locs_im1[1] && locs_i[0] <= locs_im1[0]) ) - { - actually_sorted = false; - break; - } - } - - if(actually_sorted == false) - { - // This may not be the fastest possible implementation but it maximizes code reuse. - Col abslocs(locs.n_cols, arma_nozeros_indicator()); - - for(uword i = 0; i < locs.n_cols; ++i) - { - const uword* locs_i = locs.colptr(i); - - abslocs[i] = locs_i[1] * n_rows + locs_i[0]; - } - - uvec sorted_indices = sort_index(abslocs); // Ascending sort. - - // work out the number of unique elments - uword n_unique = 1; // first element is unique - - for(uword i=1; i < sorted_indices.n_elem; ++i) - { - const uword* locs_i = locs.colptr( sorted_indices[i ] ); - const uword* locs_im1 = locs.colptr( sorted_indices[i-1] ); - - if( (locs_i[1] != locs_im1[1]) || (locs_i[0] != locs_im1[0]) ) { ++n_unique; } - } - - // resize to correct number of elements - mem_resize(n_unique); - - // Now we add the elements in this sorted order. - uword count = 0; - - // first element - { - const uword i = 0; - const uword* locs_i = locs.colptr( sorted_indices[i] ); - - arma_conform_check( ( (locs_i[0] >= n_rows) || (locs_i[1] >= n_cols) ), "SpMat::SpMat(): invalid row or column index" ); - - access::rw(values[count]) = vals[ sorted_indices[i] ]; - access::rw(row_indices[count]) = locs_i[0]; - - access::rw(col_ptrs[ locs_i[1] + 1 ])++; - } - - for(uword i=1; i < sorted_indices.n_elem; ++i) - { - const uword* locs_i = locs.colptr( sorted_indices[i ] ); - const uword* locs_im1 = locs.colptr( sorted_indices[i-1] ); - - arma_conform_check( ( (locs_i[0] >= n_rows) || (locs_i[1] >= n_cols) ), "SpMat::SpMat(): invalid row or column index" ); - - if( (locs_i[1] == locs_im1[1]) && (locs_i[0] == locs_im1[0]) ) - { - access::rw(values[count]) += vals[ sorted_indices[i] ]; - } - else - { - count++; - access::rw(values[count]) = vals[ sorted_indices[i] ]; - access::rw(row_indices[count]) = locs_i[0]; - - access::rw(col_ptrs[ locs_i[1] + 1 ])++; - } - } - } - } - - if( (sort_locations == false) || (actually_sorted == true) ) - { - // work out the number of unique elments - uword n_unique = 1; // first element is unique - - for(uword i=1; i < locs.n_cols; ++i) - { - const uword* locs_i = locs.colptr(i ); - const uword* locs_im1 = locs.colptr(i-1); - - if( (locs_i[1] != locs_im1[1]) || (locs_i[0] != locs_im1[0]) ) { ++n_unique; } - } - - // resize to correct number of elements - mem_resize(n_unique); - - // Now set the values and row indices correctly. - // Increment the column pointers in each column (so they are column "counts"). - - uword count = 0; - - // first element - { - const uword i = 0; - const uword* locs_i = locs.colptr(i); - - arma_conform_check( ( (locs_i[0] >= n_rows) || (locs_i[1] >= n_cols) ), "SpMat::SpMat(): invalid row or column index" ); - - access::rw(values[count]) = vals[i]; - access::rw(row_indices[count]) = locs_i[0]; - - access::rw(col_ptrs[ locs_i[1] + 1 ])++; - } - - for(uword i=1; i < locs.n_cols; ++i) - { - const uword* locs_i = locs.colptr(i ); - const uword* locs_im1 = locs.colptr(i-1); - - arma_conform_check( ( (locs_i[0] >= n_rows) || (locs_i[1] >= n_cols) ), "SpMat::SpMat(): invalid row or column index" ); - - arma_conform_check - ( - ( (locs_i[1] < locs_im1[1]) || (locs_i[1] == locs_im1[1] && locs_i[0] < locs_im1[0]) ), - "SpMat::SpMat(): out of order points; either pass sort_locations = true, or sort points in column-major ordering" - ); - - if( (locs_i[1] == locs_im1[1]) && (locs_i[0] == locs_im1[0]) ) - { - access::rw(values[count]) += vals[i]; - } - else - { - count++; - - access::rw(values[count]) = vals[i]; - access::rw(row_indices[count]) = locs_i[0]; - - access::rw(col_ptrs[ locs_i[1] + 1 ])++; - } - } - } - - // Now fix the column pointers. - for(uword i = 0; i < n_cols; ++i) - { - access::rw(col_ptrs[i + 1]) += col_ptrs[i]; - } - } - - - -//! constructor used by SpRow and SpCol classes -template -inline -SpMat::SpMat(const arma_vec_indicator&, const uword in_vec_state) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(in_vec_state) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - const uword in_n_rows = (in_vec_state == 2) ? 1 : 0; - const uword in_n_cols = (in_vec_state == 1) ? 1 : 0; - - init_cold(in_n_rows, in_n_cols); - } - - - -//! constructor used by SpRow and SpCol classes -template -inline -SpMat::SpMat(const arma_vec_indicator&, const uword in_n_rows, const uword in_n_cols, const uword in_vec_state) - : n_rows(0) - , n_cols(0) - , n_elem(0) - , n_nonzero(0) - , vec_state(in_vec_state) - , values(nullptr) - , row_indices(nullptr) - , col_ptrs(nullptr) - { - arma_debug_sigprint_this(this); - - init_cold(in_n_rows, in_n_cols); - } - - - -template -inline -void -SpMat::mem_resize(const uword new_n_nonzero) - { - arma_debug_sigprint(); - - invalidate_cache(); // placed here, as mem_resize() is used during matrix modification - - if(n_nonzero == new_n_nonzero) { return; } - - eT* new_values = memory::acquire (new_n_nonzero + 1); - uword* new_row_indices = memory::acquire(new_n_nonzero + 1); - - if( (n_nonzero > 0 ) && (new_n_nonzero > 0) ) - { - // Copy old elements. - uword copy_len = (std::min)(n_nonzero, new_n_nonzero); - - arrayops::copy(new_values, values, copy_len); - arrayops::copy(new_row_indices, row_indices, copy_len); - } - - if(values) { memory::release(access::rw(values)); } - if(row_indices) { memory::release(access::rw(row_indices)); } - - access::rw(values) = new_values; - access::rw(row_indices) = new_row_indices; - - // Set the "fake end" of the matrix by setting the last value and row index to 0. - // This helps the iterators work correctly. - access::rw( values[new_n_nonzero]) = 0; - access::rw(row_indices[new_n_nonzero]) = 0; - - access::rw(n_nonzero) = new_n_nonzero; - } - - - -template -inline -void -SpMat::sync() const - { - arma_debug_sigprint(); - - sync_csc(); - } - - - -template -inline -void -SpMat::remove_zeros() - { - arma_debug_sigprint(); - - sync_csc(); - - invalidate_cache(); // placed here, as remove_zeros() is used during matrix modification - - const uword old_n_nonzero = n_nonzero; - uword new_n_nonzero = 0; - - const eT* old_values = values; - - constexpr eT zero = eT(0); - - for(uword i=0; i < old_n_nonzero; ++i) - { - new_n_nonzero += (old_values[i] != zero) ? uword(1) : uword(0); - } - - if(new_n_nonzero != old_n_nonzero) - { - if(new_n_nonzero == 0) { init(n_rows, n_cols); return; } - - SpMat tmp(arma_reserve_indicator(), n_rows, n_cols, new_n_nonzero); - - uword new_index = 0; - - const_iterator it = cbegin(); - const_iterator it_end = cend(); - - for(; it != it_end; ++it) - { - const eT val = eT(*it); - - if(val != zero) - { - const uword it_row = it.row(); - const uword it_col = it.col(); - - access::rw(tmp.values[new_index]) = val; - access::rw(tmp.row_indices[new_index]) = it_row; - access::rw(tmp.col_ptrs[it_col + 1])++; - ++new_index; - } - } - - for(uword i=0; i < n_cols; ++i) - { - access::rw(tmp.col_ptrs[i + 1]) += tmp.col_ptrs[i]; - } - - steal_mem(tmp); - } - } - - - -// Steal memory from another matrix. -template -inline -void -SpMat::steal_mem(SpMat& x) - { - arma_debug_sigprint(); - - if(this == &x) { return; } - - bool layout_ok = false; - - if((*this).vec_state == x.vec_state) - { - layout_ok = true; - } - else - { - if( ((*this).vec_state == 1) && (x.n_cols == 1) ) { layout_ok = true; } - if( ((*this).vec_state == 2) && (x.n_rows == 1) ) { layout_ok = true; } - } - - if(layout_ok) - { - arma_debug_print("SpMat::steal_mem(): stealing memory"); - - x.sync_csc(); - - steal_mem_simple(x); - - x.invalidate_cache(); - - invalidate_cache(); - } - else - { - arma_debug_print("SpMat::steal_mem(): copying memory"); - - (*this).operator=(x); - } - } - - - -template -inline -void -SpMat::steal_mem_simple(SpMat& x) - { - arma_debug_sigprint(); - - if(this == &x) { return; } - - if(values ) { memory::release(access::rw(values)); } - if(row_indices) { memory::release(access::rw(row_indices)); } - if(col_ptrs ) { memory::release(access::rw(col_ptrs)); } - - access::rw(n_rows) = x.n_rows; - access::rw(n_cols) = x.n_cols; - access::rw(n_elem) = x.n_elem; - access::rw(n_nonzero) = x.n_nonzero; - - access::rw(values) = x.values; - access::rw(row_indices) = x.row_indices; - access::rw(col_ptrs) = x.col_ptrs; - - // Set other matrix to empty. - access::rw(x.n_rows) = 0; - access::rw(x.n_cols) = 0; - access::rw(x.n_elem) = 0; - access::rw(x.n_nonzero) = 0; - - access::rw(x.values) = nullptr; - access::rw(x.row_indices) = nullptr; - access::rw(x.col_ptrs) = nullptr; - } - - - -template -template -inline -void -SpMat::init_xform(const SpBase& A, const Functor& func) - { - arma_debug_sigprint(); - - // if possible, avoid doing a copy and instead apply func to the generated elements - if(SpProxy::Q_is_generated) - { - (*this) = A.get_ref(); - - const uword nnz = n_nonzero; - - eT* t_values = access::rwp(values); - - bool has_zero = false; - - for(uword i=0; i < nnz; ++i) - { - eT& t_values_i = t_values[i]; - - t_values_i = func(t_values_i); - - if(t_values_i == eT(0)) { has_zero = true; } - } - - if(has_zero) { remove_zeros(); } - } - else - { - init_xform_mt(A.get_ref(), func); - } - } - - - -template -template -inline -void -SpMat::init_xform_mt(const SpBase& A, const Functor& func) - { - arma_debug_sigprint(); - - const SpProxy P(A.get_ref()); - - if( P.is_alias(*this) || (is_SpMat::stored_type>::value) ) - { - // NOTE: unwrap_spmat will convert a submatrix to a matrix, which in effect takes care of aliasing with submatrices; - // NOTE: however, when more delayed ops are implemented, more elaborate handling of aliasing will be necessary - const unwrap_spmat::stored_type> tmp(P.Q); - - const SpMat& x = tmp.M; - - if(void_ptr(this) != void_ptr(&x)) - { - init(x.n_rows, x.n_cols, x.n_nonzero); - - arrayops::copy(access::rwp(row_indices), x.row_indices, x.n_nonzero + 1); - arrayops::copy(access::rwp(col_ptrs), x.col_ptrs, x.n_cols + 1); - } - - - // initialise the elements array with a transformed version of the elements from x - - const uword nnz = n_nonzero; - - const eT2* x_values = x.values; - eT* t_values = access::rwp(values); - - bool has_zero = false; - - for(uword i=0; i < nnz; ++i) - { - eT& t_values_i = t_values[i]; - - t_values_i = func(x_values[i]); // NOTE: func() must produce a value of type eT (ie. act as a convertor between eT2 and eT) - - if(t_values_i == eT(0)) { has_zero = true; } - } - - if(has_zero) { remove_zeros(); } - } - else - { - init(P.get_n_rows(), P.get_n_cols(), P.get_n_nonzero()); - - typename SpProxy::const_iterator_type it = P.begin(); - typename SpProxy::const_iterator_type it_end = P.end(); - - bool has_zero = false; - - while(it != it_end) - { - const eT val = func(*it); // NOTE: func() must produce a value of type eT (ie. act as a convertor between eT2 and eT) - - if(val == eT(0)) { has_zero = true; } - - const uword it_pos = it.pos(); - - access::rw(row_indices[it_pos]) = it.row(); - access::rw(values[it_pos]) = val; - ++access::rw(col_ptrs[it.col() + 1]); - ++it; - } - - // Now sum column pointers. - for(uword c = 1; c <= n_cols; ++c) - { - access::rw(col_ptrs[c]) += col_ptrs[c - 1]; - } - - if(has_zero) { remove_zeros(); } - } - } - - - -template -arma_inline -bool -SpMat::is_alias(const SpMat& X) const - { - return (&X == this); - } - - - -template -inline -typename SpMat::iterator -SpMat::begin() - { - arma_debug_sigprint(); - - sync_csc(); - - return iterator(*this); - } - - - -template -inline -typename SpMat::const_iterator -SpMat::begin() const - { - arma_debug_sigprint(); - - sync_csc(); - - return const_iterator(*this); - } - - - -template -inline -typename SpMat::const_iterator -SpMat::cbegin() const - { - arma_debug_sigprint(); - - sync_csc(); - - return const_iterator(*this); - } - - - -template -inline -typename SpMat::iterator -SpMat::end() - { - sync_csc(); - - return iterator(*this, 0, n_cols, n_nonzero); - } - - - -template -inline -typename SpMat::const_iterator -SpMat::end() const - { - sync_csc(); - - return const_iterator(*this, 0, n_cols, n_nonzero); - } - - - -template -inline -typename SpMat::const_iterator -SpMat::cend() const - { - sync_csc(); - - return const_iterator(*this, 0, n_cols, n_nonzero); - } - - - -template -inline -typename SpMat::col_iterator -SpMat::begin_col(const uword col_num) - { - sync_csc(); - - return col_iterator(*this, 0, col_num); - } - - - -template -inline -typename SpMat::const_col_iterator -SpMat::begin_col(const uword col_num) const - { - sync_csc(); - - return const_col_iterator(*this, 0, col_num); - } - - - -template -inline -typename SpMat::col_iterator -SpMat::begin_col_no_sync(const uword col_num) - { - return col_iterator(*this, 0, col_num); - } - - - -template -inline -typename SpMat::const_col_iterator -SpMat::begin_col_no_sync(const uword col_num) const - { - return const_col_iterator(*this, 0, col_num); - } - - - -template -inline -typename SpMat::col_iterator -SpMat::end_col(const uword col_num) - { - sync_csc(); - - return col_iterator(*this, 0, col_num + 1); - } - - - -template -inline -typename SpMat::const_col_iterator -SpMat::end_col(const uword col_num) const - { - sync_csc(); - - return const_col_iterator(*this, 0, col_num + 1); - } - - - -template -inline -typename SpMat::col_iterator -SpMat::end_col_no_sync(const uword col_num) - { - return col_iterator(*this, 0, col_num + 1); - } - - - -template -inline -typename SpMat::const_col_iterator -SpMat::end_col_no_sync(const uword col_num) const - { - return const_col_iterator(*this, 0, col_num + 1); - } - - - -template -inline -typename SpMat::row_iterator -SpMat::begin_row(const uword row_num) - { - sync_csc(); - - return row_iterator(*this, row_num, 0); - } - - - -template -inline -typename SpMat::const_row_iterator -SpMat::begin_row(const uword row_num) const - { - sync_csc(); - - return const_row_iterator(*this, row_num, 0); - } - - - -template -inline -typename SpMat::row_iterator -SpMat::end_row() - { - sync_csc(); - - return row_iterator(*this, n_nonzero); - } - - - -template -inline -typename SpMat::const_row_iterator -SpMat::end_row() const - { - sync_csc(); - - return const_row_iterator(*this, n_nonzero); - } - - - -template -inline -typename SpMat::row_iterator -SpMat::end_row(const uword row_num) - { - sync_csc(); - - return row_iterator(*this, row_num + 1, 0); - } - - - -template -inline -typename SpMat::const_row_iterator -SpMat::end_row(const uword row_num) const - { - sync_csc(); - - return const_row_iterator(*this, row_num + 1, 0); - } - - - -template -inline -typename SpMat::row_col_iterator -SpMat::begin_row_col() - { - sync_csc(); - - return begin(); - } - - - -template -inline -typename SpMat::const_row_col_iterator -SpMat::begin_row_col() const - { - sync_csc(); - - return begin(); - } - - - -template -inline typename SpMat::row_col_iterator -SpMat::end_row_col() - { - sync_csc(); - - return end(); - } - - - -template -inline -typename SpMat::const_row_col_iterator -SpMat::end_row_col() const - { - sync_csc(); - - return end(); - } - - - -template -inline -void -SpMat::clear() - { - (*this).reset(); - } - - - -template -inline -bool -SpMat::empty() const - { - return (n_elem == 0); - } - - - -template -inline -uword -SpMat::size() const - { - return n_elem; - } - - - -template -arma_inline -SpMat_MapMat_val -SpMat::front() - { - arma_conform_check( (n_elem == 0), "SpMat::front(): matrix is empty" ); - - return SpMat_MapMat_val((*this), cache, 0, 0); - } - - - -template -arma_inline -eT -SpMat::front() const - { - arma_conform_check( (n_elem == 0), "SpMat::front(): matrix is empty" ); - - return get_value(0,0); - } - - - -template -arma_inline -SpMat_MapMat_val -SpMat::back() - { - arma_conform_check( (n_elem == 0), "SpMat::back(): matrix is empty" ); - - return SpMat_MapMat_val((*this), cache, n_rows-1, n_cols-1); - } - - - -template -arma_inline -eT -SpMat::back() const - { - arma_conform_check( (n_elem == 0), "SpMat::back(): matrix is empty" ); - - return get_value(n_rows-1, n_cols-1); - } - - - -template -inline -eT -SpMat::get_value(const uword i) const - { - const MapMat& const_cache = cache; // declare as const for clarity of intent - - // get the element from the cache if it has more recent data than CSC - - return (sync_state == 1) ? const_cache.operator[](i) : get_value_csc(i); - } - - - -template -inline -eT -SpMat::get_value(const uword in_row, const uword in_col) const - { - const MapMat& const_cache = cache; // declare as const for clarity of intent - - // get the element from the cache if it has more recent data than CSC - - return (sync_state == 1) ? const_cache.at(in_row, in_col) : get_value_csc(in_row, in_col); - } - - - -template -inline -eT -SpMat::get_value_csc(const uword i) const - { - // First convert to the actual location. - uword lcol = i / n_rows; // Integer division. - uword lrow = i % n_rows; - - return get_value_csc(lrow, lcol); - } - - - -template -inline -const eT* -SpMat::find_value_csc(const uword in_row, const uword in_col) const - { - const uword col_offset = col_ptrs[in_col ]; - const uword next_col_offset = col_ptrs[in_col + 1]; - - const uword* start_ptr = &row_indices[ col_offset]; - const uword* end_ptr = &row_indices[next_col_offset]; - - const uword* pos_ptr = std::lower_bound(start_ptr, end_ptr, in_row); // binary search - - if( (pos_ptr != end_ptr) && ((*pos_ptr) == in_row) ) - { - const uword offset = uword(pos_ptr - start_ptr); - const uword index = offset + col_offset; - - return &(values[index]); - } - - return nullptr; - } - - - -template -inline -eT -SpMat::get_value_csc(const uword in_row, const uword in_col) const - { - const eT* val_ptr = find_value_csc(in_row, in_col); - - return (val_ptr != nullptr) ? eT(*val_ptr) : eT(0); - } - - - -template -inline -bool -SpMat::try_set_value_csc(const uword in_row, const uword in_col, const eT in_val) - { - const eT* val_ptr = find_value_csc(in_row, in_col); - - // element not found, ie. it's zero; fail if trying to set it to non-zero value - if(val_ptr == nullptr) { return (in_val == eT(0)); } - - // fail if trying to erase an existing element - if(in_val == eT(0)) { return false; } - - access::rw(*val_ptr) = in_val; - - invalidate_cache(); - - return true; - } - - - -template -inline -bool -SpMat::try_add_value_csc(const uword in_row, const uword in_col, const eT in_val) - { - const eT* val_ptr = find_value_csc(in_row, in_col); - - // element not found, ie. it's zero; fail if trying to add a non-zero value - if(val_ptr == nullptr) { return (in_val == eT(0)); } - - const eT new_val = eT(*val_ptr) + in_val; - - // fail if trying to erase an existing element - if(new_val == eT(0)) { return false; } - - access::rw(*val_ptr) = new_val; - - invalidate_cache(); - - return true; - } - - - -template -inline -bool -SpMat::try_sub_value_csc(const uword in_row, const uword in_col, const eT in_val) - { - const eT* val_ptr = find_value_csc(in_row, in_col); - - // element not found, ie. it's zero; fail if trying to subtract a non-zero value - if(val_ptr == nullptr) { return (in_val == eT(0)); } - - const eT new_val = eT(*val_ptr) - in_val; - - // fail if trying to erase an existing element - if(new_val == eT(0)) { return false; } - - access::rw(*val_ptr) = new_val; - - invalidate_cache(); - - return true; - } - - - -template -inline -bool -SpMat::try_mul_value_csc(const uword in_row, const uword in_col, const eT in_val) - { - const eT* val_ptr = find_value_csc(in_row, in_col); - - // element not found, ie. it's zero; succeed if given value is finite; zero multiplied by anything is zero, except for nan and inf - if(val_ptr == nullptr) { return arma_isfinite(in_val); } - - const eT new_val = eT(*val_ptr) * in_val; - - // fail if trying to erase an existing element - if(new_val == eT(0)) { return false; } - - access::rw(*val_ptr) = new_val; - - invalidate_cache(); - - return true; - } - - - -template -inline -bool -SpMat::try_div_value_csc(const uword in_row, const uword in_col, const eT in_val) - { - const eT* val_ptr = find_value_csc(in_row, in_col); - - // element not found, ie. it's zero; succeed if given value is not zero and not nan; zero divided by anything is zero, except for zero and nan - if(val_ptr == nullptr) { return ((in_val != eT(0)) && (arma_isnan(in_val) == false)); } - - const eT new_val = eT(*val_ptr) / in_val; - - // fail if trying to erase an existing element - if(new_val == eT(0)) { return false; } - - access::rw(*val_ptr) = new_val; - - invalidate_cache(); - - return true; - } - - - -/** - * Insert an element at the given position, and return a reference to it. - * The element will be set to 0, unless otherwise specified. - * If the element already exists, its value will be overwritten. - */ -template -inline -eT& -SpMat::insert_element(const uword in_row, const uword in_col, const eT val) - { - arma_debug_sigprint(); - - sync_csc(); - invalidate_cache(); - - // We will assume the new element does not exist and begin the search for - // where to insert it. If we find that it already exists, we will then - // overwrite it. - uword colptr = col_ptrs[in_col ]; - uword next_colptr = col_ptrs[in_col + 1]; - - uword pos = colptr; // The position in the matrix of this value. - - if(colptr != next_colptr) - { - // There are other elements in this column, so we must find where this - // element will fit as compared to those. - while(pos < next_colptr && in_row > row_indices[pos]) - { - pos++; - } - - // We aren't inserting into the last position, so it is still possible - // that the element may exist. - if(pos != next_colptr && row_indices[pos] == in_row) - { - // It already exists. Then, just overwrite it. - access::rw(values[pos]) = val; - - return access::rw(values[pos]); - } - } - - - // - // Element doesn't exist, so we have to insert it - // - - // We have to update the rest of the column pointers. - for(uword i = in_col + 1; i < n_cols + 1; i++) - { - access::rw(col_ptrs[i])++; // We are only inserting one new element. - } - - const uword old_n_nonzero = n_nonzero; - - access::rw(n_nonzero)++; // Add to count of nonzero elements. - - // Allocate larger memory. - eT* new_values = memory::acquire (n_nonzero + 1); - uword* new_row_indices = memory::acquire(n_nonzero + 1); - - // Copy things over, before the new element. - if(pos > 0) - { - arrayops::copy(new_values, values, pos); - arrayops::copy(new_row_indices, row_indices, pos); - } - - // Insert the new element. - new_values[pos] = val; - new_row_indices[pos] = in_row; - - // Copy the rest of things over (including the extra element at the end). - arrayops::copy(new_values + pos + 1, values + pos, (old_n_nonzero - pos) + 1); - arrayops::copy(new_row_indices + pos + 1, row_indices + pos, (old_n_nonzero - pos) + 1); - - // Assign new pointers. - if(values) { memory::release(access::rw(values)); } - if(row_indices) { memory::release(access::rw(row_indices)); } - - access::rw(values) = new_values; - access::rw(row_indices) = new_row_indices; - - return access::rw(values[pos]); - } - - - -/** - * Delete an element at the given position. - */ -template -inline -void -SpMat::delete_element(const uword in_row, const uword in_col) - { - arma_debug_sigprint(); - - sync_csc(); - invalidate_cache(); - - // We assume the element exists (although... it may not) and look for its - // exact position. If it doesn't exist... well, we don't need to do anything. - uword colptr = col_ptrs[in_col]; - uword next_colptr = col_ptrs[in_col + 1]; - - if(colptr != next_colptr) - { - // There's at least one element in this column. - // Let's see if we are one of them. - for(uword pos = colptr; pos < next_colptr; pos++) - { - if(in_row == row_indices[pos]) - { - --access::rw(n_nonzero); // Remove one from the count of nonzero elements. - - // Found it. Now remove it. - - // Make new arrays. - eT* new_values = memory::acquire (n_nonzero + 1); - uword* new_row_indices = memory::acquire(n_nonzero + 1); - - if(pos > 0) - { - arrayops::copy(new_values, values, pos); - arrayops::copy(new_row_indices, row_indices, pos); - } - - arrayops::copy(new_values + pos, values + pos + 1, (n_nonzero - pos) + 1); - arrayops::copy(new_row_indices + pos, row_indices + pos + 1, (n_nonzero - pos) + 1); - - if(values) { memory::release(access::rw(values)); } - if(row_indices) { memory::release(access::rw(row_indices)); } - - access::rw(values) = new_values; - access::rw(row_indices) = new_row_indices; - - // And lastly, update all the column pointers (decrement by one). - for(uword i = in_col + 1; i < n_cols + 1; i++) - { - --access::rw(col_ptrs[i]); // We only removed one element. - } - - return; // There is nothing left to do. - } - } - } - - return; // The element does not exist, so there's nothing for us to do. - } - - - -template -arma_inline -void -SpMat::invalidate_cache() const - { - arma_debug_sigprint(); - - if(sync_state == 0) { return; } - - cache.reset(); - - sync_state = 0; - } - - - -template -arma_inline -void -SpMat::invalidate_csc() const - { - arma_debug_sigprint(); - - sync_state = 1; - } - - - -template -inline -void -SpMat::sync_cache() const - { - arma_debug_sigprint(); - - // using approach adapted from http://preshing.com/20130930/double-checked-locking-is-fixed-in-cpp11/ - // - // OpenMP mode: - // sync_state uses atomic read/write, which has an implied flush; - // flush is also implicitly executed at the entrance and the exit of critical section; - // data races are prevented by the 'critical' directive - // - // C++11 mode: - // underlying type for sync_state is std::atomic; - // reading and writing to sync_state uses std::memory_order_seq_cst which has an implied fence; - // data races are prevented via the mutex - - #if defined(ARMA_USE_OPENMP) - { - if(sync_state == 0) - { - #pragma omp critical (arma_SpMat_cache) - { - sync_cache_simple(); - } - } - } - #elif defined(ARMA_USE_STD_MUTEX) - { - if(sync_state == 0) - { - const std::lock_guard lock(cache_mutex); - - sync_cache_simple(); - } - } - #else - { - sync_cache_simple(); - } - #endif - } - - - - -template -inline -void -SpMat::sync_cache_simple() const - { - arma_debug_sigprint(); - - if(sync_state == 0) - { - cache = (*this); - sync_state = 2; - } - } - - - - -template -inline -void -SpMat::sync_csc() const - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_OPENMP) - if(sync_state == 1) - { - #pragma omp critical (arma_SpMat_cache) - { - sync_csc_simple(); - } - } - #elif defined(ARMA_USE_STD_MUTEX) - if(sync_state == 1) - { - const std::lock_guard lock(cache_mutex); - - sync_csc_simple(); - } - #else - { - sync_csc_simple(); - } - #endif - } - - - -template -inline -void -SpMat::sync_csc_simple() const - { - arma_debug_sigprint(); - - // method: - // 1. construct temporary matrix to prevent the cache from getting zapped - // 2. steal memory from the temporary matrix - - // sync_state is only set to 1 by non-const element access operators, - // so the shenanigans with const_cast are to satisfy the compiler - - // see also the note in sync_cache() above - - if(sync_state == 1) - { - SpMat& x = const_cast< SpMat& >(*this); - - SpMat tmp(cache); - - x.steal_mem_simple(tmp); - - sync_state = 2; - } - } - - - - -// -// SpMat_aux - - - -template -inline -void -SpMat_aux::set_real(SpMat& out, const SpBase& X) - { - arma_debug_sigprint(); - - const unwrap_spmat tmp(X.get_ref()); - const SpMat& A = tmp.M; - - arma_conform_assert_same_size( out, A, "SpMat::set_real()" ); - - out = A; - } - - - -template -inline -void -SpMat_aux::set_imag(SpMat&, const SpBase&) - { - arma_debug_sigprint(); - } - - - -template -inline -void -SpMat_aux::set_real(SpMat< std::complex >& out, const SpBase& X) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const unwrap_spmat U(X.get_ref()); - const SpMat& Y = U.M; - - arma_conform_assert_same_size(out, Y, "SpMat::set_real()"); - - SpMat tmp(Y,arma::imag(out)); // arma:: prefix required due to bugs in GCC 4.4 - 4.6 - - out.steal_mem(tmp); - } - - - -template -inline -void -SpMat_aux::set_imag(SpMat< std::complex >& out, const SpBase& X) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const unwrap_spmat U(X.get_ref()); - const SpMat& Y = U.M; - - arma_conform_assert_same_size(out, Y, "SpMat::set_imag()"); - - SpMat tmp(arma::real(out),Y); // arma:: prefix required due to bugs in GCC 4.4 - 4.6 - - out.steal_mem(tmp); - } - - - -#if defined(ARMA_EXTRA_SPMAT_MEAT) - #include ARMA_INCFILE_WRAP(ARMA_EXTRA_SPMAT_MEAT) -#endif - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpOp_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpOp_bones.hpp deleted file mode 100644 index af8a229ba..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpOp_bones.hpp +++ /dev/null @@ -1,51 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpOp -//! @{ - - - -template -class SpOp : public SpBase< typename T1::elem_type, SpOp > - { - public: - - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_row = op_type::template traits::is_row; - static constexpr bool is_col = op_type::template traits::is_col; - static constexpr bool is_xvec = op_type::template traits::is_xvec; - - inline explicit SpOp(const T1& in_m); - inline SpOp(const T1& in_m, const elem_type in_aux); - inline SpOp(const T1& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b); - inline ~SpOp(); - - arma_inline bool is_alias(const SpMat& X) const; - - arma_aligned const T1& m; //!< the operand; must be derived from SpBase - arma_aligned elem_type aux; //!< auxiliary data, using the element type as used by T1 - arma_aligned uword aux_uword_a; //!< auxiliary data, uword format - arma_aligned uword aux_uword_b; //!< auxiliary data, uword format - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpOp_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpOp_meat.hpp deleted file mode 100644 index c3b59c8fd..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpOp_meat.hpp +++ /dev/null @@ -1,76 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpOp -//! @{ - - - -template -inline -SpOp::SpOp(const T1& in_m) - : m(in_m) - { - arma_debug_sigprint(); - } - - - -template -inline -SpOp::SpOp(const T1& in_m, const typename T1::elem_type in_aux) - : m(in_m) - , aux(in_aux) - { - arma_debug_sigprint(); - } - - - -template -inline -SpOp::SpOp(const T1& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b) - : m(in_m) - , aux_uword_a(in_aux_uword_a) - , aux_uword_b(in_aux_uword_b) - { - arma_debug_sigprint(); - } - - - -template -inline -SpOp::~SpOp() - { - arma_debug_sigprint(); - } - - - -template -arma_inline -bool -SpOp::is_alias(const SpMat& X) const - { - return m.is_alias(X); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpProxy.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpProxy.hpp deleted file mode 100644 index 82dd7b6cf..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpProxy.hpp +++ /dev/null @@ -1,739 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpProxy -//! @{ - - -// TODO: clarify and check which variables and functions are valid when 'use_iterator' is either true or false - - -// within each specialisation of the Proxy class: -// -// elem_type = type of the elements obtained from object Q -// pod_type = underlying type of elements if elem_type is std::complex -// stored_type = type of Q object -// -// const_iterator_type = type of iterator provided by begin() and begin_col() -// const_row_iterator_type = type of iterator provided by begin_row() -// -// use_iterator = boolean to indicate that provided iterators must be used for accessing elements -// Q_is_generated = boolean to indicate Q object was generated by SpProxy -// -// is_row = boolean to indicate Q object can be treated a row vector -// is_col = boolean to indicate Q object can be treated a column vector -// is_xvec = boolean to indicate Q object is a vector with unknown orientation -// -// Q = object that can be unwrapped via unwrap_spmat family of classes (ie. Q must be convertible to SpMat) -// -// get_n_rows() = return number of rows in Q -// get_n_cols() = return number of columns in Q -// get_n_elem() = return number of elements in Q -// get_n_nonzero() = return number of non-zero elements in Q -// -// operator[i] = linear element accessor; valid only if the 'use_iterator' boolean is false -// at(row,col) = access elements via (row,col); valid only if the 'use_iterator' boolean is false -// -// get_values() = return pointer to CSC values array in Q; valid only if the 'use_iterator' boolean is false -// get_row_indices() = return pointer to CSC row indices array in Q; valid only if the 'use_iterator' boolean is false -// get_col_ptrs() = return pointer to CSC column pointers array in Q; valid only if the 'use_iterator' boolean is false -// -// begin() = column-wise iterator indicating first element in Q -// begin_col(col_num) = column-wise iterator indicating first element in column 'col_num' in Q -// begin_row(row_num = 0) = row-wise iterator indicating first element in row 'row_num' in Q -// -// end() = column-wise iterator indicating "one-past-end" element in Q -// end_row() = row-wise iterator indicating "one-past-end" element in Q -// end_row(row_num) = row-wise iterator indicating "one-past-end" element in row 'row_num' in Q -// -// is_alias(X) = return true/false to indicate Q object aliases matrix X - - - -template -struct SpProxy< SpMat > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef SpMat stored_type; - - typedef typename SpMat::const_iterator const_iterator_type; - typedef typename SpMat::const_row_iterator const_row_iterator_type; - - static constexpr bool use_iterator = false; - static constexpr bool Q_is_generated = false; - - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - arma_aligned const SpMat& Q; - - inline explicit SpProxy(const SpMat& A) - : Q(A) - { - arma_debug_sigprint(); - Q.sync(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - arma_inline uword get_n_nonzero() const { return Q.n_nonzero; } - - arma_inline elem_type operator[](const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword row, const uword col) const { return Q.at(row, col); } - - arma_inline const eT* get_values() const { return Q.values; } - arma_inline const uword* get_row_indices() const { return Q.row_indices; } - arma_inline const uword* get_col_ptrs() const { return Q.col_ptrs; } - - arma_inline const_iterator_type begin() const { return Q.begin(); } - arma_inline const_iterator_type begin_col(const uword col_num) const { return Q.begin_col(col_num); } - arma_inline const_row_iterator_type begin_row(const uword row_num = 0) const { return Q.begin_row(row_num); } - - arma_inline const_iterator_type end() const { return Q.end(); } - arma_inline const_row_iterator_type end_row() const { return Q.end_row(); } - arma_inline const_row_iterator_type end_row(const uword row_num) const { return Q.end_row(row_num); } - - template - arma_inline bool is_alias(const SpMat& X) const { return (is_same_type::yes) && (void_ptr(&Q) == void_ptr(&X)); } - }; - - - -template -struct SpProxy< SpCol > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef SpCol stored_type; - - typedef typename SpCol::const_iterator const_iterator_type; - typedef typename SpCol::const_row_iterator const_row_iterator_type; - - static constexpr bool use_iterator = false; - static constexpr bool Q_is_generated = false; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const SpCol& Q; - - inline explicit SpProxy(const SpCol& A) - : Q(A) - { - arma_debug_sigprint(); - Q.sync(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - constexpr uword get_n_cols() const { return 1; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - arma_inline uword get_n_nonzero() const { return Q.n_nonzero; } - - arma_inline elem_type operator[](const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword row, const uword col) const { return Q.at(row, col); } - - arma_inline const eT* get_values() const { return Q.values; } - arma_inline const uword* get_row_indices() const { return Q.row_indices; } - arma_inline const uword* get_col_ptrs() const { return Q.col_ptrs; } - - arma_inline const_iterator_type begin() const { return Q.begin(); } - arma_inline const_iterator_type begin_col(const uword) const { return Q.begin(); } - arma_inline const_row_iterator_type begin_row(const uword row_num = 0) const { return Q.begin_row(row_num); } - - arma_inline const_iterator_type end() const { return Q.end(); } - arma_inline const_row_iterator_type end_row() const { return Q.end_row(); } - arma_inline const_row_iterator_type end_row(const uword row_num) const { return Q.end_row(row_num); } - - template - arma_inline bool is_alias(const SpMat& X) const { return (is_same_type::yes) && (void_ptr(&Q) == void_ptr(&X)); } - }; - - - -template -struct SpProxy< SpRow > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef SpRow stored_type; - - typedef typename SpRow::const_iterator const_iterator_type; - typedef typename SpRow::const_row_iterator const_row_iterator_type; - - static constexpr bool use_iterator = false; - static constexpr bool Q_is_generated = false; - - static constexpr bool is_row = true; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - arma_aligned const SpRow& Q; - - inline explicit SpProxy(const SpRow& A) - : Q(A) - { - arma_debug_sigprint(); - Q.sync(); - } - - constexpr uword get_n_rows() const { return 1; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - arma_inline uword get_n_nonzero() const { return Q.n_nonzero; } - - arma_inline elem_type operator[](const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword row, const uword col) const { return Q.at(row, col); } - - arma_inline const eT* get_values() const { return Q.values; } - arma_inline const uword* get_row_indices() const { return Q.row_indices; } - arma_inline const uword* get_col_ptrs() const { return Q.col_ptrs; } - - arma_inline const_iterator_type begin() const { return Q.begin(); } - arma_inline const_iterator_type begin_col(const uword col_num) const { return Q.begin_col(col_num); } - arma_inline const_row_iterator_type begin_row(const uword row_num = 0) const { return Q.begin_row(row_num); } - - arma_inline const_iterator_type end() const { return Q.end(); } - arma_inline const_row_iterator_type end_row() const { return Q.end_row(); } - arma_inline const_row_iterator_type end_row(const uword row_num) const { return Q.end_row(row_num); } - - template - arma_inline bool is_alias(const SpMat& X) const { return (is_same_type::yes) && (void_ptr(&Q) == void_ptr(&X)); } - }; - - - -template -struct SpProxy< SpSubview > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef SpSubview stored_type; - - typedef typename SpSubview::const_iterator const_iterator_type; - typedef typename SpSubview::const_row_iterator const_row_iterator_type; - - static constexpr bool use_iterator = true; - static constexpr bool Q_is_generated = false; - - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - arma_aligned const SpSubview& Q; - - inline explicit SpProxy(const SpSubview& A) - : Q(A) - { - arma_debug_sigprint(); - Q.m.sync(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - arma_inline uword get_n_nonzero() const { return Q.n_nonzero; } - - arma_inline elem_type operator[](const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword row, const uword col) const { return Q.at(row, col); } - - arma_inline const eT* get_values() const { return Q.m.values; } - arma_inline const uword* get_row_indices() const { return Q.m.row_indices; } - arma_inline const uword* get_col_ptrs() const { return Q.m.col_ptrs; } - - arma_inline const_iterator_type begin() const { return Q.begin(); } - arma_inline const_iterator_type begin_col(const uword col_num) const { return Q.begin_col(col_num); } - arma_inline const_row_iterator_type begin_row(const uword row_num = 0) const { return Q.begin_row(row_num); } - - arma_inline const_iterator_type end() const { return Q.end(); } - arma_inline const_row_iterator_type end_row() const { return Q.end_row(); } - arma_inline const_row_iterator_type end_row(const uword row_num) const { return Q.end_row(row_num); } - - template - arma_inline bool is_alias(const SpMat& X) const { return (is_same_type::yes) && (void_ptr(&Q.m) == void_ptr(&X)); } - }; - - - -template -struct SpProxy< SpSubview_col > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef SpSubview_col stored_type; - - typedef typename SpSubview::const_iterator const_iterator_type; - typedef typename SpSubview::const_row_iterator const_row_iterator_type; - - static constexpr bool use_iterator = true; - static constexpr bool Q_is_generated = false; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const SpSubview_col& Q; - - inline explicit SpProxy(const SpSubview_col& A) - : Q(A) - { - arma_debug_sigprint(); - Q.m.sync(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - constexpr uword get_n_cols() const { return 1; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - arma_inline uword get_n_nonzero() const { return Q.n_nonzero; } - - arma_inline elem_type operator[](const uword i) const { return Q.at(i, 0); } - arma_inline elem_type at (const uword row, const uword) const { return Q.at(row, 0); } - - arma_inline const eT* get_values() const { return Q.m.values; } - arma_inline const uword* get_row_indices() const { return Q.m.row_indices; } - arma_inline const uword* get_col_ptrs() const { return Q.m.col_ptrs; } - - arma_inline const_iterator_type begin() const { return Q.begin(); } - arma_inline const_iterator_type begin_col(const uword col_num) const { return Q.begin_col(col_num); } - arma_inline const_row_iterator_type begin_row(const uword row_num = 0) const { return Q.begin_row(row_num); } - - arma_inline const_iterator_type end() const { return Q.end(); } - arma_inline const_row_iterator_type end_row() const { return Q.end_row(); } - arma_inline const_row_iterator_type end_row(const uword row_num) const { return Q.end_row(row_num); } - - template - arma_inline bool is_alias(const SpMat& X) const { return (is_same_type::yes) && (void_ptr(&Q.m) == void_ptr(&X)); } - }; - - - -template -struct SpProxy< SpSubview_col_list > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef SpMat stored_type; - - typedef typename SpMat::const_iterator const_iterator_type; - typedef typename SpMat::const_row_iterator const_row_iterator_type; - - static constexpr bool use_iterator = false; - static constexpr bool Q_is_generated = true; - - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - arma_aligned const SpMat Q; - - inline explicit SpProxy(const SpSubview_col_list& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - arma_inline uword get_n_nonzero() const { return Q.n_nonzero; } - - arma_inline elem_type operator[](const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword row, const uword col) const { return Q.at(row, col); } - - arma_inline const eT* get_values() const { return Q.values; } - arma_inline const uword* get_row_indices() const { return Q.row_indices; } - arma_inline const uword* get_col_ptrs() const { return Q.col_ptrs; } - - arma_inline const_iterator_type begin() const { return Q.begin(); } - arma_inline const_iterator_type begin_col(const uword col_num) const { return Q.begin_col(col_num); } - arma_inline const_row_iterator_type begin_row(const uword row_num = 0) const { return Q.begin_row(row_num); } - - arma_inline const_iterator_type end() const { return Q.end(); } - arma_inline const_row_iterator_type end_row() const { return Q.end_row(); } - arma_inline const_row_iterator_type end_row(const uword row_num) const { return Q.end_row(row_num); } - - template - constexpr bool is_alias(const SpMat&) const { return false; } - }; - - - -template -struct SpProxy< SpSubview_row > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef SpSubview_row stored_type; - - typedef typename SpSubview::const_iterator const_iterator_type; - typedef typename SpSubview::const_row_iterator const_row_iterator_type; - - static constexpr bool use_iterator = true; - static constexpr bool Q_is_generated = false; - - static constexpr bool is_row = true; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - arma_aligned const SpSubview_row& Q; - - inline explicit SpProxy(const SpSubview_row& A) - : Q(A) - { - arma_debug_sigprint(); - Q.m.sync(); - } - - constexpr uword get_n_rows() const { return 1; } - arma_inline uword get_n_cols() const { return Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - arma_inline uword get_n_nonzero() const { return Q.n_nonzero; } - - arma_inline elem_type operator[](const uword i) const { return Q.at(0, i ); } - arma_inline elem_type at (const uword, const uword col) const { return Q.at(0, col); } - - arma_inline const eT* get_values() const { return Q.m.values; } - arma_inline const uword* get_row_indices() const { return Q.m.row_indices; } - arma_inline const uword* get_col_ptrs() const { return Q.m.col_ptrs; } - - arma_inline const_iterator_type begin() const { return Q.begin(); } - arma_inline const_iterator_type begin_col(const uword col_num) const { return Q.begin_col(col_num); } - arma_inline const_row_iterator_type begin_row(const uword row_num = 0) const { return Q.begin_row(row_num); } - - arma_inline const_iterator_type end() const { return Q.end(); } - arma_inline const_row_iterator_type end_row() const { return Q.end_row(); } - arma_inline const_row_iterator_type end_row(const uword row_num) const { return Q.end_row(row_num); } - - template - arma_inline bool is_alias(const SpMat& X) const { return (is_same_type::yes) && (void_ptr(&Q.m) == void_ptr(&X)); } - }; - - - -template -struct SpProxy< spdiagview > - { - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef SpMat stored_type; - - typedef typename SpMat::const_iterator const_iterator_type; - typedef typename SpMat::const_row_iterator const_row_iterator_type; - - static constexpr bool use_iterator = false; - static constexpr bool Q_is_generated = true; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const SpMat Q; - - inline explicit SpProxy(const spdiagview& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return Q.n_rows; } - constexpr uword get_n_cols() const { return 1; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - arma_inline uword get_n_nonzero() const { return Q.n_nonzero; } - - arma_inline elem_type operator[](const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword row, const uword col) const { return Q.at(row, col); } - - arma_inline const eT* get_values() const { return Q.values; } - arma_inline const uword* get_row_indices() const { return Q.row_indices; } - arma_inline const uword* get_col_ptrs() const { return Q.col_ptrs; } - - arma_inline const_iterator_type begin() const { return Q.begin(); } - arma_inline const_iterator_type begin_col(const uword col_num) const { return Q.begin_col(col_num); } - arma_inline const_row_iterator_type begin_row(const uword row_num = 0) const { return Q.begin_row(row_num); } - - arma_inline const_iterator_type end() const { return Q.end(); } - arma_inline const_row_iterator_type end_row() const { return Q.end_row(); } - arma_inline const_row_iterator_type end_row(const uword row_num) const { return Q.end_row(row_num); } - - template - constexpr bool is_alias(const SpMat&) const { return false; } - }; - - - -template -struct SpProxy< SpOp > - { - typedef typename T1::elem_type elem_type; - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result pod_type; - typedef SpMat stored_type; - - typedef typename SpMat::const_iterator const_iterator_type; - typedef typename SpMat::const_row_iterator const_row_iterator_type; - - static constexpr bool use_iterator = false; - static constexpr bool Q_is_generated = true; - - static constexpr bool is_row = SpOp::is_row; - static constexpr bool is_col = SpOp::is_col; - static constexpr bool is_xvec = SpOp::is_xvec; - - arma_aligned const SpMat Q; - - inline explicit SpProxy(const SpOp& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return is_row ? 1 : Q.n_rows; } - arma_inline uword get_n_cols() const { return is_col ? 1 : Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - arma_inline uword get_n_nonzero() const { return Q.n_nonzero; } - - arma_inline elem_type operator[](const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword row, const uword col) const { return Q.at(row, col); } - - arma_inline const eT* get_values() const { return Q.values; } - arma_inline const uword* get_row_indices() const { return Q.row_indices; } - arma_inline const uword* get_col_ptrs() const { return Q.col_ptrs; } - - arma_inline const_iterator_type begin() const { return Q.begin(); } - arma_inline const_iterator_type begin_col(const uword col_num) const { return Q.begin_col(col_num); } - arma_inline const_row_iterator_type begin_row(const uword row_num = 0) const { return Q.begin_row(row_num); } - - arma_inline const_iterator_type end() const { return Q.end(); } - arma_inline const_row_iterator_type end_row() const { return Q.end_row(); } - arma_inline const_row_iterator_type end_row(const uword row_num) const { return Q.end_row(row_num); } - - template - constexpr bool is_alias(const SpMat&) const { return false; } - }; - - - -template -struct SpProxy< SpGlue > - { - typedef typename T1::elem_type elem_type; - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result pod_type; - typedef SpMat stored_type; - - typedef typename SpMat::const_iterator const_iterator_type; - typedef typename SpMat::const_row_iterator const_row_iterator_type; - - static constexpr bool use_iterator = false; - static constexpr bool Q_is_generated = true; - - static constexpr bool is_row = SpGlue::is_row; - static constexpr bool is_col = SpGlue::is_col; - static constexpr bool is_xvec = SpGlue::is_xvec; - - arma_aligned const SpMat Q; - - inline explicit SpProxy(const SpGlue& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return is_row ? 1 : Q.n_rows; } - arma_inline uword get_n_cols() const { return is_col ? 1 : Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - arma_inline uword get_n_nonzero() const { return Q.n_nonzero; } - - arma_inline elem_type operator[](const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword row, const uword col) const { return Q.at(row, col); } - - arma_inline const eT* get_values() const { return Q.values; } - arma_inline const uword* get_row_indices() const { return Q.row_indices; } - arma_inline const uword* get_col_ptrs() const { return Q.col_ptrs; } - - arma_inline const_iterator_type begin() const { return Q.begin(); } - arma_inline const_iterator_type begin_col(const uword col_num) const { return Q.begin_col(col_num); } - arma_inline const_row_iterator_type begin_row(const uword row_num = 0) const { return Q.begin_row(row_num); } - - arma_inline const_iterator_type end() const { return Q.end(); } - arma_inline const_row_iterator_type end_row() const { return Q.end_row(); } - arma_inline const_row_iterator_type end_row(const uword row_num) const { return Q.end_row(row_num); } - - template - constexpr bool is_alias(const SpMat&) const { return false; } - }; - - - -template -struct SpProxy< mtSpOp > - { - typedef out_eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef SpMat stored_type; - - typedef typename SpMat::const_iterator const_iterator_type; - typedef typename SpMat::const_row_iterator const_row_iterator_type; - - static constexpr bool use_iterator = false; - static constexpr bool Q_is_generated = true; - - static constexpr bool is_row = mtSpOp::is_row; - static constexpr bool is_col = mtSpOp::is_col; - static constexpr bool is_xvec = mtSpOp::is_xvec; - - arma_aligned const SpMat Q; - - inline explicit SpProxy(const mtSpOp& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return is_row ? 1 : Q.n_rows; } - arma_inline uword get_n_cols() const { return is_col ? 1 : Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - arma_inline uword get_n_nonzero() const { return Q.n_nonzero; } - - arma_inline elem_type operator[](const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword row, const uword col) const { return Q.at(row, col); } - - arma_inline const out_eT* get_values() const { return Q.values; } - arma_inline const uword* get_row_indices() const { return Q.row_indices; } - arma_inline const uword* get_col_ptrs() const { return Q.col_ptrs; } - - arma_inline const_iterator_type begin() const { return Q.begin(); } - arma_inline const_iterator_type begin_col(const uword col_num) const { return Q.begin_col(col_num); } - arma_inline const_row_iterator_type begin_row(const uword row_num = 0) const { return Q.begin_row(row_num); } - - arma_inline const_iterator_type end() const { return Q.end(); } - arma_inline const_row_iterator_type end_row() const { return Q.end_row(); } - arma_inline const_row_iterator_type end_row(const uword row_num) const { return Q.end_row(row_num); } - - template - constexpr bool is_alias(const SpMat&) const { return false; } - }; - - - -template -struct SpProxy< mtSpGlue > - { - typedef out_eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef SpMat stored_type; - - typedef typename SpMat::const_iterator const_iterator_type; - typedef typename SpMat::const_row_iterator const_row_iterator_type; - - static constexpr bool use_iterator = false; - static constexpr bool Q_is_generated = true; - - static constexpr bool is_row = mtSpGlue::is_row; - static constexpr bool is_col = mtSpGlue::is_col; - static constexpr bool is_xvec = mtSpGlue::is_xvec; - - arma_aligned const SpMat Q; - - inline explicit SpProxy(const mtSpGlue& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return is_row ? 1 : Q.n_rows; } - arma_inline uword get_n_cols() const { return is_col ? 1 : Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - arma_inline uword get_n_nonzero() const { return Q.n_nonzero; } - - arma_inline elem_type operator[](const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword row, const uword col) const { return Q.at(row, col); } - - arma_inline const out_eT* get_values() const { return Q.values; } - arma_inline const uword* get_row_indices() const { return Q.row_indices; } - arma_inline const uword* get_col_ptrs() const { return Q.col_ptrs; } - - arma_inline const_iterator_type begin() const { return Q.begin(); } - arma_inline const_iterator_type begin_col(const uword col_num) const { return Q.begin_col(col_num); } - arma_inline const_row_iterator_type begin_row(const uword row_num = 0) const { return Q.begin_row(row_num); } - - arma_inline const_iterator_type end() const { return Q.end(); } - arma_inline const_row_iterator_type end_row() const { return Q.end_row(); } - arma_inline const_row_iterator_type end_row(const uword row_num) const { return Q.end_row(row_num); } - - template - constexpr bool is_alias(const SpMat&) const { return false; } - }; - - - -template -struct SpProxy< mtSpReduceOp > - { - typedef out_eT elem_type; - typedef typename get_pod_type::result pod_type; - typedef SpMat stored_type; - - typedef typename SpMat::const_iterator const_iterator_type; - typedef typename SpMat::const_row_iterator const_row_iterator_type; - - static constexpr bool use_iterator = false; - static constexpr bool Q_is_generated = true; - - static constexpr bool is_row = mtSpReduceOp::is_row; - static constexpr bool is_col = mtSpReduceOp::is_col; - static constexpr bool is_xvec = mtSpReduceOp::is_xvec; - - arma_aligned const SpMat Q; - - inline explicit SpProxy(const mtSpReduceOp& A) - : Q(A) - { - arma_debug_sigprint(); - } - - arma_inline uword get_n_rows() const { return is_row ? 1 : Q.n_rows; } - arma_inline uword get_n_cols() const { return is_col ? 1 : Q.n_cols; } - arma_inline uword get_n_elem() const { return Q.n_elem; } - arma_inline uword get_n_nonzero() const { return Q.n_nonzero; } - - arma_inline elem_type operator[](const uword i) const { return Q[i]; } - arma_inline elem_type at (const uword row, const uword col) const { return Q.at(row, col); } - - arma_inline const out_eT* get_values() const { return Q.values; } - arma_inline const uword* get_row_indices() const { return Q.row_indices; } - arma_inline const uword* get_col_ptrs() const { return Q.col_ptrs; } - - arma_inline const_iterator_type begin() const { return Q.begin(); } - arma_inline const_iterator_type begin_col(const uword col_num) const { return Q.begin_col(col_num); } - arma_inline const_row_iterator_type begin_row(const uword row_num = 0) const { return Q.begin_row(row_num); } - - arma_inline const_iterator_type end() const { return Q.end(); } - arma_inline const_row_iterator_type end_row() const { return Q.end_row(); } - arma_inline const_row_iterator_type end_row(const uword row_num) const { return Q.end_row(row_num); } - - template - constexpr bool is_alias(const SpMat&) const { return false; } - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpRow_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpRow_bones.hpp deleted file mode 100644 index c5fed2fa9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpRow_bones.hpp +++ /dev/null @@ -1,89 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpRow -//! @{ - - -//! Class for sparse row vectors (sparse matrices with only one row) -template -class SpRow : public SpMat - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_row = true; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - - inline SpRow(); - inline explicit SpRow(const uword N); - inline explicit SpRow(const uword in_rows, const uword in_cols); - inline explicit SpRow(const SizeMat& s); - - inline SpRow(const char* text); - inline SpRow& operator=(const char* text); - - inline SpRow(const std::string& text); - inline SpRow& operator=(const std::string& text); - - inline SpRow& operator=(const eT val); - - inline SpRow(const Row& X); // for backwards compatibility - - template inline explicit SpRow(const Base& X); - template inline SpRow& operator=(const Base& X); - - template inline SpRow(const SpBase& X); - template inline SpRow& operator=(const SpBase& X); - - template - inline explicit SpRow(const SpBase& A, const SpBase& B); - - arma_warn_unused inline const SpOp,spop_htrans> t() const; - arma_warn_unused inline const SpOp,spop_htrans> ht() const; - arma_warn_unused inline const SpOp,spop_strans> st() const; - - arma_warn_unused inline const SpToDOp,op_sp_as_dense> as_dense() const; - - inline void shed_col (const uword col_num); - inline void shed_cols(const uword in_col1, const uword in_col2); - - // inline void insert_cols(const uword col_num, const uword N, const bool set_to_zero = true); - - - typedef typename SpMat::iterator row_iterator; - typedef typename SpMat::const_iterator const_row_iterator; - - inline row_iterator begin_row(const uword row_num = 0); - inline const_row_iterator begin_row(const uword row_num = 0) const; - - inline row_iterator end_row(const uword row_num = 0); - inline const_row_iterator end_row(const uword row_num = 0) const; - - #if defined(ARMA_EXTRA_SPROW_PROTO) - #include ARMA_INCFILE_WRAP(ARMA_EXTRA_SPROW_PROTO) - #endif - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpRow_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpRow_meat.hpp deleted file mode 100644 index 3d063bfb5..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpRow_meat.hpp +++ /dev/null @@ -1,457 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpRow -//! @{ - - - -template -inline -SpRow::SpRow() - : SpMat(arma_vec_indicator(), 2) - { - arma_debug_sigprint(); - } - - - -template -inline -SpRow::SpRow(const uword in_n_elem) - : SpMat(arma_vec_indicator(), 1, in_n_elem, 2) - { - arma_debug_sigprint(); - } - - - -template -inline -SpRow::SpRow(const uword in_n_rows, const uword in_n_cols) - : SpMat(arma_vec_indicator(), in_n_rows, in_n_cols, 2) - { - arma_debug_sigprint(); - } - - - -template -inline -SpRow::SpRow(const SizeMat& s) - : SpMat(arma_vec_indicator(), 0, 0, 2) - { - arma_debug_sigprint(); - - SpMat::init(s.n_rows, s.n_cols); - } - - - -template -inline -SpRow::SpRow(const char* text) - : SpMat(arma_vec_indicator(), 2) - { - arma_debug_sigprint(); - - SpMat::init(std::string(text)); - } - - - -template -inline -SpRow& -SpRow::operator=(const char* text) - { - arma_debug_sigprint(); - - SpMat::init(std::string(text)); - - return *this; - } - - - -template -inline -SpRow::SpRow(const std::string& text) - : SpMat(arma_vec_indicator(), 2) - { - arma_debug_sigprint(); - - SpMat::init(text); - } - - - -template -inline -SpRow& -SpRow::operator=(const std::string& text) - { - arma_debug_sigprint(); - - SpMat::init(text); - - return *this; - } - - - -template -inline -SpRow& -SpRow::operator=(const eT val) - { - arma_debug_sigprint(); - - SpMat::operator=(val); - - return *this; - } - - - -template -template -inline -SpRow::SpRow(const Base& X) - : SpMat(arma_vec_indicator(), 2) - { - arma_debug_sigprint(); - - SpMat::operator=(X.get_ref()); - } - - - - -template -inline -SpRow::SpRow(const Row& X) - : SpMat(arma_vec_indicator(), 2) - { - arma_debug_sigprint(); - - SpMat::operator=(X); - } - - - - -template -template -inline -SpRow& -SpRow::operator=(const Base& X) - { - arma_debug_sigprint(); - - SpMat::operator=(X.get_ref()); - - return *this; - } - - - -template -template -inline -SpRow::SpRow(const SpBase& X) - : SpMat(arma_vec_indicator(), 2) - { - arma_debug_sigprint(); - - SpMat::operator=(X.get_ref()); - } - - - -template -template -inline -SpRow& -SpRow::operator=(const SpBase& X) - { - arma_debug_sigprint(); - - SpMat::operator=(X.get_ref()); - - return *this; - } - - - -template -template -inline -SpRow::SpRow - ( - const SpBase::pod_type, T1>& A, - const SpBase::pod_type, T2>& B - ) - : SpMat(arma_vec_indicator(), 2) - { - arma_debug_sigprint(); - - SpMat::init(A,B); - } - - - -template -inline -const SpOp,spop_htrans> -SpRow::t() const - { - return SpOp,spop_htrans>(*this); - } - - - -template -inline -const SpOp,spop_htrans> -SpRow::ht() const - { - return SpOp,spop_htrans>(*this); - } - - - -template -inline -const SpOp,spop_strans> -SpRow::st() const - { - return SpOp,spop_strans>(*this); - } - - - -template -inline -const SpToDOp,op_sp_as_dense> -SpRow::as_dense() const - { - return SpToDOp,op_sp_as_dense>(*this); - } - - - -//! remove specified columns -template -inline -void -SpRow::shed_col(const uword col_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( col_num >= SpMat::n_cols, "SpRow::shed_col(): out of bounds" ); - - shed_cols(col_num, col_num); - } - - - -//! remove specified columns -template -inline -void -SpRow::shed_cols(const uword in_col1, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_col1 > in_col2) || (in_col2 >= SpMat::n_cols), - "SpRow::shed_cols(): indices out of bounds or incorrectly used" - ); - - SpMat::sync_csc(); - - const uword diff = (in_col2 - in_col1 + 1); - - // This is doubleplus easy because we have all the column pointers stored. - const uword start = SpMat::col_ptrs[in_col1]; - const uword end = SpMat::col_ptrs[in_col2 + 1]; - - if(start != end) - { - const uword elem_diff = end - start; - - eT* new_values = memory::acquire (SpMat::n_nonzero - elem_diff); - uword* new_row_indices = memory::acquire(SpMat::n_nonzero - elem_diff); - - // Copy first set of elements, if necessary. - if(start > 0) - { - arrayops::copy(new_values, SpMat::values, start); - arrayops::copy(new_row_indices, SpMat::row_indices, start); - } - - // Copy last set of elements, if necessary. - if(end != SpMat::n_nonzero) - { - arrayops::copy(new_values + start, SpMat::values + end, (SpMat::n_nonzero - end)); - arrayops::copy(new_row_indices + start, SpMat::row_indices + end, (SpMat::n_nonzero - end)); - } - - memory::release(SpMat::values); - memory::release(SpMat::row_indices); - - access::rw(SpMat::values) = new_values; - access::rw(SpMat::row_indices) = new_row_indices; - - access::rw(SpMat::n_nonzero) -= elem_diff; - } - - // Update column pointers. - uword* new_col_ptrs = memory::acquire(SpMat::n_cols - diff + 1); - - // Copy first part of column pointers. - if(in_col1 > 0) - { - arrayops::copy(new_col_ptrs, SpMat::col_ptrs, in_col1); - } - - // Copy last part of column pointers (and adjust their values as necessary). - if(in_col2 < SpMat::n_cols - 1) - { - arrayops::copy(new_col_ptrs + in_col1, SpMat::col_ptrs + in_col2 + 1, SpMat::n_cols - in_col2); - // Modify their values. - arrayops::inplace_minus(new_col_ptrs + in_col1, (end - start), SpMat::n_cols - in_col2); - } - - memory::release(SpMat::col_ptrs); - - access::rw(SpMat::col_ptrs) = new_col_ptrs; - - access::rw(SpMat::n_cols) -= diff; - access::rw(SpMat::n_elem) -= diff; - - SpMat::invalidate_cache(); - } - - - -// //! insert N cols at the specified col position, -// //! optionally setting the elements of the inserted cols to zero -// template -// inline -// void -// SpRow::insert_cols(const uword col_num, const uword N, const bool set_to_zero) -// { -// arma_debug_sigprint(); -// -// // insertion at col_num == n_cols is in effect an append operation -// arma_conform_check_bounds( (col_num > SpMat::n_cols), "SpRow::insert_cols(): out of bounds" ); -// -// arma_conform_check( (set_to_zero == false), "SpRow::insert_cols(): cannot set elements to nonzero values" ); -// -// uword newVal = (col_num == 0) ? 0 : SpMat::col_ptrs[col_num]; -// SpMat::col_ptrs.insert(col_num, N, newVal); -// uword* new_col_ptrs = memory::acquire(SpMat::n_cols + N); -// -// arrayops::copy(new_col_ptrs, SpMat::col_ptrs, col_num); -// -// uword fill_value = (col_num == 0) ? 0 : SpMat::col_ptrs[col_num - 1]; -// arrayops::inplace_set(new_col_ptrs + col_num, fill_value, N); -// -// arrayops::copy(new_col_ptrs + col_num + N, SpMat::col_ptrs + col_num, SpMat::n_cols - col_num); -// -// access::rw(SpMat::n_cols) += N; -// access::rw(SpMat::n_elem) += N; -// } - - - -template -inline -typename SpRow::row_iterator -SpRow::begin_row(const uword row_num) - { - arma_debug_sigprint(); - - // Since this is a row, row_num can only be 0. But the option is provided for - // compatibility. - arma_conform_check_bounds((row_num >= 1), "SpRow::begin_row(): index out of bounds"); - - return SpMat::begin(); - } - - - -template -inline -typename SpRow::const_row_iterator -SpRow::begin_row(const uword row_num) const - { - arma_debug_sigprint(); - - // Since this is a row, row_num can only be 0. But the option is provided for - // compatibility. - arma_conform_check_bounds((row_num >= 1), "SpRow::begin_row(): index out of bounds"); - - return SpMat::begin(); - } - - - -template -inline -typename SpRow::row_iterator -SpRow::end_row(const uword row_num) - { - arma_debug_sigprint(); - - // Since this is a row, row_num can only be 0. But the option is provided for - // compatibility. - arma_conform_check_bounds((row_num >= 1), "SpRow::end_row(): index out of bounds"); - - return SpMat::end(); - } - - - -template -inline -typename SpRow::const_row_iterator -SpRow::end_row(const uword row_num) const - { - arma_debug_sigprint(); - - // Since this is a row, row_num can only be 0. But the option is provided for - // compatibility. - arma_conform_check_bounds((row_num >= 1), "SpRow::end_row(): index out of bounds"); - - return SpMat::end(); - } - - - - -#if defined(ARMA_EXTRA_SPROW_MEAT) - #include ARMA_INCFILE_WRAP(ARMA_EXTRA_SPROW_MEAT) -#endif - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpSubview_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpSubview_bones.hpp deleted file mode 100644 index fe32216e2..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpSubview_bones.hpp +++ /dev/null @@ -1,422 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpSubview -//! @{ - - -template -class SpSubview : public SpBase< eT, SpSubview > - { - public: - - const SpMat& m; - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - const uword aux_row1; - const uword aux_col1; - const uword n_rows; - const uword n_cols; - const uword n_elem; - const uword n_nonzero; - - protected: - - inline SpSubview(const SpMat& in_m, const uword in_row1, const uword in_col1, const uword in_n_rows, const uword in_n_cols); - - public: - - inline ~SpSubview(); - inline SpSubview() = delete; - - inline SpSubview(const SpSubview& in); - inline SpSubview( SpSubview&& in); - - inline const SpSubview& operator+= (const eT val); - inline const SpSubview& operator-= (const eT val); - inline const SpSubview& operator*= (const eT val); - inline const SpSubview& operator/= (const eT val); - - inline const SpSubview& operator=(const SpSubview& x); - - template inline const SpSubview& operator= (const Base& x); - template inline const SpSubview& operator+=(const Base& x); - template inline const SpSubview& operator-=(const Base& x); - template inline const SpSubview& operator*=(const Base& x); - template inline const SpSubview& operator%=(const Base& x); - template inline const SpSubview& operator/=(const Base& x); - - template inline const SpSubview& operator_equ_common(const SpBase& x); - - template inline const SpSubview& operator= (const SpBase& x); - template inline const SpSubview& operator+=(const SpBase& x); - template inline const SpSubview& operator-=(const SpBase& x); - template inline const SpSubview& operator*=(const SpBase& x); - template inline const SpSubview& operator%=(const SpBase& x); - template inline const SpSubview& operator/=(const SpBase& x); - - /* - inline static void extract(SpMat& out, const SpSubview& in); - - inline static void plus_inplace(Mat& out, const subview& in); - inline static void minus_inplace(Mat& out, const subview& in); - inline static void schur_inplace(Mat& out, const subview& in); - inline static void div_inplace(Mat& out, const subview& in); - */ - - template inline void for_each(functor F); - template inline void for_each(functor F) const; - - template inline void transform(functor F); - - inline void replace(const eT old_val, const eT new_val); - - inline void clean(const pod_type threshold); - - inline void clamp(const eT min_val, const eT max_val); - - inline void fill(const eT val); - inline void zeros(); - inline void ones(); - inline void eye(); - inline void randu(); - inline void randn(); - - - arma_warn_unused inline SpSubview_MapMat_val operator[](const uword i); - arma_warn_unused inline eT operator[](const uword i) const; - - arma_warn_unused inline SpSubview_MapMat_val operator()(const uword i); - arma_warn_unused inline eT operator()(const uword i) const; - - arma_warn_unused inline SpSubview_MapMat_val operator()(const uword in_row, const uword in_col); - arma_warn_unused inline eT operator()(const uword in_row, const uword in_col) const; - - arma_warn_unused inline SpSubview_MapMat_val at(const uword i); - arma_warn_unused inline eT at(const uword i) const; - - arma_warn_unused inline SpSubview_MapMat_val at(const uword in_row, const uword in_col); - arma_warn_unused inline eT at(const uword in_row, const uword in_col) const; - - inline bool check_overlap(const SpSubview& x) const; - - arma_warn_unused inline bool is_vec() const; - - inline SpSubview_row row(const uword row_num); - inline const SpSubview_row row(const uword row_num) const; - - inline SpSubview_col col(const uword col_num); - inline const SpSubview_col col(const uword col_num) const; - - inline SpSubview rows(const uword in_row1, const uword in_row2); - inline const SpSubview rows(const uword in_row1, const uword in_row2) const; - - inline SpSubview cols(const uword in_col1, const uword in_col2); - inline const SpSubview cols(const uword in_col1, const uword in_col2) const; - - inline SpSubview submat(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2); - inline const SpSubview submat(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2) const; - - inline SpSubview submat(const span& row_span, const span& col_span); - inline const SpSubview submat(const span& row_span, const span& col_span) const; - - inline SpSubview operator()(const uword row_num, const span& col_span); - inline const SpSubview operator()(const uword row_num, const span& col_span) const; - - inline SpSubview operator()(const span& row_span, const uword col_num); - inline const SpSubview operator()(const span& row_span, const uword col_num) const; - - inline SpSubview operator()(const span& row_span, const span& col_span); - inline const SpSubview operator()(const span& row_span, const span& col_span) const; - - - inline void swap_rows(const uword in_row1, const uword in_row2); - inline void swap_cols(const uword in_col1, const uword in_col2); - - // Forward declarations. - class iterator_base; - class const_iterator; - class iterator; - class const_row_iterator; - class row_iterator; - - // Similar to SpMat iterators but automatically iterates past and ignores values not in the subview. - class iterator_base - { - public: - - inline iterator_base(const SpSubview& in_M); - inline iterator_base(const SpSubview& in_M, const uword col, const uword pos); - - arma_inline uword col() const { return internal_col; } - arma_inline uword pos() const { return internal_pos; } - - arma_aligned const SpSubview* M; - arma_aligned uword internal_col; - arma_aligned uword internal_pos; - - typedef std::bidirectional_iterator_tag iterator_category; - typedef eT value_type; - typedef std::ptrdiff_t difference_type; // TODO: not certain on this one - typedef const eT* pointer; - typedef const eT& reference; - }; - - class const_iterator : public iterator_base - { - public: - - inline const_iterator(const SpSubview& in_M, uword initial_pos = 0); - inline const_iterator(const SpSubview& in_M, uword in_row, uword in_col); - inline const_iterator(const SpSubview& in_M, uword in_row, uword in_col, uword in_pos, uword skip_pos); - inline const_iterator(const const_iterator& other); - - arma_inline eT operator*() const; - - // Don't hold location internally; call "dummy" methods to get that information. - arma_inline uword row() const { return iterator_base::M->m.row_indices[iterator_base::internal_pos + skip_pos] - iterator_base::M->aux_row1; } - - arma_hot inline const_iterator& operator++(); - arma_warn_unused inline const_iterator operator++(int); - - arma_hot inline const_iterator& operator--(); - arma_warn_unused inline const_iterator operator--(int); - - arma_hot inline bool operator!=(const const_iterator& rhs) const; - arma_hot inline bool operator==(const const_iterator& rhs) const; - - arma_hot inline bool operator!=(const typename SpMat::const_iterator& rhs) const; - arma_hot inline bool operator==(const typename SpMat::const_iterator& rhs) const; - - arma_hot inline bool operator!=(const const_row_iterator& rhs) const; - arma_hot inline bool operator==(const const_row_iterator& rhs) const; - - arma_hot inline bool operator!=(const typename SpMat::const_row_iterator& rhs) const; - arma_hot inline bool operator==(const typename SpMat::const_row_iterator& rhs) const; - - arma_aligned uword skip_pos; // not used in row_iterator or const_row_iterator - }; - - class iterator : public const_iterator - { - public: - - inline iterator(SpSubview& in_M, const uword initial_pos = 0) : const_iterator(in_M, initial_pos) { } - inline iterator(SpSubview& in_M, const uword in_row, const uword in_col) : const_iterator(in_M, in_row, in_col) { } - inline iterator(SpSubview& in_M, const uword in_row, const uword in_col, const uword in_pos, const uword in_skip_pos) : const_iterator(in_M, in_row, in_col, in_pos, in_skip_pos) { } - inline iterator(const iterator& other) : const_iterator(other) { } - - arma_hot inline SpValProxy< SpSubview > operator*(); - - // overloads needed for return type correctness - arma_hot inline iterator& operator++(); - arma_warn_unused inline iterator operator++(int); - - arma_hot inline iterator& operator--(); - arma_warn_unused inline iterator operator--(int); - - // This has a different value_type than iterator_base. - typedef SpValProxy< SpSubview > value_type; - typedef const SpValProxy< SpSubview >* pointer; - typedef const SpValProxy< SpSubview >& reference; - }; - - class const_row_iterator : public iterator_base - { - public: - - inline const_row_iterator(); - inline const_row_iterator(const SpSubview& in_M, uword initial_pos = 0); - inline const_row_iterator(const SpSubview& in_M, uword in_row, uword in_col); - inline const_row_iterator(const const_row_iterator& other); - - arma_hot inline const_row_iterator& operator++(); - arma_warn_unused inline const_row_iterator operator++(int); - - arma_hot inline const_row_iterator& operator--(); - arma_warn_unused inline const_row_iterator operator--(int); - - uword internal_row; // Hold row internally because we use internal_pos differently. - uword actual_pos; // Actual position in subview's parent matrix. - - arma_inline eT operator*() const { return iterator_base::M->m.values[actual_pos]; } - - arma_inline uword row() const { return internal_row; } - - arma_hot inline bool operator!=(const const_iterator& rhs) const; - arma_hot inline bool operator==(const const_iterator& rhs) const; - - arma_hot inline bool operator!=(const typename SpMat::const_iterator& rhs) const; - arma_hot inline bool operator==(const typename SpMat::const_iterator& rhs) const; - - arma_hot inline bool operator!=(const const_row_iterator& rhs) const; - arma_hot inline bool operator==(const const_row_iterator& rhs) const; - - arma_hot inline bool operator!=(const typename SpMat::const_row_iterator& rhs) const; - arma_hot inline bool operator==(const typename SpMat::const_row_iterator& rhs) const; - }; - - class row_iterator : public const_row_iterator - { - public: - - inline row_iterator(SpSubview& in_M, uword initial_pos = 0) : const_row_iterator(in_M, initial_pos) { } - inline row_iterator(SpSubview& in_M, uword in_row, uword in_col) : const_row_iterator(in_M, in_row, in_col) { } - inline row_iterator(const row_iterator& other) : const_row_iterator(other) { } - - arma_hot inline SpValProxy< SpSubview > operator*(); - - // overloads needed for return type correctness - arma_hot inline row_iterator& operator++(); - arma_warn_unused inline row_iterator operator++(int); - - arma_hot inline row_iterator& operator--(); - arma_warn_unused inline row_iterator operator--(int); - - // This has a different value_type than iterator_base. - typedef SpValProxy< SpSubview > value_type; - typedef const SpValProxy< SpSubview >* pointer; - typedef const SpValProxy< SpSubview >& reference; - }; - - inline iterator begin(); - inline const_iterator begin() const; - inline const_iterator cbegin() const; - - inline iterator begin_col(const uword col_num); - inline const_iterator begin_col(const uword col_num) const; - - inline row_iterator begin_row(const uword row_num = 0); - inline const_row_iterator begin_row(const uword row_num = 0) const; - - inline iterator end(); - inline const_iterator end() const; - inline const_iterator cend() const; - - inline row_iterator end_row(); - inline const_row_iterator end_row() const; - - inline row_iterator end_row(const uword row_num); - inline const_row_iterator end_row(const uword row_num) const; - - //! don't use this unless you're writing internal Armadillo code - arma_inline bool is_alias(const SpMat& X) const; - - - private: - - friend class SpMat; - friend class SpSubview_col; - friend class SpSubview_row; - friend class SpValProxy< SpSubview >; // allow SpValProxy to call insert_element() and delete_element() - - arma_warn_unused inline eT& insert_element(const uword in_row, const uword in_col, const eT in_val = eT(0)); - inline void delete_element(const uword in_row, const uword in_col); - - inline void invalidate_cache() const; - }; - - - -template -class SpSubview_col : public SpSubview - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - inline void operator= (const SpSubview& x); - inline void operator= (const SpSubview_col& x); - - template inline void operator= (const SpBase& x); - template inline void operator= (const Base& x); - - arma_warn_unused inline const SpOp,spop_htrans> t() const; - arma_warn_unused inline const SpOp,spop_htrans> ht() const; - arma_warn_unused inline const SpOp,spop_strans> st() const; - - arma_warn_unused inline const SpToDOp,op_sp_as_dense> as_dense() const; - - - protected: - - inline SpSubview_col(const SpMat& in_m, const uword in_col); - inline SpSubview_col(const SpMat& in_m, const uword in_col, const uword in_row1, const uword in_n_rows); - inline SpSubview_col() = delete; - - - private: - - friend class SpMat; - friend class SpSubview; - }; - - - -template -class SpSubview_row : public SpSubview - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_row = true; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - inline void operator= (const SpSubview& x); - inline void operator= (const SpSubview_row& x); - - template inline void operator= (const SpBase& x); - template inline void operator= (const Base& x); - - arma_warn_unused inline const SpOp,spop_htrans> t() const; - arma_warn_unused inline const SpOp,spop_htrans> ht() const; - arma_warn_unused inline const SpOp,spop_strans> st() const; - - arma_warn_unused inline const SpToDOp,op_sp_as_dense> as_dense() const; - - - protected: - - inline SpSubview_row(const SpMat& in_m, const uword in_row); - inline SpSubview_row(const SpMat& in_m, const uword in_row, const uword in_col1, const uword in_n_cols); - inline SpSubview_row() = delete; - - - private: - - friend class SpMat; - friend class SpSubview; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpSubview_col_list_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpSubview_col_list_bones.hpp deleted file mode 100644 index 85012913f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpSubview_col_list_bones.hpp +++ /dev/null @@ -1,96 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpSubview_col_list -//! @{ - - - -template -class SpSubview_col_list : public SpBase< eT, SpSubview_col_list > - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - const SpMat& m; - const quasi_unwrap U_ci; - - - protected: - - arma_inline SpSubview_col_list(const SpMat& in_m, const Base& in_ci); - - - public: - - inline ~SpSubview_col_list(); - inline SpSubview_col_list() = delete; - - template inline void for_each(functor F); - template inline void for_each(functor F) const; - - template inline void transform(functor F); - - inline void replace(const eT old_val, const eT new_val); - - inline void clean(const pod_type threshold); - - inline void fill(const eT val); - inline void zeros(); - inline void ones(); - - inline void operator+= (const eT val); - inline void operator-= (const eT val); - inline void operator*= (const eT val); - inline void operator/= (const eT val); - - template inline void operator= (const Base& x); - template inline void operator+=(const Base& x); - template inline void operator-=(const Base& x); - template inline void operator%=(const Base& x); - template inline void operator/=(const Base& x); - - inline void operator= (const SpSubview_col_list& x); - template inline void operator= (const SpSubview_col_list& x); - - template inline void operator= (const SpBase& x); - template inline void operator+= (const SpBase& x); - template inline void operator-= (const SpBase& x); - template inline void operator%= (const SpBase& x); - template inline void operator/= (const SpBase& x); - - inline static void extract(SpMat& out, const SpSubview_col_list& in); - - inline static void plus_inplace(SpMat& out, const SpSubview_col_list& in); - inline static void minus_inplace(SpMat& out, const SpSubview_col_list& in); - inline static void schur_inplace(SpMat& out, const SpSubview_col_list& in); - inline static void div_inplace(SpMat& out, const SpSubview_col_list& in); - - - friend class SpMat; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpSubview_col_list_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpSubview_col_list_meat.hpp deleted file mode 100644 index 1a1c397c0..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpSubview_col_list_meat.hpp +++ /dev/null @@ -1,719 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpSubview_col_list -//! @{ - - - -template -inline -SpSubview_col_list::~SpSubview_col_list() - { - arma_debug_sigprint(); - } - - - -template -arma_inline -SpSubview_col_list::SpSubview_col_list - ( - const SpMat& in_m, - const Base& in_ci - ) - : m (in_m ) - , U_ci(in_ci.get_ref()) - { - arma_debug_sigprint(); - - const umat& ci = U_ci.M; - const uword* ci_mem = ci.memptr(); - const uword ci_n_elem = ci.n_elem; - - arma_conform_check - ( - ( (ci.is_vec() == false) && (ci.is_empty() == false) ), - "SpMat::cols(): given object must be a vector" - ); - - for(uword ci_count=0; ci_count < ci_n_elem; ++ci_count) - { - const uword i = ci_mem[ci_count]; - - arma_conform_check_bounds( (i >= in_m.n_cols), "SpMat::cols(): index out of bounds" ); - } - } - - - -//! apply a functor to each element -template -template -inline -void -SpSubview_col_list::for_each(functor F) - { - arma_debug_sigprint(); - - SpMat tmp(*this); - - tmp.for_each(F); - - (*this).operator=(tmp); - } - - - -template -template -inline -void -SpSubview_col_list::for_each(functor F) const - { - arma_debug_sigprint(); - - const SpMat tmp(*this); - - tmp.for_each(F); - } - - - -//! transform each element using a functor -template -template -inline -void -SpSubview_col_list::transform(functor F) - { - arma_debug_sigprint(); - - SpMat tmp(*this); - - tmp.transform(F); - - (*this).operator=(tmp); - } - - - -template -inline -void -SpSubview_col_list::replace(const eT old_val, const eT new_val) - { - arma_debug_sigprint(); - - SpMat tmp(*this); - - tmp.replace(old_val, new_val); - - (*this).operator=(tmp); - } - - - -template -inline -void -SpSubview_col_list::clean(const typename get_pod_type::result threshold) - { - arma_debug_sigprint(); - - SpMat tmp(*this); - - tmp.clean(threshold); - - (*this).operator=(tmp); - } - - - -template -inline -void -SpSubview_col_list::fill(const eT val) - { - arma_debug_sigprint(); - - Mat tmp(m.n_rows, U_ci.M.n_elem, arma_nozeros_indicator()); tmp.fill(val); - - (*this).operator=(tmp); - } - - - -template -inline -void -SpSubview_col_list::zeros() - { - arma_debug_sigprint(); - - SpMat& m_local = const_cast< SpMat& >(m); - - const umat& ci = U_ci.M; - const uword* ci_mem = ci.memptr(); - const uword ci_n_elem = ci.n_elem; - - m_local.sync_csc(); - m_local.invalidate_cache(); - - for(uword ci_count=0; ci_count < ci_n_elem; ++ci_count) - { - const uword i = ci_mem[ci_count]; - - const uword col_n_nonzero = m_local.col_ptrs[i+1] - m_local.col_ptrs[i]; - - uword offset = m_local.col_ptrs[i]; - - for(uword j=0; j < col_n_nonzero; ++j) - { - access::rw(m_local.values[offset]) = eT(0); - - ++offset; - } - } - - m_local.remove_zeros(); - } - - - -template -inline -void -SpSubview_col_list::ones() - { - arma_debug_sigprint(); - - const Mat tmp(m.n_rows, U_ci.M.n_elem, fill::ones); - - (*this).operator=(tmp); - } - - - -template -inline -void -SpSubview_col_list::operator+= (const eT val) - { - arma_debug_sigprint(); - - const SpMat tmp1(*this); - - Mat tmp2(tmp1.n_rows, tmp1.n_cols, arma_nozeros_indicator()); tmp2.fill(val); - - const Mat tmp3 = tmp1 + tmp2; - - (*this).operator=(tmp3); - } - - - -template -inline -void -SpSubview_col_list::operator-= (const eT val) - { - arma_debug_sigprint(); - - const SpMat tmp1(*this); - - Mat tmp2(tmp1.n_rows, tmp1.n_cols, arma_nozeros_indicator()); tmp2.fill(val); - - const Mat tmp3 = tmp1 - tmp2; - - (*this).operator=(tmp3); - } - - - -template -inline -void -SpSubview_col_list::operator*= (const eT val) - { - arma_debug_sigprint(); - - if(val == eT(0)) { (*this).zeros(); return; } - - SpMat& m_local = const_cast< SpMat& >(m); - - const umat& ci = U_ci.M; - const uword* ci_mem = ci.memptr(); - const uword ci_n_elem = ci.n_elem; - - m_local.sync_csc(); - m_local.invalidate_cache(); - - bool has_zero = false; - - for(uword ci_count=0; ci_count < ci_n_elem; ++ci_count) - { - const uword i = ci_mem[ci_count]; - - const uword col_n_nonzero = m_local.col_ptrs[i+1] - m_local.col_ptrs[i]; - - uword offset = m_local.col_ptrs[i]; - - for(uword j=0; j < col_n_nonzero; ++j) - { - eT& m_local_val = access::rw(m_local.values[offset]); - - m_local_val *= val; - - if(m_local_val == eT(0)) { has_zero = true; } - - ++offset; - } - } - - if(has_zero) { m_local.remove_zeros(); } - } - - - -template -inline -void -SpSubview_col_list::operator/= (const eT val) - { - arma_debug_sigprint(); - - const SpMat tmp1(*this); - - Mat tmp2(tmp1.n_rows, tmp1.n_cols, arma_nozeros_indicator()); tmp2.fill(val); - - const SpMat tmp3 = tmp1 / tmp2; - - (*this).operator=(tmp3); - } - - - -template -template -inline -void -SpSubview_col_list::operator= (const Base& x) - { - arma_debug_sigprint(); - - const quasi_unwrap U(x.get_ref()); - const Mat& X = U.M; - - SpMat& m_local = const_cast< SpMat& >(m); - - const umat& ci = U_ci.M; - const uword* ci_mem = ci.memptr(); - const uword ci_n_elem = ci.n_elem; - - arma_conform_assert_same_size( m_local.n_rows, ci_n_elem, X.n_rows, X.n_cols, "SpMat::cols()" ); - - const uword X_n_elem = X.n_elem; - const eT* X_mem = X.memptr(); - - uword X_n_nonzero = 0; - - for(uword i=0; i < X_n_elem; ++i) { X_n_nonzero += (X_mem[i] != eT(0)) ? uword(1) : uword(0); } - - SpMat Y(arma_reserve_indicator(), X.n_rows, m_local.n_cols, X_n_nonzero); - - uword count = 0; - - for(uword ci_count=0; ci_count < ci_n_elem; ++ci_count) - { - const uword i = ci_mem[ci_count]; - - for(uword row=0; row < X.n_rows; ++row) - { - const eT X_val = (*X_mem); ++X_mem; - - if(X_val != eT(0)) - { - access::rw(Y.row_indices[count]) = row; - access::rw(Y.values [count]) = X_val; - ++count; - ++access::rw(Y.col_ptrs[i + 1]); - } - } - } - - // fix the column pointers - for(uword i = 0; i < Y.n_cols; ++i) - { - access::rw(Y.col_ptrs[i+1]) += Y.col_ptrs[i]; - } - - (*this).zeros(); - - SpMat tmp = m_local + Y; - - m_local.steal_mem(tmp); - } - - - -template -template -inline -void -SpSubview_col_list::operator+= (const Base& x) - { - arma_debug_sigprint(); - - const Mat tmp = SpMat(*this) + x.get_ref(); - - (*this).operator=(tmp); - } - - - -template -template -inline -void -SpSubview_col_list::operator-= (const Base& x) - { - arma_debug_sigprint(); - - const Mat tmp = SpMat(*this) - x.get_ref(); - - (*this).operator=(tmp); - } - - - -template -template -inline -void -SpSubview_col_list::operator%= (const Base& x) - { - arma_debug_sigprint(); - - const SpMat tmp = SpMat(*this) % x.get_ref(); - - (*this).operator=(tmp); - } - - - -template -template -inline -void -SpSubview_col_list::operator/= (const Base& x) - { - arma_debug_sigprint(); - - const SpMat tmp = SpMat(*this) / x.get_ref(); - - (*this).operator=(tmp); - } - - - -template -inline -void -SpSubview_col_list::operator= (const SpSubview_col_list& x) - { - arma_debug_sigprint(); - - const SpMat tmp(x); - - (*this).operator=(tmp); - } - - - -template -template -inline -void -SpSubview_col_list::operator= (const SpSubview_col_list& x) - { - arma_debug_sigprint(); - - const SpMat tmp(x); - - (*this).operator=(tmp); - } - - - -template -template -inline -void -SpSubview_col_list::operator= (const SpBase& x) - { - arma_debug_sigprint(); - - const unwrap_spmat U(x.get_ref()); - const SpMat& X = U.M; - - if(U.is_alias(m)) - { - const SpMat tmp(X); - - (*this).operator=(tmp); - - return; - } - - SpMat& m_local = const_cast< SpMat& >(m); - - const umat& ci = U_ci.M; - const uword* ci_mem = ci.memptr(); - const uword ci_n_elem = ci.n_elem; - - arma_conform_assert_same_size( m_local.n_rows, ci_n_elem, X.n_rows, X.n_cols, "SpMat::cols()" ); - - SpMat Y(arma_reserve_indicator(), X.n_rows, m_local.n_cols, X.n_nonzero); - - uword count = 0; - - for(uword ci_count=0; ci_count < ci_n_elem; ++ci_count) - { - const uword i = ci_mem[ci_count]; - - typename SpMat::const_col_iterator X_col_it = X.begin_col(ci_count); - typename SpMat::const_col_iterator X_col_it_end = X.end_col(ci_count); - - while(X_col_it != X_col_it_end) - { - access::rw(Y.row_indices[count]) = X_col_it.row(); - access::rw(Y.values [count]) = (*X_col_it); - ++count; - ++access::rw(Y.col_ptrs[i + 1]); - ++X_col_it; - } - } - - // fix the column pointers - for(uword i = 0; i < Y.n_cols; ++i) - { - access::rw(Y.col_ptrs[i+1]) += Y.col_ptrs[i]; - } - - (*this).zeros(); - - SpMat tmp = m_local + Y; - - m_local.steal_mem(tmp); - } - - - -template -template -inline -void -SpSubview_col_list::operator+= (const SpBase& x) - { - arma_debug_sigprint(); - - const SpMat tmp = SpMat(*this) + x.get_ref(); - - (*this).operator=(tmp); - } - - - -template -template -inline -void -SpSubview_col_list::operator-= (const SpBase& x) - { - arma_debug_sigprint(); - - const SpMat tmp = SpMat(*this) - x.get_ref(); - - (*this).operator=(tmp); - } - - - -template -template -inline -void -SpSubview_col_list::operator%= (const SpBase& x) - { - arma_debug_sigprint(); - - const SpMat tmp = SpMat(*this) % x.get_ref(); - - (*this).operator=(tmp); - } - - - -template -template -inline -void -SpSubview_col_list::operator/= (const SpBase& x) - { - arma_debug_sigprint(); - - SpMat tmp(*this); - - tmp /= x.get_ref(); - - (*this).operator=(tmp); - } - - - -// -// - - - -template -inline -void -SpSubview_col_list::extract(SpMat& out, const SpSubview_col_list& in) - { - arma_debug_sigprint(); - - // NOTE: aliasing is handled by SpMat::operator=(const SpSubview_col_list& in) - - const umat& ci = in.U_ci.M; - const uword* ci_mem = ci.memptr(); - const uword ci_n_elem = ci.n_elem; - - const SpMat& in_m = in.m; - - in_m.sync_csc(); - - uword total_n_nonzero = 0; - - for(uword ci_count=0; ci_count < ci_n_elem; ++ci_count) - { - const uword i = ci_mem[ci_count]; - - const uword col_n_nonzero = in_m.col_ptrs[i+1] - in_m.col_ptrs[i]; - - total_n_nonzero += col_n_nonzero; - } - - out.reserve(in.m.n_rows, ci_n_elem, total_n_nonzero); - - uword out_n_nonzero = 0; - uword out_col_count = 0; - - for(uword ci_count=0; ci_count < ci_n_elem; ++ci_count) - { - const uword i = ci_mem[ci_count]; - - const uword col_n_nonzero = in_m.col_ptrs[i+1] - in_m.col_ptrs[i]; - - uword offset = in_m.col_ptrs[i]; - - for(uword j=0; j < col_n_nonzero; ++j) - { - const eT val = in_m.values [ offset ]; - const uword row = in_m.row_indices[ offset ]; - - ++offset; - - access::rw(out.values [out_n_nonzero]) = val; - access::rw(out.row_indices[out_n_nonzero]) = row; - - access::rw(out.col_ptrs[out_col_count+1])++; - - ++out_n_nonzero; - } - - ++out_col_count; - } - - // fix the column pointers - for(uword i = 0; i < out.n_cols; ++i) - { - access::rw(out.col_ptrs[i+1]) += out.col_ptrs[i]; - } - } - - - -template -inline -void -SpSubview_col_list::plus_inplace(SpMat& out, const SpSubview_col_list& in) - { - arma_debug_sigprint(); - - const SpMat tmp(in); - - out += tmp; - } - - - -template -inline -void -SpSubview_col_list::minus_inplace(SpMat& out, const SpSubview_col_list& in) - { - arma_debug_sigprint(); - - const SpMat tmp(in); - - out -= tmp; - } - - - -template -inline -void -SpSubview_col_list::schur_inplace(SpMat& out, const SpSubview_col_list& in) - { - arma_debug_sigprint(); - - const SpMat tmp(in); - - out %= tmp; - } - - - -template -inline -void -SpSubview_col_list::div_inplace(SpMat& out, const SpSubview_col_list& in) - { - arma_debug_sigprint(); - - const SpMat tmp(in); - - out /= tmp; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpSubview_iterators_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpSubview_iterators_meat.hpp deleted file mode 100644 index d97d7c63d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpSubview_iterators_meat.hpp +++ /dev/null @@ -1,1154 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpSubview -//! @{ - - -/////////////////////////////////////////////////////////////////////////////// -// SpSubview::iterator_base implementation // -/////////////////////////////////////////////////////////////////////////////// - -template -inline -SpSubview::iterator_base::iterator_base(const SpSubview& in_M) - : M(&in_M) - , internal_col(0) - , internal_pos(0) - { - // Technically this iterator is invalid (it may not point to a valid element) - } - - - -template -inline -SpSubview::iterator_base::iterator_base(const SpSubview& in_M, const uword in_col, const uword in_pos) - : M(&in_M) - , internal_col(in_col) - , internal_pos(in_pos) - { - // Nothing to do. - } - - - -/////////////////////////////////////////////////////////////////////////////// -// SpSubview::const_iterator implementation // -/////////////////////////////////////////////////////////////////////////////// - -template -inline -SpSubview::const_iterator::const_iterator(const SpSubview& in_M, const uword initial_pos) - : iterator_base(in_M, 0, initial_pos) - { - // Corner case for empty subviews. - if(in_M.n_nonzero == 0) - { - iterator_base::internal_col = in_M.n_cols; - skip_pos = in_M.m.n_nonzero; - return; - } - - // Figure out the row and column of the position. - // lskip_pos holds the number of values which aren't part of this subview. - const uword aux_col = iterator_base::M->aux_col1; - const uword aux_row = iterator_base::M->aux_row1; - const uword ln_rows = iterator_base::M->n_rows; - const uword ln_cols = iterator_base::M->n_cols; - - uword cur_pos = 0; // off by one because we might be searching for pos 0 - uword lskip_pos = iterator_base::M->m.col_ptrs[aux_col]; - uword cur_col = 0; - - while(cur_pos < (iterator_base::internal_pos + 1)) - { - // Have we stepped forward a column (or multiple columns)? - while(((lskip_pos + cur_pos) >= iterator_base::M->m.col_ptrs[cur_col + aux_col + 1]) && (cur_col < ln_cols)) - { - ++cur_col; - } - - // See if the current position is in the subview. - const uword row_index = iterator_base::M->m.row_indices[cur_pos + lskip_pos]; - if(row_index < aux_row) - { - ++lskip_pos; // not valid - } - else if(row_index < (aux_row + ln_rows)) - { - ++cur_pos; // valid, in the subview - } - else - { - // skip to end of column - const uword next_colptr = iterator_base::M->m.col_ptrs[cur_col + aux_col + 1]; - lskip_pos += (next_colptr - (cur_pos + lskip_pos)); - } - } - - iterator_base::internal_col = cur_col; - skip_pos = lskip_pos; - } - - - -template -inline -SpSubview::const_iterator::const_iterator(const SpSubview& in_M, const uword in_row, const uword in_col) - : iterator_base(in_M, in_col, 0) - { - // Corner case for empty subviews. - if(in_M.n_nonzero == 0) - { - // We must be at the last position. - iterator_base::internal_col = in_M.n_cols; - skip_pos = in_M.m.n_nonzero; - return; - } - - // We have a destination we want to be just after, but don't know what position that is. - // Because we have to count the points in this subview and not in this subview, this becomes a little difficult and slow. - const uword aux_col = iterator_base::M->aux_col1; - const uword aux_row = iterator_base::M->aux_row1; - const uword ln_rows = iterator_base::M->n_rows; - const uword ln_cols = iterator_base::M->n_cols; - - uword cur_pos = 0; - skip_pos = iterator_base::M->m.col_ptrs[aux_col]; - uword cur_col = 0; - - // Skip any empty columns. - while(((skip_pos + cur_pos) >= iterator_base::M->m.col_ptrs[cur_col + aux_col + 1]) && (cur_col < ln_cols)) - { - ++cur_col; - } - - while(cur_col < in_col) - { - // See if the current position is in the subview. - const uword row_index = iterator_base::M->m.row_indices[cur_pos + skip_pos]; - if(row_index < aux_row) - { - ++skip_pos; - } - else if(row_index < (aux_row + ln_rows)) - { - ++cur_pos; - } - else - { - // skip to end of column - const uword next_colptr = iterator_base::M->m.col_ptrs[cur_col + aux_col + 1]; - skip_pos += (next_colptr - (cur_pos + skip_pos)); - } - - // Have we stepped forward a column (or multiple columns)? - while(((skip_pos + cur_pos) >= iterator_base::M->m.col_ptrs[cur_col + aux_col + 1]) && (cur_col < ln_cols)) - { - ++cur_col; - } - } - - // Now we are either on the right column or ahead of it. - if(cur_col == in_col) - { - // We have to find the right row index. - uword row_index = iterator_base::M->m.row_indices[cur_pos + skip_pos]; - while((row_index < (in_row + aux_row))) - { - if(row_index < aux_row) - { - ++skip_pos; - } - else - { - ++cur_pos; - } - - // Ensure we didn't step forward a column; if we did, we need to stop. - while(((skip_pos + cur_pos) >= iterator_base::M->m.col_ptrs[cur_col + aux_col + 1]) && (cur_col < ln_cols)) - { - ++cur_col; - } - - if(cur_col != in_col) - { - break; - } - - row_index = iterator_base::M->m.row_indices[cur_pos + skip_pos]; - } - } - - // Now we need to find the next valid position in the subview. - uword row_index; - while(true) - { - const uword next_colptr = iterator_base::M->m.col_ptrs[cur_col + aux_col + 1]; - row_index = iterator_base::M->m.row_indices[cur_pos + skip_pos]; - - // Are we at the last position? - if(cur_col >= ln_cols) - { - cur_col = ln_cols; - // Make sure we will be pointing at the last element in the parent matrix. - skip_pos = iterator_base::M->m.n_nonzero - iterator_base::M->n_nonzero; - break; - } - - if(row_index < aux_row) - { - ++skip_pos; - } - else if(row_index < (aux_row + ln_rows)) - { - break; // found - } - else - { - skip_pos += (next_colptr - (cur_pos + skip_pos)); - } - - // Did we move any columns? - while(((skip_pos + cur_pos) >= iterator_base::M->m.col_ptrs[cur_col + aux_col + 1]) && (cur_col < ln_cols)) - { - ++cur_col; - } - } - - // It is possible we have moved another column. - while(((skip_pos + cur_pos) >= iterator_base::M->m.col_ptrs[cur_col + aux_col + 1]) && (cur_col < ln_cols)) - { - ++cur_col; - } - - iterator_base::internal_pos = cur_pos; - iterator_base::internal_col = cur_col; - } - - - -template -inline -SpSubview::const_iterator::const_iterator(const SpSubview& in_M, uword in_row, uword in_col, uword in_pos, uword in_skip_pos) - : iterator_base(in_M, in_col, in_pos) - , skip_pos(in_skip_pos) - { - arma_ignore(in_row); - - // Nothing to do. - } - - - -template -inline -SpSubview::const_iterator::const_iterator(const const_iterator& other) - : iterator_base(*other.M, other.internal_col, other.internal_pos) - , skip_pos(other.skip_pos) - { - // Nothing to do. - } - - - -template -arma_inline -eT -SpSubview::const_iterator::operator*() const - { - return iterator_base::M->m.values[iterator_base::internal_pos + skip_pos]; - } - - - -template -inline -typename SpSubview::const_iterator& -SpSubview::const_iterator::operator++() - { - const uword aux_col = iterator_base::M->aux_col1; - const uword aux_row = iterator_base::M->aux_row1; - const uword ln_rows = iterator_base::M->n_rows; - const uword ln_cols = iterator_base::M->n_cols; - - uword cur_col = iterator_base::internal_col; - uword cur_pos = iterator_base::internal_pos + 1; - uword lskip_pos = skip_pos; - uword row_index; - - while(true) - { - const uword next_colptr = iterator_base::M->m.col_ptrs[cur_col + aux_col + 1]; - row_index = iterator_base::M->m.row_indices[cur_pos + lskip_pos]; - - // Did we move any columns? - while((cur_col < ln_cols) && ((lskip_pos + cur_pos) >= iterator_base::M->m.col_ptrs[cur_col + aux_col + 1])) - { - ++cur_col; - } - - // Are we at the last position? - if(cur_col >= ln_cols) - { - cur_col = ln_cols; - // Make sure we will be pointing at the last element in the parent matrix. - lskip_pos = iterator_base::M->m.n_nonzero - iterator_base::M->n_nonzero; - break; - } - - if(row_index < aux_row) - { - ++lskip_pos; - } - else if(row_index < (aux_row + ln_rows)) - { - break; // found - } - else - { - lskip_pos += (next_colptr - (cur_pos + lskip_pos)); - } - } - - iterator_base::internal_pos = cur_pos; - iterator_base::internal_col = cur_col; - skip_pos = lskip_pos; - - return *this; - } - - - -template -inline -typename SpSubview::const_iterator -SpSubview::const_iterator::operator++(int) - { - typename SpSubview::const_iterator tmp(*this); - - ++(*this); - - return tmp; - } - - - -template -inline -typename SpSubview::const_iterator& -SpSubview::const_iterator::operator--() - { - const uword aux_col = iterator_base::M->aux_col1; - const uword aux_row = iterator_base::M->aux_row1; - const uword ln_rows = iterator_base::M->n_rows; - - uword cur_col = iterator_base::internal_col; - uword cur_pos = iterator_base::internal_pos - 1; - - // Special condition for end of iterator. - if((skip_pos + cur_pos + 1) == iterator_base::M->m.n_nonzero) - { - // We are at the last element. So we need to set skip_pos back to what it - // would be if we didn't manually modify it back in operator++(). - skip_pos = iterator_base::M->m.col_ptrs[cur_col + aux_col] - iterator_base::internal_pos; - } - - uword row_index; - - while(true) - { - const uword colptr = iterator_base::M->m.col_ptrs[cur_col + aux_col]; - row_index = iterator_base::M->m.row_indices[cur_pos + skip_pos]; - - // Did we move back any columns? - while((skip_pos + cur_pos) < iterator_base::M->m.col_ptrs[cur_col + aux_col]) - { - --cur_col; - } - - if(row_index < aux_row) - { - skip_pos -= (colptr - (cur_pos + skip_pos) + 1); - } - else if(row_index < (aux_row + ln_rows)) - { - break; // found - } - else - { - --skip_pos; - } - } - - iterator_base::internal_pos = cur_pos; - iterator_base::internal_col = cur_col; - - return *this; - } - - - -template -inline -typename SpSubview::const_iterator -SpSubview::const_iterator::operator--(int) - { - typename SpSubview::const_iterator tmp(*this); - - --(*this); - - return tmp; - } - - - -template -inline -bool -SpSubview::const_iterator::operator==(const const_iterator& rhs) const - { - return (rhs.row() == (*this).row()) && (rhs.col() == iterator_base::internal_col); - } - - - -template -inline -bool -SpSubview::const_iterator::operator!=(const const_iterator& rhs) const - { - return (rhs.row() != (*this).row()) || (rhs.col() != iterator_base::internal_col); - } - - - -template -inline -bool -SpSubview::const_iterator::operator==(const typename SpMat::const_iterator& rhs) const - { - return (rhs.row() == (*this).row()) && (rhs.col() == iterator_base::internal_col); - } - - - -template -inline -bool -SpSubview::const_iterator::operator!=(const typename SpMat::const_iterator& rhs) const - { - return (rhs.row() != (*this).row()) || (rhs.col() != iterator_base::internal_col); - } - - - -template -inline -bool -SpSubview::const_iterator::operator==(const const_row_iterator& rhs) const - { - return (rhs.row() == (*this).row()) && (rhs.col() == iterator_base::internal_col); - } - - - -template -inline -bool -SpSubview::const_iterator::operator!=(const const_row_iterator& rhs) const - { - return (rhs.row() != (*this).row()) || (rhs.col() != iterator_base::internal_col); - } - - - -template -inline -bool -SpSubview::const_iterator::operator==(const typename SpMat::const_row_iterator& rhs) const - { - return (rhs.row() == (*this).row()) && (rhs.col() == iterator_base::internal_col); - } - - - -template -inline -bool -SpSubview::const_iterator::operator!=(const typename SpMat::const_row_iterator& rhs) const - { - return (rhs.row() != (*this).row()) || (rhs.col() != iterator_base::internal_col); - } - - - -/////////////////////////////////////////////////////////////////////////////// -// SpSubview::iterator implementation // -/////////////////////////////////////////////////////////////////////////////// - -template -inline -SpValProxy< SpSubview > -SpSubview::iterator::operator*() - { - return SpValProxy< SpSubview >( - const_iterator::row(), - iterator_base::col(), - access::rw(*iterator_base::M), - &(access::rw(iterator_base::M->m.values[iterator_base::internal_pos + const_iterator::skip_pos]))); - } - - - -template -inline -typename SpSubview::iterator& -SpSubview::iterator::operator++() - { - const_iterator::operator++(); - return *this; - } - - - -template -inline -typename SpSubview::iterator -SpSubview::iterator::operator++(int) - { - typename SpSubview::iterator tmp(*this); - - const_iterator::operator++(); - - return tmp; - } - - - -template -inline -typename SpSubview::iterator& -SpSubview::iterator::operator--() - { - const_iterator::operator--(); - return *this; - } - - - -template -inline -typename SpSubview::iterator -SpSubview::iterator::operator--(int) - { - typename SpSubview::iterator tmp(*this); - - const_iterator::operator--(); - - return tmp; - } - - - -/////////////////////////////////////////////////////////////////////////////// -// SpSubview::const_row_iterator implementation // -/////////////////////////////////////////////////////////////////////////////// - -template -inline -SpSubview::const_row_iterator::const_row_iterator() - : iterator_base() - , internal_row(0) - , actual_pos(0) - { - } - - - -template -inline -SpSubview::const_row_iterator::const_row_iterator(const SpSubview& in_M, uword initial_pos) - : iterator_base(in_M, 0, initial_pos) - , internal_row(0) - , actual_pos(0) - { - // Corner case for the end of a subview. - if(initial_pos == in_M.n_nonzero) - { - iterator_base::internal_col = 0; - internal_row = in_M.n_rows; - return; - } - - const uword aux_col = iterator_base::M->aux_col1; - const uword aux_row = iterator_base::M->aux_row1; - - // We don't count zeros in our position count, so we have to find the nonzero - // value corresponding to the given initial position, and we also have to skip - // any nonzero elements that aren't a part of the subview. - - uword cur_pos = std::numeric_limits::max(); - uword cur_actual_pos = 0; - - // Since we don't know where the elements are in each row, we have to loop - // across all columns looking for elements in row 0 and add to our sum, then - // in row 1, and so forth, until we get to the desired position. - for(uword row = 0; row < iterator_base::M->n_rows; ++row) - { - for(uword col = 0; col < iterator_base::M->n_cols; ++col) - { - // Find the first element with row greater than or equal to row + aux_row. - const uword col_offset = iterator_base::M->m.col_ptrs[col + aux_col ]; - const uword next_col_offset = iterator_base::M->m.col_ptrs[col + aux_col + 1]; - - const uword* start_ptr = &iterator_base::M->m.row_indices[ col_offset]; - const uword* end_ptr = &iterator_base::M->m.row_indices[next_col_offset]; - - if(start_ptr != end_ptr) - { - const uword* pos_ptr = std::lower_bound(start_ptr, end_ptr, row + aux_row); - - const uword offset = uword(pos_ptr - start_ptr); - - if(iterator_base::M->m.row_indices[col_offset + offset] == row + aux_row) - { - cur_actual_pos = col_offset + offset; - - // Increment position portably. - if(cur_pos == std::numeric_limits::max()) - cur_pos = 0; - else - ++cur_pos; - - // Do we terminate? - if(cur_pos == initial_pos) - { - internal_row = row; - iterator_base::internal_col = col; - iterator_base::internal_pos = cur_pos; - actual_pos = cur_actual_pos; - - return; - } - } - } - } - } - - // This shouldn't happen. - iterator_base::internal_pos = iterator_base::M->n_nonzero; - iterator_base::internal_col = 0; - internal_row = iterator_base::M->n_rows; - actual_pos = iterator_base::M->n_nonzero; - } - - - -template -inline -SpSubview::const_row_iterator::const_row_iterator(const SpSubview& in_M, uword in_row, uword in_col) - : iterator_base(in_M, in_col, 0) - , internal_row(0) - , actual_pos(0) - { - // Start our search in the given row. We need to find two things: - // - // 1. The first nonzero element (iterating by rows) after (in_row, in_col). - // 2. The number of nonzero elements (iterating by rows) that come before - // (in_row, in_col). - // - // We'll find these simultaneously, though we will have to loop over all - // columns. - - const uword aux_col = iterator_base::M->aux_col1; - const uword aux_row = iterator_base::M->aux_row1; - - // This will hold the total number of points in the subview with rows less - // than in_row. - uword cur_pos = 0; - uword cur_min_row = iterator_base::M->n_rows; - uword cur_min_col = 0; - uword cur_actual_pos = 0; - - for(uword col = 0; col < iterator_base::M->n_cols; ++col) - { - // Find the first element with row greater than or equal to in_row. - const uword col_offset = iterator_base::M->m.col_ptrs[col + aux_col ]; - const uword next_col_offset = iterator_base::M->m.col_ptrs[col + aux_col + 1]; - - const uword* start_ptr = &iterator_base::M->m.row_indices[ col_offset]; - const uword* end_ptr = &iterator_base::M->m.row_indices[next_col_offset]; - - if(start_ptr != end_ptr) - { - // First let us find the first element that is in the subview. - const uword* first_subview_ptr = std::lower_bound(start_ptr, end_ptr, aux_row); - - if(first_subview_ptr != end_ptr && (*first_subview_ptr) < aux_row + iterator_base::M->n_rows) - { - // There exists at least one element in the subview. - const uword* pos_ptr = std::lower_bound(first_subview_ptr, end_ptr, aux_row + in_row); - - // This is the number of elements in the subview with row index less - // than in_row. - cur_pos += uword(pos_ptr - first_subview_ptr); - - if(pos_ptr != end_ptr && (*pos_ptr) < aux_row + iterator_base::M->n_rows) - { - // This is the row index of the first element in the column with row - // index greater than or equal to in_row + aux_row. - if((*pos_ptr) - aux_row < cur_min_row) - { - // If we are in the desired row but before the desired column, we - // can't take this. - if(col >= in_col) - { - cur_min_row = (*pos_ptr) - aux_row; - cur_min_col = col; - cur_actual_pos = col_offset + (pos_ptr - start_ptr); - } - } - } - } - } - } - - // Now we know what the minimum row is. - internal_row = cur_min_row; - iterator_base::internal_col = cur_min_col; - iterator_base::internal_pos = cur_pos; - actual_pos = cur_actual_pos; - } - - - -template -inline -SpSubview::const_row_iterator::const_row_iterator(const const_row_iterator& other) - : iterator_base(*other.M, other.internal_col, other.internal_pos) - , internal_row(other.internal_row) - , actual_pos(other.actual_pos) - { - // Nothing to do. - } - - - -template -inline -typename SpSubview::const_row_iterator& -SpSubview::const_row_iterator::operator++() - { - // We just need to find the next nonzero element. - ++iterator_base::internal_pos; - - // If we have exceeded the bounds, update accordingly. - if(iterator_base::internal_pos >= iterator_base::M->n_nonzero) - { - internal_row = iterator_base::M->n_rows; - iterator_base::internal_col = 0; - actual_pos = iterator_base::M->n_nonzero; - - return *this; - } - - const uword aux_col = iterator_base::M->aux_col1; - const uword aux_row = iterator_base::M->aux_row1; - const uword M_n_cols = iterator_base::M->n_cols; - - // Otherwise, we need to search. We have to loop over all of the columns in - // the subview. - uword next_min_row = iterator_base::M->n_rows; - uword next_min_col = 0; - uword next_actual_pos = 0; - - for(uword col = iterator_base::internal_col + 1; col < M_n_cols; ++col) - { - // Find the first element with row greater than or equal to row. - const uword col_offset = iterator_base::M->m.col_ptrs[col + aux_col ]; - const uword next_col_offset = iterator_base::M->m.col_ptrs[col + aux_col + 1]; - - const uword* start_ptr = &iterator_base::M->m.row_indices[ col_offset]; - const uword* end_ptr = &iterator_base::M->m.row_indices[next_col_offset]; - - if(start_ptr != end_ptr) - { - // Find the first element in the column with row greater than or equal to - // the current row. Since this is a subview, it's possible that we may - // find rows past the end of the subview. - const uword* pos_ptr = std::lower_bound(start_ptr, end_ptr, internal_row + aux_row); - - if(pos_ptr != end_ptr) - { - // We found something; is the row index correct? - if((*pos_ptr) == internal_row + aux_row && (*pos_ptr) < aux_row + iterator_base::M->n_rows) - { - // Exact match---so we are done. - iterator_base::internal_col = col; - actual_pos = col_offset + (pos_ptr - start_ptr); - return *this; - } - else if((*pos_ptr) < next_min_row + aux_row && (*pos_ptr) < aux_row + iterator_base::M->n_rows) - { - // The first element in this column is in a subsequent row, but it's - // the minimum row we've seen so far. - next_min_row = (*pos_ptr) - aux_row; - next_min_col = col; - next_actual_pos = col_offset + (pos_ptr - start_ptr); - } - else if((*pos_ptr) == next_min_row + aux_row && col < next_min_col && (*pos_ptr) < aux_row + iterator_base::M->n_rows) - { - // The first element in this column is in a subsequent row that we - // already have another elemnt for, but the column index is less so - // this element will come first. - next_min_col = col; - next_actual_pos = col_offset + (pos_ptr - start_ptr); - } - } - } - } - - // Restart the search in the next row. - for(uword col = 0; col <= iterator_base::internal_col; ++col) - { - // Find the first element with row greater than or equal to row + 1. - const uword col_offset = iterator_base::M->m.col_ptrs[col + aux_col ]; - const uword next_col_offset = iterator_base::M->m.col_ptrs[col + aux_col + 1]; - - const uword* start_ptr = &iterator_base::M->m.row_indices[ col_offset]; - const uword* end_ptr = &iterator_base::M->m.row_indices[next_col_offset]; - - if(start_ptr != end_ptr) - { - const uword* pos_ptr = std::lower_bound(start_ptr, end_ptr, internal_row + aux_row + 1); - - if(pos_ptr != end_ptr) - { - // We found something in the column, but is the row index correct? - if((*pos_ptr) == internal_row + aux_row + 1 && (*pos_ptr) < aux_row + iterator_base::M->n_rows) - { - // Exact match---so we are done. - iterator_base::internal_col = col; - internal_row++; - actual_pos = col_offset + (pos_ptr - start_ptr); - return *this; - } - else if((*pos_ptr) < next_min_row + aux_row && (*pos_ptr) < aux_row + iterator_base::M->n_rows) - { - // The first element in this column is in a subsequent row, but it's - // the minimum row we've seen so far. - next_min_row = (*pos_ptr) - aux_row; - next_min_col = col; - next_actual_pos = col_offset + (pos_ptr - start_ptr); - } - else if((*pos_ptr) == next_min_row + aux_row && col < next_min_col && (*pos_ptr) < aux_row + iterator_base::M->n_rows) - { - // We've found a better column. - next_min_col = col; - next_actual_pos = col_offset + (pos_ptr - start_ptr); - } - } - } - } - - iterator_base::internal_col = next_min_col; - internal_row = next_min_row; - actual_pos = next_actual_pos; - - return *this; - } - - - -template -inline -typename SpSubview::const_row_iterator -SpSubview::const_row_iterator::operator++(int) - { - typename SpSubview::const_row_iterator tmp(*this); - - ++(*this); - - return tmp; - } - - - -template -inline -typename SpSubview::const_row_iterator& -SpSubview::const_row_iterator::operator--() - { - if(iterator_base::internal_pos == 0) - { - // We are already at the beginning. - return *this; - } - - iterator_base::internal_pos--; - - const uword aux_col = iterator_base::M->aux_col1; - const uword aux_row = iterator_base::M->aux_row1; - - // We have to search backwards. - uword max_row = 0; - uword max_col = 0; - uword next_actual_pos = 0; - - for(uword col = iterator_base::internal_col; col >= 1; --col) - { - // Find the first element with row greater than or equal to in_row + 1. - const uword col_offset = iterator_base::M->m.col_ptrs[col + aux_col - 1]; - const uword next_col_offset = iterator_base::M->m.col_ptrs[col + aux_col ]; - - const uword* start_ptr = &iterator_base::M->m.row_indices[ col_offset]; - const uword* end_ptr = &iterator_base::M->m.row_indices[next_col_offset]; - - if(start_ptr != end_ptr) - { - // There are elements in this column. - const uword* pos_ptr = std::lower_bound(start_ptr, end_ptr, internal_row + aux_row + 1); - - if(pos_ptr != start_ptr) - { - if(*(pos_ptr - 1) > max_row + aux_row) - { - // There are elements in this column with row index < internal_row. - max_row = *(pos_ptr - 1) - aux_row; - max_col = col - 1; - next_actual_pos = col_offset + (pos_ptr - 1 - start_ptr); - } - else if(*(pos_ptr - 1) == max_row + aux_row && (col - 1) >= max_col) - { - max_col = col - 1; - next_actual_pos = col_offset + (pos_ptr - 1 - start_ptr); - } - } - } - } - - for(uword col = iterator_base::M->n_cols - 1; col >= iterator_base::internal_col; --col) - { - // Find the first element with row greater than or equal to row + 1. - const uword col_offset = iterator_base::M->m.col_ptrs[col + aux_col ]; - const uword next_col_offset = iterator_base::M->m.col_ptrs[col + aux_col + 1]; - - const uword* start_ptr = &iterator_base::M->m.row_indices[ col_offset]; - const uword* end_ptr = &iterator_base::M->m.row_indices[next_col_offset]; - - if(start_ptr != end_ptr) - { - // There are elements in this column. - const uword* pos_ptr = std::lower_bound(start_ptr, end_ptr, internal_row + aux_row); - - if(pos_ptr != start_ptr) - { - // There are elements in this column with row index < internal_row. - if(*(pos_ptr - 1) > max_row + aux_row) - { - max_row = *(pos_ptr - 1) - aux_row; - max_col = col; - next_actual_pos = col_offset + (pos_ptr - 1 - start_ptr); - } - else if(*(pos_ptr - 1) == max_row + aux_row && col >= max_col) - { - max_col = col; - next_actual_pos = col_offset + (pos_ptr - 1 - start_ptr); - } - } - } - - if(col == 0) // Catch edge case that the loop termination condition won't. - { - break; - } - } - - iterator_base::internal_col = max_col; - internal_row = max_row; - actual_pos = next_actual_pos; - - return *this; - } - - - -template -inline -typename SpSubview::const_row_iterator -SpSubview::const_row_iterator::operator--(int) - { - typename SpSubview::const_row_iterator tmp(*this); - - --(*this); - - return tmp; - } - - - -template -inline -bool -SpSubview::const_row_iterator::operator==(const const_iterator& rhs) const - { - return (rhs.row() == row()) && (rhs.col() == iterator_base::internal_col); - } - - - -template -inline -bool -SpSubview::const_row_iterator::operator!=(const const_iterator& rhs) const - { - return (rhs.row() != row()) || (rhs.col() != iterator_base::internal_col); - } - - - -template -inline -bool -SpSubview::const_row_iterator::operator==(const typename SpMat::const_iterator& rhs) const - { - return (rhs.row() == row()) && (rhs.col() == iterator_base::internal_col); - } - - - -template -inline -bool -SpSubview::const_row_iterator::operator!=(const typename SpMat::const_iterator& rhs) const - { - return (rhs.row() != row()) || (rhs.col() != iterator_base::internal_col); - } - - - -template -inline -bool -SpSubview::const_row_iterator::operator==(const const_row_iterator& rhs) const - { - return (rhs.row() == row()) && (rhs.col() == iterator_base::internal_col); - } - - - -template -inline -bool -SpSubview::const_row_iterator::operator!=(const const_row_iterator& rhs) const - { - return (rhs.row() != row()) || (rhs.col() != iterator_base::internal_col); - } - - - -template -inline -bool -SpSubview::const_row_iterator::operator==(const typename SpMat::const_row_iterator& rhs) const - { - return (rhs.row() == row()) && (rhs.col() == iterator_base::internal_col); - } - - - -template -inline -bool -SpSubview::const_row_iterator::operator!=(const typename SpMat::const_row_iterator& rhs) const - { - return (rhs.row() != row()) || (rhs.col() != iterator_base::internal_col); - } - - - -/////////////////////////////////////////////////////////////////////////////// -// SpSubview::row_iterator implementation // -/////////////////////////////////////////////////////////////////////////////// - -template -inline -SpValProxy< SpSubview > -SpSubview::row_iterator::operator*() - { - return SpValProxy< SpSubview >( - const_row_iterator::internal_row, - iterator_base::internal_col, - access::rw(*iterator_base::M), - &access::rw(iterator_base::M->m.values[const_row_iterator::actual_pos])); - } - - - -template -inline -typename SpSubview::row_iterator& -SpSubview::row_iterator::operator++() - { - const_row_iterator::operator++(); - return *this; - } - - - -template -inline -typename SpSubview::row_iterator -SpSubview::row_iterator::operator++(int) - { - typename SpSubview::row_iterator tmp(*this); - - ++(*this); - - return tmp; - } - - - -template -inline -typename SpSubview::row_iterator& -SpSubview::row_iterator::operator--() - { - const_row_iterator::operator--(); - return *this; - } - - - -template -inline -typename SpSubview::row_iterator -SpSubview::row_iterator::operator--(int) - { - typename SpSubview::row_iterator tmp(*this); - - --(*this); - - return tmp; - } - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpSubview_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpSubview_meat.hpp deleted file mode 100644 index 757be6539..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpSubview_meat.hpp +++ /dev/null @@ -1,2036 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpSubview -//! @{ - - -template -inline -SpSubview::~SpSubview() - { - arma_debug_sigprint_this(this); - } - - - -template -inline -SpSubview::SpSubview(const SpMat& in_m, const uword in_row1, const uword in_col1, const uword in_n_rows, const uword in_n_cols) - : m(in_m) - , aux_row1(in_row1) - , aux_col1(in_col1) - , n_rows(in_n_rows) - , n_cols(in_n_cols) - , n_elem(in_n_rows * in_n_cols) - , n_nonzero(0) - { - arma_debug_sigprint_this(this); - - m.sync_csc(); - - // count the number of non-zeros in the subview - uword count = 0; - - if(n_rows == m.n_rows) - { - count = m.col_ptrs[aux_col1 + n_cols] - m.col_ptrs[aux_col1]; - } - else - { - arma_debug_print("counting non-zeros in sparse subview"); - - uword lend = m.col_ptrs[in_col1 + in_n_cols]; - uword lend_row = in_row1 + in_n_rows; - - for(uword i = m.col_ptrs[in_col1]; i < lend; ++i) - { - const uword m_row_indices_i = m.row_indices[i]; - - const bool condition = (m_row_indices_i >= in_row1) && (m_row_indices_i < lend_row); - - count += condition ? uword(1) : uword(0); - } - } - - access::rw(n_nonzero) = count; - } - - - -template -inline -SpSubview::SpSubview(const SpSubview& in) - : m (in.m ) - , aux_row1 (in.aux_row1 ) - , aux_col1 (in.aux_col1 ) - , n_rows (in.n_rows ) - , n_cols (in.n_cols ) - , n_elem (in.n_elem ) - , n_nonzero(in.n_nonzero) - { - arma_debug_sigprint(arma_str::format("this: %x; in: %x") % this % &in); - } - - - -template -inline -SpSubview::SpSubview(SpSubview&& in) - : m (in.m ) - , aux_row1 (in.aux_row1 ) - , aux_col1 (in.aux_col1 ) - , n_rows (in.n_rows ) - , n_cols (in.n_cols ) - , n_elem (in.n_elem ) - , n_nonzero(in.n_nonzero) - { - arma_debug_sigprint(arma_str::format("this: %x; in: %x") % this % &in); - - // for paranoia - - access::rw(in.aux_row1 ) = 0; - access::rw(in.aux_col1 ) = 0; - access::rw(in.n_rows ) = 0; - access::rw(in.n_cols ) = 0; - access::rw(in.n_elem ) = 0; - access::rw(in.n_nonzero) = 0; - } - - - -template -inline -const SpSubview& -SpSubview::operator+=(const eT val) - { - arma_debug_sigprint(); - - if(val == eT(0)) { return *this; } - - Mat tmp( (*this).n_rows, (*this).n_cols, arma_nozeros_indicator() ); - - tmp.fill(val); - - return (*this).operator=( (*this) + tmp ); - } - - - -template -inline -const SpSubview& -SpSubview::operator-=(const eT val) - { - arma_debug_sigprint(); - - if(val == eT(0)) { return *this; } - - Mat tmp( (*this).n_rows, (*this).n_cols, arma_nozeros_indicator() ); - - tmp.fill(val); - - return (*this).operator=( (*this) - tmp ); - } - - - -template -inline -const SpSubview& -SpSubview::operator*=(const eT val) - { - arma_debug_sigprint(); - - if(val == eT(0)) { (*this).zeros(); return *this; } - - if((n_elem == 0) || (n_nonzero == 0)) { return *this; } - - m.sync_csc(); - m.invalidate_cache(); - - const uword lstart_row = aux_row1; - const uword lend_row = aux_row1 + n_rows; - - const uword lstart_col = aux_col1; - const uword lend_col = aux_col1 + n_cols; - - const uword* m_row_indices = m.row_indices; - eT* m_values = access::rwp(m.values); - - bool has_zero = false; - - for(uword c = lstart_col; c < lend_col; ++c) - { - const uword r_start = m.col_ptrs[c ]; - const uword r_end = m.col_ptrs[c + 1]; - - for(uword r = r_start; r < r_end; ++r) - { - const uword m_row_indices_r = m_row_indices[r]; - - if( (m_row_indices_r >= lstart_row) && (m_row_indices_r < lend_row) ) - { - eT& m_values_r = m_values[r]; - - m_values_r *= val; - - if(m_values_r == eT(0)) { has_zero = true; } - } - } - } - - if(has_zero) - { - const uword old_m_n_nonzero = m.n_nonzero; - - access::rw(m).remove_zeros(); - - if(m.n_nonzero != old_m_n_nonzero) - { - access::rw(n_nonzero) = n_nonzero - (old_m_n_nonzero - m.n_nonzero); - } - } - - return *this; - } - - - -template -inline -const SpSubview& -SpSubview::operator/=(const eT val) - { - arma_debug_sigprint(); - - arma_conform_check( (val == eT(0)), "element-wise division: division by zero" ); - - m.sync_csc(); - m.invalidate_cache(); - - const uword lstart_row = aux_row1; - const uword lend_row = aux_row1 + n_rows; - - const uword lstart_col = aux_col1; - const uword lend_col = aux_col1 + n_cols; - - const uword* m_row_indices = m.row_indices; - eT* m_values = access::rwp(m.values); - - bool has_zero = false; - - for(uword c = lstart_col; c < lend_col; ++c) - { - const uword r_start = m.col_ptrs[c ]; - const uword r_end = m.col_ptrs[c + 1]; - - for(uword r = r_start; r < r_end; ++r) - { - const uword m_row_indices_r = m_row_indices[r]; - - if( (m_row_indices_r >= lstart_row) && (m_row_indices_r < lend_row) ) - { - eT& m_values_r = m_values[r]; - - m_values_r /= val; - - if(m_values_r == eT(0)) { has_zero = true; } - } - } - } - - if(has_zero) - { - const uword old_m_n_nonzero = m.n_nonzero; - - access::rw(m).remove_zeros(); - - if(m.n_nonzero != old_m_n_nonzero) - { - access::rw(n_nonzero) = n_nonzero - (old_m_n_nonzero - m.n_nonzero); - } - } - - return *this; - } - - - -template -template -inline -const SpSubview& -SpSubview::operator=(const Base& in) - { - arma_debug_sigprint(); - - if(is_same_type< T1, Gen, gen_zeros> >::yes) - { - const Proxy P(in.get_ref()); - - arma_conform_assert_same_size(n_rows, n_cols, P.get_n_rows(), P.get_n_cols(), "insertion into sparse submatrix"); - - (*this).zeros(); - - return *this; - } - - if(is_same_type< T1, Gen, gen_eye> >::yes) - { - const Proxy P(in.get_ref()); - - arma_conform_assert_same_size(n_rows, n_cols, P.get_n_rows(), P.get_n_cols(), "insertion into sparse submatrix"); - - (*this).eye(); - - return *this; - } - - const quasi_unwrap U(in.get_ref()); - - arma_conform_assert_same_size(n_rows, n_cols, U.M.n_rows, U.M.n_cols, "insertion into sparse submatrix"); - - spglue_merge::subview_merge(*this, U.M); - - return *this; - } - - - -template -template -inline -const SpSubview& -SpSubview::operator+=(const Base& x) - { - arma_debug_sigprint(); - - return (*this).operator=( (*this) + x.get_ref() ); - } - - - -template -template -inline -const SpSubview& -SpSubview::operator-=(const Base& x) - { - arma_debug_sigprint(); - - return (*this).operator=( (*this) - x.get_ref() ); - } - - - -template -template -inline -const SpSubview& -SpSubview::operator*=(const Base& x) - { - arma_debug_sigprint(); - - SpMat tmp(*this); - - tmp *= x.get_ref(); - - return (*this).operator=(tmp); - } - - - -template -template -inline -const SpSubview& -SpSubview::operator%=(const Base& x) - { - arma_debug_sigprint(); - - SpSubview& sv = (*this); - - const quasi_unwrap U(x.get_ref()); - const Mat& B = U.M; - - arma_conform_assert_same_size(sv.n_rows, sv.n_cols, B.n_rows, B.n_cols, "element-wise multiplication"); - - SpMat& sv_m = access::rw(sv.m); - - sv_m.sync_csc(); - sv_m.invalidate_cache(); - - const uword m_row_start = sv.aux_row1; - const uword m_row_end = sv.aux_row1 + sv.n_rows - 1; - - const uword m_col_start = sv.aux_col1; - const uword m_col_end = sv.aux_col1 + sv.n_cols - 1; - - constexpr eT zero = eT(0); - - bool has_zero = false; - uword count = 0; - - for(uword m_col = m_col_start; m_col <= m_col_end; ++m_col) - { - const uword sv_col = m_col - m_col_start; - - const uword index_start = sv_m.col_ptrs[m_col ]; - const uword index_end = sv_m.col_ptrs[m_col + 1]; - - for(uword i=index_start; i < index_end; ++i) - { - const uword m_row = sv_m.row_indices[i]; - - if(m_row < m_row_start) { continue; } - if(m_row > m_row_end ) { break; } - - const uword sv_row = m_row - m_row_start; - - eT& m_val = access::rw(sv_m.values[i]); - - const eT result = m_val * B.at(sv_row, sv_col); - - m_val = result; - - if(result == zero) { has_zero = true; } else { ++count; } - } - } - - if(has_zero) { sv_m.remove_zeros(); } - - access::rw(sv.n_nonzero) = count; - - return (*this); - } - - - -template -template -inline -const SpSubview& -SpSubview::operator/=(const Base& x) - { - arma_debug_sigprint(); - - const SpSubview& A = (*this); - - const quasi_unwrap U(x.get_ref()); - const Mat& B = U.M; - - arma_conform_assert_same_size(A.n_rows, A.n_cols, B.n_rows, B.n_cols, "element-wise division"); - - bool result_ok = true; - - constexpr eT zero = eT(0); - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - for(uword c=0; c < B_n_cols; ++c) - { - for(uword r=0; r < B_n_rows; ++r) - { - // a zero in B and A at the same location implies the division result is NaN; - // hence a zero in A (not stored) needs to be changed into a non-zero - - // for efficiency, an element in B is checked before checking the corresponding element in A - - if((B.at(r,c) == zero) && (A.at(r,c) == zero)) { result_ok = false; break; } - } - - if(result_ok == false) { break; } - } - - if(result_ok) - { - const_iterator cit = A.begin(); - const_iterator cit_end = A.end(); - - while(cit != cit_end) - { - const eT tmp = (*cit) / B.at(cit.row(), cit.col()); - - if(tmp == zero) { result_ok = false; break; } - - ++cit; - } - } - - if(result_ok) - { - iterator it = (*this).begin(); - iterator it_end = (*this).end(); - - while(it != it_end) - { - (*it) /= B.at(it.row(), it.col()); - - ++it; - } - } - else - { - (*this).operator=( (*this) / B ); - } - - return (*this); - } - - - -template -inline -const SpSubview& -SpSubview::operator=(const SpSubview& x) - { - arma_debug_sigprint(); - - return (*this).operator_equ_common(x); - } - - - -template -template -inline -const SpSubview& -SpSubview::operator=(const SpBase& x) - { - arma_debug_sigprint(); - - return (*this).operator_equ_common( x.get_ref() ); - } - - - -template -template -inline -const SpSubview& -SpSubview::operator_equ_common(const SpBase& in) - { - arma_debug_sigprint(); - - const unwrap_spmat U(in.get_ref()); - - arma_conform_assert_same_size(n_rows, n_cols, U.M.n_rows, U.M.n_cols, "insertion into sparse submatrix"); - - if(U.is_alias(m)) - { - const SpMat tmp(U.M); - - spglue_merge::subview_merge(*this, tmp); - } - else - { - spglue_merge::subview_merge(*this, U.M); - } - - return *this; - } - - - -template -template -inline -const SpSubview& -SpSubview::operator+=(const SpBase& x) - { - arma_debug_sigprint(); - - // TODO: implement dedicated machinery - return (*this).operator=( (*this) + x.get_ref() ); - } - - - -template -template -inline -const SpSubview& -SpSubview::operator-=(const SpBase& x) - { - arma_debug_sigprint(); - - // TODO: implement dedicated machinery - return (*this).operator=( (*this) - x.get_ref() ); - } - - - -template -template -inline -const SpSubview& -SpSubview::operator*=(const SpBase& x) - { - arma_debug_sigprint(); - - return (*this).operator=( (*this) * x.get_ref() ); - } - - - -template -template -inline -const SpSubview& -SpSubview::operator%=(const SpBase& x) - { - arma_debug_sigprint(); - - // TODO: implement dedicated machinery - return (*this).operator=( (*this) % x.get_ref() ); - } - - - -template -template -inline -const SpSubview& -SpSubview::operator/=(const SpBase& x) - { - arma_debug_sigprint(); - - // NOTE: use of this function is not advised; it is implemented only for completeness - - SpProxy p(x.get_ref()); - - arma_conform_assert_same_size(n_rows, n_cols, p.get_n_rows(), p.get_n_cols(), "element-wise division"); - - if(p.is_alias(m) == false) - { - for(uword lcol = 0; lcol < n_cols; ++lcol) - for(uword lrow = 0; lrow < n_rows; ++lrow) - { - at(lrow,lcol) /= p.at(lrow,lcol); - } - } - else - { - const SpMat tmp(p.Q); - - (*this).operator/=(tmp); - } - - return *this; - } - - - -//! apply a functor to each element -template -template -inline -void -SpSubview::for_each(functor F) - { - arma_debug_sigprint(); - - m.sync_csc(); - m.invalidate_cache(); - - const uword lstart_row = aux_row1; - const uword lend_row = aux_row1 + n_rows; - - const uword lstart_col = aux_col1; - const uword lend_col = aux_col1 + n_cols; - - const uword* m_row_indices = m.row_indices; - eT* m_values = access::rwp(m.values); - - bool has_zero = false; - - for(uword c = lstart_col; c < lend_col; ++c) - { - const uword r_start = m.col_ptrs[c ]; - const uword r_end = m.col_ptrs[c + 1]; - - for(uword r = r_start; r < r_end; ++r) - { - const uword m_row_indices_r = m_row_indices[r]; - - if( (m_row_indices_r >= lstart_row) && (m_row_indices_r < lend_row) ) - { - eT& m_values_r = m_values[r]; - - F(m_values_r); - - if(m_values_r == eT(0)) { has_zero = true; } - } - } - } - - if(has_zero) - { - const uword old_m_n_nonzero = m.n_nonzero; - - access::rw(m).remove_zeros(); - - if(m.n_nonzero != old_m_n_nonzero) - { - access::rw(n_nonzero) = n_nonzero - (old_m_n_nonzero - m.n_nonzero); - } - } - } - - - -template -template -inline -void -SpSubview::for_each(functor F) const - { - arma_debug_sigprint(); - - m.sync_csc(); - - const uword lstart_row = aux_row1; - const uword lend_row = aux_row1 + n_rows; - - const uword lstart_col = aux_col1; - const uword lend_col = aux_col1 + n_cols; - - const uword* m_row_indices = m.row_indices; - - for(uword c = lstart_col; c < lend_col; ++c) - { - const uword r_start = m.col_ptrs[c ]; - const uword r_end = m.col_ptrs[c + 1]; - - for(uword r = r_start; r < r_end; ++r) - { - const uword m_row_indices_r = m_row_indices[r]; - - if( (m_row_indices_r >= lstart_row) && (m_row_indices_r < lend_row) ) - { - F(m.values[r]); - } - } - } - } - - - -//! transform each element using a functor -template -template -inline -void -SpSubview::transform(functor F) - { - arma_debug_sigprint(); - - m.sync_csc(); - m.invalidate_cache(); - - const uword lstart_row = aux_row1; - const uword lend_row = aux_row1 + n_rows; - - const uword lstart_col = aux_col1; - const uword lend_col = aux_col1 + n_cols; - - const uword* m_row_indices = m.row_indices; - eT* m_values = access::rwp(m.values); - - bool has_zero = false; - - for(uword c = lstart_col; c < lend_col; ++c) - { - const uword r_start = m.col_ptrs[c ]; - const uword r_end = m.col_ptrs[c + 1]; - - for(uword r = r_start; r < r_end; ++r) - { - const uword m_row_indices_r = m_row_indices[r]; - - if( (m_row_indices_r >= lstart_row) && (m_row_indices_r < lend_row) ) - { - eT& m_values_r = m_values[r]; - - m_values_r = eT( F(m_values_r) ); - - if(m_values_r == eT(0)) { has_zero = true; } - } - } - } - - if(has_zero) - { - const uword old_m_n_nonzero = m.n_nonzero; - - access::rw(m).remove_zeros(); - - if(m.n_nonzero != old_m_n_nonzero) - { - access::rw(n_nonzero) = n_nonzero - (old_m_n_nonzero - m.n_nonzero); - } - } - } - - - -template -inline -void -SpSubview::replace(const eT old_val, const eT new_val) - { - arma_debug_sigprint(); - - if(old_val == eT(0)) - { - if(new_val != eT(0)) - { - Mat tmp(*this); - - tmp.replace(old_val, new_val); - - (*this).operator=(tmp); - } - - return; - } - - m.sync_csc(); - m.invalidate_cache(); - - const uword lstart_row = aux_row1; - const uword lend_row = aux_row1 + n_rows; - - const uword lstart_col = aux_col1; - const uword lend_col = aux_col1 + n_cols; - - const uword* m_row_indices = m.row_indices; - eT* m_values = access::rwp(m.values); - - if(arma_isnan(old_val)) - { - for(uword c = lstart_col; c < lend_col; ++c) - { - const uword r_start = m.col_ptrs[c ]; - const uword r_end = m.col_ptrs[c + 1]; - - for(uword r = r_start; r < r_end; ++r) - { - const uword m_row_indices_r = m_row_indices[r]; - - if( (m_row_indices_r >= lstart_row) && (m_row_indices_r < lend_row) ) - { - eT& val = m_values[r]; - - val = (arma_isnan(val)) ? new_val : val; - } - } - } - } - else - { - for(uword c = lstart_col; c < lend_col; ++c) - { - const uword r_start = m.col_ptrs[c ]; - const uword r_end = m.col_ptrs[c + 1]; - - for(uword r = r_start; r < r_end; ++r) - { - const uword m_row_indices_r = m_row_indices[r]; - - if( (m_row_indices_r >= lstart_row) && (m_row_indices_r < lend_row) ) - { - eT& val = m_values[r]; - - val = (val == old_val) ? new_val : val; - } - } - } - } - - if(new_val == eT(0)) { access::rw(m).remove_zeros(); } - } - - - -template -inline -void -SpSubview::clean(const typename get_pod_type::result threshold) - { - arma_debug_sigprint(); - - if((n_elem == 0) || (n_nonzero == 0)) { return; } - - // TODO: replace with a more efficient implementation - - SpMat tmp(*this); - - tmp.clean(threshold); - - if(is_cx::yes) - { - (*this).operator=(tmp); - } - else - if(tmp.n_nonzero != n_nonzero) - { - (*this).operator=(tmp); - } - } - - - -template -inline -void -SpSubview::clamp(const eT min_val, const eT max_val) - { - arma_debug_sigprint(); - - if(is_cx::no) - { - arma_conform_check( (access::tmp_real(min_val) > access::tmp_real(max_val)), "SpSubview::clamp(): min_val must be less than max_val" ); - } - else - { - arma_conform_check( (access::tmp_real(min_val) > access::tmp_real(max_val)), "SpSubview::clamp(): real(min_val) must be less than real(max_val)" ); - arma_conform_check( (access::tmp_imag(min_val) > access::tmp_imag(max_val)), "SpSubview::clamp(): imag(min_val) must be less than imag(max_val)" ); - } - - if((n_elem == 0) || (n_nonzero == 0)) { return; } - - // TODO: replace with a more efficient implementation - - SpMat tmp(*this); - - tmp.clamp(min_val, max_val); - - (*this).operator=(tmp); - } - - - -template -inline -void -SpSubview::fill(const eT val) - { - arma_debug_sigprint(); - - if(val != eT(0)) - { - Mat tmp( (*this).n_rows, (*this).n_cols, arma_nozeros_indicator() ); - - tmp.fill(val); - - (*this).operator=(tmp); - } - else - { - (*this).zeros(); - } - } - - - -template -inline -void -SpSubview::zeros() - { - arma_debug_sigprint(); - - if((n_elem == 0) || (n_nonzero == 0)) { return; } - - if((m.n_nonzero - n_nonzero) == 0) - { - access::rw(m).zeros(); - access::rw(n_nonzero) = 0; - return; - } - - SpMat tmp(arma_reserve_indicator(), m.n_rows, m.n_cols, m.n_nonzero - n_nonzero); - - const uword sv_row_start = aux_row1; - const uword sv_col_start = aux_col1; - - const uword sv_row_end = aux_row1 + n_rows - 1; - const uword sv_col_end = aux_col1 + n_cols - 1; - - typename SpMat::const_iterator m_it = m.begin(); - typename SpMat::const_iterator m_it_end = m.end(); - - uword tmp_count = 0; - - for(; m_it != m_it_end; ++m_it) - { - const uword m_it_row = m_it.row(); - const uword m_it_col = m_it.col(); - - const bool inside_box = ((m_it_row >= sv_row_start) && (m_it_row <= sv_row_end)) && ((m_it_col >= sv_col_start) && (m_it_col <= sv_col_end)); - - if(inside_box == false) - { - access::rw(tmp.values[tmp_count]) = (*m_it); - access::rw(tmp.row_indices[tmp_count]) = m_it_row; - access::rw(tmp.col_ptrs[m_it_col + 1])++; - ++tmp_count; - } - } - - for(uword i=0; i < tmp.n_cols; ++i) - { - access::rw(tmp.col_ptrs[i + 1]) += tmp.col_ptrs[i]; - } - - access::rw(m).steal_mem(tmp); - - access::rw(n_nonzero) = 0; - } - - - -template -inline -void -SpSubview::ones() - { - arma_debug_sigprint(); - - (*this).fill(eT(1)); - } - - - -template -inline -void -SpSubview::eye() - { - arma_debug_sigprint(); - - SpMat tmp; - - tmp.eye( (*this).n_rows, (*this).n_cols ); - - (*this).operator=(tmp); - } - - - -template -inline -void -SpSubview::randu() - { - arma_debug_sigprint(); - - Mat tmp( (*this).n_rows, (*this).n_cols, fill::randu ); - - (*this).operator=(tmp); - } - - - -template -inline -void -SpSubview::randn() - { - arma_debug_sigprint(); - - Mat tmp( (*this).n_rows, (*this).n_cols, fill::randn ); - - (*this).operator=(tmp); - } - - - -template -inline -SpSubview_MapMat_val -SpSubview::operator[](const uword i) - { - const uword lrow = i % n_rows; - const uword lcol = i / n_rows; - - return (*this).at(lrow, lcol); - } - - - -template -inline -eT -SpSubview::operator[](const uword i) const - { - const uword lrow = i % n_rows; - const uword lcol = i / n_rows; - - return (*this).at(lrow, lcol); - } - - - -template -inline -SpSubview_MapMat_val -SpSubview::operator()(const uword i) - { - arma_conform_check_bounds( (i >= n_elem), "SpSubview::operator(): index out of bounds" ); - - const uword lrow = i % n_rows; - const uword lcol = i / n_rows; - - return (*this).at(lrow, lcol); - } - - - -template -inline -eT -SpSubview::operator()(const uword i) const - { - arma_conform_check_bounds( (i >= n_elem), "SpSubview::operator(): index out of bounds" ); - - const uword lrow = i % n_rows; - const uword lcol = i / n_rows; - - return (*this).at(lrow, lcol); - } - - - -template -inline -SpSubview_MapMat_val -SpSubview::operator()(const uword in_row, const uword in_col) - { - arma_conform_check_bounds( (in_row >= n_rows) || (in_col >= n_cols), "SpSubview::operator(): index out of bounds" ); - - return (*this).at(in_row, in_col); - } - - - -template -inline -eT -SpSubview::operator()(const uword in_row, const uword in_col) const - { - arma_conform_check_bounds( (in_row >= n_rows) || (in_col >= n_cols), "SpSubview::operator(): index out of bounds" ); - - return (*this).at(in_row, in_col); - } - - - -template -inline -SpSubview_MapMat_val -SpSubview::at(const uword i) - { - const uword lrow = i % n_rows; - const uword lcol = i / n_cols; - - return (*this).at(lrow, lcol); - } - - - -template -inline -eT -SpSubview::at(const uword i) const - { - const uword lrow = i % n_rows; - const uword lcol = i / n_cols; - - return (*this).at(lrow, lcol); - } - - - -template -inline -SpSubview_MapMat_val -SpSubview::at(const uword in_row, const uword in_col) - { - return SpSubview_MapMat_val((*this), m.cache, aux_row1 + in_row, aux_col1 + in_col); - } - - - -template -inline -eT -SpSubview::at(const uword in_row, const uword in_col) const - { - return m.at(aux_row1 + in_row, aux_col1 + in_col); - } - - - -template -inline -bool -SpSubview::check_overlap(const SpSubview& x) const - { - const SpSubview& t = *this; - - if(&t.m != &x.m) - { - return false; - } - else - { - if( (t.n_elem == 0) || (x.n_elem == 0) ) - { - return false; - } - else - { - const uword t_row_start = t.aux_row1; - const uword t_row_end_p1 = t_row_start + t.n_rows; - - const uword t_col_start = t.aux_col1; - const uword t_col_end_p1 = t_col_start + t.n_cols; - - const uword x_row_start = x.aux_row1; - const uword x_row_end_p1 = x_row_start + x.n_rows; - - const uword x_col_start = x.aux_col1; - const uword x_col_end_p1 = x_col_start + x.n_cols; - - const bool outside_rows = ( (x_row_start >= t_row_end_p1) || (t_row_start >= x_row_end_p1) ); - const bool outside_cols = ( (x_col_start >= t_col_end_p1) || (t_col_start >= x_col_end_p1) ); - - return ( (outside_rows == false) && (outside_cols == false) ); - } - } - } - - - -template -inline -bool -SpSubview::is_vec() const - { - return ( (n_rows == 1) || (n_cols == 1) ); - } - - - -template -inline -SpSubview_row -SpSubview::row(const uword row_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds(row_num >= n_rows, "SpSubview::row(): out of bounds"); - - return SpSubview_row(const_cast< SpMat& >(m), row_num + aux_row1, aux_col1, n_cols); - } - - - -template -inline -const SpSubview_row -SpSubview::row(const uword row_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds(row_num >= n_rows, "SpSubview::row(): out of bounds"); - - return SpSubview_row(m, row_num + aux_row1, aux_col1, n_cols); - } - - - -template -inline -SpSubview_col -SpSubview::col(const uword col_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds(col_num >= n_cols, "SpSubview::col(): out of bounds"); - - return SpSubview_col(const_cast< SpMat& >(m), col_num + aux_col1, aux_row1, n_rows); - } - - - -template -inline -const SpSubview_col -SpSubview::col(const uword col_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds(col_num >= n_cols, "SpSubview::col(): out of bounds"); - - return SpSubview_col(m, col_num + aux_col1, aux_row1, n_rows); - } - - - -template -inline -SpSubview -SpSubview::rows(const uword in_row1, const uword in_row2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_row2 >= n_rows), - "SpSubview::rows(): indices out of bounds or incorrectly used" - ); - - return submat(in_row1, 0, in_row2, n_cols - 1); - } - - - -template -inline -const SpSubview -SpSubview::rows(const uword in_row1, const uword in_row2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_row2 >= n_rows), - "SpSubview::rows(): indices out of bounds or incorrectly used" - ); - - return submat(in_row1, 0, in_row2, n_cols - 1); - } - - - -template -inline -SpSubview -SpSubview::cols(const uword in_col1, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_col1 > in_col2) || (in_col2 >= n_cols), - "SpSubview::cols(): indices out of bounds or incorrectly used" - ); - - return submat(0, in_col1, n_rows - 1, in_col2); - } - - - -template -inline -const SpSubview -SpSubview::cols(const uword in_col1, const uword in_col2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_col1 > in_col2) || (in_col2 >= n_cols), - "SpSubview::cols(): indices out of bounds or incorrectly used" - ); - - return submat(0, in_col1, n_rows - 1, in_col2); - } - - - -template -inline -SpSubview -SpSubview::submat(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_col1 > in_col2) || (in_row2 >= n_rows) || (in_col2 >= n_cols), - "SpSubview::submat(): indices out of bounds or incorrectly used" - ); - - return access::rw(m).submat(in_row1 + aux_row1, in_col1 + aux_col1, in_row2 + aux_row1, in_col2 + aux_col1); - } - - - -template -inline -const SpSubview -SpSubview::submat(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_col1 > in_col2) || (in_row2 >= n_rows) || (in_col2 >= n_cols), - "SpSubview::submat(): indices out of bounds or incorrectly used" - ); - - return m.submat(in_row1 + aux_row1, in_col1 + aux_col1, in_row2 + aux_row1, in_col2 + aux_col1); - } - - - -template -inline -SpSubview -SpSubview::submat(const span& row_span, const span& col_span) - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - const bool col_all = row_span.whole; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_all ? n_rows : row_span.b; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_all ? n_cols : col_span.b; - - arma_conform_check_bounds - ( - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= n_rows))) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= n_cols))), - "SpSubview::submat(): indices out of bounds or incorrectly used" - ); - - return submat(in_row1, in_col1, in_row2, in_col2); - } - - - -template -inline -const SpSubview -SpSubview::submat(const span& row_span, const span& col_span) const - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - const bool col_all = row_span.whole; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_all ? n_rows - 1 : row_span.b; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_all ? n_cols - 1 : col_span.b; - - arma_conform_check_bounds - ( - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= n_rows))) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= n_cols))), - "SpSubview::submat(): indices out of bounds or incorrectly used" - ); - - return submat(in_row1, in_col1, in_row2, in_col2); - } - - - -template -inline -SpSubview -SpSubview::operator()(const uword row_num, const span& col_span) - { - arma_debug_sigprint(); - - return submat(span(row_num, row_num), col_span); - } - - - -template -inline -const SpSubview -SpSubview::operator()(const uword row_num, const span& col_span) const - { - arma_debug_sigprint(); - - return submat(span(row_num, row_num), col_span); - } - - - -template -inline -SpSubview -SpSubview::operator()(const span& row_span, const uword col_num) - { - arma_debug_sigprint(); - - return submat(row_span, span(col_num, col_num)); - } - - - -template -inline -const SpSubview -SpSubview::operator()(const span& row_span, const uword col_num) const - { - arma_debug_sigprint(); - - return submat(row_span, span(col_num, col_num)); - } - - - -template -inline -SpSubview -SpSubview::operator()(const span& row_span, const span& col_span) - { - arma_debug_sigprint(); - - return submat(row_span, col_span); - } - - - -template -inline -const SpSubview -SpSubview::operator()(const span& row_span, const span& col_span) const - { - arma_debug_sigprint(); - - return submat(row_span, col_span); - } - - - -template -inline -void -SpSubview::swap_rows(const uword in_row1, const uword in_row2) - { - arma_debug_sigprint(); - - arma_conform_check((in_row1 >= n_rows) || (in_row2 >= n_rows), "SpSubview::swap_rows(): invalid row index"); - - const uword lstart_col = aux_col1; - const uword lend_col = aux_col1 + n_cols; - - for(uword c = lstart_col; c < lend_col; ++c) - { - const eT val = access::rw(m).at(in_row1 + aux_row1, c); - access::rw(m).at(in_row2 + aux_row1, c) = eT( access::rw(m).at(in_row1 + aux_row1, c) ); - access::rw(m).at(in_row1 + aux_row1, c) = val; - } - } - - - -template -inline -void -SpSubview::swap_cols(const uword in_col1, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check((in_col1 >= n_cols) || (in_col2 >= n_cols), "SpSubview::swap_cols(): invalid column index"); - - const uword lstart_row = aux_row1; - const uword lend_row = aux_row1 + n_rows; - - for(uword r = lstart_row; r < lend_row; ++r) - { - const eT val = access::rw(m).at(r, in_col1 + aux_col1); - access::rw(m).at(r, in_col1 + aux_col1) = eT( access::rw(m).at(r, in_col2 + aux_col1) ); - access::rw(m).at(r, in_col2 + aux_col1) = val; - } - } - - - -template -inline -typename SpSubview::iterator -SpSubview::begin() - { - m.sync_csc(); - - return iterator(*this); - } - - - -template -inline -typename SpSubview::const_iterator -SpSubview::begin() const - { - m.sync_csc(); - - return const_iterator(*this); - } - - - -template -inline -typename SpSubview::const_iterator -SpSubview::cbegin() const - { - m.sync_csc(); - - return const_iterator(*this); - } - - - -template -inline -typename SpSubview::iterator -SpSubview::begin_col(const uword col_num) - { - m.sync_csc(); - - return iterator(*this, 0, col_num); - } - - -template -inline -typename SpSubview::const_iterator -SpSubview::begin_col(const uword col_num) const - { - m.sync_csc(); - - return const_iterator(*this, 0, col_num); - } - - - -template -inline -typename SpSubview::row_iterator -SpSubview::begin_row(const uword row_num) - { - m.sync_csc(); - - return row_iterator(*this, row_num, 0); - } - - - -template -inline -typename SpSubview::const_row_iterator -SpSubview::begin_row(const uword row_num) const - { - m.sync_csc(); - - return const_row_iterator(*this, row_num, 0); - } - - - -template -inline -typename SpSubview::iterator -SpSubview::end() - { - m.sync_csc(); - - return iterator(*this, 0, n_cols, n_nonzero, m.n_nonzero - n_nonzero); - } - - - -template -inline -typename SpSubview::const_iterator -SpSubview::end() const - { - m.sync_csc(); - - return const_iterator(*this, 0, n_cols, n_nonzero, m.n_nonzero - n_nonzero); - } - - - -template -inline -typename SpSubview::const_iterator -SpSubview::cend() const - { - m.sync_csc(); - - return const_iterator(*this, 0, n_cols, n_nonzero, m.n_nonzero - n_nonzero); - } - - - -template -inline -typename SpSubview::row_iterator -SpSubview::end_row() - { - m.sync_csc(); - - return row_iterator(*this, n_nonzero); - } - - - -template -inline -typename SpSubview::const_row_iterator -SpSubview::end_row() const - { - m.sync_csc(); - - return const_row_iterator(*this, n_nonzero); - } - - - -template -inline -typename SpSubview::row_iterator -SpSubview::end_row(const uword row_num) - { - m.sync_csc(); - - return row_iterator(*this, row_num + 1, 0); - } - - - -template -inline -typename SpSubview::const_row_iterator -SpSubview::end_row(const uword row_num) const - { - m.sync_csc(); - - return const_row_iterator(*this, row_num + 1, 0); - } - - - -template -arma_inline -bool -SpSubview::is_alias(const SpMat& X) const - { - return m.is_alias(X); - } - - - -template -inline -eT& -SpSubview::insert_element(const uword in_row, const uword in_col, const eT in_val) - { - arma_debug_sigprint(); - - // This may not actually insert an element. - const uword old_n_nonzero = m.n_nonzero; - eT& retval = access::rw(m).insert_element(in_row + aux_row1, in_col + aux_col1, in_val); - // Update n_nonzero (if necessary). - access::rw(n_nonzero) += (m.n_nonzero - old_n_nonzero); - - return retval; - } - - - -template -inline -void -SpSubview::delete_element(const uword in_row, const uword in_col) - { - arma_debug_sigprint(); - - // This may not actually delete an element. - const uword old_n_nonzero = m.n_nonzero; - access::rw(m).delete_element(in_row + aux_row1, in_col + aux_col1); - access::rw(n_nonzero) -= (old_n_nonzero - m.n_nonzero); - } - - - -template -inline -void -SpSubview::invalidate_cache() const - { - arma_debug_sigprint(); - - m.invalidate_cache(); - } - - - -// -// -// - - - -template -inline -SpSubview_col::SpSubview_col(const SpMat& in_m, const uword in_col) - : SpSubview(in_m, 0, in_col, in_m.n_rows, 1) - { - arma_debug_sigprint(); - } - - - -template -inline -SpSubview_col::SpSubview_col(const SpMat& in_m, const uword in_col, const uword in_row1, const uword in_n_rows) - : SpSubview(in_m, in_row1, in_col, in_n_rows, 1) - { - arma_debug_sigprint(); - } - - - -template -inline -void -SpSubview_col::operator=(const SpSubview& x) - { - arma_debug_sigprint(); - - SpSubview::operator=(x); - } - - - -template -inline -void -SpSubview_col::operator=(const SpSubview_col& x) - { - arma_debug_sigprint(); - - SpSubview::operator=(x); // interprets 'SpSubview_col' as 'SpSubview' - } - - - -template -template -inline -void -SpSubview_col::operator=(const SpBase& x) - { - arma_debug_sigprint(); - - SpSubview::operator=(x); - } - - - -template -template -inline -void -SpSubview_col::operator=(const Base& x) - { - arma_debug_sigprint(); - - SpSubview::operator=(x); - } - - - -template -inline -const SpOp,spop_htrans> -SpSubview_col::t() const - { - return SpOp,spop_htrans>(*this); - } - - - -template -inline -const SpOp,spop_htrans> -SpSubview_col::ht() const - { - return SpOp,spop_htrans>(*this); - } - - - -template -inline -const SpOp,spop_strans> -SpSubview_col::st() const - { - return SpOp,spop_strans>(*this); - } - - - -template -inline -const SpToDOp,op_sp_as_dense> -SpSubview_col::as_dense() const - { - return SpToDOp,op_sp_as_dense>(*this); - } - - - -// -// -// - - - -template -inline -SpSubview_row::SpSubview_row(const SpMat& in_m, const uword in_row) - : SpSubview(in_m, in_row, 0, 1, in_m.n_cols) - { - arma_debug_sigprint(); - } - - - -template -inline -SpSubview_row::SpSubview_row(const SpMat& in_m, const uword in_row, const uword in_col1, const uword in_n_cols) - : SpSubview(in_m, in_row, in_col1, 1, in_n_cols) - { - arma_debug_sigprint(); - } - - - -template -inline -void -SpSubview_row::operator=(const SpSubview& x) - { - arma_debug_sigprint(); - - SpSubview::operator=(x); - } - - - -template -inline -void -SpSubview_row::operator=(const SpSubview_row& x) - { - arma_debug_sigprint(); - - SpSubview::operator=(x); // interprets 'SpSubview_row' as 'SpSubview' - } - - - -template -template -inline -void -SpSubview_row::operator=(const SpBase& x) - { - arma_debug_sigprint(); - - SpSubview::operator=(x); - } - - - -template -template -inline -void -SpSubview_row::operator=(const Base& x) - { - arma_debug_sigprint(); - - SpSubview::operator=(x); - } - - - -template -inline -const SpOp,spop_htrans> -SpSubview_row::t() const - { - return SpOp,spop_htrans>(*this); - } - - - -template -inline -const SpOp,spop_htrans> -SpSubview_row::ht() const - { - return SpOp,spop_htrans>(*this); - } - - - -template -inline -const SpOp,spop_strans> -SpSubview_row::st() const - { - return SpOp,spop_strans>(*this); - } - - - -template -inline -const SpToDOp,op_sp_as_dense> -SpSubview_row::as_dense() const - { - return SpToDOp,op_sp_as_dense>(*this); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpToDGlue_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpToDGlue_bones.hpp deleted file mode 100644 index 158dd6b89..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpToDGlue_bones.hpp +++ /dev/null @@ -1,45 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpToDGlue -//! @{ - - - -template -class SpToDGlue : public Base< typename T1::elem_type, SpToDGlue > - { - public: - - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_row = glue_type::template traits::is_row; - static constexpr bool is_col = glue_type::template traits::is_col; - static constexpr bool is_xvec = glue_type::template traits::is_xvec; - - inline explicit SpToDGlue(const T1& in_A, const T2& in_B); - inline ~SpToDGlue(); - - const T1& A; //!< first operand; must be derived from Base or SpBase - const T2& B; //!< second operand; must be derived from Base or SpBase - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpToDGlue_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpToDGlue_meat.hpp deleted file mode 100644 index 26c26a9b5..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpToDGlue_meat.hpp +++ /dev/null @@ -1,44 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpToDGlue -//! @{ - - - -template -inline -SpToDGlue::SpToDGlue(const T1& in_A, const T2& in_B) - : A(in_A) - , B(in_B) - { - arma_debug_sigprint(); - } - - - -template -inline -SpToDGlue::~SpToDGlue() - { - arma_debug_sigprint(); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpToDOp_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpToDOp_bones.hpp deleted file mode 100644 index 44fa78950..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpToDOp_bones.hpp +++ /dev/null @@ -1,50 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpToDOp -//! @{ - - -// NOTE: SpToDOp is dedicated for unary operations on sparse matrices that result in dense matrices. - -template -class SpToDOp : public Base< typename T1::elem_type, SpToDOp > - { - public: - - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_row = op_type::template traits::is_row; - static constexpr bool is_col = op_type::template traits::is_col; - static constexpr bool is_xvec = op_type::template traits::is_xvec; - - inline explicit SpToDOp(const T1& in_m); - inline SpToDOp(const T1& in_m, const elem_type in_aux); - inline SpToDOp(const T1& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b); - inline ~SpToDOp(); - - arma_aligned const T1& m; //!< the operand; must be derived from SpBase - arma_aligned elem_type aux; //!< auxiliary data, using the element type as used by T1 - arma_aligned uword aux_uword_a; //!< auxiliary data, uword format - arma_aligned uword aux_uword_b; //!< auxiliary data, uword format - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpToDOp_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpToDOp_meat.hpp deleted file mode 100644 index edcec8afe..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpToDOp_meat.hpp +++ /dev/null @@ -1,66 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpToDOp -//! @{ - - - -template -inline -SpToDOp::SpToDOp(const T1& in_m) - : m(in_m) - { - arma_debug_sigprint(); - } - - - -template -inline -SpToDOp::SpToDOp(const T1& in_m, const typename T1::elem_type in_aux) - : m(in_m) - , aux(in_aux) - { - arma_debug_sigprint(); - } - - - -template -inline -SpToDOp::SpToDOp(const T1& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b) - : m(in_m) - , aux_uword_a(in_aux_uword_a) - , aux_uword_b(in_aux_uword_b) - { - arma_debug_sigprint(); - } - - - -template -inline -SpToDOp::~SpToDOp() - { - arma_debug_sigprint(); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpValProxy_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpValProxy_bones.hpp deleted file mode 100644 index af9a52d4f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpValProxy_bones.hpp +++ /dev/null @@ -1,86 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpValProxy -//! @{ - - -// Sparse value proxy class, to prevent inserting 0s into sparse matrices. -// T1 must be either SpMat or SpSubview. -// This class uses T1::insert_element(), T1::delete_element(), T1::invalidate_cache() - -template -class SpValProxy - { - public: - - typedef typename T1::elem_type eT; // Convenience typedef - - friend class SpMat; - friend class SpSubview; - - /** - * Create the sparse value proxy. - * Otherwise, pass a pointer to a reference of the value. - */ - arma_inline SpValProxy(uword row, uword col, T1& in_parent, eT* in_val_ptr = nullptr); - inline SpValProxy() = delete; - - //! For swapping operations. - arma_inline SpValProxy& operator=(const SpValProxy& rhs); - template - arma_inline SpValProxy& operator=(const SpValProxy& rhs); - - //! Overload all of the potential operators. - - //! First, the ones that could modify a value. - inline SpValProxy& operator= (const eT rhs); - inline SpValProxy& operator+=(const eT rhs); - inline SpValProxy& operator-=(const eT rhs); - inline SpValProxy& operator*=(const eT rhs); - inline SpValProxy& operator/=(const eT rhs); - - inline SpValProxy& operator++(); - inline SpValProxy& operator--(); - - inline eT operator++(const int); - inline eT operator--(const int); - - //! This will work for any other operations that do not modify a value. - arma_inline operator eT() const; - - arma_inline typename get_pod_type::result real() const; - arma_inline typename get_pod_type::result imag() const; - - - private: - - // Deletes the element if it is zero; NOTE: does not check if val_ptr == nullptr - arma_inline void check_zero(); - - arma_aligned const uword row; - arma_aligned const uword col; - - arma_aligned eT* val_ptr; - - arma_aligned T1& parent; // We will call this object if we need to insert or delete an element. - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpValProxy_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpValProxy_meat.hpp deleted file mode 100644 index 242ec07e7..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/SpValProxy_meat.hpp +++ /dev/null @@ -1,364 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup SpValProxy -//! @{ - - -//! SpValProxy implementation. -template -arma_inline -SpValProxy::SpValProxy(uword in_row, uword in_col, T1& in_parent, eT* in_val_ptr) - : row(in_row) - , col(in_col) - , val_ptr(in_val_ptr) - , parent(in_parent) - { - // Nothing to do. - } - - - -template -arma_inline -SpValProxy& -SpValProxy::operator=(const SpValProxy& rhs) - { - return (*this).operator=(eT(rhs)); - } - - - -template -template -arma_inline -SpValProxy& -SpValProxy::operator=(const SpValProxy& rhs) - { - return (*this).operator=(eT(rhs)); - } - - - -template -inline -SpValProxy& -SpValProxy::operator=(const eT rhs) - { - if(rhs != eT(0)) // A nonzero element is being assigned. - { - if(val_ptr) - { - // The value exists and merely needs to be updated. - *val_ptr = rhs; - parent.invalidate_cache(); - } - else - { - // The value is nonzero and must be inserted. - val_ptr = &parent.insert_element(row, col, rhs); - } - } - else // A zero is being assigned.~ - { - if(val_ptr) - { - // The element exists, but we need to remove it, because it is being set to 0. - parent.delete_element(row, col); - val_ptr = nullptr; - } - - // If the element does not exist, we do not need to do anything at all. - } - - return *this; - } - - - -template -inline -SpValProxy& -SpValProxy::operator+=(const eT rhs) - { - if(val_ptr) - { - // The value already exists and merely needs to be updated. - *val_ptr += rhs; - parent.invalidate_cache(); - check_zero(); - } - else - { - if(rhs != eT(0)) - { - // The value does not exist and must be inserted. - val_ptr = &parent.insert_element(row, col, rhs); - } - } - - return *this; - } - - - -template -inline -SpValProxy& -SpValProxy::operator-=(const eT rhs) - { - if(val_ptr) - { - // The value already exists and merely needs to be updated. - *val_ptr -= rhs; - parent.invalidate_cache(); - check_zero(); - } - else - { - if(rhs != eT(0)) - { - // The value does not exist and must be inserted. - val_ptr = &parent.insert_element(row, col, -rhs); - } - } - - return *this; - } - - - -template -inline -SpValProxy& -SpValProxy::operator*=(const eT rhs) - { - if(rhs != eT(0)) - { - if(val_ptr) - { - // The value already exists and merely needs to be updated. - *val_ptr *= rhs; - parent.invalidate_cache(); - check_zero(); - } - } - else - { - if(val_ptr) - { - // Since we are multiplying by zero, the value can be deleted. - parent.delete_element(row, col); - val_ptr = nullptr; - } - } - - return *this; - } - - - -template -inline -SpValProxy& -SpValProxy::operator/=(const eT rhs) - { - if(rhs != eT(0)) // I hope this is true! - { - if(val_ptr) - { - *val_ptr /= rhs; - parent.invalidate_cache(); - check_zero(); - } - } - else - { - if(val_ptr) - { - *val_ptr /= rhs; // That is where it gets ugly. - // Now check if it's 0. - if(*val_ptr == eT(0)) - { - parent.delete_element(row, col); - val_ptr = nullptr; - } - } - else - { - eT val = eT(0) / rhs; // This may vary depending on type and implementation. - - if(val != eT(0)) - { - // Ok, now we have to insert it. - val_ptr = &parent.insert_element(row, col, val); - } - } - } - - return *this; - } - - - -template -inline -SpValProxy& -SpValProxy::operator++() - { - if(val_ptr) - { - (*val_ptr) += eT(1); - parent.invalidate_cache(); - check_zero(); - } - else - { - val_ptr = &parent.insert_element(row, col, eT(1)); - } - - return *this; - } - - - -template -inline -SpValProxy& -SpValProxy::operator--() - { - if(val_ptr) - { - (*val_ptr) -= eT(1); - parent.invalidate_cache(); - check_zero(); - } - else - { - val_ptr = &parent.insert_element(row, col, eT(-1)); - } - - return *this; - } - - - -template -inline -typename T1::elem_type -SpValProxy::operator++(const int) - { - if(val_ptr) - { - (*val_ptr) += eT(1); - parent.invalidate_cache(); - check_zero(); - } - else - { - val_ptr = &parent.insert_element(row, col, eT(1)); - } - - if(val_ptr) // It may have changed to now be 0. - { - return *(val_ptr) - eT(1); - } - else - { - return eT(0); - } - } - - - -template -inline -typename T1::elem_type -SpValProxy::operator--(const int) - { - if(val_ptr) - { - (*val_ptr) -= eT(1); - parent.invalidate_cache(); - check_zero(); - } - else - { - val_ptr = &parent.insert_element(row, col, eT(-1)); - } - - if(val_ptr) // It may have changed to now be 0. - { - return *(val_ptr) + eT(1); - } - else - { - return eT(0); - } - } - - - -template -arma_inline -SpValProxy::operator eT() const - { - return (val_ptr) ? eT(*val_ptr) : eT(0); - } - - - -template -arma_inline -typename get_pod_type::eT>::result -SpValProxy::real() const - { - typedef typename get_pod_type::result T; - - return T( access::tmp_real( (val_ptr) ? eT(*val_ptr) : eT(0) ) ); - } - - - -template -arma_inline -typename get_pod_type::eT>::result -SpValProxy::imag() const - { - typedef typename get_pod_type::result T; - - return T( access::tmp_imag( (val_ptr) ? eT(*val_ptr) : eT(0) ) ); - } - - - -template -arma_inline -void -SpValProxy::check_zero() - { - if(*val_ptr == eT(0)) - { - parent.delete_element(row, col); - val_ptr = nullptr; - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/access.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/access.hpp deleted file mode 100644 index 77db8621f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/access.hpp +++ /dev/null @@ -1,45 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup access -//! @{ - - -class access - { - public: - - //! internal function to allow modification of data declared as read-only (use with caution) - template constexpr static T1& rw (const T1& x) { return const_cast(x); } - template constexpr static T1*& rwp(const T1* const& x) { return const_cast(x); } - - //! internal function to obtain the real part of either a plain number or a complex number - template constexpr static const eT& tmp_real(const eT& X) { return X; } - template constexpr static const T tmp_real(const std::complex& X) { return X.real(); } - - //! internal function to obtain the imag part of either a plain number or a complex number - template constexpr static const eT tmp_imag(const eT ) { return eT(0); } - template constexpr static const T tmp_imag(const std::complex& X) { return X.imag(); } - - //! internal function to work around braindead compilers - template constexpr static const typename enable_if2::no, const eT&>::result alt_conj(const eT& X) { return X; } - template arma_inline static const typename enable_if2::yes, const eT >::result alt_conj(const eT& X) { return std::conj(X); } - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_cmath.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_cmath.hpp deleted file mode 100644 index 22df4bf0f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_cmath.hpp +++ /dev/null @@ -1,378 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup arma_cmath -//! @{ - - - -// -// wrappers for isfinite - - -template -inline -bool -arma_isfinite(eT) - { - return true; - } - - - -template<> -inline -bool -arma_isfinite(float x) - { - return std::isfinite(x); - } - - - -template<> -inline -bool -arma_isfinite(double x) - { - return std::isfinite(x); - } - - - -template -inline -bool -arma_isfinite(const std::complex& x) - { - return ( arma_isfinite(x.real()) && arma_isfinite(x.imag()) ); - } - - - -// -// wrappers for isinf - - -template -inline -bool -arma_isinf(eT) - { - return false; - } - - - -template<> -inline -bool -arma_isinf(float x) - { - return std::isinf(x); - } - - - -template<> -inline -bool -arma_isinf(double x) - { - return std::isinf(x); - } - - - -template -inline -bool -arma_isinf(const std::complex& x) - { - return ( arma_isinf(x.real()) || arma_isinf(x.imag()) ); - } - - - -// -// wrappers for isnan - - -template -inline -bool -arma_isnan(eT val) - { - arma_ignore(val); - - return false; - } - - - -template<> -inline -bool -arma_isnan(float x) - { - return std::isnan(x); - } - - - -template<> -inline -bool -arma_isnan(double x) - { - return std::isnan(x); - } - - - -template -inline -bool -arma_isnan(const std::complex& x) - { - return ( arma_isnan(x.real()) || arma_isnan(x.imag()) ); - } - - - -// -// implementation of arma_sign() - - -template -constexpr -typename arma_unsigned_integral_only::result -arma_sign(const eT x) - { - return (x > eT(0)) ? eT(+1) : eT(0); - } - - - -template -constexpr -typename arma_signed_integral_only::result -arma_sign(const eT x) - { - return (x > eT(0)) ? eT(+1) : ( (x < eT(0)) ? eT(-1) : eT(0) ); - } - - - -template -constexpr -typename arma_real_only::result -arma_sign(const eT x) - { - return (x > eT(0)) ? eT(+1) : ( (x < eT(0)) ? eT(-1) : ((x == eT(0)) ? eT(0) : x) ); - } - - - -template -inline -typename arma_cx_only::result -arma_sign(const eT& x) - { - typedef typename eT::value_type T; - - const T abs_x = std::abs(x); - - return (abs_x != T(0)) ? (x / abs_x) : x; - } - - - -// -// wrappers for hypot(x, y) = sqrt(x^2 + y^2) - - -template -inline -eT -arma_hypot(const eT x, const eT y) - { - arma_ignore(x); - arma_ignore(y); - - arma_stop_runtime_error("arma_hypot(): not implemented for integer or complex element types"); - - return eT(0); - } - - - -template<> -inline -float -arma_hypot(const float x, const float y) - { - return std::hypot(x, y); - } - - - -template<> -inline -double -arma_hypot(const double x, const double y) - { - return std::hypot(x, y); - } - - - -// -// implementation of arma_sinc() - - -template -inline -eT -arma_sinc_generic(const eT x) - { - typedef typename get_pod_type::result T; - - const eT tmp = Datum::pi * x; - - return (tmp == eT(0)) ? eT(1) : eT( std::sin(tmp) / tmp ); - } - - - -template -inline -eT -arma_sinc(const eT x) - { - return eT( arma_sinc_generic( double(x) ) ); - } - - - -template<> -inline -float -arma_sinc(const float x) - { - return arma_sinc_generic(x); - } - - - -template<> -inline -double -arma_sinc(const double x) - { - return arma_sinc_generic(x); - } - - - -template -inline -std::complex -arma_sinc(const std::complex& x) - { - return arma_sinc_generic(x); - } - - - -// -// wrappers for arg() - - -template -struct arma_arg - { - static - inline - eT - eval(const eT x) - { - return eT( std::arg(x) ); - } - }; - - - -template<> -struct arma_arg - { - static - inline - float - eval(const float x) - { - return std::arg(x); - } - }; - - - -template<> -struct arma_arg - { - static - inline - double - eval(const double x) - { - return std::arg(x); - } - }; - - - -template<> -struct arma_arg< std::complex > - { - static - inline - float - eval(const std::complex& x) - { - return std::arg(x); - } - }; - - - -template<> -struct arma_arg< std::complex > - { - static - inline - double - eval(const std::complex& x) - { - return std::arg(x); - } - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_config.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_config.hpp deleted file mode 100644 index 892b21ff0..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_config.hpp +++ /dev/null @@ -1,245 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup arma_config -//! @{ - - - -struct arma_config - { - #if defined(ARMA_MAT_PREALLOC) - static constexpr uword mat_prealloc = (sword(ARMA_MAT_PREALLOC) > 0) ? uword(ARMA_MAT_PREALLOC) : 1; - #else - static constexpr uword mat_prealloc = 16; - #endif - - - #if defined(ARMA_OPENMP_THRESHOLD) - static constexpr uword mp_threshold = (sword(ARMA_OPENMP_THRESHOLD) > 0) ? uword(ARMA_OPENMP_THRESHOLD) : 320; - #else - static constexpr uword mp_threshold = 320; - #endif - - - #if defined(ARMA_OPENMP_THREADS) - static constexpr uword mp_threads = (sword(ARMA_OPENMP_THREADS) > 0) ? uword(ARMA_OPENMP_THREADS) : 8; - #else - static constexpr uword mp_threads = 8; - #endif - - - #if defined(ARMA_OPTIMISE_BAND) - static constexpr bool optimise_band = true; - #else - static constexpr bool optimise_band = false; - #endif - - - #if defined(ARMA_OPTIMISE_SYM) - static constexpr bool optimise_sym = true; - #else - static constexpr bool optimise_sym = false; - #endif - - - #if defined(ARMA_OPTIMISE_INVEXPR) - static constexpr bool optimise_invexpr = true; - #else - static constexpr bool optimise_invexpr = false; - #endif - - - #if defined(ARMA_CHECK_CONFORMANCE) - static constexpr bool check_conform = true; - #else - static constexpr bool check_conform = false; - #endif - - - #if defined(ARMA_CHECK_NONFINITE) - static constexpr bool check_nonfinite = true; - #else - static constexpr bool check_nonfinite = false; - #endif - - - #if defined(ARMA_USE_LAPACK) - static constexpr bool lapack = true; - #else - static constexpr bool lapack = false; - #endif - - - #if defined(ARMA_USE_BLAS) - static constexpr bool blas = true; - #else - static constexpr bool blas = false; - #endif - - - #if defined(ARMA_USE_ATLAS) - static constexpr bool atlas = true; - #else - static constexpr bool atlas = false; - #endif - - - #if defined(ARMA_USE_NEWARP) - static constexpr bool newarp = true; - #else - static constexpr bool newarp = false; - #endif - - - #if defined(ARMA_USE_ARPACK) - static constexpr bool arpack = true; - #else - static constexpr bool arpack = false; - #endif - - - #if defined(ARMA_USE_SUPERLU) - static constexpr bool superlu = true; - #else - static constexpr bool superlu = false; - #endif - - - #if defined(ARMA_USE_HDF5) - static constexpr bool hdf5 = true; - #else - static constexpr bool hdf5 = false; - #endif - - - #if defined(ARMA_GOOD_COMPILER) - static constexpr bool good_comp = true; - #else - static constexpr bool good_comp = false; - #endif - - - #if ( \ - defined(ARMA_EXTRA_MAT_PROTO) || defined(ARMA_EXTRA_MAT_MEAT) \ - || defined(ARMA_EXTRA_COL_PROTO) || defined(ARMA_EXTRA_COL_MEAT) \ - || defined(ARMA_EXTRA_ROW_PROTO) || defined(ARMA_EXTRA_ROW_MEAT) \ - || defined(ARMA_EXTRA_CUBE_PROTO) || defined(ARMA_EXTRA_CUBE_MEAT) \ - || defined(ARMA_EXTRA_FIELD_PROTO) || defined(ARMA_EXTRA_FIELD_MEAT) \ - || defined(ARMA_EXTRA_SPMAT_PROTO) || defined(ARMA_EXTRA_SPMAT_MEAT) \ - || defined(ARMA_EXTRA_SPCOL_PROTO) || defined(ARMA_EXTRA_SPCOL_MEAT) \ - || defined(ARMA_EXTRA_SPROW_PROTO) || defined(ARMA_EXTRA_SPROW_MEAT) \ - || defined(ARMA_ALIEN_MEM_ALLOC_FUNCTION) \ - || defined(ARMA_ALIEN_MEM_FREE_FUNCTION) \ - ) - static constexpr bool extra_code = true; - #else - static constexpr bool extra_code = false; - #endif - - - #if defined(ARMA_HAVE_CXX14) - static constexpr bool cxx14 = true; - #else - static constexpr bool cxx14 = false; - #endif - - - #if defined(ARMA_HAVE_CXX17) - static constexpr bool cxx17 = true; - #else - static constexpr bool cxx17 = false; - #endif - - - #if defined(ARMA_HAVE_CXX20) - static constexpr bool cxx20 = true; - #else - static constexpr bool cxx20 = false; - #endif - - - #if defined(ARMA_HAVE_CXX23) - static constexpr bool cxx23 = true; - #else - static constexpr bool cxx23 = false; - #endif - - - #if defined(ARMA_USE_STD_MUTEX) - static constexpr bool std_mutex = true; - #else - static constexpr bool std_mutex = false; - #endif - - - #if (defined(_POSIX_C_SOURCE) && (_POSIX_C_SOURCE >= 200112L)) - static constexpr bool posix = true; - #else - static constexpr bool posix = false; - #endif - - - #if defined(ARMA_USE_WRAPPER) - static constexpr bool wrapper = true; - #else - static constexpr bool wrapper = false; - #endif - - - #if defined(ARMA_USE_OPENMP) - static constexpr bool openmp = true; - #else - static constexpr bool openmp = false; - #endif - - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - static constexpr bool hidden_args = true; - #else - static constexpr bool hidden_args = false; - #endif - - - #if defined(ARMA_FAST_MATH) - static constexpr bool fast_math = true; - #else - static constexpr bool fast_math = false; - #endif - - - #if defined(ARMA_FAST_MATH) && !defined(ARMA_DONT_PRINT_FAST_MATH_WARNING) - static constexpr bool fast_math_warn = true; - #else - static constexpr bool fast_math_warn = false; - #endif - - - #if (!defined(ARMA_DONT_TREAT_TEXT_AS_BINARY)) - static constexpr bool text_as_binary = true; - #else - static constexpr bool text_as_binary = false; - #endif - - - static constexpr uword warn_level = (sword(ARMA_WARN_LEVEL) > 0) ? uword(ARMA_WARN_LEVEL) : 0; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_forward.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_forward.hpp deleted file mode 100644 index b35d64ef4..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_forward.hpp +++ /dev/null @@ -1,487 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -using std::cout; -using std::cerr; -using std::endl; -using std::ios; -using std::size_t; - -template struct Base; -template struct BaseCube; - -template class Mat; -template class Col; -template class Row; -template class Cube; -template class xvec_htrans; -template class field; - -template class xtrans_mat; - - -template class subview; -template class subview_col; -template class subview_cols; -template class subview_row; -template class subview_row_strans; -template class subview_row_htrans; -template class subview_cube; -template class subview_field; - -template class SpValProxy; -template class SpMat; -template class SpCol; -template class SpRow; -template class SpSubview; -template class SpSubview_col; -template class SpSubview_row; - -template class diagview; -template class spdiagview; - -template class MapMat; -template class MapMat_val; -template class SpMat_MapMat_val; -template class SpSubview_MapMat_val; - -template class subview_elem1; -template class subview_elem2; - -template class subview_each1; -template class subview_each2; - -template class subview_cube_each1; -template class subview_cube_each2; -template class subview_cube_slices; - -template class SpSubview_col_list; - - -class SizeMat; -class SizeCube; - -class arma_empty_class {}; - -class diskio; - -class op_strans; -class op_htrans; -class op_htrans2; -class op_inv_gen_default; -class op_inv_spd_default; -class op_inv_gen_full; -class op_inv_spd_full; -class op_diagmat; -class op_trimat; -class op_vectorise_row; -class op_vectorise_col; - -class op_row_as_mat; -class op_col_as_mat; - -class glue_times; -class glue_times_diag; - -class glue_rel_lt; -class glue_rel_gt; -class glue_rel_lteq; -class glue_rel_gteq; -class glue_rel_eq; -class glue_rel_noteq; -class glue_rel_and; -class glue_rel_or; - -class op_rel_lt_pre; -class op_rel_lt_post; -class op_rel_gt_pre; -class op_rel_gt_post; -class op_rel_lteq_pre; -class op_rel_lteq_post; -class op_rel_gteq_pre; -class op_rel_gteq_post; -class op_rel_eq; -class op_rel_noteq; - -class gen_eye; -class gen_ones; -class gen_zeros; - - - -class spop_strans; -class spop_htrans; -class spop_vectorise_row; -class spop_vectorise_col; - -class spop_rel_lt_pre; -class spop_rel_lt_post; -class spop_rel_gt_pre; -class spop_rel_gt_post; -class spop_rel_lteq_pre; -class spop_rel_lteq_post; -class spop_rel_gteq_pre; -class spop_rel_gteq_post; -class spop_rel_eq; -class spop_rel_noteq; - -class spglue_plus; -class spglue_minus; -class spglue_schur; -class spglue_times; -class spglue_max; -class spglue_min; -class spglue_rel_lt; -class spglue_rel_gt; - -class op_sp_as_dense; - -class op_internal_equ; -class op_internal_plus; -class op_internal_minus; -class op_internal_schur; -class op_internal_div; - - - -struct traits_op_default - { - template - struct traits - { - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - }; - }; - - -struct traits_op_xvec - { - template - struct traits - { - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = true; - }; - }; - - -struct traits_op_col - { - template - struct traits - { - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - }; - }; - - -struct traits_op_row - { - template - struct traits - { - static constexpr bool is_row = true; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - }; - }; - - -struct traits_op_passthru - { - template - struct traits - { - static constexpr bool is_row = T1::is_row; - static constexpr bool is_col = T1::is_col; - static constexpr bool is_xvec = T1::is_xvec; - }; - }; - - -struct traits_glue_default - { - template - struct traits - { - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - }; - }; - - -struct traits_glue_or - { - template - struct traits - { - static constexpr bool is_row = (T1::is_row || T2::is_row ); - static constexpr bool is_col = (T1::is_col || T2::is_col ); - static constexpr bool is_xvec = (T1::is_xvec || T2::is_xvec); - }; - }; - - - -template class gemm; -template class gemv; - - -template< typename eT, typename gen_type> class Gen; - -template< typename T1, typename op_type> class Op; -template< typename T1, typename eop_type> class eOp; -template< typename T1, typename op_type> class SpToDOp; -template< typename T1, typename op_type> class CubeToMatOp; -template class mtOp; - -template< typename T1, typename T2, typename glue_type> class Glue; -template< typename T1, typename T2, typename eglue_type> class eGlue; -template< typename T1, typename T2, typename glue_type> class SpToDGlue; -template class mtGlue; - - - -template< typename eT, typename gen_type> class GenCube; - -template< typename T1, typename op_type> class OpCube; -template< typename T1, typename eop_type> class eOpCube; -template class mtOpCube; - -template< typename T1, typename T2, typename glue_type> class GlueCube; -template< typename T1, typename T2, typename eglue_type> class eGlueCube; -template class mtGlueCube; - - -template struct Proxy; -template struct ProxyCube; - -template class diagmat_proxy; - -template struct unwrap; -template struct quasi_unwrap; -template struct unwrap_cube; -template struct unwrap_spmat; - - - - -struct state_type - { - #if defined(ARMA_USE_OPENMP) - int state; - #elif defined(ARMA_USE_STD_MUTEX) - std::atomic state; - #else - int state; - #endif - - arma_inline state_type() : state(int(0)) {} - - // openmp: "omp atomic" does an implicit flush on the affected variable - // C++11: std::atomic<>::load() and std::atomic<>::store() use std::memory_order_seq_cst by default, which has an implied fence - - arma_inline - operator int () const - { - int out; - - #if defined(ARMA_USE_OPENMP) - #pragma omp atomic read - out = state; - #elif defined(ARMA_USE_STD_MUTEX) - out = state.load(); - #else - out = state; - #endif - - return out; - } - - arma_inline - void - operator= (const int in_state) - { - #if defined(ARMA_USE_OPENMP) - #pragma omp atomic write - state = in_state; - #elif defined(ARMA_USE_STD_MUTEX) - state.store(in_state); - #else - state = in_state; - #endif - } - }; - - -template< typename T1, typename spop_type> class SpOp; -template class mtSpOp; -template class mtSpReduceOp; - -template< typename T1, typename T2, typename spglue_type> class SpGlue; -template class mtSpGlue; - - -template struct SpProxy; - - - -struct arma_vec_indicator {}; -struct arma_fixed_indicator {}; -struct arma_reserve_indicator {}; -struct arma_layout_indicator {}; - -template struct arma_initmode_indicator {}; - -struct arma_zeros_indicator : public arma_initmode_indicator {}; -struct arma_nozeros_indicator : public arma_initmode_indicator {}; - - -//! \addtogroup injector -//! @{ - -template struct injector_end_of_row {}; - -// DEPRECATED: DO NOT USE IN NEW CODE -static const injector_end_of_row<> endr = injector_end_of_row<>(); -//!< endr indicates "end of row" when using the << operator; -//!< similar conceptual meaning to std::endl - -//! @} - - - -//! \addtogroup diskio -//! @{ - - -enum struct file_type : unsigned int - { - file_type_unknown, - auto_detect, //!< attempt to automatically detect the file type - raw_ascii, //!< raw text (ASCII), without a header - arma_ascii, //!< Armadillo text format, with a header specifying matrix type and size - csv_ascii, //!< comma separated values (CSV), without a header - raw_binary, //!< raw binary format (machine dependent), without a header - arma_binary, //!< Armadillo binary format (machine dependent), with a header specifying matrix type and size - pgm_binary, //!< Portable Grey Map (greyscale image) - ppm_binary, //!< Portable Pixel Map (colour image), used by the field and cube classes - hdf5_binary, //!< HDF5: open binary format, not specific to Armadillo, which can store arbitrary data - hdf5_binary_trans, //!< [NOTE: DO NOT USE - deprecated] as per hdf5_binary, but save/load the data with columns transposed to rows - coord_ascii, //!< simple co-ordinate format for sparse matrices (indices start at zero) - ssv_ascii, //!< similar to csv_ascii; uses semicolon (;) instead of comma (,) as the separator - }; - - -static constexpr file_type file_type_unknown = file_type::file_type_unknown; -static constexpr file_type auto_detect = file_type::auto_detect; -static constexpr file_type raw_ascii = file_type::raw_ascii; -static constexpr file_type arma_ascii = file_type::arma_ascii; -static constexpr file_type csv_ascii = file_type::csv_ascii; -static constexpr file_type raw_binary = file_type::raw_binary; -static constexpr file_type arma_binary = file_type::arma_binary; -static constexpr file_type pgm_binary = file_type::pgm_binary; -static constexpr file_type ppm_binary = file_type::ppm_binary; -static constexpr file_type hdf5_binary = file_type::hdf5_binary; -static constexpr file_type hdf5_binary_trans = file_type::hdf5_binary_trans; -static constexpr file_type coord_ascii = file_type::coord_ascii; -static constexpr file_type ssv_ascii = file_type::ssv_ascii; - - -struct hdf5_name; -struct csv_name; - - -//! @} - - - -//! \addtogroup fn_spsolve -//! @{ - - -struct spsolve_opts_base - { - const unsigned int id; - - inline spsolve_opts_base(const unsigned int in_id) : id(in_id) {} - }; - - -struct spsolve_opts_none : public spsolve_opts_base - { - inline spsolve_opts_none() : spsolve_opts_base(0) {} - }; - - -struct superlu_opts : public spsolve_opts_base - { - typedef enum {NATURAL, MMD_ATA, MMD_AT_PLUS_A, COLAMD} permutation_type; - - typedef enum {REF_NONE, REF_SINGLE, REF_DOUBLE, REF_EXTRA} refine_type; - - bool allow_ugly; - bool equilibrate; - bool symmetric; - double pivot_thresh; - permutation_type permutation; - refine_type refine; - - inline superlu_opts() - : spsolve_opts_base(1) - { - allow_ugly = false; - equilibrate = false; - symmetric = false; - pivot_thresh = 1.0; - permutation = COLAMD; - refine = REF_NONE; - } - }; - - -//! @} - - - -//! \ingroup fn_eigs_sym fs_eigs_gen -//! @{ - - -struct eigs_opts - { - double tol; // tolerance - unsigned int maxiter; // max iterations - unsigned int subdim; // subspace dimension - - inline eigs_opts() - { - tol = 0.0; - maxiter = 1000; - subdim = 0; - } - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_ostream_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_ostream_bones.hpp deleted file mode 100644 index e59c26fc2..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_ostream_bones.hpp +++ /dev/null @@ -1,79 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup arma_ostream -//! @{ - - - -class arma_ostream_state - { - private: - - const ios::fmtflags orig_flags; - const std::streamsize orig_precision; - const std::streamsize orig_width; - const char orig_fill; - - - public: - - inline arma_ostream_state(const std::ostream& o); - - inline void restore(std::ostream& o) const; - }; - - - -class arma_ostream - { - public: - - template inline static std::streamsize modify_stream(std::ostream& o, const eT* data, const uword n_elem); - template inline static std::streamsize modify_stream(std::ostream& o, const std::complex* data, const uword n_elem); - template inline static std::streamsize modify_stream(std::ostream& o, typename SpMat::const_iterator begin, const uword n_elem, const typename arma_not_cx::result* junk = nullptr); - template inline static std::streamsize modify_stream(std::ostream& o, typename SpMat::const_iterator begin, const uword n_elem, const typename arma_cx_only::result* junk = nullptr); - - template inline static void print_elem_zero(std::ostream& o, const bool modify); - - template inline static void print_elem(std::ostream& o, const eT& x, const bool modify); - template inline static void raw_print_elem(std::ostream& o, const eT& x); - - template inline static void print_elem(std::ostream& o, const std::complex& x, const bool modify); - template inline static void raw_print_elem(std::ostream& o, const std::complex& x); - - template arma_cold inline static void print(std::ostream& o, const Mat& m, const bool modify); - template arma_cold inline static void print(std::ostream& o, const Cube& m, const bool modify); - - template arma_cold inline static void print(std::ostream& o, const field& m); - template arma_cold inline static void print(std::ostream& o, const subview_field& m); - - template arma_cold inline static void print_dense(std::ostream& o, const SpMat& m, const bool modify); - template arma_cold inline static void print(std::ostream& o, const SpMat& m, const bool modify); - - arma_cold inline static void print(std::ostream& o, const SizeMat& S); - arma_cold inline static void print(std::ostream& o, const SizeCube& S); - - template arma_cold inline static void brief_print(std::ostream& o, const Mat& m, const bool print_size = true); - template arma_cold inline static void brief_print(std::ostream& o, const Cube& m); - template arma_cold inline static void brief_print(std::ostream& o, const SpMat& m); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_ostream_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_ostream_meat.hpp deleted file mode 100644 index bf79a1b7d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_ostream_meat.hpp +++ /dev/null @@ -1,1274 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup arma_ostream -//! @{ - - - -inline -arma_ostream_state::arma_ostream_state(const std::ostream& o) - : orig_flags (o.flags()) - , orig_precision(o.precision()) - , orig_width (o.width()) - , orig_fill (o.fill()) - { - } - - - -inline -void -arma_ostream_state::restore(std::ostream& o) const - { - o.flags (orig_flags); - o.precision(orig_precision); - o.width (orig_width); - o.fill (orig_fill); - } - - - -// -// - - - -template -inline -std::streamsize -arma_ostream::modify_stream(std::ostream& o, const eT* data, const uword n_elem) - { - o.unsetf(ios::showbase); - o.unsetf(ios::uppercase); - o.unsetf(ios::showpos); - - o.fill(' '); - - std::streamsize cell_width; - - bool use_layout_B = false; - bool use_layout_C = false; - bool use_layout_D = false; - - for(uword i=0; i 4) && (is_same_type::yes || is_same_type::yes) >::geq(val, eT(+10000000000)) ) - || - ( cond_rel< (sizeof(eT) > 4) && is_same_type::yes >::leq(val, eT(-10000000000)) ) - ) - { - use_layout_D = true; - break; - } - - if( - ( val >= eT(+100) ) - || - //( (is_signed::value) && (val <= eT(-100)) ) || - //( (is_non_integral::value) && (val > eT(0)) && (val <= eT(+1e-4)) ) || - //( (is_non_integral::value) && (is_signed::value) && (val < eT(0)) && (val >= eT(-1e-4)) ) - ( - cond_rel< is_signed::value >::leq(val, eT(-100)) - ) - || - ( - cond_rel< is_non_integral::value >::gt(val, eT(0)) - && - cond_rel< is_non_integral::value >::leq(val, eT(+1e-4)) - ) - || - ( - cond_rel< is_non_integral::value && is_signed::value >::lt(val, eT(0)) - && - cond_rel< is_non_integral::value && is_signed::value >::geq(val, eT(-1e-4)) - ) - ) - { - use_layout_C = true; - break; - } - - if( - // (val >= eT(+10)) || ( (is_signed::value) && (val <= eT(-10)) ) - (val >= eT(+10)) || ( cond_rel< is_signed::value >::leq(val, eT(-10)) ) - ) - { - use_layout_B = true; - } - } - - if(use_layout_D) - { - o.setf(ios::scientific); - o.setf(ios::right); - o.unsetf(ios::fixed); - o.precision(4); - cell_width = 21; - } - else - if(use_layout_C) - { - o.setf(ios::scientific); - o.setf(ios::right); - o.unsetf(ios::fixed); - o.precision(4); - cell_width = 13; - } - else - if(use_layout_B) - { - o.unsetf(ios::scientific); - o.setf(ios::right); - o.setf(ios::fixed); - o.precision(4); - cell_width = 10; - } - else - { - o.unsetf(ios::scientific); - o.setf(ios::right); - o.setf(ios::fixed); - o.precision(4); - cell_width = 9; - } - - return cell_width; - } - - - -//! "better than nothing" settings for complex numbers -template -inline -std::streamsize -arma_ostream::modify_stream(std::ostream& o, const std::complex* data, const uword n_elem) - { - arma_ignore(data); - arma_ignore(n_elem); - - o.unsetf(ios::showbase); - o.unsetf(ios::uppercase); - o.fill(' '); - - o.setf(ios::scientific); - o.setf(ios::showpos); - o.setf(ios::right); - o.unsetf(ios::fixed); - - std::streamsize cell_width; - - o.precision(3); - cell_width = 2 + 2*(1 + 3 + o.precision() + 5) + 1; - - return cell_width; - } - - -template -inline -std::streamsize -arma_ostream::modify_stream(std::ostream& o, typename SpMat::const_iterator begin, const uword n_elem, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - o.unsetf(ios::showbase); - o.unsetf(ios::uppercase); - o.unsetf(ios::showpos); - - o.fill(' '); - - std::streamsize cell_width; - - bool use_layout_B = false; - bool use_layout_C = false; - - for(typename SpMat::const_iterator it = begin; it.pos() < n_elem; ++it) - { - const eT val = (*it); - - if(arma_isfinite(val) == false) { continue; } - - if( - val >= eT(+100) || - ( (is_signed::value) && (val <= eT(-100)) ) || - ( (is_non_integral::value) && (val > eT(0)) && (val <= eT(+1e-4)) ) || - ( (is_non_integral::value) && (is_signed::value) && (val < eT(0)) && (val >= eT(-1e-4)) ) - ) - { - use_layout_C = true; - break; - } - - if( - (val >= eT(+10)) || ( (is_signed::value) && (val <= eT(-10)) ) - ) - { - use_layout_B = true; - } - } - - if(use_layout_C) - { - o.setf(ios::scientific); - o.setf(ios::right); - o.unsetf(ios::fixed); - o.precision(4); - cell_width = 13; - } - else - if(use_layout_B) - { - o.unsetf(ios::scientific); - o.setf(ios::right); - o.setf(ios::fixed); - o.precision(4); - cell_width = 10; - } - else - { - o.unsetf(ios::scientific); - o.setf(ios::right); - o.setf(ios::fixed); - o.precision(4); - cell_width = 9; - } - - return cell_width; - } - - - -//! "better than nothing" settings for complex numbers -template -inline -std::streamsize -arma_ostream::modify_stream(std::ostream& o, typename SpMat::const_iterator begin, const uword n_elem, const typename arma_cx_only::result* junk) - { - arma_ignore(begin); - arma_ignore(n_elem); - arma_ignore(junk); - - o.unsetf(ios::showbase); - o.unsetf(ios::uppercase); - o.fill(' '); - - o.setf(ios::scientific); - o.setf(ios::showpos); - o.setf(ios::right); - o.unsetf(ios::fixed); - - std::streamsize cell_width; - - o.precision(3); - cell_width = 2 + 2*(1 + 3 + o.precision() + 5) + 1; - - return cell_width; - } - - - -template -inline -void -arma_ostream::print_elem_zero(std::ostream& o, const bool modify) - { - typedef typename promote_type::result promoted_eT; - - if(modify) - { - const ios::fmtflags save_flags = o.flags(); - const std::streamsize save_precision = o.precision(); - - o.unsetf(ios::scientific); - o.setf(ios::fixed); - o.precision(0); - - o << promoted_eT(0); - - o.flags(save_flags); - o.precision(save_precision); - } - else - { - o << promoted_eT(0); - } - } - - - -template -inline -void -arma_ostream::print_elem(std::ostream& o, const eT& x, const bool modify) - { - if(x == eT(0)) - { - arma_ostream::print_elem_zero(o, modify); - } - else - { - arma_ostream::raw_print_elem(o, x); - } - } - - - -template -inline -void -arma_ostream::raw_print_elem(std::ostream& o, const eT& x) - { - if(is_signed::value) - { - typedef typename promote_type::result promoted_eT; - - if(arma_isfinite(x)) - { - o << promoted_eT(x); - } - else - { - o << ( arma_isinf(x) ? ((x <= eT(0)) ? "-inf" : "inf") : "nan" ); - } - } - else - { - typedef typename promote_type::result promoted_eT; - - o << promoted_eT(x); - } - } - - - -template -inline -void -arma_ostream::print_elem(std::ostream& o, const std::complex& x, const bool modify) - { - if( (x.real() == T(0)) && (x.imag() == T(0)) && (modify) ) - { - o << "(0,0)"; - } - else - { - arma_ostream::raw_print_elem(o, x); - } - } - - - -template -inline -void -arma_ostream::raw_print_elem(std::ostream& o, const std::complex& x) - { - std::ostringstream ss; - ss.flags(o.flags()); - //ss.imbue(o.getloc()); - ss.precision(o.precision()); - - ss << '('; - - const T a = x.real(); - - if(arma_isfinite(a)) - { - ss << a; - } - else - { - ss << ( arma_isinf(a) ? ((a <= T(0)) ? "-inf" : "+inf") : "nan" ); - } - - ss << ','; - - const T b = x.imag(); - - if(arma_isfinite(b)) - { - ss << b; - } - else - { - ss << ( arma_isinf(b) ? ((b <= T(0)) ? "-inf" : "+inf") : "nan" ); - } - - ss << ')'; - - o << ss.str(); - } - - - -//! Print a matrix to the specified stream -template -inline -void -arma_ostream::print(std::ostream& o, const Mat& m, const bool modify) - { - arma_debug_sigprint(); - - const arma_ostream_state stream_state(o); - - const std::streamsize cell_width = modify ? arma_ostream::modify_stream(o, m.memptr(), m.n_elem) : o.width(); - - const uword m_n_rows = m.n_rows; - const uword m_n_cols = m.n_cols; - - if(m.is_empty() == false) - { - if(m_n_cols > 0) - { - if(cell_width > 0) - { - for(uword row=0; row < m_n_rows; ++row) - { - for(uword col=0; col < m_n_cols; ++col) - { - // the cell width appears to be reset after each element is printed, - // hence we need to restore it - o.width(cell_width); - arma_ostream::print_elem(o, m.at(row,col), modify); - } - - o << '\n'; - } - } - else - { - for(uword row=0; row < m_n_rows; ++row) - { - for(uword col=0; col < m_n_cols-1; ++col) - { - arma_ostream::print_elem(o, m.at(row,col), modify); - o << ' '; - } - - arma_ostream::print_elem(o, m.at(row, m_n_cols-1), modify); - o << '\n'; - } - } - } - } - else - { - if(modify) - { - o.unsetf(ios::showbase); - o.unsetf(ios::uppercase); - o.unsetf(ios::showpos); - o.setf(ios::fixed); - } - - o << "[matrix size: " << m_n_rows << 'x' << m_n_cols << "]\n"; - } - - o.flush(); - stream_state.restore(o); - } - - - -//! Print a cube to the specified stream -template -inline -void -arma_ostream::print(std::ostream& o, const Cube& x, const bool modify) - { - arma_debug_sigprint(); - - const arma_ostream_state stream_state(o); - - if(x.is_empty() == false) - { - for(uword slice=0; slice < x.n_slices; ++slice) - { - const Mat tmp(const_cast(x.slice_memptr(slice)), x.n_rows, x.n_cols, false); - - o << "[cube slice: " << slice << ']' << '\n'; - arma_ostream::print(o, tmp, modify); - - if((slice+1) < x.n_slices) { o << '\n'; } - } - } - else - { - if(modify) - { - o.unsetf(ios::showbase); - o.unsetf(ios::uppercase); - o.unsetf(ios::showpos); - o.setf(ios::fixed); - } - - o << "[cube size: " << x.n_rows << 'x' << x.n_cols << 'x' << x.n_slices << "]\n"; - } - - stream_state.restore(o); - } - - - - -//! Print a field to the specified stream -//! Assumes type oT can be printed, ie. oT has std::ostream& operator<< (std::ostream&, const oT&) -template -inline -void -arma_ostream::print(std::ostream& o, const field& x) - { - arma_debug_sigprint(); - - const arma_ostream_state stream_state(o); - - const std::streamsize cell_width = o.width(); - - const uword x_n_rows = x.n_rows; - const uword x_n_cols = x.n_cols; - const uword x_n_slices = x.n_slices; - - if(x.is_empty() == false) - { - if(x_n_slices == 1) - { - for(uword col=0; col < x_n_cols; ++col) - { - o << "[field column: " << col << ']' << '\n'; - - for(uword row=0; row < x_n_rows; ++row) - { - o.width(cell_width); - o << x.at(row,col) << '\n'; - } - - o << '\n'; - } - } - else - { - for(uword slice=0; slice < x_n_slices; ++slice) - { - o << "[field slice: " << slice << ']' << '\n'; - - for(uword col=0; col < x_n_cols; ++col) - { - o << "[field column: " << col << ']' << '\n'; - - for(uword row=0; row < x_n_rows; ++row) - { - o.width(cell_width); - o << x.at(row,col,slice) << '\n'; - } - - o << '\n'; - } - - o << '\n'; - } - } - } - else - { - o.unsetf(ios::showbase); - o.unsetf(ios::uppercase); - o.unsetf(ios::showpos); - o.setf(ios::fixed); - - o << "[field size: " << x_n_rows << 'x' << x_n_cols << 'x' << x_n_slices << "]\n"; - } - - o.flush(); - stream_state.restore(o); - } - - - -//! Print a subfield to the specified stream -//! Assumes type oT can be printed, ie. oT has std::ostream& operator<< (std::ostream&, const oT&) -template -inline -void -arma_ostream::print(std::ostream& o, const subview_field& x) - { - arma_debug_sigprint(); - - const arma_ostream_state stream_state(o); - - const std::streamsize cell_width = o.width(); - - const uword x_n_rows = x.n_rows; - const uword x_n_cols = x.n_cols; - const uword x_n_slices = x.n_slices; - - if(x.is_empty() == false) - { - if(x_n_slices == 1) - { - for(uword col=0; col < x_n_cols; ++col) - { - o << "[field column: " << col << ']' << '\n'; - for(uword row=0; row -inline -void -arma_ostream::print_dense(std::ostream& o, const SpMat& m, const bool modify) - { - arma_debug_sigprint(); - - const arma_ostream_state stream_state(o); - - std::streamsize cell_width = o.width(); - - if(modify) - { - if(m.n_nonzero > 0) - { - cell_width = arma_ostream::modify_stream(o, m.begin(), m.n_nonzero); - } - else - { - eT tmp[1]; tmp[0] = eT(0); - - cell_width = arma_ostream::modify_stream(o, &tmp[0], 1); - } - } - - const uword m_n_rows = m.n_rows; - const uword m_n_cols = m.n_cols; - - if(m.is_empty() == false) - { - if(m_n_cols > 0) - { - if(cell_width > 0) - { - for(uword row=0; row < m_n_rows; ++row) - { - for(uword col=0; col < m_n_cols; ++col) - { - // the cell width appears to be reset after each element is printed, - // hence we need to restore it - o.width(cell_width); - arma_ostream::print_elem(o, m.at(row,col), modify); - } - - o << '\n'; - } - } - else - { - for(uword row=0; row < m_n_rows; ++row) - { - for(uword col=0; col < m_n_cols-1; ++col) - { - arma_ostream::print_elem(o, m.at(row,col), modify); - o << ' '; - } - - arma_ostream::print_elem(o, m.at(row, m_n_cols-1), modify); - o << '\n'; - } - } - } - } - else - { - if(modify) - { - o.unsetf(ios::showbase); - o.unsetf(ios::uppercase); - o.unsetf(ios::showpos); - o.setf(ios::fixed); - } - - o << "[matrix size: " << m_n_rows << 'x' << m_n_cols << "]\n"; - } - - o.flush(); - stream_state.restore(o); - } - - - -template -inline -void -arma_ostream::print(std::ostream& o, const SpMat& m, const bool modify) - { - arma_debug_sigprint(); - - const arma_ostream_state stream_state(o); - - o.unsetf(ios::showbase); - o.unsetf(ios::uppercase); - o.unsetf(ios::showpos); - o.unsetf(ios::scientific); - o.setf(ios::right); - o.setf(ios::fixed); - - const uword m_n_nonzero = m.n_nonzero; - const double density = (m.n_elem > 0) ? (double(m_n_nonzero) / double(m.n_elem) * double(100)) : double(0); - - o << "[matrix size: " << m.n_rows << 'x' << m.n_cols << "; n_nonzero: " << m_n_nonzero; - - if(density == double(0)) - { - o.precision(0); - } - else - if(density >= (double(10.0)-std::numeric_limits::epsilon())) - { - o.precision(1); - } - else - if(density > (double(0.01)-std::numeric_limits::epsilon())) - { - o.precision(2); - } - else - if(density > (double(0.001)-std::numeric_limits::epsilon())) - { - o.precision(3); - } - else - if(density > (double(0.0001)-std::numeric_limits::epsilon())) - { - o.precision(4); - } - else - { - o.unsetf(ios::fixed); - o.setf(ios::scientific); - o.precision(2); - } - - o << "; density: " << density << "%]\n\n"; - - if(modify == false) { stream_state.restore(o); } - - if(m_n_nonzero > 0) - { - const std::streamsize cell_width = modify ? arma_ostream::modify_stream(o, m.begin(), m_n_nonzero) : o.width(); - - typename SpMat::const_iterator it = m.begin(); - typename SpMat::const_iterator it_end = m.end(); - - while(it != it_end) - { - const uword row = it.row(); - const uword col = it.col(); - - // TODO: change the maximum number of spaces before and after each location to be dependent on n_rows and n_cols - - if(row < 10) { o << " "; } - else if(row < 100) { o << " "; } - else if(row < 1000) { o << " "; } - else if(row < 10000) { o << " "; } - else if(row < 100000) { o << " "; } - else if(row < 1000000) { o << ' '; } - - o << '(' << row << ", " << col << ") "; - - if(col < 10) { o << " "; } - else if(col < 100) { o << " "; } - else if(col < 1000) { o << " "; } - else if(col < 10000) { o << " "; } - else if(col < 100000) { o << " "; } - else if(col < 1000000) { o << ' '; } - - if(cell_width > 0) { o.width(cell_width); } - - arma_ostream::print_elem(o, eT(*it), modify); - o << '\n'; - - ++it; - } - - o << '\n'; - } - - o.flush(); - stream_state.restore(o); - } - - - -inline -void -arma_ostream::print(std::ostream& o, const SizeMat& S) - { - arma_debug_sigprint(); - - const arma_ostream_state stream_state(o); - - o.unsetf(ios::showbase); - o.unsetf(ios::uppercase); - o.unsetf(ios::showpos); - - o.setf(ios::fixed); - - o << S.n_rows << 'x' << S.n_cols; - - stream_state.restore(o); - } - - - -inline -void -arma_ostream::print(std::ostream& o, const SizeCube& S) - { - arma_debug_sigprint(); - - const arma_ostream_state stream_state(o); - - o.unsetf(ios::showbase); - o.unsetf(ios::uppercase); - o.unsetf(ios::showpos); - - o.setf(ios::fixed); - - o << S.n_rows << 'x' << S.n_cols << 'x' << S.n_slices; - - stream_state.restore(o); - } - - - -template -inline -void -arma_ostream::brief_print(std::ostream& o, const Mat& m, const bool print_size) - { - arma_debug_sigprint(); - - const arma_ostream_state stream_state(o); - - if(print_size) - { - o.unsetf(ios::showbase); - o.unsetf(ios::uppercase); - o.unsetf(ios::showpos); - o.setf(ios::fixed); - - o << "[matrix size: " << m.n_rows << 'x' << m.n_cols << "]\n"; - } - - if(m.n_elem == 0) { o.flush(); stream_state.restore(o); return; } - - if((m.n_rows <= 5) && (m.n_cols <= 5)) { arma_ostream::print(o, m, true); return; } - - const bool print_row_ellipsis = (m.n_rows >= 6); - const bool print_col_ellipsis = (m.n_cols >= 6); - - if( (print_row_ellipsis == true) && (print_col_ellipsis == true) ) - { - Mat X(4, 4, arma_nozeros_indicator()); - - X( span(0,2), span(0,2) ) = m( span(0,2), span(0,2) ); // top left submatrix - X( 3, span(0,2) ) = m( m.n_rows-1, span(0,2) ); // truncated last row - X( span(0,2), 3 ) = m( span(0,2), m.n_cols-1 ); // truncated last column - X( 3, 3 ) = m( m.n_rows-1, m.n_cols-1 ); // bottom right element - - const std::streamsize cell_width = arma_ostream::modify_stream(o, X.memptr(), X.n_elem); - - for(uword row=0; row <= 2; ++row) - { - for(uword col=0; col <= 2; ++col) - { - o.width(cell_width); - arma_ostream::print_elem(o, X.at(row,col), true); - } - - o.width(6); - o << "..."; - - o.width(cell_width); - arma_ostream::print_elem(o, X.at(row,3), true); - o << '\n'; - } - - for(uword col=0; col <= 2; ++col) - { - o.width(cell_width); - o << ':'; - } - - o.width(6); - o << "..."; - - o.width(cell_width); - o << ':' << '\n'; - - const uword row = 3; - { - for(uword col=0; col <= 2; ++col) - { - o.width(cell_width); - arma_ostream::print_elem(o, X.at(row,col), true); - } - - o.width(6); - o << "..."; - - o.width(cell_width); - arma_ostream::print_elem(o, X.at(row,3), true); - o << '\n'; - } - } - - - if( (print_row_ellipsis == true) && (print_col_ellipsis == false) ) - { - Mat X(4, m.n_cols, arma_nozeros_indicator()); - - X( span(0,2), span::all ) = m( span(0,2), span::all ); // top - X( 3, span::all ) = m( m.n_rows-1, span::all ); // bottom - - const std::streamsize cell_width = arma_ostream::modify_stream(o, X.memptr(), X.n_elem); - - for(uword row=0; row <= 2; ++row) // first 3 rows - { - for(uword col=0; col < m.n_cols; ++col) - { - o.width(cell_width); - arma_ostream::print_elem(o, X.at(row,col), true); - } - - o << '\n'; - } - - for(uword col=0; col < m.n_cols; ++col) - { - o.width(cell_width); - o << ':'; - } - - o.width(cell_width); - o << '\n'; - - const uword row = 3; - { - for(uword col=0; col < m.n_cols; ++col) - { - o.width(cell_width); - arma_ostream::print_elem(o, X.at(row,col), true); - } - } - - o << '\n'; - } - - - if( (print_row_ellipsis == false) && (print_col_ellipsis == true) ) - { - Mat X(m.n_rows, 4, arma_nozeros_indicator()); - - X( span::all, span(0,2) ) = m( span::all, span(0,2) ); // left - X( span::all, 3 ) = m( span::all, m.n_cols-1 ); // right - - const std::streamsize cell_width = arma_ostream::modify_stream(o, X.memptr(), X.n_elem); - - for(uword row=0; row < m.n_rows; ++row) - { - for(uword col=0; col <= 2; ++col) - { - o.width(cell_width); - arma_ostream::print_elem(o, X.at(row,col), true); - } - - o.width(6); - o << "..."; - - o.width(cell_width); - arma_ostream::print_elem(o, X.at(row,3), true); - o << '\n'; - } - } - - - o.flush(); - stream_state.restore(o); - } - - - -template -inline -void -arma_ostream::brief_print(std::ostream& o, const Cube& x) - { - arma_debug_sigprint(); - - const arma_ostream_state stream_state(o); - - o.unsetf(ios::showbase); - o.unsetf(ios::uppercase); - o.unsetf(ios::showpos); - o.setf(ios::fixed); - - o << "[cube size: " << x.n_rows << 'x' << x.n_cols << 'x' << x.n_slices << "]\n"; - - if(x.n_elem == 0) { o.flush(); stream_state.restore(o); return; } - - if(x.n_slices <= 3) - { - for(uword slice=0; slice < x.n_slices; ++slice) - { - const Mat tmp(const_cast(x.slice_memptr(slice)), x.n_rows, x.n_cols, false); - - o << "[cube slice: " << slice << ']' << '\n'; - arma_ostream::brief_print(o, tmp, false); - - if((slice+1) < x.n_slices) { o << '\n'; } - } - } - else - { - for(uword slice=0; slice <= 1; ++slice) - { - const Mat tmp(const_cast(x.slice_memptr(slice)), x.n_rows, x.n_cols, false); - - o << "[cube slice: " << slice << ']' << '\n'; - arma_ostream::brief_print(o, tmp, false); - o << '\n'; - } - - o << "[cube slice: ...]\n\n"; - - const uword slice = x.n_slices-1; - { - const Mat tmp(const_cast(x.slice_memptr(slice)), x.n_rows, x.n_cols, false); - - o << "[cube slice: " << slice << ']' << '\n'; - arma_ostream::brief_print(o, tmp, false); - } - } - - stream_state.restore(o); - } - - - -template -inline -void -arma_ostream::brief_print(std::ostream& o, const SpMat& m) - { - arma_debug_sigprint(); - - if(m.n_nonzero <= 10) { arma_ostream::print(o, m, true); return; } - - const arma_ostream_state stream_state(o); - - o.unsetf(ios::showbase); - o.unsetf(ios::uppercase); - o.unsetf(ios::showpos); - o.unsetf(ios::scientific); - o.setf(ios::right); - o.setf(ios::fixed); - - const uword m_n_nonzero = m.n_nonzero; - const double density = (m.n_elem > 0) ? (double(m_n_nonzero) / double(m.n_elem) * double(100)) : double(0); - - o << "[matrix size: " << m.n_rows << 'x' << m.n_cols << "; n_nonzero: " << m_n_nonzero; - - if(density == double(0)) - { - o.precision(0); - } - else - if(density >= (double(10.0)-std::numeric_limits::epsilon())) - { - o.precision(1); - } - else - if(density > (double(0.01)-std::numeric_limits::epsilon())) - { - o.precision(2); - } - else - if(density > (double(0.001)-std::numeric_limits::epsilon())) - { - o.precision(3); - } - else - if(density > (double(0.0001)-std::numeric_limits::epsilon())) - { - o.precision(4); - } - else - { - o.unsetf(ios::fixed); - o.setf(ios::scientific); - o.precision(2); - } - - o << "; density: " << density << "%]\n\n"; - - // get the first 9 elements and the last element - - typename SpMat::const_iterator it = m.begin(); - typename SpMat::const_iterator it_end = m.end(); - - uvec storage_row(10); - uvec storage_col(10); - Col storage_val(10); - - uword count = 0; - - while( (it != it_end) && (count < 9) ) - { - storage_row(count) = it.row(); - storage_col(count) = it.col(); - storage_val(count) = (*it); - - ++it; - ++count; - } - - it = it_end; - --it; - - storage_row(count) = it.row(); - storage_col(count) = it.col(); - storage_val(count) = (*it); - - const std::streamsize cell_width = arma_ostream::modify_stream(o, storage_val.memptr(), 10); - - for(uword i=0; i < 9; ++i) - { - const uword row = storage_row(i); - const uword col = storage_col(i); - - if(row < 10) { o << " "; } - else if(row < 100) { o << " "; } - else if(row < 1000) { o << " "; } - else if(row < 10000) { o << " "; } - else if(row < 100000) { o << " "; } - else if(row < 1000000) { o << ' '; } - - o << '(' << row << ", " << col << ") "; - - if(col < 10) { o << " "; } - else if(col < 100) { o << " "; } - else if(col < 1000) { o << " "; } - else if(col < 10000) { o << " "; } - else if(col < 100000) { o << " "; } - else if(col < 1000000) { o << ' '; } - - if(cell_width > 0) { o.width(cell_width); } - - arma_ostream::print_elem(o, storage_val(i), true); - o << '\n'; - } - - o << " (:, :) "; - if(cell_width > 0) { o.width(cell_width); } - o << "...\n"; - - - const uword i = 9; - { - const uword row = storage_row(i); - const uword col = storage_col(i); - - if(row < 10) { o << " "; } - else if(row < 100) { o << " "; } - else if(row < 1000) { o << " "; } - else if(row < 10000) { o << " "; } - else if(row < 100000) { o << " "; } - else if(row < 1000000) { o << ' '; } - - o << '(' << row << ", " << col << ") "; - - if(col < 10) { o << " "; } - else if(col < 100) { o << " "; } - else if(col < 1000) { o << " "; } - else if(col < 10000) { o << " "; } - else if(col < 100000) { o << " "; } - else if(col < 1000000) { o << ' '; } - - if(cell_width > 0) { o.width(cell_width); } - - arma_ostream::print_elem(o, storage_val(i), true); - o << '\n'; - } - - o.flush(); - stream_state.restore(o); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_rel_comparators.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_rel_comparators.hpp deleted file mode 100644 index 977617b2a..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_rel_comparators.hpp +++ /dev/null @@ -1,170 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup arma_rel_comparators -//! @{ - - - -template -struct arma_lt_comparator - { - arma_inline bool operator() (const eT a, const eT b) const { return (a < b); } - }; - - - -template -struct arma_gt_comparator - { - arma_inline bool operator() (const eT a, const eT b) const { return (a > b); } - }; - - - -template -struct arma_leq_comparator - { - arma_inline bool operator() (const eT a, const eT b) const { return (a <= b); } - }; - - - -template -struct arma_geq_comparator - { - arma_inline bool operator() (const eT a, const eT b) const { return (a >= b); } - }; - - - -template -struct arma_lt_comparator< std::complex > - { - typedef typename std::complex eT; - - inline bool operator() (const eT& a, const eT& b) const { return (std::abs(a) < std::abs(b)); } - - // inline - // bool - // operator() (const eT& a, const eT& b) const - // { - // const T abs_a = std::abs(a); - // const T abs_b = std::abs(b); - // - // return ( (abs_a != abs_b) ? (abs_a < abs_b) : (std::arg(a) < std::arg(b)) ); - // } - - // inline - // bool - // operator() (const eT& a, const eT& b) const - // { - // const T a_real = a.real(); - // const T a_imag = a.imag(); - // - // const T a_mag_squared = a_real*a_real + a_imag*a_imag; - // - // const T b_real = b.real(); - // const T b_imag = b.imag(); - // - // const T b_mag_squared = b_real*b_real + b_imag*b_imag; - // - // if( (a_mag_squared != T(0)) && (b_mag_squared != T(0)) && std::isfinite(a_mag_squared) && std::isfinite(b_mag_squared) ) - // { - // return ( (a_mag_squared != b_mag_squared) ? (a_mag_squared < b_mag_squared) : (std::arg(a) < std::arg(b)) ); - // } - // else - // { - // const T abs_a = std::abs(a); - // const T abs_b = std::abs(b); - // - // return ( (abs_a != abs_b) ? (abs_a < abs_b) : (std::arg(a) < std::arg(b)) ); - // } - // } - }; - - - -template -struct arma_gt_comparator< std::complex > - { - typedef typename std::complex eT; - - inline bool operator() (const eT& a, const eT& b) const { return (std::abs(a) > std::abs(b)); } - - // inline - // bool - // operator() (const eT& a, const eT& b) const - // { - // const T abs_a = std::abs(a); - // const T abs_b = std::abs(b); - // - // return ( (abs_a != abs_b) ? (abs_a > abs_b) : (std::arg(a) > std::arg(b)) ); - // } - - // inline - // bool - // operator() (const eT& a, const eT& b) const - // { - // const T a_real = a.real(); - // const T a_imag = a.imag(); - // - // const T a_mag_squared = a_real*a_real + a_imag*a_imag; - // - // const T b_real = b.real(); - // const T b_imag = b.imag(); - // - // const T b_mag_squared = b_real*b_real + b_imag*b_imag; - // - // if( (a_mag_squared != T(0)) && (b_mag_squared != T(0)) && std::isfinite(a_mag_squared) && std::isfinite(b_mag_squared) ) - // { - // return ( (a_mag_squared != b_mag_squared) ? (a_mag_squared > b_mag_squared) : (std::arg(a) > std::arg(b)) ); - // } - // else - // { - // const T abs_a = std::abs(a); - // const T abs_b = std::abs(b); - // - // return ( (abs_a != abs_b) ? (abs_a > abs_b) : (std::arg(a) > std::arg(b)) ); - // } - // } - }; - - - -template -struct arma_leq_comparator< std::complex > - { - typedef typename std::complex eT; - - inline bool operator() (const eT& a, const eT& b) const { return (std::abs(a) <= std::abs(b)); } - }; - - - -template -struct arma_geq_comparator< std::complex > - { - typedef typename std::complex eT; - - inline bool operator() (const eT& a, const eT& b) const { return (std::abs(a) >= std::abs(b)); } - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_rng.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_rng.hpp deleted file mode 100644 index f10488105..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_rng.hpp +++ /dev/null @@ -1,1042 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup arma_rng -//! @{ - - -#undef ARMA_USE_CXX11_RNG -#define ARMA_USE_CXX11_RNG - -#undef ARMA_USE_THREAD_LOCAL -#define ARMA_USE_THREAD_LOCAL - -#if (defined(ARMA_RNG_ALT) || defined(ARMA_DONT_USE_CXX11_RNG)) - #undef ARMA_USE_CXX11_RNG -#endif - -#if defined(ARMA_DONT_USE_THREAD_LOCAL) - #undef ARMA_USE_THREAD_LOCAL -#endif - - -// NOTE: ARMA_WARMUP_PRODUCER enables a workaround -// NOTE: for thread_local issue on macOS 11 and/or AppleClang 12.0 -// NOTE: see https://gitlab.com/conradsnicta/armadillo-code/-/issues/173 -// NOTE: if this workaround causes problems, please report it and -// NOTE: disable the workaround by commenting out the code block below: - -#if defined(__APPLE__) || defined(__apple_build_version__) - #undef ARMA_WARMUP_PRODUCER - #define ARMA_WARMUP_PRODUCER -#endif - -#if defined(ARMA_DONT_WARMUP_PRODUCER) - #undef ARMA_WARMUP_PRODUCER -#endif - -// NOTE: workaround for another thread_local issue on macOS -// NOTE: where GCC (not Clang) may not have support for thread_local - -#if (defined(__APPLE__) && defined(__GNUG__) && !defined(__clang__)) - #undef ARMA_USE_THREAD_LOCAL -#endif - -// NOTE: disable use of thread_local on MinGW et al; -// NOTE: i don't have the patience to keep looking into these broken platforms - -#if (defined(__MINGW32__) || defined(__MINGW64__) || defined(__CYGWIN__) || defined(__MSYS__) || defined(__MSYS2__)) - #undef ARMA_USE_THREAD_LOCAL -#endif - -#if defined(ARMA_FORCE_USE_THREAD_LOCAL) - #undef ARMA_USE_THREAD_LOCAL - #define ARMA_USE_THREAD_LOCAL -#endif - -#if (!defined(ARMA_USE_THREAD_LOCAL)) - #undef ARMA_GUARD_PRODUCER - #define ARMA_GUARD_PRODUCER -#endif - -#if (defined(ARMA_DONT_GUARD_PRODUCER) || (!defined(ARMA_USE_STD_MUTEX))) - #undef ARMA_GUARD_PRODUCER -#endif - - -class arma_rng - { - public: - - #if defined(ARMA_RNG_ALT) - typedef arma_rng_alt::seed_type seed_type; - #elif defined(ARMA_USE_CXX11_RNG) - typedef std::mt19937_64::result_type seed_type; - #else - typedef arma_rng_cxx03::seed_type seed_type; - #endif - - #if defined(ARMA_RNG_ALT) - static constexpr int rng_method = 2; - #elif defined(ARMA_USE_CXX11_RNG) - static constexpr int rng_method = 1; - #else - static constexpr int rng_method = 0; - #endif - - #if defined(ARMA_USE_CXX11_RNG) - inline static std::mt19937_64& get_producer(); - inline static void warmup_producer(std::mt19937_64& producer); - - inline static void lock_producer(); - inline static void unlock_producer(); - - #if defined(ARMA_GUARD_PRODUCER) - inline static std::mutex& get_producer_mutex(); - #endif - #endif - - inline static void set_seed(const seed_type val); - inline static void set_seed_random(); - - template struct randi; - template struct randu; - template struct randn; - template struct randg; - }; - - - -#if defined(ARMA_USE_CXX11_RNG) - -inline -std::mt19937_64& -arma_rng::get_producer() - { - #if defined(ARMA_USE_THREAD_LOCAL) - - // use a thread-safe RNG, with each thread having its own unique starting seed - - static std::atomic mt19937_64_producer_counter(0); - - static thread_local std::mt19937_64 mt19937_64_producer( std::mt19937_64::default_seed + mt19937_64_producer_counter++ ); - - arma_rng::warmup_producer(mt19937_64_producer); - - #else - - // use a plain RNG in case we don't have thread_local - - static std::mt19937_64 mt19937_64_producer( std::mt19937_64::default_seed ); - - arma_rng::warmup_producer(mt19937_64_producer); - - #endif - - return mt19937_64_producer; - } - - -inline -void -arma_rng::warmup_producer(std::mt19937_64& producer) - { - #if defined(ARMA_WARMUP_PRODUCER) - - static std::atomic_flag warmup_done = ATOMIC_FLAG_INIT; // init to false - - if(warmup_done.test_and_set() == false) - { - typename std::mt19937_64::result_type junk = producer(); - - arma_ignore(junk); - } - - #else - - arma_ignore(producer); - - #endif - } - - -inline -void -arma_rng::lock_producer() - { - #if defined(ARMA_GUARD_PRODUCER) - - std::mutex& producer_mutex = arma_rng::get_producer_mutex(); - - producer_mutex.lock(); - - #endif - } - - -inline -void -arma_rng::unlock_producer() - { - #if defined(ARMA_GUARD_PRODUCER) - - std::mutex& producer_mutex = arma_rng::get_producer_mutex(); - - producer_mutex.unlock(); - - #endif - } - - -#if defined(ARMA_GUARD_PRODUCER) - inline - std::mutex& - arma_rng::get_producer_mutex() - { - static std::mutex producer_mutex; - - return producer_mutex; - } -#endif - -#endif - - -inline -void -arma_rng::set_seed(const arma_rng::seed_type val) - { - #if defined(ARMA_RNG_ALT) - { - arma_rng_alt::set_seed(val); - } - #elif defined(ARMA_USE_CXX11_RNG) - { - arma_rng::lock_producer(); - arma_rng::get_producer().seed(val); - arma_rng::unlock_producer(); - } - #else - { - arma_rng_cxx03::set_seed(val); - } - #endif - } - - - -arma_cold -inline -void -arma_rng::set_seed_random() - { - seed_type seed1 = seed_type(0); - seed_type seed2 = seed_type(0); - seed_type seed3 = seed_type(0); - seed_type seed4 = seed_type(0); - - bool have_seed = false; - - try - { - std::random_device rd; - - if(rd.entropy() > double(0)) { seed1 = static_cast( rd() ); } - - have_seed = (seed1 != seed_type(0)); - } - catch(...) {} - - - if(have_seed == false) - { - try - { - union - { - seed_type a; - unsigned char b[sizeof(seed_type)]; - } tmp; - - tmp.a = seed_type(0); - - std::ifstream f("/dev/urandom", std::ifstream::binary); - - if(f.good()) { f.read((char*)(&(tmp.b[0])), sizeof(seed_type)); } - - if(f.good()) { seed2 = tmp.a; } - - have_seed = (seed2 != seed_type(0)); - } - catch(...) {} - } - - - if(have_seed == false) - { - // get better-than-nothing seeds in case reading /dev/urandom failed - - const std::chrono::system_clock::time_point tp_now = std::chrono::system_clock::now(); - - auto since_epoch_usec = std::chrono::duration_cast(tp_now.time_since_epoch()).count(); - - seed3 = static_cast( since_epoch_usec & 0xFFFF ); - - union - { - uword* a; - unsigned char b[sizeof(uword*)]; - } tmp; - - tmp.a = (uword*)malloc(sizeof(uword)); - - if(tmp.a != nullptr) - { - for(size_t i=0; i -struct arma_rng::randi - { - inline - operator eT () - { - #if defined(ARMA_RNG_ALT) - { - return eT( arma_rng_alt::randi_val() ); - } - #elif defined(ARMA_USE_CXX11_RNG) - { - constexpr double scale = double(std::numeric_limits::max()) / double(std::mt19937_64::max()); - - arma_rng::lock_producer(); - - const eT out = eT(double(arma_rng::get_producer()()) * scale); - - arma_rng::unlock_producer(); - - return out; - } - #else - { - return eT( arma_rng_cxx03::randi_val() ); - } - #endif - } - - - inline - static - int - max_val() - { - #if defined(ARMA_RNG_ALT) - { - return arma_rng_alt::randi_max_val(); - } - #elif defined(ARMA_USE_CXX11_RNG) - { - return std::numeric_limits::max(); - } - #else - { - return arma_rng_cxx03::randi_max_val(); - } - #endif - } - - - inline - static - void - fill(eT* mem, const uword N, const int a, const int b) - { - #if defined(ARMA_RNG_ALT) - { - arma_rng_alt::randi_fill(mem, N, a, b); - } - #elif defined(ARMA_USE_CXX11_RNG) - { - std::uniform_int_distribution local_i_distr(a, b); - - std::mt19937_64& producer = arma_rng::get_producer(); - - arma_rng::lock_producer(); - - for(uword i=0; i local_i_distr(a, b); - - local_engine.seed( local_seed_type(std::rand()) ); - - for(uword i=0; i -struct arma_rng::randu - { - inline - operator eT () - { - #if defined(ARMA_RNG_ALT) - { - return eT( arma_rng_alt::randu_val() ); - } - #elif defined(ARMA_USE_CXX11_RNG) - { - constexpr double scale = double(1.0) / double(std::mt19937_64::max()); - - arma_rng::lock_producer(); - - const eT out = eT( double(arma_rng::get_producer()()) * scale ); - - arma_rng::unlock_producer(); - - return out; - } - #else - { - return eT( arma_rng_cxx03::randu_val() ); - } - #endif - } - - - inline - static - void - fill(eT* mem, const uword N) - { - #if defined(ARMA_RNG_ALT) - { - for(uword i=0; i < N; ++i) { mem[i] = eT( arma_rng_alt::randu_val() ); } - } - #elif defined(ARMA_USE_CXX11_RNG) - { - std::uniform_real_distribution local_u_distr; - - std::mt19937_64& producer = arma_rng::get_producer(); - - arma_rng::lock_producer(); - - for(uword i=0; i < N; ++i) { mem[i] = eT( local_u_distr(producer) ); } - - arma_rng::unlock_producer(); - } - #else - { - if(N == uword(1)) { mem[0] = eT( arma_rng_cxx03::randu_val() ); return; } - - typedef typename std::mt19937_64::result_type local_seed_type; - - std::mt19937_64 local_engine; - std::uniform_real_distribution local_u_distr; - - local_engine.seed( local_seed_type(std::rand()) ); - - for(uword i=0; i < N; ++i) { mem[i] = eT( local_u_distr(local_engine) ); } - } - #endif - } - - - inline - static - void - fill(eT* mem, const uword N, const double a, const double b) - { - #if defined(ARMA_RNG_ALT) - { - const double r = b - a; - - for(uword i=0; i < N; ++i) { mem[i] = eT( arma_rng_alt::randu_val() * r + a ); } - } - #elif defined(ARMA_USE_CXX11_RNG) - { - std::uniform_real_distribution local_u_distr(a,b); - - std::mt19937_64& producer = arma_rng::get_producer(); - - arma_rng::lock_producer(); - - for(uword i=0; i < N; ++i) { mem[i] = eT( local_u_distr(producer) ); } - - arma_rng::unlock_producer(); - } - #else - { - if(N == uword(1)) { mem[0] = eT( arma_rng_cxx03::randu_val() * (b - a) + a ); return; } - - typedef typename std::mt19937_64::result_type local_seed_type; - - std::mt19937_64 local_engine; - std::uniform_real_distribution local_u_distr(a,b); - - local_engine.seed( local_seed_type(std::rand()) ); - - for(uword i=0; i < N; ++i) { mem[i] = eT( local_u_distr(local_engine) ); } - } - #endif - } - }; - - - -template -struct arma_rng::randu< std::complex > - { - arma_inline - operator std::complex () - { - #if defined(ARMA_RNG_ALT) - { - const T a = T( arma_rng_alt::randu_val() ); - const T b = T( arma_rng_alt::randu_val() ); - - return std::complex(a, b); - } - #elif defined(ARMA_USE_CXX11_RNG) - { - std::uniform_real_distribution local_u_distr; - - std::mt19937_64& producer = arma_rng::get_producer(); - - arma_rng::lock_producer(); - - const T a = T( local_u_distr(producer) ); - const T b = T( local_u_distr(producer) ); - - arma_rng::unlock_producer(); - - return std::complex(a, b); - } - #else - { - const T a = T( arma_rng_cxx03::randu_val() ); - const T b = T( arma_rng_cxx03::randu_val() ); - - return std::complex(a, b); - } - #endif - } - - - inline - static - void - fill(std::complex* mem, const uword N) - { - #if defined(ARMA_RNG_ALT) - { - for(uword i=0; i < N; ++i) - { - const T a = T( arma_rng_alt::randu_val() ); - const T b = T( arma_rng_alt::randu_val() ); - - mem[i] = std::complex(a, b); - } - } - #elif defined(ARMA_USE_CXX11_RNG) - { - std::uniform_real_distribution local_u_distr; - - std::mt19937_64& producer = arma_rng::get_producer(); - - arma_rng::lock_producer(); - - for(uword i=0; i < N; ++i) - { - const T a = T( local_u_distr(producer) ); - const T b = T( local_u_distr(producer) ); - - mem[i] = std::complex(a, b); - } - - arma_rng::unlock_producer(); - } - #else - { - if(N == uword(1)) - { - const T a = T( arma_rng_cxx03::randu_val() ); - const T b = T( arma_rng_cxx03::randu_val() ); - - mem[0] = std::complex(a, b); - - return; - } - - typedef typename std::mt19937_64::result_type local_seed_type; - - std::mt19937_64 local_engine; - std::uniform_real_distribution local_u_distr; - - local_engine.seed( local_seed_type(std::rand()) ); - - for(uword i=0; i < N; ++i) - { - const T a = T( local_u_distr(local_engine) ); - const T b = T( local_u_distr(local_engine) ); - - mem[i] = std::complex(a, b); - } - } - #endif - } - - - inline - static - void - fill(std::complex* mem, const uword N, const double a, const double b) - { - #if defined(ARMA_RNG_ALT) - { - const double r = b - a; - - for(uword i=0; i < N; ++i) - { - const T tmp1 = T( arma_rng_alt::randu_val() * r + a ); - const T tmp2 = T( arma_rng_alt::randu_val() * r + a ); - - mem[i] = std::complex(tmp1, tmp2); - } - } - #elif defined(ARMA_USE_CXX11_RNG) - { - std::uniform_real_distribution local_u_distr(a,b); - - std::mt19937_64& producer = arma_rng::get_producer(); - - arma_rng::lock_producer(); - - for(uword i=0; i < N; ++i) - { - const T tmp1 = T( local_u_distr(producer) ); - const T tmp2 = T( local_u_distr(producer) ); - - mem[i] = std::complex(tmp1, tmp2); - } - - arma_rng::unlock_producer(); - } - #else - { - if(N == uword(1)) - { - const double r = b - a; - - const T tmp1 = T( arma_rng_cxx03::randu_val() * r + a); - const T tmp2 = T( arma_rng_cxx03::randu_val() * r + a); - - mem[0] = std::complex(tmp1, tmp2); - - return; - } - - typedef typename std::mt19937_64::result_type local_seed_type; - - std::mt19937_64 local_engine; - std::uniform_real_distribution local_u_distr(a,b); - - local_engine.seed( local_seed_type(std::rand()) ); - - for(uword i=0; i < N; ++i) - { - const T tmp1 = T( local_u_distr(local_engine) ); - const T tmp2 = T( local_u_distr(local_engine) ); - - mem[i] = std::complex(tmp1, tmp2); - } - } - #endif - } - }; - - - -// - - - -template -struct arma_rng::randn - { - inline - operator eT () const - { - #if defined(ARMA_RNG_ALT) - { - return eT( arma_rng_alt::randn_val() ); - } - #elif defined(ARMA_USE_CXX11_RNG) - { - std::normal_distribution local_n_distr; - - arma_rng::lock_producer(); - - const eT out = eT( local_n_distr(arma_rng::get_producer()) ); - - arma_rng::unlock_producer(); - - return out; - } - #else - { - return eT( arma_rng_cxx03::randn_val() ); - } - #endif - } - - - inline - static - void - dual_val(eT& out1, eT& out2) - { - #if defined(ARMA_RNG_ALT) - { - arma_rng_alt::randn_dual_val(out1, out2); - } - #elif defined(ARMA_USE_CXX11_RNG) - { - std::normal_distribution local_n_distr; - - std::mt19937_64& producer = arma_rng::get_producer(); - - arma_rng::lock_producer(); - - out1 = eT( local_n_distr(producer) ); - out2 = eT( local_n_distr(producer) ); - - arma_rng::unlock_producer(); - } - #else - { - arma_rng_cxx03::randn_dual_val(out1, out2); - } - #endif - } - - - inline - static - void - fill(eT* mem, const uword N) - { - #if defined(ARMA_RNG_ALT) - { - // NOTE: old method to avoid regressions in user code that assumes specific sequence - - uword i, j; - - for(i=0, j=1; j < N; i+=2, j+=2) { arma_rng_alt::randn_dual_val( mem[i], mem[j] ); } - - if(i < N) { mem[i] = eT( arma_rng_alt::randn_val() ); } - } - #elif defined(ARMA_USE_CXX11_RNG) - { - std::normal_distribution local_n_distr; - - std::mt19937_64& producer = arma_rng::get_producer(); - - arma_rng::lock_producer(); - - for(uword i=0; i < N; ++i) { mem[i] = eT( local_n_distr(producer) ); } - - arma_rng::unlock_producer(); - } - #else - { - if(N == uword(1)) { mem[0] = eT( arma_rng_cxx03::randn_val() ); return; } - - typedef typename std::mt19937_64::result_type local_seed_type; - - std::mt19937_64 local_engine; - std::normal_distribution local_n_distr; - - local_engine.seed( local_seed_type(std::rand()) ); - - for(uword i=0; i < N; ++i) { mem[i] = eT( local_n_distr(local_engine) ); } - } - #endif - } - - - inline - static - void - fill(eT* mem, const uword N, const double mu, const double sd) - { - #if defined(ARMA_RNG_ALT) - { - // NOTE: old method to avoid regressions in user code that assumes specific sequence - - uword i, j; - - for(i=0, j=1; j < N; i+=2, j+=2) - { - eT val_i = eT(0); - eT val_j = eT(0); - - arma_rng_alt::randn_dual_val( val_i, val_j ); - - mem[i] = (val_i * sd) + mu; - mem[j] = (val_j * sd) + mu; - } - - if(i < N) - { - const eT val_i = eT( arma_rng_alt::randn_val() ); - - mem[i] = (val_i * sd) + mu; - } - } - #elif defined(ARMA_USE_CXX11_RNG) - { - std::normal_distribution local_n_distr(mu, sd); - - std::mt19937_64& producer = arma_rng::get_producer(); - - arma_rng::lock_producer(); - - for(uword i=0; i < N; ++i) { mem[i] = eT( local_n_distr(producer) ); } - - arma_rng::unlock_producer(); - } - #else - { - if(N == uword(1)) - { - const eT val = eT( arma_rng_cxx03::randn_val() ); - - mem[0] = (val * sd) + mu; - - return; - } - - typedef typename std::mt19937_64::result_type local_seed_type; - - std::mt19937_64 local_engine; - std::normal_distribution local_n_distr(mu, sd); - - local_engine.seed( local_seed_type(std::rand()) ); - - for(uword i=0; i < N; ++i) { mem[i] = eT( local_n_distr(local_engine) ); } - } - #endif - } - }; - - - -template -struct arma_rng::randn< std::complex > - { - inline - operator std::complex () const - { - #if defined(_MSC_VER) - // attempt at workaround for MSVC bug - // does MS even test their so-called compilers before release? - T a; - T b; - #else - T a(0); - T b(0); - #endif - - arma_rng::randn::dual_val(a, b); - - return std::complex(a, b); - } - - - inline - static - void - dual_val(std::complex& out1, std::complex& out2) - { - #if defined(_MSC_VER) - T a; - T b; - #else - T a(0); - T b(0); - #endif - - arma_rng::randn::dual_val(a,b); - out1 = std::complex(a,b); - - arma_rng::randn::dual_val(a,b); - out2 = std::complex(a,b); - } - - - inline - static - void - fill(std::complex* mem, const uword N) - { - #if defined(ARMA_RNG_ALT) - { - for(uword i=0; i < N; ++i) { mem[i] = std::complex( arma_rng::randn< std::complex >() ); } - } - #elif defined(ARMA_USE_CXX11_RNG) - { - std::normal_distribution local_n_distr; - - std::mt19937_64& producer = arma_rng::get_producer(); - - arma_rng::lock_producer(); - - for(uword i=0; i < N; ++i) - { - const T a = T( local_n_distr(producer) ); - const T b = T( local_n_distr(producer) ); - - mem[i] = std::complex(a,b); - } - - arma_rng::unlock_producer(); - } - #else - { - if(N == uword(1)) - { - T a = T(0); - T b = T(0); - - arma_rng_cxx03::randn_dual_val(a,b); - - mem[0] = std::complex(a,b); - - return; - } - - typedef typename std::mt19937_64::result_type local_seed_type; - - std::mt19937_64 local_engine; - std::normal_distribution local_n_distr; - - local_engine.seed( local_seed_type(std::rand()) ); - - for(uword i=0; i < N; ++i) - { - const T a = T( local_n_distr(local_engine) ); - const T b = T( local_n_distr(local_engine) ); - - mem[i] = std::complex(a,b); - } - } - #endif - } - - - inline - static - void - fill(std::complex* mem, const uword N, const double mu, const double sd) - { - arma_rng::randn< std::complex >::fill(mem, N); - - if( (mu == double(0)) && (sd == double(1)) ) { return; } - - for(uword i=0; i& val = mem[i]; - - mem[i] = std::complex( ((val.real() * sd) + mu), ((val.imag() * sd) + mu) ); - } - } - }; - - - -// - - - -template -struct arma_rng::randg - { - inline - static - void - fill(eT* mem, const uword N, const double a, const double b) - { - #if defined(ARMA_USE_CXX11_RNG) - { - std::gamma_distribution local_g_distr(a,b); - - std::mt19937_64& producer = arma_rng::get_producer(); - - arma_rng::lock_producer(); - - for(uword i=0; i local_g_distr(a,b); - - local_engine.seed( local_seed_type(arma_rng::randi()) ); - - for(uword i=0; i - inline static void randn_dual_val(eT& out1, eT& out2); - - template - inline static void randi_fill(eT* mem, const uword N, const int a, const int b); - - inline static int randi_max_val(); - }; - - - -inline -void -arma_rng_cxx03::set_seed(const arma_rng_cxx03::seed_type val) - { - std::srand(val); - } - - - -arma_inline -int -arma_rng_cxx03::randi_val() - { - #if (RAND_MAX == 32767) - { - // NOTE: this is a better-than-nothing solution - // NOTE: see also arma_rng_cxx03::randi_max_val() - - u32 val1 = u32(std::rand()); - u32 val2 = u32(std::rand()); - - val1 <<= 15; - - return (val1 | val2); - } - #else - { - return std::rand(); - } - #endif - } - - - -arma_inline -double -arma_rng_cxx03::randu_val() - { - return double( double(randi_val()) * ( double(1) / double(randi_max_val()) ) ); - } - - - -inline -double -arma_rng_cxx03::randn_val() - { - // polar form of the Box-Muller transformation: - // http://en.wikipedia.org/wiki/Box-Muller_transformation - // http://en.wikipedia.org/wiki/Marsaglia_polar_method - - double tmp1 = double(0); - double tmp2 = double(0); - double w = double(0); - - do - { - tmp1 = double(2) * double(randi_val()) * (double(1) / double(randi_max_val())) - double(1); - tmp2 = double(2) * double(randi_val()) * (double(1) / double(randi_max_val())) - double(1); - - w = tmp1*tmp1 + tmp2*tmp2; - } - while( w >= double(1) ); - - return double( tmp1 * std::sqrt( (double(-2) * std::log(w)) / w) ); - } - - - -template -inline -void -arma_rng_cxx03::randn_dual_val(eT& out1, eT& out2) - { - // make sure we are internally using at least floats - typedef typename promote_type::result eTp; - - eTp tmp1 = eTp(0); - eTp tmp2 = eTp(0); - eTp w = eTp(0); - - do - { - tmp1 = eTp(2) * eTp(randi_val()) * (eTp(1) / eTp(randi_max_val())) - eTp(1); - tmp2 = eTp(2) * eTp(randi_val()) * (eTp(1) / eTp(randi_max_val())) - eTp(1); - - w = tmp1*tmp1 + tmp2*tmp2; - } - while( w >= eTp(1) ); - - const eTp k = std::sqrt( (eTp(-2) * std::log(w)) / w); - - out1 = eT(tmp1*k); - out2 = eT(tmp2*k); - } - - - -template -inline -void -arma_rng_cxx03::randi_fill(eT* mem, const uword N, const int a, const int b) - { - if( (a == 0) && (b == RAND_MAX) ) - { - for(uword i=0; i n_chars_prealloc) { std::free(mem); } - - mem = nullptr; - n_chars = 0; - } - - inline - char_buffer() - { - mem = &(local_mem[0]); - n_chars = n_chars_prealloc; - - if(n_chars > 0) { mem[0] = char(0); } - } - - inline - void - set_size(const uword new_n_chars) - { - if(n_chars > n_chars_prealloc) { std::free(mem); } - - mem = (new_n_chars <= n_chars_prealloc) ? &(local_mem[0]) : (char*)std::malloc(new_n_chars); - n_chars = (new_n_chars <= n_chars_prealloc) ? n_chars_prealloc : new_n_chars; - - if(n_chars > 0) { mem[0] = char(0); } - } - }; - - - class format - { - public: - - const std::string fmt; - - inline format(const char* in_fmt) : fmt(in_fmt) { } - inline format(const std::string& in_fmt) : fmt(in_fmt) { } - - private: - format(); - }; - - - - template - class basic_format - { - public: - - const T1& A; - const T2& B; - - inline basic_format(const T1& in_A, const T2& in_B) : A(in_A) , B(in_B) { } - - private: - basic_format(); - }; - - - - template - inline - basic_format< format, T2 > - operator% (const format& X, const T2& arg) - { - return basic_format< format, T2 >(X, arg); - } - - - - template - inline - basic_format< basic_format, T3 > - operator% (const basic_format& X, const T3& arg) - { - return basic_format< basic_format, T3 >(X, arg); - } - - - - template - inline - std::string - str(const basic_format< format, T2>& X) - { - std::string out; - char_buffer buf; - - bool status = false; - - while(status == false) - { - int required_size = (std::snprintf)(buf.mem, size_t(buf.n_chars), X.A.fmt.c_str(), X.B); - - if(required_size < 0) { break; } - - if(uword(required_size) >= buf.n_chars) - { - if(buf.n_chars > char_buffer::n_chars_prealloc) { break; } - - buf.set_size(1 + uword(required_size)); - } - else - { - status = true; - } - - if(status) { out = buf.mem; } - } - - return out; - } - - - - template - inline - std::string - str(const basic_format< basic_format< format, T2>, T3>& X) - { - char_buffer buf; - std::string out; - - bool status = false; - - while(status == false) - { - int required_size = (std::snprintf)(buf.mem, size_t(buf.n_chars), X.A.A.fmt.c_str(), X.A.B, X.B); - - if(required_size < 0) { break; } - - if(uword(required_size) >= buf.n_chars) - { - if(buf.n_chars > char_buffer::n_chars_prealloc) { break; } - - buf.set_size(1 + uword(required_size)); - } - else - { - status = true; - } - - if(status) { out = buf.mem; } - } - - return out; - } - - - - template - inline - std::string - str(const basic_format< basic_format< basic_format< format, T2>, T3>, T4>& X) - { - char_buffer buf; - std::string out; - - bool status = false; - - while(status == false) - { - int required_size = (std::snprintf)(buf.mem, size_t(buf.n_chars), X.A.A.A.fmt.c_str(), X.A.A.B, X.A.B, X.B); - - if(required_size < 0) { break; } - - if(uword(required_size) >= buf.n_chars) - { - if(buf.n_chars > char_buffer::n_chars_prealloc) { break; } - - buf.set_size(1 + uword(required_size)); - } - else - { - status = true; - } - - if(status) { out = buf.mem; } - } - - return out; - } - - - - template - inline - std::string - str(const basic_format< basic_format< basic_format< basic_format< format, T2>, T3>, T4>, T5>& X) - { - char_buffer buf; - std::string out; - - bool status = false; - - while(status == false) - { - int required_size = (std::snprintf)(buf.mem, size_t(buf.n_chars), X.A.A.A.A.fmt.c_str(), X.A.A.A.B, X.A.A.B, X.A.B, X.B); - - if(required_size < 0) { break; } - - if(uword(required_size) >= buf.n_chars) - { - if(buf.n_chars > char_buffer::n_chars_prealloc) { break; } - - buf.set_size(1 + uword(required_size)); - } - else - { - status = true; - } - - if(status) { out = buf.mem; } - } - - return out; - } - - - - template - inline - std::string - str(const basic_format< basic_format< basic_format< basic_format< basic_format< format, T2>, T3>, T4>, T5>, T6>& X) - { - char_buffer buf; - std::string out; - - bool status = false; - - while(status == false) - { - int required_size = (std::snprintf)(buf.mem, size_t(buf.n_chars), X.A.A.A.A.A.fmt.c_str(), X.A.A.A.A.B, X.A.A.A.B, X.A.A.B, X.A.B, X.B); - - if(required_size < 0) { break; } - - if(uword(required_size) >= buf.n_chars) - { - if(buf.n_chars > char_buffer::n_chars_prealloc) { break; } - - buf.set_size(1 + uword(required_size)); - } - else - { - status = true; - } - - if(status) { out = buf.mem; } - } - - return out; - } - - - - template - inline - std::string - str(const basic_format< basic_format< basic_format< basic_format< basic_format< basic_format< format, T2>, T3>, T4>, T5>, T6>, T7>& X) - { - char_buffer buf; - std::string out; - - bool status = false; - - while(status == false) - { - int required_size = (std::snprintf)(buf.mem, size_t(buf.n_chars), X.A.A.A.A.A.A.fmt.c_str(), X.A.A.A.A.A.B, X.A.A.A.A.B, X.A.A.A.B, X.A.A.B, X.A.B, X.B); - - if(required_size < 0) { break; } - - if(uword(required_size) >= buf.n_chars) - { - if(buf.n_chars > char_buffer::n_chars_prealloc) { break; } - - buf.set_size(1 + uword(required_size)); - } - else - { - status = true; - } - - if(status) { out = buf.mem; } - } - - return out; - } - - - - template - struct format_metaprog - { - static constexpr uword depth = 0; - - inline - static - const std::string& - get_fmt(const T1& X) - { - return X.A; - } - }; - - - - //template<> - template - struct format_metaprog< basic_format > - { - static constexpr uword depth = 1 + format_metaprog::depth; - - inline - static - const std::string& - get_fmt(const T1& X) - { - return format_metaprog::get_fmt(X.A); - } - - }; - - - - template - inline - std::string - str(const basic_format& X) - { - return format_metaprog< basic_format >::get_fmt(X.A); - } - - - - template - inline - std::ostream& - operator<< (std::ostream& o, const basic_format& X) - { - o << str(X); - return o; - } - - - template struct string_only { }; - template<> struct string_only { typedef std::string result; }; - - template struct char_only { }; - template<> struct char_only { typedef char result; }; - - template - struct basic_format_only { }; - - template - struct basic_format_only< basic_format > { typedef basic_format result; }; - - - - template - inline - static - const T1& - str_wrapper(const T1& x, const typename string_only::result* junk = nullptr) - { - arma_ignore(junk); - - return x; - } - - - - template - inline - static - const T1* - str_wrapper(const T1* x, const typename char_only::result* junk = nullptr) - { - arma_ignore(junk); - - return x; - } - - - - template - inline - static - std::string - str_wrapper(const T1& x, const typename basic_format_only::result* junk = nullptr) - { - arma_ignore(junk); - - return str(x); - } - - } - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_version.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_version.hpp deleted file mode 100644 index 6665eef57..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arma_version.hpp +++ /dev/null @@ -1,61 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup arma_version -//! @{ - - - -#define ARMA_VERSION_MAJOR 14 -#define ARMA_VERSION_MINOR 0 -#define ARMA_VERSION_PATCH 2 -#define ARMA_VERSION_NAME "Stochastic Parrot" - - - -struct arma_version - { - static constexpr unsigned int major = ARMA_VERSION_MAJOR; - static constexpr unsigned int minor = ARMA_VERSION_MINOR; - static constexpr unsigned int patch = ARMA_VERSION_PATCH; - - static - inline - std::string - as_string() - { - const char* nickname = ARMA_VERSION_NAME; - - std::ostringstream ss; - - ss << arma_version::major - << '.' - << arma_version::minor - << '.' - << arma_version::patch - << " (" - << nickname - << ')'; - - return ss.str(); - } - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arrayops_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arrayops_bones.hpp deleted file mode 100644 index 0beec3ae1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arrayops_bones.hpp +++ /dev/null @@ -1,229 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup arrayops -//! @{ - - -class arrayops - { - public: - - template - arma_inline static void - copy(eT* dest, const eT* src, const uword n_elem); - - template - inline static void - fill_zeros(eT* dest, const uword n_elem); - - template - arma_hot inline static void - replace(eT* mem, const uword n_elem, const eT old_val, const eT new_val); - - template - arma_hot inline static void - clean(eT* mem, const uword n_elem, const eT abs_limit, const typename arma_not_cx::result* junk = nullptr); - - template - arma_hot inline static void - clean(std::complex* mem, const uword n_elem, const T abs_limit); - - template - inline static void - clamp(eT* mem, const uword n_elem, const eT min_val, const eT max_val, const typename arma_not_cx::result* junk = nullptr); - - template - inline static void - clamp(std::complex* mem, const uword n_elem, const std::complex& min_val, const std::complex& max_val); - - - // - // array = convert(array) - - template - arma_inline static void - convert_cx_scalar(out_eT& out, const in_eT& in, const typename arma_not_cx::result* junk1 = nullptr, const typename arma_not_cx< in_eT>::result* junk2 = nullptr); - - template - arma_inline static void - convert_cx_scalar(out_eT& out, const std::complex& in, const typename arma_not_cx::result* junk = nullptr); - - template - arma_inline static void - convert_cx_scalar(std::complex& out, const std::complex< in_T>& in); - - template - arma_hot inline static void - convert(out_eT* dest, const in_eT* src, const uword n_elem); - - template - arma_hot inline static void - convert_cx(out_eT* dest, const in_eT* src, const uword n_elem); - - - // - // array op= array - - template - arma_hot inline static - void - inplace_plus(eT* dest, const eT* src, const uword n_elem); - - template - arma_hot inline static - void - inplace_minus(eT* dest, const eT* src, const uword n_elem); - - template - arma_hot inline static - void - inplace_mul(eT* dest, const eT* src, const uword n_elem); - - template - arma_hot inline static - void - inplace_div(eT* dest, const eT* src, const uword n_elem); - - - template - arma_hot inline static - void - inplace_plus_base(eT* dest, const eT* src, const uword n_elem); - - template - arma_hot inline static - void - inplace_minus_base(eT* dest, const eT* src, const uword n_elem); - - template - arma_hot inline static - void - inplace_mul_base(eT* dest, const eT* src, const uword n_elem); - - template - arma_hot inline static - void - inplace_div_base(eT* dest, const eT* src, const uword n_elem); - - - // - // array op= scalar - - template - arma_hot inline static - void - inplace_set(eT* dest, const eT val, const uword n_elem); - - template - arma_hot inline static - void - inplace_set_simple(eT* dest, const eT val, const uword n_elem); - - template - arma_hot inline static - void - inplace_set_base(eT* dest, const eT val, const uword n_elem); - - template - arma_hot inline static - void - inplace_set_fixed(eT* dest, const eT val); - - template - arma_hot inline static - void - inplace_plus(eT* dest, const eT val, const uword n_elem); - - template - arma_hot inline static - void - inplace_minus(eT* dest, const eT val, const uword n_elem); - - template - arma_hot inline static void - inplace_mul(eT* dest, const eT val, const uword n_elem); - - template - arma_hot inline static - void - inplace_div(eT* dest, const eT val, const uword n_elem); - - - template - arma_hot inline static - void - inplace_plus_base(eT* dest, const eT val, const uword n_elem); - - template - arma_hot inline static - void - inplace_minus_base(eT* dest, const eT val, const uword n_elem); - - template - arma_hot inline static void - inplace_mul_base(eT* dest, const eT val, const uword n_elem); - - template - arma_hot inline static - void - inplace_div_base(eT* dest, const eT val, const uword n_elem); - - - // - // scalar = op(array) - - template - arma_hot inline static - eT - accumulate(const eT* src, const uword n_elem); - - template - arma_hot inline static - eT - product(const eT* src, const uword n_elem); - - template - arma_hot inline static - bool - is_zero(const eT* mem, const uword n_elem, const eT abs_limit, const typename arma_not_cx::result* junk = nullptr); - - template - arma_hot inline static - bool - is_zero(const std::complex* mem, const uword n_elem, const T abs_limit); - - template - arma_hot inline static - bool - is_finite(const eT* src, const uword n_elem); - - template - arma_hot inline static - bool - has_inf(const eT* src, const uword n_elem); - - template - arma_hot inline static - bool - has_nan(const eT* src, const uword n_elem); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arrayops_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arrayops_meat.hpp deleted file mode 100644 index 57f1a1d43..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/arrayops_meat.hpp +++ /dev/null @@ -1,1108 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup arrayops -//! @{ - - - -template -arma_inline -void -arrayops::copy(eT* dest, const eT* src, const uword n_elem) - { - if( (dest == src) || (n_elem == 0) ) { return; } - - std::memcpy(dest, src, n_elem*sizeof(eT)); - } - - - -template -inline -void -arrayops::fill_zeros(eT* dest, const uword n_elem) - { - typedef typename get_pod_type::result pod_type; - - if(n_elem == 0) { return; } - - if(std::numeric_limits::is_integer || std::numeric_limits::is_iec559) - { - std::memset((void*)dest, 0, sizeof(eT)*n_elem); - } - else - { - arrayops::inplace_set_simple(dest, eT(0), n_elem); - } - } - - - -template -inline -void -arrayops::replace(eT* mem, const uword n_elem, const eT old_val, const eT new_val) - { - if(arma_isnan(old_val)) - { - for(uword i=0; i -inline -void -arrayops::clean(eT* mem, const uword n_elem, const eT abs_limit, const typename arma_not_cx::result* junk) - { - arma_ignore(junk); - - for(uword i=0; i -inline -void -arrayops::clean(std::complex* mem, const uword n_elem, const T abs_limit) - { - typedef typename std::complex eT; - - for(uword i=0; i(T(0), val_imag); - } - else - if(std::abs(val_imag) <= abs_limit) - { - val = std::complex(val_real, T(0)); - } - } - } - - - -template -inline -void -arrayops::clamp(eT* mem, const uword n_elem, const eT min_val, const eT max_val, const typename arma_not_cx::result* junk) - { - arma_ignore(junk); - - for(uword i=0; i max_val) ? max_val : val); - } - } - - - -template -inline -void -arrayops::clamp(std::complex* mem, const uword n_elem, const std::complex& min_val, const std::complex& max_val) - { - typedef typename std::complex eT; - - const T min_val_real = std::real(min_val); - const T min_val_imag = std::imag(min_val); - - const T max_val_real = std::real(max_val); - const T max_val_imag = std::imag(max_val); - - for(uword i=0; i max_val_real) ? max_val_real : val_real); - val_imag = (val_imag < min_val_imag) ? min_val_imag : ((val_imag > max_val_imag) ? max_val_imag : val_imag); - - val = std::complex(val_real,val_imag); - } - } - - - -template -arma_inline -void -arrayops::convert_cx_scalar - ( - out_eT& out, - const in_eT& in, - const typename arma_not_cx::result* junk1, - const typename arma_not_cx< in_eT>::result* junk2 - ) - { - arma_ignore(junk1); - arma_ignore(junk2); - - out = out_eT(in); - } - - - -template -arma_inline -void -arrayops::convert_cx_scalar - ( - out_eT& out, - const std::complex& in, - const typename arma_not_cx::result* junk - ) - { - arma_ignore(junk); - - const in_T val = in.real(); - - const bool conversion_ok = (std::is_integral::value && std::is_floating_point::value) ? arma_isfinite(val) : true; - - out = conversion_ok ? out_eT(val) : out_eT(0); - } - - - -template -arma_inline -void -arrayops::convert_cx_scalar - ( - std::complex& out, - const std::complex< in_T>& in - ) - { - typedef std::complex out_eT; - - out = out_eT(in); - } - - - -template -inline -void -arrayops::convert(out_eT* dest, const in_eT* src, const uword n_elem) - { - if(is_same_type::value) - { - const out_eT* src2 = (const out_eT*)src; - - if(dest != src2) { arrayops::copy(dest, src2, n_elem); } - - return; - } - - const bool check_finite = (std::is_integral::value && std::is_floating_point::value); - - uword j; - - for(j=1; j::value) - ? out_eT( tmp_i ) - : ( cond_rel< is_signed::value >::lt(tmp_i, in_eT(0)) ? out_eT(0) : out_eT(tmp_i) ) - ) - : out_eT(0); - - dest++; - - (*dest) = ok_j - ? ( - (is_signed::value) - ? out_eT( tmp_j ) - : ( cond_rel< is_signed::value >::lt(tmp_j, in_eT(0)) ? out_eT(0) : out_eT(tmp_j) ) - ) - : out_eT(0); - dest++; - } - - if((j-1) < n_elem) - { - const in_eT tmp_i = (*src); - - // dest[i] = out_eT( tmp_i ); - - const bool ok_i = check_finite ? arma_isfinite(tmp_i) : true; - - (*dest) = ok_i - ? ( - (is_signed::value) - ? out_eT( tmp_i ) - : ( cond_rel< is_signed::value >::lt(tmp_i, in_eT(0)) ? out_eT(0) : out_eT(tmp_i) ) - ) - : out_eT(0); - } - } - - - -template -inline -void -arrayops::convert_cx(out_eT* dest, const in_eT* src, const uword n_elem) - { - uword j; - - for(j=1; j -inline -void -arrayops::inplace_plus(eT* dest, const eT* src, const uword n_elem) - { - if(memory::is_aligned(dest)) - { - memory::mark_as_aligned(dest); - - if(memory::is_aligned(src)) - { - memory::mark_as_aligned(src); - - arrayops::inplace_plus_base(dest, src, n_elem); - } - else - { - arrayops::inplace_plus_base(dest, src, n_elem); - } - } - else - { - if(memory::is_aligned(src)) - { - memory::mark_as_aligned(src); - - arrayops::inplace_plus_base(dest, src, n_elem); - } - else - { - arrayops::inplace_plus_base(dest, src, n_elem); - } - } - } - - - -template -inline -void -arrayops::inplace_minus(eT* dest, const eT* src, const uword n_elem) - { - if(memory::is_aligned(dest)) - { - memory::mark_as_aligned(dest); - - if(memory::is_aligned(src)) - { - memory::mark_as_aligned(src); - - arrayops::inplace_minus_base(dest, src, n_elem); - } - else - { - arrayops::inplace_minus_base(dest, src, n_elem); - } - } - else - { - if(memory::is_aligned(src)) - { - memory::mark_as_aligned(src); - - arrayops::inplace_minus_base(dest, src, n_elem); - } - else - { - arrayops::inplace_minus_base(dest, src, n_elem); - } - } - } - - - -template -inline -void -arrayops::inplace_mul(eT* dest, const eT* src, const uword n_elem) - { - if(memory::is_aligned(dest)) - { - memory::mark_as_aligned(dest); - - if(memory::is_aligned(src)) - { - memory::mark_as_aligned(src); - - arrayops::inplace_mul_base(dest, src, n_elem); - } - else - { - arrayops::inplace_mul_base(dest, src, n_elem); - } - } - else - { - if(memory::is_aligned(src)) - { - memory::mark_as_aligned(src); - - arrayops::inplace_mul_base(dest, src, n_elem); - } - else - { - arrayops::inplace_mul_base(dest, src, n_elem); - } - } - } - - - -template -inline -void -arrayops::inplace_div(eT* dest, const eT* src, const uword n_elem) - { - if(memory::is_aligned(dest)) - { - memory::mark_as_aligned(dest); - - if(memory::is_aligned(src)) - { - memory::mark_as_aligned(src); - - arrayops::inplace_div_base(dest, src, n_elem); - } - else - { - arrayops::inplace_div_base(dest, src, n_elem); - } - } - else - { - if(memory::is_aligned(src)) - { - memory::mark_as_aligned(src); - - arrayops::inplace_div_base(dest, src, n_elem); - } - else - { - arrayops::inplace_div_base(dest, src, n_elem); - } - } - } - - - -template -inline -void -arrayops::inplace_plus_base(eT* dest, const eT* src, const uword n_elem) - { - #if defined(ARMA_SIMPLE_LOOPS) - { - for(uword i=0; i -inline -void -arrayops::inplace_minus_base(eT* dest, const eT* src, const uword n_elem) - { - #if defined(ARMA_SIMPLE_LOOPS) - { - for(uword i=0; i -inline -void -arrayops::inplace_mul_base(eT* dest, const eT* src, const uword n_elem) - { - #if defined(ARMA_SIMPLE_LOOPS) - { - for(uword i=0; i -inline -void -arrayops::inplace_div_base(eT* dest, const eT* src, const uword n_elem) - { - #if defined(ARMA_SIMPLE_LOOPS) - { - for(uword i=0; i -inline -void -arrayops::inplace_set(eT* dest, const eT val, const uword n_elem) - { - if(val == eT(0)) - { - arrayops::fill_zeros(dest, n_elem); - } - else - { - arrayops::inplace_set_simple(dest, val, n_elem); - } - } - - - -template -inline -void -arrayops::inplace_set_simple(eT* dest, const eT val, const uword n_elem) - { - if(memory::is_aligned(dest)) - { - memory::mark_as_aligned(dest); - - arrayops::inplace_set_base(dest, val, n_elem); - } - else - { - arrayops::inplace_set_base(dest, val, n_elem); - } - } - - - -template -inline -void -arrayops::inplace_set_base(eT* dest, const eT val, const uword n_elem) - { - #if defined(ARMA_SIMPLE_LOOPS) - { - for(uword i=0; i -inline -void -arrayops::inplace_set_fixed(eT* dest, const eT val) - { - for(uword i=0; i -inline -void -arrayops::inplace_plus(eT* dest, const eT val, const uword n_elem) - { - if(memory::is_aligned(dest)) - { - memory::mark_as_aligned(dest); - - arrayops::inplace_plus_base(dest, val, n_elem); - } - else - { - arrayops::inplace_plus_base(dest, val, n_elem); - } - } - - - -template -inline -void -arrayops::inplace_minus(eT* dest, const eT val, const uword n_elem) - { - if(memory::is_aligned(dest)) - { - memory::mark_as_aligned(dest); - - arrayops::inplace_minus_base(dest, val, n_elem); - } - else - { - arrayops::inplace_minus_base(dest, val, n_elem); - } - } - - - -template -inline -void -arrayops::inplace_mul(eT* dest, const eT val, const uword n_elem) - { - if(memory::is_aligned(dest)) - { - memory::mark_as_aligned(dest); - - arrayops::inplace_mul_base(dest, val, n_elem); - } - else - { - arrayops::inplace_mul_base(dest, val, n_elem); - } - } - - - -template -inline -void -arrayops::inplace_div(eT* dest, const eT val, const uword n_elem) - { - if(memory::is_aligned(dest)) - { - memory::mark_as_aligned(dest); - - arrayops::inplace_div_base(dest, val, n_elem); - } - else - { - arrayops::inplace_div_base(dest, val, n_elem); - } - } - - - -template -inline -void -arrayops::inplace_plus_base(eT* dest, const eT val, const uword n_elem) - { - #if defined(ARMA_SIMPLE_LOOPS) - { - for(uword i=0; i -inline -void -arrayops::inplace_minus_base(eT* dest, const eT val, const uword n_elem) - { - #if defined(ARMA_SIMPLE_LOOPS) - { - for(uword i=0; i -inline -void -arrayops::inplace_mul_base(eT* dest, const eT val, const uword n_elem) - { - #if defined(ARMA_SIMPLE_LOOPS) - { - for(uword i=0; i -inline -void -arrayops::inplace_div_base(eT* dest, const eT val, const uword n_elem) - { - #if defined(ARMA_SIMPLE_LOOPS) - { - for(uword i=0; i -inline -eT -arrayops::accumulate(const eT* src, const uword n_elem) - { - #if defined(__FAST_MATH__) - { - eT acc = eT(0); - - if(memory::is_aligned(src)) - { - memory::mark_as_aligned(src); - for(uword i=0; i -inline -eT -arrayops::product(const eT* src, const uword n_elem) - { - eT val1 = eT(1); - eT val2 = eT(1); - - uword i,j; - - for(i=0, j=1; j -inline -bool -arrayops::is_zero(const eT* mem, const uword n_elem, const eT abs_limit, const typename arma_not_cx::result* junk) - { - arma_ignore(junk); - - if(n_elem == 0) { return false; } - - if(abs_limit == eT(0)) - { - for(uword i=0; i abs_limit) { return false; } - } - } - - return true; - } - - - -template -inline -bool -arrayops::is_zero(const std::complex* mem, const uword n_elem, const T abs_limit) - { - typedef typename std::complex eT; - - if(n_elem == 0) { return false; } - - if(abs_limit == T(0)) - { - for(uword i=0; i abs_limit) { return false; } - if(std::abs(std::imag(val)) > abs_limit) { return false; } - } - } - - return true; - } - - - -template -inline -bool -arrayops::is_finite(const eT* src, const uword n_elem) - { - uword j; - - for(j=1; j -inline -bool -arrayops::has_inf(const eT* src, const uword n_elem) - { - uword j; - - for(j=1; j -inline -bool -arrayops::has_nan(const eT* src, const uword n_elem) - { - uword j; - - for(j=1; j - inline static bool inv(Mat& A); - - template - inline static bool inv(Mat& out, const Mat& X); - - template - inline static bool inv_rcond(Mat& A, typename get_pod_type::result& out_rcond); - - template - inline static bool inv_tr(Mat& A, const uword layout); - - template - inline static bool inv_tr_rcond(Mat& A, typename get_pod_type::result& out_rcond, const uword layout); - - template - inline static bool inv_sympd(Mat& A, bool& out_sympd_state); - - template - inline static bool inv_sympd(Mat& out, const Mat& X); - - template - inline static bool inv_sympd_rcond(Mat& A, bool& out_sympd_state, eT& out_rcond); - - template - inline static bool inv_sympd_rcond(Mat< std::complex >& A, bool& out_sympd_state, T& out_rcond); - - - // - // det and log_det - - template - inline static bool det(eT& out_val, Mat& A); - - template - inline static bool log_det(eT& out_val, typename get_pod_type::result& out_sign, Mat& A); - - template - inline static bool log_det_sympd(typename get_pod_type::result& out_val, Mat& A); - - - // - // lu - - template - inline static bool lu(Mat& L, Mat& U, podarray& ipiv, const Base& X); - - template - inline static bool lu(Mat& L, Mat& U, Mat& P, const Base& X); - - template - inline static bool lu(Mat& L, Mat& U, const Base& X); - - - // - // eig_gen - - template - inline static bool eig_gen(Mat< std::complex >& vals, Mat< std::complex >& vecs, const bool vecs_on, const Base& expr); - - template - inline static bool eig_gen(Mat< std::complex >& vals, Mat< std::complex >& vecs, const bool vecs_on, const Base< std::complex, T1 >& expr); - - - // - // eig_gen_balance - - template - inline static bool eig_gen_balance(Mat< std::complex >& vals, Mat< std::complex >& vecs, const bool vecs_on, const Base& expr); - - template - inline static bool eig_gen_balance(Mat< std::complex >& vals, Mat< std::complex >& vecs, const bool vecs_on, const Base< std::complex, T1 >& expr); - - - // - // eig_gen_twosided - - template - inline static bool eig_gen_twosided(Mat< std::complex >& vals, Mat< std::complex >& lvecs, Mat< std::complex >& rvecs, const Base& expr); - - template - inline static bool eig_gen_twosided(Mat< std::complex >& vals, Mat< std::complex >& lvecs, Mat< std::complex >& rvecs, const Base< std::complex, T1 >& expr); - - - // - // eig_gen_twosided_balance - - template - inline static bool eig_gen_twosided_balance(Mat< std::complex >& vals, Mat< std::complex >& lvecs, Mat< std::complex >& rvecs, const Base& expr); - - template - inline static bool eig_gen_twosided_balance(Mat< std::complex >& vals, Mat< std::complex >& lvecs, Mat< std::complex >& rvecs, const Base< std::complex, T1 >& expr); - - - // - // eig_pair - - template - inline static bool eig_pair(Mat< std::complex >& vals, Mat< std::complex >& vecs, const bool vecs_on, const Base& A_expr, const Base& B_expr); - - template - inline static bool eig_pair(Mat< std::complex >& vals, Mat< std::complex >& vecs, const bool vecs_on, const Base< std::complex, T1 >& A_expr, const Base< std::complex, T2 >& B_expr); - - - // - // eig_pair_twosided - - template - inline static bool eig_pair_twosided(Mat< std::complex >& vals, Mat< std::complex >& lvecs, Mat< std::complex >& rvecs, const Base& A_expr, const Base& B_expr); - - template - inline static bool eig_pair_twosided(Mat< std::complex >& vals, Mat< std::complex >& lvecs, Mat< std::complex >& rvecs, const Base< std::complex, T1 >& A_expr, const Base< std::complex, T2 >& B_expr); - - - // - // eig_sym - - template - inline static bool eig_sym(Col& eigval, Mat& A); - - template - inline static bool eig_sym(Col& eigval, Mat< std::complex >& A); - - template - inline static bool eig_sym(Col& eigval, Mat& eigvec, const Mat& X); - - template - inline static bool eig_sym(Col& eigval, Mat< std::complex >& eigvec, const Mat< std::complex >& X); - - template - inline static bool eig_sym_dc(Col& eigval, Mat& eigvec, const Mat& X); - - template - inline static bool eig_sym_dc(Col& eigval, Mat< std::complex >& eigvec, const Mat< std::complex >& X); - - - // - // chol - - template - inline static bool chol_simple(Mat& X); - - template - inline static bool chol(Mat& X, const uword layout); - - template - inline static bool chol_band(Mat& X, const uword KD, const uword layout); - - template - inline static bool chol_band(Mat< std::complex >& X, const uword KD, const uword layout); - - template - inline static bool chol_band_common(Mat& X, const uword KD, const uword layout); - - template - inline static bool chol_pivot(Mat& X, Mat& P, const uword layout); - - - // - // hessenberg decomposition - - template - inline static bool hess(Mat& H, const Base& X, Col& tao); - - - // - // qr - - template - inline static bool qr(Mat& Q, Mat& R, const Base& X); - - template - inline static bool qr_econ(Mat& Q, Mat& R, const Base& X); - - template - inline static bool qr_pivot(Mat& Q, Mat& R, Mat& P, const Base& X); - - template - inline static bool qr_pivot(Mat< std::complex >& Q, Mat< std::complex >& R, Mat& P, const Base,T1>& X); - - - // - // svd - - template - inline static bool svd(Col& S, Mat& A); - - template - inline static bool svd(Col& S, Mat< std::complex >& A); - - - template - inline static bool svd(Mat& U, Col& S, Mat& V, Mat& A); - - template - inline static bool svd(Mat< std::complex >& U, Col& S, Mat< std::complex >& V, Mat< std::complex >& A); - - template - inline static bool svd_econ(Mat& U, Col& S, Mat& V, Mat& A, const char mode); - - template - inline static bool svd_econ(Mat< std::complex >& U, Col& S, Mat< std::complex >& V, Mat< std::complex >& A, const char mode); - - - template - inline static bool svd_dc(Col& S, Mat& A); - - template - inline static bool svd_dc(Col& S, Mat< std::complex >& A); - - - template - inline static bool svd_dc(Mat& U, Col& S, Mat& V, Mat& A); - - template - inline static bool svd_dc(Mat< std::complex >& U, Col& S, Mat< std::complex >& V, Mat< std::complex >& A); - - template - inline static bool svd_dc_econ(Mat& U, Col& S, Mat& V, Mat& A); - - template - inline static bool svd_dc_econ(Mat< std::complex >& U, Col& S, Mat< std::complex >& V, Mat< std::complex >& A); - - - // - // solve - - template - inline static bool solve_square_fast(Mat& out, Mat& A, const Base& B_expr); - - template - inline static bool solve_square_rcond(Mat& out, typename T1::pod_type& out_rcond, Mat& A, const Base& B_expr); - - template - inline static bool solve_square_refine(Mat& out, typename T1::pod_type& out_rcond, Mat& A, const Base& B_expr, const bool equilibrate); - - template - inline static bool solve_square_refine(Mat< std::complex >& out, typename T1::pod_type& out_rcond, Mat< std::complex >& A, const Base,T1>& B_expr, const bool equilibrate); - - // - - template - inline static bool solve_sympd_fast(Mat& out, Mat& A, const Base& B_expr); - - template - inline static bool solve_sympd_fast_common(Mat& out, Mat& A, const Base& B_expr); - - template - inline static bool solve_sympd_rcond(Mat& out, bool& out_sympd_state, typename T1::pod_type& out_rcond, Mat& A, const Base& B_expr); - - template - inline static bool solve_sympd_rcond(Mat< std::complex >& out, bool& out_sympd_state, typename T1::pod_type& out_rcond, Mat< std::complex >& A, const Base< std::complex,T1>& B_expr); - - template - inline static bool solve_sympd_refine(Mat& out, typename T1::pod_type& out_rcond, Mat& A, const Base& B_expr, const bool equilibrate); - - template - inline static bool solve_sympd_refine(Mat< std::complex >& out, typename T1::pod_type& out_rcond, Mat< std::complex >& A, const Base,T1>& B_expr, const bool equilibrate); - - // - - template - inline static bool solve_rect_fast(Mat& out, Mat& A, const Base& B_expr); - - template - inline static bool solve_rect_rcond(Mat& out, typename T1::pod_type& out_rcond, Mat& A, const Base& B_expr); - - // - - template - inline static bool solve_approx_svd(Mat& out, Mat& A, const Base& B_expr); - - template - inline static bool solve_approx_svd(Mat< std::complex >& out, Mat< std::complex >& A, const Base,T1>& B_expr); - - // - - template - inline static bool solve_trimat_fast(Mat& out, const Mat& A, const Base& B_expr, const uword layout); - - template - inline static bool solve_trimat_rcond(Mat& out, typename T1::pod_type& out_rcond, const Mat& A, const Base& B_expr, const uword layout); - - // - - template - inline static bool solve_band_fast(Mat& out, Mat& A, const uword KL, const uword KU, const Base& B_expr); - - template - inline static bool solve_band_fast(Mat< std::complex >& out, Mat< std::complex >& A, const uword KL, const uword KU, const Base< std::complex,T1>& B_expr); - - template - inline static bool solve_band_fast_common(Mat& out, const Mat& A, const uword KL, const uword KU, const Base& B_expr); - - template - inline static bool solve_band_rcond(Mat& out, typename T1::pod_type& out_rcond, Mat& A, const uword KL, const uword KU, const Base& B_expr); - - template - inline static bool solve_band_rcond(Mat< std::complex >& out, typename T1::pod_type& out_rcond, Mat< std::complex >& A, const uword KL, const uword KU, const Base< std::complex,T1>& B_expr); - - template - inline static bool solve_band_rcond_common(Mat& out, typename T1::pod_type& out_rcond, const Mat& A, const uword KL, const uword KU, const Base& B_expr); - - template - inline static bool solve_band_refine(Mat& out, typename T1::pod_type& out_rcond, Mat& A, const uword KL, const uword KU, const Base& B_expr, const bool equilibrate); - - template - inline static bool solve_band_refine(Mat< std::complex >& out, typename T1::pod_type& out_rcond, Mat< std::complex >& A, const uword KL, const uword KU, const Base,T1>& B_expr, const bool equilibrate); - - // - - template - inline static bool solve_tridiag_fast(Mat& out, Mat& A, const Base& B_expr); - - template - inline static bool solve_tridiag_fast(Mat< std::complex >& out, Mat< std::complex >& A, const Base< std::complex,T1>& B_expr); - - template - inline static bool solve_tridiag_fast_common(Mat& out, const Mat& A, const Base& B_expr); - - - // - // Schur decomposition - - template - inline static bool schur(Mat& U, Mat& S, const Base& X, const bool calc_U = true); - - template - inline static bool schur(Mat< std::complex >& U, Mat< std::complex >& S, const Base,T1>& X, const bool calc_U = true); - - template - inline static bool schur(Mat< std::complex >& U, Mat< std::complex >& S, const bool calc_U = true); - - // - // solve the Sylvester equation AX + XB = C - - template - inline static bool syl(Mat& X, const Mat& A, const Mat& B, const Mat& C); - - - // - // QZ decomposition - - template - inline static bool qz(Mat& A, Mat& B, Mat& vsl, Mat& vsr, const Base& X_expr, const Base& Y_expr, const char mode); - - template - inline static bool qz(Mat< std::complex >& A, Mat< std::complex >& B, Mat< std::complex >& vsl, Mat< std::complex >& vsr, const Base< std::complex, T1 >& X_expr, const Base< std::complex, T2 >& Y_expr, const char mode); - - - // - // rcond - - template - inline static eT rcond(Mat& A); - - template - inline static T rcond(Mat< std::complex >& A); - - template - inline static eT rcond_sympd(Mat& A, bool& calc_ok); - - template - inline static T rcond_sympd(Mat< std::complex >& A, bool& calc_ok); - - template - inline static eT rcond_trimat(const Mat& A, const uword layout); - - template - inline static T rcond_trimat(const Mat< std::complex >& A, const uword layout); - - - // - // lu_rcond (rcond from pre-computed LU decomposition) - - template - inline static eT lu_rcond(const Mat& A, const eT norm_val); - - template - inline static T lu_rcond(const Mat< std::complex >& A, const T norm_val); - - template - inline static eT lu_rcond_sympd(const Mat& A, const eT norm_val); - - template - inline static T lu_rcond_sympd(const Mat< std::complex >& A, const T norm_val); - - template - inline static eT lu_rcond_band(const Mat& AB, const uword KL, const uword KU, const podarray& ipiv, const eT norm_val); - - template - inline static T lu_rcond_band(const Mat< std::complex >& AB, const uword KL, const uword KU, const podarray& ipiv, const T norm_val); - - - // - // misc - - template - inline static bool crippled_lapack(const Base&); - - template - inline static bool rudimentary_sym_check(const Mat& X); - - template - inline static bool rudimentary_sym_check(const Mat< std::complex >& X); - - template - inline static typename get_pod_type::result norm1_gen(const Mat& A); - - template - inline static typename get_pod_type::result norm1_sym(const Mat& A); - - template - inline static typename get_pod_type::result norm1_band(const Mat& A, const uword KL, const uword KU); - }; - - - -namespace qz_helper - { - template inline blas_int select_lhp(const T* x_ptr, const T* y_ptr, const T* z_ptr); - template inline blas_int select_rhp(const T* x_ptr, const T* y_ptr, const T* z_ptr); - template inline blas_int select_iuc(const T* x_ptr, const T* y_ptr, const T* z_ptr); - template inline blas_int select_ouc(const T* x_ptr, const T* y_ptr, const T* z_ptr); - - template inline blas_int cx_select_lhp(const std::complex* x_ptr, const std::complex* y_ptr); - template inline blas_int cx_select_rhp(const std::complex* x_ptr, const std::complex* y_ptr); - template inline blas_int cx_select_iuc(const std::complex* x_ptr, const std::complex* y_ptr); - template inline blas_int cx_select_ouc(const std::complex* x_ptr, const std::complex* y_ptr); - - template inline void_ptr ptr_cast(blas_int (*function)(const T*, const T*, const T*)); - template inline void_ptr ptr_cast(blas_int (*function)(const std::complex*, const std::complex*)); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/auxlib_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/auxlib_meat.hpp deleted file mode 100644 index bc70fdadc..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/auxlib_meat.hpp +++ /dev/null @@ -1,7060 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup auxlib -//! @{ - - - -template -inline -bool -auxlib::inv(Mat& A) - { - arma_debug_sigprint(); - - if(A.is_empty()) { return true; } - - #if defined(ARMA_USE_LAPACK) - { - arma_conform_assert_blas_size(A); - - blas_int n = blas_int(A.n_rows); - blas_int lda = blas_int(A.n_rows); - blas_int lwork = (std::max)(blas_int(podarray_prealloc_n_elem::val), n); - blas_int info = 0; - - podarray ipiv(A.n_rows); - - arma_debug_print("lapack::getrf()"); - lapack::getrf(&n, &n, A.memptr(), &lda, ipiv.memptr(), &info); - - if(info != 0) { return false; } - - if(n > 16) - { - eT work_query[2] = {}; - blas_int lwork_query = -1; - - arma_debug_print("lapack::getri()"); - lapack::getri(&n, A.memptr(), &lda, ipiv.memptr(), &work_query[0], &lwork_query, &info); - - if(info != 0) { return false; } - - blas_int lwork_proposed = static_cast( access::tmp_real(work_query[0]) ); - - lwork = (std::max)(lwork_proposed, lwork); - } - - podarray work( static_cast(lwork) ); - - arma_debug_print("lapack::getri()"); - lapack::getri(&n, A.memptr(), &lda, ipiv.memptr(), work.memptr(), &lwork, &info); - - return (info == 0); - } - #else - { - arma_ignore(A); - arma_stop_logic_error("inv(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::inv(Mat& out, const Mat& X) - { - arma_debug_sigprint(); - - out = X; - - return auxlib::inv(out); - } - - - -template -inline -bool -auxlib::inv_rcond(Mat& A, typename get_pod_type::result& out_rcond) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - out_rcond = T(0); - - if(A.is_empty()) { return true; } - - #if defined(ARMA_USE_LAPACK) - { - arma_conform_assert_blas_size(A); - - char norm_id = '1'; - blas_int n = blas_int(A.n_rows); - blas_int lda = blas_int(A.n_rows); - blas_int lwork = (std::max)(blas_int(podarray_prealloc_n_elem::val), n); - blas_int info = 0; - T norm_val = T(0); - - podarray junk(1); - podarray ipiv(A.n_rows); - - arma_debug_print("lapack::lange()"); - norm_val = (has_blas_float_bug::value) ? auxlib::norm1_gen(A) : lapack::lange(&norm_id, &n, &n, A.memptr(), &lda, junk.memptr()); - - arma_debug_print("lapack::getrf()"); - lapack::getrf(&n, &n, A.memptr(), &lda, ipiv.memptr(), &info); - - if(info != 0) { return false; } - - out_rcond = auxlib::lu_rcond(A, norm_val); - - if(n > 16) - { - eT work_query[2] = {}; - blas_int lwork_query = -1; - - arma_debug_print("lapack::getri()"); - lapack::getri(&n, A.memptr(), &lda, ipiv.memptr(), &work_query[0], &lwork_query, &info); - - if(info != 0) { return false; } - - blas_int lwork_proposed = static_cast( access::tmp_real(work_query[0]) ); - - lwork = (std::max)(lwork_proposed, lwork); - } - - podarray work( static_cast(lwork) ); - - arma_debug_print("lapack::getri()"); - lapack::getri(&n, A.memptr(), &lda, ipiv.memptr(), work.memptr(), &lwork, &info); - - return (info == 0); - } - #else - { - arma_ignore(A); - arma_stop_logic_error("inv_rcond(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::inv_tr(Mat& A, const uword layout) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - if(A.is_empty()) { return true; } - - arma_conform_assert_blas_size(A); - - char uplo = (layout == 0) ? 'U' : 'L'; - char diag = 'N'; - blas_int n = blas_int(A.n_rows); - blas_int info = 0; - - arma_debug_print("lapack::trtri()"); - lapack::trtri(&uplo, &diag, &n, A.memptr(), &n, &info); - - if(info != 0) { return false; } - - return true; - } - #else - { - arma_ignore(A); - arma_ignore(layout); - arma_stop_logic_error("inv(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::inv_tr_rcond(Mat& A, typename get_pod_type::result& out_rcond, const uword layout) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename get_pod_type::result T; - - if(A.is_empty()) { return true; } - - out_rcond = auxlib::rcond_trimat(A, layout); - - arma_conform_assert_blas_size(A); - - char uplo = (layout == 0) ? 'U' : 'L'; - char diag = 'N'; - blas_int n = blas_int(A.n_rows); - blas_int info = 0; - - arma_debug_print("lapack::trtri()"); - lapack::trtri(&uplo, &diag, &n, A.memptr(), &n, &info); - - if(info != 0) { out_rcond = T(0); return false; } - - return true; - } - #else - { - arma_ignore(A); - arma_ignore(out_rcond); - arma_ignore(layout); - arma_stop_logic_error("inv(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::inv_sympd(Mat& A, bool& out_sympd_state) - { - arma_debug_sigprint(); - - out_sympd_state = false; - - if(A.is_empty()) { return true; } - - #if defined(ARMA_USE_LAPACK) - { - arma_conform_assert_blas_size(A); - - char uplo = 'L'; - blas_int n = blas_int(A.n_rows); - blas_int info = 0; - - // NOTE: for complex matrices, zpotrf() assumes the matrix is hermitian (not simply symmetric) - - arma_debug_print("lapack::potrf()"); - lapack::potrf(&uplo, &n, A.memptr(), &n, &info); - - if(info != 0) { return false; } - - out_sympd_state = true; - - arma_debug_print("lapack::potri()"); - lapack::potri(&uplo, &n, A.memptr(), &n, &info); - - if(info != 0) { return false; } - - A = symmatl(A); - - return true; - } - #else - { - arma_ignore(A); - arma_ignore(out_sympd_state); - arma_stop_logic_error("inv_sympd(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::inv_sympd(Mat& out, const Mat& X) - { - arma_debug_sigprint(); - - out = X; - - bool sympd_state_junk = false; - - return auxlib::inv_sympd(out, sympd_state_junk); - } - - - -template -inline -bool -auxlib::inv_sympd_rcond(Mat& A, bool& out_sympd_state, eT& out_rcond) - { - arma_debug_sigprint(); - - out_sympd_state = false; - - if(A.is_empty()) { return true; } - - #if defined(ARMA_USE_LAPACK) - { - typedef typename get_pod_type::result T; - - arma_conform_assert_blas_size(A); - - char norm_id = '1'; - char uplo = 'L'; - blas_int n = blas_int(A.n_rows); - blas_int info = 0; - T norm_val = T(0); - - podarray work(A.n_rows); - - arma_debug_print("lapack::lansy()"); - norm_val = (has_blas_float_bug::value) ? auxlib::norm1_sym(A) : lapack::lansy(&norm_id, &uplo, &n, A.memptr(), &n, work.memptr()); - - arma_debug_print("lapack::potrf()"); - lapack::potrf(&uplo, &n, A.memptr(), &n, &info); - - if(info != 0) { out_rcond = eT(0); return false; } - - out_sympd_state = true; - - out_rcond = auxlib::lu_rcond_sympd(A, norm_val); - - if(arma_isnan(out_rcond)) { return false; } - - arma_debug_print("lapack::potri()"); - lapack::potri(&uplo, &n, A.memptr(), &n, &info); - - if(info != 0) { return false; } - - A = symmatl(A); - - return true; - } - #else - { - arma_ignore(A); - arma_ignore(out_sympd_state); - arma_ignore(out_rcond); - arma_stop_logic_error("inv_sympd_rcond(): use LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::inv_sympd_rcond(Mat< std::complex >& A, bool& out_sympd_state, T& out_rcond) - { - arma_debug_sigprint(); - - out_sympd_state = false; - - if(A.is_empty()) { return true; } - - #if defined(ARMA_CRIPPLED_LAPACK) - { - arma_ignore(A); - arma_ignore(out_sympd_state); - arma_ignore(out_rcond); - return false; - } - #elif defined(ARMA_USE_LAPACK) - { - arma_conform_assert_blas_size(A); - - char norm_id = '1'; - char uplo = 'L'; - blas_int n = blas_int(A.n_rows); - blas_int info = 0; - T norm_val = T(0); - - podarray work(A.n_rows); - - arma_debug_print("lapack::lanhe()"); - norm_val = (has_blas_float_bug::value) ? auxlib::norm1_sym(A) : lapack::lanhe(&norm_id, &uplo, &n, A.memptr(), &n, work.memptr()); - - arma_debug_print("lapack::potrf()"); - lapack::potrf(&uplo, &n, A.memptr(), &n, &info); - - if(info != 0) { out_rcond = T(0); return false; } - - out_sympd_state = true; - - out_rcond = auxlib::lu_rcond_sympd(A, norm_val); - - if(arma_isnan(out_rcond)) { return false; } - - arma_debug_print("lapack::potri()"); - lapack::potri(&uplo, &n, A.memptr(), &n, &info); - - if(info != 0) { return false; } - - A = symmatl(A); - - return true; - } - #else - { - arma_ignore(A); - arma_ignore(out_sympd_state); - arma_ignore(out_rcond); - arma_stop_logic_error("inv_sympd_rcond(): use LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! determinant of a matrix -template -inline -bool -auxlib::det(eT& out_val, Mat& A) - { - arma_debug_sigprint(); - - if(A.is_empty()) { out_val = eT(1); return true; } - - #if defined(ARMA_USE_LAPACK) - { - arma_conform_assert_blas_size(A); - - podarray ipiv(A.n_rows); - - blas_int info = 0; - blas_int n_rows = blas_int(A.n_rows); - blas_int n_cols = blas_int(A.n_cols); - - arma_debug_print("lapack::getrf()"); - lapack::getrf(&n_rows, &n_cols, A.memptr(), &n_rows, ipiv.memptr(), &info); - - if(info < 0) { return false; } - - // on output A appears to be L+U_alt, where U_alt is U with the main diagonal set to zero - eT val = A.at(0,0); - for(uword i=1; i < A.n_rows; ++i) { val *= A.at(i,i); } - - blas_int sign = +1; - for(uword i=0; i < A.n_rows; ++i) - { - // NOTE: adjustment of -1 is required as Fortran counts from 1 - if( blas_int(i) != (ipiv.mem[i] - 1) ) { sign *= -1; } - } - - out_val = (sign < 0) ? eT(-val) : eT(val); - - return true; - } - #else - { - arma_ignore(out_val); - arma_ignore(A); - arma_stop_logic_error("det(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! log determinant of a matrix -template -inline -bool -auxlib::log_det(eT& out_val, typename get_pod_type::result& out_sign, Mat& A) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - if(A.is_empty()) { out_val = eT(0); out_sign = T(1); return true; } - - #if defined(ARMA_USE_LAPACK) - { - arma_conform_assert_blas_size(A); - - podarray ipiv(A.n_rows); - - blas_int info = 0; - blas_int n_rows = blas_int(A.n_rows); - blas_int n_cols = blas_int(A.n_cols); - - arma_debug_print("lapack::getrf()"); - lapack::getrf(&n_rows, &n_cols, A.memptr(), &n_rows, ipiv.memptr(), &info); - - if(info < 0) { return false; } - - // on output A appears to be L+U_alt, where U_alt is U with the main diagonal set to zero - - sword sign = (is_cx::no) ? ( (access::tmp_real( A.at(0,0) ) < T(0)) ? -1 : +1 ) : +1; - eT val = (is_cx::no) ? std::log( (access::tmp_real( A.at(0,0) ) < T(0)) ? A.at(0,0)*T(-1) : A.at(0,0) ) : std::log( A.at(0,0) ); - - for(uword i=1; i < A.n_rows; ++i) - { - const eT x = A.at(i,i); - - sign *= (is_cx::no) ? ( (access::tmp_real(x) < T(0)) ? -1 : +1 ) : +1; - val += (is_cx::no) ? std::log( (access::tmp_real(x) < T(0)) ? x*T(-1) : x ) : std::log(x); - } - - for(uword i=0; i < A.n_rows; ++i) - { - if( blas_int(i) != (ipiv.mem[i] - 1) ) // NOTE: adjustment of -1 is required as Fortran counts from 1 - { - sign *= -1; - } - } - - out_val = val; - out_sign = T(sign); - - return true; - } - #else - { - arma_ignore(A); - arma_ignore(out_val); - arma_ignore(out_sign); - arma_stop_logic_error("log_det(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::log_det_sympd(typename get_pod_type::result& out_val, Mat& A) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - if(A.is_empty()) { out_val = T(0); return true; } - - #if defined(ARMA_USE_LAPACK) - { - arma_conform_assert_blas_size(A); - - char uplo = 'L'; - blas_int n = blas_int(A.n_rows); - blas_int info = 0; - - arma_debug_print("lapack::potrf()"); - lapack::potrf(&uplo, &n, A.memptr(), &n, &info); - - if(info != 0) { return false; } - - T val = T(0); - - for(uword i=0; i < A.n_rows; ++i) { val += std::log( access::tmp_real(A.at(i,i)) ); } - - out_val = T(2) * val; - - return true; - } - #else - { - arma_ignore(out_val); - arma_ignore(A); - arma_stop_logic_error("log_det_sympd(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! LU decomposition of a matrix -template -inline -bool -auxlib::lu(Mat& L, Mat& U, podarray& ipiv, const Base& X) - { - arma_debug_sigprint(); - - U = X.get_ref(); - - const uword U_n_rows = U.n_rows; - const uword U_n_cols = U.n_cols; - - if(U.is_empty()) { L.set_size(U_n_rows, 0); U.set_size(0, U_n_cols); ipiv.reset(); return true; } - - #if defined(ARMA_USE_LAPACK) - { - arma_conform_assert_blas_size(U); - - ipiv.set_size( (std::min)(U_n_rows, U_n_cols) ); - - blas_int info = 0; - - blas_int n_rows = blas_int(U_n_rows); - blas_int n_cols = blas_int(U_n_cols); - - arma_debug_print("lapack::getrf()"); - lapack::getrf(&n_rows, &n_cols, U.memptr(), &n_rows, ipiv.memptr(), &info); - - if(info < 0) { return false; } - - // take into account that Fortran counts from 1 - arrayops::inplace_minus(ipiv.memptr(), blas_int(1), ipiv.n_elem); - - L.copy_size(U); - - for(uword col=0; col < U_n_cols; ++col) - { - for(uword row=0; (row < col) && (row < U_n_rows); ++row) - { - L.at(row,col) = eT(0); - } - - if( L.in_range(col,col) ) - { - L.at(col,col) = eT(1); - } - - for(uword row = (col+1); row < U_n_rows; ++row) - { - L.at(row,col) = U.at(row,col); - U.at(row,col) = eT(0); - } - } - - return true; - } - #else - { - arma_stop_logic_error("lu(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::lu(Mat& L, Mat& U, Mat& P, const Base& X) - { - arma_debug_sigprint(); - - podarray ipiv1; - const bool status = auxlib::lu(L, U, ipiv1, X); - - if(status == false) { return false; } - - if(U.is_empty()) - { - // L and U have been already set to the correct empty matrices - P.eye(L.n_rows, L.n_rows); - return true; - } - - const uword n = ipiv1.n_elem; - const uword P_rows = U.n_rows; - - podarray ipiv2(P_rows); - - const blas_int* ipiv1_mem = ipiv1.memptr(); - blas_int* ipiv2_mem = ipiv2.memptr(); - - for(uword i=0; i(ipiv1_mem[i]); - - if( ipiv2_mem[i] != ipiv2_mem[k] ) - { - std::swap( ipiv2_mem[i], ipiv2_mem[k] ); - } - } - - P.zeros(P_rows, P_rows); - - for(uword row=0; row(ipiv2_mem[row])) = eT(1); - } - - if(L.n_cols > U.n_rows) - { - L.shed_cols(U.n_rows, L.n_cols-1); - } - - if(U.n_rows > L.n_cols) - { - U.shed_rows(L.n_cols, U.n_rows-1); - } - - return true; - } - - - -template -inline -bool -auxlib::lu(Mat& L, Mat& U, const Base& X) - { - arma_debug_sigprint(); - - podarray ipiv1; - const bool status = auxlib::lu(L, U, ipiv1, X); - - if(status == false) { return false; } - - if(U.is_empty()) - { - // L and U have been already set to the correct empty matrices - return true; - } - - const uword n = ipiv1.n_elem; - const uword P_rows = U.n_rows; - - podarray ipiv2(P_rows); - - const blas_int* ipiv1_mem = ipiv1.memptr(); - blas_int* ipiv2_mem = ipiv2.memptr(); - - for(uword i=0; i(ipiv1_mem[i]); - - if( ipiv2_mem[i] != ipiv2_mem[k] ) - { - std::swap( ipiv2_mem[i], ipiv2_mem[k] ); - L.swap_rows( static_cast(ipiv2_mem[i]), static_cast(ipiv2_mem[k]) ); - } - } - - if(L.n_cols > U.n_rows) - { - L.shed_cols(U.n_rows, L.n_cols-1); - } - - if(U.n_rows > L.n_cols) - { - U.shed_rows(L.n_cols, U.n_rows-1); - } - - return true; - } - - - -//! eigen decomposition of general square matrix (real) -template -inline -bool -auxlib::eig_gen - ( - Mat< std::complex >& vals, - Mat< std::complex >& vecs, - const bool vecs_on, - const Base& expr - ) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type T; - - Mat X = expr.get_ref(); - - arma_conform_check( (X.is_square() == false), "eig_gen(): given matrix must be square sized" ); - - arma_conform_assert_blas_size(X); - - if(X.is_empty()) { vals.reset(); vecs.reset(); return true; } - - if(arma_config::check_nonfinite && X.internal_has_nonfinite()) { return false; } - - vals.set_size(X.n_rows, 1); - - Mat tmp(1, 1, arma_nozeros_indicator()); - - if(vecs_on) - { - vecs.set_size(X.n_rows, X.n_rows); - tmp.set_size(X.n_rows, X.n_rows); - } - - podarray junk(1); - - char jobvl = 'N'; - char jobvr = (vecs_on) ? 'V' : 'N'; - blas_int N = blas_int(X.n_rows); - T* vl = junk.memptr(); - T* vr = (vecs_on) ? tmp.memptr() : junk.memptr(); - blas_int ldvl = blas_int(1); - blas_int ldvr = (vecs_on) ? blas_int(tmp.n_rows) : blas_int(1); - blas_int lwork = 64*N; // lwork_min = (vecs_on) ? (std::max)(blas_int(1), 4*N) : (std::max)(blas_int(1), 3*N) - blas_int info = 0; - - podarray work( static_cast(lwork) ); - - podarray vals_real(X.n_rows); - podarray vals_imag(X.n_rows); - - arma_debug_print("lapack::geev() -- START"); - lapack::geev(&jobvl, &jobvr, &N, X.memptr(), &N, vals_real.memptr(), vals_imag.memptr(), vl, &ldvl, vr, &ldvr, work.memptr(), &lwork, &info); - arma_debug_print("lapack::geev() -- END"); - - if(info != 0) { return false; } - - arma_debug_print("reformatting eigenvalues and eigenvectors"); - - std::complex* vals_mem = vals.memptr(); - - for(uword i=0; i < X.n_rows; ++i) { vals_mem[i] = std::complex(vals_real[i], vals_imag[i]); } - - if(vecs_on) - { - for(uword j=0; j < X.n_rows; ++j) - { - if( (j < (X.n_rows-1)) && (vals_mem[j] == std::conj(vals_mem[j+1])) ) - { - for(uword i=0; i < X.n_rows; ++i) - { - vecs.at(i,j) = std::complex( tmp.at(i,j), tmp.at(i,j+1) ); - vecs.at(i,j+1) = std::complex( tmp.at(i,j), -tmp.at(i,j+1) ); - } - - ++j; - } - else - { - for(uword i=0; i(tmp.at(i,j), T(0)); - } - } - } - } - - return true; - } - #else - { - arma_ignore(vals); - arma_ignore(vecs); - arma_ignore(vecs_on); - arma_ignore(expr); - arma_stop_logic_error("eig_gen(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! eigen decomposition of general square matrix (complex) -template -inline -bool -auxlib::eig_gen - ( - Mat< std::complex >& vals, - Mat< std::complex >& vecs, - const bool vecs_on, - const Base< std::complex, T1 >& expr - ) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type T; - typedef typename std::complex eT; - - Mat X = expr.get_ref(); - - arma_conform_check( (X.is_square() == false), "eig_gen(): given matrix must be square sized" ); - - arma_conform_assert_blas_size(X); - - if(X.is_empty()) { vals.reset(); vecs.reset(); return true; } - - if(arma_config::check_nonfinite && X.internal_has_nonfinite()) { return false; } - - vals.set_size(X.n_rows, 1); - - if(vecs_on) { vecs.set_size(X.n_rows, X.n_rows); } - - podarray junk(1); - - char jobvl = 'N'; - char jobvr = (vecs_on) ? 'V' : 'N'; - blas_int N = blas_int(X.n_rows); - eT* vl = junk.memptr(); - eT* vr = (vecs_on) ? vecs.memptr() : junk.memptr(); - blas_int ldvl = blas_int(1); - blas_int ldvr = (vecs_on) ? blas_int(vecs.n_rows) : blas_int(1); - blas_int lwork = 64*N; // lwork_min = (std::max)(blas_int(1), 2*N) - blas_int info = 0; - - podarray work( static_cast(lwork) ); - podarray< T> rwork( static_cast(2*N) ); - - arma_debug_print("lapack::cx_geev() -- START"); - lapack::cx_geev(&jobvl, &jobvr, &N, X.memptr(), &N, vals.memptr(), vl, &ldvl, vr, &ldvr, work.memptr(), &lwork, rwork.memptr(), &info); - arma_debug_print("lapack::cx_geev() -- END"); - - return (info == 0); - } - #else - { - arma_ignore(vals); - arma_ignore(vecs); - arma_ignore(vecs_on); - arma_ignore(expr); - arma_stop_logic_error("eig_gen(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! eigen decomposition of general square matrix (real, balance given matrix) -template -inline -bool -auxlib::eig_gen_balance - ( - Mat< std::complex >& vals, - Mat< std::complex >& vecs, - const bool vecs_on, - const Base& expr - ) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type T; - - Mat X = expr.get_ref(); - - arma_conform_check( (X.is_square() == false), "eig_gen(): given matrix must be square sized" ); - - arma_conform_assert_blas_size(X); - - if(X.is_empty()) { vals.reset(); vecs.reset(); return true; } - - if(arma_config::check_nonfinite && X.internal_has_nonfinite()) { return false; } - - vals.set_size(X.n_rows, 1); - - Mat tmp(1, 1, arma_nozeros_indicator()); - - if(vecs_on) - { - vecs.set_size(X.n_rows, X.n_rows); - tmp.set_size(X.n_rows, X.n_rows); - } - - podarray junk(1); - - char bal = 'B'; - char jobvl = 'N'; - char jobvr = (vecs_on) ? 'V' : 'N'; - char sense = 'N'; - blas_int N = blas_int(X.n_rows); - T* vl = junk.memptr(); - T* vr = (vecs_on) ? tmp.memptr() : junk.memptr(); - blas_int ldvl = blas_int(1); - blas_int ldvr = (vecs_on) ? blas_int(tmp.n_rows) : blas_int(1); - blas_int ilo = blas_int(0); - blas_int ihi = blas_int(0); - T abnrm = T(0); - blas_int lwork = 64*N; // lwork_min = (vecs_on) ? (std::max)(blas_int(1), 2*N) : (std::max)(blas_int(1), 3*N) - blas_int info = blas_int(0); - - podarray scale(X.n_rows); - podarray rconde(X.n_rows); - podarray rcondv(X.n_rows); - - podarray work( static_cast(lwork) ); - podarray iwork( uword(1) ); // iwork not used by lapack::geevx() as sense = 'N' - - podarray vals_real(X.n_rows); - podarray vals_imag(X.n_rows); - - arma_debug_print("lapack::geevx() -- START"); - lapack::geevx(&bal, &jobvl, &jobvr, &sense, &N, X.memptr(), &N, vals_real.memptr(), vals_imag.memptr(), vl, &ldvl, vr, &ldvr, &ilo, &ihi, scale.memptr(), &abnrm, rconde.memptr(), rcondv.memptr(), work.memptr(), &lwork, iwork.memptr(), &info); - arma_debug_print("lapack::geevx() -- END"); - - if(info != 0) { return false; } - - arma_debug_print("reformatting eigenvalues and eigenvectors"); - - std::complex* vals_mem = vals.memptr(); - - for(uword i=0; i < X.n_rows; ++i) { vals_mem[i] = std::complex(vals_real[i], vals_imag[i]); } - - if(vecs_on) - { - for(uword j=0; j < X.n_rows; ++j) - { - if( (j < (X.n_rows-1)) && (vals_mem[j] == std::conj(vals_mem[j+1])) ) - { - for(uword i=0; i < X.n_rows; ++i) - { - vecs.at(i,j) = std::complex( tmp.at(i,j), tmp.at(i,j+1) ); - vecs.at(i,j+1) = std::complex( tmp.at(i,j), -tmp.at(i,j+1) ); - } - - ++j; - } - else - { - for(uword i=0; i(tmp.at(i,j), T(0)); - } - } - } - } - - return true; - } - #else - { - arma_ignore(vals); - arma_ignore(vecs); - arma_ignore(vecs_on); - arma_ignore(expr); - arma_stop_logic_error("eig_gen(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! eigen decomposition of general square matrix (complex, balance given matrix) -template -inline -bool -auxlib::eig_gen_balance - ( - Mat< std::complex >& vals, - Mat< std::complex >& vecs, - const bool vecs_on, - const Base< std::complex, T1 >& expr - ) - { - arma_debug_sigprint(); - - #if defined(ARMA_CRIPPLED_LAPACK) - { - arma_debug_print("auxlib::eig_gen_balance(): redirecting to auxlib::eig_gen() due to crippled LAPACK"); - - return auxlib::eig_gen(vals, vecs, vecs_on, expr); - } - #elif defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type T; - typedef typename std::complex eT; - - Mat X = expr.get_ref(); - - arma_conform_check( (X.is_square() == false), "eig_gen(): given matrix must be square sized" ); - - arma_conform_assert_blas_size(X); - - if(X.is_empty()) { vals.reset(); vecs.reset(); return true; } - - if(arma_config::check_nonfinite && X.internal_has_nonfinite()) { return false; } - - vals.set_size(X.n_rows, 1); - - if(vecs_on) { vecs.set_size(X.n_rows, X.n_rows); } - - podarray junk(1); - - char bal = 'B'; - char jobvl = 'N'; - char jobvr = (vecs_on) ? 'V' : 'N'; - char sense = 'N'; - blas_int N = blas_int(X.n_rows); - eT* vl = junk.memptr(); - eT* vr = (vecs_on) ? vecs.memptr() : junk.memptr(); - blas_int ldvl = blas_int(1); - blas_int ldvr = (vecs_on) ? blas_int(vecs.n_rows) : blas_int(1); - blas_int ilo = blas_int(0); - blas_int ihi = blas_int(0); - T abnrm = T(0); - blas_int lwork = 64*N; // lwork_min = (std::max)(blas_int(1), blas_int(2*N)) - blas_int info = blas_int(0); - - podarray scale(X.n_rows); - podarray rconde(X.n_rows); - podarray rcondv(X.n_rows); - - podarray work( static_cast(lwork) ); - podarray< T> rwork( static_cast(2*N) ); - - arma_debug_print("lapack::cx_geevx() -- START"); - lapack::cx_geevx(&bal, &jobvl, &jobvr, &sense, &N, X.memptr(), &N, vals.memptr(), vl, &ldvl, vr, &ldvr, &ilo, &ihi, scale.memptr(), &abnrm, rconde.memptr(), rcondv.memptr(), work.memptr(), &lwork, rwork.memptr(), &info); - arma_debug_print("lapack::cx_geevx() -- END"); - - return (info == 0); - } - #else - { - arma_ignore(vals); - arma_ignore(vecs); - arma_ignore(vecs_on); - arma_ignore(expr); - arma_stop_logic_error("eig_gen(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! two-sided eigen decomposition of general square matrix (real) -template -inline -bool -auxlib::eig_gen_twosided - ( - Mat< std::complex >& vals, - Mat< std::complex >& lvecs, - Mat< std::complex >& rvecs, - const Base& expr - ) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type T; - - Mat X = expr.get_ref(); - - arma_conform_check( (X.is_square() == false), "eig_gen(): given matrix must be square sized" ); - - arma_conform_assert_blas_size(X); - - if(X.is_empty()) { vals.reset(); lvecs.reset(); rvecs.reset(); return true; } - - if(arma_config::check_nonfinite && X.internal_has_nonfinite()) { return false; } - - vals.set_size(X.n_rows, 1); - - lvecs.set_size(X.n_rows, X.n_rows); - rvecs.set_size(X.n_rows, X.n_rows); - - Mat ltmp(X.n_rows, X.n_rows, arma_nozeros_indicator()); - Mat rtmp(X.n_rows, X.n_rows, arma_nozeros_indicator()); - - char jobvl = 'V'; - char jobvr = 'V'; - blas_int N = blas_int(X.n_rows); - blas_int ldvl = blas_int(ltmp.n_rows); - blas_int ldvr = blas_int(rtmp.n_rows); - blas_int lwork = 64*N; // lwork_min = (std::max)(blas_int(1), 4*N) - blas_int info = 0; - - podarray work( static_cast(lwork) ); - - podarray vals_real(X.n_rows); - podarray vals_imag(X.n_rows); - - arma_debug_print("lapack::geev() -- START"); - lapack::geev(&jobvl, &jobvr, &N, X.memptr(), &N, vals_real.memptr(), vals_imag.memptr(), ltmp.memptr(), &ldvl, rtmp.memptr(), &ldvr, work.memptr(), &lwork, &info); - arma_debug_print("lapack::geev() -- END"); - - if(info != 0) { return false; } - - arma_debug_print("reformatting eigenvalues and eigenvectors"); - - std::complex* vals_mem = vals.memptr(); - - for(uword i=0; i < X.n_rows; ++i) { vals_mem[i] = std::complex(vals_real[i], vals_imag[i]); } - - for(uword j=0; j < X.n_rows; ++j) - { - if( (j < (X.n_rows-1)) && (vals_mem[j] == std::conj(vals_mem[j+1])) ) - { - for(uword i=0; i < X.n_rows; ++i) - { - lvecs.at(i,j) = std::complex( ltmp.at(i,j), ltmp.at(i,j+1) ); - lvecs.at(i,j+1) = std::complex( ltmp.at(i,j), -ltmp.at(i,j+1) ); - rvecs.at(i,j) = std::complex( rtmp.at(i,j), rtmp.at(i,j+1) ); - rvecs.at(i,j+1) = std::complex( rtmp.at(i,j), -rtmp.at(i,j+1) ); - } - ++j; - } - else - { - for(uword i=0; i(ltmp.at(i,j), T(0)); - rvecs.at(i,j) = std::complex(rtmp.at(i,j), T(0)); - } - } - } - - return true; - } - #else - { - arma_ignore(vals); - arma_ignore(lvecs); - arma_ignore(rvecs); - arma_ignore(expr); - arma_stop_logic_error("eig_gen(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! two-sided eigen decomposition of general square matrix (complex) -template -inline -bool -auxlib::eig_gen_twosided - ( - Mat< std::complex >& vals, - Mat< std::complex >& lvecs, - Mat< std::complex >& rvecs, - const Base< std::complex, T1 >& expr - ) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type T; - typedef typename std::complex eT; - - Mat X = expr.get_ref(); - - arma_conform_check( (X.is_square() == false), "eig_gen(): given matrix must be square sized" ); - - arma_conform_assert_blas_size(X); - - if(X.is_empty()) { vals.reset(); lvecs.reset(); rvecs.reset(); return true; } - - if(arma_config::check_nonfinite && X.internal_has_nonfinite()) { return false; } - - vals.set_size(X.n_rows, 1); - - lvecs.set_size(X.n_rows, X.n_rows); - rvecs.set_size(X.n_rows, X.n_rows); - - char jobvl = 'V'; - char jobvr = 'V'; - blas_int N = blas_int(X.n_rows); - blas_int ldvl = blas_int(lvecs.n_rows); - blas_int ldvr = blas_int(rvecs.n_rows); - blas_int lwork = 64*N; // lwork_min = (std::max)(blas_int(1), 2*N) - blas_int info = 0; - - podarray work( static_cast(lwork) ); - podarray< T> rwork( static_cast(2*N) ); - - arma_debug_print("lapack::cx_geev() -- START"); - lapack::cx_geev(&jobvl, &jobvr, &N, X.memptr(), &N, vals.memptr(), lvecs.memptr(), &ldvl, rvecs.memptr(), &ldvr, work.memptr(), &lwork, rwork.memptr(), &info); - arma_debug_print("lapack::cx_geev() -- END"); - - return (info == 0); - } - #else - { - arma_ignore(vals); - arma_ignore(lvecs); - arma_ignore(rvecs); - arma_ignore(expr); - arma_stop_logic_error("eig_gen(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! two-sided eigen decomposition of general square matrix (real, balance given matrix) -template -inline -bool -auxlib::eig_gen_twosided_balance - ( - Mat< std::complex >& vals, - Mat< std::complex >& lvecs, - Mat< std::complex >& rvecs, - const Base& expr - ) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type T; - - Mat X = expr.get_ref(); - - arma_conform_check( (X.is_square() == false), "eig_gen(): given matrix must be square sized" ); - - arma_conform_assert_blas_size(X); - - if(X.is_empty()) { vals.reset(); lvecs.reset(); rvecs.reset(); return true; } - - if(arma_config::check_nonfinite && X.internal_has_nonfinite()) { return false; } - - vals.set_size(X.n_rows, 1); - - lvecs.set_size(X.n_rows, X.n_rows); - rvecs.set_size(X.n_rows, X.n_rows); - - Mat ltmp(X.n_rows, X.n_rows, arma_nozeros_indicator()); - Mat rtmp(X.n_rows, X.n_rows, arma_nozeros_indicator()); - - char bal = 'B'; - char jobvl = 'V'; - char jobvr = 'V'; - char sense = 'N'; - blas_int N = blas_int(X.n_rows); - blas_int ldvl = blas_int(ltmp.n_rows); - blas_int ldvr = blas_int(rtmp.n_rows); - blas_int ilo = blas_int(0); - blas_int ihi = blas_int(0); - T abnrm = T(0); - blas_int lwork = 64*N; // lwork_min = (std::max)(blas_int(1), blas_int(3*N)) - blas_int info = blas_int(0); - - podarray scale(X.n_rows); - podarray rconde(X.n_rows); - podarray rcondv(X.n_rows); - - podarray work( static_cast(lwork) ); - podarray iwork( uword(1) ); // iwork not used by lapack::geevx() as sense = 'N' - - podarray vals_real(X.n_rows); - podarray vals_imag(X.n_rows); - - arma_debug_print("lapack::geevx() -- START"); - lapack::geevx(&bal, &jobvl, &jobvr, &sense, &N, X.memptr(), &N, vals_real.memptr(), vals_imag.memptr(), ltmp.memptr(), &ldvl, rtmp.memptr(), &ldvr, &ilo, &ihi, scale.memptr(), &abnrm, rconde.memptr(), rcondv.memptr(), work.memptr(), &lwork, iwork.memptr(), &info); - arma_debug_print("lapack::geevx() -- END"); - - if(info != 0) { return false; } - - arma_debug_print("reformatting eigenvalues and eigenvectors"); - - std::complex* vals_mem = vals.memptr(); - - for(uword i=0; i < X.n_rows; ++i) { vals_mem[i] = std::complex(vals_real[i], vals_imag[i]); } - - for(uword j=0; j < X.n_rows; ++j) - { - if( (j < (X.n_rows-1)) && (vals_mem[j] == std::conj(vals_mem[j+1])) ) - { - for(uword i=0; i < X.n_rows; ++i) - { - lvecs.at(i,j) = std::complex( ltmp.at(i,j), ltmp.at(i,j+1) ); - lvecs.at(i,j+1) = std::complex( ltmp.at(i,j), -ltmp.at(i,j+1) ); - rvecs.at(i,j) = std::complex( rtmp.at(i,j), rtmp.at(i,j+1) ); - rvecs.at(i,j+1) = std::complex( rtmp.at(i,j), -rtmp.at(i,j+1) ); - } - ++j; - } - else - { - for(uword i=0; i(ltmp.at(i,j), T(0)); - rvecs.at(i,j) = std::complex(rtmp.at(i,j), T(0)); - } - } - } - - return true; - } - #else - { - arma_ignore(vals); - arma_ignore(lvecs); - arma_ignore(rvecs); - arma_ignore(expr); - arma_stop_logic_error("eig_gen(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! two-sided eigen decomposition of general square matrix (complex, balance given matrix) -template -inline -bool -auxlib::eig_gen_twosided_balance - ( - Mat< std::complex >& vals, - Mat< std::complex >& lvecs, - Mat< std::complex >& rvecs, - const Base< std::complex, T1 >& expr - ) - { - arma_debug_sigprint(); - - #if defined(ARMA_CRIPPLED_LAPACK) - { - arma_debug_print("auxlib::eig_gen_twosided_balance(): redirecting to auxlib::eig_gen() due to crippled LAPACK"); - - return auxlib::eig_gen(vals, lvecs, rvecs, expr); - } - #elif defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type T; - typedef typename std::complex eT; - - Mat X = expr.get_ref(); - - arma_conform_check( (X.is_square() == false), "eig_gen(): given matrix must be square sized" ); - - arma_conform_assert_blas_size(X); - - if(X.is_empty()) { vals.reset(); lvecs.reset(); rvecs.reset(); return true; } - - if(arma_config::check_nonfinite && X.internal_has_nonfinite()) { return false; } - - vals.set_size(X.n_rows, 1); - - lvecs.set_size(X.n_rows, X.n_rows); - rvecs.set_size(X.n_rows, X.n_rows); - - char bal = 'B'; - char jobvl = 'V'; - char jobvr = 'V'; - char sense = 'N'; - blas_int N = blas_int(X.n_rows); - blas_int ldvl = blas_int(lvecs.n_rows); - blas_int ldvr = blas_int(rvecs.n_rows); - blas_int ilo = blas_int(0); - blas_int ihi = blas_int(0); - T abnrm = T(0); - blas_int lwork = 64*N; // lwork_min = (std::max)(blas_int(1), blas_int(2*N)) - blas_int info = blas_int(0); - - podarray scale(X.n_rows); - podarray rconde(X.n_rows); - podarray rcondv(X.n_rows); - - podarray work( static_cast(lwork) ); - podarray< T> rwork( static_cast(2*N) ); - - arma_debug_print("lapack::cx_geevx() -- START"); - lapack::cx_geevx(&bal, &jobvl, &jobvr, &sense, &N, X.memptr(), &N, vals.memptr(), lvecs.memptr(), &ldvl, rvecs.memptr(), &ldvr, &ilo, &ihi, scale.memptr(), &abnrm, rconde.memptr(), rcondv.memptr(), work.memptr(), &lwork, rwork.memptr(), &info); - arma_debug_print("lapack::cx_geevx() -- END"); - - return (info == 0); - } - #else - { - arma_ignore(vals); - arma_ignore(lvecs); - arma_ignore(rvecs); - arma_ignore(expr); - arma_stop_logic_error("eig_gen(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! eigendecomposition of general square matrix pair (real) -template -inline -bool -auxlib::eig_pair - ( - Mat< std::complex >& vals, - Mat< std::complex >& vecs, - const bool vecs_on, - const Base& A_expr, - const Base& B_expr - ) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type T; - typedef std::complex eT; - - Mat A(A_expr.get_ref()); - Mat B(B_expr.get_ref()); - - arma_conform_check( ((A.is_square() == false) || (B.is_square() == false)), "eig_pair(): given matrices must be square sized" ); - - arma_conform_check( (A.n_rows != B.n_rows), "eig_pair(): given matrices must have the same size" ); - - arma_conform_assert_blas_size(A); - - if(A.is_empty()) { vals.reset(); vecs.reset(); return true; } - - if(arma_config::check_nonfinite && A.internal_has_nonfinite()) { return false; } - if(arma_config::check_nonfinite && B.internal_has_nonfinite()) { return false; } - - vals.set_size(A.n_rows, 1); - - Mat tmp(1, 1, arma_nozeros_indicator()); - - if(vecs_on) - { - vecs.set_size(A.n_rows, A.n_rows); - tmp.set_size(A.n_rows, A.n_rows); - } - - podarray junk(1); - - char jobvl = 'N'; - char jobvr = (vecs_on) ? 'V' : 'N'; - blas_int N = blas_int(A.n_rows); - T* vl = junk.memptr(); - T* vr = (vecs_on) ? tmp.memptr() : junk.memptr(); - blas_int ldvl = blas_int(1); - blas_int ldvr = (vecs_on) ? blas_int(tmp.n_rows) : blas_int(1); - blas_int lwork = 64*N; // lwork_min = (std::max)(blas_int(1), 8*N) - blas_int info = 0; - - podarray alphar(A.n_rows); - podarray alphai(A.n_rows); - podarray beta(A.n_rows); - - podarray work( static_cast(lwork) ); - - arma_debug_print("lapack::ggev()"); - lapack::ggev(&jobvl, &jobvr, &N, A.memptr(), &N, B.memptr(), &N, alphar.memptr(), alphai.memptr(), beta.memptr(), vl, &ldvl, vr, &ldvr, work.memptr(), &lwork, &info); - - if(info != 0) { return false; } - - arma_debug_print("reformatting eigenvalues and eigenvectors"); - - eT* vals_mem = vals.memptr(); - const T* alphar_mem = alphar.memptr(); - const T* alphai_mem = alphai.memptr(); - const T* beta_mem = beta.memptr(); - - bool beta_has_zero = false; - - for(uword j=0; j(re, im); - - if( (alphai_val > T(0)) && (j < (A.n_rows-1)) ) - { - ++j; - vals_mem[j] = std::complex(re,-im); // force exact conjugate - } - } - - if(beta_has_zero) { arma_warn(1, "eig_pair(): given matrices appear ill-conditioned"); } - - if(vecs_on) - { - for(uword j=0; j( tmp.at(i,j), tmp.at(i,j+1) ); - vecs.at(i,j+1) = std::complex( tmp.at(i,j), -tmp.at(i,j+1) ); - } - - ++j; - } - else - { - for(uword i=0; i(tmp.at(i,j), T(0)); - } - } - } - } - - return true; - } - #else - { - arma_ignore(vals); - arma_ignore(vecs); - arma_ignore(vecs_on); - arma_ignore(A_expr); - arma_ignore(B_expr); - arma_stop_logic_error("eig_pair(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! eigendecomposition of general square matrix pair (complex) -template -inline -bool -auxlib::eig_pair - ( - Mat< std::complex >& vals, - Mat< std::complex >& vecs, - const bool vecs_on, - const Base< std::complex, T1 >& A_expr, - const Base< std::complex, T2 >& B_expr - ) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type T; - typedef typename std::complex eT; - - Mat A(A_expr.get_ref()); - Mat B(B_expr.get_ref()); - - arma_conform_check( ((A.is_square() == false) || (B.is_square() == false)), "eig_pair(): given matrices must be square sized" ); - - arma_conform_check( (A.n_rows != B.n_rows), "eig_pair(): given matrices must have the same size" ); - - arma_conform_assert_blas_size(A); - - if(A.is_empty()) { vals.reset(); vecs.reset(); return true; } - - if(arma_config::check_nonfinite && A.internal_has_nonfinite()) { return false; } - if(arma_config::check_nonfinite && B.internal_has_nonfinite()) { return false; } - - vals.set_size(A.n_rows, 1); - - if(vecs_on) { vecs.set_size(A.n_rows, A.n_rows); } - - podarray junk(1); - - char jobvl = 'N'; - char jobvr = (vecs_on) ? 'V' : 'N'; - blas_int N = blas_int(A.n_rows); - eT* vl = junk.memptr(); - eT* vr = (vecs_on) ? vecs.memptr() : junk.memptr(); - blas_int ldvl = blas_int(1); - blas_int ldvr = (vecs_on) ? blas_int(vecs.n_rows) : blas_int(1); - blas_int lwork = 64*N; // lwork_min = (std::max)(blas_int(1),2*N) - blas_int info = 0; - - podarray alpha(A.n_rows); - podarray beta(A.n_rows); - - podarray work( static_cast(lwork) ); - podarray rwork( static_cast(8*N) ); - - arma_debug_print("lapack::cx_ggev()"); - lapack::cx_ggev(&jobvl, &jobvr, &N, A.memptr(), &N, B.memptr(), &N, alpha.memptr(), beta.memptr(), vl, &ldvl, vr, &ldvr, work.memptr(), &lwork, rwork.memptr(), &info); - - if(info != 0) { return false; } - - eT* vals_mem = vals.memptr(); - const eT* alpha_mem = alpha.memptr(); - const eT* beta_mem = beta.memptr(); - - const std::complex zero(T(0), T(0)); - - bool beta_has_zero = false; - - for(uword i=0; i -inline -bool -auxlib::eig_pair_twosided - ( - Mat< std::complex >& vals, - Mat< std::complex >& lvecs, - Mat< std::complex >& rvecs, - const Base& A_expr, - const Base& B_expr - ) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type T; - typedef std::complex eT; - - Mat A(A_expr.get_ref()); - Mat B(B_expr.get_ref()); - - arma_conform_check( ((A.is_square() == false) || (B.is_square() == false)), "eig_pair(): given matrices must be square sized" ); - - arma_conform_check( (A.n_rows != B.n_rows), "eig_pair(): given matrices must have the same size" ); - - arma_conform_assert_blas_size(A); - - if(A.is_empty()) { vals.reset(); lvecs.reset(); rvecs.reset(); return true; } - - if(arma_config::check_nonfinite && A.internal_has_nonfinite()) { return false; } - if(arma_config::check_nonfinite && B.internal_has_nonfinite()) { return false; } - - vals.set_size(A.n_rows, 1); - - lvecs.set_size(A.n_rows, A.n_rows); - rvecs.set_size(A.n_rows, A.n_rows); - - Mat ltmp(A.n_rows, A.n_rows, arma_nozeros_indicator()); - Mat rtmp(A.n_rows, A.n_rows, arma_nozeros_indicator()); - - char jobvl = 'V'; - char jobvr = 'V'; - blas_int N = blas_int(A.n_rows); - blas_int ldvl = blas_int(ltmp.n_rows); - blas_int ldvr = blas_int(rtmp.n_rows); - blas_int lwork = 64*N; // lwork_min = (std::max)(blas_int(1), 8*N) - blas_int info = 0; - - podarray alphar(A.n_rows); - podarray alphai(A.n_rows); - podarray beta(A.n_rows); - - podarray work( static_cast(lwork) ); - - arma_debug_print("lapack::ggev()"); - lapack::ggev(&jobvl, &jobvr, &N, A.memptr(), &N, B.memptr(), &N, alphar.memptr(), alphai.memptr(), beta.memptr(), ltmp.memptr(), &ldvl, rtmp.memptr(), &ldvr, work.memptr(), &lwork, &info); - - if(info != 0) { return false; } - - arma_debug_print("reformatting eigenvalues and eigenvectors"); - - eT* vals_mem = vals.memptr(); - const T* alphar_mem = alphar.memptr(); - const T* alphai_mem = alphai.memptr(); - const T* beta_mem = beta.memptr(); - - bool beta_has_zero = false; - - for(uword j=0; j(re, im); - - if( (alphai_val > T(0)) && (j < (A.n_rows-1)) ) - { - ++j; - vals_mem[j] = std::complex(re,-im); // force exact conjugate - } - } - - if(beta_has_zero) { arma_warn(1, "eig_pair(): given matrices appear ill-conditioned"); } - - for(uword j=0; j < A.n_rows; ++j) - { - if( (j < (A.n_rows-1)) && (vals_mem[j] == std::conj(vals_mem[j+1])) ) - { - for(uword i=0; i < A.n_rows; ++i) - { - lvecs.at(i,j) = std::complex( ltmp.at(i,j), ltmp.at(i,j+1) ); - lvecs.at(i,j+1) = std::complex( ltmp.at(i,j), -ltmp.at(i,j+1) ); - rvecs.at(i,j) = std::complex( rtmp.at(i,j), rtmp.at(i,j+1) ); - rvecs.at(i,j+1) = std::complex( rtmp.at(i,j), -rtmp.at(i,j+1) ); - } - ++j; - } - else - { - for(uword i=0; i(ltmp.at(i,j), T(0)); - rvecs.at(i,j) = std::complex(rtmp.at(i,j), T(0)); - } - } - } - - return true; - } - #else - { - arma_ignore(vals); - arma_ignore(lvecs); - arma_ignore(rvecs); - arma_ignore(A_expr); - arma_ignore(B_expr); - arma_stop_logic_error("eig_pair(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! two-sided eigendecomposition of general square matrix pair (complex) -template -inline -bool -auxlib::eig_pair_twosided - ( - Mat< std::complex >& vals, - Mat< std::complex >& lvecs, - Mat< std::complex >& rvecs, - const Base< std::complex, T1 >& A_expr, - const Base< std::complex, T2 >& B_expr - ) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type T; - typedef typename std::complex eT; - - Mat A(A_expr.get_ref()); - Mat B(B_expr.get_ref()); - - arma_conform_check( ((A.is_square() == false) || (B.is_square() == false)), "eig_pair(): given matrices must be square sized" ); - - arma_conform_check( (A.n_rows != B.n_rows), "eig_pair(): given matrices must have the same size" ); - - arma_conform_assert_blas_size(A); - - if(A.is_empty()) { vals.reset(); lvecs.reset(); rvecs.reset(); return true; } - - if(arma_config::check_nonfinite && A.internal_has_nonfinite()) { return false; } - if(arma_config::check_nonfinite && B.internal_has_nonfinite()) { return false; } - - vals.set_size(A.n_rows, 1); - - lvecs.set_size(A.n_rows, A.n_rows); - rvecs.set_size(A.n_rows, A.n_rows); - - char jobvl = 'V'; - char jobvr = 'V'; - blas_int N = blas_int(A.n_rows); - blas_int ldvl = blas_int(lvecs.n_rows); - blas_int ldvr = blas_int(rvecs.n_rows); - blas_int lwork = 64*N; // lwork_min = (std::max)(blas_int(1),2*N) - blas_int info = 0; - - podarray alpha(A.n_rows); - podarray beta(A.n_rows); - - podarray work( static_cast(lwork) ); - podarray rwork( static_cast(8*N) ); - - arma_debug_print("lapack::cx_ggev()"); - lapack::cx_ggev(&jobvl, &jobvr, &N, A.memptr(), &N, B.memptr(), &N, alpha.memptr(), beta.memptr(), lvecs.memptr(), &ldvl, rvecs.memptr(), &ldvr, work.memptr(), &lwork, rwork.memptr(), &info); - - if(info != 0) { return false; } - - eT* vals_mem = vals.memptr(); - const eT* alpha_mem = alpha.memptr(); - const eT* beta_mem = beta.memptr(); - - const std::complex zero(T(0), T(0)); - - bool beta_has_zero = false; - - for(uword i=0; i -inline -bool -auxlib::eig_sym(Col& eigval, Mat& A) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - arma_conform_check( (A.is_square() == false), "eig_sym(): given matrix must be square sized" ); - - if(A.is_empty()) { eigval.reset(); return true; } - - if((arma_config::check_conform) && (auxlib::rudimentary_sym_check(A) == false)) - { - arma_warn(1, "eig_sym(): given matrix is not symmetric"); - } - - if(arma_config::check_nonfinite && trimat_helper::has_nonfinite_triu(A)) { return false; } - - arma_conform_assert_blas_size(A); - - eigval.set_size(A.n_rows); - - char jobz = 'N'; - char uplo = 'U'; - - blas_int N = blas_int(A.n_rows); - blas_int lwork = (64+2)*N; // lwork_min = (std::max)(blas_int(1), 3*N-1) - blas_int info = 0; - - podarray work( static_cast(lwork) ); - - arma_debug_print("lapack::syev()"); - lapack::syev(&jobz, &uplo, &N, A.memptr(), &N, eigval.memptr(), work.memptr(), &lwork, &info); - - return (info == 0); - } - #else - { - arma_ignore(eigval); - arma_ignore(A); - arma_stop_logic_error("eig_sym(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! eigenvalues of a hermitian complex matrix -template -inline -bool -auxlib::eig_sym(Col& eigval, Mat< std::complex >& A) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename std::complex eT; - - arma_conform_check( (A.is_square() == false), "eig_sym(): given matrix must be square sized" ); - - if(A.is_empty()) { eigval.reset(); return true; } - - if((arma_config::check_conform) && (auxlib::rudimentary_sym_check(A) == false)) - { - arma_warn(1, "eig_sym(): given matrix is not hermitian"); - } - - if(arma_config::check_nonfinite && trimat_helper::has_nonfinite_triu(A)) { return false; } - - arma_conform_assert_blas_size(A); - - eigval.set_size(A.n_rows); - - char jobz = 'N'; - char uplo = 'U'; - - blas_int N = blas_int(A.n_rows); - blas_int lwork = (64+1)*N; // lwork_min = (std::max)(blas_int(1), 2*N-1) - blas_int info = 0; - - podarray work( static_cast(lwork) ); - podarray rwork( static_cast( (std::max)(blas_int(1), 3*N) ) ); - - arma_debug_print("lapack::heev()"); - lapack::heev(&jobz, &uplo, &N, A.memptr(), &N, eigval.memptr(), work.memptr(), &lwork, rwork.memptr(), &info); - - return (info == 0); - } - #else - { - arma_ignore(eigval); - arma_ignore(A); - arma_stop_logic_error("eig_sym(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! eigenvalues and eigenvectors of a symmetric real matrix -template -inline -bool -auxlib::eig_sym(Col& eigval, Mat& eigvec, const Mat& X) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - arma_conform_check( (X.is_square() == false), "eig_sym(): given matrix must be square sized" ); - - if(arma_config::check_nonfinite && trimat_helper::has_nonfinite_triu(X)) { return false; } - - eigvec = X; - - if(eigvec.is_empty()) { eigval.reset(); eigvec.reset(); return true; } - - arma_conform_assert_blas_size(eigvec); - - eigval.set_size(eigvec.n_rows); - - char jobz = 'V'; - char uplo = 'U'; - - blas_int N = blas_int(eigvec.n_rows); - blas_int lwork = (64+2)*N; // lwork_min = (std::max)(blas_int(1), 3*N-1) - blas_int info = 0; - - podarray work( static_cast(lwork) ); - - arma_debug_print("lapack::syev()"); - lapack::syev(&jobz, &uplo, &N, eigvec.memptr(), &N, eigval.memptr(), work.memptr(), &lwork, &info); - - return (info == 0); - } - #else - { - arma_ignore(eigval); - arma_ignore(eigvec); - arma_ignore(X); - arma_stop_logic_error("eig_sym(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! eigenvalues and eigenvectors of a hermitian complex matrix -template -inline -bool -auxlib::eig_sym(Col& eigval, Mat< std::complex >& eigvec, const Mat< std::complex >& X) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename std::complex eT; - - arma_conform_check( (X.is_square() == false), "eig_sym(): given matrix must be square sized" ); - - if(arma_config::check_nonfinite && trimat_helper::has_nonfinite_triu(X)) { return false; } - - eigvec = X; - - if(eigvec.is_empty()) { eigval.reset(); eigvec.reset(); return true; } - - arma_conform_assert_blas_size(eigvec); - - eigval.set_size(eigvec.n_rows); - - char jobz = 'V'; - char uplo = 'U'; - - blas_int N = blas_int(eigvec.n_rows); - blas_int lwork = (64+1)*N; // lwork_min = (std::max)(blas_int(1), 2*N-1) - blas_int info = 0; - - podarray work( static_cast(lwork) ); - podarray rwork( static_cast((std::max)(blas_int(1), 3*N)) ); - - arma_debug_print("lapack::heev()"); - lapack::heev(&jobz, &uplo, &N, eigvec.memptr(), &N, eigval.memptr(), work.memptr(), &lwork, rwork.memptr(), &info); - - return (info == 0); - } - #else - { - arma_ignore(eigval); - arma_ignore(eigvec); - arma_ignore(X); - arma_stop_logic_error("eig_sym(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! eigenvalues and eigenvectors of a symmetric real matrix (divide and conquer algorithm) -template -inline -bool -auxlib::eig_sym_dc(Col& eigval, Mat& eigvec, const Mat& X) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - arma_conform_check( (X.is_square() == false), "eig_sym(): given matrix must be square sized" ); - - if(arma_config::check_nonfinite && trimat_helper::has_nonfinite_triu(X)) { return false; } - - eigvec = X; - - if(eigvec.is_empty()) { eigval.reset(); eigvec.reset(); return true; } - - arma_conform_assert_blas_size(eigvec); - - eigval.set_size(eigvec.n_rows); - - char jobz = 'V'; - char uplo = 'U'; - - blas_int N = blas_int(eigvec.n_rows); - blas_int lwork_min = 1 + 6*N + 2*(N*N); - blas_int liwork_min = 3 + 5*N; - blas_int info = 0; - - blas_int lwork_proposed = 0; - blas_int liwork_proposed = 0; - - if(N >= 32) - { - eT work_query[2] = {}; - blas_int iwork_query[2] = {}; - - blas_int lwork_query = -1; - blas_int liwork_query = -1; - - arma_debug_print("lapack::syevd()"); - lapack::syevd(&jobz, &uplo, &N, eigvec.memptr(), &N, eigval.memptr(), &work_query[0], &lwork_query, &iwork_query[0], &liwork_query, &info); - - if(info != 0) { return false; } - - lwork_proposed = static_cast( work_query[0] ); - liwork_proposed = iwork_query[0]; - } - - blas_int lwork_final = (std::max)( lwork_proposed, lwork_min); - blas_int liwork_final = (std::max)(liwork_proposed, liwork_min); - - podarray work( static_cast( lwork_final) ); - podarray iwork( static_cast(liwork_final) ); - - arma_debug_print("lapack::syevd()"); - lapack::syevd(&jobz, &uplo, &N, eigvec.memptr(), &N, eigval.memptr(), work.memptr(), &lwork_final, iwork.memptr(), &liwork_final, &info); - - return (info == 0); - } - #else - { - arma_ignore(eigval); - arma_ignore(eigvec); - arma_ignore(X); - arma_stop_logic_error("eig_sym(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! eigenvalues and eigenvectors of a hermitian complex matrix (divide and conquer algorithm) -template -inline -bool -auxlib::eig_sym_dc(Col& eigval, Mat< std::complex >& eigvec, const Mat< std::complex >& X) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename std::complex eT; - - arma_conform_check( (X.is_square() == false), "eig_sym(): given matrix must be square sized" ); - - if(arma_config::check_nonfinite && trimat_helper::has_nonfinite_triu(X)) { return false; } - - eigvec = X; - - if(eigvec.is_empty()) { eigval.reset(); eigvec.reset(); return true; } - - arma_conform_assert_blas_size(eigvec); - - eigval.set_size(eigvec.n_rows); - - char jobz = 'V'; - char uplo = 'U'; - - blas_int N = blas_int(eigvec.n_rows); - blas_int lwork_min = 2*N + N*N; - blas_int lrwork_min = 1 + 5*N + 2*(N*N); - blas_int liwork_min = 3 + 5*N; - blas_int info = 0; - - blas_int lwork_proposed = 0; - blas_int lrwork_proposed = 0; - blas_int liwork_proposed = 0; - - if(N >= 32) - { - eT work_query[2] = {}; - T rwork_query[2] = {}; - blas_int iwork_query[2] = {}; - - blas_int lwork_query = -1; - blas_int lrwork_query = -1; - blas_int liwork_query = -1; - - arma_debug_print("lapack::heevd()"); - lapack::heevd(&jobz, &uplo, &N, eigvec.memptr(), &N, eigval.memptr(), &work_query[0], &lwork_query, &rwork_query[0], &lrwork_query, &iwork_query[0], &liwork_query, &info); - - if(info != 0) { return false; } - - lwork_proposed = static_cast( access::tmp_real(work_query[0]) ); - lrwork_proposed = static_cast( rwork_query[0] ); - liwork_proposed = iwork_query[0]; - } - - blas_int lwork_final = (std::max)( lwork_proposed, lwork_min); - blas_int lrwork_final = (std::max)(lrwork_proposed, lrwork_min); - blas_int liwork_final = (std::max)(liwork_proposed, liwork_min); - - podarray work( static_cast( lwork_final) ); - podarray< T> rwork( static_cast(lrwork_final) ); - podarray iwork( static_cast(liwork_final) ); - - arma_debug_print("lapack::heevd()"); - lapack::heevd(&jobz, &uplo, &N, eigvec.memptr(), &N, eigval.memptr(), work.memptr(), &lwork_final, rwork.memptr(), &lrwork_final, iwork.memptr(), &liwork_final, &info); - - return (info == 0); - } - #else - { - arma_ignore(eigval); - arma_ignore(eigvec); - arma_ignore(X); - arma_stop_logic_error("eig_sym(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::chol_simple(Mat& X) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - arma_conform_assert_blas_size(X); - - char uplo = 'U'; - blas_int n = blas_int(X.n_rows); - blas_int info = 0; - - arma_debug_print("lapack::potrf()"); - lapack::potrf(&uplo, &n, X.memptr(), &n, &info); - - return (info == 0); - } - #else - { - arma_ignore(X); - - arma_stop_logic_error("chol(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::chol(Mat& X, const uword layout) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - arma_conform_assert_blas_size(X); - - char uplo = (layout == 0) ? 'U' : 'L'; - blas_int n = blas_int(X.n_rows); - blas_int info = 0; - - arma_debug_print("lapack::potrf()"); - lapack::potrf(&uplo, &n, X.memptr(), &n, &info); - - if(info != 0) { return false; } - - X = (layout == 0) ? trimatu(X) : trimatl(X); // trimatu() and trimatl() return the same type - - return true; - } - #else - { - arma_ignore(X); - arma_ignore(layout); - - arma_stop_logic_error("chol(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::chol_band(Mat& X, const uword KD, const uword layout) - { - arma_debug_sigprint(); - - return auxlib::chol_band_common(X, KD, layout); - } - - - -template -inline -bool -auxlib::chol_band(Mat< std::complex >& X, const uword KD, const uword layout) - { - arma_debug_sigprint(); - - #if defined(ARMA_CRIPPLED_LAPACK) - { - arma_debug_print("auxlib::chol_band(): redirecting to auxlib::chol() due to crippled LAPACK"); - - arma_ignore(KD); - - return auxlib::chol(X, layout); - } - #else - { - return auxlib::chol_band_common(X, KD, layout); - } - #endif - } - - - -template -inline -bool -auxlib::chol_band_common(Mat& X, const uword KD, const uword layout) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - const uword N = X.n_rows; - - const uword KL = (layout == 0) ? uword(0) : KD; - const uword KU = (layout == 0) ? KD : uword(0); - - Mat AB; - band_helper::compress(AB, X, KL, KU, false); - - arma_conform_assert_blas_size(AB); - - char uplo = (layout == 0) ? 'U' : 'L'; - blas_int n = blas_int(N); - blas_int kd = blas_int(KD); - blas_int ldab = blas_int(AB.n_rows); - blas_int info = 0; - - arma_debug_print("lapack::pbtrf()"); - lapack::pbtrf(&uplo, &n, &kd, AB.memptr(), &ldab, &info); - - if(info != 0) { return false; } - - band_helper::uncompress(X, AB, KL, KU, false); - - return true; - } - #else - { - arma_ignore(X); - arma_ignore(KD); - arma_ignore(layout); - - arma_stop_logic_error("chol(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::chol_pivot(Mat& X, Mat& P, const uword layout) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename get_pod_type::result T; - - arma_conform_assert_blas_size(X); - - char uplo = (layout == 0) ? 'U' : 'L'; - blas_int n = blas_int(X.n_rows); - blas_int rank = 0; - T tol = T(-1); - blas_int info = 0; - - podarray ipiv( X.n_rows); - podarray work(2*X.n_rows); - - ipiv.zeros(); - - arma_debug_print("lapack::pstrf()"); - lapack::pstrf(&uplo, &n, X.memptr(), &n, ipiv.memptr(), &rank, &tol, work.memptr(), &info); - - if(info != 0) { return false; } - - X = (layout == 0) ? trimatu(X) : trimatl(X); // trimatu() and trimatl() return the same type - - P.set_size(X.n_rows, 1); - - for(uword i=0; i < X.n_rows; ++i) - { - P[i] = uword(ipiv[i] - 1); // take into account that Fortran counts from 1 - } - - return true; - } - #else - { - arma_ignore(X); - arma_ignore(P); - arma_ignore(layout); - - arma_stop_logic_error("chol(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -// -// hessenberg decomposition -template -inline -bool -auxlib::hess(Mat& H, const Base& X, Col& tao) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - H = X.get_ref(); - - arma_conform_check( (H.is_square() == false), "hess(): given matrix must be square sized" ); - - if(H.is_empty()) { return true; } - - arma_conform_assert_blas_size(H); - - if(H.n_rows > 2) - { - tao.set_size(H.n_rows-1); - - blas_int n = blas_int(H.n_rows); - blas_int ilo = 1; - blas_int ihi = blas_int(H.n_rows); - blas_int lda = blas_int(H.n_rows); - blas_int lwork = blas_int(H.n_rows) * 64; - blas_int info = 0; - - podarray work(static_cast(lwork)); - - arma_debug_print("lapack::gehrd()"); - lapack::gehrd(&n, &ilo, &ihi, H.memptr(), &lda, tao.memptr(), work.memptr(), &lwork, &info); - - return (info == 0); - } - - return true; - } - #else - { - arma_ignore(H); - arma_ignore(X); - arma_ignore(tao); - arma_stop_logic_error("hess(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::qr(Mat& Q, Mat& R, const Base& X) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - R = X.get_ref(); - - const uword R_n_rows = R.n_rows; - const uword R_n_cols = R.n_cols; - - if(R.is_empty()) { Q.eye(R_n_rows, R_n_rows); return true; } - - arma_conform_assert_blas_size(R); - - blas_int m = static_cast(R_n_rows); - blas_int n = static_cast(R_n_cols); - blas_int lwork_min = (std::max)(blas_int(1), (std::max)(m,n)); // take into account requirements of geqrf() _and_ orgqr()/ungqr() - blas_int k = (std::min)(m,n); - blas_int info = 0; - - podarray tau( static_cast(k) ); - - eT work_query[2] = {}; - blas_int lwork_query = -1; - - arma_debug_print("lapack::geqrf()"); - lapack::geqrf(&m, &n, R.memptr(), &m, tau.memptr(), &work_query[0], &lwork_query, &info); - - if(info != 0) { return false; } - - blas_int lwork_proposed = static_cast( access::tmp_real(work_query[0]) ); - blas_int lwork_final = (std::max)(lwork_proposed, lwork_min); - - podarray work( static_cast(lwork_final) ); - - arma_debug_print("lapack::geqrf()"); - lapack::geqrf(&m, &n, R.memptr(), &m, tau.memptr(), work.memptr(), &lwork_final, &info); - - if(info != 0) { return false; } - - Q.set_size(R_n_rows, R_n_rows); - - arrayops::copy( Q.memptr(), R.memptr(), (std::min)(Q.n_elem, R.n_elem) ); - - // - // construct R - - for(uword col=0; col < R_n_cols; ++col) - { - for(uword row=(col+1); row < R_n_rows; ++row) - { - R.at(row,col) = eT(0); - } - } - - - if( (is_float::value) || (is_double::value) ) - { - arma_debug_print("lapack::orgqr()"); - lapack::orgqr(&m, &m, &k, Q.memptr(), &m, tau.memptr(), work.memptr(), &lwork_final, &info); - } - else - if( (is_cx_float::value) || (is_cx_double::value) ) - { - arma_debug_print("lapack::ungqr()"); - lapack::ungqr(&m, &m, &k, Q.memptr(), &m, tau.memptr(), work.memptr(), &lwork_final, &info); - } - - return (info == 0); - } - #else - { - arma_ignore(Q); - arma_ignore(R); - arma_ignore(X); - arma_stop_logic_error("qr(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::qr_econ(Mat& Q, Mat& R, const Base& X) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - if(is_Mat::value) - { - const unwrap tmp(X.get_ref()); - const Mat& M = tmp.M; - - if(M.n_rows < M.n_cols) { return auxlib::qr(Q, R, X); } - } - - Q = X.get_ref(); - - const uword Q_n_rows = Q.n_rows; - const uword Q_n_cols = Q.n_cols; - - if( Q_n_rows <= Q_n_cols ) { return auxlib::qr(Q, R, Q); } - - if(Q.is_empty()) { Q.set_size(Q_n_rows, 0); R.set_size(0, Q_n_cols); return true; } - - arma_conform_assert_blas_size(Q); - - blas_int m = static_cast(Q_n_rows); - blas_int n = static_cast(Q_n_cols); - blas_int lwork_min = (std::max)(blas_int(1), (std::max)(m,n)); // take into account requirements of geqrf() _and_ orgqr()/ungqr() - blas_int k = (std::min)(m,n); - blas_int info = 0; - - podarray tau( static_cast(k) ); - - eT work_query[2] = {}; - blas_int lwork_query = -1; - - arma_debug_print("lapack::geqrf()"); - lapack::geqrf(&m, &n, Q.memptr(), &m, tau.memptr(), &work_query[0], &lwork_query, &info); - - if(info != 0) { return false; } - - blas_int lwork_proposed = static_cast( access::tmp_real(work_query[0]) ); - blas_int lwork_final = (std::max)(lwork_proposed, lwork_min); - - podarray work( static_cast(lwork_final) ); - - arma_debug_print("lapack::geqrf()"); - lapack::geqrf(&m, &n, Q.memptr(), &m, tau.memptr(), work.memptr(), &lwork_final, &info); - - if(info != 0) { return false; } - - R.zeros(Q_n_cols, Q_n_cols); - - // - // construct R - - for(uword col=0; col < Q_n_cols; ++col) - { - for(uword row=0; row <= col; ++row) - { - R.at(row,col) = Q.at(row,col); - } - } - - if( (is_float::value) || (is_double::value) ) - { - arma_debug_print("lapack::orgqr()"); - lapack::orgqr(&m, &n, &k, Q.memptr(), &m, tau.memptr(), work.memptr(), &lwork_final, &info); - } - else - if( (is_cx_float::value) || (is_cx_double::value) ) - { - arma_debug_print("lapack::ungqr()"); - lapack::ungqr(&m, &n, &k, Q.memptr(), &m, tau.memptr(), work.memptr(), &lwork_final, &info); - } - - return (info == 0); - } - #else - { - arma_ignore(Q); - arma_ignore(R); - arma_ignore(X); - arma_stop_logic_error("qr_econ(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::qr_pivot(Mat& Q, Mat& R, Mat& P, const Base& X) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - R = X.get_ref(); - - const uword R_n_rows = R.n_rows; - const uword R_n_cols = R.n_cols; - - if(R.is_empty()) - { - Q.eye(R_n_rows, R_n_rows); - - P.set_size(R_n_cols, 1); - - for(uword col=0; col < R_n_cols; ++col) { P.at(col) = col; } - - return true; - } - - arma_conform_assert_blas_size(R); - - blas_int m = static_cast(R_n_rows); - blas_int n = static_cast(R_n_cols); - blas_int lwork_min = (std::max)(blas_int(3*n + 1), (std::max)(m,n)); // take into account requirements of geqp3() and orgqr() - blas_int k = (std::min)(m,n); - blas_int info = 0; - - podarray tau( static_cast(k) ); - podarray jpvt( R_n_cols ); - - jpvt.zeros(); - - eT work_query[2] = {}; - blas_int lwork_query = -1; - - arma_debug_print("lapack::geqp3()"); - lapack::geqp3(&m, &n, R.memptr(), &m, jpvt.memptr(), tau.memptr(), &work_query[0], &lwork_query, &info); - - if(info != 0) { return false; } - - blas_int lwork_proposed = static_cast( access::tmp_real(work_query[0]) ); - blas_int lwork_final = (std::max)(lwork_proposed, lwork_min); - - podarray work( static_cast(lwork_final) ); - - arma_debug_print("lapack::geqp3()"); - lapack::geqp3(&m, &n, R.memptr(), &m, jpvt.memptr(), tau.memptr(), work.memptr(), &lwork_final, &info); - - if(info != 0) { return false; } - - Q.set_size(R_n_rows, R_n_rows); - - arrayops::copy( Q.memptr(), R.memptr(), (std::min)(Q.n_elem, R.n_elem) ); - - // - // construct R and P - - P.set_size(R_n_cols, 1); - - for(uword col=0; col < R_n_cols; ++col) - { - for(uword row=(col+1); row < R_n_rows; ++row) { R.at(row,col) = eT(0); } - - P.at(col) = jpvt[col] - 1; // take into account that Fortran counts from 1 - } - - arma_debug_print("lapack::orgqr()"); - lapack::orgqr(&m, &m, &k, Q.memptr(), &m, tau.memptr(), work.memptr(), &lwork_final, &info); - - return (info == 0); - } - #else - { - arma_ignore(Q); - arma_ignore(R); - arma_ignore(P); - arma_ignore(X); - arma_stop_logic_error("qr(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::qr_pivot(Mat< std::complex >& Q, Mat< std::complex >& R, Mat& P, const Base,T1>& X) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename std::complex eT; - - R = X.get_ref(); - - const uword R_n_rows = R.n_rows; - const uword R_n_cols = R.n_cols; - - if(R.is_empty()) - { - Q.eye(R_n_rows, R_n_rows); - - P.set_size(R_n_cols, 1); - - for(uword col=0; col < R_n_cols; ++col) { P.at(col) = col; } - - return true; - } - - arma_conform_assert_blas_size(R); - - blas_int m = static_cast(R_n_rows); - blas_int n = static_cast(R_n_cols); - blas_int lwork_min = (std::max)(blas_int(3*n + 1), (std::max)(m,n)); // take into account requirements of geqp3() and ungqr() - blas_int k = (std::min)(m,n); - blas_int info = 0; - - podarray tau( static_cast(k) ); - podarray< T> rwork( 2*R_n_cols ); - podarray jpvt( R_n_cols ); - - jpvt.zeros(); - - eT work_query[2] = {}; - blas_int lwork_query = -1; - - arma_debug_print("lapack::geqp3()"); - lapack::cx_geqp3(&m, &n, R.memptr(), &m, jpvt.memptr(), tau.memptr(), &work_query[0], &lwork_query, rwork.memptr(), &info); - - if(info != 0) { return false; } - - blas_int lwork_proposed = static_cast( access::tmp_real(work_query[0]) ); - blas_int lwork_final = (std::max)(lwork_proposed, lwork_min); - - podarray work( static_cast(lwork_final) ); - - arma_debug_print("lapack::geqp3()"); - lapack::cx_geqp3(&m, &n, R.memptr(), &m, jpvt.memptr(), tau.memptr(), work.memptr(), &lwork_final, rwork.memptr(), &info); - - if(info != 0) { return false; } - - Q.set_size(R_n_rows, R_n_rows); - - arrayops::copy( Q.memptr(), R.memptr(), (std::min)(Q.n_elem, R.n_elem) ); - - // - // construct R and P - - P.set_size(R_n_cols, 1); - - for(uword col=0; col < R_n_cols; ++col) - { - for(uword row=(col+1); row < R_n_rows; ++row) { R.at(row,col) = eT(0); } - - P.at(col) = jpvt[col] - 1; // take into account that Fortran counts from 1 - } - - arma_debug_print("lapack::ungqr()"); - lapack::ungqr(&m, &m, &k, Q.memptr(), &m, tau.memptr(), work.memptr(), &lwork_final, &info); - - return (info == 0); - } - #else - { - arma_ignore(Q); - arma_ignore(R); - arma_ignore(P); - arma_ignore(X); - arma_stop_logic_error("qr(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::svd(Col& S, Mat& A) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - if(A.is_empty()) { S.reset(); return true; } - - if(arma_config::check_nonfinite && A.internal_has_nonfinite()) { return false; } - - arma_conform_assert_blas_size(A); - - Mat U(1, 1, arma_nozeros_indicator()); - Mat V(1, A.n_cols, arma_nozeros_indicator()); - - char jobu = 'N'; - char jobvt = 'N'; - - blas_int m = blas_int(A.n_rows); - blas_int n = blas_int(A.n_cols); - blas_int min_mn = (std::min)(m,n); - blas_int lda = blas_int(A.n_rows); - blas_int ldu = blas_int(U.n_rows); - blas_int ldvt = blas_int(V.n_rows); - blas_int lwork_min = (std::max)( blas_int(1), (std::max)( (3*min_mn + (std::max)(m,n)), 5*min_mn ) ); - blas_int info = 0; - - S.set_size( static_cast(min_mn) ); - - blas_int lwork_proposed = 0; - - if(A.n_elem >= 1024) - { - eT work_query[2] = {}; - blas_int lwork_query = -1; - - arma_debug_print("lapack::gesvd()"); - lapack::gesvd(&jobu, &jobvt, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, &work_query[0], &lwork_query, &info); - - if(info != 0) { return false; } - - lwork_proposed = static_cast( work_query[0] ); - } - - blas_int lwork_final = (std::max)(lwork_proposed, lwork_min); - - podarray work( static_cast(lwork_final) ); - - arma_debug_print("lapack::gesvd()"); - lapack::gesvd(&jobu, &jobvt, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, work.memptr(), &lwork_final, &info); - - return (info == 0); - } - #else - { - arma_ignore(S); - arma_ignore(A); - arma_stop_logic_error("svd(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::svd(Col& S, Mat< std::complex >& A) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef std::complex eT; - - if(A.is_empty()) { S.reset(); return true; } - - if(arma_config::check_nonfinite && A.internal_has_nonfinite()) { return false; } - - arma_conform_assert_blas_size(A); - - Mat U(1, 1, arma_nozeros_indicator()); - Mat V(1, A.n_cols, arma_nozeros_indicator()); - - char jobu = 'N'; - char jobvt = 'N'; - - blas_int m = blas_int(A.n_rows); - blas_int n = blas_int(A.n_cols); - blas_int min_mn = (std::min)(m,n); - blas_int lda = blas_int(A.n_rows); - blas_int ldu = blas_int(U.n_rows); - blas_int ldvt = blas_int(V.n_rows); - blas_int lwork_min = (std::max)( blas_int(1), 2*min_mn+(std::max)(m,n) ); - blas_int info = 0; - - S.set_size( static_cast(min_mn) ); - - podarray rwork( static_cast(5*min_mn) ); - - blas_int lwork_proposed = 0; - - if(A.n_elem >= 256) - { - eT work_query[2] = {}; - blas_int lwork_query = -1; // query to find optimum size of workspace - - arma_debug_print("lapack::cx_gesvd()"); - lapack::cx_gesvd(&jobu, &jobvt, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, &work_query[0], &lwork_query, rwork.memptr(), &info); - - if(info != 0) { return false; } - - lwork_proposed = static_cast( access::tmp_real(work_query[0]) ); - } - - blas_int lwork_final = (std::max)(lwork_proposed, lwork_min); - - podarray work( static_cast(lwork_final) ); - - arma_debug_print("lapack::cx_gesvd()"); - lapack::cx_gesvd(&jobu, &jobvt, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, work.memptr(), &lwork_final, rwork.memptr(), &info); - - return (info == 0); - } - #else - { - arma_ignore(S); - arma_ignore(A); - arma_stop_logic_error("svd(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::svd(Mat& U, Col& S, Mat& V, Mat& A) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - if(A.is_empty()) { U.eye(A.n_rows, A.n_rows); S.reset(); V.eye(A.n_cols, A.n_cols); return true; } - - if(arma_config::check_nonfinite && A.internal_has_nonfinite()) { return false; } - - arma_conform_assert_blas_size(A); - - U.set_size(A.n_rows, A.n_rows); - V.set_size(A.n_cols, A.n_cols); - - char jobu = 'A'; - char jobvt = 'A'; - - blas_int m = blas_int(A.n_rows); - blas_int n = blas_int(A.n_cols); - blas_int min_mn = (std::min)(m,n); - blas_int lda = blas_int(A.n_rows); - blas_int ldu = blas_int(U.n_rows); - blas_int ldvt = blas_int(V.n_rows); - blas_int lwork_min = (std::max)( blas_int(1), (std::max)( (3*min_mn + (std::max)(m,n)), 5*min_mn ) ); - blas_int info = 0; - - S.set_size( static_cast(min_mn) ); - - blas_int lwork_proposed = 0; - - if(A.n_elem >= 1024) - { - // query to find optimum size of workspace - eT work_query[2] = {}; - blas_int lwork_query = -1; - - arma_debug_print("lapack::gesvd()"); - lapack::gesvd(&jobu, &jobvt, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, &work_query[0], &lwork_query, &info); - - if(info != 0) { return false; } - - lwork_proposed = static_cast( work_query[0] ); - } - - blas_int lwork_final = (std::max)(lwork_proposed, lwork_min); - - podarray work( static_cast(lwork_final) ); - - arma_debug_print("lapack::gesvd()"); - lapack::gesvd(&jobu, &jobvt, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, work.memptr(), &lwork_final, &info); - - if(info != 0) { return false; } - - op_strans::apply_mat_inplace(V); - - return true; - } - #else - { - arma_ignore(U); - arma_ignore(S); - arma_ignore(V); - arma_ignore(A); - arma_stop_logic_error("svd(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::svd(Mat< std::complex >& U, Col& S, Mat< std::complex >& V, Mat< std::complex >& A) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef std::complex eT; - - if(A.is_empty()) { U.eye(A.n_rows, A.n_rows); S.reset(); V.eye(A.n_cols, A.n_cols); return true; } - - if(arma_config::check_nonfinite && A.internal_has_nonfinite()) { return false; } - - arma_conform_assert_blas_size(A); - - U.set_size(A.n_rows, A.n_rows); - V.set_size(A.n_cols, A.n_cols); - - char jobu = 'A'; - char jobvt = 'A'; - - blas_int m = blas_int(A.n_rows); - blas_int n = blas_int(A.n_cols); - blas_int min_mn = (std::min)(m,n); - blas_int lda = blas_int(A.n_rows); - blas_int ldu = blas_int(U.n_rows); - blas_int ldvt = blas_int(V.n_rows); - blas_int lwork_min = (std::max)( blas_int(1), 2*min_mn + (std::max)(m,n) ); - blas_int info = 0; - - S.set_size( static_cast(min_mn) ); - - podarray rwork( static_cast(5*min_mn) ); - - blas_int lwork_proposed = 0; - - if(A.n_elem >= 256) - { - eT work_query[2] = {}; - blas_int lwork_query = -1; // query to find optimum size of workspace - - arma_debug_print("lapack::cx_gesvd()"); - lapack::cx_gesvd(&jobu, &jobvt, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, &work_query[0], &lwork_query, rwork.memptr(), &info); - - if(info != 0) { return false; } - - lwork_proposed = static_cast( access::tmp_real(work_query[0]) ); - } - - blas_int lwork_final = (std::max)(lwork_proposed, lwork_min); - - podarray work( static_cast(lwork_final) ); - - arma_debug_print("lapack::cx_gesvd()"); - lapack::cx_gesvd(&jobu, &jobvt, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, work.memptr(), &lwork_final, rwork.memptr(), &info); - - if(info != 0) { return false; } - - op_htrans::apply_mat_inplace(V); - - return true; - } - #else - { - arma_ignore(U); - arma_ignore(S); - arma_ignore(V); - arma_ignore(A); - arma_stop_logic_error("svd(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::svd_econ(Mat& U, Col& S, Mat& V, Mat& A, const char mode) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - if(A.is_empty()) { U.eye(); S.reset(); V.eye(); return true; } - - if(arma_config::check_nonfinite && A.internal_has_nonfinite()) { return false; } - - arma_conform_assert_blas_size(A); - - blas_int m = blas_int(A.n_rows); - blas_int n = blas_int(A.n_cols); - blas_int min_mn = (std::min)(m,n); - blas_int lda = blas_int(A.n_rows); - - S.set_size( static_cast(min_mn) ); - - blas_int ldu = 0; - blas_int ldvt = 0; - - char jobu = char(0); - char jobvt = char(0); - - if(mode == 'l') - { - jobu = 'S'; - jobvt = 'N'; - - ldu = m; - ldvt = 1; - - U.set_size( static_cast(ldu), static_cast(min_mn) ); - V.reset(); - } - - if(mode == 'r') - { - jobu = 'N'; - jobvt = 'S'; - - ldu = 1; - ldvt = (std::min)(m,n); - - U.reset(); - V.set_size( static_cast(ldvt), static_cast(n) ); - } - - if(mode == 'b') - { - jobu = 'S'; - jobvt = 'S'; - - ldu = m; - ldvt = (std::min)(m,n); - - U.set_size( static_cast(ldu), static_cast(min_mn) ); - V.set_size( static_cast(ldvt), static_cast(n ) ); - } - - - blas_int lwork_min = (std::max)( blas_int(1), (std::max)( (3*min_mn + (std::max)(m,n)), 5*min_mn ) ); - blas_int info = 0; - - blas_int lwork_proposed = 0; - - if(A.n_elem >= 1024) - { - eT work_query[2] = {}; - blas_int lwork_query = -1; // query to find optimum size of workspace - - arma_debug_print("lapack::gesvd()"); - lapack::gesvd(&jobu, &jobvt, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, &work_query[0], &lwork_query, &info); - - if(info != 0) { return false; } - - lwork_proposed = static_cast(work_query[0]); - } - - blas_int lwork_final = (std::max)(lwork_proposed, lwork_min); - - podarray work( static_cast(lwork_final) ); - - arma_debug_print("lapack::gesvd()"); - lapack::gesvd(&jobu, &jobvt, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, work.memptr(), &lwork_final, &info); - - if(info != 0) { return false; } - - op_strans::apply_mat_inplace(V); - - return true; - } - #else - { - arma_ignore(U); - arma_ignore(S); - arma_ignore(V); - arma_ignore(A); - arma_ignore(mode); - arma_stop_logic_error("svd(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::svd_econ(Mat< std::complex >& U, Col& S, Mat< std::complex >& V, Mat< std::complex >& A, const char mode) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef std::complex eT; - - if(A.is_empty()) { U.eye(); S.reset(); V.eye(); return true; } - - if(arma_config::check_nonfinite && A.internal_has_nonfinite()) { return false; } - - arma_conform_assert_blas_size(A); - - blas_int m = blas_int(A.n_rows); - blas_int n = blas_int(A.n_cols); - blas_int min_mn = (std::min)(m,n); - blas_int lda = blas_int(A.n_rows); - - S.set_size( static_cast(min_mn) ); - - blas_int ldu = 0; - blas_int ldvt = 0; - - char jobu = char(0); - char jobvt = char(0); - - if(mode == 'l') - { - jobu = 'S'; - jobvt = 'N'; - - ldu = m; - ldvt = 1; - - U.set_size( static_cast(ldu), static_cast(min_mn) ); - V.reset(); - } - - if(mode == 'r') - { - jobu = 'N'; - jobvt = 'S'; - - ldu = 1; - ldvt = (std::min)(m,n); - - U.reset(); - V.set_size( static_cast(ldvt), static_cast(n) ); - } - - if(mode == 'b') - { - jobu = 'S'; - jobvt = 'S'; - - ldu = m; - ldvt = (std::min)(m,n); - - U.set_size( static_cast(ldu), static_cast(min_mn) ); - V.set_size( static_cast(ldvt), static_cast(n) ); - } - - blas_int lwork_min = (std::max)( blas_int(1), (std::max)( (3*min_mn + (std::max)(m,n)), 5*min_mn ) ); - blas_int info = 0; - - podarray rwork( static_cast(5*min_mn) ); - - blas_int lwork_proposed = 0; - - if(A.n_elem >= 256) - { - eT work_query[2] = {}; - blas_int lwork_query = -1; // query to find optimum size of workspace - - arma_debug_print("lapack::cx_gesvd()"); - lapack::cx_gesvd(&jobu, &jobvt, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, &work_query[0], &lwork_query, rwork.memptr(), &info); - - if(info != 0) { return false; } - - lwork_proposed = static_cast( access::tmp_real(work_query[0]) ); - } - - blas_int lwork_final = (std::max)(lwork_proposed, lwork_min); - - podarray work( static_cast(lwork_final) ); - - arma_debug_print("lapack::cx_gesvd()"); - lapack::cx_gesvd(&jobu, &jobvt, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, work.memptr(), &lwork_final, rwork.memptr(), &info); - - if(info != 0) { return false; } - - op_htrans::apply_mat_inplace(V); - - return true; - } - #else - { - arma_ignore(U); - arma_ignore(S); - arma_ignore(V); - arma_ignore(A); - arma_ignore(mode); - arma_stop_logic_error("svd(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::svd_dc(Col& S, Mat& A) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - if(A.is_empty()) { S.reset(); return true; } - - if(arma_config::check_nonfinite && A.internal_has_nonfinite()) { return false; } - - arma_conform_assert_blas_size(A); - - Mat U(1, 1, arma_nozeros_indicator()); - Mat V(1, 1, arma_nozeros_indicator()); - - char jobz = 'N'; - - blas_int m = blas_int(A.n_rows); - blas_int n = blas_int(A.n_cols); - blas_int min_mn = (std::min)(m,n); - blas_int max_mn = (std::max)(m,n); - blas_int lda = blas_int(A.n_rows); - blas_int ldu = blas_int(U.n_rows); - blas_int ldvt = blas_int(V.n_rows); - blas_int lwork_min = 3*min_mn + (std::max)( max_mn, 7*min_mn ); - blas_int info = 0; - - S.set_size( static_cast(min_mn) ); - - podarray iwork( static_cast(8*min_mn) ); - - blas_int lwork_proposed = 0; - - if(A.n_elem >= 1024) - { - eT work_query[2] = {}; - blas_int lwork_query = blas_int(-1); - - arma_debug_print("lapack::gesdd()"); - lapack::gesdd(&jobz, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, &work_query[0], &lwork_query, iwork.memptr(), &info); - - if(info != 0) { return false; } - - lwork_proposed = static_cast( work_query[0] ); - } - - blas_int lwork_final = (std::max)(lwork_proposed, lwork_min); - - podarray work( static_cast(lwork_final) ); - - arma_debug_print("lapack::gesdd()"); - lapack::gesdd(&jobz, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, work.memptr(), &lwork_final, iwork.memptr(), &info); - - return (info == 0); - } - #else - { - arma_ignore(S); - arma_ignore(A); - arma_stop_logic_error("svd(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::svd_dc(Col& S, Mat< std::complex >& A) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef std::complex eT; - - if(A.is_empty()) { S.reset(); return true; } - - if(arma_config::check_nonfinite && A.internal_has_nonfinite()) { return false; } - - arma_conform_assert_blas_size(A); - - Mat U(1, 1, arma_nozeros_indicator()); - Mat V(1, 1, arma_nozeros_indicator()); - - char jobz = 'N'; - - blas_int m = blas_int(A.n_rows); - blas_int n = blas_int(A.n_cols); - blas_int min_mn = (std::min)(m,n); - blas_int max_mn = (std::max)(m,n); - blas_int lda = blas_int(A.n_rows); - blas_int ldu = blas_int(U.n_rows); - blas_int ldvt = blas_int(V.n_rows); - blas_int lwork_min = 2*min_mn + max_mn; - blas_int info = 0; - - S.set_size( static_cast(min_mn) ); - - podarray rwork( static_cast(7*min_mn) ); // from LAPACK 3.8 docs: LAPACK <= v3.6 needs 7*mn - podarray iwork( static_cast(8*min_mn) ); - - blas_int lwork_proposed = 0; - - if(A.n_elem >= 256) - { - eT work_query[2] = {}; - blas_int lwork_query = blas_int(-1); - - arma_debug_print("lapack::cx_gesdd()"); - lapack::cx_gesdd(&jobz, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, &work_query[0], &lwork_query, rwork.memptr(), iwork.memptr(), &info); - - if(info != 0) { return false; } - - lwork_proposed = static_cast( access::tmp_real(work_query[0]) ); - } - - blas_int lwork_final = (std::max)(lwork_proposed, lwork_min); - - podarray work( static_cast(lwork_final) ); - - arma_debug_print("lapack::cx_gesdd()"); - lapack::cx_gesdd(&jobz, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, work.memptr(), &lwork_final, rwork.memptr(), iwork.memptr(), &info); - - return (info == 0); - } - #else - { - arma_ignore(S); - arma_ignore(A); - arma_stop_logic_error("svd(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::svd_dc(Mat& U, Col& S, Mat& V, Mat& A) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - if(A.is_empty()) { U.eye(A.n_rows, A.n_rows); S.reset(); V.eye(A.n_cols, A.n_cols); return true; } - - if(arma_config::check_nonfinite && A.internal_has_nonfinite()) { return false; } - - arma_conform_assert_blas_size(A); - - U.set_size(A.n_rows, A.n_rows); - V.set_size(A.n_cols, A.n_cols); - - char jobz = 'A'; - - blas_int m = blas_int(A.n_rows); - blas_int n = blas_int(A.n_cols); - blas_int min_mn = (std::min)(m,n); - blas_int max_mn = (std::max)(m,n); - blas_int lda = blas_int(A.n_rows); - blas_int ldu = blas_int(U.n_rows); - blas_int ldvt = blas_int(V.n_rows); - blas_int lwork1 = 3*min_mn*min_mn + (std::max)(max_mn, 4*min_mn*min_mn + 4*min_mn); // as per LAPACK 3.2 docs - blas_int lwork2 = 4*min_mn*min_mn + 6*min_mn + max_mn; // as per LAPACK 3.8 docs; consistent with LAPACK 3.4 docs - blas_int lwork_min = (std::max)(lwork1, lwork2); // due to differences between LAPACK 3.2 and 3.8 - blas_int info = 0; - - S.set_size( static_cast(min_mn) ); - - podarray iwork( static_cast(8*min_mn) ); - - blas_int lwork_proposed = 0; - - if(A.n_elem >= 1024) - { - eT work_query[2] = {}; - blas_int lwork_query = blas_int(-1); - - arma_debug_print("lapack::gesdd()"); - lapack::gesdd(&jobz, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, &work_query[0], &lwork_query, iwork.memptr(), &info); - - if(info != 0) { return false; } - - lwork_proposed = static_cast(work_query[0]); - } - - blas_int lwork_final = (std::max)(lwork_proposed, lwork_min); - - podarray work( static_cast(lwork_final) ); - - arma_debug_print("lapack::gesdd()"); - lapack::gesdd(&jobz, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, work.memptr(), &lwork_final, iwork.memptr(), &info); - - if(info != 0) { return false; } - - op_strans::apply_mat_inplace(V); - - return true; - } - #else - { - arma_ignore(U); - arma_ignore(S); - arma_ignore(V); - arma_ignore(A); - arma_stop_logic_error("svd(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::svd_dc(Mat< std::complex >& U, Col& S, Mat< std::complex >& V, Mat< std::complex >& A) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef std::complex eT; - - if(A.is_empty()) { U.eye(A.n_rows, A.n_rows); S.reset(); V.eye(A.n_cols, A.n_cols); return true; } - - if(arma_config::check_nonfinite && A.internal_has_nonfinite()) { return false; } - - arma_conform_assert_blas_size(A); - - U.set_size(A.n_rows, A.n_rows); - V.set_size(A.n_cols, A.n_cols); - - char jobz = 'A'; - - blas_int m = blas_int(A.n_rows); - blas_int n = blas_int(A.n_cols); - blas_int min_mn = (std::min)(m,n); - blas_int max_mn = (std::max)(m,n); - blas_int lda = blas_int(A.n_rows); - blas_int ldu = blas_int(U.n_rows); - blas_int ldvt = blas_int(V.n_rows); - blas_int lwork_min = min_mn*min_mn + 2*min_mn + max_mn; // as per LAPACK 3.2, 3.4, 3.8 docs - blas_int lrwork = min_mn * ((std::max)(5*min_mn+7, 2*max_mn + 2*min_mn+1)); // as per LAPACK 3.4 docs; LAPACK 3.8 uses 5*min_mn+5 instead of 5*min_mn+7 - blas_int info = 0; - - S.set_size( static_cast(min_mn) ); - - podarray rwork( static_cast(lrwork ) ); - podarray iwork( static_cast(8*min_mn) ); - - blas_int lwork_proposed = 0; - - if(A.n_elem >= 256) - { - eT work_query[2] = {}; - blas_int lwork_query = blas_int(-1); - - arma_debug_print("lapack::cx_gesdd()"); - lapack::cx_gesdd(&jobz, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, &work_query[0], &lwork_query, rwork.memptr(), iwork.memptr(), &info); - - if(info != 0) { return false; } - - lwork_proposed = static_cast( access::tmp_real(work_query[0]) ); - } - - blas_int lwork_final = (std::max)(lwork_proposed, lwork_min); - - podarray work( static_cast(lwork_final) ); - - arma_debug_print("lapack::cx_gesdd()"); - lapack::cx_gesdd(&jobz, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, work.memptr(), &lwork_final, rwork.memptr(), iwork.memptr(), &info); - - if(info != 0) { return false; } - - op_htrans::apply_mat_inplace(V); - - return true; - } - #else - { - arma_ignore(U); - arma_ignore(S); - arma_ignore(V); - arma_ignore(A); - arma_stop_logic_error("svd(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::svd_dc_econ(Mat& U, Col& S, Mat& V, Mat& A) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - if(arma_config::check_nonfinite && A.internal_has_nonfinite()) { return false; } - - arma_conform_assert_blas_size(A); - - char jobz = 'S'; - - blas_int m = blas_int(A.n_rows); - blas_int n = blas_int(A.n_cols); - blas_int min_mn = (std::min)(m,n); - blas_int max_mn = (std::max)(m,n); - blas_int lda = blas_int(A.n_rows); - blas_int ldu = m; - blas_int ldvt = min_mn; - blas_int lwork1 = 3*min_mn*min_mn + (std::max)( max_mn, 4*min_mn*min_mn + 4*min_mn ); // as per LAPACK 3.2 docs - blas_int lwork2 = 4*min_mn*min_mn + 6*min_mn + max_mn; // as per LAPACK 3.4 docs; LAPACK 3.8 requires 4*min_mn*min_mn + 7*min_mn - blas_int lwork_min = (std::max)(lwork1, lwork2); // due to differences between LAPACK 3.2 and 3.4 - blas_int info = 0; - - if(A.is_empty()) - { - U.eye(); - S.reset(); - V.eye( static_cast(n), static_cast(min_mn) ); - return true; - } - - S.set_size( static_cast(min_mn) ); - - U.set_size( static_cast(m), static_cast(min_mn) ); - - V.set_size( static_cast(min_mn), static_cast(n) ); - - podarray iwork( static_cast(8*min_mn) ); - - blas_int lwork_proposed = 0; - - if(A.n_elem >= 1024) - { - eT work_query[2] = {}; - blas_int lwork_query = blas_int(-1); - - arma_debug_print("lapack::gesdd()"); - lapack::gesdd(&jobz, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, &work_query[0], &lwork_query, iwork.memptr(), &info); - - if(info != 0) { return false; } - - lwork_proposed = static_cast(work_query[0]); - } - - blas_int lwork_final = (std::max)(lwork_proposed, lwork_min); - - podarray work( static_cast(lwork_final) ); - - arma_debug_print("lapack::gesdd()"); - lapack::gesdd(&jobz, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, work.memptr(), &lwork_final, iwork.memptr(), &info); - - if(info != 0) { return false; } - - op_strans::apply_mat_inplace(V); - - return true; - } - #else - { - arma_ignore(U); - arma_ignore(S); - arma_ignore(V); - arma_ignore(A); - arma_stop_logic_error("svd(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::svd_dc_econ(Mat< std::complex >& U, Col& S, Mat< std::complex >& V, Mat< std::complex >& A) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef std::complex eT; - - if(arma_config::check_nonfinite && A.internal_has_nonfinite()) { return false; } - - arma_conform_assert_blas_size(A); - - char jobz = 'S'; - - blas_int m = blas_int(A.n_rows); - blas_int n = blas_int(A.n_cols); - blas_int min_mn = (std::min)(m,n); - blas_int max_mn = (std::max)(m,n); - blas_int lda = blas_int(A.n_rows); - blas_int ldu = m; - blas_int ldvt = min_mn; - blas_int lwork_min = min_mn*min_mn + 2*min_mn + max_mn; // as per LAPACK 3.2 docs - blas_int lrwork = min_mn * ((std::max)(5*min_mn+7, 2*max_mn + 2*min_mn+1)); // LAPACK 3.8 uses 5*min_mn+5 instead of 5*min_mn+7 - blas_int info = 0; - - if(A.is_empty()) - { - U.eye(); - S.reset(); - V.eye( static_cast(n), static_cast(min_mn) ); - return true; - } - - S.set_size( static_cast(min_mn) ); - - U.set_size( static_cast(m), static_cast(min_mn) ); - - V.set_size( static_cast(min_mn), static_cast(n) ); - - podarray rwork( static_cast(lrwork ) ); - podarray iwork( static_cast(8*min_mn) ); - - blas_int lwork_proposed = 0; - - if(A.n_elem >= 256) - { - eT work_query[2] = {}; - blas_int lwork_query = blas_int(-1); - - arma_debug_print("lapack::cx_gesdd()"); - lapack::cx_gesdd(&jobz, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, &work_query[0], &lwork_query, rwork.memptr(), iwork.memptr(), &info); - - if(info != 0) { return false; } - - lwork_proposed = static_cast( access::tmp_real(work_query[0]) ); - } - - blas_int lwork_final = (std::max)(lwork_proposed, lwork_min); - - podarray work( static_cast(lwork_final) ); - - arma_debug_print("lapack::cx_gesdd()"); - lapack::cx_gesdd(&jobz, &m, &n, A.memptr(), &lda, S.memptr(), U.memptr(), &ldu, V.memptr(), &ldvt, work.memptr(), &lwork_final, rwork.memptr(), iwork.memptr(), &info); - - if(info != 0) { return false; } - - op_htrans::apply_mat_inplace(V); - - return true; - } - #else - { - arma_ignore(U); - arma_ignore(S); - arma_ignore(V); - arma_ignore(A); - arma_stop_logic_error("svd(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! solve a system of linear equations via LU decomposition -template -inline -bool -auxlib::solve_square_fast(Mat& out, Mat& A, const Base& B_expr) - { - arma_debug_sigprint(); - - out = B_expr.get_ref(); - - const uword B_n_rows = out.n_rows; - const uword B_n_cols = out.n_cols; - - arma_conform_check( (A.n_rows != B_n_rows), "solve(): number of rows in given matrices must be the same", [&](){ out.soft_reset(); } ); - - if(A.is_empty() || out.is_empty()) { out.zeros(A.n_cols, B_n_cols); return true; } - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::elem_type eT; - - arma_conform_assert_blas_size(A); - - blas_int n = blas_int(A.n_rows); // assuming A is square - blas_int lda = blas_int(A.n_rows); - blas_int ldb = blas_int(B_n_rows); - blas_int nrhs = blas_int(B_n_cols); - blas_int info = blas_int(0); - - podarray ipiv(A.n_rows + 2); // +2 for paranoia: some versions of Lapack might be trashing memory - - arma_debug_print("lapack::gesv()"); - lapack::gesv(&n, &nrhs, A.memptr(), &lda, ipiv.memptr(), out.memptr(), &ldb, &info); - - return (info == 0); - } - #else - { - arma_stop_logic_error("solve(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! solve a system of linear equations via LU decomposition with rcond estimate -template -inline -bool -auxlib::solve_square_rcond(Mat& out, typename T1::pod_type& out_rcond, Mat& A, const Base& B_expr) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - out_rcond = T(0); - - out = B_expr.get_ref(); - - const uword B_n_rows = out.n_rows; - const uword B_n_cols = out.n_cols; - - arma_conform_check( (A.n_rows != B_n_rows), "solve(): number of rows in given matrices must be the same", [&](){ out.soft_reset(); } ); - - if(A.is_empty() || out.is_empty()) { out.zeros(A.n_cols, B_n_cols); return true; } - - arma_conform_assert_blas_size(A); - - char norm_id = '1'; - char trans = 'N'; - blas_int n = blas_int(A.n_rows); // assuming A is square - blas_int lda = blas_int(A.n_rows); - blas_int ldb = blas_int(B_n_rows); - blas_int nrhs = blas_int(B_n_cols); - blas_int info = blas_int(0); - T norm_val = T(0); - - podarray junk(1); - podarray ipiv(A.n_rows + 2); // +2 for paranoia - - arma_debug_print("lapack::lange()"); - norm_val = (has_blas_float_bug::value) ? auxlib::norm1_gen(A) : lapack::lange(&norm_id, &n, &n, A.memptr(), &lda, junk.memptr()); - - arma_debug_print("lapack::getrf()"); - lapack::getrf(&n, &n, A.memptr(), &n, ipiv.memptr(), &info); - - if(info != blas_int(0)) { return false; } - - arma_debug_print("lapack::getrs()"); - lapack::getrs(&trans, &n, &nrhs, A.memptr(), &lda, ipiv.memptr(), out.memptr(), &ldb, &info); - - if(info != blas_int(0)) { return false; } - - out_rcond = auxlib::lu_rcond(A, norm_val); - - return true; - } - #else - { - arma_ignore(out); - arma_ignore(out_rcond); - arma_ignore(A); - arma_ignore(B_expr); - arma_stop_logic_error("solve(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! solve a system of linear equations via LU decomposition with refinement (real matrices) -template -inline -bool -auxlib::solve_square_refine(Mat& out, typename T1::pod_type& out_rcond, Mat& A, const Base& B_expr, const bool equilibrate) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type eT; - - // Mat B = B_expr.get_ref(); // B is overwritten by lapack::gesvx() if equilibrate is enabled - - quasi_unwrap UB(B_expr.get_ref()); // deliberately not declaring as const - - const Mat& UB_M_as_Mat = UB.M; // so we don't confuse the ?: operator below - - const bool use_copy = ((equilibrate && UB.is_const) || UB.is_alias(out)); - - Mat B_tmp; if(use_copy) { B_tmp = UB_M_as_Mat; } - - const Mat& B = (use_copy) ? B_tmp : UB_M_as_Mat; - - arma_conform_check( (A.n_rows != B.n_rows), "solve(): number of rows in given matrices must be the same" ); - - if(A.is_empty() || B.is_empty()) { out.zeros(A.n_rows, B.n_cols); return true; } - - arma_conform_assert_blas_size(A,B); - - out.set_size(A.n_rows, B.n_cols); - - char fact = (equilibrate) ? 'E' : 'N'; - char trans = 'N'; - char equed = char(0); - blas_int n = blas_int(A.n_rows); - blas_int nrhs = blas_int(B.n_cols); - blas_int lda = blas_int(A.n_rows); - blas_int ldaf = blas_int(A.n_rows); - blas_int ldb = blas_int(A.n_rows); - blas_int ldx = blas_int(A.n_rows); - blas_int info = blas_int(0); - eT rcond = eT(0); - - Mat AF(A.n_rows, A.n_rows, arma_nozeros_indicator()); - - podarray IPIV( A.n_rows); - podarray R( A.n_rows); - podarray C( A.n_rows); - podarray FERR( B.n_cols); - podarray BERR( B.n_cols); - podarray WORK(4*A.n_rows); - podarray IWORK( A.n_rows); - - arma_debug_print("lapack::gesvx()"); - lapack::gesvx - ( - &fact, &trans, &n, &nrhs, - A.memptr(), &lda, - AF.memptr(), &ldaf, - IPIV.memptr(), - &equed, - R.memptr(), - C.memptr(), - const_cast(B.memptr()), &ldb, - out.memptr(), &ldx, - &rcond, - FERR.memptr(), - BERR.memptr(), - WORK.memptr(), - IWORK.memptr(), - &info - ); - - // NOTE: using const_cast(B.memptr()) to allow B to be overwritten for equilibration; - // NOTE: B is created as a copy of B_expr if equilibration is enabled; otherwise B is a reference to B_expr - - out_rcond = rcond; - - return ((info == 0) || (info == (n+1))); - } - #else - { - arma_ignore(out); - arma_ignore(out_rcond); - arma_ignore(A); - arma_ignore(B_expr); - arma_ignore(equilibrate); - arma_stop_logic_error("solve(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! solve a system of linear equations via LU decomposition with refinement (complex matrices) -template -inline -bool -auxlib::solve_square_refine(Mat< std::complex >& out, typename T1::pod_type& out_rcond, Mat< std::complex >& A, const Base,T1>& B_expr, const bool equilibrate) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type T; - typedef typename std::complex eT; - - // Mat B = B_expr.get_ref(); // B is overwritten by lapack::cx_gesvx() if equilibrate is enabled - - quasi_unwrap UB(B_expr.get_ref()); // deliberately not declaring as const - - const Mat& UB_M_as_Mat = UB.M; // so we don't confuse the ?: operator below - - const bool use_copy = ((equilibrate && UB.is_const) || UB.is_alias(out)); - - Mat B_tmp; if(use_copy) { B_tmp = UB_M_as_Mat; } - - const Mat& B = (use_copy) ? B_tmp : UB_M_as_Mat; - - arma_conform_check( (A.n_rows != B.n_rows), "solve(): number of rows in given matrices must be the same" ); - - if(A.is_empty() || B.is_empty()) { out.zeros(A.n_rows, B.n_cols); return true; } - - arma_conform_assert_blas_size(A,B); - - out.set_size(A.n_rows, B.n_cols); - - char fact = (equilibrate) ? 'E' : 'N'; - char trans = 'N'; - char equed = char(0); - blas_int n = blas_int(A.n_rows); - blas_int nrhs = blas_int(B.n_cols); - blas_int lda = blas_int(A.n_rows); - blas_int ldaf = blas_int(A.n_rows); - blas_int ldb = blas_int(A.n_rows); - blas_int ldx = blas_int(A.n_rows); - blas_int info = blas_int(0); - T rcond = T(0); - - Mat AF(A.n_rows, A.n_rows, arma_nozeros_indicator()); - - podarray IPIV( A.n_rows); - podarray< T> R( A.n_rows); - podarray< T> C( A.n_rows); - podarray< T> FERR( B.n_cols); - podarray< T> BERR( B.n_cols); - podarray WORK(2*A.n_rows); - podarray< T> RWORK(2*A.n_rows); - - arma_debug_print("lapack::cx_gesvx()"); - lapack::cx_gesvx - ( - &fact, &trans, &n, &nrhs, - A.memptr(), &lda, - AF.memptr(), &ldaf, - IPIV.memptr(), - &equed, - R.memptr(), - C.memptr(), - const_cast(B.memptr()), &ldb, - out.memptr(), &ldx, - &rcond, - FERR.memptr(), - BERR.memptr(), - WORK.memptr(), - RWORK.memptr(), - &info - ); - - // NOTE: using const_cast(B.memptr()) to allow B to be overwritten for equilibration; - // NOTE: B is created as a copy of B_expr if equilibration is enabled; otherwise B is a reference to B_expr - - out_rcond = rcond; - - return ((info == 0) || (info == (n+1))); - } - #else - { - arma_ignore(out); - arma_ignore(out_rcond); - arma_ignore(A); - arma_ignore(B_expr); - arma_ignore(equilibrate); - arma_stop_logic_error("solve(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::solve_sympd_fast(Mat& out, Mat& A, const Base& B_expr) - { - arma_debug_sigprint(); - - #if defined(ARMA_CRIPPLED_LAPACK) - { - arma_debug_print("auxlib::solve_sympd_fast(): redirecting to auxlib::solve_square_fast() due to crippled LAPACK"); - - return auxlib::solve_square_fast(out, A, B_expr); - } - #else - { - return auxlib::solve_sympd_fast_common(out, A, B_expr); - } - #endif - } - - - -template -inline -bool -auxlib::solve_sympd_fast_common(Mat& out, Mat& A, const Base& B_expr) - { - arma_debug_sigprint(); - - out = B_expr.get_ref(); - - const uword B_n_rows = out.n_rows; - const uword B_n_cols = out.n_cols; - - arma_conform_check( (A.n_rows != B_n_rows), "solve(): number of rows in given matrices must be the same", [&](){ out.soft_reset(); } ); - - if(A.is_empty() || out.is_empty()) { out.zeros(A.n_cols, B_n_cols); return true; } - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::elem_type eT; - - arma_conform_assert_blas_size(A, out); - - char uplo = 'L'; - blas_int n = blas_int(A.n_rows); // assuming A is square - blas_int nrhs = blas_int(B_n_cols); - blas_int lda = blas_int(A.n_rows); - blas_int ldb = blas_int(B_n_rows); - blas_int info = blas_int(0); - - arma_debug_print("lapack::posv()"); - lapack::posv(&uplo, &n, &nrhs, A.memptr(), &lda, out.memptr(), &ldb, &info); - - return (info == 0); - } - #else - { - arma_ignore(out); - arma_ignore(A); - arma_ignore(B_expr); - arma_stop_logic_error("solve(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! solve a system of linear equations via Cholesky decomposition with rcond estimate (real matrices) -template -inline -bool -auxlib::solve_sympd_rcond(Mat& out, bool& out_sympd_state, typename T1::pod_type& out_rcond, Mat& A, const Base& B_expr) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - out_sympd_state = false; - out_rcond = T(0); - - out = B_expr.get_ref(); - - const uword B_n_rows = out.n_rows; - const uword B_n_cols = out.n_cols; - - arma_conform_check( (A.n_rows != B_n_rows), "solve(): number of rows in given matrices must be the same", [&](){ out.soft_reset(); } ); - - if(A.is_empty() || out.is_empty()) { out.zeros(A.n_cols, B_n_cols); return true; } - - arma_conform_assert_blas_size(A, out); - - char norm_id = '1'; - char uplo = 'L'; - blas_int n = blas_int(A.n_rows); // assuming A is square - blas_int nrhs = blas_int(B_n_cols); - blas_int info = blas_int(0); - T norm_val = T(0); - - podarray work(A.n_rows); - - arma_debug_print("lapack::lansy()"); - norm_val = (has_blas_float_bug::value) ? auxlib::norm1_sym(A) : lapack::lansy(&norm_id, &uplo, &n, A.memptr(), &n, work.memptr()); - - arma_debug_print("lapack::potrf()"); - lapack::potrf(&uplo, &n, A.memptr(), &n, &info); - - if(info != 0) { return false; } - - out_sympd_state = true; - - arma_debug_print("lapack::potrs()"); - lapack::potrs(&uplo, &n, &nrhs, A.memptr(), &n, out.memptr(), &n, &info); - - if(info != 0) { return false; } - - out_rcond = auxlib::lu_rcond_sympd(A, norm_val); - - return true; - } - #else - { - arma_ignore(out); - arma_ignore(out_sympd_state); - arma_ignore(out_rcond); - arma_ignore(A); - arma_ignore(B_expr); - arma_stop_logic_error("solve(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! solve a system of linear equations via Cholesky decomposition with rcond estimate (complex matrices) -template -inline -bool -auxlib::solve_sympd_rcond(Mat< std::complex >& out, bool& out_sympd_state, typename T1::pod_type& out_rcond, Mat< std::complex >& A, const Base< std::complex,T1>& B_expr) - { - arma_debug_sigprint(); - - #if defined(ARMA_CRIPPLED_LAPACK) - { - arma_debug_print("auxlib::solve_sympd_rcond(): redirecting to auxlib::solve_square_rcond() due to crippled LAPACK"); - - out_sympd_state = false; - - return auxlib::solve_square_rcond(out, out_rcond, A, B_expr); - } - #elif defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type T; - typedef typename std::complex eT; - - out_sympd_state = false; - out_rcond = T(0); - - out = B_expr.get_ref(); - - const uword B_n_rows = out.n_rows; - const uword B_n_cols = out.n_cols; - - arma_conform_check( (A.n_rows != B_n_rows), "solve(): number of rows in given matrices must be the same", [&](){ out.soft_reset(); } ); - - if(A.is_empty() || out.is_empty()) { out.zeros(A.n_cols, B_n_cols); return true; } - - arma_conform_assert_blas_size(A, out); - - char norm_id = '1'; - char uplo = 'L'; - blas_int n = blas_int(A.n_rows); // assuming A is square - blas_int nrhs = blas_int(B_n_cols); - blas_int info = blas_int(0); - T norm_val = T(0); - - podarray work(A.n_rows); - - arma_debug_print("lapack::lanhe()"); - norm_val = (has_blas_float_bug::value) ? auxlib::norm1_sym(A) : lapack::lanhe(&norm_id, &uplo, &n, A.memptr(), &n, work.memptr()); - - arma_debug_print("lapack::potrf()"); - lapack::potrf(&uplo, &n, A.memptr(), &n, &info); - - if(info != 0) { return false; } - - out_sympd_state = true; - - arma_debug_print("lapack::potrs()"); - lapack::potrs(&uplo, &n, &nrhs, A.memptr(), &n, out.memptr(), &n, &info); - - if(info != 0) { return false; } - - out_rcond = auxlib::lu_rcond_sympd(A, norm_val); - - return true; - } - #else - { - arma_ignore(out); - arma_ignore(out_sympd_state); - arma_ignore(out_rcond); - arma_ignore(A); - arma_ignore(B_expr); - arma_stop_logic_error("solve(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! solve a system of linear equations via Cholesky decomposition with refinement (real matrices) -template -inline -bool -auxlib::solve_sympd_refine(Mat& out, typename T1::pod_type& out_rcond, Mat& A, const Base& B_expr, const bool equilibrate) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type eT; - - // Mat B = B_expr.get_ref(); // B is overwritten by lapack::posvx() if equilibrate is enabled - - quasi_unwrap UB(B_expr.get_ref()); // deliberately not declaring as const - - const Mat& UB_M_as_Mat = UB.M; // so we don't confuse the ?: operator below - - const bool use_copy = ((equilibrate && UB.is_const) || UB.is_alias(out)); - - Mat B_tmp; if(use_copy) { B_tmp = UB_M_as_Mat; } - - const Mat& B = (use_copy) ? B_tmp : UB_M_as_Mat; - - arma_conform_check( (A.n_rows != B.n_rows), "solve(): number of rows in given matrices must be the same" ); - - if(A.is_empty() || B.is_empty()) { out.zeros(A.n_rows, B.n_cols); return true; } - - arma_conform_assert_blas_size(A,B); - - out.set_size(A.n_rows, B.n_cols); - - char fact = (equilibrate) ? 'E' : 'N'; - char uplo = 'L'; - char equed = char(0); - blas_int n = blas_int(A.n_rows); - blas_int nrhs = blas_int(B.n_cols); - blas_int lda = blas_int(A.n_rows); - blas_int ldaf = blas_int(A.n_rows); - blas_int ldb = blas_int(A.n_rows); - blas_int ldx = blas_int(A.n_rows); - blas_int info = blas_int(0); - eT rcond = eT(0); - - Mat AF(A.n_rows, A.n_rows, arma_nozeros_indicator()); - - podarray S( A.n_rows); - podarray FERR( B.n_cols); - podarray BERR( B.n_cols); - podarray WORK(3*A.n_rows); - podarray IWORK( A.n_rows); - - arma_debug_print("lapack::posvx()"); - lapack::posvx(&fact, &uplo, &n, &nrhs, A.memptr(), &lda, AF.memptr(), &ldaf, &equed, S.memptr(), const_cast(B.memptr()), &ldb, out.memptr(), &ldx, &rcond, FERR.memptr(), BERR.memptr(), WORK.memptr(), IWORK.memptr(), &info); - - // NOTE: using const_cast(B.memptr()) to allow B to be overwritten for equilibration; - // NOTE: B is created as a copy of B_expr if equilibration is enabled; otherwise B is a reference to B_expr - - // NOTE: lapack::posvx() sets rcond to zero if A is not sympd - out_rcond = rcond; - - return ((info == 0) || (info == (n+1))); - } - #else - { - arma_ignore(out); - arma_ignore(out_rcond); - arma_ignore(A); - arma_ignore(B_expr); - arma_ignore(equilibrate); - arma_stop_logic_error("solve(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! solve a system of linear equations via Cholesky decomposition with refinement (complex matrices) -template -inline -bool -auxlib::solve_sympd_refine(Mat< std::complex >& out, typename T1::pod_type& out_rcond, Mat< std::complex >& A, const Base,T1>& B_expr, const bool equilibrate) - { - arma_debug_sigprint(); - - #if defined(ARMA_CRIPPLED_LAPACK) - { - arma_debug_print("auxlib::solve_sympd_refine(): redirecting to auxlib::solve_square_refine() due to crippled LAPACK"); - - return auxlib::solve_square_refine(out, out_rcond, A, B_expr, equilibrate); - } - #elif defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type T; - typedef typename std::complex eT; - - // Mat B = B_expr.get_ref(); // B is overwritten by lapack::cx_posvx() if equilibrate is enabled - - quasi_unwrap UB(B_expr.get_ref()); // deliberately not declaring as const - - const Mat& UB_M_as_Mat = UB.M; // so we don't confuse the ?: operator below - - const bool use_copy = ((equilibrate && UB.is_const) || UB.is_alias(out)); - - Mat B_tmp; if(use_copy) { B_tmp = UB_M_as_Mat; } - - const Mat& B = (use_copy) ? B_tmp : UB_M_as_Mat; - - arma_conform_check( (A.n_rows != B.n_rows), "solve(): number of rows in given matrices must be the same" ); - - if(A.is_empty() || B.is_empty()) { out.zeros(A.n_rows, B.n_cols); return true; } - - arma_conform_assert_blas_size(A,B); - - out.set_size(A.n_rows, B.n_cols); - - char fact = (equilibrate) ? 'E' : 'N'; - char uplo = 'L'; - char equed = char(0); - blas_int n = blas_int(A.n_rows); - blas_int nrhs = blas_int(B.n_cols); - blas_int lda = blas_int(A.n_rows); - blas_int ldaf = blas_int(A.n_rows); - blas_int ldb = blas_int(A.n_rows); - blas_int ldx = blas_int(A.n_rows); - blas_int info = blas_int(0); - T rcond = T(0); - - Mat AF(A.n_rows, A.n_rows, arma_nozeros_indicator()); - - podarray< T> S( A.n_rows); - podarray< T> FERR( B.n_cols); - podarray< T> BERR( B.n_cols); - podarray WORK(2*A.n_rows); - podarray< T> RWORK( A.n_rows); - - arma_debug_print("lapack::cx_posvx()"); - lapack::cx_posvx(&fact, &uplo, &n, &nrhs, A.memptr(), &lda, AF.memptr(), &ldaf, &equed, S.memptr(), const_cast(B.memptr()), &ldb, out.memptr(), &ldx, &rcond, FERR.memptr(), BERR.memptr(), WORK.memptr(), RWORK.memptr(), &info); - - // NOTE: using const_cast(B.memptr()) to allow B to be overwritten for equilibration; - // NOTE: B is created as a copy of B_expr if equilibration is enabled; otherwise B is a reference to B_expr - - // NOTE: lapack::cx_posvx() sets rcond to zero if A is not sympd - out_rcond = rcond; - - return ((info == 0) || (info == (n+1))); - } - #else - { - arma_ignore(out); - arma_ignore(out_rcond); - arma_ignore(A); - arma_ignore(B_expr); - arma_ignore(equilibrate); - arma_stop_logic_error("solve(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! solve a non-square full-rank system via QR or LQ decomposition -template -inline -bool -auxlib::solve_rect_fast(Mat& out, Mat& A, const Base& B_expr) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::elem_type eT; - - const unwrap U(B_expr.get_ref()); - const Mat& B = U.M; - - arma_conform_check( (A.n_rows != B.n_rows), "solve(): number of rows in given matrices must be the same" ); - - if(A.is_empty() || B.is_empty()) { out.zeros(A.n_cols, B.n_cols); return true; } - - arma_conform_assert_blas_size(A,B); - - Mat tmp( (std::max)(A.n_rows, A.n_cols), B.n_cols, arma_nozeros_indicator() ); - - if(arma::size(tmp) == arma::size(B)) - { - tmp = B; - } - else - { - tmp.zeros(); - tmp(0,0, arma::size(B)) = B; - } - - char trans = 'N'; - blas_int m = blas_int(A.n_rows); - blas_int n = blas_int(A.n_cols); - blas_int lda = blas_int(A.n_rows); - blas_int ldb = blas_int(tmp.n_rows); - blas_int nrhs = blas_int(B.n_cols); - blas_int min_mn = (std::min)(m,n); - blas_int lwork_min = (std::max)(blas_int(1), min_mn + (std::max)(min_mn, nrhs)); - blas_int info = 0; - - blas_int lwork_proposed = 0; - - if(A.n_elem >= ((is_cx::yes) ? uword(256) : uword(1024))) - { - eT work_query[2] = {}; - blas_int lwork_query = -1; - - arma_debug_print("lapack::gels()"); - lapack::gels( &trans, &m, &n, &nrhs, A.memptr(), &lda, tmp.memptr(), &ldb, &work_query[0], &lwork_query, &info ); - - if(info != 0) { return false; } - - lwork_proposed = static_cast( access::tmp_real(work_query[0]) ); - } - - blas_int lwork_final = (std::max)(lwork_proposed, lwork_min); - - podarray work( static_cast(lwork_final) ); - - arma_debug_print("lapack::gels()"); - lapack::gels( &trans, &m, &n, &nrhs, A.memptr(), &lda, tmp.memptr(), &ldb, work.memptr(), &lwork_final, &info ); - - if(info != 0) { return false; } - - if(tmp.n_rows == A.n_cols) - { - out.steal_mem(tmp); - } - else - { - out = tmp.head_rows(A.n_cols); - } - - return true; - } - #else - { - arma_ignore(out); - arma_ignore(A); - arma_ignore(B_expr); - arma_stop_logic_error("solve(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! solve a non-square full-rank system via QR or LQ decomposition with rcond estimate (experimental) -template -inline -bool -auxlib::solve_rect_rcond(Mat& out, typename T1::pod_type& out_rcond, Mat& A, const Base& B_expr) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - out_rcond = T(0); - - const unwrap U(B_expr.get_ref()); - const Mat& B = U.M; - - arma_conform_check( (A.n_rows != B.n_rows), "solve(): number of rows in given matrices must be the same" ); - - if(A.is_empty() || B.is_empty()) { out.zeros(A.n_cols, B.n_cols); return true; } - - arma_conform_assert_blas_size(A,B); - - Mat tmp( (std::max)(A.n_rows, A.n_cols), B.n_cols, arma_nozeros_indicator() ); - - if(arma::size(tmp) == arma::size(B)) - { - tmp = B; - } - else - { - tmp.zeros(); - tmp(0,0, arma::size(B)) = B; - } - - char trans = 'N'; - blas_int m = blas_int(A.n_rows); - blas_int n = blas_int(A.n_cols); - blas_int lda = blas_int(A.n_rows); - blas_int ldb = blas_int(tmp.n_rows); - blas_int nrhs = blas_int(B.n_cols); - blas_int min_mn = (std::min)(m,n); - blas_int lwork_min = (std::max)(blas_int(1), min_mn + (std::max)(min_mn, nrhs)); - blas_int info = 0; - - blas_int lwork_proposed = 0; - - if(A.n_elem >= ((is_cx::yes) ? uword(256) : uword(1024))) - { - eT work_query[2] = {}; - blas_int lwork_query = -1; - - arma_debug_print("lapack::gels()"); - lapack::gels( &trans, &m, &n, &nrhs, A.memptr(), &lda, tmp.memptr(), &ldb, &work_query[0], &lwork_query, &info ); - - if(info != 0) { return false; } - - lwork_proposed = static_cast( access::tmp_real(work_query[0]) ); - } - - blas_int lwork_final = (std::max)(lwork_proposed, lwork_min); - - podarray work( static_cast(lwork_final) ); - - arma_debug_print("lapack::gels()"); - lapack::gels( &trans, &m, &n, &nrhs, A.memptr(), &lda, tmp.memptr(), &ldb, work.memptr(), &lwork_final, &info ); - - if(info != 0) { return false; } - - if(A.n_rows >= A.n_cols) - { - arma_debug_print("estimating rcond via R"); - - // xGELS docs: for M >= N, A contains details of its QR decomposition as returned by xGEQRF - // xGEQRF docs: elements on and above the diagonal contain the min(M,N)-by-N upper trapezoidal matrix R - - Mat R(A.n_cols, A.n_cols, arma_zeros_indicator()); - - for(uword col=0; col < A.n_cols; ++col) - { - for(uword row=0; row <= col; ++row) - { - R.at(row,col) = A.at(row,col); - } - } - - // determine quality of solution - out_rcond = auxlib::rcond_trimat(R, 0); // 0: upper triangular; 1: lower triangular - } - else - if(A.n_rows < A.n_cols) - { - arma_debug_print("estimating rcond via L"); - - // xGELS docs: for M < N, A contains details of its LQ decomposition as returned by xGELQF - // xGELQF docs: elements on and below the diagonal contain the M-by-min(M,N) lower trapezoidal matrix L - - Mat L(A.n_rows, A.n_rows, arma_zeros_indicator()); - - for(uword col=0; col < A.n_rows; ++col) - { - for(uword row=col; row < A.n_rows; ++row) - { - L.at(row,col) = A.at(row,col); - } - } - - // determine quality of solution - out_rcond = auxlib::rcond_trimat(L, 1); // 0: upper triangular; 1: lower triangular - } - - if(tmp.n_rows == A.n_cols) - { - out.steal_mem(tmp); - } - else - { - out = tmp.head_rows(A.n_cols); - } - - return true; - } - #else - { - arma_ignore(out); - arma_ignore(out_rcond); - arma_ignore(A); - arma_ignore(B_expr); - arma_stop_logic_error("solve(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::solve_approx_svd(Mat& out, Mat& A, const Base& B_expr) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type eT; - - const unwrap U(B_expr.get_ref()); - const Mat& B = U.M; - - arma_conform_check( (A.n_rows != B.n_rows), "solve(): number of rows in given matrices must be the same" ); - - if(A.is_empty() || B.is_empty()) { out.zeros(A.n_cols, B.n_cols); return true; } - - if(arma_config::check_nonfinite && A.internal_has_nonfinite()) { return false; } - if(arma_config::check_nonfinite && B.internal_has_nonfinite()) { return false; } - - arma_conform_assert_blas_size(A,B); - - Mat tmp( (std::max)(A.n_rows, A.n_cols), B.n_cols, arma_nozeros_indicator() ); - - if(arma::size(tmp) == arma::size(B)) - { - tmp = B; - } - else - { - tmp.zeros(); - tmp(0,0, arma::size(B)) = B; - } - - blas_int m = blas_int(A.n_rows); - blas_int n = blas_int(A.n_cols); - blas_int min_mn = (std::min)(m, n); - blas_int nrhs = blas_int(B.n_cols); - blas_int lda = blas_int(A.n_rows); - blas_int ldb = blas_int(tmp.n_rows); - //eT rcond = eT(-1); // -1 means "use machine precision" - eT rcond = (std::max)(A.n_rows, A.n_cols) * std::numeric_limits::epsilon(); - blas_int rank = blas_int(0); - blas_int info = blas_int(0); - - podarray S( static_cast(min_mn) ); - - // NOTE: assuming LAPACK 3.8+, where the workspace query also obtains liwork in addition to lwork - - blas_int ispec = blas_int(9); - - const char* const_name = (is_float::value) ? "SGELSD" : "DGELSD"; - const char* const_opts = " "; - - char* name = const_cast(const_name); - char* opts = const_cast(const_opts); - - blas_int n1 = m; - blas_int n2 = n; - blas_int n3 = nrhs; - blas_int n4 = lda; - - blas_int laenv_result = (arma_config::hidden_args) ? blas_int(lapack::laenv(&ispec, name, opts, &n1, &n2, &n3, &n4, 6, 1)) : blas_int(0); - - blas_int smlsiz = (std::max)( blas_int(25), laenv_result ); - blas_int smlsiz_p1 = blas_int(1) + smlsiz; - - blas_int nlvl = (std::max)( blas_int(0), blas_int(1) + blas_int( std::log2( double(min_mn)/double(smlsiz_p1) ) ) ); - - blas_int lwork_min = blas_int(12)*min_mn + blas_int(2)*min_mn*smlsiz + blas_int(8)*min_mn*nlvl + min_mn*nrhs + smlsiz_p1*smlsiz_p1; - blas_int liwork_min = (std::max)( blas_int(1), (blas_int(3)*min_mn*nlvl + blas_int(11)*min_mn) ); - - eT work_query[2] = {}; - blas_int iwork_query[2] = {}; - - blas_int lwork_query = blas_int(-1); - - arma_debug_print("lapack::gelsd()"); - lapack::gelsd(&m, &n, &nrhs, A.memptr(), &lda, tmp.memptr(), &ldb, S.memptr(), &rcond, &rank, &work_query[0], &lwork_query, &iwork_query[0], &info); - - if(info != 0) { return false; } - - blas_int lwork_proposed = static_cast( access::tmp_real(work_query[0]) ); - blas_int liwork_proposed = iwork_query[0]; - - blas_int lwork_final = (std::max)( lwork_proposed, lwork_min); - blas_int liwork_final = (std::max)(liwork_proposed, liwork_min); - - podarray work( static_cast( lwork_final) ); - podarray iwork( static_cast(liwork_final) ); - - arma_debug_print("lapack::gelsd()"); - lapack::gelsd(&m, &n, &nrhs, A.memptr(), &lda, tmp.memptr(), &ldb, S.memptr(), &rcond, &rank, work.memptr(), &lwork_final, iwork.memptr(), &info); - - if(info != 0) { return false; } - - if(tmp.n_rows == A.n_cols) - { - out.steal_mem(tmp); - } - else - { - out = tmp.head_rows(A.n_cols); - } - - return true; - } - #else - { - arma_ignore(out); - arma_ignore(A); - arma_ignore(B_expr); - arma_stop_logic_error("solve(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::solve_approx_svd(Mat< std::complex >& out, Mat< std::complex >& A, const Base,T1>& B_expr) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type T; - typedef typename std::complex eT; - - const unwrap U(B_expr.get_ref()); - const Mat& B = U.M; - - arma_conform_check( (A.n_rows != B.n_rows), "solve(): number of rows in given matrices must be the same" ); - - if(A.is_empty() || B.is_empty()) { out.zeros(A.n_cols, B.n_cols); return true; } - - if(arma_config::check_nonfinite && A.internal_has_nonfinite()) { return false; } - if(arma_config::check_nonfinite && B.internal_has_nonfinite()) { return false; } - - arma_conform_assert_blas_size(A,B); - - Mat tmp( (std::max)(A.n_rows, A.n_cols), B.n_cols, arma_nozeros_indicator() ); - - if(arma::size(tmp) == arma::size(B)) - { - tmp = B; - } - else - { - tmp.zeros(); - tmp(0,0, arma::size(B)) = B; - } - - blas_int m = blas_int(A.n_rows); - blas_int n = blas_int(A.n_cols); - blas_int min_mn = (std::min)(m, n); - blas_int nrhs = blas_int(B.n_cols); - blas_int lda = blas_int(A.n_rows); - blas_int ldb = blas_int(tmp.n_rows); - //T rcond = T(-1); // -1 means "use machine precision" - T rcond = (std::max)(A.n_rows, A.n_cols) * std::numeric_limits::epsilon(); - blas_int rank = blas_int(0); - blas_int info = blas_int(0); - - podarray S( static_cast(min_mn) ); - - // NOTE: assuming LAPACK 3.8+, where the workspace query also obtains lrwork and liwork in addition to lwork - - blas_int ispec = blas_int(9); - - const char* const_name = (is_float::value) ? "CGELSD" : "ZGELSD"; - const char* const_opts = " "; - - char* name = const_cast(const_name); - char* opts = const_cast(const_opts); - - blas_int n1 = m; - blas_int n2 = n; - blas_int n3 = nrhs; - blas_int n4 = lda; - - blas_int laenv_result = (arma_config::hidden_args) ? blas_int(lapack::laenv(&ispec, name, opts, &n1, &n2, &n3, &n4, 6, 1)) : blas_int(0); - - blas_int smlsiz = (std::max)( blas_int(25), laenv_result ); - blas_int smlsiz_p1 = blas_int(1) + smlsiz; - - blas_int nlvl = (std::max)( blas_int(0), blas_int(1) + blas_int( std::log2( double(min_mn)/double(smlsiz_p1) ) ) ); - - blas_int lwork_min = 2*min_mn + min_mn*nrhs; - - blas_int lrwork_min = (m >= n) - ? blas_int(10)*n + blas_int(2)*n*smlsiz + blas_int(8)*n*nlvl + blas_int(3)*smlsiz*nrhs + (std::max)( (smlsiz_p1)*(smlsiz_p1), n*(blas_int(1)+nrhs) + blas_int(2)*nrhs ) - : blas_int(10)*m + blas_int(2)*m*smlsiz + blas_int(8)*m*nlvl + blas_int(3)*smlsiz*nrhs + (std::max)( (smlsiz_p1)*(smlsiz_p1), n*(blas_int(1)+nrhs) + blas_int(2)*nrhs ); - - blas_int liwork_min = (std::max)( blas_int(1), (blas_int(3)*blas_int(min_mn)*nlvl + blas_int(11)*blas_int(min_mn)) ); - - eT work_query[2] = {}; - T rwork_query[2] = {}; - blas_int iwork_query[2] = {}; - - blas_int lwork_query = blas_int(-1); - - arma_debug_print("lapack::cx_gelsd()"); - lapack::cx_gelsd(&m, &n, &nrhs, A.memptr(), &lda, tmp.memptr(), &ldb, S.memptr(), &rcond, &rank, &work_query[0], &lwork_query, &rwork_query[0], &iwork_query[0], &info); - - if(info != 0) { return false; } - - blas_int lwork_proposed = static_cast( access::tmp_real(work_query[0]) ); - blas_int lrwork_proposed = static_cast( rwork_query[0] ); - blas_int liwork_proposed = iwork_query[0]; - - blas_int lwork_final = (std::max)( lwork_proposed, lwork_min); - blas_int lrwork_final = (std::max)(lrwork_proposed, lrwork_min); - blas_int liwork_final = (std::max)(liwork_proposed, liwork_min); - - podarray work( static_cast( lwork_final) ); - podarray rwork( static_cast(lrwork_final) ); - podarray iwork( static_cast(liwork_final) ); - - arma_debug_print("lapack::cx_gelsd()"); - lapack::cx_gelsd(&m, &n, &nrhs, A.memptr(), &lda, tmp.memptr(), &ldb, S.memptr(), &rcond, &rank, work.memptr(), &lwork_final, rwork.memptr(), iwork.memptr(), &info); - - if(info != 0) { return false; } - - if(tmp.n_rows == A.n_cols) - { - out.steal_mem(tmp); - } - else - { - out = tmp.head_rows(A.n_cols); - } - - return true; - } - #else - { - arma_ignore(out); - arma_ignore(A); - arma_ignore(B_expr); - arma_stop_logic_error("solve(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::solve_trimat_fast(Mat& out, const Mat& A, const Base& B_expr, const uword layout) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - out = B_expr.get_ref(); - - const uword B_n_rows = out.n_rows; - const uword B_n_cols = out.n_cols; - - arma_conform_check( (A.n_rows != B_n_rows), "solve(): number of rows in given matrices must be the same", [&](){ out.soft_reset(); } ); - - if(A.is_empty() || out.is_empty()) { out.zeros(A.n_cols, B_n_cols); return true; } - - arma_conform_assert_blas_size(A,out); - - char uplo = (layout == 0) ? 'U' : 'L'; - char trans = 'N'; - char diag = 'N'; - blas_int n = blas_int(A.n_rows); - blas_int nrhs = blas_int(B_n_cols); - blas_int info = 0; - - arma_debug_print("lapack::trtrs()"); - lapack::trtrs(&uplo, &trans, &diag, &n, &nrhs, A.memptr(), &n, out.memptr(), &n, &info); - - return (info == 0); - } - #else - { - arma_ignore(out); - arma_ignore(A); - arma_ignore(B_expr); - arma_ignore(layout); - arma_stop_logic_error("solve(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::solve_trimat_rcond(Mat& out, typename T1::pod_type& out_rcond, const Mat& A, const Base& B_expr, const uword layout) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type T; - - out_rcond = T(0); - - out = B_expr.get_ref(); - - const uword B_n_rows = out.n_rows; - const uword B_n_cols = out.n_cols; - - arma_conform_check( (A.n_rows != B_n_rows), "solve(): number of rows in given matrices must be the same", [&](){ out.soft_reset(); } ); - - if(A.is_empty() || out.is_empty()) { out.zeros(A.n_cols, B_n_cols); return true; } - - arma_conform_assert_blas_size(A,out); - - char uplo = (layout == 0) ? 'U' : 'L'; - char trans = 'N'; - char diag = 'N'; - blas_int n = blas_int(A.n_rows); - blas_int nrhs = blas_int(B_n_cols); - blas_int info = 0; - - arma_debug_print("lapack::trtrs()"); - lapack::trtrs(&uplo, &trans, &diag, &n, &nrhs, A.memptr(), &n, out.memptr(), &n, &info); - - if(info != 0) { return false; } - - // determine quality of solution - out_rcond = auxlib::rcond_trimat(A, layout); - - return true; - } - #else - { - arma_ignore(out); - arma_ignore(out_rcond); - arma_ignore(A); - arma_ignore(B_expr); - arma_ignore(layout); - arma_stop_logic_error("solve(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! solve a system of linear equations via LU decomposition (real band matrix) -template -inline -bool -auxlib::solve_band_fast(Mat& out, Mat& A, const uword KL, const uword KU, const Base& B_expr) - { - arma_debug_sigprint(); - - return auxlib::solve_band_fast_common(out, A, KL, KU, B_expr); - } - - - -//! solve a system of linear equations via LU decomposition (complex band matrix) -template -inline -bool -auxlib::solve_band_fast(Mat< std::complex >& out, Mat< std::complex >& A, const uword KL, const uword KU, const Base< std::complex,T1>& B_expr) - { - arma_debug_sigprint(); - - #if defined(ARMA_CRIPPLED_LAPACK) - { - arma_debug_print("auxlib::solve_band_fast(): redirecting to auxlib::solve_square_fast() due to crippled LAPACK"); - - arma_ignore(KL); - arma_ignore(KU); - - return auxlib::solve_square_fast(out, A, B_expr); - } - #else - { - return auxlib::solve_band_fast_common(out, A, KL, KU, B_expr); - } - #endif - } - - - -//! solve a system of linear equations via LU decomposition (band matrix) -template -inline -bool -auxlib::solve_band_fast_common(Mat& out, const Mat& A, const uword KL, const uword KU, const Base& B_expr) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::elem_type eT; - - out = B_expr.get_ref(); - - const uword B_n_rows = out.n_rows; - const uword B_n_cols = out.n_cols; - - arma_conform_check( (A.n_rows != B_n_rows), "solve(): number of rows in given matrices must be the same", [&](){ out.soft_reset(); } ); - - if(A.is_empty() || out.is_empty()) { out.zeros(A.n_rows, B_n_cols); return true; } - - // for gbsv, matrix AB size: 2*KL+KU+1 x N; band representation of A stored in rows KL+1 to 2*KL+KU+1 (note: fortran counts from 1) - - Mat AB; - band_helper::compress(AB, A, KL, KU, true); - - const uword N = AB.n_cols; // order of the original square matrix A - - arma_conform_assert_blas_size(AB,out); - - blas_int n = blas_int(N); - blas_int kl = blas_int(KL); - blas_int ku = blas_int(KU); - blas_int nrhs = blas_int(B_n_cols); - blas_int ldab = blas_int(AB.n_rows); - blas_int ldb = blas_int(B_n_rows); - blas_int info = blas_int(0); - - podarray ipiv(N + 2); // +2 for paranoia - - // NOTE: AB is overwritten - - arma_debug_print("lapack::gbsv()"); - lapack::gbsv(&n, &kl, &ku, &nrhs, AB.memptr(), &ldab, ipiv.memptr(), out.memptr(), &ldb, &info); - - return (info == 0); - } - #else - { - arma_ignore(out); - arma_ignore(A); - arma_ignore(KL); - arma_ignore(KU); - arma_ignore(B_expr); - arma_stop_logic_error("solve(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! solve a system of linear equations via LU decomposition (real band matrix) -template -inline -bool -auxlib::solve_band_rcond(Mat& out, typename T1::pod_type& out_rcond, Mat& A, const uword KL, const uword KU, const Base& B_expr) - { - arma_debug_sigprint(); - - return auxlib::solve_band_rcond_common(out, out_rcond, A, KL, KU, B_expr); - } - - - -//! solve a system of linear equations via LU decomposition (complex band matrix) -template -inline -bool -auxlib::solve_band_rcond(Mat< std::complex >& out, typename T1::pod_type& out_rcond, Mat< std::complex >& A, const uword KL, const uword KU, const Base< std::complex,T1>& B_expr) - { - arma_debug_sigprint(); - - #if defined(ARMA_CRIPPLED_LAPACK) - { - arma_debug_print("auxlib::solve_band_rcond(): redirecting to auxlib::solve_square_rcond() due to crippled LAPACK"); - - arma_ignore(KL); - arma_ignore(KU); - - return auxlib::solve_square_rcond(out, out_rcond, A, B_expr); - } - #else - { - return auxlib::solve_band_rcond_common(out, out_rcond, A, KL, KU, B_expr); - } - #endif - } - - - -//! solve a system of linear equations via LU decomposition (band matrix) -template -inline -bool -auxlib::solve_band_rcond_common(Mat& out, typename T1::pod_type& out_rcond, const Mat& A, const uword KL, const uword KU, const Base& B_expr) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - out_rcond = T(0); - - out = B_expr.get_ref(); - - const uword B_n_rows = out.n_rows; - const uword B_n_cols = out.n_cols; - - arma_conform_check( (A.n_rows != B_n_rows), "solve(): number of rows in given matrices must be the same", [&](){ out.soft_reset(); } ); - - if(A.is_empty() || out.is_empty()) { out.zeros(A.n_rows, B_n_cols); return true; } - - // for gbtrf, matrix AB size: 2*KL+KU+1 x N; band representation of A stored in rows KL+1 to 2*KL+KU+1 (note: fortran counts from 1) - - Mat AB; - band_helper::compress(AB, A, KL, KU, true); - - const uword N = AB.n_cols; // order of the original square matrix A - - arma_conform_assert_blas_size(AB,out); - - //char norm_id = '1'; - char trans = 'N'; - blas_int n = blas_int(N); // assuming square matrix - blas_int kl = blas_int(KL); - blas_int ku = blas_int(KU); - blas_int nrhs = blas_int(B_n_cols); - blas_int ldab = blas_int(AB.n_rows); - blas_int ldb = blas_int(B_n_rows); - blas_int info = blas_int(0); - T norm_val = T(0); - - //podarray junk(1); - podarray ipiv(N + 2); // +2 for paranoia - - // // NOTE: lapack::langb() and lapack::gbtrf() use incompatible storage formats for the band matrix - // arma_debug_print("lapack::langb()"); - // norm_val = lapack::langb(&norm_id, &n, &kl, &ku, AB.memptr(), &ldab, junk.memptr()); - - norm_val = auxlib::norm1_band(A,KL,KU); - - arma_debug_print("lapack::gbtrf()"); - lapack::gbtrf(&n, &n, &kl, &ku, AB.memptr(), &ldab, ipiv.memptr(), &info); - - if(info != 0) { return false; } - - arma_debug_print("lapack::gbtrs()"); - lapack::gbtrs(&trans, &n, &kl, &ku, &nrhs, AB.memptr(), &ldab, ipiv.memptr(), out.memptr(), &ldb, &info); - - if(info != 0) { return false; } - - out_rcond = auxlib::lu_rcond_band(AB, KL, KU, ipiv, norm_val); - - return true; - } - #else - { - arma_ignore(out); - arma_ignore(out_rcond); - arma_ignore(A); - arma_ignore(KL); - arma_ignore(KU); - arma_ignore(B_expr); - arma_stop_logic_error("solve(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! solve a system of linear equations via LU decomposition with refinement (real band matrices) -template -inline -bool -auxlib::solve_band_refine(Mat& out, typename T1::pod_type& out_rcond, Mat& A, const uword KL, const uword KU, const Base& B_expr, const bool equilibrate) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type eT; - - Mat B = B_expr.get_ref(); // B is overwritten - - arma_conform_check( (A.n_rows != B.n_rows), "solve(): number of rows in given matrices must be the same" ); - - if(A.is_empty() || B.is_empty()) { out.zeros(A.n_rows, B.n_cols); return true; } - - // for gbsvx, matrix AB size: KL+KU+1 x N; band representation of A stored in rows 1 to KL+KU+1 (note: fortran counts from 1) - - Mat AB; - band_helper::compress(AB, A, KL, KU, false); - - const uword N = AB.n_cols; - - arma_conform_assert_blas_size(AB,B); - - out.set_size(N, B.n_cols); - - Mat AFB(2*KL+KU+1, N, arma_nozeros_indicator()); - - char fact = (equilibrate) ? 'E' : 'N'; - char trans = 'N'; - char equed = char(0); - blas_int n = blas_int(N); - blas_int kl = blas_int(KL); - blas_int ku = blas_int(KU); - blas_int nrhs = blas_int(B.n_cols); - blas_int ldab = blas_int(AB.n_rows); - blas_int ldafb = blas_int(AFB.n_rows); - blas_int ldb = blas_int(B.n_rows); - blas_int ldx = blas_int(N); - blas_int info = blas_int(0); - eT rcond = eT(0); - - podarray IPIV( N); - podarray R( N); - podarray C( N); - podarray FERR( B.n_cols); - podarray BERR( B.n_cols); - podarray WORK(3*N); - podarray IWORK( N); - - arma_debug_print("lapack::gbsvx()"); - lapack::gbsvx - ( - &fact, &trans, &n, &kl, &ku, &nrhs, - AB.memptr(), &ldab, - AFB.memptr(), &ldafb, - IPIV.memptr(), - &equed, - R.memptr(), - C.memptr(), - B.memptr(), &ldb, - out.memptr(), &ldx, - &rcond, - FERR.memptr(), - BERR.memptr(), - WORK.memptr(), - IWORK.memptr(), - &info - ); - - out_rcond = rcond; - - return ((info == 0) || (info == (n+1))); - } - #else - { - arma_ignore(out); - arma_ignore(out_rcond); - arma_ignore(A); - arma_ignore(KL); - arma_ignore(KU); - arma_ignore(B_expr); - arma_ignore(equilibrate); - arma_stop_logic_error("solve(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! solve a system of linear equations via LU decomposition with refinement (complex band matrices) -template -inline -bool -auxlib::solve_band_refine(Mat< std::complex >& out, typename T1::pod_type& out_rcond, Mat< std::complex >& A, const uword KL, const uword KU, const Base,T1>& B_expr, const bool equilibrate) - { - arma_debug_sigprint(); - - #if defined(ARMA_CRIPPLED_LAPACK) - { - arma_debug_print("auxlib::solve_band_refine(): redirecting to auxlib::solve_square_refine() due to crippled LAPACK"); - - arma_ignore(KL); - arma_ignore(KU); - - return auxlib::solve_square_refine(out, out_rcond, A, B_expr, equilibrate); - } - #elif defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type T; - typedef typename std::complex eT; - - Mat B = B_expr.get_ref(); // B is overwritten - - arma_conform_check( (A.n_rows != B.n_rows), "solve(): number of rows in given matrices must be the same" ); - - if(A.is_empty() || B.is_empty()) { out.zeros(A.n_rows, B.n_cols); return true; } - - // for gbsvx, matrix AB size: KL+KU+1 x N; band representation of A stored in rows 1 to KL+KU+1 (note: fortran counts from 1) - - Mat AB; - band_helper::compress(AB, A, KL, KU, false); - - const uword N = AB.n_cols; - - arma_conform_assert_blas_size(AB,B); - - out.set_size(N, B.n_cols); - - Mat AFB(2*KL+KU+1, N, arma_nozeros_indicator()); - - char fact = (equilibrate) ? 'E' : 'N'; - char trans = 'N'; - char equed = char(0); - blas_int n = blas_int(N); - blas_int kl = blas_int(KL); - blas_int ku = blas_int(KU); - blas_int nrhs = blas_int(B.n_cols); - blas_int ldab = blas_int(AB.n_rows); - blas_int ldafb = blas_int(AFB.n_rows); - blas_int ldb = blas_int(B.n_rows); - blas_int ldx = blas_int(N); - blas_int info = blas_int(0); - T rcond = T(0); - - podarray IPIV( N); - podarray< T> R( N); - podarray< T> C( N); - podarray< T> FERR( B.n_cols); - podarray< T> BERR( B.n_cols); - podarray WORK(2*N); - podarray< T> RWORK( N); // NOTE: according to lapack 3.6.1 docs, the size of RWORK in zgbsvx is different to RWORK in dgesvx - - arma_debug_print("lapack::cx_gbsvx()"); - lapack::cx_gbsvx - ( - &fact, &trans, &n, &kl, &ku, &nrhs, - AB.memptr(), &ldab, - AFB.memptr(), &ldafb, - IPIV.memptr(), - &equed, - R.memptr(), - C.memptr(), - B.memptr(), &ldb, - out.memptr(), &ldx, - &rcond, - FERR.memptr(), - BERR.memptr(), - WORK.memptr(), - RWORK.memptr(), - &info - ); - - out_rcond = rcond; - - return ((info == 0) || (info == (n+1))); - } - #else - { - arma_ignore(out); - arma_ignore(out_rcond); - arma_ignore(A); - arma_ignore(KL); - arma_ignore(KU); - arma_ignore(B_expr); - arma_ignore(equilibrate); - arma_stop_logic_error("solve(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! solve a system of linear equations via Gaussian elimination with partial pivoting (real tridiagonal band matrix) -template -inline -bool -auxlib::solve_tridiag_fast(Mat& out, Mat& A, const Base& B_expr) - { - arma_debug_sigprint(); - - return auxlib::solve_tridiag_fast_common(out, A, B_expr); - } - - - -//! solve a system of linear equations via Gaussian elimination with partial pivoting (complex tridiagonal band matrix) -template -inline -bool -auxlib::solve_tridiag_fast(Mat< std::complex >& out, Mat< std::complex >& A, const Base< std::complex,T1>& B_expr) - { - arma_debug_sigprint(); - - #if defined(ARMA_CRIPPLED_LAPACK) - { - arma_debug_print("auxlib::solve_tridiag_fast(): redirecting to auxlib::solve_square_fast() due to crippled LAPACK"); - - return auxlib::solve_square_fast(out, A, B_expr); - } - #else - { - return auxlib::solve_tridiag_fast_common(out, A, B_expr); - } - #endif - } - - - -//! solve a system of linear equations via Gaussian elimination with partial pivoting (tridiagonal band matrix) -template -inline -bool -auxlib::solve_tridiag_fast_common(Mat& out, const Mat& A, const Base& B_expr) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::elem_type eT; - - out = B_expr.get_ref(); - - const uword B_n_rows = out.n_rows; - const uword B_n_cols = out.n_cols; - - arma_conform_check( (A.n_rows != B_n_rows), "solve(): number of rows in given matrices must be the same", [&](){ out.soft_reset(); } ); - - if(A.is_empty() || out.is_empty()) { out.zeros(A.n_rows, B_n_cols); return true; } - - Mat tridiag; - band_helper::extract_tridiag(tridiag, A); - - arma_conform_assert_blas_size(tridiag, out); - - blas_int n = blas_int(A.n_rows); - blas_int nrhs = blas_int(B_n_cols); - blas_int ldb = blas_int(B_n_rows); - blas_int info = blas_int(0); - - arma_debug_print("lapack::gtsv()"); - lapack::gtsv(&n, &nrhs, tridiag.colptr(0), tridiag.colptr(1), tridiag.colptr(2), out.memptr(), &ldb, &info); - - return (info == 0); - } - #else - { - arma_ignore(out); - arma_ignore(A); - arma_ignore(B_expr); - arma_stop_logic_error("solve(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -// -// Schur decomposition - -template -inline -bool -auxlib::schur(Mat& U, Mat& S, const Base& X, const bool calc_U) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - S = X.get_ref(); - - arma_conform_check( (S.is_square() == false), "schur(): given matrix must be square sized" ); - - if(S.is_empty()) { U.reset(); S.reset(); return true; } - - arma_conform_assert_blas_size(S); - - const uword S_n_rows = S.n_rows; - - if(calc_U) { U.set_size(S_n_rows, S_n_rows); } else { U.set_size(1,1); } - - char jobvs = calc_U ? 'V' : 'N'; - char sort = 'N'; - void* select = 0; - blas_int n = blas_int(S_n_rows); - blas_int sdim = 0; - blas_int ldvs = calc_U ? n : blas_int(1); - blas_int lwork = 64*n; // lwork_min = (std::max)(blas_int(1), 3*n) - blas_int info = 0; - - podarray wr(S_n_rows); - podarray wi(S_n_rows); - - podarray work( static_cast(lwork) ); - podarray bwork(S_n_rows); - - arma_debug_print("lapack::gees()"); - lapack::gees(&jobvs, &sort, select, &n, S.memptr(), &n, &sdim, wr.memptr(), wi.memptr(), U.memptr(), &ldvs, work.memptr(), &lwork, bwork.memptr(), &info); - - return (info == 0); - } - #else - { - arma_ignore(U); - arma_ignore(S); - arma_ignore(X); - arma_ignore(calc_U); - arma_stop_logic_error("schur(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -auxlib::schur(Mat< std::complex >& U, Mat< std::complex >& S, const Base,T1>& X, const bool calc_U) - { - arma_debug_sigprint(); - - S = X.get_ref(); - - arma_conform_check( (S.is_square() == false), "schur(): given matrix must be square sized" ); - - return auxlib::schur(U,S,calc_U); - } - - - -template -inline -bool -auxlib::schur(Mat< std::complex >& U, Mat< std::complex >& S, const bool calc_U) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef std::complex eT; - - if(S.is_empty()) { U.reset(); S.reset(); return true; } - - arma_conform_assert_blas_size(S); - - const uword S_n_rows = S.n_rows; - - if(calc_U) { U.set_size(S_n_rows, S_n_rows); } else { U.set_size(1,1); } - - char jobvs = calc_U ? 'V' : 'N'; - char sort = 'N'; - void* select = 0; - blas_int n = blas_int(S_n_rows); - blas_int sdim = 0; - blas_int ldvs = calc_U ? n : blas_int(1); - blas_int lwork = 64*n; // lwork_min = (std::max)(blas_int(1), 2*n) - blas_int info = 0; - - podarray w(S_n_rows); - podarray work( static_cast(lwork) ); - podarray< T> rwork(S_n_rows); - podarray bwork(S_n_rows); - - arma_debug_print("lapack::cx_gees()"); - lapack::cx_gees(&jobvs, &sort, select, &n, S.memptr(), &n, &sdim, w.memptr(), U.memptr(), &ldvs, work.memptr(), &lwork, rwork.memptr(), bwork.memptr(), &info); - - return (info == 0); - } - #else - { - arma_ignore(U); - arma_ignore(S); - arma_ignore(calc_U); - arma_stop_logic_error("schur(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -// -// solve the Sylvester equation AX + XB = C - -template -inline -bool -auxlib::syl(Mat& X, const Mat& A, const Mat& B, const Mat& C) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - arma_conform_check( (A.is_square() == false) || (B.is_square() == false), "syl(): given matrices must be square sized" ); - - arma_conform_check( (C.n_rows != A.n_rows) || (C.n_cols != B.n_cols), "syl(): matrices are not conformant" ); - - if(A.is_empty() || B.is_empty() || C.is_empty()) { X.reset(); return true; } - - Mat Z1, Z2, T1, T2; - - const bool status_sd1 = auxlib::schur(Z1, T1, A); - const bool status_sd2 = auxlib::schur(Z2, T2, B); - - if( (status_sd1 == false) || (status_sd2 == false) ) { return false; } - - char trana = 'N'; - char tranb = 'N'; - blas_int isgn = +1; - blas_int m = blas_int(T1.n_rows); - blas_int n = blas_int(T2.n_cols); - - eT scale = eT(0); - blas_int info = 0; - - Mat Y = trans(Z1) * C * Z2; - - arma_debug_print("lapack::trsyl()"); - lapack::trsyl(&trana, &tranb, &isgn, &m, &n, T1.memptr(), &m, T2.memptr(), &n, Y.memptr(), &m, &scale, &info); - - if(info < 0) { return false; } - - //Y /= scale; - Y /= (-scale); - - X = Z1 * Y * trans(Z2); - - return true; - } - #else - { - arma_ignore(X); - arma_ignore(A); - arma_ignore(B); - arma_ignore(C); - arma_stop_logic_error("syl(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -// -// QZ decomposition of general square real matrix pair - -template -inline -bool -auxlib::qz(Mat& A, Mat& B, Mat& vsl, Mat& vsr, const Base& X_expr, const Base& Y_expr, const char mode) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - A = X_expr.get_ref(); - B = Y_expr.get_ref(); - - arma_conform_check( ((A.is_square() == false) || (B.is_square() == false)), "qz(): given matrices must be square sized", [&](){ A.soft_reset(); B.soft_reset(); } ); - - arma_conform_check( (A.n_rows != B.n_rows), "qz(): given matrices must have the same size" ); - - if(A.is_empty()) { A.reset(); B.reset(); vsl.reset(); vsr.reset(); return true; } - - if(arma_config::check_nonfinite && A.internal_has_nonfinite()) { return false; } - if(arma_config::check_nonfinite && B.internal_has_nonfinite()) { return false; } - - arma_conform_assert_blas_size(A); - - vsl.set_size(A.n_rows, A.n_rows); - vsr.set_size(A.n_rows, A.n_rows); - - char jobvsl = 'V'; - char jobvsr = 'V'; - char eigsort = 'N'; - void* selctg = 0; - blas_int N = blas_int(A.n_rows); - blas_int sdim = 0; - blas_int lwork = 64*N+16; // lwork_min = (std::max)(blas_int(1),8*N+16) - blas_int info = 0; - - if(mode == 'l') { eigsort = 'S'; selctg = qz_helper::ptr_cast(&(qz_helper::select_lhp)); } - else if(mode == 'r') { eigsort = 'S'; selctg = qz_helper::ptr_cast(&(qz_helper::select_rhp)); } - else if(mode == 'i') { eigsort = 'S'; selctg = qz_helper::ptr_cast(&(qz_helper::select_iuc)); } - else if(mode == 'o') { eigsort = 'S'; selctg = qz_helper::ptr_cast(&(qz_helper::select_ouc)); } - - podarray alphar(A.n_rows); - podarray alphai(A.n_rows); - podarray beta(A.n_rows); - - podarray work( static_cast(lwork) ); - podarray bwork( static_cast(N) ); - - arma_debug_print("lapack::gges()"); - - lapack::gges - ( - &jobvsl, &jobvsr, &eigsort, selctg, &N, - A.memptr(), &N, B.memptr(), &N, &sdim, - alphar.memptr(), alphai.memptr(), beta.memptr(), - vsl.memptr(), &N, vsr.memptr(), &N, - work.memptr(), &lwork, bwork.memptr(), - &info - ); - - if(info != 0) { return false; } - - op_strans::apply_mat_inplace(vsl); - - return true; - } - #else - { - arma_ignore(A); - arma_ignore(B); - arma_ignore(vsl); - arma_ignore(vsr); - arma_ignore(X_expr); - arma_ignore(Y_expr); - arma_ignore(mode); - arma_stop_logic_error("qz(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -// -// QZ decomposition of general square complex matrix pair - -template -inline -bool -auxlib::qz(Mat< std::complex >& A, Mat< std::complex >& B, Mat< std::complex >& vsl, Mat< std::complex >& vsr, const Base< std::complex, T1 >& X_expr, const Base< std::complex, T2 >& Y_expr, const char mode) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename std::complex eT; - - A = X_expr.get_ref(); - B = Y_expr.get_ref(); - - arma_conform_check( ((A.is_square() == false) || (B.is_square() == false)), "qz(): given matrices must be square sized", [&](){ A.soft_reset(); B.soft_reset(); } ); - - arma_conform_check( (A.n_rows != B.n_rows), "qz(): given matrices must have the same size" ); - - if(A.is_empty()) { A.reset(); B.reset(); vsl.reset(); vsr.reset(); return true; } - - if(arma_config::check_nonfinite && A.internal_has_nonfinite()) { return false; } - if(arma_config::check_nonfinite && B.internal_has_nonfinite()) { return false; } - - arma_conform_assert_blas_size(A); - - vsl.set_size(A.n_rows, A.n_rows); - vsr.set_size(A.n_rows, A.n_rows); - - char jobvsl = 'V'; - char jobvsr = 'V'; - char eigsort = 'N'; - void* selctg = 0; - blas_int N = blas_int(A.n_rows); - blas_int sdim = 0; - blas_int lwork = 64*N; // lwork_min = (std::max)(blas_int(1),2*N) - blas_int info = 0; - - if(mode == 'l') { eigsort = 'S'; selctg = qz_helper::ptr_cast(&(qz_helper::cx_select_lhp)); } - else if(mode == 'r') { eigsort = 'S'; selctg = qz_helper::ptr_cast(&(qz_helper::cx_select_rhp)); } - else if(mode == 'i') { eigsort = 'S'; selctg = qz_helper::ptr_cast(&(qz_helper::cx_select_iuc)); } - else if(mode == 'o') { eigsort = 'S'; selctg = qz_helper::ptr_cast(&(qz_helper::cx_select_ouc)); } - - podarray alpha(A.n_rows); - podarray beta(A.n_rows); - - podarray work( static_cast(lwork) ); - podarray< T> rwork( static_cast(8*N) ); - podarray bwork( static_cast(N) ); - - arma_debug_print("lapack::cx_gges()"); - - lapack::cx_gges - ( - &jobvsl, &jobvsr, &eigsort, selctg, &N, - A.memptr(), &N, B.memptr(), &N, &sdim, - alpha.memptr(), beta.memptr(), - vsl.memptr(), &N, vsr.memptr(), &N, - work.memptr(), &lwork, rwork.memptr(), bwork.memptr(), - &info - ); - - if(info != 0) { return false; } - - op_htrans::apply_mat_inplace(vsl); - - return true; - } - #else - { - arma_ignore(A); - arma_ignore(B); - arma_ignore(vsl); - arma_ignore(vsr); - arma_ignore(X_expr); - arma_ignore(Y_expr); - arma_ignore(mode); - arma_stop_logic_error("qz(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -template -inline -eT -auxlib::rcond(Mat& A) - { - #if defined(ARMA_USE_LAPACK) - { - arma_conform_assert_blas_size(A); - - char norm_id = '1'; - blas_int m = blas_int(A.n_rows); - blas_int n = blas_int(A.n_rows); // assuming square matrix - blas_int lda = blas_int(A.n_rows); - eT norm_val = eT(0); - eT rcond = eT(0); - blas_int info = blas_int(0); - - podarray work(4*A.n_rows); - podarray iwork( A.n_rows); - podarray ipiv( (std::min)(A.n_rows, A.n_cols) ); - - arma_debug_print("lapack::lange()"); - norm_val = (has_blas_float_bug::value) ? auxlib::norm1_gen(A) : lapack::lange(&norm_id, &m, &n, A.memptr(), &lda, work.memptr()); - - arma_debug_print("lapack::getrf()"); - lapack::getrf(&m, &n, A.memptr(), &lda, ipiv.memptr(), &info); - - if(info != blas_int(0)) { return eT(0); } - - arma_debug_print("lapack::gecon()"); - lapack::gecon(&norm_id, &n, A.memptr(), &lda, &norm_val, &rcond, work.memptr(), iwork.memptr(), &info); - - if(info != blas_int(0)) { return eT(0); } - - return rcond; - } - #else - { - arma_ignore(A); - arma_stop_logic_error("rcond(): use of LAPACK must be enabled"); - return eT(0); - } - #endif - } - - - -template -inline -T -auxlib::rcond(Mat< std::complex >& A) - { - #if defined(ARMA_USE_LAPACK) - { - typedef typename std::complex eT; - - arma_conform_assert_blas_size(A); - - char norm_id = '1'; - blas_int m = blas_int(A.n_rows); - blas_int n = blas_int(A.n_rows); // assuming square matrix - blas_int lda = blas_int(A.n_rows); - T norm_val = T(0); - T rcond = T(0); - blas_int info = blas_int(0); - - podarray< T> junk(1); - podarray work(2*A.n_rows); - podarray< T> rwork(2*A.n_rows); - podarray ipiv( (std::min)(A.n_rows, A.n_cols) ); - - arma_debug_print("lapack::lange()"); - norm_val = (has_blas_float_bug::value) ? auxlib::norm1_gen(A) : lapack::lange(&norm_id, &m, &n, A.memptr(), &lda, junk.memptr()); - - arma_debug_print("lapack::getrf()"); - lapack::getrf(&m, &n, A.memptr(), &lda, ipiv.memptr(), &info); - - if(info != blas_int(0)) { return T(0); } - - arma_debug_print("lapack::cx_gecon()"); - lapack::cx_gecon(&norm_id, &n, A.memptr(), &lda, &norm_val, &rcond, work.memptr(), rwork.memptr(), &info); - - if(info != blas_int(0)) { return T(0); } - - return rcond; - } - #else - { - arma_ignore(A); - arma_stop_logic_error("rcond(): use of LAPACK must be enabled"); - return T(0); - } - #endif - } - - - -template -inline -eT -auxlib::rcond_sympd(Mat& A, bool& calc_ok) - { - #if defined(ARMA_USE_LAPACK) - { - arma_conform_assert_blas_size(A); - - calc_ok = false; - - char norm_id = '1'; - char uplo = 'L'; - blas_int n = blas_int(A.n_rows); // assuming square matrix - blas_int lda = blas_int(A.n_rows); - eT norm_val = eT(0); - eT rcond = eT(0); - blas_int info = blas_int(0); - - podarray work(3*A.n_rows); - podarray iwork( A.n_rows); - - arma_debug_print("lapack::lansy()"); - norm_val = (has_blas_float_bug::value) ? auxlib::norm1_sym(A) : lapack::lansy(&norm_id, &uplo, &n, A.memptr(), &lda, work.memptr()); - - arma_debug_print("lapack::potrf()"); - lapack::potrf(&uplo, &n, A.memptr(), &lda, &info); - - if(info != blas_int(0)) { return eT(0); } - - arma_debug_print("lapack::pocon()"); - lapack::pocon(&uplo, &n, A.memptr(), &lda, &norm_val, &rcond, work.memptr(), iwork.memptr(), &info); - - if(info != blas_int(0)) { return eT(0); } - - calc_ok = true; - - return rcond; - } - #else - { - arma_ignore(A); - calc_ok = false; - arma_stop_logic_error("rcond(): use of LAPACK must be enabled"); - return eT(0); - } - #endif - } - - - -template -inline -T -auxlib::rcond_sympd(Mat< std::complex >& A, bool& calc_ok) - { - #if defined(ARMA_CRIPPLED_LAPACK) - { - arma_debug_print("auxlib::rcond_sympd(): redirecting to auxlib::rcond() due to crippled LAPACK"); - - calc_ok = true; - - return auxlib::rcond(A); - } - #elif defined(ARMA_USE_LAPACK) - { - typedef typename std::complex eT; - - arma_conform_assert_blas_size(A); - - calc_ok = false; - - char norm_id = '1'; - char uplo = 'L'; - blas_int n = blas_int(A.n_rows); // assuming square matrix - blas_int lda = blas_int(A.n_rows); - T norm_val = T(0); - T rcond = T(0); - blas_int info = blas_int(0); - - podarray work(2*A.n_rows); - podarray< T> rwork( A.n_rows); - - arma_debug_print("lapack::lanhe()"); - norm_val = (has_blas_float_bug::value) ? auxlib::norm1_sym(A) : lapack::lanhe(&norm_id, &uplo, &n, A.memptr(), &lda, rwork.memptr()); - - arma_debug_print("lapack::potrf()"); - lapack::potrf(&uplo, &n, A.memptr(), &lda, &info); - - if(info != blas_int(0)) { return T(0); } - - arma_debug_print("lapack::cx_pocon()"); - lapack::cx_pocon(&uplo, &n, A.memptr(), &lda, &norm_val, &rcond, work.memptr(), rwork.memptr(), &info); - - if(info != blas_int(0)) { return T(0); } - - calc_ok = true; - - return rcond; - } - #else - { - arma_ignore(A); - calc_ok = false; - arma_stop_logic_error("rcond(): use of LAPACK must be enabled"); - return T(0); - } - #endif - } - - - -template -inline -eT -auxlib::rcond_trimat(const Mat& A, const uword layout) - { - #if defined(ARMA_USE_LAPACK) - { - arma_conform_assert_blas_size(A); - - char norm_id = '1'; - char uplo = (layout == 0) ? 'U' : 'L'; - char diag = 'N'; - blas_int n = blas_int(A.n_rows); // assuming square matrix - eT rcond = eT(0); - blas_int info = blas_int(0); - - podarray work(3*A.n_rows); - podarray iwork( A.n_rows); - - arma_debug_print("lapack::trcon()"); - lapack::trcon(&norm_id, &uplo, &diag, &n, A.memptr(), &n, &rcond, work.memptr(), iwork.memptr(), &info); - - if(info != blas_int(0)) { return eT(0); } - - return rcond; - } - #else - { - arma_ignore(A); - arma_ignore(layout); - arma_stop_logic_error("rcond(): use of LAPACK must be enabled"); - return eT(0); - } - #endif - } - - - -template -inline -T -auxlib::rcond_trimat(const Mat< std::complex >& A, const uword layout) - { - #if defined(ARMA_USE_LAPACK) - { - typedef typename std::complex eT; - - arma_conform_assert_blas_size(A); - - char norm_id = '1'; - char uplo = (layout == 0) ? 'U' : 'L'; - char diag = 'N'; - blas_int n = blas_int(A.n_rows); // assuming square matrix - T rcond = T(0); - blas_int info = blas_int(0); - - podarray work(2*A.n_rows); - podarray< T> rwork( A.n_rows); - - arma_debug_print("lapack::cx_trcon()"); - lapack::cx_trcon(&norm_id, &uplo, &diag, &n, A.memptr(), &n, &rcond, work.memptr(), rwork.memptr(), &info); - - if(info != blas_int(0)) { return T(0); } - - return rcond; - } - #else - { - arma_ignore(A); - arma_ignore(layout); - arma_stop_logic_error("rcond(): use of LAPACK must be enabled"); - return T(0); - } - #endif - } - - - -template -inline -eT -auxlib::lu_rcond(const Mat& A, const eT norm_val) - { - #if defined(ARMA_USE_LAPACK) - { - char norm_id = '1'; - blas_int n = blas_int(A.n_rows); // assuming square matrix - blas_int lda = blas_int(A.n_rows); - eT rcond = eT(0); - blas_int info = blas_int(0); - - podarray work(4*A.n_rows); - podarray iwork( A.n_rows); - - arma_debug_print("lapack::gecon()"); - lapack::gecon(&norm_id, &n, A.memptr(), &lda, &norm_val, &rcond, work.memptr(), iwork.memptr(), &info); - - if(info != blas_int(0)) { return eT(0); } - - return rcond; - } - #else - { - arma_ignore(A); - arma_ignore(norm_val); - return eT(0); - } - #endif - } - - - -template -inline -T -auxlib::lu_rcond(const Mat< std::complex >& A, const T norm_val) - { - #if defined(ARMA_USE_LAPACK) - { - typedef typename std::complex eT; - - char norm_id = '1'; - blas_int n = blas_int(A.n_rows); // assuming square matrix - blas_int lda = blas_int(A.n_rows); - T rcond = T(0); - blas_int info = blas_int(0); - - podarray work(2*A.n_rows); - podarray< T> rwork(2*A.n_rows); - - arma_debug_print("lapack::cx_gecon()"); - lapack::cx_gecon(&norm_id, &n, A.memptr(), &lda, &norm_val, &rcond, work.memptr(), rwork.memptr(), &info); - - if(info != blas_int(0)) { return T(0); } - - return rcond; - } - #else - { - arma_ignore(A); - arma_ignore(norm_val); - return T(0); - } - #endif - } - - - -template -inline -eT -auxlib::lu_rcond_sympd(const Mat& A, const eT norm_val) - { - #if defined(ARMA_USE_LAPACK) - { - char uplo = 'L'; - blas_int n = blas_int(A.n_rows); // assuming square matrix - eT rcond = eT(0); - blas_int info = blas_int(0); - - podarray work(3*A.n_rows); - podarray iwork( A.n_rows); - - arma_debug_print("lapack::pocon()"); - lapack::pocon(&uplo, &n, A.memptr(), &n, &norm_val, &rcond, work.memptr(), iwork.memptr(), &info); - - if(info != blas_int(0)) { return eT(0); } - - return rcond; - } - #else - { - arma_ignore(A); - arma_ignore(norm_val); - return eT(0); - } - #endif - } - - - -template -inline -T -auxlib::lu_rcond_sympd(const Mat< std::complex >& A, const T norm_val) - { - #if defined(ARMA_CRIPPLED_LAPACK) - { - arma_ignore(A); - arma_ignore(norm_val); - return T(0); - } - #elif defined(ARMA_USE_LAPACK) - { - typedef typename std::complex eT; - - char uplo = 'L'; - blas_int n = blas_int(A.n_rows); // assuming square matrix - T rcond = T(0); - blas_int info = blas_int(0); - - podarray work(2*A.n_rows); - podarray< T> rwork( A.n_rows); - - arma_debug_print("lapack::cx_pocon()"); - lapack::cx_pocon(&uplo, &n, A.memptr(), &n, &norm_val, &rcond, work.memptr(), rwork.memptr(), &info); - - if(info != blas_int(0)) { return T(0); } - - return rcond; - } - #else - { - arma_ignore(A); - arma_ignore(norm_val); - return T(0); - } - #endif - } - - - -template -inline -eT -auxlib::lu_rcond_band(const Mat& AB, const uword KL, const uword KU, const podarray& ipiv, const eT norm_val) - { - #if defined(ARMA_USE_LAPACK) - { - const uword N = AB.n_cols; // order of the original square matrix A - - char norm_id = '1'; - blas_int n = blas_int(N); - blas_int kl = blas_int(KL); - blas_int ku = blas_int(KU); - blas_int ldab = blas_int(AB.n_rows); - eT rcond = eT(0); - blas_int info = blas_int(0); - - podarray work(3*N); - podarray iwork( N); - - arma_debug_print("lapack::gbcon()"); - lapack::gbcon(&norm_id, &n, &kl, &ku, AB.memptr(), &ldab, ipiv.memptr(), &norm_val, &rcond, work.memptr(), iwork.memptr(), &info); - - if(info != blas_int(0)) { return eT(0); } - - return rcond; - } - #else - { - arma_ignore(AB); - arma_ignore(KL); - arma_ignore(KU); - arma_ignore(ipiv); - arma_ignore(norm_val); - return eT(0); - } - #endif - } - - - -template -inline -T -auxlib::lu_rcond_band(const Mat< std::complex >& AB, const uword KL, const uword KU, const podarray& ipiv, const T norm_val) - { - #if defined(ARMA_CRIPPLED_LAPACK) - { - arma_ignore(AB); - arma_ignore(KL); - arma_ignore(KU); - arma_ignore(ipiv); - arma_ignore(norm_val); - return T(0); - } - #elif defined(ARMA_USE_LAPACK) - { - typedef typename std::complex eT; - - const uword N = AB.n_cols; // order of the original square matrix A - - char norm_id = '1'; - blas_int n = blas_int(N); - blas_int kl = blas_int(KL); - blas_int ku = blas_int(KU); - blas_int ldab = blas_int(AB.n_rows); - T rcond = T(0); - blas_int info = blas_int(0); - - podarray work(2*N); - podarray< T> rwork( N); - - arma_debug_print("lapack::cx_gbcon()"); - lapack::cx_gbcon(&norm_id, &n, &kl, &ku, AB.memptr(), &ldab, ipiv.memptr(), &norm_val, &rcond, work.memptr(), rwork.memptr(), &info); - - if(info != blas_int(0)) { return T(0); } - - return rcond; - } - #else - { - arma_ignore(AB); - arma_ignore(KL); - arma_ignore(KU); - arma_ignore(ipiv); - arma_ignore(norm_val); - return T(0); - } - #endif - } - - - -template -inline -bool -auxlib::crippled_lapack(const Base&) - { - #if defined(ARMA_CRIPPLED_LAPACK) - { - arma_debug_print("auxlib::crippled_lapack(): true"); - - return (is_cx::yes); - } - #else - { - return false; - } - #endif - } - - - -template -inline -bool -auxlib::rudimentary_sym_check(const Mat& X) - { - arma_debug_sigprint(); - - const uword N = X.n_rows; - const uword Nm2 = N-2; - - if(N != X.n_cols) { return false; } - if(N <= uword(1)) { return true; } - - const eT* X_mem = X.memptr(); - - const eT* X_offsetA = &(X_mem[Nm2 ]); - const eT* X_offsetB = &(X_mem[Nm2*N]); - - const eT A1 = *(X_offsetA ); - const eT A2 = *(X_offsetA+1); // bottom-left corner (ie. last value in first column) - const eT B1 = *(X_offsetB ); - const eT B2 = *(X_offsetB+N); // top-right corner (ie. first value in last column) - - const eT C1 = (std::max)(std::abs(A1), std::abs(B1)); - const eT C2 = (std::max)(std::abs(A2), std::abs(B2)); - - const eT delta1 = std::abs(A1 - B1); - const eT delta2 = std::abs(A2 - B2); - - const eT tol = eT(10000)*std::numeric_limits::epsilon(); // allow some leeway - - const bool okay1 = ( (delta1 <= tol) || (delta1 <= (C1 * tol)) ); - const bool okay2 = ( (delta2 <= tol) || (delta2 <= (C2 * tol)) ); - - return (okay1 && okay2); - } - - - -template -inline -bool -auxlib::rudimentary_sym_check(const Mat< std::complex >& X) - { - arma_debug_sigprint(); - - // NOTE: the function name is a misnomer, as it checks for hermitian complex matrices; - // NOTE: for simplicity of use, the function name is the same as for real matrices - - typedef typename std::complex eT; - - const uword N = X.n_rows; - const uword Nm1 = N-1; - - if(N != X.n_cols) { return false; } - if(N == uword(0)) { return true; } - - const eT* X_mem = X.memptr(); - - const T tol = T(10000)*std::numeric_limits::epsilon(); // allow some leeway - - if(std::abs(X_mem[0 ].imag()) > tol) { return false; } // check top-left - if(std::abs(X_mem[X.n_elem-1].imag()) > tol) { return false; } // check bottom-right - - const eT& A = X_mem[Nm1 ]; // bottom-left corner (ie. last value in first column) - const eT& B = X_mem[Nm1*N]; // top-right corner (ie. first value in last column) - - const T C_real = (std::max)(std::abs(A.real()), std::abs(B.real())); - const T C_imag = (std::max)(std::abs(A.imag()), std::abs(B.imag())); - - const T delta_real = std::abs(A.real() - B.real()); - const T delta_imag = std::abs(A.imag() + B.imag()); // take into account the conjugate - - const bool okay_real = ( (delta_real <= tol) || (delta_real <= (C_real * tol)) ); - const bool okay_imag = ( (delta_imag <= tol) || (delta_imag <= (C_imag * tol)) ); - - return (okay_real && okay_imag); - } - - - -template -inline -typename get_pod_type::result -auxlib::norm1_gen(const Mat& A) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - if(A.n_elem == 0) { return T(0); } - - const uword n_rows = A.n_rows; - const uword n_cols = A.n_cols; - - T max_val = T(0); - - for(uword c=0; c < n_cols; ++c) - { - const eT* colmem = A.colptr(c); - T acc_val = T(0); - - for(uword r=0; r < n_rows; ++r) { acc_val += std::abs(colmem[r]); } - - max_val = (acc_val > max_val) ? acc_val : max_val; - } - - return max_val; - } - - - -template -inline -typename get_pod_type::result -auxlib::norm1_sym(const Mat& A) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - if(A.n_elem == 0) { return T(0); } - - const uword N = (std::min)(A.n_rows, A.n_cols); - - T max_val = T(0); - - for(uword col=0; col < N; ++col) - { - const eT* colmem = A.colptr(col); - T acc_val = T(0); - - for(uword c=0; c < col; ++c) { acc_val += std::abs(A.at(col,c)); } - - for(uword r=col; r < N; ++r) { acc_val += std::abs(colmem[r]); } - - max_val = (acc_val > max_val) ? acc_val : max_val; - } - - return max_val; - } - - - -template -inline -typename get_pod_type::result -auxlib::norm1_band(const Mat& A, const uword KL, const uword KU) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - if(A.n_elem == 0) { return T(0); } - - const uword n_rows = A.n_rows; - const uword n_cols = A.n_cols; - - T max_val = T(0); - - for(uword c=0; c < n_cols; ++c) - { - const eT* colmem = A.colptr(c); - T acc_val = T(0); - - // use values only from main diagonal + KU upper diagonals + KL lower diagonals - - const uword start = ( c > KU ) ? (c - KU) : 0; - const uword end = ((c + KL) < n_rows) ? (c + KL) : (n_rows-1); - - for(uword r=start; r <= end; ++r) { acc_val += std::abs(colmem[r]); } - - max_val = (acc_val > max_val) ? acc_val : max_val; - } - - return max_val; - } - - - -// - - - -namespace qz_helper -{ - -// sgges() and dgges() require an external function with three arguments: -// select(alpha_real, alpha_imag, beta) -// where the eigenvalue is defined as complex(alpha_real, alpha_imag) / beta - -template -inline -blas_int -select_lhp(const T* x_ptr, const T* y_ptr, const T* z_ptr) - { - arma_debug_sigprint(); - - // cout << "select_lhp(): (*x_ptr) = " << (*x_ptr) << endl; - // cout << "select_lhp(): (*y_ptr) = " << (*y_ptr) << endl; - // cout << "select_lhp(): (*z_ptr) = " << (*z_ptr) << endl; - - arma_ignore(y_ptr); // ignore imaginary part - - const T x = (*x_ptr); - const T z = (*z_ptr); - - if(z == T(0)) { return blas_int(0); } // consider an infinite eig value not to lie in either lhp or rhp - - return ((x/z) < T(0)) ? blas_int(1) : blas_int(0); - } - - - -template -inline -blas_int -select_rhp(const T* x_ptr, const T* y_ptr, const T* z_ptr) - { - arma_debug_sigprint(); - - // cout << "select_rhp(): (*x_ptr) = " << (*x_ptr) << endl; - // cout << "select_rhp(): (*y_ptr) = " << (*y_ptr) << endl; - // cout << "select_rhp(): (*z_ptr) = " << (*z_ptr) << endl; - - arma_ignore(y_ptr); // ignore imaginary part - - const T x = (*x_ptr); - const T z = (*z_ptr); - - if(z == T(0)) { return blas_int(0); } // consider an infinite eig value not to lie in either lhp or rhp - - return ((x/z) > T(0)) ? blas_int(1) : blas_int(0); - } - - - -template -inline -blas_int -select_iuc(const T* x_ptr, const T* y_ptr, const T* z_ptr) - { - arma_debug_sigprint(); - - // cout << "select_iuc(): (*x_ptr) = " << (*x_ptr) << endl; - // cout << "select_iuc(): (*y_ptr) = " << (*y_ptr) << endl; - // cout << "select_iuc(): (*z_ptr) = " << (*z_ptr) << endl; - - const T x = (*x_ptr); - const T y = (*y_ptr); - const T z = (*z_ptr); - - if(z == T(0)) { return blas_int(0); } // consider an infinite eig value to be outside of the unit circle - - //return (std::abs(std::complex(x,y) / z) < T(1)) ? blas_int(1) : blas_int(0); - return (std::sqrt(x*x + y*y) < std::abs(z)) ? blas_int(1) : blas_int(0); - } - - - -template -inline -blas_int -select_ouc(const T* x_ptr, const T* y_ptr, const T* z_ptr) - { - arma_debug_sigprint(); - - // cout << "select_ouc(): (*x_ptr) = " << (*x_ptr) << endl; - // cout << "select_ouc(): (*y_ptr) = " << (*y_ptr) << endl; - // cout << "select_ouc(): (*z_ptr) = " << (*z_ptr) << endl; - - const T x = (*x_ptr); - const T y = (*y_ptr); - const T z = (*z_ptr); - - if(z == T(0)) - { - return (x == T(0)) ? blas_int(0) : blas_int(1); // consider an infinite eig value to be outside of the unit circle - } - - //return (std::abs(std::complex(x,y) / z) > T(1)) ? blas_int(1) : blas_int(0); - return (std::sqrt(x*x + y*y) > std::abs(z)) ? blas_int(1) : blas_int(0); - } - - - -// cgges() and zgges() require an external function with two arguments: -// select(alpha, beta) -// where the complex eigenvalue is defined as (alpha / beta) - -template -inline -blas_int -cx_select_lhp(const std::complex* x_ptr, const std::complex* y_ptr) - { - arma_debug_sigprint(); - - // cout << "cx_select_lhp(): (*x_ptr) = " << (*x_ptr) << endl; - // cout << "cx_select_lhp(): (*y_ptr) = " << (*y_ptr) << endl; - - const std::complex& x = (*x_ptr); - const std::complex& y = (*y_ptr); - - if( (y.real() == T(0)) && (y.imag() == T(0)) ) { return blas_int(0); } // consider an infinite eig value not to lie in either lhp or rhp - - return (std::real(x / y) < T(0)) ? blas_int(1) : blas_int(0); - } - - - -template -inline -blas_int -cx_select_rhp(const std::complex* x_ptr, const std::complex* y_ptr) - { - arma_debug_sigprint(); - - // cout << "cx_select_rhp(): (*x_ptr) = " << (*x_ptr) << endl; - // cout << "cx_select_rhp(): (*y_ptr) = " << (*y_ptr) << endl; - - const std::complex& x = (*x_ptr); - const std::complex& y = (*y_ptr); - - if( (y.real() == T(0)) && (y.imag() == T(0)) ) { return blas_int(0); } // consider an infinite eig value not to lie in either lhp or rhp - - return (std::real(x / y) > T(0)) ? blas_int(1) : blas_int(0); - } - - - -template -inline -blas_int -cx_select_iuc(const std::complex* x_ptr, const std::complex* y_ptr) - { - arma_debug_sigprint(); - - // cout << "cx_select_iuc(): (*x_ptr) = " << (*x_ptr) << endl; - // cout << "cx_select_iuc(): (*y_ptr) = " << (*y_ptr) << endl; - - const std::complex& x = (*x_ptr); - const std::complex& y = (*y_ptr); - - if( (y.real() == T(0)) && (y.imag() == T(0)) ) { return blas_int(0); } // consider an infinite eig value to be outside of the unit circle - - return (std::abs(x / y) < T(1)) ? blas_int(1) : blas_int(0); - } - - - -template -inline -blas_int -cx_select_ouc(const std::complex* x_ptr, const std::complex* y_ptr) - { - arma_debug_sigprint(); - - // cout << "cx_select_ouc(): (*x_ptr) = " << (*x_ptr) << endl; - // cout << "cx_select_ouc(): (*y_ptr) = " << (*y_ptr) << endl; - - const std::complex& x = (*x_ptr); - const std::complex& y = (*y_ptr); - - if( (y.real() == T(0)) && (y.imag() == T(0)) ) - { - return ((x.real() == T(0)) && (x.imag() == T(0))) ? blas_int(0) : blas_int(1); // consider an infinite eig value to be outside of the unit circle - } - - return (std::abs(x / y) > T(1)) ? blas_int(1) : blas_int(0); - } - - - -// need to do shenanigans with pointers due to: -// - we're using LAPACK ?gges() defined to expect pointer-to-function to be passed as pointer-to-object -// - explicit casting between pointer-to-function and pointer-to-object is a non-standard extension in C -// - the extension is essentially mandatory on POSIX systems -// - some compilers will complain about the extension in pedantic mode - -template -inline -void_ptr -ptr_cast(blas_int (*function)(const T*, const T*, const T*)) - { - union converter - { - blas_int (*fn)(const T*, const T*, const T*); - void_ptr obj; - }; - - converter tmp; - - tmp.obj = 0; - tmp.fn = function; - - return tmp.obj; - } - - - -template -inline -void_ptr -ptr_cast(blas_int (*function)(const std::complex*, const std::complex*)) - { - union converter - { - blas_int (*fn)(const std::complex*, const std::complex*); - void_ptr obj; - }; - - converter tmp; - - tmp.obj = 0; - tmp.fn = function; - - return tmp.obj; - } - - - -} // end of namespace qz_helper - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/band_helper.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/band_helper.hpp deleted file mode 100644 index 36a2ce384..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/band_helper.hpp +++ /dev/null @@ -1,379 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup band_helper -//! @{ - - -namespace band_helper -{ - - - -template -inline -bool -is_band(uword& out_KL, uword& out_KU, const Mat& A, const uword N_min) - { - arma_debug_sigprint(); - - // NOTE: assuming that A has a square size - // NOTE: assuming that N_min is >= 4 - - const uword N = A.n_rows; - - if(N < N_min) { return false; } - - // first, quickly check bottom-left and top-right corners - - const eT eT_zero = eT(0); - - const eT* A_col0 = A.memptr(); - const eT* A_col1 = A_col0 + N; - - if( (A_col0[N-2] != eT_zero) || (A_col0[N-1] != eT_zero) || (A_col1[N-2] != eT_zero) || (A_col1[N-1] != eT_zero) ) { return false; } - - const eT* A_colNm2 = A.colptr(N-2); - const eT* A_colNm1 = A_colNm2 + N; - - if( (A_colNm2[0] != eT_zero) || (A_colNm2[1] != eT_zero) || (A_colNm1[0] != eT_zero) || (A_colNm1[1] != eT_zero) ) { return false; } - - // if we reached this point, go through the entire matrix to work out number of subdiagonals and superdiagonals - - const uword n_nonzero_threshold = (N*N)/4; // empirically determined - - uword KL = 0; // number of subdiagonals - uword KU = 0; // number of superdiagonals - - const eT* A_colptr = A.memptr(); - - for(uword col=0; col < N; ++col) - { - uword first_nonzero_row = col; - uword last_nonzero_row = col; - - for(uword row=0; row < col; ++row) - { - if( A_colptr[row] != eT_zero ) { first_nonzero_row = row; break; } - } - - for(uword row=(col+1); row < N; ++row) - { - last_nonzero_row = (A_colptr[row] != eT_zero) ? row : last_nonzero_row; - } - - const uword L_count = last_nonzero_row - col; - const uword U_count = col - first_nonzero_row; - - if( (L_count > KL) || (U_count > KU) ) - { - KL = (std::max)(KL, L_count); - KU = (std::max)(KU, U_count); - - const uword n_nonzero = N*(KL+KU+1) - (KL*(KL+1) + KU*(KU+1))/2; - - // return as soon as we know that it's not worth analysing the matrix any further - - if(n_nonzero > n_nonzero_threshold) { return false; } - } - - A_colptr += N; - } - - out_KL = KL; - out_KU = KU; - - return true; - } - - - -template -inline -bool -is_band_lower(uword& out_KD, const Mat& A, const uword N_min) - { - arma_debug_sigprint(); - - // NOTE: assuming that A has a square size - // NOTE: assuming that N_min is >= 4 - - const uword N = A.n_rows; - - if(N < N_min) { return false; } - - // first, quickly check bottom-left corner - - const eT eT_zero = eT(0); - - const eT* A_col0 = A.memptr(); - const eT* A_col1 = A_col0 + N; - - if( (A_col0[N-2] != eT_zero) || (A_col0[N-1] != eT_zero) || (A_col1[N-2] != eT_zero) || (A_col1[N-1] != eT_zero) ) { return false; } - - // if we reached this point, go through the bottom triangle to work out number of subdiagonals - - const uword n_nonzero_threshold = ( N*N - (N*(N-1))/2 ) / 4; // empirically determined - - uword KL = 0; // number of subdiagonals - - const eT* A_colptr = A.memptr(); - - for(uword col=0; col < N; ++col) - { - uword last_nonzero_row = col; - - for(uword row=(col+1); row < N; ++row) - { - last_nonzero_row = (A_colptr[row] != eT_zero) ? row : last_nonzero_row; - } - - const uword L_count = last_nonzero_row - col; - - if(L_count > KL) - { - KL = L_count; - - const uword n_nonzero = N*(KL+1) - (KL*(KL+1))/2; - - // return as soon as we know that it's not worth analysing the matrix any further - - if(n_nonzero > n_nonzero_threshold) { return false; } - } - - A_colptr += N; - } - - out_KD = KL; - - return true; - } - - - -template -inline -bool -is_band_upper(uword& out_KD, const Mat& A, const uword N_min) - { - arma_debug_sigprint(); - - // NOTE: assuming that A has a square size - // NOTE: assuming that N_min is >= 4 - - const uword N = A.n_rows; - - if(N < N_min) { return false; } - - // first, quickly check top-right corner - - const eT eT_zero = eT(0); - - const eT* A_colNm2 = A.colptr(N-2); - const eT* A_colNm1 = A_colNm2 + N; - - if( (A_colNm2[0] != eT_zero) || (A_colNm2[1] != eT_zero) || (A_colNm1[0] != eT_zero) || (A_colNm1[1] != eT_zero) ) { return false; } - - // if we reached this point, go through the entire matrix to work out number of superdiagonals - - const uword n_nonzero_threshold = ( N*N - (N*(N-1))/2 ) / 4; // empirically determined - - uword KU = 0; // number of superdiagonals - - const eT* A_colptr = A.memptr(); - - for(uword col=0; col < N; ++col) - { - uword first_nonzero_row = col; - - for(uword row=0; row < col; ++row) - { - if( A_colptr[row] != eT_zero ) { first_nonzero_row = row; break; } - } - - const uword U_count = col - first_nonzero_row; - - if(U_count > KU) - { - KU = U_count; - - const uword n_nonzero = N*(KU+1) - (KU*(KU+1))/2; - - // return as soon as we know that it's not worth analysing the matrix any further - - if(n_nonzero > n_nonzero_threshold) { return false; } - } - - A_colptr += N; - } - - out_KD = KU; - - return true; - } - - - -template -inline -void -compress(Mat& AB, const Mat& A, const uword KL, const uword KU, const bool use_offset) - { - arma_debug_sigprint(); - - // NOTE: assuming that A has a square size - - // band matrix storage format - // http://www.netlib.org/lapack/lug/node124.html - - // for ?gbsv, matrix AB size: 2*KL+KU+1 x N; band representation of A stored in rows KL+1 to 2*KL+KU+1 (note: fortran counts from 1) - // for ?gbsvx, matrix AB size: KL+KU+1 x N; band representaiton of A stored in rows 1 to KL+KU+1 (note: fortran counts from 1) - // - // the +1 in the above formulas is to take into account the main diagonal - - const uword AB_n_rows = (use_offset) ? uword(2*KL + KU + 1) : uword(KL + KU + 1); - const uword N = A.n_rows; - - AB.set_size(AB_n_rows, N); - - if(A.is_empty()) { AB.zeros(); return; } - - if(AB_n_rows == uword(1)) - { - eT* AB_mem = AB.memptr(); - - for(uword i=0; i KU) ? uword(j - KU) : uword(0); - const uword A_row_endp1 = (std::min)(N, j+KL+1); - - const uword length = A_row_endp1 - A_row_start; - - const uword AB_row_start = (KU > j) ? (KU - j) : uword(0); - - const eT* A_colptr = A.colptr(j) + A_row_start; - eT* AB_colptr = AB.colptr(j) + AB_row_start + ( (use_offset) ? KL : uword(0) ); - - arrayops::copy( AB_colptr, A_colptr, length ); - } - } - } - - - -template -inline -void -uncompress(Mat& A, const Mat& AB, const uword KL, const uword KU, const bool use_offset) - { - arma_debug_sigprint(); - - const uword AB_n_rows = AB.n_rows; - const uword N = AB.n_cols; - - arma_conform_check( (AB_n_rows != ((use_offset) ? uword(2*KL + KU + 1) : uword(KL + KU + 1))), "band_helper::uncompress(): detected inconsistency" ); - - A.zeros(N,N); // assuming there is no aliasing between A and AB - - if(AB_n_rows == uword(1)) - { - const eT* AB_mem = AB.memptr(); - - for(uword i=0; i KU) ? uword(j - KU) : uword(0); - const uword A_row_endp1 = (std::min)(N, j+KL+1); - - const uword length = A_row_endp1 - A_row_start; - - const uword AB_row_start = (KU > j) ? (KU - j) : uword(0); - - const eT* AB_colptr = AB.colptr(j) + AB_row_start + ( (use_offset) ? KL : uword(0) ); - eT* A_colptr = A.colptr(j) + A_row_start; - - arrayops::copy( A_colptr, AB_colptr, length ); - } - } - } - - - -template -inline -void -extract_tridiag(Mat& out, const Mat& A) - { - arma_debug_sigprint(); - - // NOTE: assuming that A has a square size and is at least 2x2 - - const uword N = A.n_rows; - - out.set_size(N, 3); // assuming there is no aliasing between 'out' and 'A' - - if(N < 2) { return; } - - eT* DL = out.colptr(0); - eT* DD = out.colptr(1); - eT* DU = out.colptr(2); - - DD[0] = A[0]; - DL[0] = A[1]; - - const uword Nm1 = N-1; - const uword Nm2 = N-2; - - for(uword i=0; i < Nm2; ++i) - { - const uword ip1 = i+1; - - const eT* data = &(A.at(i, ip1)); - - const eT tmp0 = data[0]; - const eT tmp1 = data[1]; - const eT tmp2 = data[2]; - - DL[ip1] = tmp2; - DD[ip1] = tmp1; - DU[i ] = tmp0; - } - - const eT* data = &(A.at(Nm2, Nm1)); - - DL[Nm1] = 0; - DU[Nm2] = data[0]; - DU[Nm1] = 0; - DD[Nm1] = data[1]; - } - - - -} // end of namespace band_helper - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/compiler_check.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/compiler_check.hpp deleted file mode 100644 index 18ea59a19..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/compiler_check.hpp +++ /dev/null @@ -1,95 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -#undef ARMA_HAVE_CXX11 -#undef ARMA_HAVE_CXX14 -#undef ARMA_HAVE_CXX17 -#undef ARMA_HAVE_CXX20 -#undef ARMA_HAVE_CXX23 - -#if (__cplusplus >= 201103L) - #define ARMA_HAVE_CXX11 -#endif - -#if (__cplusplus >= 201402L) - #define ARMA_HAVE_CXX14 -#endif - -#if (__cplusplus >= 201703L) - #define ARMA_HAVE_CXX17 -#endif - -#if (__cplusplus >= 202002L) - #define ARMA_HAVE_CXX20 -#endif - -#if (__cplusplus >= 202302L) - #define ARMA_HAVE_CXX23 -#endif - - -// MS really can't get its proverbial shit together -#if defined(_MSVC_LANG) - - #if (_MSVC_LANG >= 201402L) - #undef ARMA_HAVE_CXX11 - #define ARMA_HAVE_CXX11 - - #undef ARMA_HAVE_CXX14 - #define ARMA_HAVE_CXX14 - #endif - - #if (_MSVC_LANG >= 201703L) - #undef ARMA_HAVE_CXX17 - #define ARMA_HAVE_CXX17 - #endif - - #if (_MSVC_LANG >= 202002L) - #undef ARMA_HAVE_CXX20 - #define ARMA_HAVE_CXX20 - #endif - - #if (_MSVC_LANG >= 202302L) - #undef ARMA_HAVE_CXX23 - #define ARMA_HAVE_CXX23 - #endif - -#endif - - -// warn about ignored option used in old versions of Armadillo -#if defined(ARMA_DONT_USE_CXX11) - #pragma message ("WARNING: option ARMA_DONT_USE_CXX11 ignored") -#endif - - -#if !defined(ARMA_HAVE_CXX11) - #error "*** C++11 compiler required; enable C++11 mode in your compiler, or use an earlier version of Armadillo" -#endif - - -#if (!defined(ARMA_HAVE_CXX14)) - #if (!defined(ARMA_IGNORE_DEPRECATED_MARKER)) || defined(ARMA_DONT_IGNORE_DEPRECATED_MARKER) || defined(ARMA_DEBUG) - #pragma message ("INFO: support for C++11 is deprecated") - #endif -#endif - - -// for compatibility with earlier versions of Armadillo -#undef ARMA_USE_CXX11 -#define ARMA_USE_CXX11 diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/compiler_setup.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/compiler_setup.hpp deleted file mode 100644 index 3978911c1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/compiler_setup.hpp +++ /dev/null @@ -1,486 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -#undef arma_hot -#undef arma_cold -#undef arma_aligned -#undef arma_align_mem -#undef arma_warn_unused -#undef arma_deprecated -#undef arma_frown -#undef arma_malloc -#undef arma_inline -#undef arma_noinline -#undef arma_ignore - -#define arma_hot -#define arma_cold -#define arma_aligned -#define arma_align_mem -#define arma_warn_unused -#define arma_deprecated -#define arma_frown(msg) -#define arma_malloc -#define arma_inline inline -#define arma_noinline -#define arma_ignore(variable) ((void)(variable)) - -#undef arma_fortran_sans_prefix_B -#undef arma_fortran_with_prefix_B - -#if defined(ARMA_BLAS_UNDERSCORE) - #define arma_fortran_sans_prefix_B(function) function##_ - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - #define arma_fortran_with_prefix_B(function) wrapper2_##function##_ - #else - #define arma_fortran_with_prefix_B(function) wrapper_##function##_ - #endif -#else - #define arma_fortran_sans_prefix_B(function) function - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - #define arma_fortran_with_prefix_B(function) wrapper2_##function - #else - #define arma_fortran_with_prefix_B(function) wrapper_##function - #endif -#endif - -#undef arma_fortran -#undef arma_wrapper - -#if defined(ARMA_USE_WRAPPER) - #define arma_fortran(function) arma_fortran_with_prefix_B(function) - #define arma_wrapper(function) wrapper_##function -#else - #define arma_fortran(function) arma_fortran_sans_prefix_B(function) - #define arma_wrapper(function) function -#endif - -#undef arma_fortran_sans_prefix -#undef arma_fortran_with_prefix - -#define arma_fortran_sans_prefix(function) arma_fortran_sans_prefix_B(function) -#define arma_fortran_with_prefix(function) arma_fortran_with_prefix_B(function) - -#undef ARMA_INCFILE_WRAP -#define ARMA_INCFILE_WRAP(x) - - -#if !defined(ARMA_32BIT_WORD) - #undef ARMA_64BIT_WORD - #define ARMA_64BIT_WORD -#endif - -#if defined(ARMA_64BIT_WORD) && defined(SIZE_MAX) - #if (SIZE_MAX < 0xFFFFFFFFFFFFFFFFull) - // #pragma message ("WARNING: disabled use of 64 bit integers, as std::size_t is smaller than 64 bits") - #undef ARMA_64BIT_WORD - #endif -#endif - - -// most compilers can't vectorise slightly elaborate loops; -// for example clang: http://llvm.org/bugs/show_bug.cgi?id=16358 -#undef ARMA_SIMPLE_LOOPS -#define ARMA_SIMPLE_LOOPS - -#undef ARMA_GOOD_COMPILER - -// posix_memalign() is part of IEEE standard 1003.1 -// http://pubs.opengroup.org/onlinepubs/009696899/functions/posix_memalign.html -// http://pubs.opengroup.org/onlinepubs/9699919799/basedefs/unistd.h.html -// http://sourceforge.net/p/predef/wiki/Standards/ -#if ( defined(_POSIX_ADVISORY_INFO) && (_POSIX_ADVISORY_INFO >= 200112L) ) - #undef ARMA_HAVE_POSIX_MEMALIGN - #define ARMA_HAVE_POSIX_MEMALIGN -#endif - - -#if defined(__APPLE__) || defined(__apple_build_version__) - // NOTE: Apple accelerate framework has broken implementations of functions that return a float value, - // NOTE: such as sdot(), slange(), clange(), slansy(), clanhe(), slangb(), snrm2(), sasum() - #undef ARMA_BLAS_FLOAT_BUG - #define ARMA_BLAS_FLOAT_BUG - - // #undef ARMA_HAVE_POSIX_MEMALIGN - // NOTE: posix_memalign() is available since macOS 10.6 (late 2009 onwards) -#endif - - -#if defined(__MINGW32__) || defined(__CYGWIN__) || defined(_MSC_VER) - #undef ARMA_HAVE_POSIX_MEMALIGN -#endif - - -#undef ARMA_FNSIG - -#if defined (__GNUG__) - #define ARMA_FNSIG __PRETTY_FUNCTION__ -#elif defined (_MSC_VER) - #define ARMA_FNSIG __FUNCSIG__ -#elif defined(__INTEL_COMPILER) - #define ARMA_FNSIG __FUNCTION__ -#else - #define ARMA_FNSIG __func__ -#endif - - -#if !defined(ARMA_ALLOW_FAKE_GCC) - #if (defined(__GNUG__) || defined(__GNUC__)) && (defined(__INTEL_COMPILER) || defined(__NVCC__) || defined(__CUDACC__) || defined(__PGI) || defined(__PATHSCALE__) || defined(__ARMCC_VERSION) || defined(__IBMCPP__)) - #undef ARMA_DETECTED_FAKE_GCC - #define ARMA_DETECTED_FAKE_GCC - - #pragma message ("WARNING: this compiler is pretending to be GCC but it may not be fully compatible;") - #pragma message ("WARNING: to allow this compiler to use GCC features such as data alignment attributes,") - #pragma message ("WARNING: #define ARMA_ALLOW_FAKE_GCC before #include ") - #endif -#endif - - -#if defined(__GNUG__) && (!defined(__clang__) && !defined(ARMA_DETECTED_FAKE_GCC)) - - // #pragma message ("using GCC extensions") - - #undef ARMA_GCC_VERSION - #define ARMA_GCC_VERSION (__GNUC__ * 10000 + __GNUC_MINOR__ * 100 + __GNUC_PATCHLEVEL__) - - #if (ARMA_GCC_VERSION < 60100) - #error "*** newer compiler required; need gcc 6.1 or newer ***" - #endif - - // gcc 6.1 has proper C++14 support and fixes an OpenMP related bug: - // https://gcc.gnu.org/bugzilla/show_bug.cgi?id=57580 - - #define ARMA_GOOD_COMPILER - - #undef arma_hot - #undef arma_cold - #undef arma_aligned - #undef arma_align_mem - #undef arma_warn_unused - #undef arma_deprecated - #undef arma_frown - #undef arma_malloc - #undef arma_inline - #undef arma_noinline - - #define arma_hot __attribute__((__hot__)) - #define arma_cold __attribute__((__cold__)) - #define arma_aligned __attribute__((__aligned__)) - #define arma_align_mem __attribute__((__aligned__(16))) - #define arma_warn_unused __attribute__((__warn_unused_result__)) - #define arma_deprecated __attribute__((__deprecated__)) - #define arma_frown(msg) __attribute__((__deprecated__(msg))) - #define arma_malloc __attribute__((__malloc__)) - #define arma_inline __attribute__((__always_inline__)) inline - #define arma_noinline __attribute__((__noinline__)) - - #undef ARMA_HAVE_ALIGNED_ATTRIBUTE - #define ARMA_HAVE_ALIGNED_ATTRIBUTE - - #undef ARMA_HAVE_GCC_ASSUME_ALIGNED - #define ARMA_HAVE_GCC_ASSUME_ALIGNED - - // gcc's vectoriser can handle elaborate loops - #undef ARMA_SIMPLE_LOOPS - - #if defined(__OPTIMIZE_SIZE__) - #define ARMA_SIMPLE_LOOPS - #endif - -#endif - - -// TODO: __INTEL_CLANG_COMPILER indicates the clang based intel compiler, distinct from the classic intel compiler -#if !defined(ARMA_ALLOW_FAKE_CLANG) - #if defined(__clang__) && (defined(__INTEL_COMPILER) || defined(__NVCC__) || defined(__CUDACC__) || defined(__PGI) || defined(__PATHSCALE__) || defined(__ARMCC_VERSION) || defined(__IBMCPP__)) - #undef ARMA_DETECTED_FAKE_CLANG - #define ARMA_DETECTED_FAKE_CLANG - - #pragma message ("WARNING: this compiler is pretending to be Clang but it may not be fully compatible;") - #pragma message ("WARNING: to allow this compiler to use Clang features such as data alignment attributes,") - #pragma message ("WARNING: #define ARMA_ALLOW_FAKE_CLANG before #include ") - #endif -#endif - - -#if defined(__clang__) && !defined(ARMA_DETECTED_FAKE_CLANG) - - // #pragma message ("using Clang extensions") - - #define ARMA_GOOD_COMPILER - - #if !defined(__has_attribute) - #define __has_attribute(x) 0 - #endif - - #if __has_attribute(__aligned__) - #undef arma_aligned - #undef arma_align_mem - - #define arma_aligned __attribute__((__aligned__)) - #define arma_align_mem __attribute__((__aligned__(16))) - - #undef ARMA_HAVE_ALIGNED_ATTRIBUTE - #define ARMA_HAVE_ALIGNED_ATTRIBUTE - #endif - - #if __has_attribute(__warn_unused_result__) - #undef arma_warn_unused - #define arma_warn_unused __attribute__((__warn_unused_result__)) - #endif - - #if __has_attribute(__deprecated__) - #undef arma_deprecated - #define arma_deprecated __attribute__((__deprecated__)) - #endif - - #if __has_attribute(__deprecated__) - #undef arma_frown - #define arma_frown(msg) __attribute__((__deprecated__(msg))) - #endif - - #if __has_attribute(__malloc__) - #undef arma_malloc - #define arma_malloc __attribute__((__malloc__)) - #endif - - #if __has_attribute(__always_inline__) - #undef arma_inline - #define arma_inline __attribute__((__always_inline__)) inline - #endif - - #if __has_attribute(__noinline__) - #undef arma_noinline - #define arma_noinline __attribute__((__noinline__)) - #endif - - #if __has_attribute(__hot__) - #undef arma_hot - #define arma_hot __attribute__((__hot__)) - #endif - - #if __has_attribute(__cold__) - #undef arma_cold - #define arma_cold __attribute__((__cold__)) - #elif __has_attribute(__minsize__) - #undef arma_cold - #define arma_cold __attribute__((__minsize__)) - #endif - - #if defined(__has_builtin) && __has_builtin(__builtin_assume_aligned) - #undef ARMA_HAVE_GCC_ASSUME_ALIGNED - #define ARMA_HAVE_GCC_ASSUME_ALIGNED - #endif - -#endif - - -#if defined(__INTEL_COMPILER) - - #if (__INTEL_COMPILER == 9999) - #error "*** newer compiler required ***" - #endif - - #if (__INTEL_COMPILER < 1600) - #error "*** newer compiler required ***" - #endif - - #undef ARMA_HAVE_GCC_ASSUME_ALIGNED - -#endif - - -#if defined(_MSC_VER) - - #if (_MSC_VER < 1900) - #error "*** newer compiler required ***" - #endif - - #undef arma_deprecated - #define arma_deprecated __declspec(deprecated) - - #undef arma_noinline - #define arma_noinline __declspec(noinline) - - - #pragma warning(push) - - #pragma warning(disable: 4127) // conditional expression is constant - #pragma warning(disable: 4146) // unary minus operator applied to unsigned type, result still unsigned - #pragma warning(disable: 4180) // qualifier has no meaning - #pragma warning(disable: 4244) // possible loss of data when converting types (see also 4305) - #pragma warning(disable: 4510) // default constructor could not be generated - #pragma warning(disable: 4511) // copy constructor can't be generated - #pragma warning(disable: 4512) // assignment operator can't be generated - #pragma warning(disable: 4513) // destructor can't be generated - #pragma warning(disable: 4514) // unreferenced inline function has been removed - #pragma warning(disable: 4519) // default template args are only allowed on a class template (C++11) - #pragma warning(disable: 4522) // multiple assignment operators specified - #pragma warning(disable: 4623) // default constructor can't be generated - #pragma warning(disable: 4624) // destructor can't be generated - #pragma warning(disable: 4625) // copy constructor can't be generated - #pragma warning(disable: 4626) // assignment operator can't be generated - #pragma warning(disable: 4702) // unreachable code - #pragma warning(disable: 4710) // function not inlined - #pragma warning(disable: 4711) // call was inlined - #pragma warning(disable: 4714) // __forceinline can't be inlined - #pragma warning(disable: 4800) // value forced to bool - - #if defined(ARMA_HAVE_CXX17) - #pragma warning(disable: 26812) // unscoped enum - #pragma warning(disable: 26819) // unannotated fallthrough - #endif - - // #if (_MANAGED == 1) || (_M_CEE == 1) - // - // // don't do any alignment when compiling in "managed code" mode - // - // #undef arma_aligned - // #define arma_aligned - // - // #undef arma_align_mem - // #define arma_align_mem - // - // #elif (_MSC_VER >= 1700) - // - // #undef arma_align_mem - // #define arma_align_mem __declspec(align(16)) - // - // #define ARMA_HAVE_ALIGNED_ATTRIBUTE - // - // // disable warnings: "structure was padded due to __declspec(align(16))" - // #pragma warning(disable: 4324) - // - // #endif - -#endif - - -#if defined(ARMA_HAVE_CXX14) - #undef arma_deprecated - #define arma_deprecated [[deprecated]] - - #undef arma_frown - #define arma_frown(msg) [[deprecated(msg)]] -#endif - - -#if defined(ARMA_HAVE_CXX17) - #undef arma_warn_unused - #define arma_warn_unused [[nodiscard]] -#endif - - -#if !defined(ARMA_DONT_USE_OPENMP) - #if (defined(_OPENMP) && (_OPENMP >= 201107)) - #undef ARMA_USE_OPENMP - #define ARMA_USE_OPENMP - #endif -#endif - - -#if ( defined(ARMA_USE_OPENMP) && (!defined(_OPENMP) || (defined(_OPENMP) && (_OPENMP < 201107))) ) - // OpenMP 3.0 required for parallelisation of loops with unsigned integers - // OpenMP 3.1 required for atomic read and atomic write - #undef ARMA_USE_OPENMP - #undef ARMA_PRINT_OPENMP_WARNING - #define ARMA_PRINT_OPENMP_WARNING -#endif - - -#if defined(ARMA_PRINT_OPENMP_WARNING) && !defined(ARMA_DONT_PRINT_OPENMP_WARNING) - #pragma message ("WARNING: use of OpenMP disabled; compiler support for OpenMP 3.1+ not detected") - - #if (defined(_OPENMP) && (_OPENMP < 201107)) - #pragma message ("NOTE: your compiler has an outdated version of OpenMP") - #pragma message ("NOTE: consider upgrading to a better compiler") - #endif -#endif - - -#if (defined(__FAST_MATH__) || (defined(__FINITE_MATH_ONLY__) && (__FINITE_MATH_ONLY__ > 0)) || defined(_M_FP_FAST)) - #undef ARMA_FAST_MATH - #define ARMA_FAST_MATH -#endif - - -#if defined(ARMA_FAST_MATH) && !defined(ARMA_DONT_PRINT_FAST_MATH_WARNING) - #pragma message ("WARNING: compiler is in fast math mode; some functions may be unreliable.") - #pragma message ("WARNING: to suppress this warning and related warnings,") - #pragma message ("WARNING: #define ARMA_DONT_PRINT_FAST_MATH_WARNING before #include ") -#endif - - -#if ( (defined(_WIN32) || defined(_WIN64) || defined(_MSC_VER)) && (!defined(__MINGW32__) && !defined(__MINGW64__)) ) - #undef ARMA_PRINT_EXCEPTIONS_INTERNAL - #define ARMA_PRINT_EXCEPTIONS_INTERNAL -#endif - - -#if (defined(ARMA_ALIEN_MEM_ALLOC_FUNCTION) && !defined(ARMA_ALIEN_MEM_FREE_FUNCTION)) || (!defined(ARMA_ALIEN_MEM_ALLOC_FUNCTION) && defined(ARMA_ALIEN_MEM_FREE_FUNCTION)) - #error "*** both ARMA_ALIEN_MEM_ALLOC_FUNCTION and ARMA_ALIEN_MEM_FREE_FUNCTION must be defined ***" -#endif - - - -// cleanup - -#undef ARMA_DETECTED_FAKE_GCC -#undef ARMA_DETECTED_FAKE_CLANG -#undef ARMA_GCC_VERSION -#undef ARMA_PRINT_OPENMP_WARNING - - - -// undefine conflicting macros - -#if defined(log2) - #undef log2 - #pragma message ("WARNING: undefined conflicting 'log2' macro") -#endif - -#if defined(check) - #undef check - #pragma message ("WARNING: undefined conflicting 'check' macro") -#endif - -#if defined(min) || defined(max) - #undef min - #undef max - #pragma message ("WARNING: undefined conflicting 'min' and/or 'max' macros") -#endif - -// https://sourceware.org/bugzilla/show_bug.cgi?id=19239 -#undef minor -#undef major - - -// optionally allow disabling of compile-time deprecation messages (not recommended) -// NOTE: option 'ARMA_IGNORE_DEPRECATED_MARKER' will be removed -// NOTE: disabling deprecation messages is counter-productive - -#if defined(ARMA_IGNORE_DEPRECATED_MARKER) && (!defined(ARMA_DONT_IGNORE_DEPRECATED_MARKER)) && (!defined(ARMA_DEBUG)) - #undef arma_deprecated - #define arma_deprecated - - #undef arma_frown - #define arma_frown(msg) -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/compiler_setup_post.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/compiler_setup_post.hpp deleted file mode 100644 index 6274b7ee8..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/compiler_setup_post.hpp +++ /dev/null @@ -1,24 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -#if defined(_MSC_VER) - - #pragma warning(pop) - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/cond_rel_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/cond_rel_bones.hpp deleted file mode 100644 index a160d26de..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/cond_rel_bones.hpp +++ /dev/null @@ -1,42 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup cond_rel -//! @{ - - -// -// for preventing pedantic compiler warnings - -template -class cond_rel - { - public: - - template arma_inline static bool lt(const eT A, const eT B); - template arma_inline static bool gt(const eT A, const eT B); - - template arma_inline static bool leq(const eT A, const eT B); - template arma_inline static bool geq(const eT A, const eT B); - - template arma_inline static eT make_neg(const eT val); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/cond_rel_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/cond_rel_meat.hpp deleted file mode 100644 index a285774d0..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/cond_rel_meat.hpp +++ /dev/null @@ -1,134 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup cond_rel -//! @{ - - - -template<> -template -arma_inline -bool -cond_rel::lt(const eT A, const eT B) - { - return (A < B); - } - - - -template<> -template -arma_inline -bool -cond_rel::lt(const eT, const eT) - { - return false; - } - - - -template<> -template -arma_inline -bool -cond_rel::gt(const eT A, const eT B) - { - return (A > B); - } - - - -template<> -template -arma_inline -bool -cond_rel::gt(const eT, const eT) - { - return false; - } - - - -template<> -template -arma_inline -bool -cond_rel::leq(const eT A, const eT B) - { - return (A <= B); - } - - - -template<> -template -arma_inline -bool -cond_rel::leq(const eT, const eT) - { - return false; - } - - - -template<> -template -arma_inline -bool -cond_rel::geq(const eT A, const eT B) - { - return (A >= B); - } - - - -template<> -template -arma_inline -bool -cond_rel::geq(const eT, const eT) - { - return false; - } - - - -template<> -template -arma_inline -eT -cond_rel::make_neg(const eT val) - { - return -val; - } - - - -template<> -template -arma_inline -eT -cond_rel::make_neg(const eT) - { - return eT(0); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/config.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/config.hpp deleted file mode 100644 index 50d579f7e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/config.hpp +++ /dev/null @@ -1,366 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -#if !defined(ARMA_WARN_LEVEL) - #define ARMA_WARN_LEVEL 2 -#endif -//// The level of warning messages printed to ARMA_CERR_STREAM. -//// Must be an integer >= 0. The default value is 2. -//// 0 = no warnings; generally not recommended -//// 1 = only critical warnings about arguments and/or data which are likely to lead to incorrect results -//// 2 = as per level 1, and warnings about poorly conditioned systems (low rcond) detected by solve(), spsolve(), etc -//// 3 = as per level 2, and warnings about failed decompositions, failed saving/loading, etc - -// #define ARMA_USE_WRAPPER -//// Comment out the above line if you prefer to directly link with BLAS, LAPACK, etc -//// instead of the Armadillo runtime library. -//// You will need to link your programs directly with -lopenblas -llapack instead of -larmadillo - -#if !defined(ARMA_USE_LAPACK) -#define ARMA_USE_LAPACK -//// Comment out the above line if you don't have LAPACK or a high-speed replacement for LAPACK, -//// such as OpenBLAS, Intel MKL, or the Accelerate framework. -//// LAPACK is required for matrix decompositions (eg. SVD) and matrix inverse. -#endif - -#if !defined(ARMA_USE_BLAS) -#define ARMA_USE_BLAS -//// Comment out the above line if you don't have BLAS or a high-speed replacement for BLAS, -//// such as OpenBLAS, Intel MKL, or the Accelerate framework. -//// BLAS is used for matrix multiplication. -//// Without BLAS, matrix multiplication will still work, but might be slower. -#endif - -#if !defined(ARMA_USE_NEWARP) -#define ARMA_USE_NEWARP -//// Uncomment the above line to enable the built-in partial emulation of ARPACK. -//// This is used for eigen decompositions of real (non-complex) sparse matrices, eg. eigs_sym(), svds() -#endif - -#if !defined(ARMA_USE_ARPACK) -// #define ARMA_USE_ARPACK -//// Uncomment the above line if you have ARPACK or a high-speed replacement for ARPACK. -//// ARPACK is required for eigen decompositions of complex sparse matrices -#endif - -#if !defined(ARMA_USE_SUPERLU) -// #define ARMA_USE_SUPERLU -//// Uncomment the above line if you have SuperLU. -//// SuperLU is used for solving sparse linear systems via spsolve() -//// Caveat: only SuperLU version 5.2 can be used! -#endif - -#if !defined(ARMA_SUPERLU_INCLUDE_DIR) -// #define ARMA_SUPERLU_INCLUDE_DIR /usr/include/ -//// If you're using SuperLU and want to explicitly include the SuperLU headers, -//// uncomment the above define and specify the appropriate include directory. -//// Make sure the directory has a trailing / -#endif - -#if !defined(ARMA_USE_ATLAS) -// #define ARMA_USE_ATLAS -//// NOTE: support for ATLAS is deprecated and will be removed. -#endif - -#if !defined(ARMA_USE_HDF5) -// #define ARMA_USE_HDF5 -//// Uncomment the above line to allow the ability to save and load matrices stored in HDF5 format; -//// the hdf5.h header file must be available on your system, -//// and you will need to link with the hdf5 library (eg. -lhdf5) -#endif - -#if !defined(ARMA_USE_FFTW3) -// #define ARMA_USE_FFTW3 -//// Uncomment the above line to allow the use of the FFTW3 library by fft() and ifft() functions; -//// you will need to link with the FFTW3 library (eg. -lfftw3) -#endif - -#if defined(ARMA_USE_FFTW) - #error "use ARMA_USE_FFTW3 instead of ARMA_USE_FFTW" -#endif - -// #define ARMA_BLAS_CAPITALS -//// Uncomment the above line if your BLAS and LAPACK libraries have capitalised function names - -#define ARMA_BLAS_UNDERSCORE -//// Uncomment the above line if your BLAS and LAPACK libraries have function names with a trailing underscore. -//// Conversely, comment it out if the function names don't have a trailing underscore. - -// #define ARMA_BLAS_LONG -//// Uncomment the above line if your BLAS and LAPACK libraries use "long" instead of "int" - -// #define ARMA_BLAS_LONG_LONG -//// Uncomment the above line if your BLAS and LAPACK libraries use "long long" instead of "int" - -// #define ARMA_BLAS_NOEXCEPT -//// Uncomment the above line if you require BLAS functions to have the 'noexcept' specification - -// #define ARMA_LAPACK_NOEXCEPT -//// Uncomment the above line if you require LAPACK functions to have the 'noexcept' specification - -#define ARMA_USE_FORTRAN_HIDDEN_ARGS -//// Comment out the above line to call BLAS and LAPACK functions without using so-called "hidden" arguments. -//// Fortran functions (compiled without a BIND(C) declaration) that have char arguments -//// (like many BLAS and LAPACK functions) also have associated "hidden" arguments. -//// For each char argument, the corresponding "hidden" argument specifies the number of characters. -//// These "hidden" arguments are typically tacked onto the end of function definitions. - -// #define ARMA_USE_TBB_ALLOC -//// Uncomment the above line to use Intel TBB scalable_malloc() and scalable_free() instead of standard malloc() and free() - -// #define ARMA_USE_MKL_ALLOC -//// Uncomment the above line to use Intel MKL mkl_malloc() and mkl_free() instead of standard malloc() and free() - -// #define ARMA_USE_MKL_TYPES -//// Uncomment the above line to use Intel MKL types for complex numbers. -//// You will need to include appropriate MKL headers before the Armadillo header. -//// You may also need to enable or disable the following options: -//// ARMA_BLAS_LONG, ARMA_BLAS_LONG_LONG, ARMA_USE_FORTRAN_HIDDEN_ARGS - -#if !defined(ARMA_USE_OPENMP) -// #define ARMA_USE_OPENMP -//// Uncomment the above line to forcefully enable use of OpenMP for parallelisation. -//// Note that ARMA_USE_OPENMP is automatically enabled when a compiler supporting OpenMP 3.1 is detected. -#endif - -#if !defined(ARMA_USE_STD_MUTEX) - #define ARMA_USE_STD_MUTEX -//// Comment out the above line to disable use of std::mutex -#endif - -#if !defined(ARMA_64BIT_WORD) -// #define ARMA_64BIT_WORD -//// Uncomment the above line if you require matrices/vectors capable of holding more than 4 billion elements. -//// Note that ARMA_64BIT_WORD is automatically enabled when std::size_t has 64 bits and ARMA_32BIT_WORD is not defined. -#endif - -#if !defined(ARMA_OPTIMISE_BAND) - #define ARMA_OPTIMISE_BAND - //// Comment out the above line to disable optimised handling - //// of band matrices by solve() and chol() -#endif - -#if !defined(ARMA_OPTIMISE_SYM) - #define ARMA_OPTIMISE_SYM - //// Comment out the above line to disable optimised handling - //// of symmetric/hermitian matrices by various functions: - //// solve(), inv(), pinv(), expmat(), logmat(), sqrtmat(), rcond(), rank() -#endif - -#if !defined(ARMA_OPTIMISE_INVEXPR) - #define ARMA_OPTIMISE_INVEXPR - //// Comment out the above line to disable optimised handling - //// of inv() and inv_sympd() within compound expressions -#endif - -#if !defined(ARMA_CHECK_CONFORMANCE) - #define ARMA_CHECK_CONFORMANCE - //// Comment out the above line to disable conformance checks for bounds and size. - //// This is NOT RECOMMENDED. - //// It is strongly recommended that conformance checks are enabled during development, - //// as this greatly aids in finding mistakes in your code. -#endif - -#if !defined(ARMA_CHECK_NONFINITE) - #define ARMA_CHECK_NONFINITE - //// Comment out the above line to disable checking for nonfinite matrices -#endif - -#if !defined(ARMA_MAT_PREALLOC) - #define ARMA_MAT_PREALLOC 16 -#endif -//// This is the number of preallocated elements used by matrices and vectors; -//// it must be an integer that is at least 1. -//// If you mainly use lots of very small vectors (eg. <= 4 elements), -//// change the number to the size of your vectors. - -#if !defined(ARMA_OPENMP_THRESHOLD) - #define ARMA_OPENMP_THRESHOLD 320 -#endif -//// The minimum number of elements in a matrix to allow OpenMP based parallelisation; -//// it must be an integer that is at least 1. - -#if !defined(ARMA_OPENMP_THREADS) - #define ARMA_OPENMP_THREADS 8 -#endif -//// The maximum number of threads to use for OpenMP based parallelisation; -//// it must be an integer that is at least 1. - -// #define ARMA_DEBUG -//// Uncomment the above line to see the function traces of how Armadillo evaluates expressions. -//// This is mainly useful for debugging of the library. - -#if defined(ARMA_EXTRA_DEBUG) - // for compatibility with earlier versions of Armadillo - #undef ARMA_DEBUG - #define ARMA_DEBUG -#endif - - -#if defined(ARMA_DEFAULT_OSTREAM) - #pragma message ("WARNING: support for ARMA_DEFAULT_OSTREAM is deprecated and will be removed;") - #pragma message ("WARNING: use ARMA_COUT_STREAM and ARMA_CERR_STREAM instead") -#endif - - -#if !defined(ARMA_COUT_STREAM) - #if defined(ARMA_DEFAULT_OSTREAM) - // for compatibility with earlier versions of Armadillo - #define ARMA_COUT_STREAM ARMA_DEFAULT_OSTREAM - #else - #define ARMA_COUT_STREAM std::cout - #endif -#endif - -#if !defined(ARMA_CERR_STREAM) - #if defined(ARMA_DEFAULT_OSTREAM) - // for compatibility with earlier versions of Armadillo - #define ARMA_CERR_STREAM ARMA_DEFAULT_OSTREAM - #else - #define ARMA_CERR_STREAM std::cerr - #endif -#endif - - -#if !defined(ARMA_PRINT_EXCEPTIONS) - // #define ARMA_PRINT_EXCEPTIONS - #if defined(ARMA_PRINT_EXCEPTIONS_INTERNAL) - #undef ARMA_PRINT_EXCEPTIONS - #define ARMA_PRINT_EXCEPTIONS - #endif -#endif - -#if defined(ARMA_DONT_USE_LAPACK) - #undef ARMA_USE_LAPACK -#endif - -#if defined(ARMA_DONT_USE_BLAS) - #undef ARMA_USE_BLAS -#endif - -#if defined(ARMA_DONT_USE_NEWARP) || !defined(ARMA_USE_LAPACK) - #undef ARMA_USE_NEWARP -#endif - -#if defined(ARMA_DONT_USE_ARPACK) - #undef ARMA_USE_ARPACK -#endif - -#if defined(ARMA_DONT_USE_SUPERLU) - #undef ARMA_USE_SUPERLU - #undef ARMA_SUPERLU_INCLUDE_DIR -#endif - -#if defined(ARMA_DONT_USE_ATLAS) - #undef ARMA_USE_ATLAS -#endif - -#if defined(ARMA_DONT_USE_HDF5) - #undef ARMA_USE_HDF5 -#endif - -#if defined(ARMA_DONT_USE_FFTW3) - #undef ARMA_USE_FFTW3 -#endif - -#if defined(ARMA_DONT_USE_WRAPPER) - #undef ARMA_USE_WRAPPER -#endif - -#if defined(ARMA_DONT_USE_FORTRAN_HIDDEN_ARGS) - #undef ARMA_USE_FORTRAN_HIDDEN_ARGS -#endif - -#if defined(ARMA_DONT_USE_STD_MUTEX) - #undef ARMA_USE_STD_MUTEX -#endif - -// for compatibility with earlier versions of Armadillo -#if defined(ARMA_DONT_USE_CXX11_MUTEX) - #pragma message ("WARNING: support for ARMA_DONT_USE_CXX11_MUTEX is deprecated and will be removed;") - #pragma message ("WARNING: use ARMA_DONT_USE_STD_MUTEX instead") - #undef ARMA_USE_STD_MUTEX -#endif - -#if defined(ARMA_DONT_USE_OPENMP) - #undef ARMA_USE_OPENMP -#endif - -#if defined(ARMA_32BIT_WORD) - #undef ARMA_64BIT_WORD -#endif - -#if defined(ARMA_DONT_OPTIMISE_BAND) || defined(ARMA_DONT_OPTIMISE_SOLVE_BAND) - #undef ARMA_OPTIMISE_BAND -#endif - -#if defined(ARMA_DONT_OPTIMISE_SYM) || defined(ARMA_DONT_OPTIMISE_SYMPD) || defined(ARMA_DONT_OPTIMISE_SOLVE_SYMPD) - #undef ARMA_OPTIMISE_SYM -#endif - -#if defined(ARMA_DONT_OPTIMISE_INVEXPR) - #undef ARMA_OPTIMISE_INVEXPR -#endif - -#if defined(ARMA_DONT_CHECK_CONFORMANCE) - #if defined(ARMA_CHECK_CONFORMANCE) && (ARMA_WARN_LEVEL >= 2) - #pragma message ("WARNING: conformance checks disabled") - #endif - - #undef ARMA_CHECK_CONFORMANCE -#endif - -#if defined(ARMA_DONT_CHECK_NONFINITE) - #undef ARMA_CHECK_NONFINITE -#endif - -#if defined(ARMA_NO_DEBUG) - #undef ARMA_DEBUG - #undef ARMA_EXTRA_DEBUG -#endif - -#if defined(ARMA_DEBUG) - #undef ARMA_DONT_CHECK_CONFORMANCE - #undef ARMA_DONT_CHECK_NONFINITE - - #undef ARMA_CHECK_CONFORMANCE - #define ARMA_CHECK_CONFORMANCE - - #undef ARMA_CHECK_NONFINITE - #define ARMA_CHECK_NONFINITE - - #undef ARMA_WARN_LEVEL - #define ARMA_WARN_LEVEL 3 -#endif - -#if defined(ARMA_DONT_PRINT_EXCEPTIONS) - #undef ARMA_PRINT_EXCEPTIONS -#endif - -#if defined(ARMA_NO_CRIPPLED_LAPACK) - #undef ARMA_CRIPPLED_LAPACK -#endif - - -// if Armadillo was installed on this system via CMake and ARMA_USE_WRAPPER is not defined, -// ARMA_AUX_LIBS lists the libraries required by Armadillo on this system, and -// ARMA_AUX_INCDIRS lists the include directories required by Armadillo on this system. -// Do not use these unless you know what you are doing. -#define ARMA_AUX_LIBS -#define ARMA_AUX_INCDIRS diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/constants.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/constants.hpp deleted file mode 100644 index a4b67522c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/constants.hpp +++ /dev/null @@ -1,263 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup constants -//! @{ - - -namespace priv - { - class Datum_helper - { - public: - - template - static - typename arma_real_only::result - nan(typename arma_real_only::result* junk = nullptr) - { - arma_ignore(junk); - - return (std::numeric_limits::has_quiet_NaN) ? eT(std::numeric_limits::quiet_NaN()) : eT(0); - } - - - template - static - typename arma_cx_only::result - nan(typename arma_cx_only::result* junk = nullptr) - { - arma_ignore(junk); - - typedef typename get_pod_type::result T; - - return eT( Datum_helper::nan(), Datum_helper::nan() ); - } - - - template - static - typename arma_integral_only::result - nan(typename arma_integral_only::result* junk = nullptr) - { - arma_ignore(junk); - - return eT(0); - } - - - template - static - typename arma_real_only::result - inf(typename arma_real_only::result* junk = nullptr) - { - arma_ignore(junk); - - return (std::numeric_limits::has_infinity) ? eT(std::numeric_limits::infinity()) : eT(std::numeric_limits::max()); - } - - - template - static - typename arma_cx_only::result - inf(typename arma_cx_only::result* junk = nullptr) - { - arma_ignore(junk); - - typedef typename get_pod_type::result T; - - return eT( Datum_helper::inf(), Datum_helper::inf() ); - } - - - template - static - typename arma_integral_only::result - inf(typename arma_integral_only::result* junk = nullptr) - { - arma_ignore(junk); - - return std::numeric_limits::max(); - } - }; - } - - - -//! various constants. -//! Physical constants taken from NIST 2018 CODATA values, and some from WolframAlpha (values provided as of 2009-06-23) -//! http://physics.nist.gov/cuu/Constants -//! http://www.wolframalpha.com -//! See also http://en.wikipedia.org/wiki/Physical_constant - - -template -class Datum - { - public: - - static const eT pi; //!< ratio of any circle's circumference to its diameter - static const eT tau; //!< ratio of any circle's circumference to its radius (replacement of 2*pi) - static const eT e; //!< base of the natural logarithm - static const eT euler; //!< Euler's constant, aka Euler-Mascheroni constant - static const eT gratio; //!< golden ratio - static const eT sqrt2; //!< square root of 2 - static const eT sqrt2pi; //!< square root of 2*pi - static const eT log_sqrt2pi; //!< log of square root of 2*pi - static const eT eps; //!< the difference between 1 and the least value greater than 1 that is representable - static const eT log_min; //!< log of the minimum representable value - static const eT log_max; //!< log of the maximum representable value - static const eT nan; //!< "not a number" - static const eT inf; //!< infinity - - // - - static const eT m_u; //!< atomic mass constant (in kg) - static const eT N_A; //!< Avogadro constant - static const eT k; //!< Boltzmann constant (in joules per kelvin) - static const eT k_evk; //!< Boltzmann constant (in eV/K) - static const eT a_0; //!< Bohr radius (in meters) - static const eT mu_B; //!< Bohr magneton - static const eT Z_0; //!< characteristic impedance of vacuum (in ohms) - static const eT G_0; //!< conductance quantum (in siemens) - static const eT k_e; //!< Coulomb's constant (in meters per farad) - static const eT eps_0; //!< electric constant (in farads per meter) - static const eT m_e; //!< electron mass (in kg) - static const eT eV; //!< electron volt (in joules) - static const eT ec; //!< elementary charge (in coulombs) - static const eT F; //!< Faraday constant (in coulombs) - static const eT alpha; //!< fine-structure constant - static const eT alpha_inv; //!< inverse fine-structure constant - static const eT K_J; //!< Josephson constant - static const eT mu_0; //!< magnetic constant (in henries per meter) - static const eT phi_0; //!< magnetic flux quantum (in webers) - static const eT R; //!< molar gas constant (in joules per mole kelvin) - static const eT G; //!< Newtonian constant of gravitation (in newton square meters per kilogram squared) - static const eT h; //!< Planck constant (in joule seconds) - static const eT h_bar; //!< Planck constant over 2 pi, aka reduced Planck constant (in joule seconds) - static const eT m_p; //!< proton mass (in kg) - static const eT R_inf; //!< Rydberg constant (in reciprocal meters) - static const eT c_0; //!< speed of light in vacuum (in meters per second) - static const eT sigma; //!< Stefan-Boltzmann constant - static const eT R_k; //!< von Klitzing constant (in ohms) - static const eT b; //!< Wien wavelength displacement law constant - }; - - -// the long lengths of the constants are for future support of "long double" -// and any smart compiler that does high-precision computation at compile-time - -template const eT Datum::pi = eT(3.1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679); -template const eT Datum::tau = eT(6.2831853071795864769252867665590057683943387987502116419498891846156328125724179972560696506842341359); -template const eT Datum::e = eT(2.7182818284590452353602874713526624977572470936999595749669676277240766303535475945713821785251664274); -template const eT Datum::euler = eT(0.5772156649015328606065120900824024310421593359399235988057672348848677267776646709369470632917467495); -template const eT Datum::gratio = eT(1.6180339887498948482045868343656381177203091798057628621354486227052604628189024497072072041893911374); -template const eT Datum::sqrt2 = eT(1.4142135623730950488016887242096980785696718753769480731766797379907324784621070388503875343276415727); -template const eT Datum::sqrt2pi = eT(2.5066282746310005024157652848110452530069867406099383166299235763422936546078419749465958383780572661); -template const eT Datum::log_sqrt2pi = eT(0.9189385332046727417803297364056176398613974736377834128171515404827656959272603976947432986359541976); -template const eT Datum::eps = std::numeric_limits::epsilon(); -template const eT Datum::log_min = std::log(std::numeric_limits::min()); -template const eT Datum::log_max = std::log(std::numeric_limits::max()); -template const eT Datum::nan = priv::Datum_helper::nan(); -template const eT Datum::inf = priv::Datum_helper::inf(); - -template const eT Datum::m_u = eT(1.66053906892e-27); -template const eT Datum::N_A = eT(6.02214076e23); -template const eT Datum::k = eT(1.380649e-23); -template const eT Datum::k_evk = eT(8.617333262e-5); -template const eT Datum::a_0 = eT(5.29177210544e-11); -template const eT Datum::mu_B = eT(9.2740100657e-24); -template const eT Datum::Z_0 = eT(376.730313412); -template const eT Datum::G_0 = eT(7.748091729e-5); -template const eT Datum::k_e = eT(8.9875517923e9); -template const eT Datum::eps_0 = eT(8.8541878128e-12); -template const eT Datum::m_e = eT(9.1093837139e-31); -template const eT Datum::eV = eT(1.602176634e-19); -template const eT Datum::ec = eT(1.602176634e-19); -template const eT Datum::F = eT(96485.33212); -template const eT Datum::alpha = eT(7.2973525643e-3); -template const eT Datum::alpha_inv = eT(137.035999177); -template const eT Datum::K_J = eT(483597.8484e9); -template const eT Datum::mu_0 = eT(1.25663706212e-6); -template const eT Datum::phi_0 = eT(2.067833848e-15); -template const eT Datum::R = eT(8.314462618); -template const eT Datum::G = eT(6.67430e-11); -template const eT Datum::h = eT(6.62607015e-34); -template const eT Datum::h_bar = eT(1.054571817e-34); -template const eT Datum::m_p = eT(1.67262192595e-27); -template const eT Datum::R_inf = eT(10973731.568157); -template const eT Datum::c_0 = eT(299792458.0); -template const eT Datum::sigma = eT(5.670374419e-8); -template const eT Datum::R_k = eT(25812.80745); -template const eT Datum::b = eT(2.897771955e-3); - - - -typedef Datum fdatum; -typedef Datum datum; - - - - -namespace priv - { - - template - static - constexpr - typename arma_real_only::result - most_neg() - { - return (std::numeric_limits::has_infinity) ? -(std::numeric_limits::infinity()) : std::numeric_limits::lowest(); - } - - - template - static - constexpr - typename arma_integral_only::result - most_neg() - { - return std::numeric_limits::lowest(); - } - - - template - static - constexpr - typename arma_real_only::result - most_pos() - { - return (std::numeric_limits::has_infinity) ? std::numeric_limits::infinity() : std::numeric_limits::max(); - } - - - template - static - constexpr - typename arma_integral_only::result - most_pos() - { - return std::numeric_limits::max(); - } - - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/constants_old.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/constants_old.hpp deleted file mode 100644 index a2bc04662..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/constants_old.hpp +++ /dev/null @@ -1,93 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup constants_old -//! @{ - - -// DO NOT USE IN NEW CODE !!! -// the Math and Phy classes are kept for compatibility with old code; -// for new code, use the Datum class instead -// eg. instead of math::pi(), use datum::pi - -template -class Math - { - public: - - arma_frown("use datum::pi instead") static eT pi() { return eT(Datum::pi); } - arma_frown("use datum::e instead") static eT e() { return eT(Datum::e); } - arma_frown("use datum::euler instead") static eT euler() { return eT(Datum::euler); } - arma_frown("use datum::gratio instead") static eT gratio() { return eT(Datum::gratio); } - arma_frown("use datum::sqrt2 instead") static eT sqrt2() { return eT(Datum::sqrt2); } - arma_frown("use datum::eps instead") static eT eps() { return eT(Datum::eps); } - arma_frown("use datum::log_min instead") static eT log_min() { return eT(Datum::log_min); } - arma_frown("use datum::log_max instead") static eT log_max() { return eT(Datum::log_max); } - arma_frown("use datum::nan instead") static eT nan() { return eT(Datum::nan); } - arma_frown("use datum::inf instead") static eT inf() { return eT(Datum::inf); } - }; - - - -template -class Phy - { - public: - - arma_deprecated static eT m_u() { return eT(Datum::m_u); } - arma_deprecated static eT N_A() { return eT(Datum::N_A); } - arma_deprecated static eT k() { return eT(Datum::k); } - arma_deprecated static eT k_evk() { return eT(Datum::k_evk); } - arma_deprecated static eT a_0() { return eT(Datum::a_0); } - arma_deprecated static eT mu_B() { return eT(Datum::mu_B); } - arma_deprecated static eT Z_0() { return eT(Datum::Z_0); } - arma_deprecated static eT G_0() { return eT(Datum::G_0); } - arma_deprecated static eT k_e() { return eT(Datum::k_e); } - arma_deprecated static eT eps_0() { return eT(Datum::eps_0); } - arma_deprecated static eT m_e() { return eT(Datum::m_e); } - arma_deprecated static eT eV() { return eT(Datum::eV); } - arma_deprecated static eT e() { return eT(Datum::ec); } - arma_deprecated static eT F() { return eT(Datum::F); } - arma_deprecated static eT alpha() { return eT(Datum::alpha); } - arma_deprecated static eT alpha_inv() { return eT(Datum::alpha_inv); } - arma_deprecated static eT K_J() { return eT(Datum::K_J); } - arma_deprecated static eT mu_0() { return eT(Datum::mu_0); } - arma_deprecated static eT phi_0() { return eT(Datum::phi_0); } - arma_deprecated static eT R() { return eT(Datum::R); } - arma_deprecated static eT G() { return eT(Datum::G); } - arma_deprecated static eT h() { return eT(Datum::h); } - arma_deprecated static eT h_bar() { return eT(Datum::h_bar); } - arma_deprecated static eT m_p() { return eT(Datum::m_p); } - arma_deprecated static eT R_inf() { return eT(Datum::R_inf); } - arma_deprecated static eT c_0() { return eT(Datum::c_0); } - arma_deprecated static eT sigma() { return eT(Datum::sigma); } - arma_deprecated static eT R_k() { return eT(Datum::R_k); } - arma_deprecated static eT b() { return eT(Datum::b); } - }; - - - -typedef Math fmath; -typedef Math math; - -typedef Phy fphy; -typedef Phy phy; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/csv_name.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/csv_name.hpp deleted file mode 100644 index c6a1df5d6..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/csv_name.hpp +++ /dev/null @@ -1,138 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup diskio -//! @{ - - -namespace csv_opts - { - typedef unsigned int flag_type; - - struct opts - { - const flag_type flags; - - inline constexpr explicit opts(const flag_type in_flags); - - inline const opts operator+(const opts& rhs) const; - }; - - inline - constexpr - opts::opts(const flag_type in_flags) - : flags(in_flags) - {} - - inline - const opts - opts::operator+(const opts& rhs) const - { - const opts result( flags | rhs.flags ); - - return result; - } - - // The values below (eg. 1u << 0) are for internal Armadillo use only. - // The values can change without notice. - - static constexpr flag_type flag_none = flag_type(0 ); - static constexpr flag_type flag_trans = flag_type(1u << 0); - static constexpr flag_type flag_no_header = flag_type(1u << 1); - static constexpr flag_type flag_with_header = flag_type(1u << 2); - static constexpr flag_type flag_semicolon = flag_type(1u << 3); - static constexpr flag_type flag_strict = flag_type(1u << 4); - - struct opts_none : public opts { inline constexpr opts_none() : opts(flag_none ) {} }; - struct opts_trans : public opts { inline constexpr opts_trans() : opts(flag_trans ) {} }; - struct opts_no_header : public opts { inline constexpr opts_no_header() : opts(flag_no_header ) {} }; - struct opts_with_header : public opts { inline constexpr opts_with_header() : opts(flag_with_header) {} }; - struct opts_semicolon : public opts { inline constexpr opts_semicolon() : opts(flag_semicolon ) {} }; - struct opts_strict : public opts { inline constexpr opts_strict() : opts(flag_strict ) {} }; - - static constexpr opts_none none; - static constexpr opts_trans trans; - static constexpr opts_no_header no_header; - static constexpr opts_with_header with_header; - static constexpr opts_semicolon semicolon; - static constexpr opts_strict strict; - } - - -struct csv_name - { - typedef field header_type; - - const std::string filename; - const csv_opts::opts opts; - - header_type header_junk; - const header_type& header_ro; - header_type& header_rw; - - inline - csv_name(const std::string& in_filename) - : filename (in_filename ) - , opts (csv_opts::no_header) - , header_ro(header_junk ) - , header_rw(header_junk ) - {} - - inline - csv_name(const std::string& in_filename, const csv_opts::opts& in_opts) - : filename (in_filename ) - , opts (csv_opts::no_header + in_opts) - , header_ro(header_junk ) - , header_rw(header_junk ) - {} - - inline - csv_name(const std::string& in_filename, field& in_header) - : filename (in_filename ) - , opts (csv_opts::with_header) - , header_ro(in_header ) - , header_rw(in_header ) - {} - - inline - csv_name(const std::string& in_filename, const field& in_header) - : filename (in_filename ) - , opts (csv_opts::with_header) - , header_ro(in_header ) - , header_rw(header_junk ) - {} - - inline - csv_name(const std::string& in_filename, field& in_header, const csv_opts::opts& in_opts) - : filename (in_filename ) - , opts (csv_opts::with_header + in_opts) - , header_ro(in_header ) - , header_rw(in_header ) - {} - - inline - csv_name(const std::string& in_filename, const field& in_header, const csv_opts::opts& in_opts) - : filename (in_filename ) - , opts (csv_opts::with_header + in_opts) - , header_ro(in_header ) - , header_rw(header_junk ) - {} - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/debug.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/debug.hpp deleted file mode 100644 index e2a51731e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/debug.hpp +++ /dev/null @@ -1,1463 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup debug -//! @{ - - - -inline -std::ostream& -get_cout_stream() - { - return (ARMA_COUT_STREAM); - } - - - -inline -std::ostream& -get_cerr_stream() - { - return (ARMA_CERR_STREAM); - } - - - -arma_deprecated -inline -std::ostream& -get_stream_err1() - { - return get_cerr_stream(); - } - - - -arma_deprecated -inline -std::ostream& -get_stream_err2() - { - return get_cerr_stream(); - } - - - -arma_frown("this function does nothing; instead use ARMA_COUT_STREAM or ARMA_WARN_LEVEL; see documentation") -inline -void -set_cout_stream(const std::ostream&) - { - } - - - -arma_frown("this function does nothing; instead use ARMA_CERR_STREAM or ARMA_WARN_LEVEL; see documentation") -inline -void -set_cerr_stream(const std::ostream&) - { - } - - - -arma_frown("this function does nothing; instead use ARMA_CERR_STREAM or ARMA_WARN_LEVEL; see documentation") -inline -void -set_stream_err1(const std::ostream&) - { - } - - - -arma_frown("this function does nothing; instead use ARMA_CERR_STREAM or ARMA_WARN_LEVEL; see documentation") -inline -void -set_stream_err2(const std::ostream&) - { - } - - - -template -arma_frown("this function does nothing; instead use ARMA_COUT_STREAM or ARMA_WARN_LEVEL; see documentation") -inline -std::ostream& -arma_cout_stream(std::ostream*) - { - return (ARMA_COUT_STREAM); - } - - - -template -arma_frown("this function does nothing; instead use ARMA_CERR_STREAM or ARMA_WARN_LEVEL; see documentation") -inline -std::ostream& -arma_cerr_stream(std::ostream*) - { - return (ARMA_CERR_STREAM); - } - - - -//! print a message to get_cerr_stream() and throw logic_error exception -template -arma_cold -arma_noinline -static -void -arma_stop_logic_error(const T1& x) - { - #if defined(ARMA_PRINT_EXCEPTIONS) - { - get_cerr_stream() << "\nerror: " << x << std::endl; - } - #endif - - throw std::logic_error( std::string(x) ); - } - - - -arma_cold -arma_noinline -static -void -arma_stop_logic_error(const char* x, const char* y) - { - arma_stop_logic_error( std::string(x) + std::string(y) ); - } - - - -//! print a message to get_cerr_stream() and throw out_of_range exception -template -arma_cold -arma_noinline -static -void -arma_stop_bounds_error(const T1& x) - { - #if defined(ARMA_PRINT_EXCEPTIONS) - { - get_cerr_stream() << "\nerror: " << x << std::endl; - } - #endif - - throw std::out_of_range( std::string(x) ); - } - - - -//! print a message to get_cerr_stream() and throw bad_alloc exception -template -arma_cold -arma_noinline -static -void -arma_stop_bad_alloc(const T1& x) - { - #if defined(ARMA_PRINT_EXCEPTIONS) - { - get_cerr_stream() << "\nerror: " << x << std::endl; - } - #else - { - arma_ignore(x); - } - #endif - - throw std::bad_alloc(); - } - - - -//! print a message to get_cerr_stream() and throw runtime_error exception -template -arma_cold -arma_noinline -static -void -arma_stop_runtime_error(const T1& x) - { - #if defined(ARMA_PRINT_EXCEPTIONS) - { - get_cerr_stream() << "\nerror: " << x << std::endl; - } - #endif - - throw std::runtime_error( std::string(x) ); - } - - - -// -// arma_print - - -arma_cold -inline -void -arma_print() - { - get_cerr_stream() << std::endl; - } - - -template -arma_cold -arma_noinline -static -void -arma_print(const T1& x) - { - get_cerr_stream() << x << std::endl; - } - - - -template -arma_cold -arma_noinline -static -void -arma_print(const T1& x, const T2& y) - { - get_cerr_stream() << x << y << std::endl; - } - - - -template -arma_cold -arma_noinline -static -void -arma_print(const T1& x, const T2& y, const T3& z) - { - get_cerr_stream() << x << y << z << std::endl; - } - - - - - - -// -// arma_sigprint - -//! print a message to the cerr stream with a preceding @ character. -//! used for printing the signature of a function -//! (see the arma_debug_sigprint macro) -inline -void -arma_sigprint(const char* x) - { - get_cerr_stream() << "@ " << x; - } - - - -// -// arma_bktprint - - -inline -void -arma_bktprint() - { - get_cerr_stream() << std::endl; - } - - -template -inline -void -arma_bktprint(const T1& x) - { - get_cerr_stream() << " [" << x << ']' << std::endl; - } - - - -template -inline -void -arma_bktprint(const T1& x, const T2& y) - { - get_cerr_stream() << " [" << x << y << ']' << std::endl; - } - - - - - - -// -// arma_thisprint - -inline -void -arma_thisprint(const void* this_ptr) - { - get_cerr_stream() << " [this: " << this_ptr << ']' << std::endl; - } - - - -// -// arma_plain_warn - - -//! print a message to the warn stream -template -arma_cold -arma_noinline -static -void -arma_plain_warn(const T1& arg1) - { - get_cerr_stream() << "\nwarning: " << arg1 << std::endl; - } - - -template -arma_cold -arma_noinline -static -void -arma_plain_warn(const T1& arg1, const T2& arg2) - { - get_cerr_stream() << "\nwarning: " << arg1 << arg2 << std::endl; - } - - -template -arma_cold -arma_noinline -static -void -arma_plain_warn(const T1& arg1, const T2& arg2, const T3& arg3) - { - get_cerr_stream() << "\nwarning: " << arg1 << arg2 << arg3 << std::endl; - } - - -template -arma_cold -arma_noinline -static -void -arma_plain_warn(const T1& arg1, const T2& arg2, const T3& arg3, const T4& arg4) - { - get_cerr_stream() << "\nwarning: " << arg1 << arg2 << arg3 << arg4 << std::endl; - } - - - -// -// arma_warn - - -template -inline -void -arma_warn(const uword level, const T1& arg1) - { - constexpr uword config_level = (sword(ARMA_WARN_LEVEL) > 0) ? uword(ARMA_WARN_LEVEL) : uword(0); - - if((config_level > 0) && (level <= config_level)) { arma_plain_warn(arg1); } - } - - -template -inline -void -arma_warn(const uword level, const T1& arg1, const T2& arg2) - { - constexpr uword config_level = (sword(ARMA_WARN_LEVEL) > 0) ? uword(ARMA_WARN_LEVEL) : uword(0); - - if((config_level > 0) && (level <= config_level)) { arma_plain_warn(arg1,arg2); } - } - - -template -inline -void -arma_warn(const uword level, const T1& arg1, const T2& arg2, const T3& arg3) - { - constexpr uword config_level = (sword(ARMA_WARN_LEVEL) > 0) ? uword(ARMA_WARN_LEVEL) : uword(0); - - if((config_level > 0) && (level <= config_level)) { arma_plain_warn(arg1,arg2,arg3); } - } - - -template -inline -void -arma_warn(const uword level, const T1& arg1, const T2& arg2, const T3& arg3, const T4& arg4) - { - constexpr uword config_level = (sword(ARMA_WARN_LEVEL) > 0) ? uword(ARMA_WARN_LEVEL) : uword(0); - - if((config_level > 0) && (level <= config_level)) { arma_plain_warn(arg1,arg2,arg3,arg4); } - } - - - -// -// arma_check - -//! if state is true, abort program -template -arma_hot -inline -void -arma_check(const bool state, const T1& x) - { - if(state) { arma_stop_logic_error(arma_str::str_wrapper(x)); } - } - - -template -arma_hot -inline -void -arma_check(const bool state, const char* x, const Functor& fn) - { - if(state) { fn(); arma_stop_logic_error(x); } - } - - -arma_hot -inline -void -arma_check(const bool state, const char* x, const char* y) - { - if(state) { arma_stop_logic_error(x,y); } - } - - -template -arma_hot -inline -void -arma_check(const bool state, const char* x, const char* y, const Functor& fn) - { - if(state) { fn(); arma_stop_logic_error(x,y); } - } - - -template -arma_hot -inline -void -arma_check_bounds(const bool state, const T1& x) - { - if(state) { arma_stop_bounds_error(arma_str::str_wrapper(x)); } - } - - -template -arma_hot -inline -void -arma_check_bad_alloc(const bool state, const T1& x) - { - if(state) { arma_stop_bad_alloc(x); } - } - - - -// -// arma_set_error - - -arma_hot -arma_inline -void -arma_set_error(bool& err_state, char*& err_msg, const bool expression, const char* message) - { - if(expression) - { - err_state = true; - err_msg = const_cast(message); - } - } - - - - -// -// functions for generating strings indicating size errors - -arma_cold -arma_noinline -static -std::string -arma_incompat_size_string(const uword A_n_rows, const uword A_n_cols, const uword B_n_rows, const uword B_n_cols, const char* x) - { - std::ostringstream tmp; - - tmp << x << ": incompatible matrix dimensions: " << A_n_rows << 'x' << A_n_cols << " and " << B_n_rows << 'x' << B_n_cols; - - return tmp.str(); - } - - - -arma_cold -arma_noinline -static -std::string -arma_incompat_size_string(const uword A_n_rows, const uword A_n_cols, const uword A_n_slices, const uword B_n_rows, const uword B_n_cols, const uword B_n_slices, const char* x) - { - std::ostringstream tmp; - - tmp << x << ": incompatible cube dimensions: " << A_n_rows << 'x' << A_n_cols << 'x' << A_n_slices << " and " << B_n_rows << 'x' << B_n_cols << 'x' << B_n_slices; - - return tmp.str(); - } - - - -template -arma_cold -arma_noinline -static -std::string -arma_incompat_size_string(const subview_cube& Q, const Mat& A, const char* x) - { - std::ostringstream tmp; - - tmp << x - << ": interpreting matrix as cube with dimensions: " - << A.n_rows << 'x' << A.n_cols << 'x' << 1 - << " or " - << A.n_rows << 'x' << 1 << 'x' << A.n_cols - << " or " - << 1 << 'x' << A.n_rows << 'x' << A.n_cols - << " is incompatible with cube dimensions: " - << Q.n_rows << 'x' << Q.n_cols << 'x' << Q.n_slices; - - return tmp.str(); - } - - - -// -// functions for checking whether two dense matrices have the same dimensions - - - -arma_hot -arma_inline -void -arma_assert_same_size(const uword A_n_rows, const uword A_n_cols, const uword B_n_rows, const uword B_n_cols, const char* x) - { - if( (A_n_rows != B_n_rows) || (A_n_cols != B_n_cols) ) - { - arma_stop_logic_error( arma_incompat_size_string(A_n_rows, A_n_cols, B_n_rows, B_n_cols, x) ); - } - } - - - -//! stop if given matrices do not have the same size -template -arma_hot -inline -void -arma_assert_same_size(const Mat& A, const Mat& B, const char* x) - { - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - if( (A_n_rows != B_n_rows) || (A_n_cols != B_n_cols) ) - { - arma_stop_logic_error( arma_incompat_size_string(A_n_rows, A_n_cols, B_n_rows, B_n_cols, x) ); - } - } - - - -//! stop if given proxies do not have the same size -template -arma_hot -inline -void -arma_assert_same_size(const Proxy& A, const Proxy& B, const char* x) - { - const uword A_n_rows = A.get_n_rows(); - const uword A_n_cols = A.get_n_cols(); - - const uword B_n_rows = B.get_n_rows(); - const uword B_n_cols = B.get_n_cols(); - - if( (A_n_rows != B_n_rows) || (A_n_cols != B_n_cols) ) - { - arma_stop_logic_error( arma_incompat_size_string(A_n_rows, A_n_cols, B_n_rows, B_n_cols, x) ); - } - } - - - -template -arma_hot -inline -void -arma_assert_same_size(const subview& A, const subview& B, const char* x) - { - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - if( (A_n_rows != B_n_rows) || (A_n_cols != B_n_cols) ) - { - arma_stop_logic_error( arma_incompat_size_string(A_n_rows, A_n_cols, B_n_rows, B_n_cols, x) ); - } - } - - - -template -arma_hot -inline -void -arma_assert_same_size(const Mat& A, const subview& B, const char* x) - { - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - if( (A_n_rows != B_n_rows) || (A_n_cols != B_n_cols) ) - { - arma_stop_logic_error( arma_incompat_size_string(A_n_rows, A_n_cols, B_n_rows, B_n_cols, x) ); - } - } - - - -template -arma_hot -inline -void -arma_assert_same_size(const subview& A, const Mat& B, const char* x) - { - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - if( (A_n_rows != B_n_rows) || (A_n_cols != B_n_cols) ) - { - arma_stop_logic_error( arma_incompat_size_string(A_n_rows, A_n_cols, B_n_rows, B_n_cols, x) ); - } - } - - - -template -arma_hot -inline -void -arma_assert_same_size(const Mat& A, const Proxy& B, const char* x) - { - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const uword B_n_rows = B.get_n_rows(); - const uword B_n_cols = B.get_n_cols(); - - if( (A_n_rows != B_n_rows) || (A_n_cols != B_n_cols) ) - { - arma_stop_logic_error( arma_incompat_size_string(A_n_rows, A_n_cols, B_n_rows, B_n_cols, x) ); - } - } - - - -template -arma_hot -inline -void -arma_assert_same_size(const Proxy& A, const Mat& B, const char* x) - { - const uword A_n_rows = A.get_n_rows(); - const uword A_n_cols = A.get_n_cols(); - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - if( (A_n_rows != B_n_rows) || (A_n_cols != B_n_cols) ) - { - arma_stop_logic_error( arma_incompat_size_string(A_n_rows, A_n_cols, B_n_rows, B_n_cols, x) ); - } - } - - - -template -arma_hot -inline -void -arma_assert_same_size(const Proxy& A, const subview& B, const char* x) - { - const uword A_n_rows = A.get_n_rows(); - const uword A_n_cols = A.get_n_cols(); - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - if( (A_n_rows != B_n_rows) || (A_n_cols != B_n_cols) ) - { - arma_stop_logic_error( arma_incompat_size_string(A_n_rows, A_n_cols, B_n_rows, B_n_cols, x) ); - } - } - - - -template -arma_hot -inline -void -arma_assert_same_size(const subview& A, const Proxy& B, const char* x) - { - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const uword B_n_rows = B.get_n_rows(); - const uword B_n_cols = B.get_n_cols(); - - if( (A_n_rows != B_n_rows) || (A_n_cols != B_n_cols) ) - { - arma_stop_logic_error( arma_incompat_size_string(A_n_rows, A_n_cols, B_n_rows, B_n_cols, x) ); - } - } - - - -// -// functions for checking whether two sparse matrices have the same dimensions - - - -template -arma_hot -inline -void -arma_assert_same_size(const SpMat& A, const SpMat& B, const char* x) - { - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - if( (A_n_rows != B_n_rows) || (A_n_cols != B_n_cols) ) - { - arma_stop_logic_error( arma_incompat_size_string(A_n_rows, A_n_cols, B_n_rows, B_n_cols, x) ); - } - } - - - -// -// functions for checking whether two cubes have the same dimensions - - - -arma_hot -inline -void -arma_assert_same_size(const uword A_n_rows, const uword A_n_cols, const uword A_n_slices, const uword B_n_rows, const uword B_n_cols, const uword B_n_slices, const char* x) - { - if( (A_n_rows != B_n_rows) || (A_n_cols != B_n_cols) || (A_n_slices != B_n_slices) ) - { - arma_stop_logic_error( arma_incompat_size_string(A_n_rows, A_n_cols, A_n_slices, B_n_rows, B_n_cols, B_n_slices, x) ); - } - } - - - -//! stop if given cubes do not have the same size -template -arma_hot -inline -void -arma_assert_same_size(const Cube& A, const Cube& B, const char* x) - { - if( (A.n_rows != B.n_rows) || (A.n_cols != B.n_cols) || (A.n_slices != B.n_slices) ) - { - arma_stop_logic_error( arma_incompat_size_string(A.n_rows, A.n_cols, A.n_slices, B.n_rows, B.n_cols, B.n_slices, x) ); - } - } - - - -template -arma_hot -inline -void -arma_assert_same_size(const Cube& A, const subview_cube& B, const char* x) - { - if( (A.n_rows != B.n_rows) || (A.n_cols != B.n_cols) || (A.n_slices != B.n_slices) ) - { - arma_stop_logic_error( arma_incompat_size_string(A.n_rows, A.n_cols, A.n_slices, B.n_rows, B.n_cols, B.n_slices, x) ); - } - } - - - -template -arma_hot -inline -void -arma_assert_same_size(const subview_cube& A, const Cube& B, const char* x) - { - if( (A.n_rows != B.n_rows) || (A.n_cols != B.n_cols) || (A.n_slices != B.n_slices) ) - { - arma_stop_logic_error( arma_incompat_size_string(A.n_rows, A.n_cols, A.n_slices, B.n_rows, B.n_cols, B.n_slices, x) ); - } - } - - - -template -arma_hot -inline -void -arma_assert_same_size(const subview_cube& A, const subview_cube& B, const char* x) - { - if( (A.n_rows != B.n_rows) || (A.n_cols != B.n_cols) || (A.n_slices != B.n_slices)) - { - arma_stop_logic_error( arma_incompat_size_string(A.n_rows, A.n_cols, A.n_slices, B.n_rows, B.n_cols, B.n_slices, x) ); - } - } - - - -template -arma_hot -inline -void -arma_assert_same_size(const subview_cube& A, const ProxyCube& B, const char* x) - { - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - const uword A_n_slices = A.n_slices; - - const uword B_n_rows = B.get_n_rows(); - const uword B_n_cols = B.get_n_cols(); - const uword B_n_slices = B.get_n_slices(); - - if( (A_n_rows != B_n_rows) || (A_n_cols != B_n_cols) || (A_n_slices != B_n_slices) ) - { - arma_stop_logic_error( arma_incompat_size_string(A_n_rows, A_n_cols, A_n_slices, B_n_rows, B_n_cols, B_n_slices, x) ); - } - } - - - -//! stop if given cube proxies do not have the same size -template -arma_hot -inline -void -arma_assert_same_size(const ProxyCube& A, const ProxyCube& B, const char* x) - { - const uword A_n_rows = A.get_n_rows(); - const uword A_n_cols = A.get_n_cols(); - const uword A_n_slices = A.get_n_slices(); - - const uword B_n_rows = B.get_n_rows(); - const uword B_n_cols = B.get_n_cols(); - const uword B_n_slices = B.get_n_slices(); - - if( (A_n_rows != B_n_rows) || (A_n_cols != B_n_cols) || (A_n_slices != B_n_slices)) - { - arma_stop_logic_error( arma_incompat_size_string(A_n_rows, A_n_cols, A_n_slices, B_n_rows, B_n_cols, B_n_slices, x) ); - } - } - - - -// -// functions for checking whether a cube or subcube can be interpreted as a matrix (ie. single slice) - - - -template -arma_hot -inline -void -arma_assert_same_size(const Cube& A, const Mat& B, const char* x) - { - if( (A.n_rows != B.n_rows) || (A.n_cols != B.n_cols) || (A.n_slices != 1) ) - { - arma_stop_logic_error( arma_incompat_size_string(A.n_rows, A.n_cols, A.n_slices, B.n_rows, B.n_cols, 1, x) ); - } - } - - - -template -arma_hot -inline -void -arma_assert_same_size(const Mat& A, const Cube& B, const char* x) - { - if( (A.n_rows != B.n_rows) || (A.n_cols != B.n_cols) || (1 != B.n_slices) ) - { - arma_stop_logic_error( arma_incompat_size_string(A.n_rows, A.n_cols, 1, B.n_rows, B.n_cols, B.n_slices, x) ); - } - } - - - -template -arma_hot -inline -void -arma_assert_same_size(const subview_cube& A, const Mat& B, const char* x) - { - if( (A.n_rows != B.n_rows) || (A.n_cols != B.n_cols) || (A.n_slices != 1) ) - { - arma_stop_logic_error( arma_incompat_size_string(A.n_rows, A.n_cols, A.n_slices, B.n_rows, B.n_cols, 1, x) ); - } - } - - - -template -arma_hot -inline -void -arma_assert_same_size(const Mat& A, const subview_cube& B, const char* x) - { - if( (A.n_rows != B.n_rows) || (A.n_cols != B.n_cols) || (1 != B.n_slices) ) - { - arma_stop_logic_error( arma_incompat_size_string(A.n_rows, A.n_cols, 1, B.n_rows, B.n_cols, B.n_slices, x) ); - } - } - - - -template -inline -void -arma_assert_cube_as_mat(const Mat& M, const T1& Q, const char* x, const bool check_compat_size) - { - const uword Q_n_rows = Q.n_rows; - const uword Q_n_cols = Q.n_cols; - const uword Q_n_slices = Q.n_slices; - - const uword M_vec_state = M.vec_state; - - if(M_vec_state == 0) - { - if( ( (Q_n_rows == 1) || (Q_n_cols == 1) || (Q_n_slices == 1) ) == false ) - { - std::ostringstream tmp; - - tmp << x - << ": can't interpret cube with dimensions " - << Q_n_rows << 'x' << Q_n_cols << 'x' << Q_n_slices - << " as a matrix; one of the dimensions must be 1"; - - arma_stop_logic_error( tmp.str() ); - } - } - else - { - if(Q_n_slices == 1) - { - if( (M_vec_state == 1) && (Q_n_cols != 1) ) - { - std::ostringstream tmp; - - tmp << x - << ": can't interpret cube with dimensions " - << Q_n_rows << 'x' << Q_n_cols << 'x' << Q_n_slices - << " as a column vector"; - - arma_stop_logic_error( tmp.str() ); - } - - if( (M_vec_state == 2) && (Q_n_rows != 1) ) - { - std::ostringstream tmp; - - tmp << x - << ": can't interpret cube with dimensions " - << Q_n_rows << 'x' << Q_n_cols << 'x' << Q_n_slices - << " as a row vector"; - - arma_stop_logic_error( tmp.str() ); - } - } - else - { - if( (Q_n_cols != 1) && (Q_n_rows != 1) ) - { - std::ostringstream tmp; - - tmp << x - << ": can't interpret cube with dimensions " - << Q_n_rows << 'x' << Q_n_cols << 'x' << Q_n_slices - << " as a vector"; - - arma_stop_logic_error( tmp.str() ); - } - } - } - - - if(check_compat_size) - { - const uword M_n_rows = M.n_rows; - const uword M_n_cols = M.n_cols; - - if(M_vec_state == 0) - { - if( - ( - ( (Q_n_rows == M_n_rows) && (Q_n_cols == M_n_cols) ) - || - ( (Q_n_rows == M_n_rows) && (Q_n_slices == M_n_cols) ) - || - ( (Q_n_cols == M_n_rows) && (Q_n_slices == M_n_cols) ) - ) - == false - ) - { - std::ostringstream tmp; - - tmp << x - << ": can't interpret cube with dimensions " - << Q_n_rows << 'x' << Q_n_cols << 'x' << Q_n_slices - << " as a matrix with dimensions " - << M_n_rows << 'x' << M_n_cols; - - arma_stop_logic_error( tmp.str() ); - } - } - else - { - if(Q_n_slices == 1) - { - if( (M_vec_state == 1) && (Q_n_rows != M_n_rows) ) - { - std::ostringstream tmp; - - tmp << x - << ": can't interpret cube with dimensions " - << Q_n_rows << 'x' << Q_n_cols << 'x' << Q_n_slices - << " as a column vector with dimensions " - << M_n_rows << 'x' << M_n_cols; - - arma_stop_logic_error( tmp.str() ); - } - - if( (M_vec_state == 2) && (Q_n_cols != M_n_cols) ) - { - std::ostringstream tmp; - - tmp << x - << ": can't interpret cube with dimensions " - << Q_n_rows << 'x' << Q_n_cols << 'x' << Q_n_slices - << " as a row vector with dimensions " - << M_n_rows << 'x' << M_n_cols; - - arma_stop_logic_error( tmp.str() ); - } - } - else - { - if( ( (M_n_cols == Q_n_slices) || (M_n_rows == Q_n_slices) ) == false ) - { - std::ostringstream tmp; - - tmp << x - << ": can't interpret cube with dimensions " - << Q_n_rows << 'x' << Q_n_cols << 'x' << Q_n_slices - << " as a vector with dimensions " - << M_n_rows << 'x' << M_n_cols; - - arma_stop_logic_error( tmp.str() ); - } - } - } - } - } - - - -// -// functions for checking whether two matrices have dimensions that are compatible with the matrix multiply operation - - - -arma_hot -inline -void -arma_assert_mul_size(const uword A_n_rows, const uword A_n_cols, const uword B_n_rows, const uword B_n_cols, const char* x) - { - if(A_n_cols != B_n_rows) - { - arma_stop_logic_error( arma_incompat_size_string(A_n_rows, A_n_cols, B_n_rows, B_n_cols, x) ); - } - } - - - -//! stop if given matrices are incompatible for multiplication -template -arma_hot -inline -void -arma_assert_mul_size(const Mat& A, const Mat& B, const char* x) - { - const uword A_n_cols = A.n_cols; - const uword B_n_rows = B.n_rows; - - if(A_n_cols != B_n_rows) - { - arma_stop_logic_error( arma_incompat_size_string(A.n_rows, A_n_cols, B_n_rows, B.n_cols, x) ); - } - } - - - -//! stop if given matrices are incompatible for multiplication -template -arma_hot -inline -void -arma_assert_mul_size(const Mat& A, const Mat& B, const bool do_trans_A, const bool do_trans_B, const char* x) - { - const uword final_A_n_cols = (do_trans_A == false) ? A.n_cols : A.n_rows; - const uword final_B_n_rows = (do_trans_B == false) ? B.n_rows : B.n_cols; - - if(final_A_n_cols != final_B_n_rows) - { - const uword final_A_n_rows = (do_trans_A == false) ? A.n_rows : A.n_cols; - const uword final_B_n_cols = (do_trans_B == false) ? B.n_cols : B.n_rows; - - arma_stop_logic_error( arma_incompat_size_string(final_A_n_rows, final_A_n_cols, final_B_n_rows, final_B_n_cols, x) ); - } - } - - - -template -arma_hot -inline -void -arma_assert_trans_mul_size(const uword A_n_rows, const uword A_n_cols, const uword B_n_rows, const uword B_n_cols, const char* x) - { - const uword final_A_n_cols = (do_trans_A == false) ? A_n_cols : A_n_rows; - const uword final_B_n_rows = (do_trans_B == false) ? B_n_rows : B_n_cols; - - if(final_A_n_cols != final_B_n_rows) - { - const uword final_A_n_rows = (do_trans_A == false) ? A_n_rows : A_n_cols; - const uword final_B_n_cols = (do_trans_B == false) ? B_n_cols : B_n_rows; - - arma_stop_logic_error( arma_incompat_size_string(final_A_n_rows, final_A_n_cols, final_B_n_rows, final_B_n_cols, x) ); - } - } - - - -template -arma_hot -inline -void -arma_assert_mul_size(const Mat& A, const subview& B, const char* x) - { - if(A.n_cols != B.n_rows) - { - arma_stop_logic_error( arma_incompat_size_string(A.n_rows, A.n_cols, B.n_rows, B.n_cols, x) ); - } - } - - - -template -arma_hot -inline -void -arma_assert_mul_size(const subview& A, const Mat& B, const char* x) - { - if(A.n_cols != B.n_rows) - { - arma_stop_logic_error( arma_incompat_size_string(A.n_rows, A.n_cols, B.n_rows, B.n_cols, x) ); - } - } - - - -template -arma_hot -inline -void -arma_assert_mul_size(const subview& A, const subview& B, const char* x) - { - if(A.n_cols != B.n_rows) - { - arma_stop_logic_error( arma_incompat_size_string(A.n_rows, A.n_cols, B.n_rows, B.n_cols, x) ); - } - } - - - -template -arma_hot -inline -void -arma_assert_blas_size(const T1& A) - { - if(sizeof(uword) >= sizeof(blas_int)) - { - bool overflow; - - overflow = (A.n_rows > ARMA_MAX_BLAS_INT); - overflow = (A.n_cols > ARMA_MAX_BLAS_INT) || overflow; - - if(overflow) - { - arma_stop_runtime_error("integer overflow: matrix dimensions are too large for integer type used by BLAS and LAPACK"); - } - } - } - - - -template -arma_hot -inline -void -arma_assert_blas_size(const T1& A, const T2& B) - { - if(sizeof(uword) >= sizeof(blas_int)) - { - bool overflow; - - overflow = (A.n_rows > ARMA_MAX_BLAS_INT); - overflow = (A.n_cols > ARMA_MAX_BLAS_INT) || overflow; - overflow = (B.n_rows > ARMA_MAX_BLAS_INT) || overflow; - overflow = (B.n_cols > ARMA_MAX_BLAS_INT) || overflow; - - if(overflow) - { - arma_stop_runtime_error("integer overflow: matrix dimensions are too large for integer type used by BLAS and LAPACK"); - } - } - } - - - -// TODO: remove support for ATLAS in next major version -template -arma_hot -inline -void -arma_assert_atlas_size(const T1& A) - { - if(sizeof(uword) >= sizeof(int)) - { - bool overflow; - - overflow = (A.n_rows > INT_MAX); - overflow = (A.n_cols > INT_MAX) || overflow; - - if(overflow) - { - arma_stop_runtime_error("integer overflow: matrix dimensions are too large for integer type used by ATLAS"); - } - } - } - - - -// TODO: remove support for ATLAS in next major version -template -arma_hot -inline -void -arma_assert_atlas_size(const T1& A, const T2& B) - { - if(sizeof(uword) >= sizeof(int)) - { - bool overflow; - - overflow = (A.n_rows > INT_MAX); - overflow = (A.n_cols > INT_MAX) || overflow; - overflow = (B.n_rows > INT_MAX) || overflow; - overflow = (B.n_cols > INT_MAX) || overflow; - - if(overflow) - { - arma_stop_runtime_error("integer overflow: matrix dimensions are too large for integer type used by ATLAS"); - } - } - } - - - -// -// macros - - -// #define ARMA_STRING1(x) #x -// #define ARMA_STRING2(x) ARMA_STRING1(x) -// #define ARMA_FILELINE __FILE__ ": " ARMA_STRING2(__LINE__) - - -#if defined(ARMA_CHECK_CONFORMANCE) - - #define arma_conform_check arma_check - #define arma_conform_check_bounds arma_check_bounds - #define arma_conform_set_error arma_set_error - #define arma_conform_assert_same_size arma_assert_same_size - #define arma_conform_assert_mul_size arma_assert_mul_size - #define arma_conform_assert_trans_mul_size arma_assert_trans_mul_size - #define arma_conform_assert_cube_as_mat arma_assert_cube_as_mat - #define arma_conform_assert_blas_size arma_assert_blas_size - #define arma_conform_assert_atlas_size arma_assert_atlas_size - -#else - - #define arma_conform_check true ? (void)0 : arma_check - #define arma_conform_check_bounds true ? (void)0 : arma_check_bounds - #define arma_conform_set_error true ? (void)0 : arma_set_error - #define arma_conform_assert_same_size true ? (void)0 : arma_assert_same_size - #define arma_conform_assert_mul_size true ? (void)0 : arma_assert_mul_size - #define arma_conform_assert_trans_mul_size true ? (void)0 : arma_assert_trans_mul_size - #define arma_conform_assert_cube_as_mat true ? (void)0 : arma_assert_cube_as_mat - #define arma_conform_assert_blas_size true ? (void)0 : arma_assert_blas_size - #define arma_conform_assert_atlas_size true ? (void)0 : arma_assert_atlas_size - -#endif - - - -#if defined(ARMA_DEBUG) - - #define arma_debug_sigprint arma_sigprint(ARMA_FNSIG); arma_bktprint - #define arma_debug_sigprint_this arma_sigprint(ARMA_FNSIG); arma_thisprint - #define arma_debug_print arma_print - - // for compatibility with earlier versions of Armadillo - #define arma_extra_debug_sigprint arma_sigprint(ARMA_FNSIG); arma_bktprint - #define arma_extra_debug_sigprint_this arma_sigprint(ARMA_FNSIG); arma_thisprint - #define arma_extra_debug_print arma_print - -#else - - #define arma_debug_sigprint true ? (void)0 : arma_bktprint - #define arma_debug_sigprint_this true ? (void)0 : arma_thisprint - #define arma_debug_print true ? (void)0 : arma_print - - // for compatibility with earlier versions of Armadillo - #define arma_extra_debug_sigprint true ? (void)0 : arma_bktprint - #define arma_extra_debug_sigprint_this true ? (void)0 : arma_thisprint - #define arma_extra_debug_print true ? (void)0 : arma_print - -#endif - - -// for compatibility with earlier versions of Armadillo -arma_frown("use arma_conform_check() instead") -inline void arma_debug_check(bool state, const char* msg) { arma_conform_check(state, msg); } - - -#if defined(ARMA_DEBUG) - - namespace junk - { - class arma_first_debug_message - { - public: - - inline - arma_first_debug_message() - { - const char* nickname = ARMA_VERSION_NAME; - - std::ostream& out = get_cerr_stream(); - - out << "@ ---" << '\n'; - out << "@ Armadillo " - << arma_version::major << '.' << arma_version::minor << '.' << arma_version::patch - << " (" << nickname << ')'; - - out << "\n@ arma_config::wrapper = " << arma_config::wrapper; - out << "\n@ arma_config::cxx14 = " << arma_config::cxx14; - out << "\n@ arma_config::cxx17 = " << arma_config::cxx17; - out << "\n@ arma_config::cxx20 = " << arma_config::cxx20; - out << "\n@ arma_config::cxx23 = " << arma_config::cxx23; - out << "\n@ arma_config::std_mutex = " << arma_config::std_mutex; - out << "\n@ arma_config::posix = " << arma_config::posix; - out << "\n@ arma_config::openmp = " << arma_config::openmp; - out << "\n@ arma_config::lapack = " << arma_config::lapack; - out << "\n@ arma_config::blas = " << arma_config::blas; - out << "\n@ arma_config::newarp = " << arma_config::newarp; - out << "\n@ arma_config::arpack = " << arma_config::arpack; - out << "\n@ arma_config::superlu = " << arma_config::superlu; - out << "\n@ arma_config::atlas = " << arma_config::atlas; - out << "\n@ arma_config::hdf5 = " << arma_config::hdf5; - out << "\n@ arma_config::good_comp = " << arma_config::good_comp; - out << "\n@ arma_config::extra_code = " << arma_config::extra_code; - out << "\n@ arma_config::hidden_args = " << arma_config::hidden_args; - out << "\n@ arma_config::mat_prealloc = " << arma_config::mat_prealloc; - out << "\n@ arma_config::mp_threshold = " << arma_config::mp_threshold; - out << "\n@ arma_config::mp_threads = " << arma_config::mp_threads; - out << "\n@ arma_config::optimise_band = " << arma_config::optimise_band; - out << "\n@ arma_config::optimise_sym = " << arma_config::optimise_sym; - out << "\n@ arma_config::optimise_invexpr = " << arma_config::optimise_invexpr; - out << "\n@ arma_config::check_conform = " << arma_config::check_conform; - out << "\n@ arma_config::check_nonfinite = " << arma_config::check_nonfinite; - out << "\n@ arma_config::fast_math = " << arma_config::fast_math; - out << "\n@ sizeof(void*) = " << sizeof(void*); - out << "\n@ sizeof(int) = " << sizeof(int); - out << "\n@ sizeof(long) = " << sizeof(long); - out << "\n@ sizeof(uword) = " << sizeof(uword); - out << "\n@ sizeof(blas_int) = " << sizeof(blas_int); - out << "\n@ ---" << std::endl; - } - }; - - static arma_first_debug_message arma_first_debug_message_run; - } - -#endif - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/def_arpack.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/def_arpack.hpp deleted file mode 100644 index 5bbbb7f91..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/def_arpack.hpp +++ /dev/null @@ -1,109 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -#if defined(ARMA_USE_ARPACK) - -// I'm not sure this is necessary. -#if !defined(ARMA_BLAS_CAPITALS) - - #define arma_snaupd snaupd - #define arma_dnaupd dnaupd - #define arma_cnaupd cnaupd - #define arma_znaupd znaupd - - #define arma_sneupd sneupd - #define arma_dneupd dneupd - #define arma_cneupd cneupd - #define arma_zneupd zneupd - - #define arma_ssaupd ssaupd - #define arma_dsaupd dsaupd - - #define arma_sseupd sseupd - #define arma_dseupd dseupd - -#else - - #define arma_snaupd SNAUPD - #define arma_dnaupd DNAUPD - #define arma_cnaupd CNAUPD - #define arma_znaupd ZNAUPD - - #define arma_sneupd SNEUPD - #define arma_dneupd DNEUPD - #define arma_cneupd CNEUPD - #define arma_zneupd ZNEUPD - - #define arma_ssaupd SSAUPD - #define arma_dsaupd DSAUPD - - #define arma_sseupd SSEUPD - #define arma_dseupd DSEUPD - -#endif - -extern "C" -{ -#if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - - // eigendecomposition of non-symmetric positive semi-definite matrices - void arma_fortran(arma_snaupd)(blas_int* ido, char* bmat, blas_int* n, char* which, blas_int* nev, float* tol, float* resid, blas_int* ncv, float* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, float* workd, float* workl, blas_int* lworkl, blas_int* info, blas_len bmat_len, blas_len which_len); - void arma_fortran(arma_dnaupd)(blas_int* ido, char* bmat, blas_int* n, char* which, blas_int* nev, double* tol, double* resid, blas_int* ncv, double* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, double* workd, double* workl, blas_int* lworkl, blas_int* info, blas_len bmat_len, blas_len which_len); - void arma_fortran(arma_cnaupd)(blas_int* ido, char* bmat, blas_int* n, char* which, blas_int* nev, float* tol, void* resid, blas_int* ncv, void* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, void* workd, void* workl, blas_int* lworkl, float* rwork, blas_int* info, blas_len bmat_len, blas_len which_len); - void arma_fortran(arma_znaupd)(blas_int* ido, char* bmat, blas_int* n, char* which, blas_int* nev, double* tol, void* resid, blas_int* ncv, void* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, void* workd, void* workl, blas_int* lworkl, double* rwork, blas_int* info, blas_len bmat_len, blas_len which_len); - - // recovery of eigenvectors after naupd(); uses blas_int for LOGICAL types - void arma_fortran(arma_sneupd)(blas_int* rvec, char* howmny, blas_int* select, float* dr, float* di, float* z, blas_int* ldz, float* sigmar, float* sigmai, float* workev, char* bmat, blas_int* n, char* which, blas_int* nev, float* tol, float* resid, blas_int* ncv, float* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, float* workd, float* workl, blas_int* lworkl, blas_int* info, blas_len howmny_len, blas_len bmat_len, blas_len which_len); - void arma_fortran(arma_dneupd)(blas_int* rvec, char* howmny, blas_int* select, double* dr, double* di, double* z, blas_int* ldz, double* sigmar, double* sigmai, double* workev, char* bmat, blas_int* n, char* which, blas_int* nev, double* tol, double* resid, blas_int* ncv, double* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, double* workd, double* workl, blas_int* lworkl, blas_int* info, blas_len howmny_len, blas_len bmat_len, blas_len which_len); - void arma_fortran(arma_cneupd)(blas_int* rvec, char* howmny, blas_int* select, void* d, void* z, blas_int* ldz, void* sigma, void* workev, char* bmat, blas_int* n, char* which, blas_int* nev, float* tol, void* resid, blas_int* ncv, void* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, void* workd, void* workl, blas_int* lworkl, float* rwork, blas_int* info, blas_len howmny_len, blas_len bmat_len, blas_len which_len); - void arma_fortran(arma_zneupd)(blas_int* rvec, char* howmny, blas_int* select, void* d, void* z, blas_int* ldz, void* sigma, void* workev, char* bmat, blas_int* n, char* which, blas_int* nev, double* tol, void* resid, blas_int* ncv, void* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, void* workd, void* workl, blas_int* lworkl, double* rwork, blas_int* info, blas_len howmny_len, blas_len bmat_len, blas_len which_len); - - // eigendecomposition of symmetric positive semi-definite matrices - void arma_fortran(arma_ssaupd)(blas_int* ido, char* bmat, blas_int* n, char* which, blas_int* nev, float* tol, float* resid, blas_int* ncv, float* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, float* workd, float* workl, blas_int* lworkl, blas_int* info, blas_len bmat_len, blas_len which_len); - void arma_fortran(arma_dsaupd)(blas_int* ido, char* bmat, blas_int* n, char* which, blas_int* nev, double* tol, double* resid, blas_int* ncv, double* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, double* workd, double* workl, blas_int* lworkl, blas_int* info, blas_len bmat_len, blas_len which_len); - - // recovery of eigenvectors after saupd(); uses blas_int for LOGICAL types - void arma_fortran(arma_sseupd)(blas_int* rvec, char* howmny, blas_int* select, float* d, float* z, blas_int* ldz, float* sigma, char* bmat, blas_int* n, char* which, blas_int* nev, float* tol, float* resid, blas_int* ncv, float* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, float* workd, float* workl, blas_int* lworkl, blas_int* info, blas_len howmny_len, blas_len bmat_len, blas_len which_len); - void arma_fortran(arma_dseupd)(blas_int* rvec, char* howmny, blas_int* select, double* d, double* z, blas_int* ldz, double* sigma, char* bmat, blas_int* n, char* which, blas_int* nev, double* tol, double* resid, blas_int* ncv, double* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, double* workd, double* workl, blas_int* lworkl, blas_int* info, blas_len howmny_len, blas_len bmat_len, blas_len which_len); - -#else - - // eigendecomposition of non-symmetric positive semi-definite matrices - void arma_fortran(arma_snaupd)(blas_int* ido, char* bmat, blas_int* n, char* which, blas_int* nev, float* tol, float* resid, blas_int* ncv, float* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, float* workd, float* workl, blas_int* lworkl, blas_int* info); - void arma_fortran(arma_dnaupd)(blas_int* ido, char* bmat, blas_int* n, char* which, blas_int* nev, double* tol, double* resid, blas_int* ncv, double* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, double* workd, double* workl, blas_int* lworkl, blas_int* info); - void arma_fortran(arma_cnaupd)(blas_int* ido, char* bmat, blas_int* n, char* which, blas_int* nev, float* tol, void* resid, blas_int* ncv, void* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, void* workd, void* workl, blas_int* lworkl, float* rwork, blas_int* info); - void arma_fortran(arma_znaupd)(blas_int* ido, char* bmat, blas_int* n, char* which, blas_int* nev, double* tol, void* resid, blas_int* ncv, void* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, void* workd, void* workl, blas_int* lworkl, double* rwork, blas_int* info); - - // recovery of eigenvectors after naupd(); uses blas_int for LOGICAL types - void arma_fortran(arma_sneupd)(blas_int* rvec, char* howmny, blas_int* select, float* dr, float* di, float* z, blas_int* ldz, float* sigmar, float* sigmai, float* workev, char* bmat, blas_int* n, char* which, blas_int* nev, float* tol, float* resid, blas_int* ncv, float* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, float* workd, float* workl, blas_int* lworkl, blas_int* info); - void arma_fortran(arma_dneupd)(blas_int* rvec, char* howmny, blas_int* select, double* dr, double* di, double* z, blas_int* ldz, double* sigmar, double* sigmai, double* workev, char* bmat, blas_int* n, char* which, blas_int* nev, double* tol, double* resid, blas_int* ncv, double* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, double* workd, double* workl, blas_int* lworkl, blas_int* info); - void arma_fortran(arma_cneupd)(blas_int* rvec, char* howmny, blas_int* select, void* d, void* z, blas_int* ldz, void* sigma, void* workev, char* bmat, blas_int* n, char* which, blas_int* nev, float* tol, void* resid, blas_int* ncv, void* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, void* workd, void* workl, blas_int* lworkl, float* rwork, blas_int* info); - void arma_fortran(arma_zneupd)(blas_int* rvec, char* howmny, blas_int* select, void* d, void* z, blas_int* ldz, void* sigma, void* workev, char* bmat, blas_int* n, char* which, blas_int* nev, double* tol, void* resid, blas_int* ncv, void* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, void* workd, void* workl, blas_int* lworkl, double* rwork, blas_int* info); - - // eigendecomposition of symmetric positive semi-definite matrices - void arma_fortran(arma_ssaupd)(blas_int* ido, char* bmat, blas_int* n, char* which, blas_int* nev, float* tol, float* resid, blas_int* ncv, float* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, float* workd, float* workl, blas_int* lworkl, blas_int* info); - void arma_fortran(arma_dsaupd)(blas_int* ido, char* bmat, blas_int* n, char* which, blas_int* nev, double* tol, double* resid, blas_int* ncv, double* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, double* workd, double* workl, blas_int* lworkl, blas_int* info); - - // recovery of eigenvectors after saupd(); uses blas_int for LOGICAL types - void arma_fortran(arma_sseupd)(blas_int* rvec, char* howmny, blas_int* select, float* d, float* z, blas_int* ldz, float* sigma, char* bmat, blas_int* n, char* which, blas_int* nev, float* tol, float* resid, blas_int* ncv, float* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, float* workd, float* workl, blas_int* lworkl, blas_int* info); - void arma_fortran(arma_dseupd)(blas_int* rvec, char* howmny, blas_int* select, double* d, double* z, blas_int* ldz, double* sigma, char* bmat, blas_int* n, char* which, blas_int* nev, double* tol, double* resid, blas_int* ncv, double* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, double* workd, double* workl, blas_int* lworkl, blas_int* info); - -#endif -} - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/def_atlas.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/def_atlas.hpp deleted file mode 100644 index e410d9b0e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/def_atlas.hpp +++ /dev/null @@ -1,79 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -// TODO: remove support for ATLAS in next major version - -#if defined(ARMA_USE_ATLAS) - - -typedef enum - { - atlas_CblasRowMajor = 101, - atlas_CblasColMajor = 102 - } - atlas_CBLAS_LAYOUT; - -typedef enum - { - atlas_CblasNoTrans = 111, - atlas_CblasTrans = 112, - atlas_CblasConjTrans = 113 - } - atlas_CBLAS_TRANS; - -typedef enum - { - atlas_CblasUpper = 121, - atlas_CblasLower = 122 - } - atlas_CBLAS_UPLO; - - -extern "C" - { - float arma_wrapper(cblas_sasum)(const int N, const float *X, const int incX); - double arma_wrapper(cblas_dasum)(const int N, const double *X, const int incX); - - float arma_wrapper(cblas_snrm2)(const int N, const float *X, const int incX); - double arma_wrapper(cblas_dnrm2)(const int N, const double *X, const int incX); - - float arma_wrapper(cblas_sdot)(const int N, const float *X, const int incX, const float *Y, const int incY); - double arma_wrapper(cblas_ddot)(const int N, const double *X, const int incX, const double *Y, const int incY); - - void arma_wrapper(cblas_cdotu_sub)(const int N, const void *X, const int incX, const void *Y, const int incY, void *dotu); - void arma_wrapper(cblas_zdotu_sub)(const int N, const void *X, const int incX, const void *Y, const int incY, void *dotu); - - void arma_wrapper(cblas_sgemv)(const atlas_CBLAS_LAYOUT layout, const atlas_CBLAS_TRANS TransA, const int M, const int N, const float alpha, const float *A, const int lda, const float *X, const int incX, const float beta, float *Y, const int incY); - void arma_wrapper(cblas_dgemv)(const atlas_CBLAS_LAYOUT layout, const atlas_CBLAS_TRANS TransA, const int M, const int N, const double alpha, const double *A, const int lda, const double *X, const int incX, const double beta, double *Y, const int incY); - void arma_wrapper(cblas_cgemv)(const atlas_CBLAS_LAYOUT layout, const atlas_CBLAS_TRANS TransA, const int M, const int N, const void *alpha, const void *A, const int lda, const void *X, const int incX, const void *beta, void *Y, const int incY); - void arma_wrapper(cblas_zgemv)(const atlas_CBLAS_LAYOUT layout, const atlas_CBLAS_TRANS TransA, const int M, const int N, const void *alpha, const void *A, const int lda, const void *X, const int incX, const void *beta, void *Y, const int incY); - - void arma_wrapper(cblas_sgemm)(const atlas_CBLAS_LAYOUT layout, const atlas_CBLAS_TRANS TransA, const atlas_CBLAS_TRANS TransB, const int M, const int N, const int K, const float alpha, const float *A, const int lda, const float *B, const int ldb, const float beta, float *C, const int ldc); - void arma_wrapper(cblas_dgemm)(const atlas_CBLAS_LAYOUT layout, const atlas_CBLAS_TRANS TransA, const atlas_CBLAS_TRANS TransB, const int M, const int N, const int K, const double alpha, const double *A, const int lda, const double *B, const int ldb, const double beta, double *C, const int ldc); - void arma_wrapper(cblas_cgemm)(const atlas_CBLAS_LAYOUT layout, const atlas_CBLAS_TRANS TransA, const atlas_CBLAS_TRANS TransB, const int M, const int N, const int K, const void *alpha, const void *A, const int lda, const void *B, const int ldb, const void *beta, void *C, const int ldc); - void arma_wrapper(cblas_zgemm)(const atlas_CBLAS_LAYOUT layout, const atlas_CBLAS_TRANS TransA, const atlas_CBLAS_TRANS TransB, const int M, const int N, const int K, const void *alpha, const void *A, const int lda, const void *B, const int ldb, const void *beta, void *C, const int ldc); - - void arma_wrapper(cblas_ssyrk)(const atlas_CBLAS_LAYOUT layout, const atlas_CBLAS_UPLO Uplo, const atlas_CBLAS_TRANS Trans, const int N, const int K, const float alpha, const float *A, const int lda, const float beta, float *C, const int ldc); - void arma_wrapper(cblas_dsyrk)(const atlas_CBLAS_LAYOUT layout, const atlas_CBLAS_UPLO Uplo, const atlas_CBLAS_TRANS Trans, const int N, const int K, const double alpha, const double *A, const int lda, const double beta, double *C, const int ldc); - - void arma_wrapper(cblas_cherk)(const atlas_CBLAS_LAYOUT layout, const atlas_CBLAS_UPLO Uplo, const atlas_CBLAS_TRANS Trans, const int N, const int K, const float alpha, const void *A, const int lda, const float beta, void *C, const int ldc); - void arma_wrapper(cblas_zherk)(const atlas_CBLAS_LAYOUT layout, const atlas_CBLAS_UPLO Uplo, const atlas_CBLAS_TRANS Trans, const int N, const int K, const double alpha, const void *A, const int lda, const double beta, void *C, const int ldc); - } - - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/def_blas.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/def_blas.hpp deleted file mode 100644 index e27ca6c4c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/def_blas.hpp +++ /dev/null @@ -1,161 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -#if defined(ARMA_USE_BLAS) - -#if defined(dgemm) || defined(DGEMM) - #pragma message ("WARNING: detected possible interference with definitions of BLAS functions;") - #pragma message ("WARNING: include the armadillo header before any other header as a workaround") -#endif - - -#if defined(ARMA_BLAS_NOEXCEPT) - #undef ARMA_NOEXCEPT - #define ARMA_NOEXCEPT noexcept -#else - #undef ARMA_NOEXCEPT - #define ARMA_NOEXCEPT -#endif - - -#if !defined(ARMA_BLAS_CAPITALS) - - #define arma_sasum sasum - #define arma_dasum dasum - - #define arma_snrm2 snrm2 - #define arma_dnrm2 dnrm2 - - #define arma_sdot sdot - #define arma_ddot ddot - - #define arma_sgemv sgemv - #define arma_dgemv dgemv - #define arma_cgemv cgemv - #define arma_zgemv zgemv - - #define arma_sgemm sgemm - #define arma_dgemm dgemm - #define arma_cgemm cgemm - #define arma_zgemm zgemm - - #define arma_ssyrk ssyrk - #define arma_dsyrk dsyrk - - #define arma_cherk cherk - #define arma_zherk zherk - -#else - - #define arma_sasum SASUM - #define arma_dasum DASUM - - #define arma_snrm2 SNRM2 - #define arma_dnrm2 DNRM2 - - #define arma_sdot SDOT - #define arma_ddot DDOT - - #define arma_sgemv SGEMV - #define arma_dgemv DGEMV - #define arma_cgemv CGEMV - #define arma_zgemv ZGEMV - - #define arma_sgemm SGEMM - #define arma_dgemm DGEMM - #define arma_cgemm CGEMM - #define arma_zgemm ZGEMM - - #define arma_ssyrk SSYRK - #define arma_dsyrk DSYRK - - #define arma_cherk CHERK - #define arma_zherk ZHERK - -#endif - - -// NOTE: "For arguments of CHARACTER type, the character length is passed as a hidden argument at the end of the argument list." -// NOTE: https://gcc.gnu.org/onlinedocs/gfortran/Argument-passing-conventions.html - - -extern "C" -{ -#if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - - float arma_fortran(arma_sasum)(const blas_int* n, const float* x, const blas_int* incx) ARMA_NOEXCEPT; - double arma_fortran(arma_dasum)(const blas_int* n, const double* x, const blas_int* incx) ARMA_NOEXCEPT; - - float arma_fortran(arma_snrm2)(const blas_int* n, const float* x, const blas_int* incx) ARMA_NOEXCEPT; - double arma_fortran(arma_dnrm2)(const blas_int* n, const double* x, const blas_int* incx) ARMA_NOEXCEPT; - - float arma_fortran(arma_sdot)(const blas_int* n, const float* x, const blas_int* incx, const float* y, const blas_int* incy) ARMA_NOEXCEPT; - double arma_fortran(arma_ddot)(const blas_int* n, const double* x, const blas_int* incx, const double* y, const blas_int* incy) ARMA_NOEXCEPT; - - void arma_fortran(arma_sgemv)(const char* transA, const blas_int* m, const blas_int* n, const float* alpha, const float* A, const blas_int* ldA, const float* x, const blas_int* incx, const float* beta, float* y, const blas_int* incy, blas_len transA_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dgemv)(const char* transA, const blas_int* m, const blas_int* n, const double* alpha, const double* A, const blas_int* ldA, const double* x, const blas_int* incx, const double* beta, double* y, const blas_int* incy, blas_len transA_len) ARMA_NOEXCEPT; - void arma_fortran(arma_cgemv)(const char* transA, const blas_int* m, const blas_int* n, const blas_cxf* alpha, const blas_cxf* A, const blas_int* ldA, const blas_cxf* x, const blas_int* incx, const blas_cxf* beta, blas_cxf* y, const blas_int* incy, blas_len transA_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zgemv)(const char* transA, const blas_int* m, const blas_int* n, const blas_cxd* alpha, const blas_cxd* A, const blas_int* ldA, const blas_cxd* x, const blas_int* incx, const blas_cxd* beta, blas_cxd* y, const blas_int* incy, blas_len transA_len) ARMA_NOEXCEPT; - - void arma_fortran(arma_sgemm)(const char* transA, const char* transB, const blas_int* m, const blas_int* n, const blas_int* k, const float* alpha, const float* A, const blas_int* ldA, const float* B, const blas_int* ldB, const float* beta, float* C, const blas_int* ldC, blas_len transA_len, blas_len transB_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dgemm)(const char* transA, const char* transB, const blas_int* m, const blas_int* n, const blas_int* k, const double* alpha, const double* A, const blas_int* ldA, const double* B, const blas_int* ldB, const double* beta, double* C, const blas_int* ldC, blas_len transA_len, blas_len transB_len) ARMA_NOEXCEPT; - void arma_fortran(arma_cgemm)(const char* transA, const char* transB, const blas_int* m, const blas_int* n, const blas_int* k, const blas_cxf* alpha, const blas_cxf* A, const blas_int* ldA, const blas_cxf* B, const blas_int* ldB, const blas_cxf* beta, blas_cxf* C, const blas_int* ldC, blas_len transA_len, blas_len transB_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zgemm)(const char* transA, const char* transB, const blas_int* m, const blas_int* n, const blas_int* k, const blas_cxd* alpha, const blas_cxd* A, const blas_int* ldA, const blas_cxd* B, const blas_int* ldB, const blas_cxd* beta, blas_cxd* C, const blas_int* ldC, blas_len transA_len, blas_len transB_len) ARMA_NOEXCEPT; - - void arma_fortran(arma_ssyrk)(const char* uplo, const char* transA, const blas_int* n, const blas_int* k, const float* alpha, const float* A, const blas_int* ldA, const float* beta, float* C, const blas_int* ldC, blas_len uplo_len, blas_len transA_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dsyrk)(const char* uplo, const char* transA, const blas_int* n, const blas_int* k, const double* alpha, const double* A, const blas_int* ldA, const double* beta, double* C, const blas_int* ldC, blas_len uplo_len, blas_len transA_len) ARMA_NOEXCEPT; - - void arma_fortran(arma_cherk)(const char* uplo, const char* transA, const blas_int* n, const blas_int* k, const float* alpha, const blas_cxf* A, const blas_int* ldA, const float* beta, blas_cxf* C, const blas_int* ldC, blas_len uplo_len, blas_len transA_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zherk)(const char* uplo, const char* transA, const blas_int* n, const blas_int* k, const double* alpha, const blas_cxd* A, const blas_int* ldA, const double* beta, blas_cxd* C, const blas_int* ldC, blas_len uplo_len, blas_len transA_len) ARMA_NOEXCEPT; - -#else - - // prototypes without hidden arguments - - float arma_fortran(arma_sasum)(const blas_int* n, const float* x, const blas_int* incx) ARMA_NOEXCEPT; - double arma_fortran(arma_dasum)(const blas_int* n, const double* x, const blas_int* incx) ARMA_NOEXCEPT; - - float arma_fortran(arma_snrm2)(const blas_int* n, const float* x, const blas_int* incx) ARMA_NOEXCEPT; - double arma_fortran(arma_dnrm2)(const blas_int* n, const double* x, const blas_int* incx) ARMA_NOEXCEPT; - - float arma_fortran(arma_sdot)(const blas_int* n, const float* x, const blas_int* incx, const float* y, const blas_int* incy) ARMA_NOEXCEPT; - double arma_fortran(arma_ddot)(const blas_int* n, const double* x, const blas_int* incx, const double* y, const blas_int* incy) ARMA_NOEXCEPT; - - void arma_fortran(arma_sgemv)(const char* transA, const blas_int* m, const blas_int* n, const float* alpha, const float* A, const blas_int* ldA, const float* x, const blas_int* incx, const float* beta, float* y, const blas_int* incy) ARMA_NOEXCEPT; - void arma_fortran(arma_dgemv)(const char* transA, const blas_int* m, const blas_int* n, const double* alpha, const double* A, const blas_int* ldA, const double* x, const blas_int* incx, const double* beta, double* y, const blas_int* incy) ARMA_NOEXCEPT; - void arma_fortran(arma_cgemv)(const char* transA, const blas_int* m, const blas_int* n, const blas_cxf* alpha, const blas_cxf* A, const blas_int* ldA, const blas_cxf* x, const blas_int* incx, const blas_cxf* beta, blas_cxf* y, const blas_int* incy) ARMA_NOEXCEPT; - void arma_fortran(arma_zgemv)(const char* transA, const blas_int* m, const blas_int* n, const blas_cxd* alpha, const blas_cxd* A, const blas_int* ldA, const blas_cxd* x, const blas_int* incx, const blas_cxd* beta, blas_cxd* y, const blas_int* incy) ARMA_NOEXCEPT; - - void arma_fortran(arma_sgemm)(const char* transA, const char* transB, const blas_int* m, const blas_int* n, const blas_int* k, const float* alpha, const float* A, const blas_int* ldA, const float* B, const blas_int* ldB, const float* beta, float* C, const blas_int* ldC) ARMA_NOEXCEPT; - void arma_fortran(arma_dgemm)(const char* transA, const char* transB, const blas_int* m, const blas_int* n, const blas_int* k, const double* alpha, const double* A, const blas_int* ldA, const double* B, const blas_int* ldB, const double* beta, double* C, const blas_int* ldC) ARMA_NOEXCEPT; - void arma_fortran(arma_cgemm)(const char* transA, const char* transB, const blas_int* m, const blas_int* n, const blas_int* k, const blas_cxf* alpha, const blas_cxf* A, const blas_int* ldA, const blas_cxf* B, const blas_int* ldB, const blas_cxf* beta, blas_cxf* C, const blas_int* ldC) ARMA_NOEXCEPT; - void arma_fortran(arma_zgemm)(const char* transA, const char* transB, const blas_int* m, const blas_int* n, const blas_int* k, const blas_cxd* alpha, const blas_cxd* A, const blas_int* ldA, const blas_cxd* B, const blas_int* ldB, const blas_cxd* beta, blas_cxd* C, const blas_int* ldC) ARMA_NOEXCEPT; - - void arma_fortran(arma_ssyrk)(const char* uplo, const char* transA, const blas_int* n, const blas_int* k, const float* alpha, const float* A, const blas_int* ldA, const float* beta, float* C, const blas_int* ldC) ARMA_NOEXCEPT; - void arma_fortran(arma_dsyrk)(const char* uplo, const char* transA, const blas_int* n, const blas_int* k, const double* alpha, const double* A, const blas_int* ldA, const double* beta, double* C, const blas_int* ldC) ARMA_NOEXCEPT; - - void arma_fortran(arma_cherk)(const char* uplo, const char* transA, const blas_int* n, const blas_int* k, const float* alpha, const blas_cxf* A, const blas_int* ldA, const float* beta, blas_cxf* C, const blas_int* ldC) ARMA_NOEXCEPT; - void arma_fortran(arma_zherk)(const char* uplo, const char* transA, const blas_int* n, const blas_int* k, const double* alpha, const blas_cxd* A, const blas_int* ldA, const double* beta, blas_cxd* C, const blas_int* ldC) ARMA_NOEXCEPT; - -#endif -} - -#undef ARMA_NOEXCEPT - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/def_fftw3.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/def_fftw3.hpp deleted file mode 100644 index a2dce5f70..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/def_fftw3.hpp +++ /dev/null @@ -1,56 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -#if defined(ARMA_USE_FFTW3) && !defined(FFTW3_H) - - -// prefix for single precision: fftwf_ -// prefix for double precision: fftw_ - - -typedef void fftwf_complex; -typedef void fftw_complex; - -typedef void_ptr fftwf_plan; -typedef void_ptr fftw_plan; - - -extern "C" - { - // single precision (float) - - fftwf_plan fftwf_plan_dft_1d(int N, fftwf_complex* input, fftwf_complex* output, int fftw3_sign, unsigned int fftw3_flags); - - void fftwf_execute(fftwf_plan plan); - void fftwf_destroy_plan(fftwf_plan plan); - - void fftwf_cleanup(); - - - // double precision (double) - - fftw_plan fftw_plan_dft_1d(int N, fftw_complex* input, fftw_complex* output, int fftw3_sign, unsigned int fftw3_flags); - - void fftw_execute(fftw_plan plan); - void fftw_destroy_plan(fftw_plan plan); - - void fftw_cleanup(); - } - - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/def_lapack.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/def_lapack.hpp deleted file mode 100644 index 00854ab09..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/def_lapack.hpp +++ /dev/null @@ -1,1178 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -#if defined(ARMA_USE_LAPACK) - -#if defined(dgetrf) || defined(DGETRF) - #pragma message ("WARNING: detected possible interference with definitions of LAPACK functions;") - #pragma message ("WARNING: include the armadillo header before any other header as a workaround") -#endif - - -#if defined(ARMA_LAPACK_NOEXCEPT) - #undef ARMA_NOEXCEPT - #define ARMA_NOEXCEPT noexcept -#else - #undef ARMA_NOEXCEPT - #define ARMA_NOEXCEPT -#endif - - -#if !defined(ARMA_BLAS_CAPITALS) - #define arma_sgetrf sgetrf - #define arma_dgetrf dgetrf - #define arma_cgetrf cgetrf - #define arma_zgetrf zgetrf - - #define arma_sgetrs sgetrs - #define arma_dgetrs dgetrs - #define arma_cgetrs cgetrs - #define arma_zgetrs zgetrs - - #define arma_sgetri sgetri - #define arma_dgetri dgetri - #define arma_cgetri cgetri - #define arma_zgetri zgetri - - #define arma_strtri strtri - #define arma_dtrtri dtrtri - #define arma_ctrtri ctrtri - #define arma_ztrtri ztrtri - - #define arma_sgeev sgeev - #define arma_dgeev dgeev - #define arma_cgeev cgeev - #define arma_zgeev zgeev - - #define arma_sgeevx sgeevx - #define arma_dgeevx dgeevx - #define arma_cgeevx cgeevx - #define arma_zgeevx zgeevx - - #define arma_ssyev ssyev - #define arma_dsyev dsyev - - #define arma_cheev cheev - #define arma_zheev zheev - - #define arma_ssyevd ssyevd - #define arma_dsyevd dsyevd - - #define arma_cheevd cheevd - #define arma_zheevd zheevd - - #define arma_sggev sggev - #define arma_dggev dggev - - #define arma_cggev cggev - #define arma_zggev zggev - - #define arma_spotrf spotrf - #define arma_dpotrf dpotrf - #define arma_cpotrf cpotrf - #define arma_zpotrf zpotrf - - #define arma_spotrs spotrs - #define arma_dpotrs dpotrs - #define arma_cpotrs cpotrs - #define arma_zpotrs zpotrs - - #define arma_spbtrf spbtrf - #define arma_dpbtrf dpbtrf - #define arma_cpbtrf cpbtrf - #define arma_zpbtrf zpbtrf - - #define arma_spotri spotri - #define arma_dpotri dpotri - #define arma_cpotri cpotri - #define arma_zpotri zpotri - - #define arma_sgeqrf sgeqrf - #define arma_dgeqrf dgeqrf - #define arma_cgeqrf cgeqrf - #define arma_zgeqrf zgeqrf - - #define arma_sgeqp3 sgeqp3 - #define arma_dgeqp3 dgeqp3 - #define arma_cgeqp3 cgeqp3 - #define arma_zgeqp3 zgeqp3 - - #define arma_sorgqr sorgqr - #define arma_dorgqr dorgqr - - #define arma_cungqr cungqr - #define arma_zungqr zungqr - - #define arma_sgesvd sgesvd - #define arma_dgesvd dgesvd - - #define arma_cgesvd cgesvd - #define arma_zgesvd zgesvd - - #define arma_sgesdd sgesdd - #define arma_dgesdd dgesdd - #define arma_cgesdd cgesdd - #define arma_zgesdd zgesdd - - #define arma_sgesv sgesv - #define arma_dgesv dgesv - #define arma_cgesv cgesv - #define arma_zgesv zgesv - - #define arma_sgesvx sgesvx - #define arma_dgesvx dgesvx - #define arma_cgesvx cgesvx - #define arma_zgesvx zgesvx - - #define arma_sposv sposv - #define arma_dposv dposv - #define arma_cposv cposv - #define arma_zposv zposv - - #define arma_sposvx sposvx - #define arma_dposvx dposvx - #define arma_cposvx cposvx - #define arma_zposvx zposvx - - #define arma_sgels sgels - #define arma_dgels dgels - #define arma_cgels cgels - #define arma_zgels zgels - - #define arma_sgelsd sgelsd - #define arma_dgelsd dgelsd - #define arma_cgelsd cgelsd - #define arma_zgelsd zgelsd - - #define arma_strtrs strtrs - #define arma_dtrtrs dtrtrs - #define arma_ctrtrs ctrtrs - #define arma_ztrtrs ztrtrs - - #define arma_sgbtrf sgbtrf - #define arma_dgbtrf dgbtrf - #define arma_cgbtrf cgbtrf - #define arma_zgbtrf zgbtrf - - #define arma_sgbtrs sgbtrs - #define arma_dgbtrs dgbtrs - #define arma_cgbtrs cgbtrs - #define arma_zgbtrs zgbtrs - - #define arma_sgbsv sgbsv - #define arma_dgbsv dgbsv - #define arma_cgbsv cgbsv - #define arma_zgbsv zgbsv - - #define arma_sgbsvx sgbsvx - #define arma_dgbsvx dgbsvx - #define arma_cgbsvx cgbsvx - #define arma_zgbsvx zgbsvx - - #define arma_sgtsv sgtsv - #define arma_dgtsv dgtsv - #define arma_cgtsv cgtsv - #define arma_zgtsv zgtsv - - #define arma_sgtsvx sgtsvx - #define arma_dgtsvx dgtsvx - #define arma_cgtsvx cgtsvx - #define arma_zgtsvx zgtsvx - - #define arma_sgees sgees - #define arma_dgees dgees - #define arma_cgees cgees - #define arma_zgees zgees - - #define arma_strsyl strsyl - #define arma_dtrsyl dtrsyl - #define arma_ctrsyl ctrsyl - #define arma_ztrsyl ztrsyl - - #define arma_sgges sgges - #define arma_dgges dgges - #define arma_cgges cgges - #define arma_zgges zgges - - #define arma_slange slange - #define arma_dlange dlange - #define arma_clange clange - #define arma_zlange zlange - - #define arma_slansy slansy - #define arma_dlansy dlansy - #define arma_clansy clansy - #define arma_zlansy zlansy - - #define arma_clanhe clanhe - #define arma_zlanhe zlanhe - - #define arma_slangb slangb - #define arma_dlangb dlangb - #define arma_clangb clangb - #define arma_zlangb zlangb - - #define arma_sgecon sgecon - #define arma_dgecon dgecon - #define arma_cgecon cgecon - #define arma_zgecon zgecon - - #define arma_spocon spocon - #define arma_dpocon dpocon - #define arma_cpocon cpocon - #define arma_zpocon zpocon - - #define arma_strcon strcon - #define arma_dtrcon dtrcon - #define arma_ctrcon ctrcon - #define arma_ztrcon ztrcon - - #define arma_sgbcon sgbcon - #define arma_dgbcon dgbcon - #define arma_cgbcon cgbcon - #define arma_zgbcon zgbcon - - #define arma_ilaenv ilaenv - - #define arma_slahqr slahqr - #define arma_dlahqr dlahqr - - #define arma_sstedc sstedc - #define arma_dstedc dstedc - - #define arma_strevc strevc - #define arma_dtrevc dtrevc - - #define arma_sgehrd sgehrd - #define arma_dgehrd dgehrd - #define arma_cgehrd cgehrd - #define arma_zgehrd zgehrd - - #define arma_spstrf spstrf - #define arma_dpstrf dpstrf - #define arma_cpstrf cpstrf - #define arma_zpstrf zpstrf - -#else - - #define arma_sgetrf SGETRF - #define arma_dgetrf DGETRF - #define arma_cgetrf CGETRF - #define arma_zgetrf ZGETRF - - #define arma_sgetrs SGETRS - #define arma_dgetrs DGETRS - #define arma_cgetrs CGETRS - #define arma_zgetrs ZGETRS - - #define arma_sgetri SGETRI - #define arma_dgetri DGETRI - #define arma_cgetri CGETRI - #define arma_zgetri ZGETRI - - #define arma_strtri STRTRI - #define arma_dtrtri DTRTRI - #define arma_ctrtri CTRTRI - #define arma_ztrtri ZTRTRI - - #define arma_sgeev SGEEV - #define arma_dgeev DGEEV - #define arma_cgeev CGEEV - #define arma_zgeev ZGEEV - - #define arma_sgeevx SGEEVX - #define arma_dgeevx DGEEVX - #define arma_cgeevx CGEEVX - #define arma_zgeevx ZGEEVX - - #define arma_ssyev SSYEV - #define arma_dsyev DSYEV - - #define arma_cheev CHEEV - #define arma_zheev ZHEEV - - #define arma_ssyevd SSYEVD - #define arma_dsyevd DSYEVD - - #define arma_cheevd CHEEVD - #define arma_zheevd ZHEEVD - - #define arma_sggev SGGEV - #define arma_dggev DGGEV - - #define arma_cggev CGGEV - #define arma_zggev ZGGEV - - #define arma_spotrf SPOTRF - #define arma_dpotrf DPOTRF - #define arma_cpotrf CPOTRF - #define arma_zpotrf ZPOTRF - - #define arma_spotrs SPOTRS - #define arma_dpotrs DPOTRS - #define arma_cpotrs CPOTRS - #define arma_zpotrs ZPOTRS - - #define arma_spbtrf SPBTRF - #define arma_dpbtrf DPBTRF - #define arma_cpbtrf CPBTRF - #define arma_zpbtrf ZPBTRF - - #define arma_spotri SPOTRI - #define arma_dpotri DPOTRI - #define arma_cpotri CPOTRI - #define arma_zpotri ZPOTRI - - #define arma_sgeqrf SGEQRF - #define arma_dgeqrf DGEQRF - #define arma_cgeqrf CGEQRF - #define arma_zgeqrf ZGEQRF - - #define arma_sgeqp3 SGEQP3 - #define arma_dgeqp3 DGEQP3 - #define arma_cgeqp3 CGEQP3 - #define arma_zgeqp3 ZGEQP3 - - #define arma_sorgqr SORGQR - #define arma_dorgqr DORGQR - - #define arma_cungqr CUNGQR - #define arma_zungqr ZUNGQR - - #define arma_sgesvd SGESVD - #define arma_dgesvd DGESVD - - #define arma_cgesvd CGESVD - #define arma_zgesvd ZGESVD - - #define arma_sgesdd SGESDD - #define arma_dgesdd DGESDD - #define arma_cgesdd CGESDD - #define arma_zgesdd ZGESDD - - #define arma_sgesv SGESV - #define arma_dgesv DGESV - #define arma_cgesv CGESV - #define arma_zgesv ZGESV - - #define arma_sgesvx SGESVX - #define arma_dgesvx DGESVX - #define arma_cgesvx CGESVX - #define arma_zgesvx ZGESVX - - #define arma_sposv SPOSV - #define arma_dposv DPOSV - #define arma_cposv CPOSV - #define arma_zposv ZPOSV - - #define arma_sposvx SPOSVX - #define arma_dposvx DPOSVX - #define arma_cposvx CPOSVX - #define arma_zposvx ZPOSVX - - #define arma_sgels SGELS - #define arma_dgels DGELS - #define arma_cgels CGELS - #define arma_zgels ZGELS - - #define arma_sgelsd SGELSD - #define arma_dgelsd DGELSD - #define arma_cgelsd CGELSD - #define arma_zgelsd ZGELSD - - #define arma_strtrs STRTRS - #define arma_dtrtrs DTRTRS - #define arma_ctrtrs CTRTRS - #define arma_ztrtrs ZTRTRS - - #define arma_sgbtrf SGBTRF - #define arma_dgbtrf DGBTRF - #define arma_cgbtrf CGBTRF - #define arma_zgbtrf ZGBTRF - - #define arma_sgbtrs SGBTRS - #define arma_dgbtrs DGBTRS - #define arma_cgbtrs CGBTRS - #define arma_zgbtrs ZGBTRS - - #define arma_sgbsv SGBSV - #define arma_dgbsv DGBSV - #define arma_cgbsv CGBSV - #define arma_zgbsv ZGBSV - - #define arma_sgbsvx SGBSVX - #define arma_dgbsvx DGBSVX - #define arma_cgbsvx CGBSVX - #define arma_zgbsvx ZGBSVX - - #define arma_sgtsv SGTSV - #define arma_dgtsv DGTSV - #define arma_cgtsv CGTSV - #define arma_zgtsv ZGTSV - - #define arma_sgtsvx SGTSVX - #define arma_dgtsvx DGTSVX - #define arma_cgtsvx CGTSVX - #define arma_zgtsvx ZGTSVX - - #define arma_sgees SGEES - #define arma_dgees DGEES - #define arma_cgees CGEES - #define arma_zgees ZGEES - - #define arma_strsyl STRSYL - #define arma_dtrsyl DTRSYL - #define arma_ctrsyl CTRSYL - #define arma_ztrsyl ZTRSYL - - #define arma_sgges SGGES - #define arma_dgges DGGES - #define arma_cgges CGGES - #define arma_zgges ZGGES - - #define arma_slange SLANGE - #define arma_dlange DLANGE - #define arma_clange CLANGE - #define arma_zlange ZLANGE - - #define arma_slansy SLANSY - #define arma_dlansy DLANSY - #define arma_clansy CLANSY - #define arma_zlansy ZLANSY - - #define arma_clanhe CLANHE - #define arma_zlanhe ZLANHE - - #define arma_slangb SLANGB - #define arma_dlangb DLANGB - #define arma_clangb CLANGB - #define arma_zlangb ZLANGB - - #define arma_sgecon SGECON - #define arma_dgecon DGECON - #define arma_cgecon CGECON - #define arma_zgecon ZGECON - - #define arma_spocon SPOCON - #define arma_dpocon DPOCON - #define arma_cpocon CPOCON - #define arma_zpocon ZPOCON - - #define arma_strcon STRCON - #define arma_dtrcon DTRCON - #define arma_ctrcon CTRCON - #define arma_ztrcon ZTRCON - - #define arma_sgbcon SGBCON - #define arma_dgbcon DGBCON - #define arma_cgbcon CGBCON - #define arma_zgbcon ZGBCON - - #define arma_ilaenv ILAENV - - #define arma_slahqr SLAHQR - #define arma_dlahqr DLAHQR - - #define arma_sstedc SSTEDC - #define arma_dstedc DSTEDC - - #define arma_strevc STREVC - #define arma_dtrevc DTREVC - - #define arma_sgehrd SGEHRD - #define arma_dgehrd DGEHRD - #define arma_cgehrd CGEHRD - #define arma_zgehrd ZGEHRD - - #define arma_spstrf SPSTRF - #define arma_dpstrf DPSTRF - #define arma_cpstrf CPSTRF - #define arma_zpstrf ZPSTRF - -#endif - - -typedef blas_int (*fn_select_s2) (const float*, const float* ); -typedef blas_int (*fn_select_s3) (const float*, const float*, const float*); - -typedef blas_int (*fn_select_d2) (const double*, const double* ); -typedef blas_int (*fn_select_d3) (const double*, const double*, const double*); - -typedef blas_int (*fn_select_c1) (const blas_cxf* ); -typedef blas_int (*fn_select_c2) (const blas_cxf*, const blas_cxf*); - -typedef blas_int (*fn_select_z1) (const blas_cxd* ); -typedef blas_int (*fn_select_z2) (const blas_cxd*, const blas_cxd*); - - -// NOTE: "For arguments of CHARACTER type, the character length is passed as a hidden argument at the end of the argument list." -// NOTE: https://gcc.gnu.org/onlinedocs/gfortran/Argument-passing-conventions.html - - -extern "C" -{ -#if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - - // LU decomposition - void arma_fortran(arma_sgetrf)(const blas_int* m, const blas_int* n, float* a, const blas_int* lda, blas_int* ipiv, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgetrf)(const blas_int* m, const blas_int* n, double* a, const blas_int* lda, blas_int* ipiv, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cgetrf)(const blas_int* m, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_int* ipiv, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgetrf)(const blas_int* m, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_int* ipiv, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations using pre-computed LU decomposition - void arma_fortran(arma_sgetrs)(const char* trans, const blas_int* n, const blas_int* nrhs, const float* a, const blas_int* lda, const blas_int* ipiv, float* b, const blas_int* ldb, blas_int* info, const blas_len trans_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dgetrs)(const char* trans, const blas_int* n, const blas_int* nrhs, const double* a, const blas_int* lda, const blas_int* ipiv, double* b, const blas_int* ldb, blas_int* info, const blas_len trans_len) ARMA_NOEXCEPT; - void arma_fortran(arma_cgetrs)(const char* trans, const blas_int* n, const blas_int* nrhs, const blas_cxf* a, const blas_int* lda, const blas_int* ipiv, blas_cxf* b, const blas_int* ldb, blas_int* info, const blas_len trans_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zgetrs)(const char* trans, const blas_int* n, const blas_int* nrhs, const blas_cxd* a, const blas_int* lda, const blas_int* ipiv, blas_cxd* b, const blas_int* ldb, blas_int* info, const blas_len trans_len) ARMA_NOEXCEPT; - - // matrix inversion (using pre-computed LU decomposition) - void arma_fortran(arma_sgetri)(const blas_int* n, float* a, const blas_int* lda, const blas_int* ipiv, float* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgetri)(const blas_int* n, double* a, const blas_int* lda, const blas_int* ipiv, double* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cgetri)(const blas_int* n, blas_cxf* a, const blas_int* lda, const blas_int* ipiv, blas_cxf* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgetri)(const blas_int* n, blas_cxd* a, const blas_int* lda, const blas_int* ipiv, blas_cxd* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - - // matrix inversion (triangular matrices) - void arma_fortran(arma_strtri)(const char* uplo, const char* diag, const blas_int* n, float* a, const blas_int* lda, blas_int* info, blas_len uplo_len, blas_len diag_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dtrtri)(const char* uplo, const char* diag, const blas_int* n, double* a, const blas_int* lda, blas_int* info, blas_len uplo_len, blas_len diag_len) ARMA_NOEXCEPT; - void arma_fortran(arma_ctrtri)(const char* uplo, const char* diag, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_int* info, blas_len uplo_len, blas_len diag_len) ARMA_NOEXCEPT; - void arma_fortran(arma_ztrtri)(const char* uplo, const char* diag, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_int* info, blas_len uplo_len, blas_len diag_len) ARMA_NOEXCEPT; - - // eigen decomposition of general matrix (real) - void arma_fortran(arma_sgeev)(const char* jobvl, const char* jobvr, const blas_int* n, float* a, const blas_int* lda, float* wr, float* wi, float* vl, const blas_int* ldvl, float* vr, const blas_int* ldvr, float* work, const blas_int* lwork, blas_int* info, blas_len jobvl_len, blas_len jobvr_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dgeev)(const char* jobvl, const char* jobvr, const blas_int* n, double* a, const blas_int* lda, double* wr, double* wi, double* vl, const blas_int* ldvl, double* vr, const blas_int* ldvr, double* work, const blas_int* lwork, blas_int* info, blas_len jobvl_len, blas_len jobvr_len) ARMA_NOEXCEPT; - - // eigen decomposition of general matrix (complex) - void arma_fortran(arma_cgeev)(const char* jobvl, const char* jobvr, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_cxf* w, blas_cxf* vl, const blas_int* ldvl, blas_cxf* vr, const blas_int* ldvr, blas_cxf* work, const blas_int* lwork, float* rwork, blas_int* info, blas_len jobvl_len, blas_len jobvr_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zgeev)(const char* jobvl, const char* jobvr, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_cxd* w, blas_cxd* vl, const blas_int* ldvl, blas_cxd* vr, const blas_int* ldvr, blas_cxd* work, const blas_int* lwork, double* rwork, blas_int* info, blas_len jobvl_len, blas_len jobvr_len) ARMA_NOEXCEPT; - - // eigen decomposition of general matrix (real; advanced form) - void arma_fortran(arma_sgeevx)(const char* balanc, const char* jobvl, const char* jobvr, const char* sense, const blas_int* n, float* a, const blas_int* lda, float* wr, float* wi, float* vl, const blas_int* ldvl, float* vr, const blas_int* ldvr, blas_int* ilo, blas_int* ihi, float* scale, float* abnrm, float* rconde, float* rcondv, float* work, const blas_int* lwork, blas_int* iwork, blas_int* info, blas_len balanc_len, blas_len jobvl_len, blas_len jobvr_len, blas_len sense_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dgeevx)(const char* balanc, const char* jobvl, const char* jobvr, const char* sense, const blas_int* n, double* a, const blas_int* lda, double* wr, double* wi, double* vl, const blas_int* ldvl, double* vr, const blas_int* ldvr, blas_int* ilo, blas_int* ihi, double* scale, double* abnrm, double* rconde, double* rcondv, double* work, const blas_int* lwork, blas_int* iwork, blas_int* info, blas_len balanc_len, blas_len jobvl_len, blas_len jobvr_len, blas_len sense_len) ARMA_NOEXCEPT; - - // eigen decomposition of general matrix (complex; advanced form) - void arma_fortran(arma_cgeevx)(const char* balanc, const char* jobvl, const char* jobvr, const char* sense, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_cxf* w, blas_cxf* vl, const blas_int* ldvl, blas_cxf* vr, const blas_int* ldvr, blas_int* ilo, blas_int* ihi, float* scale, float* abnrm, float* rconde, float* rcondv, blas_cxf* work, const blas_int* lwork, float* rwork, const blas_int* info, blas_len balanc_len, blas_len jobvl_len, blas_len jobvr_len, blas_len sense_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zgeevx)(const char* balanc, const char* jobvl, const char* jobvr, const char* sense, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_cxd* w, blas_cxd* vl, const blas_int* ldvl, blas_cxd* vr, const blas_int* ldvr, blas_int* ilo, blas_int* ihi, double* scale, double* abnrm, double* rconde, double* rcondv, blas_cxd* work, const blas_int* lwork, double* rwork, const blas_int* info, blas_len balanc_len, blas_len jobvl_len, blas_len jobvr_len, blas_len sense_len) ARMA_NOEXCEPT; - - // eigen decomposition of symmetric real matrices - void arma_fortran(arma_ssyev)(const char* jobz, const char* uplo, const blas_int* n, float* a, const blas_int* lda, float* w, float* work, const blas_int* lwork, blas_int* info, blas_len jobz_len, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dsyev)(const char* jobz, const char* uplo, const blas_int* n, double* a, const blas_int* lda, double* w, double* work, const blas_int* lwork, blas_int* info, blas_len jobz_len, blas_len uplo_len) ARMA_NOEXCEPT; - - // eigen decomposition of hermitian matrices (complex) - void arma_fortran(arma_cheev)(const char* jobz, const char* uplo, const blas_int* n, blas_cxf* a, const blas_int* lda, float* w, blas_cxf* work, const blas_int* lwork, float* rwork, blas_int* info, blas_len jobz_len, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zheev)(const char* jobz, const char* uplo, const blas_int* n, blas_cxd* a, const blas_int* lda, double* w, blas_cxd* work, const blas_int* lwork, double* rwork, blas_int* info, blas_len jobz_len, blas_len uplo_len) ARMA_NOEXCEPT; - - // eigen decomposition of symmetric real matrices by divide and conquer - void arma_fortran(arma_ssyevd)(const char* jobz, const char* uplo, const blas_int* n, float* a, const blas_int* lda, float* w, float* work, const blas_int* lwork, blas_int* iwork, const blas_int* liwork, blas_int* info, blas_len jobz_len, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dsyevd)(const char* jobz, const char* uplo, const blas_int* n, double* a, const blas_int* lda, double* w, double* work, const blas_int* lwork, blas_int* iwork, const blas_int* liwork, blas_int* info, blas_len jobz_len, blas_len uplo_len) ARMA_NOEXCEPT; - - // eigen decomposition of hermitian matrices (complex) by divide and conquer - void arma_fortran(arma_cheevd)(const char* jobz, const char* uplo, const blas_int* n, blas_cxf* a, const blas_int* lda, float* w, blas_cxf* work, const blas_int* lwork, float* rwork, const blas_int* lrwork, blas_int* iwork, const blas_int* liwork, blas_int* info, blas_len jobz_len, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zheevd)(const char* jobz, const char* uplo, const blas_int* n, blas_cxd* a, const blas_int* lda, double* w, blas_cxd* work, const blas_int* lwork, double* rwork, const blas_int* lrwork, blas_int* iwork, const blas_int* liwork, blas_int* info, blas_len jobz_len, blas_len uplo_len) ARMA_NOEXCEPT; - - // eigen decomposition of general real matrix pair - void arma_fortran(arma_sggev)(const char* jobvl, const char* jobvr, const blas_int* n, float* a, const blas_int* lda, float* b, const blas_int* ldb, float* alphar, float* alphai, float* beta, float* vl, const blas_int* ldvl, float* vr, const blas_int* ldvr, float* work, const blas_int* lwork, blas_int* info, blas_len jobvl_len, blas_len jobvr_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dggev)(const char* jobvl, const char* jobvr, const blas_int* n, double* a, const blas_int* lda, double* b, const blas_int* ldb, double* alphar, double* alphai, double* beta, double* vl, const blas_int* ldvl, double* vr, const blas_int* ldvr, double* work, const blas_int* lwork, blas_int* info, blas_len jobvl_len, blas_len jobvr_len) ARMA_NOEXCEPT; - - // eigen decomposition of general complex matrix pair - void arma_fortran(arma_cggev)(const char* jobvl, const char* jobvr, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_cxf* b, const blas_int* ldb, blas_cxf* alpha, blas_cxf* beta, blas_cxf* vl, const blas_int* ldvl, blas_cxf* vr, const blas_int* ldvr, blas_cxf* work, const blas_int* lwork, float* rwork, blas_int* info, blas_len jobvl_len, blas_len jobvr_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zggev)(const char* jobvl, const char* jobvr, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_cxd* b, const blas_int* ldb, blas_cxd* alpha, blas_cxd* beta, blas_cxd* vl, const blas_int* ldvl, blas_cxd* vr, const blas_int* ldvr, blas_cxd* work, const blas_int* lwork, double* rwork, blas_int* info, blas_len jobvl_len, blas_len jobvr_len) ARMA_NOEXCEPT; - - // Cholesky decomposition - void arma_fortran(arma_spotrf)(const char* uplo, const blas_int* n, float* a, const blas_int* lda, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dpotrf)(const char* uplo, const blas_int* n, double* a, const blas_int* lda, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_cpotrf)(const char* uplo, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zpotrf)(const char* uplo, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - - // solve system of linear equations using pre-computed Cholesky decomposition - void arma_fortran(arma_spotrs)(const char* uplo, const blas_int* n, const blas_int* nrhs, const float* a, const blas_int* lda, float* b, const blas_int* ldb, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dpotrs)(const char* uplo, const blas_int* n, const blas_int* nrhs, const double* a, const blas_int* lda, double* b, const blas_int* ldb, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_cpotrs)(const char* uplo, const blas_int* n, const blas_int* nrhs, const blas_cxf* a, const blas_int* lda, blas_cxf* b, const blas_int* ldb, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zpotrs)(const char* uplo, const blas_int* n, const blas_int* nrhs, const blas_cxd* a, const blas_int* lda, blas_cxd* b, const blas_int* ldb, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - - // Cholesky decomposition (band matrices) - void arma_fortran(arma_spbtrf)(const char* uplo, const blas_int* n, const blas_int* kd, float* ab, const blas_int* ldab, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dpbtrf)(const char* uplo, const blas_int* n, const blas_int* kd, double* ab, const blas_int* ldab, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_cpbtrf)(const char* uplo, const blas_int* n, const blas_int* kd, blas_cxf* ab, const blas_int* ldab, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zpbtrf)(const char* uplo, const blas_int* n, const blas_int* kd, blas_cxd* ab, const blas_int* ldab, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - - // matrix inversion (using pre-computed Cholesky decomposition) - void arma_fortran(arma_spotri)(const char* uplo, const blas_int* n, float* a, const blas_int* lda, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dpotri)(const char* uplo, const blas_int* n, double* a, const blas_int* lda, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_cpotri)(const char* uplo, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zpotri)(const char* uplo, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - - // QR decomposition - void arma_fortran(arma_sgeqrf)(const blas_int* m, const blas_int* n, float* a, const blas_int* lda, float* tau, float* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgeqrf)(const blas_int* m, const blas_int* n, double* a, const blas_int* lda, double* tau, double* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cgeqrf)(const blas_int* m, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_cxf* tau, blas_cxf* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgeqrf)(const blas_int* m, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_cxd* tau, blas_cxd* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - - // QR decomposition with pivoting (real matrices) - void arma_fortran(arma_sgeqp3)(const blas_int* m, const blas_int* n, float* a, const blas_int* lda, blas_int* jpvt, float* tau, float* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgeqp3)(const blas_int* m, const blas_int* n, double* a, const blas_int* lda, blas_int* jpvt, double* tau, double* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - - // QR decomposition with pivoting (complex matrices) - void arma_fortran(arma_cgeqp3)(const blas_int* m, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_int* jpvt, blas_cxf* tau, blas_cxf* work, const blas_int* lwork, float* rwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgeqp3)(const blas_int* m, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_int* jpvt, blas_cxd* tau, blas_cxd* work, const blas_int* lwork, double* rwork, blas_int* info) ARMA_NOEXCEPT; - - // Q matrix calculation from QR decomposition (real matrices) - void arma_fortran(arma_sorgqr)(const blas_int* m, const blas_int* n, const blas_int* k, float* a, const blas_int* lda, const float* tau, float* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dorgqr)(const blas_int* m, const blas_int* n, const blas_int* k, double* a, const blas_int* lda, const double* tau, double* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - - // Q matrix calculation from QR decomposition (complex matrices) - void arma_fortran(arma_cungqr)(const blas_int* m, const blas_int* n, const blas_int* k, blas_cxf* a, const blas_int* lda, const blas_cxf* tau, blas_cxf* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zungqr)(const blas_int* m, const blas_int* n, const blas_int* k, blas_cxd* a, const blas_int* lda, const blas_cxd* tau, blas_cxd* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - - // SVD (real matrices) - void arma_fortran(arma_sgesvd)(const char* jobu, const char* jobvt, const blas_int* m, const blas_int* n, float* a, const blas_int* lda, float* s, float* u, const blas_int* ldu, float* vt, const blas_int* ldvt, float* work, const blas_int* lwork, blas_int* info, blas_len jobu_len, blas_len jobvt_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dgesvd)(const char* jobu, const char* jobvt, const blas_int* m, const blas_int* n, double* a, const blas_int* lda, double* s, double* u, const blas_int* ldu, double* vt, const blas_int* ldvt, double* work, const blas_int* lwork, blas_int* info, blas_len jobu_len, blas_len jobvt_len) ARMA_NOEXCEPT; - - // SVD (complex matrices) - void arma_fortran(arma_cgesvd)(const char* jobu, const char* jobvt, const blas_int* m, const blas_int* n, blas_cxf* a, const blas_int* lda, float* s, blas_cxf* u, const blas_int* ldu, blas_cxf* vt, const blas_int* ldvt, blas_cxf* work, const blas_int* lwork, float* rwork, blas_int* info, blas_len jobu_len, blas_len jobvt_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zgesvd)(const char* jobu, const char* jobvt, const blas_int* m, const blas_int* n, blas_cxd* a, const blas_int* lda, double* s, blas_cxd* u, const blas_int* ldu, blas_cxd* vt, const blas_int* ldvt, blas_cxd* work, const blas_int* lwork, double* rwork, blas_int* info, blas_len jobu_len, blas_len jobvt_len) ARMA_NOEXCEPT; - - // SVD (real matrices) by divide and conquer - void arma_fortran(arma_sgesdd)(const char* jobz, const blas_int* m, const blas_int* n, float* a, const blas_int* lda, float* s, float* u, const blas_int* ldu, float* vt, const blas_int* ldvt, float* work, const blas_int* lwork, blas_int* iwork, blas_int* info, blas_len jobz_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dgesdd)(const char* jobz, const blas_int* m, const blas_int* n, double* a, const blas_int* lda, double* s, double* u, const blas_int* ldu, double* vt, const blas_int* ldvt, double* work, const blas_int* lwork, blas_int* iwork, blas_int* info, blas_len jobz_len) ARMA_NOEXCEPT; - - // SVD (complex matrices) by divide and conquer - void arma_fortran(arma_cgesdd)(const char* jobz, const blas_int* m, const blas_int* n, blas_cxf* a, const blas_int* lda, float* s, blas_cxf* u, const blas_int* ldu, blas_cxf* vt, const blas_int* ldvt, blas_cxf* work, const blas_int* lwork, float* rwork, blas_int* iwork, blas_int* info, blas_len jobz_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zgesdd)(const char* jobz, const blas_int* m, const blas_int* n, blas_cxd* a, const blas_int* lda, double* s, blas_cxd* u, const blas_int* ldu, blas_cxd* vt, const blas_int* ldvt, blas_cxd* work, const blas_int* lwork, double* rwork, blas_int* iwork, blas_int* info, blas_len jobz_len) ARMA_NOEXCEPT; - - // solve system of linear equations (general square matrix) - void arma_fortran(arma_sgesv)(const blas_int* n, const blas_int* nrhs, float* a, const blas_int* lda, blas_int* ipiv, float* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgesv)(const blas_int* n, const blas_int* nrhs, double* a, const blas_int* lda, blas_int* ipiv, double* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cgesv)(const blas_int* n, const blas_int* nrhs, blas_cxf* a, const blas_int* lda, blas_int* ipiv, blas_cxf* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgesv)(const blas_int* n, const blas_int* nrhs, blas_cxd* a, const blas_int* lda, blas_int* ipiv, blas_cxd* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations (general square matrix, advanced form, real matrices) - void arma_fortran(arma_sgesvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* nrhs, float* a, const blas_int* lda, float* af, const blas_int* ldaf, blas_int* ipiv, char* equed, float* r, float* c, float* b, const blas_int* ldb, float* x, const blas_int* ldx, float* rcond, float* ferr, float* berr, float* work, blas_int* iwork, blas_int* info, blas_len fact_len, blas_len trans_len, blas_len equed_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dgesvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* nrhs, double* a, const blas_int* lda, double* af, const blas_int* ldaf, blas_int* ipiv, char* equed, double* r, double* c, double* b, const blas_int* ldb, double* x, const blas_int* ldx, double* rcond, double* ferr, double* berr, double* work, blas_int* iwork, blas_int* info, blas_len fact_len, blas_len trans_len, blas_len equed_len) ARMA_NOEXCEPT; - - // solve system of linear equations (general square matrix, advanced form, complex matrices) - void arma_fortran(arma_cgesvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* nrhs, blas_cxf* a, const blas_int* lda, blas_cxf* af, const blas_int* ldaf, blas_int* ipiv, char* equed, float* r, float* c, blas_cxf* b, const blas_int* ldb, blas_cxf* x, const blas_int* ldx, float* rcond, float* ferr, float* berr, blas_cxf* work, float* rwork, blas_int* info, blas_len fact_len, blas_len trans_len, blas_len equed_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zgesvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* nrhs, blas_cxd* a, const blas_int* lda, blas_cxd* af, const blas_int* ldaf, blas_int* ipiv, char* equed, double* r, double* c, blas_cxd* b, const blas_int* ldb, blas_cxd* x, const blas_int* ldx, double* rcond, double* ferr, double* berr, blas_cxd* work, double* rwork, blas_int* info, blas_len fact_len, blas_len trans_len, blas_len equed_len) ARMA_NOEXCEPT; - - // solve system of linear equations (symmetric positive definite matrix) - void arma_fortran(arma_sposv)(const char* uplo, const blas_int* n, const blas_int* nrhs, float* a, const blas_int* lda, float* b, const blas_int* ldb, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dposv)(const char* uplo, const blas_int* n, const blas_int* nrhs, double* a, const blas_int* lda, double* b, const blas_int* ldb, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_cposv)(const char* uplo, const blas_int* n, const blas_int* nrhs, blas_cxf* a, const blas_int* lda, blas_cxf* b, const blas_int* ldb, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zposv)(const char* uplo, const blas_int* n, const blas_int* nrhs, blas_cxd* a, const blas_int* lda, blas_cxd* b, const blas_int* ldb, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - - // solve system of linear equations (symmetric positive definite matrix, advanced form, real matrices) - void arma_fortran(arma_sposvx)(const char* fact, const char* uplo, const blas_int* n, const blas_int* nrhs, float* a, const blas_int* lda, float* af, const blas_int* ldaf, char* equed, float* s, float* b, const blas_int* ldb, float* x, const blas_int* ldx, float* rcond, float* ferr, float* berr, float* work, blas_int* iwork, blas_int* info, blas_len fact_len, blas_len uplo_len, blas_len equed_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dposvx)(const char* fact, const char* uplo, const blas_int* n, const blas_int* nrhs, double* a, const blas_int* lda, double* af, const blas_int* ldaf, char* equed, double* s, double* b, const blas_int* ldb, double* x, const blas_int* ldx, double* rcond, double* ferr, double* berr, double* work, blas_int* iwork, blas_int* info, blas_len fact_len, blas_len uplo_len, blas_len equed_len) ARMA_NOEXCEPT; - - // solve system of linear equations (hermitian positive definite matrix, advanced form, complex matrices) - void arma_fortran(arma_cposvx)(const char* fact, const char* uplo, const blas_int* n, const blas_int* nrhs, blas_cxf* a, const blas_int* lda, blas_cxf* af, const blas_int* ldaf, char* equed, float* s, blas_cxf* b, const blas_int* ldb, blas_cxf* x, const blas_int* ldx, float* rcond, float* ferr, float* berr, blas_cxf* work, float* rwork, blas_int* info, blas_len fact_len, blas_len uplo_len, blas_len equed_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zposvx)(const char* fact, const char* uplo, const blas_int* n, const blas_int* nrhs, blas_cxd* a, const blas_int* lda, blas_cxd* af, const blas_int* ldaf, char* equed, double* s, blas_cxd* b, const blas_int* ldb, blas_cxd* x, const blas_int* ldx, double* rcond, double* ferr, double* berr, blas_cxd* work, double* rwork, blas_int* info, blas_len fact_len, blas_len uplo_len, blas_len equed_len) ARMA_NOEXCEPT; - - // solve over/under-determined system of linear equations - void arma_fortran(arma_sgels)(const char* trans, const blas_int* m, const blas_int* n, const blas_int* nrhs, float* a, const blas_int* lda, float* b, const blas_int* ldb, float* work, const blas_int* lwork, blas_int* info, blas_len trans_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dgels)(const char* trans, const blas_int* m, const blas_int* n, const blas_int* nrhs, double* a, const blas_int* lda, double* b, const blas_int* ldb, double* work, const blas_int* lwork, blas_int* info, blas_len trans_len) ARMA_NOEXCEPT; - void arma_fortran(arma_cgels)(const char* trans, const blas_int* m, const blas_int* n, const blas_int* nrhs, blas_cxf* a, const blas_int* lda, blas_cxf* b, const blas_int* ldb, blas_cxf* work, const blas_int* lwork, blas_int* info, blas_len trans_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zgels)(const char* trans, const blas_int* m, const blas_int* n, const blas_int* nrhs, blas_cxd* a, const blas_int* lda, blas_cxd* b, const blas_int* ldb, blas_cxd* work, const blas_int* lwork, blas_int* info, blas_len trans_len) ARMA_NOEXCEPT; - - // approximately solve system of linear equations using svd (real) - void arma_fortran(arma_sgelsd)(const blas_int* m, const blas_int* n, const blas_int* nrhs, float* a, const blas_int* lda, float* b, const blas_int* ldb, float* S, const float* rcond, blas_int* rank, float* work, const blas_int* lwork, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgelsd)(const blas_int* m, const blas_int* n, const blas_int* nrhs, double* a, const blas_int* lda, double* b, const blas_int* ldb, double* S, const double* rcond, blas_int* rank, double* work, const blas_int* lwork, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - - // approximately solve system of linear equations using svd (complex) - void arma_fortran(arma_cgelsd)(const blas_int* m, const blas_int* n, const blas_int* nrhs, blas_cxf* a, const blas_int* lda, blas_cxf* b, const blas_int* ldb, float* S, const float* rcond, blas_int* rank, blas_cxf* work, const blas_int* lwork, float* rwork, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgelsd)(const blas_int* m, const blas_int* n, const blas_int* nrhs, blas_cxd* a, const blas_int* lda, blas_cxd* b, const blas_int* ldb, double* S, const double* rcond, blas_int* rank, blas_cxd* work, const blas_int* lwork, double* rwork, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations (triangular matrix) - void arma_fortran(arma_strtrs)(const char* uplo, const char* trans, const char* diag, const blas_int* n, const blas_int* nrhs, const float* a, const blas_int* lda, float* b, const blas_int* ldb, blas_int* info, blas_len uplo_len, blas_len trans_len, blas_len diag_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dtrtrs)(const char* uplo, const char* trans, const char* diag, const blas_int* n, const blas_int* nrhs, const double* a, const blas_int* lda, double* b, const blas_int* ldb, blas_int* info, blas_len uplo_len, blas_len trans_len, blas_len diag_len) ARMA_NOEXCEPT; - void arma_fortran(arma_ctrtrs)(const char* uplo, const char* trans, const char* diag, const blas_int* n, const blas_int* nrhs, const blas_cxf* a, const blas_int* lda, blas_cxf* b, const blas_int* ldb, blas_int* info, blas_len uplo_len, blas_len trans_len, blas_len diag_len) ARMA_NOEXCEPT; - void arma_fortran(arma_ztrtrs)(const char* uplo, const char* trans, const char* diag, const blas_int* n, const blas_int* nrhs, const blas_cxd* a, const blas_int* lda, blas_cxd* b, const blas_int* ldb, blas_int* info, blas_len uplo_len, blas_len trans_len, blas_len diag_len) ARMA_NOEXCEPT; - - // LU factorisation (general band matrix) - void arma_fortran(arma_sgbtrf)(const blas_int* m, const blas_int* n, const blas_int* kl, const blas_int* ku, float* ab, const blas_int* ldab, blas_int* ipiv, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgbtrf)(const blas_int* m, const blas_int* n, const blas_int* kl, const blas_int* ku, double* ab, const blas_int* ldab, blas_int* ipiv, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cgbtrf)(const blas_int* m, const blas_int* n, const blas_int* kl, const blas_int* ku, blas_cxf* ab, const blas_int* ldab, blas_int* ipiv, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgbtrf)(const blas_int* m, const blas_int* n, const blas_int* kl, const blas_int* ku, blas_cxd* ab, const blas_int* ldab, blas_int* ipiv, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations using pre-computed LU decomposition (general band matrix) - void arma_fortran(arma_sgbtrs)(const char* trans, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, const float* ab, const blas_int* ldab, const blas_int* ipiv, float* b, const blas_int* ldb, blas_int* info, blas_len trans_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dgbtrs)(const char* trans, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, const double* ab, const blas_int* ldab, const blas_int* ipiv, double* b, const blas_int* ldb, blas_int* info, blas_len trans_len) ARMA_NOEXCEPT; - void arma_fortran(arma_cgbtrs)(const char* trans, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, const blas_cxf* ab, const blas_int* ldab, const blas_int* ipiv, blas_cxf* b, const blas_int* ldb, blas_int* info, blas_len trans_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zgbtrs)(const char* trans, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, const blas_cxd* ab, const blas_int* ldab, const blas_int* ipiv, blas_cxd* b, const blas_int* ldb, blas_int* info, blas_len trans_len) ARMA_NOEXCEPT; - - // solve system of linear equations (general band matrix) - void arma_fortran(arma_sgbsv)(const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, float* ab, const blas_int* ldab, blas_int* ipiv, float* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgbsv)(const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, double* ab, const blas_int* ldab, blas_int* ipiv, double* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cgbsv)(const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, blas_cxf* ab, const blas_int* ldab, blas_int* ipiv, blas_cxf* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgbsv)(const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, blas_cxd* ab, const blas_int* ldab, blas_int* ipiv, blas_cxd* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations (general band matrix, advanced form, real matrices) - void arma_fortran(arma_sgbsvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, float* ab, const blas_int* ldab, float* afb, const blas_int* ldafb, blas_int* ipiv, char* equed, float* r, float* c, float* b, const blas_int* ldb, float* x, const blas_int* ldx, float* rcond, float* ferr, float* berr, float* work, blas_int* iwork, blas_int* info, blas_len fact_len, blas_len trans_len, blas_len equed_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dgbsvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, double* ab, const blas_int* ldab, double* afb, const blas_int* ldafb, blas_int* ipiv, char* equed, double* r, double* c, double* b, const blas_int* ldb, double* x, const blas_int* ldx, double* rcond, double* ferr, double* berr, double* work, blas_int* iwork, blas_int* info, blas_len fact_len, blas_len trans_len, blas_len equed_len) ARMA_NOEXCEPT; - - // solve system of linear equations (general band matrix, advanced form, complex matrices) - void arma_fortran(arma_cgbsvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, blas_cxf* ab, const blas_int* ldab, blas_cxf* afb, const blas_int* ldafb, blas_int* ipiv, char* equed, float* r, float* c, blas_cxf* b, const blas_int* ldb, blas_cxf* x, const blas_int* ldx, float* rcond, float* ferr, float* berr, blas_cxf* work, float* rwork, blas_int* info, blas_len fact_len, blas_len trans_len, blas_len equed_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zgbsvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, blas_cxd* ab, const blas_int* ldab, blas_cxd* afb, const blas_int* ldafb, blas_int* ipiv, char* equed, double* r, double* c, blas_cxd* b, const blas_int* ldb, blas_cxd* x, const blas_int* ldx, double* rcond, double* ferr, double* berr, blas_cxd* work, double* rwork, blas_int* info, blas_len fact_len, blas_len trans_len, blas_len equed_len) ARMA_NOEXCEPT; - - // solve system of linear equations (tridiagonal band matrix) - void arma_fortran(arma_sgtsv)(const blas_int* n, const blas_int* nrhs, float* dl, float* d, float* du, float* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgtsv)(const blas_int* n, const blas_int* nrhs, double* dl, double* d, double* du, double* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cgtsv)(const blas_int* n, const blas_int* nrhs, blas_cxf* dl, blas_cxf* d, blas_cxf* du, blas_cxf* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgtsv)(const blas_int* n, const blas_int* nrhs, blas_cxd* dl, blas_cxd* d, blas_cxd* du, blas_cxd* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations (tridiagonal band matrix, advanced form, real matrices) - void arma_fortran(arma_sgtsvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* nrhs, const float* dl, const float* d, const float* du, float* dlf, float* df, float* duf, float* du2, blas_int* ipiv, const float* b, const blas_int* ldb, float* x, const blas_int* ldx, float* rcond, float* ferr, float* berr, float* work, blas_int* iwork, blas_int* info, blas_len fact_len, blas_len trans_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dgtsvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* nrhs, const double* dl, const double* d, const double* du, double* dlf, double* df, double* duf, double* du2, blas_int* ipiv, const double* b, const blas_int* ldb, double* x, const blas_int* ldx, double* rcond, double* ferr, double* berr, double* work, blas_int* iwork, blas_int* info, blas_len fact_len, blas_len trans_len) ARMA_NOEXCEPT; - - // solve system of linear equations (tridiagonal band matrix, advanced form, complex matrices) - void arma_fortran(arma_cgtsvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* nrhs, const blas_cxf* dl, const blas_cxf* d, const blas_cxf* du, blas_cxf* dlf, blas_cxf* df, blas_cxf* duf, blas_cxf* du2, blas_int* ipiv, const blas_cxf* b, const blas_int* ldb, blas_cxf* x, const blas_int* ldx, float* rcond, float* ferr, float* berr, blas_cxf* work, float* rwork, blas_int* info, blas_len fact_len, blas_len trans_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zgtsvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* nrhs, const blas_cxd* dl, const blas_cxd* d, const blas_cxd* du, blas_cxd* dlf, blas_cxd* df, blas_cxd* duf, blas_cxd* du2, blas_int* ipiv, const blas_cxd* b, const blas_int* ldb, blas_cxd* x, const blas_int* ldx, double* rcond, double* ferr, double* berr, blas_cxd* work, double* rwork, blas_int* info, blas_len fact_len, blas_len trans_len) ARMA_NOEXCEPT; - - // Schur decomposition (real matrices) - void arma_fortran(arma_sgees)(const char* jobvs, const char* sort, fn_select_s2 select, const blas_int* n, float* a, const blas_int* lda, blas_int* sdim, float* wr, float* wi, float* vs, const blas_int* ldvs, float* work, const blas_int* lwork, blas_int* bwork, blas_int* info, blas_len jobvs_len, blas_len sort_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dgees)(const char* jobvs, const char* sort, fn_select_d2 select, const blas_int* n, double* a, const blas_int* lda, blas_int* sdim, double* wr, double* wi, double* vs, const blas_int* ldvs, double* work, const blas_int* lwork, blas_int* bwork, blas_int* info, blas_len jobvs_len, blas_len sort_len) ARMA_NOEXCEPT; - - // Schur decomposition (complex matrices) - void arma_fortran(arma_cgees)(const char* jobvs, const char* sort, fn_select_c1 select, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_int* sdim, blas_cxf* w, blas_cxf* vs, const blas_int* ldvs, blas_cxf* work, const blas_int* lwork, float* rwork, blas_int* bwork, blas_int* info, blas_len jobvs_len, blas_len sort_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zgees)(const char* jobvs, const char* sort, fn_select_z1 select, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_int* sdim, blas_cxd* w, blas_cxd* vs, const blas_int* ldvs, blas_cxd* work, const blas_int* lwork, double* rwork, blas_int* bwork, blas_int* info, blas_len jobvs_len, blas_len sort_len) ARMA_NOEXCEPT; - - // solve a Sylvester equation ax + xb = c, with a and b assumed to be in Schur form - void arma_fortran(arma_strsyl)(const char* transa, const char* transb, const blas_int* isgn, const blas_int* m, const blas_int* n, const float* a, const blas_int* lda, const float* b, const blas_int* ldb, float* c, const blas_int* ldc, float* scale, blas_int* info, blas_len transa_len, blas_len transb_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dtrsyl)(const char* transa, const char* transb, const blas_int* isgn, const blas_int* m, const blas_int* n, const double* a, const blas_int* lda, const double* b, const blas_int* ldb, double* c, const blas_int* ldc, double* scale, blas_int* info, blas_len transa_len, blas_len transb_len) ARMA_NOEXCEPT; - void arma_fortran(arma_ctrsyl)(const char* transa, const char* transb, const blas_int* isgn, const blas_int* m, const blas_int* n, const blas_cxf* a, const blas_int* lda, const blas_cxf* b, const blas_int* ldb, blas_cxf* c, const blas_int* ldc, float* scale, blas_int* info, blas_len transa_len, blas_len transb_len) ARMA_NOEXCEPT; - void arma_fortran(arma_ztrsyl)(const char* transa, const char* transb, const blas_int* isgn, const blas_int* m, const blas_int* n, const blas_cxd* a, const blas_int* lda, const blas_cxd* b, const blas_int* ldb, blas_cxd* c, const blas_int* ldc, double* scale, blas_int* info, blas_len transa_len, blas_len transb_len) ARMA_NOEXCEPT; - - // QZ decomposition (real matrices) - void arma_fortran(arma_sgges)(const char* jobvsl, const char* jobvsr, const char* sort, fn_select_s3 selctg, const blas_int* n, float* a, const blas_int* lda, float* b, const blas_int* ldb, blas_int* sdim, float* alphar, float* alphai, float* beta, float* vsl, const blas_int* ldvsl, float* vsr, const blas_int* ldvsr, float* work, const blas_int* lwork, blas_int* bwork, blas_int* info, blas_len jobvsl_len, blas_len jobvsr_len, blas_len sort_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dgges)(const char* jobvsl, const char* jobvsr, const char* sort, fn_select_d3 selctg, const blas_int* n, double* a, const blas_int* lda, double* b, const blas_int* ldb, blas_int* sdim, double* alphar, double* alphai, double* beta, double* vsl, const blas_int* ldvsl, double* vsr, const blas_int* ldvsr, double* work, const blas_int* lwork, blas_int* bwork, blas_int* info, blas_len jobvsl_len, blas_len jobvsr_len, blas_len sort_len) ARMA_NOEXCEPT; - - // QZ decomposition (complex matrices) - void arma_fortran(arma_cgges)(const char* jobvsl, const char* jobvsr, const char* sort, fn_select_c2 selctg, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_cxf* b, const blas_int* ldb, blas_int* sdim, blas_cxf* alpha, blas_cxf* beta, blas_cxf* vsl, const blas_int* ldvsl, blas_cxf* vsr, const blas_int* ldvsr, blas_cxf* work, const blas_int* lwork, float* rwork, blas_int* bwork, blas_int* info, blas_len jobvsl_len, blas_len jobvsr_len, blas_len sort_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zgges)(const char* jobvsl, const char* jobvsr, const char* sort, fn_select_z2 selctg, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_cxd* b, const blas_int* ldb, blas_int* sdim, blas_cxd* alpha, blas_cxd* beta, blas_cxd* vsl, const blas_int* ldvsl, blas_cxd* vsr, const blas_int* ldvsr, blas_cxd* work, const blas_int* lwork, double* rwork, blas_int* bwork, blas_int* info, blas_len jobvsl_len, blas_len jobvsr_len, blas_len sort_len) ARMA_NOEXCEPT; - - // 1-norm (general matrix) - float arma_fortran(arma_slange)(const char* norm, const blas_int* m, const blas_int* n, const float* a, const blas_int* lda, float* work, blas_len norm_len) ARMA_NOEXCEPT; - double arma_fortran(arma_dlange)(const char* norm, const blas_int* m, const blas_int* n, const double* a, const blas_int* lda, double* work, blas_len norm_len) ARMA_NOEXCEPT; - float arma_fortran(arma_clange)(const char* norm, const blas_int* m, const blas_int* n, const blas_cxf* a, const blas_int* lda, float* work, blas_len norm_len) ARMA_NOEXCEPT; - double arma_fortran(arma_zlange)(const char* norm, const blas_int* m, const blas_int* n, const blas_cxd* a, const blas_int* lda, double* work, blas_len norm_len) ARMA_NOEXCEPT; - - // 1-norm (real symmetric matrix) - float arma_fortran(arma_slansy)(const char* norm, const char* uplo, const blas_int* n, const float* a, const blas_int* lda, float* work, blas_len norm_len, blas_len uplo_len) ARMA_NOEXCEPT; - double arma_fortran(arma_dlansy)(const char* norm, const char* uplo, const blas_int* n, const double* a, const blas_int* lda, double* work, blas_len norm_len, blas_len uplo_len) ARMA_NOEXCEPT; - float arma_fortran(arma_clansy)(const char* norm, const char* uplo, const blas_int* n, const blas_cxf* a, const blas_int* lda, float* work, blas_len norm_len, blas_len uplo_len) ARMA_NOEXCEPT; - double arma_fortran(arma_zlansy)(const char* norm, const char* uplo, const blas_int* n, const blas_cxd* a, const blas_int* lda, double* work, blas_len norm_len, blas_len uplo_len) ARMA_NOEXCEPT; - - // 1-norm (complex hermitian matrix) - float arma_fortran(arma_clanhe)(const char* norm, const char* uplo, const blas_int* n, const blas_cxf* a, const blas_int* lda, float* work, blas_len norm_len, blas_len uplo_len) ARMA_NOEXCEPT; - double arma_fortran(arma_zlanhe)(const char* norm, const char* uplo, const blas_int* n, const blas_cxd* a, const blas_int* lda, double* work, blas_len norm_len, blas_len uplo_len) ARMA_NOEXCEPT; - - // 1-norm (band matrix) - float arma_fortran(arma_slangb)(const char* norm, const blas_int* n, const blas_int* kl, const blas_int* ku, const float* ab, const blas_int* ldab, float* work, blas_len norm_len) ARMA_NOEXCEPT; - double arma_fortran(arma_dlangb)(const char* norm, const blas_int* n, const blas_int* kl, const blas_int* ku, const double* ab, const blas_int* ldab, double* work, blas_len norm_len) ARMA_NOEXCEPT; - float arma_fortran(arma_clangb)(const char* norm, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_cxf* ab, const blas_int* ldab, float* work, blas_len norm_len) ARMA_NOEXCEPT; - double arma_fortran(arma_zlangb)(const char* norm, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_cxd* ab, const blas_int* ldab, double* work, blas_len norm_len) ARMA_NOEXCEPT; - - // reciprocal of condition number (real, generic matrix) - void arma_fortran(arma_sgecon)(const char* norm, const blas_int* n, const float* a, const blas_int* lda, const float* anorm, float* rcond, float* work, blas_int* iwork, blas_int* info, blas_len norm_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dgecon)(const char* norm, const blas_int* n, const double* a, const blas_int* lda, const double* anorm, double* rcond, double* work, blas_int* iwork, blas_int* info, blas_len norm_len) ARMA_NOEXCEPT; - - // reciprocal of condition number (complex, generic matrix) - void arma_fortran(arma_cgecon)(const char* norm, const blas_int* n, const blas_cxf* a, const blas_int* lda, const float* anorm, float* rcond, blas_cxf* work, float* rwork, blas_int* info, blas_len norm_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zgecon)(const char* norm, const blas_int* n, const blas_cxd* a, const blas_int* lda, const double* anorm, double* rcond, blas_cxd* work, double* rwork, blas_int* info, blas_len norm_len) ARMA_NOEXCEPT; - - // reciprocal of condition number (real, symmetric positive definite matrix) - void arma_fortran(arma_spocon)(const char* uplo, const blas_int* n, const float* a, const blas_int* lda, const float* anorm, float* rcond, float* work, blas_int* iwork, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dpocon)(const char* uplo, const blas_int* n, const double* a, const blas_int* lda, const double* anorm, double* rcond, double* work, blas_int* iwork, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - - // reciprocal of condition number (complex, hermitian positive definite matrix) - void arma_fortran(arma_cpocon)(const char* uplo, const blas_int* n, const blas_cxf* a, const blas_int* lda, const float* anorm, float* rcond, blas_cxf* work, float* rwork, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zpocon)(const char* uplo, const blas_int* n, const blas_cxd* a, const blas_int* lda, const double* anorm, double* rcond, blas_cxd* work, double* rwork, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - - // reciprocal of condition number (real, triangular matrix) - void arma_fortran(arma_strcon)(const char* norm, const char* uplo, const char* diag, const blas_int* n, const float* a, const blas_int* lda, float* rcond, float* work, blas_int* iwork, blas_int* info, blas_len norm_len, blas_len uplo_len, blas_len diag_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dtrcon)(const char* norm, const char* uplo, const char* diag, const blas_int* n, const double* a, const blas_int* lda, double* rcond, double* work, blas_int* iwork, blas_int* info, blas_len norm_len, blas_len uplo_len, blas_len diag_len) ARMA_NOEXCEPT; - - // reciprocal of condition number (complex, triangular matrix) - void arma_fortran(arma_ctrcon)(const char* norm, const char* uplo, const char* diag, const blas_int* n, const blas_cxf* a, const blas_int* lda, float* rcond, blas_cxf* work, float* rwork, blas_int* info, blas_len norm_len, blas_len uplo_len, blas_len diag_len) ARMA_NOEXCEPT; - void arma_fortran(arma_ztrcon)(const char* norm, const char* uplo, const char* diag, const blas_int* n, const blas_cxd* a, const blas_int* lda, double* rcond, blas_cxd* work, double* rwork, blas_int* info, blas_len norm_len, blas_len uplo_len, blas_len diag_len) ARMA_NOEXCEPT; - - // reciprocal of condition number (real, band matrix) - void arma_fortran(arma_sgbcon)(const char* norm, const blas_int* n, const blas_int* kl, const blas_int* ku, const float* ab, const blas_int* ldab, const blas_int* ipiv, const float* anorm, float* rcond, float* work, blas_int* iwork, blas_int* info, blas_len norm_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dgbcon)(const char* norm, const blas_int* n, const blas_int* kl, const blas_int* ku, const double* ab, const blas_int* ldab, const blas_int* ipiv, const double* anorm, double* rcond, double* work, blas_int* iwork, blas_int* info, blas_len norm_len) ARMA_NOEXCEPT; - - // reciprocal of condition number (complex, band matrix) - void arma_fortran(arma_cgbcon)(const char* norm, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_cxf* ab, const blas_int* ldab, const blas_int* ipiv, const float* anorm, float* rcond, blas_cxf* work, float* rwork, blas_int* info, blas_len norm_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zgbcon)(const char* norm, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_cxd* ab, const blas_int* ldab, const blas_int* ipiv, const double* anorm, double* rcond, blas_cxd* work, double* rwork, blas_int* info, blas_len norm_len) ARMA_NOEXCEPT; - - // obtain parameters according to the local configuration of lapack - blas_int arma_fortran(arma_ilaenv)(const blas_int* ispec, const char* name, const char* opts, const blas_int* n1, const blas_int* n2, const blas_int* n3, const blas_int* n4, blas_len name_len, blas_len opts_len) ARMA_NOEXCEPT; - - // calculate eigenvalues of an upper Hessenberg matrix - void arma_fortran(arma_slahqr)(const blas_int* wantt, const blas_int* wantz, const blas_int* n, const blas_int* ilo, const blas_int* ihi, float* h, const blas_int* ldh, float* wr, float* wi, const blas_int* iloz, const blas_int* ihiz, float* z, const blas_int* ldz, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dlahqr)(const blas_int* wantt, const blas_int* wantz, const blas_int* n, const blas_int* ilo, const blas_int* ihi, double* h, const blas_int* ldh, double* wr, double* wi, const blas_int* iloz, const blas_int* ihiz, double* z, const blas_int* ldz, blas_int* info) ARMA_NOEXCEPT; - - // calculate eigenvalues of a symmetric tridiagonal matrix - void arma_fortran(arma_sstedc)(const char* compz, const blas_int* n, float* d, float* e, float* z, const blas_int* ldz, float* work, const blas_int* lwork, blas_int* iwork, const blas_int* liwork, blas_int* info, blas_len compz_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dstedc)(const char* compz, const blas_int* n, double* d, double* e, double* z, const blas_int* ldz, double* work, const blas_int* lwork, blas_int* iwork, const blas_int* liwork, blas_int* info, blas_len compz_len) ARMA_NOEXCEPT; - - // calculate eigenvectors of a Schur form matrix - void arma_fortran(arma_strevc)(const char* side, const char* howmny, blas_int* select, const blas_int* n, const float* t, const blas_int* ldt, float* vl, const blas_int* ldvl, float* vr, const blas_int* ldvr, const blas_int* mm, blas_int* m, float* work, blas_int* info, blas_len side_len, blas_len howmny_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dtrevc)(const char* side, const char* howmny, blas_int* select, const blas_int* n, const double* t, const blas_int* ldt, double* vl, const blas_int* ldvl, double* vr, const blas_int* ldvr, const blas_int* mm, blas_int* m, double* work, blas_int* info, blas_len side_len, blas_len howmny_len) ARMA_NOEXCEPT; - - // hessenberg decomposition - void arma_fortran(arma_sgehrd)(const blas_int* n, const blas_int* ilo, const blas_int* ihi, float* a, const blas_int* lda, float* tao, float* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgehrd)(const blas_int* n, const blas_int* ilo, const blas_int* ihi, double* a, const blas_int* lda, double* tao, double* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cgehrd)(const blas_int* n, const blas_int* ilo, const blas_int* ihi, blas_cxf* a, const blas_int* lda, blas_cxf* tao, blas_cxf* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgehrd)(const blas_int* n, const blas_int* ilo, const blas_int* ihi, blas_cxd* a, const blas_int* lda, blas_cxd* tao, blas_cxd* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - - // pivoted cholesky - void arma_fortran(arma_spstrf)(const char* uplo, const blas_int* n, float* a, const blas_int* lda, blas_int* piv, blas_int* rank, const float* tol, float* work, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_dpstrf)(const char* uplo, const blas_int* n, double* a, const blas_int* lda, blas_int* piv, blas_int* rank, const double* tol, double* work, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_cpstrf)(const char* uplo, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_int* piv, blas_int* rank, const float* tol, float* work, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - void arma_fortran(arma_zpstrf)(const char* uplo, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_int* piv, blas_int* rank, const double* tol, double* work, blas_int* info, blas_len uplo_len) ARMA_NOEXCEPT; - -#else - - // prototypes without hidden arguments - - // LU decomposition - void arma_fortran(arma_sgetrf)(const blas_int* m, const blas_int* n, float* a, const blas_int* lda, blas_int* ipiv, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgetrf)(const blas_int* m, const blas_int* n, double* a, const blas_int* lda, blas_int* ipiv, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cgetrf)(const blas_int* m, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_int* ipiv, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgetrf)(const blas_int* m, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_int* ipiv, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations using pre-computed LU decomposition - void arma_fortran(arma_sgetrs)(const char* trans, const blas_int* n, const blas_int* nrhs, const float* a, const blas_int* lda, const blas_int* ipiv, float* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgetrs)(const char* trans, const blas_int* n, const blas_int* nrhs, const double* a, const blas_int* lda, const blas_int* ipiv, double* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cgetrs)(const char* trans, const blas_int* n, const blas_int* nrhs, const blas_cxf* a, const blas_int* lda, const blas_int* ipiv, blas_cxf* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgetrs)(const char* trans, const blas_int* n, const blas_int* nrhs, const blas_cxd* a, const blas_int* lda, const blas_int* ipiv, blas_cxd* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - - // matrix inversion (using pre-computed LU decomposition) - void arma_fortran(arma_sgetri)(const blas_int* n, float* a, const blas_int* lda, const blas_int* ipiv, float* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgetri)(const blas_int* n, double* a, const blas_int* lda, const blas_int* ipiv, double* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cgetri)(const blas_int* n, blas_cxf* a, const blas_int* lda, const blas_int* ipiv, blas_cxf* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgetri)(const blas_int* n, blas_cxd* a, const blas_int* lda, const blas_int* ipiv, blas_cxd* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - - // matrix inversion (triangular matrices) - void arma_fortran(arma_strtri)(const char* uplo, const char* diag, const blas_int* n, float* a, const blas_int* lda, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dtrtri)(const char* uplo, const char* diag, const blas_int* n, double* a, const blas_int* lda, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_ctrtri)(const char* uplo, const char* diag, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_ztrtri)(const char* uplo, const char* diag, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_int* info) ARMA_NOEXCEPT; - - // eigen decomposition of general matrix (real) - void arma_fortran(arma_sgeev)(const char* jobvl, const char* jobvr, const blas_int* n, float* a, const blas_int* lda, float* wr, float* wi, float* vl, const blas_int* ldvl, float* vr, const blas_int* ldvr, float* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgeev)(const char* jobvl, const char* jobvr, const blas_int* n, double* a, const blas_int* lda, double* wr, double* wi, double* vl, const blas_int* ldvl, double* vr, const blas_int* ldvr, double* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - - // eigen decomposition of general matrix (complex) - void arma_fortran(arma_cgeev)(const char* jobvl, const char* jobvr, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_cxf* w, blas_cxf* vl, const blas_int* ldvl, blas_cxf* vr, const blas_int* ldvr, blas_cxf* work, const blas_int* lwork, float* rwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgeev)(const char* jobvl, const char* jobvr, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_cxd* w, blas_cxd* vl, const blas_int* ldvl, blas_cxd* vr, const blas_int* ldvr, blas_cxd* work, const blas_int* lwork, double* rwork, blas_int* info) ARMA_NOEXCEPT; - - // eigen decomposition of general matrix (real; advanced form) - void arma_fortran(arma_sgeevx)(const char* balanc, const char* jobvl, const char* jobvr, const char* sense, const blas_int* n, float* a, const blas_int* lda, float* wr, float* wi, float* vl, const blas_int* ldvl, float* vr, const blas_int* ldvr, blas_int* ilo, blas_int* ihi, float* scale, float* abnrm, float* rconde, float* rcondv, float* work, const blas_int* lwork, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgeevx)(const char* balanc, const char* jobvl, const char* jobvr, const char* sense, const blas_int* n, double* a, const blas_int* lda, double* wr, double* wi, double* vl, const blas_int* ldvl, double* vr, const blas_int* ldvr, blas_int* ilo, blas_int* ihi, double* scale, double* abnrm, double* rconde, double* rcondv, double* work, const blas_int* lwork, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - - // eigen decomposition of general matrix (complex; advanced form) - void arma_fortran(arma_cgeevx)(const char* balanc, const char* jobvl, const char* jobvr, const char* sense, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_cxf* w, blas_cxf* vl, const blas_int* ldvl, blas_cxf* vr, const blas_int* ldvr, blas_int* ilo, blas_int* ihi, float* scale, float* abnrm, float* rconde, float* rcondv, blas_cxf* work, const blas_int* lwork, float* rwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgeevx)(const char* balanc, const char* jobvl, const char* jobvr, const char* sense, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_cxd* w, blas_cxd* vl, const blas_int* ldvl, blas_cxd* vr, const blas_int* ldvr, blas_int* ilo, blas_int* ihi, double* scale, double* abnrm, double* rconde, double* rcondv, blas_cxd* work, const blas_int* lwork, double* rwork, blas_int* info) ARMA_NOEXCEPT; - - // eigen decomposition of symmetric real matrices - void arma_fortran(arma_ssyev)(const char* jobz, const char* uplo, const blas_int* n, float* a, const blas_int* lda, float* w, float* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dsyev)(const char* jobz, const char* uplo, const blas_int* n, double* a, const blas_int* lda, double* w, double* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - - // eigen decomposition of hermitian matrices (complex) - void arma_fortran(arma_cheev)(const char* jobz, const char* uplo, const blas_int* n, blas_cxf* a, const blas_int* lda, float* w, blas_cxf* work, const blas_int* lwork, float* rwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zheev)(const char* jobz, const char* uplo, const blas_int* n, blas_cxd* a, const blas_int* lda, double* w, blas_cxd* work, const blas_int* lwork, double* rwork, blas_int* info) ARMA_NOEXCEPT; - - // eigen decomposition of symmetric real matrices by divide and conquer - void arma_fortran(arma_ssyevd)(const char* jobz, const char* uplo, const blas_int* n, float* a, const blas_int* lda, float* w, float* work, const blas_int* lwork, blas_int* iwork, const blas_int* liwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dsyevd)(const char* jobz, const char* uplo, const blas_int* n, double* a, const blas_int* lda, double* w, double* work, const blas_int* lwork, blas_int* iwork, const blas_int* liwork, blas_int* info) ARMA_NOEXCEPT; - - // eigen decomposition of hermitian matrices (complex) by divide and conquer - void arma_fortran(arma_cheevd)(const char* jobz, const char* uplo, const blas_int* n, blas_cxf* a, const blas_int* lda, float* w, blas_cxf* work, const blas_int* lwork, float* rwork, const blas_int* lrwork, blas_int* iwork, const blas_int* liwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zheevd)(const char* jobz, const char* uplo, const blas_int* n, blas_cxd* a, const blas_int* lda, double* w, blas_cxd* work, const blas_int* lwork, double* rwork, const blas_int* lrwork, blas_int* iwork, const blas_int* liwork, blas_int* info) ARMA_NOEXCEPT; - - // eigen decomposition of general real matrix pair - void arma_fortran(arma_sggev)(const char* jobvl, const char* jobvr, const blas_int* n, float* a, const blas_int* lda, float* b, const blas_int* ldb, float* alphar, float* alphai, float* beta, float* vl, const blas_int* ldvl, float* vr, const blas_int* ldvr, float* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dggev)(const char* jobvl, const char* jobvr, const blas_int* n, double* a, const blas_int* lda, double* b, const blas_int* ldb, double* alphar, double* alphai, double* beta, double* vl, const blas_int* ldvl, double* vr, const blas_int* ldvr, double* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - - // eigen decomposition of general complex matrix pair - void arma_fortran(arma_cggev)(const char* jobvl, const char* jobvr, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_cxf* b, const blas_int* ldb, blas_cxf* alpha, blas_cxf* beta, blas_cxf* vl, const blas_int* ldvl, blas_cxf* vr, const blas_int* ldvr, blas_cxf* work, const blas_int* lwork, float* rwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zggev)(const char* jobvl, const char* jobvr, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_cxd* b, const blas_int* ldb, blas_cxd* alpha, blas_cxd* beta, blas_cxd* vl, const blas_int* ldvl, blas_cxd* vr, const blas_int* ldvr, blas_cxd* work, const blas_int* lwork, double* rwork, blas_int* info) ARMA_NOEXCEPT; - - // Cholesky decomposition - void arma_fortran(arma_spotrf)(const char* uplo, const blas_int* n, float* a, const blas_int* lda, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dpotrf)(const char* uplo, const blas_int* n, double* a, const blas_int* lda, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cpotrf)(const char* uplo, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zpotrf)(const char* uplo, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations with pre-computed Cholesky decomposition - void arma_fortran(arma_spotrs)(const char* uplo, const blas_int* n, const blas_int* nrhs, const float* a, const blas_int* lda, float* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dpotrs)(const char* uplo, const blas_int* n, const blas_int* nrhs, const double* a, const blas_int* lda, double* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cpotrs)(const char* uplo, const blas_int* n, const blas_int* nrhs, const blas_cxf* a, const blas_int* lda, blas_cxf* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zpotrs)(const char* uplo, const blas_int* n, const blas_int* nrhs, const blas_cxd* a, const blas_int* lda, blas_cxd* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - - // Cholesky decomposition (band matrices) - void arma_fortran(arma_spbtrf)(const char* uplo, const blas_int* n, const blas_int* kd, float* ab, const blas_int* ldab, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dpbtrf)(const char* uplo, const blas_int* n, const blas_int* kd, double* ab, const blas_int* ldab, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cpbtrf)(const char* uplo, const blas_int* n, const blas_int* kd, blas_cxf* ab, const blas_int* ldab, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zpbtrf)(const char* uplo, const blas_int* n, const blas_int* kd, blas_cxd* ab, const blas_int* ldab, blas_int* info) ARMA_NOEXCEPT; - - // matrix inversion (using pre-computed Cholesky decomposition) - void arma_fortran(arma_spotri)(const char* uplo, const blas_int* n, float* a, const blas_int* lda, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dpotri)(const char* uplo, const blas_int* n, double* a, const blas_int* lda, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cpotri)(const char* uplo, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zpotri)(const char* uplo, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_int* info) ARMA_NOEXCEPT; - - // QR decomposition - void arma_fortran(arma_sgeqrf)(const blas_int* m, const blas_int* n, float* a, const blas_int* lda, float* tau, float* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgeqrf)(const blas_int* m, const blas_int* n, double* a, const blas_int* lda, double* tau, double* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cgeqrf)(const blas_int* m, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_cxf* tau, blas_cxf* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgeqrf)(const blas_int* m, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_cxd* tau, blas_cxd* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - - // QR decomposition with pivoting (real matrices) - void arma_fortran(arma_sgeqp3)(const blas_int* m, const blas_int* n, float* a, const blas_int* lda, blas_int* jpvt, float* tau, float* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgeqp3)(const blas_int* m, const blas_int* n, double* a, const blas_int* lda, blas_int* jpvt, double* tau, double* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - - // QR decomposition with pivoting (complex matrices) - void arma_fortran(arma_cgeqp3)(const blas_int* m, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_int* jpvt, blas_cxf* tau, blas_cxf* work, const blas_int* lwork, float* rwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgeqp3)(const blas_int* m, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_int* jpvt, blas_cxd* tau, blas_cxd* work, const blas_int* lwork, double* rwork, blas_int* info) ARMA_NOEXCEPT; - - // Q matrix calculation from QR decomposition (real matrices) - void arma_fortran(arma_sorgqr)(const blas_int* m, const blas_int* n, const blas_int* k, float* a, const blas_int* lda, const float* tau, float* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dorgqr)(const blas_int* m, const blas_int* n, const blas_int* k, double* a, const blas_int* lda, const double* tau, double* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - - // Q matrix calculation from QR decomposition (complex matrices) - void arma_fortran(arma_cungqr)(const blas_int* m, const blas_int* n, const blas_int* k, blas_cxf* a, const blas_int* lda, const blas_cxf* tau, blas_cxf* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zungqr)(const blas_int* m, const blas_int* n, const blas_int* k, blas_cxd* a, const blas_int* lda, const blas_cxd* tau, blas_cxd* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - - // SVD (real matrices) - void arma_fortran(arma_sgesvd)(const char* jobu, const char* jobvt, const blas_int* m, const blas_int* n, float* a, const blas_int* lda, float* s, float* u, const blas_int* ldu, float* vt, const blas_int* ldvt, float* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgesvd)(const char* jobu, const char* jobvt, const blas_int* m, const blas_int* n, double* a, const blas_int* lda, double* s, double* u, const blas_int* ldu, double* vt, const blas_int* ldvt, double* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - - // SVD (complex matrices) - void arma_fortran(arma_cgesvd)(const char* jobu, const char* jobvt, const blas_int* m, const blas_int* n, blas_cxf* a, const blas_int* lda, float* s, blas_cxf* u, const blas_int* ldu, blas_cxf* vt, const blas_int* ldvt, blas_cxf* work, const blas_int* lwork, float* rwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgesvd)(const char* jobu, const char* jobvt, const blas_int* m, const blas_int* n, blas_cxd* a, const blas_int* lda, double* s, blas_cxd* u, const blas_int* ldu, blas_cxd* vt, const blas_int* ldvt, blas_cxd* work, const blas_int* lwork, double* rwork, blas_int* info) ARMA_NOEXCEPT; - - // SVD (real matrices) by divide and conquer - void arma_fortran(arma_sgesdd)(const char* jobz, const blas_int* m, const blas_int* n, float* a, const blas_int* lda, float* s, float* u, const blas_int* ldu, float* vt, const blas_int* ldvt, float* work, const blas_int* lwork, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgesdd)(const char* jobz, const blas_int* m, const blas_int* n, double* a, const blas_int* lda, double* s, double* u, const blas_int* ldu, double* vt, const blas_int* ldvt, double* work, const blas_int* lwork, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - - // SVD (complex matrices) by divide and conquer - void arma_fortran(arma_cgesdd)(const char* jobz, const blas_int* m, const blas_int* n, blas_cxf* a, const blas_int* lda, float* s, blas_cxf* u, const blas_int* ldu, blas_cxf* vt, const blas_int* ldvt, blas_cxf* work, const blas_int* lwork, float* rwork, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgesdd)(const char* jobz, const blas_int* m, const blas_int* n, blas_cxd* a, const blas_int* lda, double* s, blas_cxd* u, const blas_int* ldu, blas_cxd* vt, const blas_int* ldvt, blas_cxd* work, const blas_int* lwork, double* rwork, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations (general square matrix) - void arma_fortran(arma_sgesv)(const blas_int* n, const blas_int* nrhs, float* a, const blas_int* lda, blas_int* ipiv, float* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgesv)(const blas_int* n, const blas_int* nrhs, double* a, const blas_int* lda, blas_int* ipiv, double* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cgesv)(const blas_int* n, const blas_int* nrhs, blas_cxf* a, const blas_int* lda, blas_int* ipiv, blas_cxf* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgesv)(const blas_int* n, const blas_int* nrhs, blas_cxd* a, const blas_int* lda, blas_int* ipiv, blas_cxd* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations (general square matrix, advanced form, real matrices) - void arma_fortran(arma_sgesvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* nrhs, float* a, const blas_int* lda, float* af, const blas_int* ldaf, blas_int* ipiv, char* equed, float* r, float* c, float* b, const blas_int* ldb, float* x, const blas_int* ldx, float* rcond, float* ferr, float* berr, float* work, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgesvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* nrhs, double* a, const blas_int* lda, double* af, const blas_int* ldaf, blas_int* ipiv, char* equed, double* r, double* c, double* b, const blas_int* ldb, double* x, const blas_int* ldx, double* rcond, double* ferr, double* berr, double* work, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations (general square matrix, advanced form, complex matrices) - void arma_fortran(arma_cgesvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* nrhs, blas_cxf* a, const blas_int* lda, blas_cxf* af, const blas_int* ldaf, blas_int* ipiv, char* equed, float* r, float* c, blas_cxf* b, const blas_int* ldb, blas_cxf* x, const blas_int* ldx, float* rcond, float* ferr, float* berr, blas_cxf* work, float* rwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgesvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* nrhs, blas_cxd* a, const blas_int* lda, blas_cxd* af, const blas_int* ldaf, blas_int* ipiv, char* equed, double* r, double* c, blas_cxd* b, const blas_int* ldb, blas_cxd* x, const blas_int* ldx, double* rcond, double* ferr, double* berr, blas_cxd* work, double* rwork, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations (symmetric positive definite matrix) - void arma_fortran(arma_sposv)(const char* uplo, const blas_int* n, const blas_int* nrhs, float* a, const blas_int* lda, float* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dposv)(const char* uplo, const blas_int* n, const blas_int* nrhs, double* a, const blas_int* lda, double* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cposv)(const char* uplo, const blas_int* n, const blas_int* nrhs, blas_cxf* a, const blas_int* lda, blas_cxf* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zposv)(const char* uplo, const blas_int* n, const blas_int* nrhs, blas_cxd* a, const blas_int* lda, blas_cxd* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations (symmetric positive definite matrix, advanced form, real matrices) - void arma_fortran(arma_sposvx)(const char* fact, const char* uplo, const blas_int* n, const blas_int* nrhs, float* a, const blas_int* lda, float* af, const blas_int* ldaf, char* equed, float* s, float* b, const blas_int* ldb, float* x, const blas_int* ldx, float* rcond, float* ferr, float* berr, float* work, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dposvx)(const char* fact, const char* uplo, const blas_int* n, const blas_int* nrhs, double* a, const blas_int* lda, double* af, const blas_int* ldaf, char* equed, double* s, double* b, const blas_int* ldb, double* x, const blas_int* ldx, double* rcond, double* ferr, double* berr, double* work, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations (hermitian positive definite matrix, advanced form, complex matrices) - void arma_fortran(arma_cposvx)(const char* fact, const char* uplo, const blas_int* n, const blas_int* nrhs, blas_cxf* a, const blas_int* lda, blas_cxf* af, const blas_int* ldaf, char* equed, float* s, blas_cxf* b, const blas_int* ldb, blas_cxf* x, const blas_int* ldx, float* rcond, float* ferr, float* berr, blas_cxf* work, float* rwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zposvx)(const char* fact, const char* uplo, const blas_int* n, const blas_int* nrhs, blas_cxd* a, const blas_int* lda, blas_cxd* af, const blas_int* ldaf, char* equed, double* s, blas_cxd* b, const blas_int* ldb, blas_cxd* x, const blas_int* ldx, double* rcond, double* ferr, double* berr, blas_cxd* work, double* rwork, blas_int* info) ARMA_NOEXCEPT; - - // solve over/under-determined system of linear equations - void arma_fortran(arma_sgels)(const char* trans, const blas_int* m, const blas_int* n, const blas_int* nrhs, float* a, const blas_int* lda, float* b, const blas_int* ldb, float* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgels)(const char* trans, const blas_int* m, const blas_int* n, const blas_int* nrhs, double* a, const blas_int* lda, double* b, const blas_int* ldb, double* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cgels)(const char* trans, const blas_int* m, const blas_int* n, const blas_int* nrhs, blas_cxf* a, const blas_int* lda, blas_cxf* b, const blas_int* ldb, blas_cxf* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgels)(const char* trans, const blas_int* m, const blas_int* n, const blas_int* nrhs, blas_cxd* a, const blas_int* lda, blas_cxd* b, const blas_int* ldb, blas_cxd* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - - // approximately solve system of linear equations using svd (real) - void arma_fortran(arma_sgelsd)(const blas_int* m, const blas_int* n, const blas_int* nrhs, float* a, const blas_int* lda, float* b, const blas_int* ldb, float* S, const float* rcond, blas_int* rank, float* work, const blas_int* lwork, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgelsd)(const blas_int* m, const blas_int* n, const blas_int* nrhs, double* a, const blas_int* lda, double* b, const blas_int* ldb, double* S, const double* rcond, blas_int* rank, double* work, const blas_int* lwork, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - - - // approximately solve system of linear equations using svd (complex) - void arma_fortran(arma_cgelsd)(const blas_int* m, const blas_int* n, const blas_int* nrhs, blas_cxf* a, const blas_int* lda, blas_cxf* b, const blas_int* ldb, float* S, const float* rcond, blas_int* rank, blas_cxf* work, const blas_int* lwork, float* rwork, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgelsd)(const blas_int* m, const blas_int* n, const blas_int* nrhs, blas_cxd* a, const blas_int* lda, blas_cxd* b, const blas_int* ldb, double* S, const double* rcond, blas_int* rank, blas_cxd* work, const blas_int* lwork, double* rwork, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations (triangular matrix) - void arma_fortran(arma_strtrs)(const char* uplo, const char* trans, const char* diag, const blas_int* n, const blas_int* nrhs, const float* a, const blas_int* lda, float* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dtrtrs)(const char* uplo, const char* trans, const char* diag, const blas_int* n, const blas_int* nrhs, const double* a, const blas_int* lda, double* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_ctrtrs)(const char* uplo, const char* trans, const char* diag, const blas_int* n, const blas_int* nrhs, const blas_cxf* a, const blas_int* lda, blas_cxf* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_ztrtrs)(const char* uplo, const char* trans, const char* diag, const blas_int* n, const blas_int* nrhs, const blas_cxd* a, const blas_int* lda, blas_cxd* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - - // LU factorisation (general band matrix) - void arma_fortran(arma_sgbtrf)(const blas_int* m, const blas_int* n, const blas_int* kl, const blas_int* ku, float* ab, const blas_int* ldab, blas_int* ipiv, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgbtrf)(const blas_int* m, const blas_int* n, const blas_int* kl, const blas_int* ku, double* ab, const blas_int* ldab, blas_int* ipiv, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cgbtrf)(const blas_int* m, const blas_int* n, const blas_int* kl, const blas_int* ku, blas_cxf* ab, const blas_int* ldab, blas_int* ipiv, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgbtrf)(const blas_int* m, const blas_int* n, const blas_int* kl, const blas_int* ku, blas_cxd* ab, const blas_int* ldab, blas_int* ipiv, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations using pre-computed LU decomposition (general band matrix) - void arma_fortran(arma_sgbtrs)(const char* trans, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, const float* ab, const blas_int* ldab, const blas_int* ipiv, float* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgbtrs)(const char* trans, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, const double* ab, const blas_int* ldab, const blas_int* ipiv, double* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cgbtrs)(const char* trans, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, const blas_cxf* ab, const blas_int* ldab, const blas_int* ipiv, blas_cxf* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgbtrs)(const char* trans, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, const blas_cxd* ab, const blas_int* ldab, const blas_int* ipiv, blas_cxd* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations (general band matrix) - void arma_fortran(arma_sgbsv)(const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, float* ab, const blas_int* ldab, blas_int* ipiv, float* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgbsv)(const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, double* ab, const blas_int* ldab, blas_int* ipiv, double* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cgbsv)(const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, blas_cxf* ab, const blas_int* ldab, blas_int* ipiv, blas_cxf* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgbsv)(const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, blas_cxd* ab, const blas_int* ldab, blas_int* ipiv, blas_cxd* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations (general band matrix, advanced form, real matrices) - void arma_fortran(arma_sgbsvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, float* ab, const blas_int* ldab, float* afb, const blas_int* ldafb, blas_int* ipiv, char* equed, float* r, float* c, float* b, const blas_int* ldb, float* x, const blas_int* ldx, float* rcond, float* ferr, float* berr, float* work, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgbsvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, double* ab, const blas_int* ldab, double* afb, const blas_int* ldafb, blas_int* ipiv, char* equed, double* r, double* c, double* b, const blas_int* ldb, double* x, const blas_int* ldx, double* rcond, double* ferr, double* berr, double* work, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations (general band matrix, advanced form, complex matrices) - void arma_fortran(arma_cgbsvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, blas_cxf* ab, const blas_int* ldab, blas_cxf* afb, const blas_int* ldafb, blas_int* ipiv, char* equed, float* r, float* c, blas_cxf* b, const blas_int* ldb, blas_cxf* x, const blas_int* ldx, float* rcond, float* ferr, float* berr, blas_cxf* work, float* rwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgbsvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_int* nrhs, blas_cxd* ab, const blas_int* ldab, blas_cxd* afb, const blas_int* ldafb, blas_int* ipiv, char* equed, double* r, double* c, blas_cxd* b, const blas_int* ldb, blas_cxd* x, const blas_int* ldx, double* rcond, double* ferr, double* berr, blas_cxd* work, double* rwork, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations (tridiagonal band matrix) - void arma_fortran(arma_sgtsv)(const blas_int* n, const blas_int* nrhs, float* dl, float* d, float* du, float* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgtsv)(const blas_int* n, const blas_int* nrhs, double* dl, double* d, double* du, double* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cgtsv)(const blas_int* n, const blas_int* nrhs, blas_cxf* dl, blas_cxf* d, blas_cxf* du, blas_cxf* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgtsv)(const blas_int* n, const blas_int* nrhs, blas_cxd* dl, blas_cxd* d, blas_cxd* du, blas_cxd* b, const blas_int* ldb, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations (tridiagonal band matrix, advanced form, real matrices) - void arma_fortran(arma_sgtsvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* nrhs, const float* dl, const float* d, const float* du, float* dlf, float* df, float* duf, float* du2, blas_int* ipiv, const float* b, const blas_int* ldb, float* x, const blas_int* ldx, float* rcond, float* ferr, float* berr, float* work, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgtsvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* nrhs, const double* dl, const double* d, const double* du, double* dlf, double* df, double* duf, double* du2, blas_int* ipiv, const double* b, const blas_int* ldb, double* x, const blas_int* ldx, double* rcond, double* ferr, double* berr, double* work, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - - // solve system of linear equations (tridiagonal band matrix, advanced form, complex matrices) - void arma_fortran(arma_cgtsvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* nrhs, const blas_cxf* dl, const blas_cxf* d, const blas_cxf* du, blas_cxf* dlf, blas_cxf* df, blas_cxf* duf, blas_cxf* du2, blas_int* ipiv, const blas_cxf* b, const blas_int* ldb, blas_cxf* x, const blas_int* ldx, float* rcond, float* ferr, float* berr, blas_cxf* work, float* rwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgtsvx)(const char* fact, const char* trans, const blas_int* n, const blas_int* nrhs, const blas_cxd* dl, const blas_cxd* d, const blas_cxd* du, blas_cxd* dlf, blas_cxd* df, blas_cxd* duf, blas_cxd* du2, blas_int* ipiv, const blas_cxd* b, const blas_int* ldb, blas_cxd* x, const blas_int* ldx, double* rcond, double* ferr, double* berr, blas_cxd* work, double* rwork, blas_int* info) ARMA_NOEXCEPT; - - // Schur decomposition (real matrices) - void arma_fortran(arma_sgees)(const char* jobvs, const char* sort, fn_select_s2 select, const blas_int* n, float* a, const blas_int* lda, blas_int* sdim, float* wr, float* wi, float* vs, const blas_int* ldvs, float* work, const blas_int* lwork, blas_int* bwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgees)(const char* jobvs, const char* sort, fn_select_d2 select, const blas_int* n, double* a, const blas_int* lda, blas_int* sdim, double* wr, double* wi, double* vs, const blas_int* ldvs, double* work, const blas_int* lwork, blas_int* bwork, blas_int* info) ARMA_NOEXCEPT; - - // Schur decomposition (complex matrices) - void arma_fortran(arma_cgees)(const char* jobvs, const char* sort, fn_select_c1 select, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_int* sdim, blas_cxf* w, blas_cxf* vs, const blas_int* ldvs, blas_cxf* work, const blas_int* lwork, float* rwork, blas_int* bwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgees)(const char* jobvs, const char* sort, fn_select_z1 select, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_int* sdim, blas_cxd* w, blas_cxd* vs, const blas_int* ldvs, blas_cxd* work, const blas_int* lwork, double* rwork, blas_int* bwork, blas_int* info) ARMA_NOEXCEPT; - - // solve a Sylvester equation ax + xb = c, with a and b assumed to be in Schur form - void arma_fortran(arma_strsyl)(const char* transa, const char* transb, const blas_int* isgn, const blas_int* m, const blas_int* n, const float* a, const blas_int* lda, const float* b, const blas_int* ldb, float* c, const blas_int* ldc, float* scale, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dtrsyl)(const char* transa, const char* transb, const blas_int* isgn, const blas_int* m, const blas_int* n, const double* a, const blas_int* lda, const double* b, const blas_int* ldb, double* c, const blas_int* ldc, double* scale, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_ctrsyl)(const char* transa, const char* transb, const blas_int* isgn, const blas_int* m, const blas_int* n, const blas_cxf* a, const blas_int* lda, const blas_cxf* b, const blas_int* ldb, blas_cxf* c, const blas_int* ldc, float* scale, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_ztrsyl)(const char* transa, const char* transb, const blas_int* isgn, const blas_int* m, const blas_int* n, const blas_cxd* a, const blas_int* lda, const blas_cxd* b, const blas_int* ldb, blas_cxd* c, const blas_int* ldc, double* scale, blas_int* info) ARMA_NOEXCEPT; - - // QZ decomposition (real matrices) - void arma_fortran(arma_sgges)(const char* jobvsl, const char* jobvsr, const char* sort, fn_select_s3 selctg, const blas_int* n, float* a, const blas_int* lda, float* b, const blas_int* ldb, blas_int* sdim, float* alphar, float* alphai, float* beta, float* vsl, const blas_int* ldvsl, float* vsr, const blas_int* ldvsr, float* work, const blas_int* lwork, blas_int* bwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgges)(const char* jobvsl, const char* jobvsr, const char* sort, fn_select_d3 selctg, const blas_int* n, double* a, const blas_int* lda, double* b, const blas_int* ldb, blas_int* sdim, double* alphar, double* alphai, double* beta, double* vsl, const blas_int* ldvsl, double* vsr, const blas_int* ldvsr, double* work, const blas_int* lwork, blas_int* bwork, blas_int* info) ARMA_NOEXCEPT; - - // QZ decomposition (complex matrices) - void arma_fortran(arma_cgges)(const char* jobvsl, const char* jobvsr, const char* sort, fn_select_c2 selctg, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_cxf* b, const blas_int* ldb, blas_int* sdim, blas_cxf* alpha, blas_cxf* beta, blas_cxf* vsl, const blas_int* ldvsl, blas_cxf* vsr, const blas_int* ldvsr, blas_cxf* work, const blas_int* lwork, float* rwork, blas_int* bwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgges)(const char* jobvsl, const char* jobvsr, const char* sort, fn_select_z2 selctg, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_cxd* b, const blas_int* ldb, blas_int* sdim, blas_cxd* alpha, blas_cxd* beta, blas_cxd* vsl, const blas_int* ldvsl, blas_cxd* vsr, const blas_int* ldvsr, blas_cxd* work, const blas_int* lwork, double* rwork, blas_int* bwork, blas_int* info) ARMA_NOEXCEPT; - - // 1-norm (general matrix) - float arma_fortran(arma_slange)(const char* norm, const blas_int* m, const blas_int* n, const float* a, const blas_int* lda, float* work) ARMA_NOEXCEPT; - double arma_fortran(arma_dlange)(const char* norm, const blas_int* m, const blas_int* n, const double* a, const blas_int* lda, double* work) ARMA_NOEXCEPT; - float arma_fortran(arma_clange)(const char* norm, const blas_int* m, const blas_int* n, const blas_cxf* a, const blas_int* lda, float* work) ARMA_NOEXCEPT; - double arma_fortran(arma_zlange)(const char* norm, const blas_int* m, const blas_int* n, const blas_cxd* a, const blas_int* lda, double* work) ARMA_NOEXCEPT; - - // 1-norm (real symmetric matrix) - float arma_fortran(arma_slansy)(const char* norm, const char* uplo, const blas_int* n, const float* a, const blas_int* lda, float* work) ARMA_NOEXCEPT; - double arma_fortran(arma_dlansy)(const char* norm, const char* uplo, const blas_int* n, const double* a, const blas_int* lda, double* work) ARMA_NOEXCEPT; - float arma_fortran(arma_clansy)(const char* norm, const char* uplo, const blas_int* n, const blas_cxf* a, const blas_int* lda, float* work) ARMA_NOEXCEPT; - double arma_fortran(arma_zlansy)(const char* norm, const char* uplo, const blas_int* n, const blas_cxd* a, const blas_int* lda, double* work) ARMA_NOEXCEPT; - - // 1-norm (complex hermitian matrix) - float arma_fortran(arma_clanhe)(const char* norm, const char* uplo, const blas_int* n, const blas_cxf* a, const blas_int* lda, float* work) ARMA_NOEXCEPT; - double arma_fortran(arma_zlanhe)(const char* norm, const char* uplo, const blas_int* n, const blas_cxd* a, const blas_int* lda, double* work) ARMA_NOEXCEPT; - - // 1-norm (band matrix) - float arma_fortran(arma_slangb)(const char* norm, const blas_int* n, const blas_int* kl, const blas_int* ku, const float* ab, const blas_int* ldab, float* work) ARMA_NOEXCEPT; - double arma_fortran(arma_dlangb)(const char* norm, const blas_int* n, const blas_int* kl, const blas_int* ku, const double* ab, const blas_int* ldab, double* work) ARMA_NOEXCEPT; - float arma_fortran(arma_clangb)(const char* norm, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_cxf* ab, const blas_int* ldab, float* work) ARMA_NOEXCEPT; - double arma_fortran(arma_zlangb)(const char* norm, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_cxd* ab, const blas_int* ldab, double* work) ARMA_NOEXCEPT; - - // reciprocal of condition number (real, generic matrix) - void arma_fortran(arma_sgecon)(const char* norm, const blas_int* n, const float* a, const blas_int* lda, const float* anorm, float* rcond, float* work, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgecon)(const char* norm, const blas_int* n, const double* a, const blas_int* lda, const double* anorm, double* rcond, double* work, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - - // reciprocal of condition number (complex, generic matrix) - void arma_fortran(arma_cgecon)(const char* norm, const blas_int* n, const blas_cxf* a, const blas_int* lda, const float* anorm, float* rcond, blas_cxf* work, float* rwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgecon)(const char* norm, const blas_int* n, const blas_cxd* a, const blas_int* lda, const double* anorm, double* rcond, blas_cxd* work, double* rwork, blas_int* info) ARMA_NOEXCEPT; - - // reciprocal of condition number (real, symmetric positive definite matrix) - void arma_fortran(arma_spocon)(const char* uplo, const blas_int* n, const float* a, const blas_int* lda, const float* anorm, float* rcond, float* work, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dpocon)(const char* uplo, const blas_int* n, const double* a, const blas_int* lda, const double* anorm, double* rcond, double* work, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - - // reciprocal of condition number (complex, hermitian positive definite matrix) - void arma_fortran(arma_cpocon)(const char* uplo, const blas_int* n, const blas_cxf* a, const blas_int* lda, const float* anorm, float* rcond, blas_cxf* work, float* rwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zpocon)(const char* uplo, const blas_int* n, const blas_cxd* a, const blas_int* lda, const double* anorm, double* rcond, blas_cxd* work, double* rwork, blas_int* info) ARMA_NOEXCEPT; - - // reciprocal of condition number (real, triangular matrix) - void arma_fortran(arma_strcon)(const char* norm, const char* uplo, const char* diag, const blas_int* n, const float* a, const blas_int* lda, float* rcond, float* work, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dtrcon)(const char* norm, const char* uplo, const char* diag, const blas_int* n, const double* a, const blas_int* lda, double* rcond, double* work, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - - // reciprocal of condition number (complex, triangular matrix) - void arma_fortran(arma_ctrcon)(const char* norm, const char* uplo, const char* diag, const blas_int* n, const blas_cxf* a, const blas_int* lda, float* rcond, blas_cxf* work, float* rwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_ztrcon)(const char* norm, const char* uplo, const char* diag, const blas_int* n, const blas_cxd* a, const blas_int* lda, double* rcond, blas_cxd* work, double* rwork, blas_int* info) ARMA_NOEXCEPT; - - // reciprocal of condition number (real, band matrix) - void arma_fortran(arma_sgbcon)(const char* norm, const blas_int* n, const blas_int* kl, const blas_int* ku, const float* ab, const blas_int* ldab, const blas_int* ipiv, const float* anorm, float* rcond, float* work, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgbcon)(const char* norm, const blas_int* n, const blas_int* kl, const blas_int* ku, const double* ab, const blas_int* ldab, const blas_int* ipiv, const double* anorm, double* rcond, double* work, blas_int* iwork, blas_int* info) ARMA_NOEXCEPT; - - // reciprocal of condition number (complex, band matrix) - void arma_fortran(arma_cgbcon)(const char* norm, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_cxf* ab, const blas_int* ldab, const blas_int* ipiv, const float* anorm, float* rcond, blas_cxf* work, float* rwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgbcon)(const char* norm, const blas_int* n, const blas_int* kl, const blas_int* ku, const blas_cxd* ab, const blas_int* ldab, const blas_int* ipiv, const double* anorm, double* rcond, blas_cxd* work, double* rwork, blas_int* info) ARMA_NOEXCEPT; - - // obtain parameters according to the local configuration of lapack - // NOTE: DO NOT USE THIS FORM; kept only for compatibility - // NOTE: this function takes 'name' and 'opts' argumments, which are strings with length != 1; their length needs to be given via "hidden" parameters, which this form lacks - blas_int arma_fortran(arma_ilaenv)(const blas_int* ispec, const char* name, const char* opts, const blas_int* n1, const blas_int* n2, const blas_int* n3, const blas_int* n4) ARMA_NOEXCEPT; - - // calculate eigenvalues of an upper Hessenberg matrix - void arma_fortran(arma_slahqr)(const blas_int* wantt, const blas_int* wantz, const blas_int* n, const blas_int* ilo, const blas_int* ihi, float* h, const blas_int* ldh, float* wr, float* wi, const blas_int* iloz, const blas_int* ihiz, float* z, const blas_int* ldz, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dlahqr)(const blas_int* wantt, const blas_int* wantz, const blas_int* n, const blas_int* ilo, const blas_int* ihi, double* h, const blas_int* ldh, double* wr, double* wi, const blas_int* iloz, const blas_int* ihiz, double* z, const blas_int* ldz, blas_int* info) ARMA_NOEXCEPT; - - // calculate eigenvalues of a symmetric tridiagonal matrix - void arma_fortran(arma_sstedc)(const char* compz, const blas_int* n, float* d, float* e, float* z, const blas_int* ldz, float* work, const blas_int* lwork, blas_int* iwork, const blas_int* liwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dstedc)(const char* compz, const blas_int* n, double* d, double* e, double* z, const blas_int* ldz, double* work, const blas_int* lwork, blas_int* iwork, const blas_int* liwork, blas_int* info) ARMA_NOEXCEPT; - - // calculate eigenvectors of a Schur form matrix - void arma_fortran(arma_strevc)(const char* side, const char* howmny, blas_int* select, const blas_int* n, const float* t, const blas_int* ldt, float* vl, const blas_int* ldvl, float* vr, const blas_int* ldvr, const blas_int* mm, blas_int* m, float* work, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dtrevc)(const char* side, const char* howmny, blas_int* select, const blas_int* n, const double* t, const blas_int* ldt, double* vl, const blas_int* ldvl, double* vr, const blas_int* ldvr, const blas_int* mm, blas_int* m, double* work, blas_int* info) ARMA_NOEXCEPT; - - // hessenberg decomposition - void arma_fortran(arma_sgehrd)(const blas_int* n, const blas_int* ilo, const blas_int* ihi, float* a, const blas_int* lda, float* tao, float* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dgehrd)(const blas_int* n, const blas_int* ilo, const blas_int* ihi, double* a, const blas_int* lda, double* tao, double* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cgehrd)(const blas_int* n, const blas_int* ilo, const blas_int* ihi, blas_cxf* a, const blas_int* lda, blas_cxf* tao, blas_cxf* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zgehrd)(const blas_int* n, const blas_int* ilo, const blas_int* ihi, blas_cxd* a, const blas_int* lda, blas_cxd* tao, blas_cxd* work, const blas_int* lwork, blas_int* info) ARMA_NOEXCEPT; - - // pivoted cholesky - void arma_fortran(arma_spstrf)(const char* uplo, const blas_int* n, float* a, const blas_int* lda, blas_int* piv, blas_int* rank, const float* tol, float* work, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_dpstrf)(const char* uplo, const blas_int* n, double* a, const blas_int* lda, blas_int* piv, blas_int* rank, const double* tol, double* work, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_cpstrf)(const char* uplo, const blas_int* n, blas_cxf* a, const blas_int* lda, blas_int* piv, blas_int* rank, const float* tol, float* work, blas_int* info) ARMA_NOEXCEPT; - void arma_fortran(arma_zpstrf)(const char* uplo, const blas_int* n, blas_cxd* a, const blas_int* lda, blas_int* piv, blas_int* rank, const double* tol, double* work, blas_int* info) ARMA_NOEXCEPT; - -#endif -} - -#undef ARMA_NOEXCEPT - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/def_superlu.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/def_superlu.hpp deleted file mode 100644 index 81f6ac398..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/def_superlu.hpp +++ /dev/null @@ -1,78 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - -#if defined(ARMA_USE_SUPERLU) - -extern "C" - { - extern void arma_wrapper(sgssv)(superlu::superlu_options_t*, superlu::SuperMatrix*, int*, int*, superlu::SuperMatrix*, superlu::SuperMatrix*, superlu::SuperMatrix*, superlu::SuperLUStat_t*, int*); - extern void arma_wrapper(dgssv)(superlu::superlu_options_t*, superlu::SuperMatrix*, int*, int*, superlu::SuperMatrix*, superlu::SuperMatrix*, superlu::SuperMatrix*, superlu::SuperLUStat_t*, int*); - extern void arma_wrapper(cgssv)(superlu::superlu_options_t*, superlu::SuperMatrix*, int*, int*, superlu::SuperMatrix*, superlu::SuperMatrix*, superlu::SuperMatrix*, superlu::SuperLUStat_t*, int*); - extern void arma_wrapper(zgssv)(superlu::superlu_options_t*, superlu::SuperMatrix*, int*, int*, superlu::SuperMatrix*, superlu::SuperMatrix*, superlu::SuperMatrix*, superlu::SuperLUStat_t*, int*); - - extern void arma_wrapper(sgssvx)(superlu::superlu_options_t*, superlu::SuperMatrix*, int*, int*, int*, char*, float*, float*, superlu::SuperMatrix*, superlu::SuperMatrix*, void*, int, superlu::SuperMatrix*, superlu::SuperMatrix*, float*, float*, float*, float*, superlu::GlobalLU_t*, superlu::mem_usage_t*, superlu::SuperLUStat_t*, int*); - extern void arma_wrapper(dgssvx)(superlu::superlu_options_t*, superlu::SuperMatrix*, int*, int*, int*, char*, double*, double*, superlu::SuperMatrix*, superlu::SuperMatrix*, void*, int, superlu::SuperMatrix*, superlu::SuperMatrix*, double*, double*, double*, double*, superlu::GlobalLU_t*, superlu::mem_usage_t*, superlu::SuperLUStat_t*, int*); - extern void arma_wrapper(cgssvx)(superlu::superlu_options_t*, superlu::SuperMatrix*, int*, int*, int*, char*, float*, float*, superlu::SuperMatrix*, superlu::SuperMatrix*, void*, int, superlu::SuperMatrix*, superlu::SuperMatrix*, float*, float*, float*, float*, superlu::GlobalLU_t*, superlu::mem_usage_t*, superlu::SuperLUStat_t*, int*); - extern void arma_wrapper(zgssvx)(superlu::superlu_options_t*, superlu::SuperMatrix*, int*, int*, int*, char*, double*, double*, superlu::SuperMatrix*, superlu::SuperMatrix*, void*, int, superlu::SuperMatrix*, superlu::SuperMatrix*, double*, double*, double*, double*, superlu::GlobalLU_t*, superlu::mem_usage_t*, superlu::SuperLUStat_t*, int*); - - extern void arma_wrapper(sgstrf)(superlu::superlu_options_t*, superlu::SuperMatrix*, int, int, int*, void*, int, int*, int*, superlu::SuperMatrix*, superlu::SuperMatrix*, superlu::GlobalLU_t*, superlu::SuperLUStat_t*, int*); - extern void arma_wrapper(dgstrf)(superlu::superlu_options_t*, superlu::SuperMatrix*, int, int, int*, void*, int, int*, int*, superlu::SuperMatrix*, superlu::SuperMatrix*, superlu::GlobalLU_t*, superlu::SuperLUStat_t*, int*); - extern void arma_wrapper(cgstrf)(superlu::superlu_options_t*, superlu::SuperMatrix*, int, int, int*, void*, int, int*, int*, superlu::SuperMatrix*, superlu::SuperMatrix*, superlu::GlobalLU_t*, superlu::SuperLUStat_t*, int*); - extern void arma_wrapper(zgstrf)(superlu::superlu_options_t*, superlu::SuperMatrix*, int, int, int*, void*, int, int*, int*, superlu::SuperMatrix*, superlu::SuperMatrix*, superlu::GlobalLU_t*, superlu::SuperLUStat_t*, int*); - - extern void arma_wrapper(sgstrs)(superlu::trans_t, superlu::SuperMatrix*, superlu::SuperMatrix*, int*, int*, superlu::SuperMatrix*, superlu::SuperLUStat_t*, int*); - extern void arma_wrapper(dgstrs)(superlu::trans_t, superlu::SuperMatrix*, superlu::SuperMatrix*, int*, int*, superlu::SuperMatrix*, superlu::SuperLUStat_t*, int*); - extern void arma_wrapper(cgstrs)(superlu::trans_t, superlu::SuperMatrix*, superlu::SuperMatrix*, int*, int*, superlu::SuperMatrix*, superlu::SuperLUStat_t*, int*); - extern void arma_wrapper(zgstrs)(superlu::trans_t, superlu::SuperMatrix*, superlu::SuperMatrix*, int*, int*, superlu::SuperMatrix*, superlu::SuperLUStat_t*, int*); - - extern float arma_wrapper(slangs)(char* norm, superlu::SuperMatrix* A); - extern double arma_wrapper(dlangs)(char* norm, superlu::SuperMatrix* A); - extern float arma_wrapper(clangs)(char* norm, superlu::SuperMatrix* A); - extern double arma_wrapper(zlangs)(char* norm, superlu::SuperMatrix* A); - - extern void arma_wrapper(sgscon)(char* norm, superlu::SuperMatrix* L, superlu::SuperMatrix* U, float anorm, float* rcond, superlu::SuperLUStat_t* stat, int* info); - extern void arma_wrapper(dgscon)(char* norm, superlu::SuperMatrix* L, superlu::SuperMatrix* U, double anorm, double* rcond, superlu::SuperLUStat_t* stat, int* info); - extern void arma_wrapper(cgscon)(char* norm, superlu::SuperMatrix* L, superlu::SuperMatrix* U, float anorm, float* rcond, superlu::SuperLUStat_t* stat, int* info); - extern void arma_wrapper(zgscon)(char* norm, superlu::SuperMatrix* L, superlu::SuperMatrix* U, double anorm, double* rcond, superlu::SuperLUStat_t* stat, int* info); - - extern void arma_wrapper(StatInit)(superlu::SuperLUStat_t*); - extern void arma_wrapper(StatFree)(superlu::SuperLUStat_t*); - extern void arma_wrapper(set_default_options)(superlu::superlu_options_t*); - - extern void arma_wrapper(get_perm_c)(int, superlu::SuperMatrix*, int*); - extern int arma_wrapper(sp_ienv)(int); - extern void arma_wrapper(sp_preorder)(superlu::superlu_options_t*, superlu::SuperMatrix*, int*, int*, superlu::SuperMatrix*); - - extern void arma_wrapper(Destroy_SuperNode_Matrix)(superlu::SuperMatrix*); - extern void arma_wrapper(Destroy_CompCol_Matrix)(superlu::SuperMatrix*); - extern void arma_wrapper(Destroy_CompCol_Permuted)(superlu::SuperMatrix*); - extern void arma_wrapper(Destroy_SuperMatrix_Store)(superlu::SuperMatrix*); - - // We also need superlu_malloc() and superlu_free(). - // When using the original SuperLU code directly, you (the user) may - // define USER_MALLOC and USER_FREE, but the joke is on you because - // if you are linking against SuperLU and not compiling from scratch, - // it won't actually make a difference anyway! If you've compiled - // SuperLU against a custom USER_MALLOC and USER_FREE, you're probably up - // shit creek about a thousand different ways before you even get to this - // code, so, don't do that! - - extern void* arma_wrapper(superlu_malloc)(size_t); - extern void arma_wrapper(superlu_free)(void*); - } - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/diagmat_proxy.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/diagmat_proxy.hpp deleted file mode 100644 index 6d8a727db..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/diagmat_proxy.hpp +++ /dev/null @@ -1,375 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup diagmat_proxy -//! @{ - - - -template -class diagmat_proxy_default - { - public: - - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - - inline - diagmat_proxy_default(const T1& X) - : P ( X ) - , P_is_vec( (resolves_to_vector::yes) || (P.get_n_rows() == 1) || (P.get_n_cols() == 1) ) - , P_is_col( T1::is_col || (P.get_n_cols() == 1) ) - , n_rows ( P_is_vec ? P.get_n_elem() : P.get_n_rows() ) - , n_cols ( P_is_vec ? P.get_n_elem() : P.get_n_cols() ) - { - arma_debug_sigprint(); - } - - - arma_inline - elem_type - operator[](const uword i) const - { - if(Proxy::use_at == false) - { - return P_is_vec ? P[i] : P.at(i,i); - } - else - { - if(P_is_vec) - { - return (P_is_col) ? P.at(i,0) : P.at(0,i); - } - else - { - return P.at(i,i); - } - } - } - - - arma_inline - elem_type - at(const uword row, const uword col) const - { - if(row == col) - { - if(Proxy::use_at == false) - { - return (P_is_vec) ? P[row] : P.at(row,row); - } - else - { - if(P_is_vec) - { - return (P_is_col) ? P.at(row,0) : P.at(0,row); - } - else - { - return P.at(row,row); - } - } - } - else - { - return elem_type(0); - } - } - - - inline bool is_alias(const Mat& X) const { return P.is_alias(X); } - - const Proxy P; - const bool P_is_vec; - const bool P_is_col; - const uword n_rows; - const uword n_cols; - }; - - - -template -class diagmat_proxy_fixed - { - public: - - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - - inline - diagmat_proxy_fixed(const T1& X) - : P(X) - { - arma_debug_sigprint(); - } - - - arma_inline - elem_type - operator[](const uword i) const - { - return (P_is_vec) ? P[i] : P.at(i,i); - } - - - arma_inline - elem_type - at(const uword row, const uword col) const - { - if(row == col) - { - return (P_is_vec) ? P[row] : P.at(row,row); - } - else - { - return elem_type(0); - } - } - - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&P)); } - - const T1& P; - - //// this may require T1::n_elem etc to be declared as static constexpr inline variables (C++17) - //// see also the notes in Mat::fixed - // static constexpr bool P_is_vec = (T1::n_rows == 1) || (T1::n_cols == 1); - // static constexpr uword n_rows = P_is_vec ? T1::n_elem : T1::n_rows; - // static constexpr uword n_cols = P_is_vec ? T1::n_elem : T1::n_cols; - - static const bool P_is_vec = (T1::n_rows == 1) || (T1::n_cols == 1); - static const uword n_rows = P_is_vec ? T1::n_elem : T1::n_rows; - static const uword n_cols = P_is_vec ? T1::n_elem : T1::n_cols; - }; - - - -template -struct diagmat_proxy_redirect {}; - -template -struct diagmat_proxy_redirect { typedef diagmat_proxy_default result; }; - -template -struct diagmat_proxy_redirect { typedef diagmat_proxy_fixed result; }; - - -template -class diagmat_proxy : public diagmat_proxy_redirect::value>::result - { - public: - inline diagmat_proxy(const T1& X) - : diagmat_proxy_redirect::value>::result(X) - { - } - }; - - - -template -class diagmat_proxy< Mat > - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - inline - diagmat_proxy(const Mat& X) - : P ( X ) - , P_is_vec( (X.n_rows == 1) || (X.n_cols == 1) ) - , n_rows ( P_is_vec ? X.n_elem : X.n_rows ) - , n_cols ( P_is_vec ? X.n_elem : X.n_cols ) - { - arma_debug_sigprint(); - } - - arma_inline elem_type operator[] (const uword i) const { return P_is_vec ? P[i] : P.at(i,i); } - arma_inline elem_type at (const uword row, const uword col) const { return (row == col) ? ( P_is_vec ? P[row] : P.at(row,row) ) : elem_type(0); } - - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&P)); } - - const Mat& P; - const bool P_is_vec; - const uword n_rows; - const uword n_cols; - }; - - - -template -class diagmat_proxy< Row > - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - - inline - diagmat_proxy(const Row& X) - : P(X) - , n_rows(X.n_elem) - , n_cols(X.n_elem) - { - arma_debug_sigprint(); - } - - arma_inline elem_type operator[] (const uword i) const { return P[i]; } - arma_inline elem_type at (const uword row, const uword col) const { return (row == col) ? P[row] : elem_type(0); } - - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&P)); } - - static constexpr bool P_is_vec = true; - - const Row& P; - const uword n_rows; - const uword n_cols; - }; - - - -template -class diagmat_proxy< Col > - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - - inline - diagmat_proxy(const Col& X) - : P(X) - , n_rows(X.n_elem) - , n_cols(X.n_elem) - { - arma_debug_sigprint(); - } - - arma_inline elem_type operator[] (const uword i) const { return P[i]; } - arma_inline elem_type at (const uword row, const uword col) const { return (row == col) ? P[row] : elem_type(0); } - - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&P)); } - - static constexpr bool P_is_vec = true; - - const Col& P; - const uword n_rows; - const uword n_cols; - }; - - - -template -class diagmat_proxy< subview_row > - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - - inline - diagmat_proxy(const subview_row& X) - : P(X) - , n_rows(X.n_elem) - , n_cols(X.n_elem) - { - arma_debug_sigprint(); - } - - arma_inline elem_type operator[] (const uword i) const { return P[i]; } - arma_inline elem_type at (const uword row, const uword col) const { return (row == col) ? P[row] : elem_type(0); } - - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&(P.m))); } - - static constexpr bool P_is_vec = true; - - const subview_row& P; - const uword n_rows; - const uword n_cols; - }; - - - -template -class diagmat_proxy< subview_col > - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - - inline - diagmat_proxy(const subview_col& X) - : P(X) - , n_rows(X.n_elem) - , n_cols(X.n_elem) - { - arma_debug_sigprint(); - } - - arma_inline elem_type operator[] (const uword i) const { return P[i]; } - arma_inline elem_type at (const uword row, const uword col) const { return (row == col) ? P[row] : elem_type(0); } - - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&(P.m))); } - - static constexpr bool P_is_vec = true; - - const subview_col& P; - const uword n_rows; - const uword n_cols; - }; - - - -template -class diagmat_proxy< Glue > - { - public: - - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - - inline - diagmat_proxy(const Glue& X) - { - op_diagmat::apply_times(P, X.A, X.B); - - n_rows = P.n_rows; - n_cols = P.n_cols; - - arma_debug_sigprint(); - } - - arma_inline elem_type operator[] (const uword i) const { return P.at(i,i); } - arma_inline elem_type at (const uword row, const uword col) const { return (row == col) ? P.at(row,row) : elem_type(0); } - - constexpr bool is_alias(const Mat&) const { return false; } - - static constexpr bool P_is_vec = false; - - Mat P; - uword n_rows; - uword n_cols; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/diagview_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/diagview_bones.hpp deleted file mode 100644 index 5aa4bcee7..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/diagview_bones.hpp +++ /dev/null @@ -1,117 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup diagview -//! @{ - - -//! Class for storing data required to extract and set the diagonals of a matrix -template -class diagview : public Base< eT, diagview > - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - arma_aligned const Mat& m; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - const uword row_offset; - const uword col_offset; - - const uword n_rows; // equal to n_elem - const uword n_elem; - - static constexpr uword n_cols = 1; - - - protected: - - arma_inline diagview(const Mat& in_m, const uword in_row_offset, const uword in_col_offset, const uword len); - - - public: - - inline ~diagview(); - inline diagview() = delete; - - inline diagview(const diagview& in); - inline diagview( diagview&& in); - - inline void operator=(const diagview& x); - - inline void operator+=(const eT val); - inline void operator-=(const eT val); - inline void operator*=(const eT val); - inline void operator/=(const eT val); - - template inline void operator= (const Base& x); - template inline void operator+=(const Base& x); - template inline void operator-=(const Base& x); - template inline void operator%=(const Base& x); - template inline void operator/=(const Base& x); - - - arma_inline eT at_alt (const uword ii) const; - - arma_inline eT& operator[](const uword ii); - arma_inline eT operator[](const uword ii) const; - - arma_inline eT& at(const uword ii); - arma_inline eT at(const uword ii) const; - - arma_inline eT& operator()(const uword ii); - arma_inline eT operator()(const uword ii) const; - - arma_inline eT& at(const uword in_n_row, const uword); - arma_inline eT at(const uword in_n_row, const uword) const; - - arma_inline eT& operator()(const uword in_n_row, const uword in_n_col); - arma_inline eT operator()(const uword in_n_row, const uword in_n_col) const; - - - inline void replace(const eT old_val, const eT new_val); - - inline void clean(const pod_type threshold); - - inline void clamp(const eT min_val, const eT max_val); - - inline void fill(const eT val); - inline void zeros(); - inline void ones(); - inline void randu(); - inline void randn(); - - inline static void extract(Mat& out, const diagview& in); - - inline static void plus_inplace(Mat& out, const diagview& in); - inline static void minus_inplace(Mat& out, const diagview& in); - inline static void schur_inplace(Mat& out, const diagview& in); - inline static void div_inplace(Mat& out, const diagview& in); - - - friend class Mat; - friend class subview; - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/diagview_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/diagview_meat.hpp deleted file mode 100644 index c8d741ab7..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/diagview_meat.hpp +++ /dev/null @@ -1,1025 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup diagview -//! @{ - - -template -inline -diagview::~diagview() - { - arma_debug_sigprint_this(this); - } - - - -template -arma_inline -diagview::diagview(const Mat& in_m, const uword in_row_offset, const uword in_col_offset, const uword in_len) - : m (in_m ) - , row_offset(in_row_offset) - , col_offset(in_col_offset) - , n_rows (in_len ) - , n_elem (in_len ) - { - arma_debug_sigprint_this(this); - } - - - -template -inline -diagview::diagview(const diagview& in) - : m (in.m ) - , row_offset(in.row_offset) - , col_offset(in.col_offset) - , n_rows (in.n_rows ) - , n_elem (in.n_elem ) - { - arma_debug_sigprint(arma_str::format("this: %x; in: %x") % this % &in); - } - - - -template -inline -diagview::diagview(diagview&& in) - : m (in.m ) - , row_offset(in.row_offset) - , col_offset(in.col_offset) - , n_rows (in.n_rows ) - , n_elem (in.n_elem ) - { - arma_debug_sigprint(arma_str::format("this: %x; in: %x") % this % &in); - - // for paranoia - - access::rw(in.row_offset) = 0; - access::rw(in.col_offset) = 0; - access::rw(in.n_rows ) = 0; - access::rw(in.n_elem ) = 0; - } - - - -//! set a diagonal of our matrix using a diagonal from a foreign matrix -template -inline -void -diagview::operator= (const diagview& x) - { - arma_debug_sigprint(); - - diagview& d = *this; - - arma_conform_check( (d.n_elem != x.n_elem), "diagview: diagonals have incompatible lengths" ); - - Mat& d_m = const_cast< Mat& >(d.m); - const Mat& x_m = x.m; - - if(&d_m != &x_m) - { - const uword d_n_elem = d.n_elem; - const uword d_row_offset = d.row_offset; - const uword d_col_offset = d.col_offset; - - const uword x_row_offset = x.row_offset; - const uword x_col_offset = x.col_offset; - - uword ii,jj; - for(ii=0, jj=1; jj < d_n_elem; ii+=2, jj+=2) - { - const eT tmp_i = x_m.at(ii + x_row_offset, ii + x_col_offset); - const eT tmp_j = x_m.at(jj + x_row_offset, jj + x_col_offset); - - d_m.at(ii + d_row_offset, ii + d_col_offset) = tmp_i; - d_m.at(jj + d_row_offset, jj + d_col_offset) = tmp_j; - } - - if(ii < d_n_elem) - { - d_m.at(ii + d_row_offset, ii + d_col_offset) = x_m.at(ii + x_row_offset, ii + x_col_offset); - } - } - else - { - const Mat tmp = x; - - (*this).operator=(tmp); - } - } - - - -template -inline -void -diagview::operator+=(const eT val) - { - arma_debug_sigprint(); - - Mat& t_m = const_cast< Mat& >(m); - - const uword t_n_elem = n_elem; - const uword t_row_offset = row_offset; - const uword t_col_offset = col_offset; - - for(uword ii=0; ii < t_n_elem; ++ii) - { - t_m.at( ii + t_row_offset, ii + t_col_offset) += val; - } - } - - - -template -inline -void -diagview::operator-=(const eT val) - { - arma_debug_sigprint(); - - Mat& t_m = const_cast< Mat& >(m); - - const uword t_n_elem = n_elem; - const uword t_row_offset = row_offset; - const uword t_col_offset = col_offset; - - for(uword ii=0; ii < t_n_elem; ++ii) - { - t_m.at( ii + t_row_offset, ii + t_col_offset) -= val; - } - } - - - -template -inline -void -diagview::operator*=(const eT val) - { - arma_debug_sigprint(); - - Mat& t_m = const_cast< Mat& >(m); - - const uword t_n_elem = n_elem; - const uword t_row_offset = row_offset; - const uword t_col_offset = col_offset; - - for(uword ii=0; ii < t_n_elem; ++ii) - { - t_m.at( ii + t_row_offset, ii + t_col_offset) *= val; - } - } - - - -template -inline -void -diagview::operator/=(const eT val) - { - arma_debug_sigprint(); - - Mat& t_m = const_cast< Mat& >(m); - - const uword t_n_elem = n_elem; - const uword t_row_offset = row_offset; - const uword t_col_offset = col_offset; - - for(uword ii=0; ii < t_n_elem; ++ii) - { - t_m.at( ii + t_row_offset, ii + t_col_offset) /= val; - } - } - - - -//! set a diagonal of our matrix using data from a foreign object -template -template -inline -void -diagview::operator= (const Base& o) - { - arma_debug_sigprint(); - - diagview& d = *this; - - Mat& d_m = const_cast< Mat& >(d.m); - - const uword d_n_elem = d.n_elem; - const uword d_row_offset = d.row_offset; - const uword d_col_offset = d.col_offset; - - const Proxy P( o.get_ref() ); - - arma_conform_check - ( - ( (d_n_elem != P.get_n_elem()) || ((P.get_n_rows() != 1) && (P.get_n_cols() != 1)) ), - "diagview: given object has incompatible size" - ); - - const bool is_alias = P.is_alias(d_m); - - if(is_alias) { arma_debug_print("aliasing detected"); } - - if( (is_Mat::stored_type>::value) || (Proxy::use_at) || (is_alias) ) - { - const unwrap_check::stored_type> tmp(P.Q, is_alias); - const Mat& x = tmp.M; - - const eT* x_mem = x.memptr(); - - uword ii,jj; - for(ii=0, jj=1; jj < d_n_elem; ii+=2, jj+=2) - { - const eT tmp_i = x_mem[ii]; - const eT tmp_j = x_mem[jj]; - - d_m.at( ii + d_row_offset, ii + d_col_offset) = tmp_i; - d_m.at( jj + d_row_offset, jj + d_col_offset) = tmp_j; - } - - if(ii < d_n_elem) - { - d_m.at( ii + d_row_offset, ii + d_col_offset) = x_mem[ii]; - } - } - else - { - typename Proxy::ea_type Pea = P.get_ea(); - - uword ii,jj; - for(ii=0, jj=1; jj < d_n_elem; ii+=2, jj+=2) - { - const eT tmp_i = Pea[ii]; - const eT tmp_j = Pea[jj]; - - d_m.at( ii + d_row_offset, ii + d_col_offset) = tmp_i; - d_m.at( jj + d_row_offset, jj + d_col_offset) = tmp_j; - } - - if(ii < d_n_elem) - { - d_m.at( ii + d_row_offset, ii + d_col_offset) = Pea[ii]; - } - } - } - - - -template -template -inline -void -diagview::operator+=(const Base& o) - { - arma_debug_sigprint(); - - diagview& d = *this; - - Mat& d_m = const_cast< Mat& >(d.m); - - const uword d_n_elem = d.n_elem; - const uword d_row_offset = d.row_offset; - const uword d_col_offset = d.col_offset; - - const Proxy P( o.get_ref() ); - - arma_conform_check - ( - ( (d_n_elem != P.get_n_elem()) || ((P.get_n_rows() != 1) && (P.get_n_cols() != 1)) ), - "diagview: given object has incompatible size" - ); - - const bool is_alias = P.is_alias(d_m); - - if(is_alias) { arma_debug_print("aliasing detected"); } - - if( (is_Mat::stored_type>::value) || (Proxy::use_at) || (is_alias) ) - { - const unwrap_check::stored_type> tmp(P.Q, is_alias); - const Mat& x = tmp.M; - - const eT* x_mem = x.memptr(); - - uword ii,jj; - for(ii=0, jj=1; jj < d_n_elem; ii+=2, jj+=2) - { - const eT tmp_i = x_mem[ii]; - const eT tmp_j = x_mem[jj]; - - d_m.at( ii + d_row_offset, ii + d_col_offset) += tmp_i; - d_m.at( jj + d_row_offset, jj + d_col_offset) += tmp_j; - } - - if(ii < d_n_elem) - { - d_m.at( ii + d_row_offset, ii + d_col_offset) += x_mem[ii]; - } - } - else - { - typename Proxy::ea_type Pea = P.get_ea(); - - uword ii,jj; - for(ii=0, jj=1; jj < d_n_elem; ii+=2, jj+=2) - { - const eT tmp_i = Pea[ii]; - const eT tmp_j = Pea[jj]; - - d_m.at( ii + d_row_offset, ii + d_col_offset) += tmp_i; - d_m.at( jj + d_row_offset, jj + d_col_offset) += tmp_j; - } - - if(ii < d_n_elem) - { - d_m.at( ii + d_row_offset, ii + d_col_offset) += Pea[ii]; - } - } - } - - - -template -template -inline -void -diagview::operator-=(const Base& o) - { - arma_debug_sigprint(); - - diagview& d = *this; - - Mat& d_m = const_cast< Mat& >(d.m); - - const uword d_n_elem = d.n_elem; - const uword d_row_offset = d.row_offset; - const uword d_col_offset = d.col_offset; - - const Proxy P( o.get_ref() ); - - arma_conform_check - ( - ( (d_n_elem != P.get_n_elem()) || ((P.get_n_rows() != 1) && (P.get_n_cols() != 1)) ), - "diagview: given object has incompatible size" - ); - - const bool is_alias = P.is_alias(d_m); - - if(is_alias) { arma_debug_print("aliasing detected"); } - - if( (is_Mat::stored_type>::value) || (Proxy::use_at) || (is_alias) ) - { - const unwrap_check::stored_type> tmp(P.Q, is_alias); - const Mat& x = tmp.M; - - const eT* x_mem = x.memptr(); - - uword ii,jj; - for(ii=0, jj=1; jj < d_n_elem; ii+=2, jj+=2) - { - const eT tmp_i = x_mem[ii]; - const eT tmp_j = x_mem[jj]; - - d_m.at( ii + d_row_offset, ii + d_col_offset) -= tmp_i; - d_m.at( jj + d_row_offset, jj + d_col_offset) -= tmp_j; - } - - if(ii < d_n_elem) - { - d_m.at( ii + d_row_offset, ii + d_col_offset) -= x_mem[ii]; - } - } - else - { - typename Proxy::ea_type Pea = P.get_ea(); - - uword ii,jj; - for(ii=0, jj=1; jj < d_n_elem; ii+=2, jj+=2) - { - const eT tmp_i = Pea[ii]; - const eT tmp_j = Pea[jj]; - - d_m.at( ii + d_row_offset, ii + d_col_offset) -= tmp_i; - d_m.at( jj + d_row_offset, jj + d_col_offset) -= tmp_j; - } - - if(ii < d_n_elem) - { - d_m.at( ii + d_row_offset, ii + d_col_offset) -= Pea[ii]; - } - } - } - - - -template -template -inline -void -diagview::operator%=(const Base& o) - { - arma_debug_sigprint(); - - diagview& d = *this; - - Mat& d_m = const_cast< Mat& >(d.m); - - const uword d_n_elem = d.n_elem; - const uword d_row_offset = d.row_offset; - const uword d_col_offset = d.col_offset; - - const Proxy P( o.get_ref() ); - - arma_conform_check - ( - ( (d_n_elem != P.get_n_elem()) || ((P.get_n_rows() != 1) && (P.get_n_cols() != 1)) ), - "diagview: given object has incompatible size" - ); - - const bool is_alias = P.is_alias(d_m); - - if(is_alias) { arma_debug_print("aliasing detected"); } - - if( (is_Mat::stored_type>::value) || (Proxy::use_at) || (is_alias) ) - { - const unwrap_check::stored_type> tmp(P.Q, is_alias); - const Mat& x = tmp.M; - - const eT* x_mem = x.memptr(); - - uword ii,jj; - for(ii=0, jj=1; jj < d_n_elem; ii+=2, jj+=2) - { - const eT tmp_i = x_mem[ii]; - const eT tmp_j = x_mem[jj]; - - d_m.at( ii + d_row_offset, ii + d_col_offset) *= tmp_i; - d_m.at( jj + d_row_offset, jj + d_col_offset) *= tmp_j; - } - - if(ii < d_n_elem) - { - d_m.at( ii + d_row_offset, ii + d_col_offset) *= x_mem[ii]; - } - } - else - { - typename Proxy::ea_type Pea = P.get_ea(); - - uword ii,jj; - for(ii=0, jj=1; jj < d_n_elem; ii+=2, jj+=2) - { - const eT tmp_i = Pea[ii]; - const eT tmp_j = Pea[jj]; - - d_m.at( ii + d_row_offset, ii + d_col_offset) *= tmp_i; - d_m.at( jj + d_row_offset, jj + d_col_offset) *= tmp_j; - } - - if(ii < d_n_elem) - { - d_m.at( ii + d_row_offset, ii + d_col_offset) *= Pea[ii]; - } - } - } - - - -template -template -inline -void -diagview::operator/=(const Base& o) - { - arma_debug_sigprint(); - - diagview& d = *this; - - Mat& d_m = const_cast< Mat& >(d.m); - - const uword d_n_elem = d.n_elem; - const uword d_row_offset = d.row_offset; - const uword d_col_offset = d.col_offset; - - const Proxy P( o.get_ref() ); - - arma_conform_check - ( - ( (d_n_elem != P.get_n_elem()) || ((P.get_n_rows() != 1) && (P.get_n_cols() != 1)) ), - "diagview: given object has incompatible size" - ); - - const bool is_alias = P.is_alias(d_m); - - if(is_alias) { arma_debug_print("aliasing detected"); } - - if( (is_Mat::stored_type>::value) || (Proxy::use_at) || (is_alias) ) - { - const unwrap_check::stored_type> tmp(P.Q, is_alias); - const Mat& x = tmp.M; - - const eT* x_mem = x.memptr(); - - uword ii,jj; - for(ii=0, jj=1; jj < d_n_elem; ii+=2, jj+=2) - { - const eT tmp_i = x_mem[ii]; - const eT tmp_j = x_mem[jj]; - - d_m.at( ii + d_row_offset, ii + d_col_offset) /= tmp_i; - d_m.at( jj + d_row_offset, jj + d_col_offset) /= tmp_j; - } - - if(ii < d_n_elem) - { - d_m.at( ii + d_row_offset, ii + d_col_offset) /= x_mem[ii]; - } - } - else - { - typename Proxy::ea_type Pea = P.get_ea(); - - uword ii,jj; - for(ii=0, jj=1; jj < d_n_elem; ii+=2, jj+=2) - { - const eT tmp_i = Pea[ii]; - const eT tmp_j = Pea[jj]; - - d_m.at( ii + d_row_offset, ii + d_col_offset) /= tmp_i; - d_m.at( jj + d_row_offset, jj + d_col_offset) /= tmp_j; - } - - if(ii < d_n_elem) - { - d_m.at( ii + d_row_offset, ii + d_col_offset) /= Pea[ii]; - } - } - } - - - -//! extract a diagonal and store it as a column vector -template -inline -void -diagview::extract(Mat& out, const diagview& in) - { - arma_debug_sigprint(); - - // NOTE: we're assuming that the matrix has already been set to the correct size and there is no aliasing; - // size setting and alias checking is done by either the Mat contructor or operator=() - - const Mat& in_m = in.m; - - const uword in_n_elem = in.n_elem; - const uword in_row_offset = in.row_offset; - const uword in_col_offset = in.col_offset; - - eT* out_mem = out.memptr(); - - uword i,j; - for(i=0, j=1; j < in_n_elem; i+=2, j+=2) - { - const eT tmp_i = in_m.at( i + in_row_offset, i + in_col_offset ); - const eT tmp_j = in_m.at( j + in_row_offset, j + in_col_offset ); - - out_mem[i] = tmp_i; - out_mem[j] = tmp_j; - } - - if(i < in_n_elem) - { - out_mem[i] = in_m.at( i + in_row_offset, i + in_col_offset ); - } - } - - - -//! X += Y.diag() -template -inline -void -diagview::plus_inplace(Mat& out, const diagview& in) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, in.n_rows, in.n_cols, "addition"); - - const Mat& in_m = in.m; - - const uword in_n_elem = in.n_elem; - const uword in_row_offset = in.row_offset; - const uword in_col_offset = in.col_offset; - - eT* out_mem = out.memptr(); - - uword i,j; - for(i=0, j=1; j < in_n_elem; i+=2, j+=2) - { - const eT tmp_i = in_m.at( i + in_row_offset, i + in_col_offset ); - const eT tmp_j = in_m.at( j + in_row_offset, j + in_col_offset ); - - out_mem[i] += tmp_i; - out_mem[j] += tmp_j; - } - - if(i < in_n_elem) - { - out_mem[i] += in_m.at( i + in_row_offset, i + in_col_offset ); - } - } - - - -//! X -= Y.diag() -template -inline -void -diagview::minus_inplace(Mat& out, const diagview& in) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, in.n_rows, in.n_cols, "subtraction"); - - const Mat& in_m = in.m; - - const uword in_n_elem = in.n_elem; - const uword in_row_offset = in.row_offset; - const uword in_col_offset = in.col_offset; - - eT* out_mem = out.memptr(); - - uword i,j; - for(i=0, j=1; j < in_n_elem; i+=2, j+=2) - { - const eT tmp_i = in_m.at( i + in_row_offset, i + in_col_offset ); - const eT tmp_j = in_m.at( j + in_row_offset, j + in_col_offset ); - - out_mem[i] -= tmp_i; - out_mem[j] -= tmp_j; - } - - if(i < in_n_elem) - { - out_mem[i] -= in_m.at( i + in_row_offset, i + in_col_offset ); - } - } - - - -//! X %= Y.diag() -template -inline -void -diagview::schur_inplace(Mat& out, const diagview& in) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, in.n_rows, in.n_cols, "element-wise multiplication"); - - const Mat& in_m = in.m; - - const uword in_n_elem = in.n_elem; - const uword in_row_offset = in.row_offset; - const uword in_col_offset = in.col_offset; - - eT* out_mem = out.memptr(); - - uword i,j; - for(i=0, j=1; j < in_n_elem; i+=2, j+=2) - { - const eT tmp_i = in_m.at( i + in_row_offset, i + in_col_offset ); - const eT tmp_j = in_m.at( j + in_row_offset, j + in_col_offset ); - - out_mem[i] *= tmp_i; - out_mem[j] *= tmp_j; - } - - if(i < in_n_elem) - { - out_mem[i] *= in_m.at( i + in_row_offset, i + in_col_offset ); - } - } - - - -//! X /= Y.diag() -template -inline -void -diagview::div_inplace(Mat& out, const diagview& in) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, in.n_rows, in.n_cols, "element-wise division"); - - const Mat& in_m = in.m; - - const uword in_n_elem = in.n_elem; - const uword in_row_offset = in.row_offset; - const uword in_col_offset = in.col_offset; - - eT* out_mem = out.memptr(); - - uword i,j; - for(i=0, j=1; j < in_n_elem; i+=2, j+=2) - { - const eT tmp_i = in_m.at( i + in_row_offset, i + in_col_offset ); - const eT tmp_j = in_m.at( j + in_row_offset, j + in_col_offset ); - - out_mem[i] /= tmp_i; - out_mem[j] /= tmp_j; - } - - if(i < in_n_elem) - { - out_mem[i] /= in_m.at( i + in_row_offset, i + in_col_offset ); - } - } - - - -template -arma_inline -eT -diagview::at_alt(const uword ii) const - { - return m.at(ii+row_offset, ii+col_offset); - } - - - -template -arma_inline -eT& -diagview::operator[](const uword ii) - { - return (const_cast< Mat& >(m)).at(ii+row_offset, ii+col_offset); - } - - - -template -arma_inline -eT -diagview::operator[](const uword ii) const - { - return m.at(ii+row_offset, ii+col_offset); - } - - - -template -arma_inline -eT& -diagview::at(const uword ii) - { - return (const_cast< Mat& >(m)).at(ii+row_offset, ii+col_offset); - } - - - -template -arma_inline -eT -diagview::at(const uword ii) const - { - return m.at(ii+row_offset, ii+col_offset); - } - - - -template -arma_inline -eT& -diagview::operator()(const uword ii) - { - arma_conform_check_bounds( (ii >= n_elem), "diagview::operator(): out of bounds" ); - - return (const_cast< Mat& >(m)).at(ii+row_offset, ii+col_offset); - } - - - -template -arma_inline -eT -diagview::operator()(const uword ii) const - { - arma_conform_check_bounds( (ii >= n_elem), "diagview::operator(): out of bounds" ); - - return m.at(ii+row_offset, ii+col_offset); - } - - - -template -arma_inline -eT& -diagview::at(const uword row, const uword) - { - return (const_cast< Mat& >(m)).at(row+row_offset, row+col_offset); - } - - - -template -arma_inline -eT -diagview::at(const uword row, const uword) const - { - return m.at(row+row_offset, row+col_offset); - } - - - -template -arma_inline -eT& -diagview::operator()(const uword row, const uword col) - { - arma_conform_check_bounds( ((row >= n_elem) || (col > 0)), "diagview::operator(): out of bounds" ); - - return (const_cast< Mat& >(m)).at(row+row_offset, row+col_offset); - } - - - -template -arma_inline -eT -diagview::operator()(const uword row, const uword col) const - { - arma_conform_check_bounds( ((row >= n_elem) || (col > 0)), "diagview::operator(): out of bounds" ); - - return m.at(row+row_offset, row+col_offset); - } - - - -template -inline -void -diagview::replace(const eT old_val, const eT new_val) - { - arma_debug_sigprint(); - - Mat& x = const_cast< Mat& >(m); - - const uword local_n_elem = n_elem; - - if(arma_isnan(old_val)) - { - for(uword ii=0; ii < local_n_elem; ++ii) - { - eT& val = x.at(ii+row_offset, ii+col_offset); - - val = (arma_isnan(val)) ? new_val : val; - } - } - else - { - for(uword ii=0; ii < local_n_elem; ++ii) - { - eT& val = x.at(ii+row_offset, ii+col_offset); - - val = (val == old_val) ? new_val : val; - } - } - } - - - -template -inline -void -diagview::clean(const typename get_pod_type::result threshold) - { - arma_debug_sigprint(); - - Mat tmp(*this); - - tmp.clean(threshold); - - (*this).operator=(tmp); - } - - - -template -inline -void -diagview::clamp(const eT min_val, const eT max_val) - { - arma_debug_sigprint(); - - Mat tmp(*this); - - tmp.clamp(min_val, max_val); - - (*this).operator=(tmp); - } - - - -template -inline -void -diagview::fill(const eT val) - { - arma_debug_sigprint(); - - Mat& x = const_cast< Mat& >(m); - - const uword local_n_elem = n_elem; - - for(uword ii=0; ii < local_n_elem; ++ii) - { - x.at(ii+row_offset, ii+col_offset) = val; - } - } - - - -template -inline -void -diagview::zeros() - { - arma_debug_sigprint(); - - (*this).fill(eT(0)); - } - - - -template -inline -void -diagview::ones() - { - arma_debug_sigprint(); - - (*this).fill(eT(1)); - } - - - -template -inline -void -diagview::randu() - { - arma_debug_sigprint(); - - Mat& x = const_cast< Mat& >(m); - - const uword local_n_elem = n_elem; - - for(uword ii=0; ii < local_n_elem; ++ii) - { - x.at(ii+row_offset, ii+col_offset) = eT(arma_rng::randu()); - } - } - - - -template -inline -void -diagview::randn() - { - arma_debug_sigprint(); - - Mat& x = const_cast< Mat& >(m); - - const uword local_n_elem = n_elem; - - for(uword ii=0; ii < local_n_elem; ++ii) - { - x.at(ii+row_offset, ii+col_offset) = eT(arma_rng::randn()); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/diskio_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/diskio_bones.hpp deleted file mode 100644 index 03e1ac5f9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/diskio_bones.hpp +++ /dev/null @@ -1,229 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup diskio -//! @{ - - -//! class for saving and loading matrices and fields - INTERNAL USE ONLY! -class diskio - { - public: - - arma_deprecated inline static file_type guess_file_type(std::istream& f); - - - private: - - template friend class Mat; - template friend class Cube; - template friend class SpMat; - template friend class field; - - friend class Mat_aux; - friend class Cube_aux; - friend class SpMat_aux; - friend class field_aux; - - template arma_cold inline static std::string gen_txt_header(const Mat&); - template arma_cold inline static std::string gen_bin_header(const Mat&); - - template arma_cold inline static std::string gen_bin_header(const SpMat&); - - template arma_cold inline static std::string gen_txt_header(const Cube&); - template arma_cold inline static std::string gen_bin_header(const Cube&); - - arma_cold inline static file_type guess_file_type_internal(std::istream& f); - - arma_cold inline static std::string gen_tmp_name(const std::string& x); - - arma_cold inline static bool safe_rename(const std::string& old_name, const std::string& new_name); - - arma_cold inline static bool is_readable(const std::string& name); - - arma_cold inline static void sanitise_token(std::string& token); - - template inline static bool convert_token(eT& val, const std::string& token); - template inline static bool convert_token(std::complex& val, const std::string& token); - - template inline static bool convert_token_strict(eT& val, const std::string& token); - - template inline static std::streamsize prepare_stream(std::ostream& f); - - - // - // matrix saving - - template inline static bool save_raw_ascii (const Mat& x, const std::string& final_name); - template inline static bool save_raw_binary (const Mat& x, const std::string& final_name); - template inline static bool save_arma_ascii (const Mat& x, const std::string& final_name); - template inline static bool save_csv_ascii (const Mat& x, const std::string& final_name, const field& header, const bool with_header, const char separator); - template inline static bool save_coord_ascii(const Mat& x, const std::string& final_name); - template inline static bool save_arma_binary(const Mat& x, const std::string& final_name); - template inline static bool save_pgm_binary (const Mat& x, const std::string& final_name); - template inline static bool save_pgm_binary (const Mat< std::complex >& x, const std::string& final_name); - template inline static bool save_hdf5_binary(const Mat& x, const hdf5_name& spec, std::string& err_msg); - - template inline static bool save_raw_ascii (const Mat& x, std::ostream& f); - template inline static bool save_raw_binary (const Mat& x, std::ostream& f); - template inline static bool save_arma_ascii (const Mat& x, std::ostream& f); - template inline static bool save_csv_ascii (const Mat& x, std::ostream& f, const char separator); - template inline static bool save_csv_ascii (const Mat< std::complex >& x, std::ostream& f, const char separator); - template inline static bool save_coord_ascii(const Mat& x, std::ostream& f); - template inline static bool save_coord_ascii(const Mat< std::complex >& x, std::ostream& f); - template inline static bool save_arma_binary(const Mat& x, std::ostream& f); - template inline static bool save_pgm_binary (const Mat& x, std::ostream& f); - template inline static bool save_pgm_binary (const Mat< std::complex >& x, std::ostream& f); - - - // - // matrix loading - - template inline static bool load_raw_ascii (Mat& x, const std::string& name, std::string& err_msg); - template inline static bool load_raw_binary (Mat& x, const std::string& name, std::string& err_msg); - template inline static bool load_arma_ascii (Mat& x, const std::string& name, std::string& err_msg); - template inline static bool load_csv_ascii (Mat& x, const std::string& name, std::string& err_msg, field& header, const bool with_header, const char separator, const bool strict); - template inline static bool load_coord_ascii(Mat& x, const std::string& name, std::string& err_msg); - template inline static bool load_arma_binary(Mat& x, const std::string& name, std::string& err_msg); - template inline static bool load_pgm_binary (Mat& x, const std::string& name, std::string& err_msg); - template inline static bool load_pgm_binary (Mat< std::complex >& x, const std::string& name, std::string& err_msg); - template inline static bool load_hdf5_binary(Mat& x, const hdf5_name& spec, std::string& err_msg); - template inline static bool load_auto_detect(Mat& x, const std::string& name, std::string& err_msg); - - template inline static bool load_raw_ascii (Mat& x, std::istream& f, std::string& err_msg); - template inline static bool load_raw_binary (Mat& x, std::istream& f, std::string& err_msg); - template inline static bool load_arma_ascii (Mat& x, std::istream& f, std::string& err_msg); - template inline static bool load_csv_ascii (Mat& x, std::istream& f, std::string& err_msg, const char separator, const bool strict); - template inline static bool load_csv_ascii (Mat< std::complex >& x, std::istream& f, std::string& err_msg, const char separator, const bool strict); - template inline static bool load_coord_ascii(Mat& x, std::istream& f, std::string& err_msg); - template inline static bool load_coord_ascii(Mat< std::complex >& x, std::istream& f, std::string& err_msg); - template inline static bool load_arma_binary(Mat& x, std::istream& f, std::string& err_msg); - template inline static bool load_pgm_binary (Mat& x, std::istream& is, std::string& err_msg); - template inline static bool load_pgm_binary (Mat< std::complex >& x, std::istream& is, std::string& err_msg); - template inline static bool load_auto_detect(Mat& x, std::istream& f, std::string& err_msg); - - inline static void pnm_skip_comments(std::istream& f); - - - // - // sparse matrix saving - - template inline static bool save_csv_ascii (const SpMat& x, const std::string& final_name, const field& header, const bool with_header, const char separator); - template inline static bool save_coord_ascii(const SpMat& x, const std::string& final_name); - template inline static bool save_arma_binary(const SpMat& x, const std::string& final_name); - - template inline static bool save_csv_ascii (const SpMat& x, std::ostream& f, const char separator); - template inline static bool save_csv_ascii (const SpMat< std::complex >& x, std::ostream& f, const char separator); - template inline static bool save_coord_ascii(const SpMat& x, std::ostream& f); - template inline static bool save_coord_ascii(const SpMat< std::complex >& x, std::ostream& f); - template inline static bool save_arma_binary(const SpMat& x, std::ostream& f); - - - // - // sparse matrix loading - - template inline static bool load_csv_ascii (SpMat& x, const std::string& name, std::string& err_msg, field& header, const bool with_header, const char separator); - template inline static bool load_coord_ascii(SpMat& x, const std::string& name, std::string& err_msg); - template inline static bool load_arma_binary(SpMat& x, const std::string& name, std::string& err_msg); - - template inline static bool load_csv_ascii (SpMat& x, std::istream& f, std::string& err_msg, const char separator); - template inline static bool load_csv_ascii (SpMat< std::complex >& x, std::istream& f, std::string& err_msg, const char separator); - template inline static bool load_coord_ascii(SpMat& x, std::istream& f, std::string& err_msg); - template inline static bool load_coord_ascii(SpMat< std::complex >& x, std::istream& f, std::string& err_msg); - template inline static bool load_arma_binary(SpMat& x, std::istream& f, std::string& err_msg); - - - - // - // cube saving - - template inline static bool save_raw_ascii (const Cube& x, const std::string& name); - template inline static bool save_raw_binary (const Cube& x, const std::string& name); - template inline static bool save_arma_ascii (const Cube& x, const std::string& name); - template inline static bool save_arma_binary(const Cube& x, const std::string& name); - template inline static bool save_hdf5_binary(const Cube& x, const hdf5_name& spec, std::string& err_msg); - - template inline static bool save_raw_ascii (const Cube& x, std::ostream& f); - template inline static bool save_raw_binary (const Cube& x, std::ostream& f); - template inline static bool save_arma_ascii (const Cube& x, std::ostream& f); - template inline static bool save_arma_binary(const Cube& x, std::ostream& f); - - - // - // cube loading - - template inline static bool load_raw_ascii (Cube& x, const std::string& name, std::string& err_msg); - template inline static bool load_raw_binary (Cube& x, const std::string& name, std::string& err_msg); - template inline static bool load_arma_ascii (Cube& x, const std::string& name, std::string& err_msg); - template inline static bool load_arma_binary(Cube& x, const std::string& name, std::string& err_msg); - template inline static bool load_hdf5_binary(Cube& x, const hdf5_name& spec, std::string& err_msg); - template inline static bool load_auto_detect(Cube& x, const std::string& name, std::string& err_msg); - - template inline static bool load_raw_ascii (Cube& x, std::istream& f, std::string& err_msg); - template inline static bool load_raw_binary (Cube& x, std::istream& f, std::string& err_msg); - template inline static bool load_arma_ascii (Cube& x, std::istream& f, std::string& err_msg); - template inline static bool load_arma_binary(Cube& x, std::istream& f, std::string& err_msg); - template inline static bool load_auto_detect(Cube& x, std::istream& f, std::string& err_msg); - - - // - // field saving and loading - - template inline static bool save_arma_binary(const field& x, const std::string& name); - template inline static bool save_arma_binary(const field& x, std::ostream& f); - - template inline static bool load_arma_binary( field& x, const std::string& name, std::string& err_msg); - template inline static bool load_arma_binary( field& x, std::istream& f, std::string& err_msg); - - template inline static bool load_auto_detect( field& x, const std::string& name, std::string& err_msg); - template inline static bool load_auto_detect( field& x, std::istream& f, std::string& err_msg); - - inline static bool save_std_string(const field& x, const std::string& name); - inline static bool save_std_string(const field& x, std::ostream& f); - - inline static bool load_std_string( field& x, const std::string& name, std::string& err_msg); - inline static bool load_std_string( field& x, std::istream& f, std::string& err_msg); - - - - // - // handling of PPM images by cubes - - template inline static bool save_ppm_binary(const Cube& x, const std::string& final_name); - template inline static bool save_ppm_binary(const Cube& x, std::ostream& f); - - template inline static bool load_ppm_binary( Cube& x, const std::string& final_name, std::string& err_msg); - template inline static bool load_ppm_binary( Cube& x, std::istream& f, std::string& err_msg); - - - // - // handling of PPM images by fields - - template inline static bool save_ppm_binary(const field& x, const std::string& final_name); - template inline static bool save_ppm_binary(const field& x, std::ostream& f); - - template inline static bool load_ppm_binary( field& x, const std::string& final_name, std::string& err_msg); - template inline static bool load_ppm_binary( field& x, std::istream& f, std::string& err_msg); - - - - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/diskio_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/diskio_meat.hpp deleted file mode 100644 index 2c6859fbc..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/diskio_meat.hpp +++ /dev/null @@ -1,5430 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup diskio -//! @{ - - -//! Generate the first line of the header used for saving matrices in text format. -//! Format: "ARMA_MAT_TXT_ABXYZ". -//! A is one of: I (for integral types) or F (for floating point types). -//! B is one of: U (for unsigned types), S (for signed types), N (for not applicable) or C (for complex types). -//! XYZ specifies the width of each element in terms of bytes, eg. "008" indicates eight bytes. -template -inline -std::string -diskio::gen_txt_header(const Mat&) - { - arma_type_check(( is_supported_elem_type::value == false )); - - const char* ARMA_MAT_TXT_IU001 = "ARMA_MAT_TXT_IU001"; - const char* ARMA_MAT_TXT_IS001 = "ARMA_MAT_TXT_IS001"; - const char* ARMA_MAT_TXT_IU002 = "ARMA_MAT_TXT_IU002"; - const char* ARMA_MAT_TXT_IS002 = "ARMA_MAT_TXT_IS002"; - const char* ARMA_MAT_TXT_IU004 = "ARMA_MAT_TXT_IU004"; - const char* ARMA_MAT_TXT_IS004 = "ARMA_MAT_TXT_IS004"; - const char* ARMA_MAT_TXT_IU008 = "ARMA_MAT_TXT_IU008"; - const char* ARMA_MAT_TXT_IS008 = "ARMA_MAT_TXT_IS008"; - const char* ARMA_MAT_TXT_FN004 = "ARMA_MAT_TXT_FN004"; - const char* ARMA_MAT_TXT_FN008 = "ARMA_MAT_TXT_FN008"; - const char* ARMA_MAT_TXT_FC008 = "ARMA_MAT_TXT_FC008"; - const char* ARMA_MAT_TXT_FC016 = "ARMA_MAT_TXT_FC016"; - - char* header = nullptr; - - if( is_u8::value) { header = const_cast(ARMA_MAT_TXT_IU001); } - else if( is_s8::value) { header = const_cast(ARMA_MAT_TXT_IS001); } - else if( is_u16::value) { header = const_cast(ARMA_MAT_TXT_IU002); } - else if( is_s16::value) { header = const_cast(ARMA_MAT_TXT_IS002); } - else if( is_u32::value) { header = const_cast(ARMA_MAT_TXT_IU004); } - else if( is_s32::value) { header = const_cast(ARMA_MAT_TXT_IS004); } - else if( is_u64::value) { header = const_cast(ARMA_MAT_TXT_IU008); } - else if( is_s64::value) { header = const_cast(ARMA_MAT_TXT_IS008); } - else if(is_ulng_t_32::value) { header = const_cast(ARMA_MAT_TXT_IU004); } - else if(is_slng_t_32::value) { header = const_cast(ARMA_MAT_TXT_IS004); } - else if(is_ulng_t_64::value) { header = const_cast(ARMA_MAT_TXT_IU008); } - else if(is_slng_t_64::value) { header = const_cast(ARMA_MAT_TXT_IS008); } - else if( is_float::value) { header = const_cast(ARMA_MAT_TXT_FN004); } - else if( is_double::value) { header = const_cast(ARMA_MAT_TXT_FN008); } - else if( is_cx_float::value) { header = const_cast(ARMA_MAT_TXT_FC008); } - else if(is_cx_double::value) { header = const_cast(ARMA_MAT_TXT_FC016); } - - return std::string(header); - } - - - -//! Generate the first line of the header used for saving matrices in binary format. -//! Format: "ARMA_MAT_BIN_ABXYZ". -//! A is one of: I (for integral types) or F (for floating point types). -//! B is one of: U (for unsigned types), S (for signed types), N (for not applicable) or C (for complex types). -//! XYZ specifies the width of each element in terms of bytes, eg. "008" indicates eight bytes. -template -inline -std::string -diskio::gen_bin_header(const Mat&) - { - arma_type_check(( is_supported_elem_type::value == false )); - - const char* ARMA_MAT_BIN_IU001 = "ARMA_MAT_BIN_IU001"; - const char* ARMA_MAT_BIN_IS001 = "ARMA_MAT_BIN_IS001"; - const char* ARMA_MAT_BIN_IU002 = "ARMA_MAT_BIN_IU002"; - const char* ARMA_MAT_BIN_IS002 = "ARMA_MAT_BIN_IS002"; - const char* ARMA_MAT_BIN_IU004 = "ARMA_MAT_BIN_IU004"; - const char* ARMA_MAT_BIN_IS004 = "ARMA_MAT_BIN_IS004"; - const char* ARMA_MAT_BIN_IU008 = "ARMA_MAT_BIN_IU008"; - const char* ARMA_MAT_BIN_IS008 = "ARMA_MAT_BIN_IS008"; - const char* ARMA_MAT_BIN_FN004 = "ARMA_MAT_BIN_FN004"; - const char* ARMA_MAT_BIN_FN008 = "ARMA_MAT_BIN_FN008"; - const char* ARMA_MAT_BIN_FC008 = "ARMA_MAT_BIN_FC008"; - const char* ARMA_MAT_BIN_FC016 = "ARMA_MAT_BIN_FC016"; - - char* header = nullptr; - - if( is_u8::value) { header = const_cast(ARMA_MAT_BIN_IU001); } - else if( is_s8::value) { header = const_cast(ARMA_MAT_BIN_IS001); } - else if( is_u16::value) { header = const_cast(ARMA_MAT_BIN_IU002); } - else if( is_s16::value) { header = const_cast(ARMA_MAT_BIN_IS002); } - else if( is_u32::value) { header = const_cast(ARMA_MAT_BIN_IU004); } - else if( is_s32::value) { header = const_cast(ARMA_MAT_BIN_IS004); } - else if( is_u64::value) { header = const_cast(ARMA_MAT_BIN_IU008); } - else if( is_s64::value) { header = const_cast(ARMA_MAT_BIN_IS008); } - else if(is_ulng_t_32::value) { header = const_cast(ARMA_MAT_BIN_IU004); } - else if(is_slng_t_32::value) { header = const_cast(ARMA_MAT_BIN_IS004); } - else if(is_ulng_t_64::value) { header = const_cast(ARMA_MAT_BIN_IU008); } - else if(is_slng_t_64::value) { header = const_cast(ARMA_MAT_BIN_IS008); } - else if( is_float::value) { header = const_cast(ARMA_MAT_BIN_FN004); } - else if( is_double::value) { header = const_cast(ARMA_MAT_BIN_FN008); } - else if( is_cx_float::value) { header = const_cast(ARMA_MAT_BIN_FC008); } - else if(is_cx_double::value) { header = const_cast(ARMA_MAT_BIN_FC016); } - - return std::string(header); - } - - - -//! Generate the first line of the header used for saving matrices in binary format. -//! Format: "ARMA_SPM_BIN_ABXYZ". -//! A is one of: I (for integral types) or F (for floating point types). -//! B is one of: U (for unsigned types), S (for signed types), N (for not applicable) or C (for complex types). -//! XYZ specifies the width of each element in terms of bytes, eg. "008" indicates eight bytes. -template -inline -std::string -diskio::gen_bin_header(const SpMat&) - { - arma_type_check(( is_supported_elem_type::value == false )); - - const char* ARMA_SPM_BIN_IU001 = "ARMA_SPM_BIN_IU001"; - const char* ARMA_SPM_BIN_IS001 = "ARMA_SPM_BIN_IS001"; - const char* ARMA_SPM_BIN_IU002 = "ARMA_SPM_BIN_IU002"; - const char* ARMA_SPM_BIN_IS002 = "ARMA_SPM_BIN_IS002"; - const char* ARMA_SPM_BIN_IU004 = "ARMA_SPM_BIN_IU004"; - const char* ARMA_SPM_BIN_IS004 = "ARMA_SPM_BIN_IS004"; - const char* ARMA_SPM_BIN_IU008 = "ARMA_SPM_BIN_IU008"; - const char* ARMA_SPM_BIN_IS008 = "ARMA_SPM_BIN_IS008"; - const char* ARMA_SPM_BIN_FN004 = "ARMA_SPM_BIN_FN004"; - const char* ARMA_SPM_BIN_FN008 = "ARMA_SPM_BIN_FN008"; - const char* ARMA_SPM_BIN_FC008 = "ARMA_SPM_BIN_FC008"; - const char* ARMA_SPM_BIN_FC016 = "ARMA_SPM_BIN_FC016"; - - char* header = nullptr; - - if( is_u8::value) { header = const_cast(ARMA_SPM_BIN_IU001); } - else if( is_s8::value) { header = const_cast(ARMA_SPM_BIN_IS001); } - else if( is_u16::value) { header = const_cast(ARMA_SPM_BIN_IU002); } - else if( is_s16::value) { header = const_cast(ARMA_SPM_BIN_IS002); } - else if( is_u32::value) { header = const_cast(ARMA_SPM_BIN_IU004); } - else if( is_s32::value) { header = const_cast(ARMA_SPM_BIN_IS004); } - else if( is_u64::value) { header = const_cast(ARMA_SPM_BIN_IU008); } - else if( is_s64::value) { header = const_cast(ARMA_SPM_BIN_IS008); } - else if(is_ulng_t_32::value) { header = const_cast(ARMA_SPM_BIN_IU004); } - else if(is_slng_t_32::value) { header = const_cast(ARMA_SPM_BIN_IS004); } - else if(is_ulng_t_64::value) { header = const_cast(ARMA_SPM_BIN_IU008); } - else if(is_slng_t_64::value) { header = const_cast(ARMA_SPM_BIN_IS008); } - else if( is_float::value) { header = const_cast(ARMA_SPM_BIN_FN004); } - else if( is_double::value) { header = const_cast(ARMA_SPM_BIN_FN008); } - else if( is_cx_float::value) { header = const_cast(ARMA_SPM_BIN_FC008); } - else if(is_cx_double::value) { header = const_cast(ARMA_SPM_BIN_FC016); } - - return std::string(header); - } - - -//! Generate the first line of the header used for saving cubes in text format. -//! Format: "ARMA_CUB_TXT_ABXYZ". -//! A is one of: I (for integral types) or F (for floating point types). -//! B is one of: U (for unsigned types), S (for signed types), N (for not applicable) or C (for complex types). -//! XYZ specifies the width of each element in terms of bytes, eg. "008" indicates eight bytes. -template -inline -std::string -diskio::gen_txt_header(const Cube&) - { - arma_type_check(( is_supported_elem_type::value == false )); - - const char* ARMA_CUB_TXT_IU001 = "ARMA_CUB_TXT_IU001"; - const char* ARMA_CUB_TXT_IS001 = "ARMA_CUB_TXT_IS001"; - const char* ARMA_CUB_TXT_IU002 = "ARMA_CUB_TXT_IU002"; - const char* ARMA_CUB_TXT_IS002 = "ARMA_CUB_TXT_IS002"; - const char* ARMA_CUB_TXT_IU004 = "ARMA_CUB_TXT_IU004"; - const char* ARMA_CUB_TXT_IS004 = "ARMA_CUB_TXT_IS004"; - const char* ARMA_CUB_TXT_IU008 = "ARMA_CUB_TXT_IU008"; - const char* ARMA_CUB_TXT_IS008 = "ARMA_CUB_TXT_IS008"; - const char* ARMA_CUB_TXT_FN004 = "ARMA_CUB_TXT_FN004"; - const char* ARMA_CUB_TXT_FN008 = "ARMA_CUB_TXT_FN008"; - const char* ARMA_CUB_TXT_FC008 = "ARMA_CUB_TXT_FC008"; - const char* ARMA_CUB_TXT_FC016 = "ARMA_CUB_TXT_FC016"; - - char* header = nullptr; - - if( is_u8::value) { header = const_cast(ARMA_CUB_TXT_IU001); } - else if( is_s8::value) { header = const_cast(ARMA_CUB_TXT_IS001); } - else if( is_u16::value) { header = const_cast(ARMA_CUB_TXT_IU002); } - else if( is_s16::value) { header = const_cast(ARMA_CUB_TXT_IS002); } - else if( is_u32::value) { header = const_cast(ARMA_CUB_TXT_IU004); } - else if( is_s32::value) { header = const_cast(ARMA_CUB_TXT_IS004); } - else if( is_u64::value) { header = const_cast(ARMA_CUB_TXT_IU008); } - else if( is_s64::value) { header = const_cast(ARMA_CUB_TXT_IS008); } - else if(is_ulng_t_32::value) { header = const_cast(ARMA_CUB_TXT_IU004); } - else if(is_slng_t_32::value) { header = const_cast(ARMA_CUB_TXT_IS004); } - else if(is_ulng_t_64::value) { header = const_cast(ARMA_CUB_TXT_IU008); } - else if(is_slng_t_64::value) { header = const_cast(ARMA_CUB_TXT_IS008); } - else if( is_float::value) { header = const_cast(ARMA_CUB_TXT_FN004); } - else if( is_double::value) { header = const_cast(ARMA_CUB_TXT_FN008); } - else if( is_cx_float::value) { header = const_cast(ARMA_CUB_TXT_FC008); } - else if(is_cx_double::value) { header = const_cast(ARMA_CUB_TXT_FC016); } - - return std::string(header); - } - - - -//! Generate the first line of the header used for saving cubes in binary format. -//! Format: "ARMA_CUB_BIN_ABXYZ". -//! A is one of: I (for integral types) or F (for floating point types). -//! B is one of: U (for unsigned types), S (for signed types), N (for not applicable) or C (for complex types). -//! XYZ specifies the width of each element in terms of bytes, eg. "008" indicates eight bytes. -template -inline -std::string -diskio::gen_bin_header(const Cube&) - { - arma_type_check(( is_supported_elem_type::value == false )); - - const char* ARMA_CUB_BIN_IU001 = "ARMA_CUB_BIN_IU001"; - const char* ARMA_CUB_BIN_IS001 = "ARMA_CUB_BIN_IS001"; - const char* ARMA_CUB_BIN_IU002 = "ARMA_CUB_BIN_IU002"; - const char* ARMA_CUB_BIN_IS002 = "ARMA_CUB_BIN_IS002"; - const char* ARMA_CUB_BIN_IU004 = "ARMA_CUB_BIN_IU004"; - const char* ARMA_CUB_BIN_IS004 = "ARMA_CUB_BIN_IS004"; - const char* ARMA_CUB_BIN_IU008 = "ARMA_CUB_BIN_IU008"; - const char* ARMA_CUB_BIN_IS008 = "ARMA_CUB_BIN_IS008"; - const char* ARMA_CUB_BIN_FN004 = "ARMA_CUB_BIN_FN004"; - const char* ARMA_CUB_BIN_FN008 = "ARMA_CUB_BIN_FN008"; - const char* ARMA_CUB_BIN_FC008 = "ARMA_CUB_BIN_FC008"; - const char* ARMA_CUB_BIN_FC016 = "ARMA_CUB_BIN_FC016"; - - char* header = nullptr; - - if( is_u8::value) { header = const_cast(ARMA_CUB_BIN_IU001); } - else if( is_s8::value) { header = const_cast(ARMA_CUB_BIN_IS001); } - else if( is_u16::value) { header = const_cast(ARMA_CUB_BIN_IU002); } - else if( is_s16::value) { header = const_cast(ARMA_CUB_BIN_IS002); } - else if( is_u32::value) { header = const_cast(ARMA_CUB_BIN_IU004); } - else if( is_s32::value) { header = const_cast(ARMA_CUB_BIN_IS004); } - else if( is_u64::value) { header = const_cast(ARMA_CUB_BIN_IU008); } - else if( is_s64::value) { header = const_cast(ARMA_CUB_BIN_IS008); } - else if(is_ulng_t_32::value) { header = const_cast(ARMA_CUB_BIN_IU004); } - else if(is_slng_t_32::value) { header = const_cast(ARMA_CUB_BIN_IS004); } - else if(is_ulng_t_64::value) { header = const_cast(ARMA_CUB_BIN_IU008); } - else if(is_slng_t_64::value) { header = const_cast(ARMA_CUB_BIN_IS008); } - else if( is_float::value) { header = const_cast(ARMA_CUB_BIN_FN004); } - else if( is_double::value) { header = const_cast(ARMA_CUB_BIN_FN008); } - else if( is_cx_float::value) { header = const_cast(ARMA_CUB_BIN_FC008); } - else if(is_cx_double::value) { header = const_cast(ARMA_CUB_BIN_FC016); } - - return std::string(header); - } - - - -inline -file_type -diskio::guess_file_type(std::istream& f) - { - arma_debug_sigprint(); - - return diskio::guess_file_type_internal(f); - } - - - -inline -file_type -diskio::guess_file_type_internal(std::istream& f) - { - arma_debug_sigprint(); - - f.clear(); - const std::fstream::pos_type pos1 = f.tellg(); - - f.clear(); - f.seekg(0, ios::end); - - f.clear(); - const std::fstream::pos_type pos2 = f.tellg(); - - const uword N_max = ( (pos1 >= 0) && (pos2 >= 0) && (pos2 > pos1) ) ? uword(pos2 - pos1) : uword(0); - - f.clear(); - f.seekg(pos1); - - if(N_max == 0) { return file_type_unknown; } - - const uword N_use = (std::min)(N_max, uword(4096)); - - podarray data(N_use); - data.zeros(); - - unsigned char* data_mem = data.memptr(); - - f.clear(); - f.read( reinterpret_cast(data_mem), std::streamsize(N_use) ); - - const bool load_okay = f.good(); - - f.clear(); - f.seekg(pos1); - - if(load_okay == false) { return file_type_unknown; } - - bool has_binary = false; - bool has_bracket = false; - bool has_comma = false; - bool has_semicolon = false; - - for(uword i=0; i= 123) ) { has_binary = true; break; } // the range checking can be made more elaborate - - if( (val == '(') || (val == ')') ) { has_bracket = true; } - - if( (val == ';') ) { has_semicolon = true; } - - if( (val == ',') ) { has_comma = true; } - } - - if(has_binary) { return raw_binary; } - - // ssv_ascii has to be before csv_ascii; - // if the data has semicolons, it suggests a CSV file with semicolon as the separating character; - // the semicolon may be used to allow the comma character to represent the decimal seperator (eg. 1,2345 vs 1.2345) - - if(has_semicolon && (has_bracket == false)) { return ssv_ascii; } - - if(has_comma && (has_bracket == false)) { return csv_ascii; } - - return raw_ascii; - } - - - -//! Append a quasi-random string to the given filename. -//! Avoiding use of rand() to preserve its state. -inline -std::string -diskio::gen_tmp_name(const std::string& x) - { - union { uword val; void* ptr; } u; - - u.val = uword(0); - u.ptr = const_cast(&x); - - const u16 a = u16( (u.val >> 8) & 0xFFFF ); - const u16 b = u16( (std::clock()) & 0xFFFF ); - - std::ostringstream ss; - - ss << x << ".tmp_"; - - ss.setf(std::ios_base::hex, std::ios_base::basefield); - - ss.width(4); - ss.fill('0'); - ss << a; - - ss.width(4); - ss.fill('0'); - ss << b; - - return ss.str(); - } - - - -//! Safely rename a file. -//! Before renaming, test if we can write to the final file. -//! This should prevent: -//! (i) overwriting files that are write protected, -//! (ii) overwriting directories. -inline -bool -diskio::safe_rename(const std::string& old_name, const std::string& new_name) - { - const char* new_name_c_str = new_name.c_str(); - - std::fstream f(new_name_c_str, std::fstream::out | std::fstream::app); - f.put(' '); - - if(f.good()) { f.close(); } else { return false; } - - if(std::remove( new_name_c_str) != 0) { return false; } - if(std::rename(old_name.c_str(), new_name_c_str) != 0) { return false; } - - return true; - } - - - -inline -bool -diskio::is_readable(const std::string& name) - { - std::ifstream f; - - f.open(name, std::fstream::binary); - - // std::ifstream destructor will close the file - - return (f.is_open()); - } - - - -inline -void -diskio::sanitise_token(std::string& token) - { - // remove spaces, tabs, carriage returns - - if(token.length() == 0) { return; } - - const char c_front = token.front(); - const char c_back = token.back(); - - if( (c_front == ' ') || (c_front == '\t') || (c_front == '\r') || (c_back == ' ') || (c_back == '\t') || (c_back == '\r') ) - { - token.erase(std::remove_if(token.begin(), token.end(), [](char c) { return ((c == ' ') || (c == '\t') || (c == '\r')); }), token.end()); - } - } - - - -template -inline -bool -diskio::convert_token(eT& val, const std::string& token) - { - const size_t N = size_t(token.length()); - - const char* str = token.c_str(); - - if( (N == 0) || ((N == 1) && (str[0] == '0')) ) { val = eT(0); return true; } - - if( (N == 3) || (N == 4) ) - { - const bool neg = (str[0] == '-'); - const bool pos = (str[0] == '+'); - - const size_t offset = ( (neg || pos) && (N == 4) ) ? 1 : 0; - - const char sig_a = str[offset ]; - const char sig_b = str[offset+1]; - const char sig_c = str[offset+2]; - - if( ((sig_a == 'i') || (sig_a == 'I')) && ((sig_b == 'n') || (sig_b == 'N')) && ((sig_c == 'f') || (sig_c == 'F')) ) - { - val = neg ? cond_rel< is_signed::value >::make_neg(Datum::inf) : Datum::inf; - - return true; - } - else - if( ((sig_a == 'n') || (sig_a == 'N')) && ((sig_b == 'a') || (sig_b == 'A')) && ((sig_c == 'n') || (sig_c == 'N')) ) - { - val = Datum::nan; - - return true; - } - } - - // #if (defined(ARMA_HAVE_CXX17) && (__cpp_lib_to_chars >= 201611L)) - // { - // // std::from_chars() doesn't handle leading whitespace - // // std::from_chars() doesn't handle leading + sign - // // std::from_chars() handles only the decimal point (.) as the decimal seperator - // - // const char str0 = str[0]; - // const bool start_ok = ((str0 != ' ') && (str0 != '\t') && (str0 != '+')); - // - // bool has_comma = false; - // for(uword i=0; i::value) - { - val = eT( std::strtod(str, &endptr) ); - } - else - { - if(is_signed::value) - { - // signed integer - - val = eT( std::strtoll(str, &endptr, 10) ); - } - else - { - // unsigned integer - - if((str[0] == '-') && (N >= 2)) - { - val = eT(0); - - if((str[1] == '-') || (str[1] == '+')) { return false; } - - const char* str_offset1 = &(str[1]); - - std::strtoull(str_offset1, &endptr, 10); - - if(str_offset1 == endptr) { return false; } - - return true; - } - - val = eT( std::strtoull(str, &endptr, 10) ); - } - } - - if(str == endptr) { return false; } - - return true; - } - - - -template -inline -bool -diskio::convert_token(std::complex& val, const std::string& token) - { - const size_t N = size_t(token.length()); - const size_t Nm1 = N-1; - - if(N == 0) { val = std::complex(0); return true; } - - const char* str = token.c_str(); - - // valid complex number formats: - // (real,imag) - // (real) - // () - - if( (token[0] != '(') || (token[Nm1] != ')') ) - { - // no brackets, so treat the token as a non-complex number - - T val_real; - - const bool state = diskio::convert_token(val_real, token); // use the non-complex version of this function - - val = std::complex(val_real); - - return state; - } - - // does the token contain only the () brackets? - if(N <= 2) { val = std::complex(0); return true; } - - size_t comma_loc = 0; - bool comma_found = false; - - for(size_t i=0; i(val_real); - } - else - { - const std::string token_real( &(str[1]), (comma_loc - 1 ) ); - const std::string token_imag( &(str[comma_loc+1]), (Nm1 - 1 - comma_loc) ); - - T val_real; - T val_imag; - - const bool state_real = diskio::convert_token(val_real, token_real); - const bool state_imag = diskio::convert_token(val_imag, token_imag); - - state = (state_real && state_imag); - - val = std::complex(val_real, val_imag); - } - - return state; - } - - - -template -inline -bool -diskio::convert_token_strict(eT& val, const std::string& token) - { - const size_t N = size_t(token.length()); - - const bool status = (N > 0) ? diskio::convert_token(val, token) : false; - - if(status == false) { val = Datum::nan; } - - return status; - } - - - -template -inline -std::streamsize -diskio::prepare_stream(std::ostream& f) - { - std::streamsize cell_width = f.width(); - - if(is_real::value) - { - f.unsetf(ios::fixed); - f.setf(ios::scientific); - f.fill(' '); - - f.precision(16); - cell_width = 24; - - // NOTE: for 'float' the optimum settings are f.precision(8) and cell_width = 15 - // NOTE: however, to avoid introducing errors in case single precision data is loaded as double precision, - // NOTE: the same settings must be used for both 'float' and 'double' - } - else - if(is_cx::value) - { - f.unsetf(ios::fixed); - f.setf(ios::scientific); - - f.precision(16); - } - - return cell_width; - } - - - - -//! Save a matrix as raw text (no header, human readable). -//! Matrices can be loaded in Matlab and Octave, as long as they don't have complex elements. -template -inline -bool -diskio::save_raw_ascii(const Mat& x, const std::string& final_name) - { - arma_debug_sigprint(); - - const std::string tmp_name = diskio::gen_tmp_name(final_name); - - std::ofstream f; - - (arma_config::text_as_binary) ? f.open(tmp_name, std::fstream::binary) : f.open(tmp_name); - - bool save_okay = f.is_open(); - - if(save_okay) - { - save_okay = diskio::save_raw_ascii(x, f); - - f.flush(); - f.close(); - - if(save_okay) { save_okay = diskio::safe_rename(tmp_name, final_name); } - } - - return save_okay; - } - - - -//! Save a matrix as raw text (no header, human readable). -//! Matrices can be loaded in Matlab and Octave, as long as they don't have complex elements. -template -inline -bool -diskio::save_raw_ascii(const Mat& x, std::ostream& f) - { - arma_debug_sigprint(); - - const arma_ostream_state stream_state(f); - - const std::streamsize cell_width = diskio::prepare_stream(f); - - for(uword row=0; row < x.n_rows; ++row) - { - for(uword col=0; col < x.n_cols; ++col) - { - f.put(' '); - - if(is_real::value) { f.width(cell_width); } - - arma_ostream::raw_print_elem(f, x.at(row,col)); - } - - f.put('\n'); - } - - const bool save_okay = f.good(); - - stream_state.restore(f); - - return save_okay; - } - - - -//! Save a matrix as raw binary (no header) -template -inline -bool -diskio::save_raw_binary(const Mat& x, const std::string& final_name) - { - arma_debug_sigprint(); - - const std::string tmp_name = diskio::gen_tmp_name(final_name); - - std::ofstream f(tmp_name, std::fstream::binary); - - bool save_okay = f.is_open(); - - if(save_okay) - { - save_okay = diskio::save_raw_binary(x, f); - - f.flush(); - f.close(); - - if(save_okay) { save_okay = diskio::safe_rename(tmp_name, final_name); } - } - - return save_okay; - } - - - -template -inline -bool -diskio::save_raw_binary(const Mat& x, std::ostream& f) - { - arma_debug_sigprint(); - - f.write( reinterpret_cast(x.mem), std::streamsize(x.n_elem*sizeof(eT)) ); - - return f.good(); - } - - - -//! Save a matrix in text format (human readable), -//! with a header that indicates the matrix type as well as its dimensions -template -inline -bool -diskio::save_arma_ascii(const Mat& x, const std::string& final_name) - { - arma_debug_sigprint(); - - const std::string tmp_name = diskio::gen_tmp_name(final_name); - - std::ofstream f; - - (arma_config::text_as_binary) ? f.open(tmp_name, std::fstream::binary) : f.open(tmp_name); - - bool save_okay = f.is_open(); - - if(save_okay) - { - save_okay = diskio::save_arma_ascii(x, f); - - f.flush(); - f.close(); - - if(save_okay) { save_okay = diskio::safe_rename(tmp_name, final_name); } - } - - return save_okay; - } - - - -//! Save a matrix in text format (human readable), -//! with a header that indicates the matrix type as well as its dimensions -template -inline -bool -diskio::save_arma_ascii(const Mat& x, std::ostream& f) - { - arma_debug_sigprint(); - - const arma_ostream_state stream_state(f); - - f << diskio::gen_txt_header(x) << '\n'; - f << x.n_rows << ' ' << x.n_cols << '\n'; - - const std::streamsize cell_width = diskio::prepare_stream(f); - - for(uword row=0; row < x.n_rows; ++row) - { - for(uword col=0; col < x.n_cols; ++col) - { - f.put(' '); - - if(is_real::value) { f.width(cell_width); } - - arma_ostream::raw_print_elem(f, x.at(row,col)); - } - - f.put('\n'); - } - - const bool save_okay = f.good(); - - stream_state.restore(f); - - return save_okay; - } - - - -//! Save a matrix in CSV text format (human readable) -template -inline -bool -diskio::save_csv_ascii(const Mat& x, const std::string& final_name, const field& header, const bool with_header, const char separator) - { - arma_debug_sigprint(); - - const std::string tmp_name = diskio::gen_tmp_name(final_name); - - std::ofstream f; - - (arma_config::text_as_binary) ? f.open(tmp_name, std::fstream::binary) : f.open(tmp_name); - - bool save_okay = f.is_open(); - - if(save_okay == false) { return false; } - - if(with_header) - { - arma_debug_print("diskio::save_csv_ascii(): writing header"); - - for(uword i=0; i < header.n_elem; ++i) - { - f << header.at(i); - - if(i != (header.n_elem-1)) { f.put(separator); } - } - - f.put('\n'); - - save_okay = f.good(); - } - - if(save_okay) { save_okay = diskio::save_csv_ascii(x, f, separator); } - - f.flush(); - f.close(); - - if(save_okay) { save_okay = diskio::safe_rename(tmp_name, final_name); } - - return save_okay; - } - - - -//! Save a matrix in CSV text format (human readable) -template -inline -bool -diskio::save_csv_ascii(const Mat& x, std::ostream& f, const char separator) - { - arma_debug_sigprint(); - - const arma_ostream_state stream_state(f); - - diskio::prepare_stream(f); - - uword x_n_rows = x.n_rows; - uword x_n_cols = x.n_cols; - - const eT eT_int_lowest = eT(std::numeric_limits::lowest()); - const eT eT_int_max = eT(std::numeric_limits::max()); - - for(uword row=0; row < x_n_rows; ++row) - { - for(uword col=0; col < x_n_cols; ++col) - { - const eT val = x.at(row,col); - - const bool is_real_int = (is_real::yes) && arma_isfinite(val) && (val > eT_int_lowest) && (val < eT_int_max) && (eT(int(val)) == val); - - (is_real_int) ? arma_ostream::raw_print_elem(f, int(val)) : arma_ostream::raw_print_elem(f, val); - - if( col < (x_n_cols-1) ) { f.put(separator); } - } - - f.put('\n'); - } - - const bool save_okay = f.good(); - - stream_state.restore(f); - - return save_okay; - } - - - -//! Save a matrix in CSV text format (human readable); complex numbers stored in "a+bi" format -template -inline -bool -diskio::save_csv_ascii(const Mat< std::complex >& x, std::ostream& f, const char separator) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const arma_ostream_state stream_state(f); - - diskio::prepare_stream(f); - - const T T_int_lowest = T(std::numeric_limits::lowest()); - const T T_int_max = T(std::numeric_limits::max()); - - uword x_n_rows = x.n_rows; - uword x_n_cols = x.n_cols; - - for(uword row=0; row < x_n_rows; ++row) - { - for(uword col=0; col < x_n_cols; ++col) - { - const eT& val = x.at(row,col); - - const T val_r = std::real(val); - const T val_i = std::imag(val); - const T abs_i = (val_i < T(0)) ? T(-val_i) : T(val_i); - const char sgn_i = (val_i < T(0)) ? char('-') : char('+'); - - const bool val_r_is_real_int = (is_real::yes) && arma_isfinite(val_r) && (val_r > T_int_lowest) && (val_r < T_int_max) && (T(int(val_r)) == val_r); - const bool abs_i_is_real_int = (is_real::yes) && arma_isfinite(abs_i) && (abs_i < T_int_max) && (T(int(abs_i)) == abs_i); - - (val_r_is_real_int) ? arma_ostream::raw_print_elem(f, int(val_r)) : arma_ostream::raw_print_elem(f, val_r); - - f.put(sgn_i); - - (abs_i_is_real_int) ? arma_ostream::raw_print_elem(f, int(abs_i)) : arma_ostream::raw_print_elem(f, abs_i); - - f.put('i'); - - if( col < (x_n_cols-1) ) { f.put(separator); } - } - - f.put('\n'); - } - - const bool save_okay = f.good(); - - stream_state.restore(f); - - return save_okay; - } - - - -template -inline -bool -diskio::save_coord_ascii(const Mat& x, const std::string& final_name) - { - arma_debug_sigprint(); - - const std::string tmp_name = diskio::gen_tmp_name(final_name); - - std::ofstream f; - - (arma_config::text_as_binary) ? f.open(tmp_name, std::fstream::binary) : f.open(tmp_name); - - bool save_okay = f.is_open(); - - if(save_okay) - { - save_okay = diskio::save_coord_ascii(x, f); - - f.flush(); - f.close(); - - if(save_okay) { save_okay = diskio::safe_rename(tmp_name, final_name); } - } - - return save_okay; - } - - - -template -inline -bool -diskio::save_coord_ascii(const Mat& x, std::ostream& f) - { - arma_debug_sigprint(); - - const arma_ostream_state stream_state(f); - - diskio::prepare_stream(f); - - const eT eT_zero = eT(0); - const eT eT_int_lowest = eT(std::numeric_limits::lowest()); - const eT eT_int_max = eT(std::numeric_limits::max()); - - for(uword col=0; col < x.n_cols; ++col) - for(uword row=0; row < x.n_rows; ++row) - { - const eT val = x.at(row,col); - - if(val == eT_zero) { continue; } - - f << row; f.put(' '); - f << col; f.put(' '); - - const bool is_real_int = (is_real::yes) && arma_isfinite(val) && (val > eT_int_lowest) && (val < eT_int_max) && (eT(int(val)) == val); - - (is_real_int) ? arma_ostream::raw_print_elem(f, int(val)) : arma_ostream::raw_print_elem(f, val); - - f.put('\n'); - } - - // make sure it's possible to determine the matrix size - if( (x.n_rows > 0) && (x.n_cols > 0) ) - { - const uword max_row = (x.n_rows > 0) ? x.n_rows-1 : 0; - const uword max_col = (x.n_cols > 0) ? x.n_cols-1 : 0; - - if( x.at(max_row, max_col) == eT(0) ) - { - f << max_row << ' ' << max_col << " 0\n"; - } - } - - const bool save_okay = f.good(); - - stream_state.restore(f); - - return save_okay; - } - - - -template -inline -bool -diskio::save_coord_ascii(const Mat< std::complex >& x, std::ostream& f) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const arma_ostream_state stream_state(f); - - diskio::prepare_stream(f); - - const eT eT_zero = eT(0); - const T T_int_lowest = T(std::numeric_limits::lowest()); - const T T_int_max = T(std::numeric_limits::max()); - - for(uword col=0; col < x.n_cols; ++col) - for(uword row=0; row < x.n_rows; ++row) - { - const eT& val = x.at(row,col); - - if(val == eT_zero) { continue; } - - f << row; f.put(' '); - f << col; f.put(' '); - - const T val_r = std::real(val); - const T val_i = std::imag(val); - - const bool val_r_is_real_int = (is_real::yes) && arma_isfinite(val_r) && (val_r > T_int_lowest) && (val_r < T_int_max) && (T(int(val_r)) == val_r); - const bool val_i_is_real_int = (is_real::yes) && arma_isfinite(val_i) && (val_i > T_int_lowest) && (val_i < T_int_max) && (T(int(val_i)) == val_i); - - (val_r_is_real_int) ? arma_ostream::raw_print_elem(f, int(val_r)) : arma_ostream::raw_print_elem(f, val_r); - - f.put(' '); - - (val_i_is_real_int) ? arma_ostream::raw_print_elem(f, int(val_i)) : arma_ostream::raw_print_elem(f, val_i); - - f.put('\n'); - } - - // make sure it's possible to determine the matrix size - if( (x.n_rows > 0) && (x.n_cols > 0) ) - { - const uword max_row = (x.n_rows > 0) ? x.n_rows-1 : 0; - const uword max_col = (x.n_cols > 0) ? x.n_cols-1 : 0; - - if( x.at(max_row, max_col) == eT_zero ) - { - f << max_row << ' ' << max_col << " 0 0\n"; - } - } - - const bool save_okay = f.good(); - - stream_state.restore(f); - - return save_okay; - } - - - -//! Save a matrix in binary format, -//! with a header that stores the matrix type as well as its dimensions -template -inline -bool -diskio::save_arma_binary(const Mat& x, const std::string& final_name) - { - arma_debug_sigprint(); - - const std::string tmp_name = diskio::gen_tmp_name(final_name); - - std::ofstream f(tmp_name, std::fstream::binary); - - bool save_okay = f.is_open(); - - if(save_okay) - { - save_okay = diskio::save_arma_binary(x, f); - - f.flush(); - f.close(); - - if(save_okay) { save_okay = diskio::safe_rename(tmp_name, final_name); } - } - - return save_okay; - } - - - -//! Save a matrix in binary format, -//! with a header that stores the matrix type as well as its dimensions -template -inline -bool -diskio::save_arma_binary(const Mat& x, std::ostream& f) - { - arma_debug_sigprint(); - - f << diskio::gen_bin_header(x) << '\n'; - f << x.n_rows << ' ' << x.n_cols << '\n'; - - f.write( reinterpret_cast(x.mem), std::streamsize(x.n_elem*sizeof(eT)) ); - - return f.good(); - } - - - -//! Save a matrix as a PGM greyscale image -template -inline -bool -diskio::save_pgm_binary(const Mat& x, const std::string& final_name) - { - arma_debug_sigprint(); - - const std::string tmp_name = diskio::gen_tmp_name(final_name); - - std::fstream f(tmp_name, std::fstream::out | std::fstream::binary); - - bool save_okay = f.is_open(); - - if(save_okay) - { - save_okay = diskio::save_pgm_binary(x, f); - - f.flush(); - f.close(); - - if(save_okay) { save_okay = diskio::safe_rename(tmp_name, final_name); } - } - - return save_okay; - } - - - -//! Save a matrix as a PGM greyscale image -template -inline -bool -diskio::save_pgm_binary(const Mat& x, std::ostream& f) - { - arma_debug_sigprint(); - - f << "P5" << '\n'; - f << x.n_cols << ' ' << x.n_rows << '\n'; - f << 255 << '\n'; - - const uword n_elem = x.n_rows * x.n_cols; - podarray tmp(n_elem); - - uword i = 0; - - for(uword row=0; row < x.n_rows; ++row) - for(uword col=0; col < x.n_cols; ++col) - { - tmp[i] = u8( x.at(row,col) ); // TODO: add round() ? - ++i; - } - - f.write(reinterpret_cast(tmp.mem), std::streamsize(n_elem) ); - - return f.good(); - } - - - -//! Save a matrix as a PGM greyscale image -template -inline -bool -diskio::save_pgm_binary(const Mat< std::complex >& x, const std::string& final_name) - { - arma_debug_sigprint(); - - const uchar_mat tmp = conv_to::from(x); - - return diskio::save_pgm_binary(tmp, final_name); - } - - - -//! Save a matrix as a PGM greyscale image -template -inline -bool -diskio::save_pgm_binary(const Mat< std::complex >& x, std::ostream& f) - { - arma_debug_sigprint(); - - const uchar_mat tmp = conv_to::from(x); - - return diskio::save_pgm_binary(tmp, f); - } - - - -//! Save a matrix as part of a HDF5 file -template -inline -bool -diskio::save_hdf5_binary(const Mat& x, const hdf5_name& spec, std::string& err_msg) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_HDF5) - { - hdf5_misc::hdf5_suspend_printing_errors hdf5_print_suspender; - - bool save_okay = false; - - const bool append = bool(spec.opts.flags & hdf5_opts::flag_append); - const bool replace = bool(spec.opts.flags & hdf5_opts::flag_replace); - - const bool use_existing_file = ((append || replace) && (H5Fis_hdf5(spec.filename.c_str()) > 0)); - - const std::string tmp_name = (use_existing_file) ? std::string() : diskio::gen_tmp_name(spec.filename); - - // Set up the file according to HDF5's preferences - hid_t file = (use_existing_file) ? H5Fopen(spec.filename.c_str(), H5F_ACC_RDWR, H5P_DEFAULT) : H5Fcreate(tmp_name.c_str(), H5F_ACC_TRUNC, H5P_DEFAULT, H5P_DEFAULT); - - if(file < 0) { return false; } - - // We need to create a dataset, datatype, and dataspace - hsize_t dims[2]; - dims[1] = x.n_rows; - dims[0] = x.n_cols; - - hid_t dataspace = H5Screate_simple(2, dims, NULL); // treat the matrix as a 2d array dataspace - hid_t datatype = hdf5_misc::get_hdf5_type(); - - // fail if we can't handle the datatype - if(datatype == -1) { err_msg = "unknown datatype for HDF5"; return false; } - - // MATLAB forces the users to specify a name at save time for HDF5; - // Octave will use the default of 'dataset' unless otherwise specified. - // If the user hasn't specified a dataset name, we will use 'dataset' - // We may have to split out the group name from the dataset name. - std::vector groups; - std::string full_name = spec.dsname; - size_t loc; - while((loc = full_name.find("/")) != std::string::npos) - { - // Create another group... - if(loc != 0) // Ignore the first /, if there is a leading /. - { - hid_t gid = H5Gcreate((groups.size() == 0) ? file : groups[groups.size() - 1], full_name.substr(0, loc).c_str(), H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); - - if((gid < 0) && use_existing_file) - { - gid = H5Gopen((groups.size() == 0) ? file : groups[groups.size() - 1], full_name.substr(0, loc).c_str(), H5P_DEFAULT); - } - - groups.push_back(gid); - } - - full_name = full_name.substr(loc + 1); - } - - const std::string dataset_name = full_name.empty() ? std::string("dataset") : full_name; - - const hid_t last_group = (groups.size() == 0) ? file : groups[groups.size() - 1]; - - if(use_existing_file && replace) - { - H5Ldelete(last_group, dataset_name.c_str(), H5P_DEFAULT); - // NOTE: H5Ldelete() in HDF5 v1.8 doesn't reclaim the deleted space; use h5repack to reclaim space: h5repack oldfile.h5 newfile.h5 - // NOTE: has this behaviour changed in HDF5 1.10 ? - // NOTE: https://lists.hdfgroup.org/pipermail/hdf-forum_lists.hdfgroup.org/2017-August/010482.html - // NOTE: https://lists.hdfgroup.org/pipermail/hdf-forum_lists.hdfgroup.org/2017-August/010486.html - } - - hid_t dataset = H5Dcreate(last_group, dataset_name.c_str(), datatype, dataspace, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); - - if(dataset < 0) - { - save_okay = false; - - err_msg = "failed to create dataset"; - } - else - { - save_okay = (H5Dwrite(dataset, datatype, H5S_ALL, H5S_ALL, H5P_DEFAULT, x.mem) >= 0); - - H5Dclose(dataset); - } - - H5Tclose(datatype); - H5Sclose(dataspace); - for(size_t i = 0; i < groups.size(); ++i) { H5Gclose(groups[i]); } - H5Fclose(file); - - if((use_existing_file == false) && (save_okay == true)) { save_okay = diskio::safe_rename(tmp_name, spec.filename); } - - return save_okay; - } - #else - { - arma_ignore(x); - arma_ignore(spec); - arma_ignore(err_msg); - - arma_stop_logic_error("Mat::save(): use of HDF5 must be enabled"); - - return false; - } - #endif - } - - - -//! Load a matrix as raw text (no header, human readable). -//! Can read matrices saved as text in Matlab and Octave. -//! NOTE: this is much slower than reading a file with a header. -template -inline -bool -diskio::load_raw_ascii(Mat& x, const std::string& name, std::string& err_msg) - { - arma_debug_sigprint(); - - std::ifstream f; - - (arma_config::text_as_binary) ? f.open(name, std::fstream::binary) : f.open(name); - - bool load_okay = f.is_open(); - - if(load_okay) - { - load_okay = diskio::load_raw_ascii(x, f, err_msg); - f.close(); - } - - return load_okay; - } - - - -//! Load a matrix as raw text (no header, human readable). -//! Can read matrices saved as text in Matlab and Octave. -//! NOTE: this is much slower than reading a file with a header. -template -inline -bool -diskio::load_raw_ascii(Mat& x, std::istream& f, std::string& err_msg) - { - arma_debug_sigprint(); - - bool load_okay = f.good(); - - f.clear(); - const std::fstream::pos_type pos1 = f.tellg(); - - // - // work out the size - - uword f_n_rows = 0; - uword f_n_cols = 0; - - bool f_n_cols_found = false; - - std::string line_string; - std::stringstream line_stream; - - std::string token; - - while( f.good() && load_okay ) - { - std::getline(f, line_string); - - // TODO: does it make sense to stop processing the file if an empty line is found ? - if(line_string.size() == 0) { break; } - - line_stream.clear(); - line_stream.str(line_string); - - uword line_n_cols = 0; - - while(line_stream >> token) { ++line_n_cols; } - - if(f_n_cols_found == false) - { - f_n_cols = line_n_cols; - f_n_cols_found = true; - } - else - { - if(line_n_cols != f_n_cols) - { - load_okay = false; - err_msg = "inconsistent number of columns"; - } - } - - ++f_n_rows; - } - - - if(load_okay) - { - f.clear(); - f.seekg(pos1); - - if(f.fail() || (f.tellg() != pos1)) { err_msg = "seek failure"; return false; } - - try { x.set_size(f_n_rows, f_n_cols); } catch(...) { err_msg = "not enough memory"; return false; } - - for(uword row=0; ((row < x.n_rows) && load_okay); ++row) - for(uword col=0; ((col < x.n_cols) && load_okay); ++col) - { - f >> token; - - if(diskio::convert_token(x.at(row,col), token) == false) - { - load_okay = false; - err_msg = "data interpretation failure"; - } - } - } - - - // an empty file indicates an empty matrix - if( (f_n_cols_found == false) && (load_okay == true) ) { x.reset(); } - - - return load_okay; - } - - - -//! Load a matrix in binary format (no header); -//! the matrix is assumed to have one column -template -inline -bool -diskio::load_raw_binary(Mat& x, const std::string& name, std::string& err_msg) - { - arma_debug_sigprint(); - - std::ifstream f; - f.open(name, std::fstream::binary); - - bool load_okay = f.is_open(); - - if(load_okay) - { - load_okay = diskio::load_raw_binary(x, f, err_msg); - f.close(); - } - - return load_okay; - } - - - -template -inline -bool -diskio::load_raw_binary(Mat& x, std::istream& f, std::string& err_msg) - { - arma_debug_sigprint(); - - f.clear(); - const std::streampos pos1 = f.tellg(); - - f.clear(); - f.seekg(0, ios::end); - - f.clear(); - const std::streampos pos2 = f.tellg(); - - const uword N = ( (pos1 >= 0) && (pos2 >= 0) ) ? uword(pos2 - pos1) : 0; - - f.clear(); - //f.seekg(0, ios::beg); - f.seekg(pos1); - - if(f.fail() || (f.tellg() != pos1)) { err_msg = "seek failure"; return false; } - - try { x.set_size(N / uword(sizeof(eT)), 1); } catch(...) { err_msg = "not enough memory"; return false; } - - f.clear(); - f.read( reinterpret_cast(x.memptr()), std::streamsize(x.n_elem * uword(sizeof(eT))) ); - - return f.good(); - } - - - -//! Load a matrix in text format (human readable), -//! with a header that indicates the matrix type as well as its dimensions -template -inline -bool -diskio::load_arma_ascii(Mat& x, const std::string& name, std::string& err_msg) - { - arma_debug_sigprint(); - - std::ifstream f; - - (arma_config::text_as_binary) ? f.open(name, std::fstream::binary) : f.open(name); - - bool load_okay = f.is_open(); - - if(load_okay) - { - load_okay = diskio::load_arma_ascii(x, f, err_msg); - f.close(); - } - - return load_okay; - } - - - -//! Load a matrix in text format (human readable), -//! with a header that indicates the matrix type as well as its dimensions -template -inline -bool -diskio::load_arma_ascii(Mat& x, std::istream& f, std::string& err_msg) - { - arma_debug_sigprint(); - - std::streampos pos = f.tellg(); - - bool load_okay = true; - - std::string f_header; - uword f_n_rows; - uword f_n_cols; - - f >> f_header; - f >> f_n_rows; - f >> f_n_cols; - - if(f_header == diskio::gen_txt_header(x)) - { - try { x.zeros(f_n_rows, f_n_cols); } catch(...) { err_msg = "not enough memory"; return false; } - - std::string token; - - for(uword row=0; row < x.n_rows; ++row) - for(uword col=0; col < x.n_cols; ++col) - { - f >> token; - - diskio::convert_token( x.at(row,col), token ); - } - - load_okay = f.good(); - } - else - { - load_okay = false; - err_msg = "incorrect header"; - } - - - // allow automatic conversion of u32/s32 matrices into u64/s64 matrices - - if(load_okay == false) - { - if( (sizeof(eT) == 8) && is_same_type::yes ) - { - Mat tmp; - std::string junk; - - f.clear(); - f.seekg(pos); - - load_okay = diskio::load_arma_ascii(tmp, f, junk); - - if(load_okay) { x = conv_to< Mat >::from(tmp); } - } - else - if( (sizeof(eT) == 8) && is_same_type::yes ) - { - Mat tmp; - std::string junk; - - f.clear(); - f.seekg(pos); - - load_okay = diskio::load_arma_ascii(tmp, f, junk); - - if(load_okay) { x = conv_to< Mat >::from(tmp); } - } - } - - return load_okay; - } - - - -//! Load a matrix in CSV text format (human readable) -template -inline -bool -diskio::load_csv_ascii(Mat& x, const std::string& name, std::string& err_msg, field& header, const bool with_header, const char separator, const bool strict) - { - arma_debug_sigprint(); - - std::ifstream f; - - (arma_config::text_as_binary) ? f.open(name, std::fstream::binary) : f.open(name); - - bool load_okay = f.is_open(); - - if(load_okay == false) { return false; } - - if(with_header) - { - arma_debug_print("diskio::load_csv_ascii(): reading header"); - - std::string header_line; - std::stringstream header_stream; - std::vector header_tokens; - - std::getline(f, header_line); - - load_okay = f.good(); - - if(load_okay) - { - std::string token; - - header_stream.clear(); - header_stream.str(header_line); - - uword header_n_tokens = 0; - - while(header_stream.good()) - { - std::getline(header_stream, token, separator); - - diskio::sanitise_token(token); - - ++header_n_tokens; - - header_tokens.push_back(token); - } - - if(header_n_tokens == uword(0)) - { - header.reset(); - } - else - { - header.set_size(1,header_n_tokens); - - for(uword i=0; i < header_n_tokens; ++i) { header.at(i) = header_tokens[i]; } - } - } - } - - if(load_okay) - { - load_okay = diskio::load_csv_ascii(x, f, err_msg, separator, strict); - } - - f.close(); - - return load_okay; - } - - - -//! Load a matrix in CSV text format (human readable) -template -inline -bool -diskio::load_csv_ascii(Mat& x, std::istream& f, std::string& err_msg, const char separator, const bool strict) - { - arma_debug_sigprint(); - - // TODO: replace with more efficient implementation - - if(f.good() == false) { return false; } - - f.clear(); - const std::fstream::pos_type pos1 = f.tellg(); - - // - // work out the size - - uword f_n_rows = 0; - uword f_n_cols = 0; - - std::string line_string; - std::stringstream line_stream; - - std::string token; - - while(f.good()) - { - std::getline(f, line_string); - - if(line_string.size() == 0) { break; } - - line_stream.clear(); - line_stream.str(line_string); - - uword line_n_cols = 0; - - while(line_stream.good()) - { - std::getline(line_stream, token, separator); - ++line_n_cols; - } - - if(f_n_cols < line_n_cols) { f_n_cols = line_n_cols; } - - ++f_n_rows; - } - - f.clear(); - f.seekg(pos1); - - if(f.fail() || (f.tellg() != pos1)) { err_msg = "seek failure"; return false; } - - try { x.zeros(f_n_rows, f_n_cols); } catch(...) { err_msg = "not enough memory"; return false; } - - if(strict) { x.fill(Datum::nan); } // take into account that each row may have a unique number of columns - - const bool use_mp = (arma_config::openmp) && (f_n_rows >= 2) && (f_n_cols >= 64); - - field token_array; - - bool token_array_ok = false; - - if(use_mp) - { - try - { - token_array.set_size(f_n_cols); - - for(uword i=0; i < f_n_cols; ++i) { token_array(i).reserve(32); } - - token_array_ok = true; - } - catch(...) - { - token_array.reset(); - } - } - - if(use_mp && token_array_ok) - { - #if defined(ARMA_USE_OPENMP) - { - uword row = 0; - - while(f.good()) - { - std::getline(f, line_string); - - if(line_string.size() == 0) { break; } - - line_stream.clear(); - line_stream.str(line_string); - - for(uword i=0; i < f_n_cols; ++i) { token_array(i).clear(); } - - uword line_stream_col = 0; - - while(line_stream.good()) - { - std::getline(line_stream, token_array(line_stream_col), separator); - - ++line_stream_col; - } - - const int n_threads = mp_thread_limit::get(); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword col=0; col < line_stream_col; ++col) - { - eT& out_val = x.at(row,col); - - (strict) ? diskio::convert_token_strict( out_val, token_array(col) ) : diskio::convert_token( out_val, token_array(col) ); - } - - ++row; - } - } - #endif - } - else // serial implementation - { - uword row = 0; - - while(f.good()) - { - std::getline(f, line_string); - - if(line_string.size() == 0) { break; } - - line_stream.clear(); - line_stream.str(line_string); - - uword col = 0; - - while(line_stream.good()) - { - std::getline(line_stream, token, separator); - - eT& out_val = x.at(row,col); - - (strict) ? diskio::convert_token_strict( out_val, token ) : diskio::convert_token( out_val, token ); - - ++col; - } - - ++row; - } - } - - return true; - } - - - -//! Load a matrix in CSV text format (human readable); complex numbers stored in "a+bi" format -template -inline -bool -diskio::load_csv_ascii(Mat< std::complex >& x, std::istream& f, std::string& err_msg, const char separator, const bool strict) - { - arma_debug_sigprint(); - - // TODO: replace with more efficient implementation - - if(f.good() == false) { return false; } - - f.clear(); - const std::fstream::pos_type pos1 = f.tellg(); - - // - // work out the size - - uword f_n_rows = 0; - uword f_n_cols = 0; - - std::string line_string; - std::stringstream line_stream; - - std::string token; - - while(f.good()) - { - std::getline(f, line_string); - - if(line_string.size() == 0) { break; } - - line_stream.clear(); - line_stream.str(line_string); - - uword line_n_cols = 0; - - while(line_stream.good()) - { - std::getline(line_stream, token, separator); - ++line_n_cols; - } - - if(f_n_cols < line_n_cols) { f_n_cols = line_n_cols; } - - ++f_n_rows; - } - - f.clear(); - f.seekg(pos1); - - if(f.fail() || (f.tellg() != pos1)) { err_msg = "seek failure"; return false; } - - try { x.zeros(f_n_rows, f_n_cols); } catch(...) { err_msg = "not enough memory"; return false; } - - if(strict) { x.fill(Datum< std::complex >::nan); } // take into account that each row may have a unique number of columns - - uword row = 0; - - std::string str_real; - std::string str_imag; - - while(f.good()) - { - std::getline(f, line_string); - - if(line_string.size() == 0) { break; } - - line_stream.clear(); - line_stream.str(line_string); - - uword col = 0; - - while(line_stream.good()) - { - std::getline(line_stream, token, separator); - - diskio::sanitise_token(token); - - const size_t token_len = size_t( token.length() ); - - if(token_len == 0) { col++; continue; } - - // handle special cases: inf and nan, without the imaginary part - if( (token_len == 3) || (token_len == 4) ) - { - const char* str = token.c_str(); - - const bool neg = (str[0] == '-'); - const bool pos = (str[0] == '+'); - - const size_t offset = ( (neg || pos) && (token_len == 4) ) ? 1 : 0; - - const char sig_a = str[offset ]; - const char sig_b = str[offset+1]; - const char sig_c = str[offset+2]; - - bool found_val_real = false; - T val_real = T(0); - - if( ((sig_a == 'i') || (sig_a == 'I')) && ((sig_b == 'n') || (sig_b == 'N')) && ((sig_c == 'f') || (sig_c == 'F')) ) - { - val_real = (neg) ? -(Datum::inf) : Datum::inf; - - found_val_real = true; - } - else - if( ((sig_a == 'n') || (sig_a == 'N')) && ((sig_b == 'a') || (sig_b == 'A')) && ((sig_c == 'n') || (sig_c == 'N')) ) - { - val_real = Datum::nan; - - found_val_real = true; - } - - if(found_val_real) - { - const T val_imag = (strict) ? T(Datum::nan) : T(0); - - x.at(row,col) = std::complex(val_real, val_imag); - - col++; continue; // get next token - } - } - - bool found_x = false; - std::string::size_type loc_x = 0; // location of the separator (+ or -) between the real and imaginary part - - std::string::size_type loc_i = token.find_last_of('i'); // location of the imaginary part indicator - - if(loc_i == std::string::npos) - { - str_real = token; - str_imag.clear(); - } - else - { - bool found_plus = false; - bool found_minus = false; - - std::string::size_type loc_plus = token.find_last_of('+'); - - if(loc_plus != std::string::npos) - { - if(loc_plus >= 1) - { - const char prev_char = token.at(loc_plus-1); - - // make sure we're not looking at the sign of the exponent - if( (prev_char != 'e') && (prev_char != 'E') ) - { - found_plus = true; - } - else - { - // search again, omitting the exponent - loc_plus = token.find_last_of('+', loc_plus-1); - - if(loc_plus != std::string::npos) { found_plus = true; } - } - } - else - { - // loc_plus == 0, meaning we're at the start of the string - found_plus = true; - } - } - - std::string::size_type loc_minus = token.find_last_of('-'); - - if(loc_minus != std::string::npos) - { - if(loc_minus >= 1) - { - const char prev_char = token.at(loc_minus-1); - - // make sure we're not looking at the sign of the exponent - if( (prev_char != 'e') && (prev_char != 'E') ) - { - found_minus = true; - } - else - { - // search again, omitting the exponent - loc_minus = token.find_last_of('-', loc_minus-1); - - if(loc_minus != std::string::npos) { found_minus = true; } - } - } - else - { - // loc_minus == 0, meaning we're at the start of the string - found_minus = true; - } - } - - if(found_plus && found_minus) - { - if( (loc_i > loc_plus) && (loc_i > loc_minus) ) - { - // choose the sign closest to the "i" to be the separator between the real and imaginary part - loc_x = ( (loc_i - loc_plus) < (loc_i - loc_minus) ) ? loc_plus : loc_minus; - found_x = true; - } - } - else if(found_plus ) { loc_x = loc_plus; found_x = true; } - else if(found_minus) { loc_x = loc_minus; found_x = true; } - - if(found_x) - { - if( loc_x > 0 ) { str_real = token.substr(0,loc_x); } else { str_real.clear(); } - if((loc_x+1) < token.size()) { str_imag = token.substr(loc_x, token.size()-loc_x-1); } else { str_imag.clear(); } - } - else - { - str_real.clear(); - str_imag.clear(); - } - } - - T val_real = T(0); - T val_imag = T(0); - - (strict) ? diskio::convert_token_strict(val_real, str_real) : diskio::convert_token(val_real, str_real); - (strict) ? diskio::convert_token_strict(val_imag, str_imag) : diskio::convert_token(val_imag, str_imag); - - x.at(row,col) = std::complex(val_real, val_imag); - - ++col; - } - - ++row; - } - - return true; - } - - - -template -inline -bool -diskio::load_coord_ascii(Mat& x, const std::string& name, std::string& err_msg) - { - arma_debug_sigprint(); - - std::ifstream f; - - (arma_config::text_as_binary) ? f.open(name, std::fstream::binary) : f.open(name); - - bool load_okay = f.is_open(); - - if(load_okay == false) { return false; } - - if(load_okay) - { - load_okay = diskio::load_coord_ascii(x, f, err_msg); - } - - f.close(); - - return load_okay; - } - - - -//! Load a matrix in CSV text format (human readable) -template -inline -bool -diskio::load_coord_ascii(Mat& x, std::istream& f, std::string& err_msg) - { - arma_debug_sigprint(); - - if(f.good() == false) { return false; } - - f.clear(); - const std::fstream::pos_type pos1 = f.tellg(); - - // work out the size - - uword f_n_rows = 0; - uword f_n_cols = 0; - - bool size_found = false; - - std::string line_string; - std::stringstream line_stream; - - std::string token; - - while(f.good()) - { - std::getline(f, line_string); - - if(line_string.size() == 0) { break; } - - line_stream.clear(); - line_stream.str(line_string); - - uword line_row = 0; - uword line_col = 0; - - // a valid line in co-ord format has at least 2 entries - - line_stream >> line_row; - - if(line_stream.good() == false) { err_msg = "incorrect format"; return false; } - - line_stream >> line_col; - - size_found = true; - - if(f_n_rows < line_row) { f_n_rows = line_row; } - if(f_n_cols < line_col) { f_n_cols = line_col; } - } - - // take into account that indices start at 0 - if(size_found) { ++f_n_rows; ++f_n_cols; } - - f.clear(); - f.seekg(pos1); - - if(f.fail() || (f.tellg() != pos1)) { err_msg = "seek failure"; return false; } - - try - { - Mat tmp(f_n_rows, f_n_cols, arma_zeros_indicator()); - - while(f.good()) - { - std::getline(f, line_string); - - if(line_string.size() == 0) { break; } - - line_stream.clear(); - line_stream.str(line_string); - - uword line_row = 0; - uword line_col = 0; - - line_stream >> line_row; - line_stream >> line_col; - - eT val = eT(0); - - line_stream >> token; - - if(line_stream.fail() == false) { diskio::convert_token( val, token ); } - - if(val != eT(0)) { tmp(line_row,line_col) = val; } - } - - x.steal_mem(tmp); - } - catch(...) - { - err_msg = "not enough memory"; - return false; - } - - return true; - } - - - -template -inline -bool -diskio::load_coord_ascii(Mat< std::complex >& x, std::istream& f, std::string& err_msg) - { - arma_debug_sigprint(); - - if(f.good() == false) { return false; } - - f.clear(); - const std::fstream::pos_type pos1 = f.tellg(); - - // work out the size - - uword f_n_rows = 0; - uword f_n_cols = 0; - - bool size_found = false; - - std::string line_string; - std::stringstream line_stream; - - std::string token_real; - std::string token_imag; - - while(f.good()) - { - std::getline(f, line_string); - - if(line_string.size() == 0) { break; } - - line_stream.clear(); - line_stream.str(line_string); - - uword line_row = 0; - uword line_col = 0; - - // a valid line in co-ord format has at least 2 entries - - line_stream >> line_row; - - if(line_stream.good() == false) { err_msg = "incorrect format"; return false; } - - line_stream >> line_col; - - size_found = true; - - if(f_n_rows < line_row) f_n_rows = line_row; - if(f_n_cols < line_col) f_n_cols = line_col; - } - - // take into account that indices start at 0 - if(size_found) { ++f_n_rows; ++f_n_cols; } - - f.clear(); - f.seekg(pos1); - - if(f.fail() || (f.tellg() != pos1)) { err_msg = "seek failure"; return false; } - - try - { - Mat< std::complex > tmp(f_n_rows, f_n_cols, arma_zeros_indicator()); - - while(f.good()) - { - std::getline(f, line_string); - - if(line_string.size() == 0) { break; } - - line_stream.clear(); - line_stream.str(line_string); - - uword line_row = 0; - uword line_col = 0; - - line_stream >> line_row; - line_stream >> line_col; - - T val_real = T(0); - T val_imag = T(0); - - line_stream >> token_real; - - if(line_stream.fail() == false) { diskio::convert_token( val_real, token_real ); } - - line_stream >> token_imag; - - if(line_stream.fail() == false) { diskio::convert_token( val_imag, token_imag ); } - - if( (val_real != T(0)) || (val_imag != T(0)) ) - { - tmp(line_row,line_col) = std::complex(val_real, val_imag); - } - } - - x.steal_mem(tmp); - } - catch(...) - { - err_msg = "not enough memory"; - return false; - } - - return true; - } - - - -//! Load a matrix in binary format, -//! with a header that indicates the matrix type as well as its dimensions -template -inline -bool -diskio::load_arma_binary(Mat& x, const std::string& name, std::string& err_msg) - { - arma_debug_sigprint(); - - std::ifstream f; - f.open(name, std::fstream::binary); - - bool load_okay = f.is_open(); - - if(load_okay) - { - load_okay = diskio::load_arma_binary(x, f, err_msg); - f.close(); - } - - return load_okay; - } - - - -template -inline -bool -diskio::load_arma_binary(Mat& x, std::istream& f, std::string& err_msg) - { - arma_debug_sigprint(); - - std::streampos pos = f.tellg(); - - bool load_okay = true; - - std::string f_header; - uword f_n_rows; - uword f_n_cols; - - f >> f_header; - f >> f_n_rows; - f >> f_n_cols; - - if(f_header == diskio::gen_bin_header(x)) - { - //f.seekg(1, ios::cur); // NOTE: this may not be portable, as on a Windows machine a newline could be two characters - f.get(); - - try { x.set_size(f_n_rows,f_n_cols); } catch(...) { err_msg = "not enough memory"; return false; } - - f.read( reinterpret_cast(x.memptr()), std::streamsize(x.n_elem*sizeof(eT)) ); - - load_okay = f.good(); - } - else - { - load_okay = false; - err_msg = "incorrect header"; - } - - - // allow automatic conversion of u32/s32 matrices into u64/s64 matrices - - if(load_okay == false) - { - if( (sizeof(eT) == 8) && is_same_type::yes ) - { - Mat tmp; - std::string junk; - - f.clear(); - f.seekg(pos); - - load_okay = diskio::load_arma_binary(tmp, f, junk); - - if(load_okay) { x = conv_to< Mat >::from(tmp); } - } - else - if( (sizeof(eT) == 8) && is_same_type::yes ) - { - Mat tmp; - std::string junk; - - f.clear(); - f.seekg(pos); - - load_okay = diskio::load_arma_binary(tmp, f, junk); - - if(load_okay) { x = conv_to< Mat >::from(tmp); } - } - } - - return load_okay; - } - - - -inline -void -diskio::pnm_skip_comments(std::istream& f) - { - while( isspace(f.peek()) ) - { - while( isspace(f.peek()) ) { f.get(); } - - if(f.peek() == '#') - { - while( (f.peek() != '\r') && (f.peek() != '\n') ) { f.get(); } - } - } - } - - - -//! Load a PGM greyscale image as a matrix -template -inline -bool -diskio::load_pgm_binary(Mat& x, const std::string& name, std::string& err_msg) - { - arma_debug_sigprint(); - - std::fstream f; - f.open(name, std::fstream::in | std::fstream::binary); - - bool load_okay = f.is_open(); - - if(load_okay) - { - load_okay = diskio::load_pgm_binary(x, f, err_msg); - f.close(); - } - - return load_okay; - } - - - -//! Load a PGM greyscale image as a matrix -template -inline -bool -diskio::load_pgm_binary(Mat& x, std::istream& f, std::string& err_msg) - { - bool load_okay = true; - - std::string f_header; - - f >> f_header; - - if(f_header == "P5") - { - uword f_n_rows = 0; - uword f_n_cols = 0; - int f_maxval = 0; - - diskio::pnm_skip_comments(f); - - f >> f_n_cols; - diskio::pnm_skip_comments(f); - - f >> f_n_rows; - diskio::pnm_skip_comments(f); - - f >> f_maxval; - f.get(); - - if( (f_maxval > 0) && (f_maxval <= 65535) ) - { - try { x.set_size(f_n_rows,f_n_cols); } catch(...) { err_msg = "not enough memory"; return false; } - - if(f_maxval <= 255) - { - const uword n_elem = f_n_cols*f_n_rows; - podarray tmp(n_elem); - - f.read( reinterpret_cast(tmp.memptr()), std::streamsize(n_elem) ); - - uword i = 0; - - //cout << "f_n_cols = " << f_n_cols << endl; - //cout << "f_n_rows = " << f_n_rows << endl; - - for(uword row=0; row < f_n_rows; ++row) - for(uword col=0; col < f_n_cols; ++col) - { - x.at(row,col) = eT(tmp[i]); - ++i; - } - } - else - { - const uword n_elem = f_n_cols*f_n_rows; - podarray tmp(n_elem); - - f.read( reinterpret_cast(tmp.memptr()), std::streamsize(n_elem*2) ); - - uword i = 0; - - for(uword row=0; row < f_n_rows; ++row) - for(uword col=0; col < f_n_cols; ++col) - { - x.at(row,col) = eT(tmp[i]); - ++i; - } - } - } - else - { - load_okay = false; - err_msg = "functionality unimplemented"; - } - - if(f.good() == false) { load_okay = false; } - } - else - { - load_okay = false; - err_msg = "unsupported header"; - } - - return load_okay; - } - - - -//! Load a PGM greyscale image as a matrix -template -inline -bool -diskio::load_pgm_binary(Mat< std::complex >& x, const std::string& name, std::string& err_msg) - { - arma_debug_sigprint(); - - uchar_mat tmp; - const bool load_okay = diskio::load_pgm_binary(tmp, name, err_msg); - - x = conv_to< Mat< std::complex > >::from(tmp); - - return load_okay; - } - - - -//! Load a PGM greyscale image as a matrix -template -inline -bool -diskio::load_pgm_binary(Mat< std::complex >& x, std::istream& is, std::string& err_msg) - { - arma_debug_sigprint(); - - uchar_mat tmp; - const bool load_okay = diskio::load_pgm_binary(tmp, is, err_msg); - - x = conv_to< Mat< std::complex > >::from(tmp); - - return load_okay; - } - - - -//! Load a HDF5 file as a matrix -template -inline -bool -diskio::load_hdf5_binary(Mat& x, const hdf5_name& spec, std::string& err_msg) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_HDF5) - { - if(diskio::is_readable(spec.filename) == false) { return false; } - - hdf5_misc::hdf5_suspend_printing_errors hdf5_print_suspender; - - bool load_okay = false; - - hid_t fid = H5Fopen(spec.filename.c_str(), H5F_ACC_RDONLY, H5P_DEFAULT); - - if(fid >= 0) - { - // MATLAB HDF5 dataset names are user-specified; - // Octave tends to store the datasets in a group, with the actual dataset being referred to as "value". - // If the user hasn't specified a dataset, we will search for "dataset" and "value", - // and if those are not found we will take the first dataset we do find. - - std::vector searchNames; - - const bool exact = (spec.dsname.empty() == false); - - if(exact) - { - searchNames.push_back(spec.dsname); - } - else - { - searchNames.push_back("dataset"); - searchNames.push_back("value" ); - } - - hid_t dataset = hdf5_misc::search_hdf5_file(searchNames, fid, 2, exact); - - if(dataset >= 0) - { - hid_t filespace = H5Dget_space(dataset); - - // This must be <= 2 due to our search rules. - const int ndims = H5Sget_simple_extent_ndims(filespace); - - hsize_t dims[2]; - const herr_t query_status = H5Sget_simple_extent_dims(filespace, dims, NULL); - - // arma_check(query_status < 0, "Mat::load(): cannot get size of HDF5 dataset"); - if(query_status < 0) - { - err_msg = "cannot get size of HDF5 dataset"; - - H5Sclose(filespace); - H5Dclose(dataset); - H5Fclose(fid); - - return false; - } - - if(ndims == 1) { dims[1] = 1; } // Vector case; fake second dimension (one column). - - try { x.set_size(dims[1], dims[0]); } catch(...) { err_msg = "not enough memory"; return false; } - - // Now we have to see what type is stored to figure out how to load it. - hid_t datatype = H5Dget_type(dataset); - hid_t mat_type = hdf5_misc::get_hdf5_type(); - - // If these are the same type, it is simple. - if(H5Tequal(datatype, mat_type) > 0) - { - // Load directly; H5S_ALL used so that we load the entire dataset. - hid_t read_status = H5Dread(dataset, datatype, H5S_ALL, H5S_ALL, H5P_DEFAULT, void_ptr(x.memptr())); - - if(read_status >= 0) { load_okay = true; } - } - else - { - // Load into another array and convert its type accordingly. - hid_t read_status = hdf5_misc::load_and_convert_hdf5(x.memptr(), dataset, datatype, x.n_elem); - - if(read_status >= 0) { load_okay = true; } - } - - // Now clean up. - H5Tclose(datatype); - H5Tclose(mat_type); - H5Sclose(filespace); - } - - H5Dclose(dataset); - - H5Fclose(fid); - - if(load_okay == false) - { - err_msg = "unsupported or missing HDF5 data"; - } - } - else - { - err_msg = "cannot open"; - } - - return load_okay; - } - #else - { - arma_ignore(x); - arma_ignore(spec); - arma_ignore(err_msg); - - arma_stop_logic_error("Mat::load(): use of HDF5 must be enabled"); - - return false; - } - #endif - } - - - -//! Try to load a matrix by automatically determining its type -template -inline -bool -diskio::load_auto_detect(Mat& x, const std::string& name, std::string& err_msg) - { - arma_debug_sigprint(); - - if(diskio::is_readable(name) == false) { return false; } - - #if defined(ARMA_USE_HDF5) - // We're currently using the C bindings for the HDF5 library, which don't support C++ streams - if( H5Fis_hdf5(name.c_str()) ) { return load_hdf5_binary(x, name, err_msg); } - #endif - - std::fstream f; - f.open(name, std::fstream::in | std::fstream::binary); - - bool load_okay = f.is_open(); - - if(load_okay) - { - load_okay = diskio::load_auto_detect(x, f, err_msg); - f.close(); - } - - return load_okay; - } - - - -//! Try to load a matrix by automatically determining its type -template -inline -bool -diskio::load_auto_detect(Mat& x, std::istream& f, std::string& err_msg) - { - arma_debug_sigprint(); - - const char* ARMA_MAT_TXT_str = "ARMA_MAT_TXT"; - const char* ARMA_MAT_BIN_str = "ARMA_MAT_BIN"; - const char* P5_str = "P5"; - - const uword ARMA_MAT_TXT_len = uword(12); - const uword ARMA_MAT_BIN_len = uword(12); - const uword P5_len = uword(2); - - podarray header(ARMA_MAT_TXT_len + 1); - - char* header_mem = header.memptr(); - - std::streampos pos = f.tellg(); - - f.read( header_mem, std::streamsize(ARMA_MAT_TXT_len) ); - f.clear(); - f.seekg(pos); - - header_mem[ARMA_MAT_TXT_len] = '\0'; - - if( std::strncmp(ARMA_MAT_TXT_str, header_mem, size_t(ARMA_MAT_TXT_len)) == 0 ) - { - return load_arma_ascii(x, f, err_msg); - } - else - if( std::strncmp(ARMA_MAT_BIN_str, header_mem, size_t(ARMA_MAT_BIN_len)) == 0 ) - { - return load_arma_binary(x, f, err_msg); - } - else - if( std::strncmp(P5_str, header_mem, size_t(P5_len)) == 0 ) - { - return load_pgm_binary(x, f, err_msg); - } - else - { - const file_type ft = guess_file_type_internal(f); - - switch(ft) - { - case csv_ascii: - return load_csv_ascii(x, f, err_msg, char(','), false); - break; - - case ssv_ascii: - return load_csv_ascii(x, f, err_msg, char(';'), false); - break; - - case raw_binary: - return load_raw_binary(x, f, err_msg); - break; - - case raw_ascii: - return load_raw_ascii(x, f, err_msg); - break; - - default: - err_msg = "unknown data"; - return false; - } - } - - return false; - } - - - -// -// sparse matrices -// - - - -//! Save a sparse matrix in CSV format -template -inline -bool -diskio::save_csv_ascii(const SpMat& x, const std::string& final_name, const field& header, const bool with_header, const char separator) - { - arma_debug_sigprint(); - - const std::string tmp_name = diskio::gen_tmp_name(final_name); - - std::ofstream f; - - (arma_config::text_as_binary) ? f.open(tmp_name, std::fstream::binary) : f.open(tmp_name); - - bool save_okay = f.is_open(); - - if(save_okay == false) { return false; } - - if(with_header) - { - arma_debug_print("diskio::save_csv_ascii(): writing header"); - - for(uword i=0; i < header.n_elem; ++i) - { - f << header(i); - - if(i != (header.n_elem-1)) { f.put(separator); } - } - - f.put('\n'); - - save_okay = f.good(); - } - - if(save_okay) { save_okay = diskio::save_csv_ascii(x, f, separator); } - - f.flush(); - f.close(); - - if(save_okay) { save_okay = diskio::safe_rename(tmp_name, final_name); } - - return save_okay; - } - - - -//! Save a sparse matrix in CSV format -template -inline -bool -diskio::save_csv_ascii(const SpMat& x, std::ostream& f, const char separator) - { - arma_debug_sigprint(); - - const arma_ostream_state stream_state(f); - - diskio::prepare_stream(f); - - x.sync(); - - uword x_n_rows = x.n_rows; - uword x_n_cols = x.n_cols; - - const eT eT_zero = eT(0); - const eT eT_int_lowest = eT(std::numeric_limits::lowest()); - const eT eT_int_max = eT(std::numeric_limits::max()); - - for(uword row=0; row < x_n_rows; ++row) - { - for(uword col=0; col < x_n_cols; ++col) - { - const eT val = x.at(row,col); - - if(val == eT_zero) - { - f.put('0'); - } - else - { - const bool is_real_int = (is_real::yes) && arma_isfinite(val) && (val > eT_int_lowest) && (val < eT_int_max) && (eT(int(val)) == val); - - (is_real_int) ? arma_ostream::raw_print_elem(f, int(val)) : arma_ostream::raw_print_elem(f, val); - } - - if( col < (x_n_cols-1) ) { f.put(separator); } - } - - f.put('\n'); - } - - const bool save_okay = f.good(); - - stream_state.restore(f); - - return save_okay; - } - - - -//! Save a sparse matrix in CSV format (complex numbers) -template -inline -bool -diskio::save_csv_ascii(const SpMat< std::complex >& x, std::ostream& f, const char separator) - { - arma_debug_sigprint(); - - arma_ignore(x); - arma_ignore(f); - arma_ignore(separator); - - arma_warn(1, "saving complex sparse matrices as csv_ascii not yet implemented"); - - return false; - } - - - -//! Save a matrix in ASCII coord format -template -inline -bool -diskio::save_coord_ascii(const SpMat& x, const std::string& final_name) - { - arma_debug_sigprint(); - - const std::string tmp_name = diskio::gen_tmp_name(final_name); - - std::ofstream f; - - (arma_config::text_as_binary) ? f.open(tmp_name, std::fstream::binary) : f.open(tmp_name); - - bool save_okay = f.is_open(); - - if(save_okay) - { - save_okay = diskio::save_coord_ascii(x, f); - - f.flush(); - f.close(); - - if(save_okay) { save_okay = diskio::safe_rename(tmp_name, final_name); } - } - - return save_okay; - } - - - -//! Save a matrix in ASCII coord format -template -inline -bool -diskio::save_coord_ascii(const SpMat& x, std::ostream& f) - { - arma_debug_sigprint(); - - const arma_ostream_state stream_state(f); - - diskio::prepare_stream(f); - - const eT eT_int_lowest = eT(std::numeric_limits::lowest()); - const eT eT_int_max = eT(std::numeric_limits::max()); - - typename SpMat::const_iterator iter = x.begin(); - typename SpMat::const_iterator iter_end = x.end(); - - for(; iter != iter_end; ++iter) - { - f << iter.row(); f.put(' '); - f << iter.col(); f.put(' '); - - const eT val = (*iter); - - const bool is_real_int = (is_real::yes) && arma_isfinite(val) && (val > eT_int_lowest) && (val < eT_int_max) && (eT(int(val)) == val); - - (is_real_int) ? arma_ostream::raw_print_elem(f, int(val)) : arma_ostream::raw_print_elem(f, val); - - f.put('\n'); - } - - - // make sure it's possible to determine the matrix size - if( (x.n_rows > 0) && (x.n_cols > 0) ) - { - const uword max_row = (x.n_rows > 0) ? x.n_rows-1 : 0; - const uword max_col = (x.n_cols > 0) ? x.n_cols-1 : 0; - - if( x.at(max_row, max_col) == eT(0) ) - { - f << max_row << ' ' << max_col << " 0\n"; - } - } - - const bool save_okay = f.good(); - - stream_state.restore(f); - - return save_okay; - } - - - -//! Save a matrix in ASCII coord format (complex numbers) -template -inline -bool -diskio::save_coord_ascii(const SpMat< std::complex >& x, std::ostream& f) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const arma_ostream_state stream_state(f); - - diskio::prepare_stream(f); - - const T T_int_lowest = T(std::numeric_limits::lowest()); - const T T_int_max = T(std::numeric_limits::max()); - - typename SpMat::const_iterator iter = x.begin(); - typename SpMat::const_iterator iter_end = x.end(); - - for(; iter != iter_end; ++iter) - { - f << iter.row(); f.put(' '); - f << iter.col(); f.put(' '); - - const eT val = (*iter); - - const T val_r = std::real(val); - const T val_i = std::imag(val); - - const bool val_r_is_real_int = (is_real::yes) && arma_isfinite(val_r) && (val_r > T_int_lowest) && (val_r < T_int_max) && (T(int(val_r)) == val_r); - const bool val_i_is_real_int = (is_real::yes) && arma_isfinite(val_i) && (val_i > T_int_lowest) && (val_i < T_int_max) && (T(int(val_i)) == val_i); - - (val_r_is_real_int) ? arma_ostream::raw_print_elem(f, int(val_r)) : arma_ostream::raw_print_elem(f, val_r); - - f.put(' '); - - (val_i_is_real_int) ? arma_ostream::raw_print_elem(f, int(val_i)) : arma_ostream::raw_print_elem(f, val_i); - - f.put('\n'); - } - - // make sure it's possible to determine the matrix size - if( (x.n_rows > 0) && (x.n_cols > 0) ) - { - const uword max_row = (x.n_rows > 0) ? x.n_rows-1 : 0; - const uword max_col = (x.n_cols > 0) ? x.n_cols-1 : 0; - - if( x.at(max_row, max_col) == eT(0) ) - { - f << max_row << ' ' << max_col << " 0 0\n"; - } - } - - const bool save_okay = f.good(); - - stream_state.restore(f); - - return save_okay; - } - - - -//! Save a matrix in binary format, -//! with a header that stores the matrix type as well as its dimensions -template -inline -bool -diskio::save_arma_binary(const SpMat& x, const std::string& final_name) - { - arma_debug_sigprint(); - - const std::string tmp_name = diskio::gen_tmp_name(final_name); - - std::ofstream f(tmp_name, std::fstream::binary); - - bool save_okay = f.is_open(); - - if(save_okay) - { - save_okay = diskio::save_arma_binary(x, f); - - f.flush(); - f.close(); - - if(save_okay) { save_okay = diskio::safe_rename(tmp_name, final_name); } - } - - return save_okay; - } - - - -//! Save a matrix in binary format, -//! with a header that stores the matrix type as well as its dimensions -template -inline -bool -diskio::save_arma_binary(const SpMat& x, std::ostream& f) - { - arma_debug_sigprint(); - - f << diskio::gen_bin_header(x) << '\n'; - f << x.n_rows << ' ' << x.n_cols << ' ' << x.n_nonzero << '\n'; - - f.write( reinterpret_cast(x.values), std::streamsize(x.n_nonzero*sizeof(eT)) ); - f.write( reinterpret_cast(x.row_indices), std::streamsize(x.n_nonzero*sizeof(uword)) ); - f.write( reinterpret_cast(x.col_ptrs), std::streamsize((x.n_cols+1)*sizeof(uword)) ); - - return f.good(); - } - - - -template -inline -bool -diskio::load_csv_ascii(SpMat& x, const std::string& name, std::string& err_msg, field& header, const bool with_header, const char separator) - { - arma_debug_sigprint(); - - std::ifstream f; - - (arma_config::text_as_binary) ? f.open(name, std::fstream::binary) : f.open(name); - - bool load_okay = f.is_open(); - - if(load_okay == false) { return false; } - - if(with_header) - { - arma_debug_print("diskio::load_csv_ascii(): reading header"); - - std::string header_line; - std::stringstream header_stream; - std::vector header_tokens; - - std::getline(f, header_line); - - load_okay = f.good(); - - if(load_okay) - { - std::string token; - - header_stream.clear(); - header_stream.str(header_line); - - uword header_n_tokens = 0; - - while(header_stream.good()) - { - std::getline(header_stream, token, separator); - - diskio::sanitise_token(token); - - ++header_n_tokens; - - header_tokens.push_back(token); - } - - if(header_n_tokens == uword(0)) - { - header.reset(); - } - else - { - header.set_size(1,header_n_tokens); - - for(uword i=0; i < header_n_tokens; ++i) { header.at(i) = header_tokens[i]; } - } - } - } - - if(load_okay) - { - load_okay = diskio::load_csv_ascii(x, f, err_msg, separator); - } - - f.close(); - - return load_okay; - } - - - -template -inline -bool -diskio::load_csv_ascii(SpMat& x, std::istream& f, std::string& err_msg, const char separator) - { - arma_debug_sigprint(); - - // TODO: replace with more efficient implementation - - if(f.good() == false) { return false; } - - f.clear(); - const std::fstream::pos_type pos1 = f.tellg(); - - // - // work out the size - - uword f_n_rows = 0; - uword f_n_cols = 0; - - std::string line_string; - std::stringstream line_stream; - - std::string token; - - while(f.good()) - { - std::getline(f, line_string); - - if(line_string.size() == 0) { break; } - - line_stream.clear(); - line_stream.str(line_string); - - uword line_n_cols = 0; - - while(line_stream.good()) - { - std::getline(line_stream, token, separator); - ++line_n_cols; - } - - if(f_n_cols < line_n_cols) { f_n_cols = line_n_cols; } - - ++f_n_rows; - } - - f.clear(); - f.seekg(pos1); - - if(f.fail() || (f.tellg() != pos1)) { err_msg = "seek failure"; return false; } - - try - { - MapMat tmp(f_n_rows, f_n_cols); - - uword row = 0; - - while(f.good()) - { - std::getline(f, line_string); - - if(line_string.size() == 0) { break; } - - line_stream.clear(); - line_stream.str(line_string); - - uword col = 0; - - while(line_stream.good()) - { - std::getline(line_stream, token, separator); - - eT val = eT(0); - - diskio::convert_token( val, token ); - - if(val != eT(0)) { tmp(row,col) = val; } - - ++col; - } - - ++row; - } - - x = tmp; - } - catch(...) - { - err_msg = "not enough memory"; - return false; - } - - return true; - } - - - -template -inline -bool -diskio::load_csv_ascii(SpMat< std::complex >& x, std::istream& f, std::string& err_msg, const char separator) - { - arma_debug_sigprint(); - - arma_ignore(x); - arma_ignore(f); - arma_ignore(err_msg); - arma_ignore(separator); - - arma_warn(1, "loading complex sparse matrices as csv_ascii not yet implemented"); - - return false; - } - - - -template -inline -bool -diskio::load_coord_ascii(SpMat& x, const std::string& name, std::string& err_msg) - { - arma_debug_sigprint(); - - std::ifstream f; - - (arma_config::text_as_binary) ? f.open(name, std::fstream::binary) : f.open(name); - - bool load_okay = f.is_open(); - - if(load_okay) - { - load_okay = diskio::load_coord_ascii(x, f, err_msg); - f.close(); - } - - return load_okay; - } - - - -template -inline -bool -diskio::load_coord_ascii(SpMat& x, std::istream& f, std::string& err_msg) - { - arma_debug_sigprint(); - - if(f.good() == false) { return false; } - - f.clear(); - const std::fstream::pos_type pos1 = f.tellg(); - - // work out the size - - uword f_n_rows = 0; - uword f_n_cols = 0; - - bool size_found = false; - - std::string line_string; - std::stringstream line_stream; - - std::string token; - - while(f.good()) - { - std::getline(f, line_string); - - if(line_string.size() == 0) { break; } - - line_stream.clear(); - line_stream.str(line_string); - - uword line_row = 0; - uword line_col = 0; - - // a valid line in co-ord format has at least 2 entries - - line_stream >> line_row; - - if(line_stream.good() == false) { err_msg = "incorrect format"; return false; } - - line_stream >> line_col; - - size_found = true; - - if(f_n_rows < line_row) { f_n_rows = line_row; } - if(f_n_cols < line_col) { f_n_cols = line_col; } - } - - // take into account that indices start at 0 - if(size_found) { ++f_n_rows; ++f_n_cols; } - - f.clear(); - f.seekg(pos1); - - if(f.fail() || (f.tellg() != pos1)) { err_msg = "seek failure"; return false; } - - try - { - MapMat tmp(f_n_rows, f_n_cols); - - while(f.good()) - { - std::getline(f, line_string); - - if(line_string.size() == 0) { break; } - - line_stream.clear(); - line_stream.str(line_string); - - uword line_row = 0; - uword line_col = 0; - - line_stream >> line_row; - line_stream >> line_col; - - eT val = eT(0); - - line_stream >> token; - - if(line_stream.fail() == false) { diskio::convert_token( val, token ); } - - if(val != eT(0)) { tmp(line_row,line_col) = val; } - } - - x = tmp; - } - catch(...) - { - err_msg = "not enough memory"; - return false; - } - - return true; - } - - - -template -inline -bool -diskio::load_coord_ascii(SpMat< std::complex >& x, std::istream& f, std::string& err_msg) - { - arma_debug_sigprint(); - - if(f.good() == false) { return false; } - - f.clear(); - const std::fstream::pos_type pos1 = f.tellg(); - - // work out the size - - uword f_n_rows = 0; - uword f_n_cols = 0; - - bool size_found = false; - - std::string line_string; - std::stringstream line_stream; - - std::string token_real; - std::string token_imag; - - while(f.good()) - { - std::getline(f, line_string); - - if(line_string.size() == 0) { break; } - - line_stream.clear(); - line_stream.str(line_string); - - uword line_row = 0; - uword line_col = 0; - - // a valid line in co-ord format has at least 2 entries - - line_stream >> line_row; - - if(line_stream.good() == false) { err_msg = "incorrect format"; return false; } - - line_stream >> line_col; - - size_found = true; - - if(f_n_rows < line_row) f_n_rows = line_row; - if(f_n_cols < line_col) f_n_cols = line_col; - } - - // take into account that indices start at 0 - if(size_found) { ++f_n_rows; ++f_n_cols; } - - f.clear(); - f.seekg(pos1); - - if(f.fail() || (f.tellg() != pos1)) { err_msg = "seek failure"; return false; } - - try - { - MapMat< std::complex > tmp(f_n_rows, f_n_cols); - - while(f.good()) - { - std::getline(f, line_string); - - if(line_string.size() == 0) { break; } - - line_stream.clear(); - line_stream.str(line_string); - - uword line_row = 0; - uword line_col = 0; - - line_stream >> line_row; - line_stream >> line_col; - - T val_real = T(0); - T val_imag = T(0); - - line_stream >> token_real; - - if(line_stream.fail() == false) { diskio::convert_token( val_real, token_real ); } - - line_stream >> token_imag; - - if(line_stream.fail() == false) { diskio::convert_token( val_imag, token_imag ); } - - if( (val_real != T(0)) || (val_imag != T(0)) ) - { - tmp(line_row,line_col) = std::complex(val_real, val_imag); - } - } - - x = tmp; - } - catch(...) - { - err_msg = "not enough memory"; - return false; - } - - return true; - } - - - -//! Load a matrix in binary format, -//! with a header that indicates the matrix type as well as its dimensions -template -inline -bool -diskio::load_arma_binary(SpMat& x, const std::string& name, std::string& err_msg) - { - arma_debug_sigprint(); - - std::ifstream f; - f.open(name, std::fstream::binary); - - bool load_okay = f.is_open(); - - if(load_okay) - { - load_okay = diskio::load_arma_binary(x, f, err_msg); - f.close(); - } - - return load_okay; - } - - - -template -inline -bool -diskio::load_arma_binary(SpMat& x, std::istream& f, std::string& err_msg) - { - arma_debug_sigprint(); - - bool load_okay = true; - - std::string f_header; - - f >> f_header; - - if(f_header == diskio::gen_bin_header(x)) - { - uword f_n_rows; - uword f_n_cols; - uword f_n_nz; - - f >> f_n_rows; - f >> f_n_cols; - f >> f_n_nz; - - //f.seekg(1, ios::cur); // NOTE: this may not be portable, as on a Windows machine a newline could be two characters - f.get(); - - try { x.reserve(f_n_rows, f_n_cols, f_n_nz); } catch(...) { err_msg = "not enough memory"; return false; } - - f.read( reinterpret_cast(access::rwp(x.values)), std::streamsize(x.n_nonzero*sizeof(eT)) ); - - std::streampos pos = f.tellg(); - - f.read( reinterpret_cast(access::rwp(x.row_indices)), std::streamsize(x.n_nonzero*sizeof(uword)) ); - f.read( reinterpret_cast(access::rwp(x.col_ptrs)), std::streamsize((x.n_cols+1)*sizeof(uword)) ); - - bool check1 = true; for(uword i=0; i < x.n_nonzero; ++i) { if(x.values[i] == eT(0)) { check1 = false; break; } } - bool check2 = true; for(uword i=0; i < x.n_cols; ++i) { if(x.col_ptrs[i+1] < x.col_ptrs[i]) { check2 = false; break; } } - bool check3 = (x.col_ptrs[x.n_cols] == x.n_nonzero); - - if((check1 == true) && ((check2 == false) || (check3 == false))) - { - if(sizeof(uword) == 8) - { - arma_debug_print("detected inconsistent data while loading; re-reading integer parts as u32"); - - // inconstency could be due to a different uword size used during saving, - // so try loading the row_indices and col_ptrs under the assumption of 32 bit unsigned integers - - f.clear(); - f.seekg(pos); - - podarray tmp_a(x.n_nonzero ); tmp_a.zeros(); - podarray tmp_b(x.n_cols + 1); tmp_b.zeros(); - - f.read( reinterpret_cast(tmp_a.memptr()), std::streamsize( x.n_nonzero * sizeof(u32)) ); - f.read( reinterpret_cast(tmp_b.memptr()), std::streamsize((x.n_cols + 1) * sizeof(u32)) ); - - check2 = true; for(uword i=0; i < x.n_cols; ++i) { if(tmp_b[i+1] < tmp_b[i]) { check2 = false; break; } } - check3 = (tmp_b[x.n_cols] == x.n_nonzero); - - load_okay = f.good(); - - if( load_okay && (check2 == true) && (check3 == true) ) - { - arma_debug_print("reading integer parts as u32 succeeded"); - - arrayops::convert(access::rwp(x.row_indices), tmp_a.memptr(), x.n_nonzero ); - arrayops::convert(access::rwp(x.col_ptrs), tmp_b.memptr(), x.n_cols + 1); - } - else - { - arma_debug_print("reading integer parts as u32 failed"); - } - } - } - - if((check1 == false) || (check2 == false) || (check3 == false)) - { - load_okay = false; - err_msg = "inconsistent data"; - } - else - { - load_okay = f.good(); - } - } - else - { - load_okay = false; - err_msg = "incorrect header"; - } - - return load_okay; - } - - - -// cubes - - - -//! Save a cube as raw text (no header, human readable). -template -inline -bool -diskio::save_raw_ascii(const Cube& x, const std::string& final_name) - { - arma_debug_sigprint(); - - const std::string tmp_name = diskio::gen_tmp_name(final_name); - - std::ofstream f; - - (arma_config::text_as_binary) ? f.open(tmp_name, std::fstream::binary) : f.open(tmp_name); - - bool save_okay = f.is_open(); - - if(save_okay) - { - save_okay = save_raw_ascii(x, f); - - f.flush(); - f.close(); - - if(save_okay) { save_okay = diskio::safe_rename(tmp_name, final_name); } - } - - return save_okay; - } - - - -//! Save a cube as raw text (no header, human readable). -template -inline -bool -diskio::save_raw_ascii(const Cube& x, std::ostream& f) - { - arma_debug_sigprint(); - - const arma_ostream_state stream_state(f); - - const std::streamsize cell_width = diskio::prepare_stream(f); - - for(uword slice=0; slice < x.n_slices; ++slice) - { - for(uword row=0; row < x.n_rows; ++row) - { - for(uword col=0; col < x.n_cols; ++col) - { - f.put(' '); - - if(is_real::value) { f.width(cell_width); } - - arma_ostream::raw_print_elem(f, x.at(row,col,slice)); - } - - f.put('\n'); - } - } - - const bool save_okay = f.good(); - - stream_state.restore(f); - - return save_okay; - } - - - -//! Save a cube as raw binary (no header) -template -inline -bool -diskio::save_raw_binary(const Cube& x, const std::string& final_name) - { - arma_debug_sigprint(); - - const std::string tmp_name = diskio::gen_tmp_name(final_name); - - std::ofstream f(tmp_name, std::fstream::binary); - - bool save_okay = f.is_open(); - - if(save_okay) - { - save_okay = diskio::save_raw_binary(x, f); - - f.flush(); - f.close(); - - if(save_okay) { save_okay = diskio::safe_rename(tmp_name, final_name); } - } - - return save_okay; - } - - - -template -inline -bool -diskio::save_raw_binary(const Cube& x, std::ostream& f) - { - arma_debug_sigprint(); - - f.write( reinterpret_cast(x.mem), std::streamsize(x.n_elem*sizeof(eT)) ); - - return f.good(); - } - - - -//! Save a cube in text format (human readable), -//! with a header that indicates the cube type as well as its dimensions -template -inline -bool -diskio::save_arma_ascii(const Cube& x, const std::string& final_name) - { - arma_debug_sigprint(); - - const std::string tmp_name = diskio::gen_tmp_name(final_name); - - std::ofstream f; - - (arma_config::text_as_binary) ? f.open(tmp_name, std::fstream::binary) : f.open(tmp_name); - - bool save_okay = f.is_open(); - - if(save_okay) - { - save_okay = diskio::save_arma_ascii(x, f); - - f.flush(); - f.close(); - - if(save_okay) { save_okay = diskio::safe_rename(tmp_name, final_name); } - } - - return save_okay; - } - - - -//! Save a cube in text format (human readable), -//! with a header that indicates the cube type as well as its dimensions -template -inline -bool -diskio::save_arma_ascii(const Cube& x, std::ostream& f) - { - arma_debug_sigprint(); - - const arma_ostream_state stream_state(f); - - f << diskio::gen_txt_header(x) << '\n'; - f << x.n_rows << ' ' << x.n_cols << ' ' << x.n_slices << '\n'; - - const std::streamsize cell_width = diskio::prepare_stream(f); - - for(uword slice=0; slice < x.n_slices; ++slice) - { - for(uword row=0; row < x.n_rows; ++row) - { - for(uword col=0; col < x.n_cols; ++col) - { - f.put(' '); - - if(is_real::value) { f.width(cell_width); } - - arma_ostream::raw_print_elem(f, x.at(row,col,slice)); - } - - f.put('\n'); - } - } - - const bool save_okay = f.good(); - - stream_state.restore(f); - - return save_okay; - } - - - -//! Save a cube in binary format, -//! with a header that stores the cube type as well as its dimensions -template -inline -bool -diskio::save_arma_binary(const Cube& x, const std::string& final_name) - { - arma_debug_sigprint(); - - const std::string tmp_name = diskio::gen_tmp_name(final_name); - - std::ofstream f(tmp_name, std::fstream::binary); - - bool save_okay = f.is_open(); - - if(save_okay) - { - save_okay = diskio::save_arma_binary(x, f); - - f.flush(); - f.close(); - - if(save_okay) { save_okay = diskio::safe_rename(tmp_name, final_name); } - } - - return save_okay; - } - - - -//! Save a cube in binary format, -//! with a header that stores the cube type as well as its dimensions -template -inline -bool -diskio::save_arma_binary(const Cube& x, std::ostream& f) - { - arma_debug_sigprint(); - - f << diskio::gen_bin_header(x) << '\n'; - f << x.n_rows << ' ' << x.n_cols << ' ' << x.n_slices << '\n'; - - f.write( reinterpret_cast(x.mem), std::streamsize(x.n_elem*sizeof(eT)) ); - - return f.good(); - } - - - -//! Save a cube as part of a HDF5 file -template -inline -bool -diskio::save_hdf5_binary(const Cube& x, const hdf5_name& spec, std::string& err_msg) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_HDF5) - { - hdf5_misc::hdf5_suspend_printing_errors hdf5_print_suspender; - - bool save_okay = false; - - const bool append = bool(spec.opts.flags & hdf5_opts::flag_append); - const bool replace = bool(spec.opts.flags & hdf5_opts::flag_replace); - - const bool use_existing_file = ((append || replace) && (H5Fis_hdf5(spec.filename.c_str()) > 0)); - - const std::string tmp_name = (use_existing_file) ? std::string() : diskio::gen_tmp_name(spec.filename); - - // Set up the file according to HDF5's preferences - hid_t file = (use_existing_file) ? H5Fopen(spec.filename.c_str(), H5F_ACC_RDWR, H5P_DEFAULT) : H5Fcreate(tmp_name.c_str(), H5F_ACC_TRUNC, H5P_DEFAULT, H5P_DEFAULT); - - if(file < 0) { return false; } - - // We need to create a dataset, datatype, and dataspace - hsize_t dims[3]; - dims[2] = x.n_rows; - dims[1] = x.n_cols; - dims[0] = x.n_slices; - - hid_t dataspace = H5Screate_simple(3, dims, NULL); // treat the cube as a 3d array dataspace - hid_t datatype = hdf5_misc::get_hdf5_type(); - - // fail if we can't handle the datatype - if(datatype == -1) { err_msg = "unknown datatype for HDF5"; return false; } - - // MATLAB forces the users to specify a name at save time for HDF5; - // Octave will use the default of 'dataset' unless otherwise specified. - // If the user hasn't specified a dataset name, we will use 'dataset' - // We may have to split out the group name from the dataset name. - std::vector groups; - std::string full_name = spec.dsname; - size_t loc; - while((loc = full_name.find("/")) != std::string::npos) - { - // Create another group... - if(loc != 0) // Ignore the first /, if there is a leading /. - { - hid_t gid = H5Gcreate((groups.size() == 0) ? file : groups[groups.size() - 1], full_name.substr(0, loc).c_str(), H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); - - if((gid < 0) && use_existing_file) - { - gid = H5Gopen((groups.size() == 0) ? file : groups[groups.size() - 1], full_name.substr(0, loc).c_str(), H5P_DEFAULT); - } - - groups.push_back(gid); - } - - full_name = full_name.substr(loc + 1); - } - - const std::string dataset_name = full_name.empty() ? std::string("dataset") : full_name; - - const hid_t last_group = (groups.size() == 0) ? file : groups[groups.size() - 1]; - - if(use_existing_file && replace) - { - H5Ldelete(last_group, dataset_name.c_str(), H5P_DEFAULT); - // NOTE: H5Ldelete() in HDF5 v1.8 doesn't reclaim the deleted space; use h5repack to reclaim space: h5repack oldfile.h5 newfile.h5 - // NOTE: has this behaviour changed in HDF5 1.10 ? - // NOTE: https://lists.hdfgroup.org/pipermail/hdf-forum_lists.hdfgroup.org/2017-August/010482.html - // NOTE: https://lists.hdfgroup.org/pipermail/hdf-forum_lists.hdfgroup.org/2017-August/010486.html - } - - hid_t dataset = H5Dcreate(last_group, dataset_name.c_str(), datatype, dataspace, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); - - if(dataset < 0) - { - save_okay = false; - - err_msg = "failed to create dataset"; - } - else - { - save_okay = (H5Dwrite(dataset, datatype, H5S_ALL, H5S_ALL, H5P_DEFAULT, x.mem) >= 0); - - H5Dclose(dataset); - } - - H5Tclose(datatype); - H5Sclose(dataspace); - for(size_t i = 0; i < groups.size(); ++i) { H5Gclose(groups[i]); } - H5Fclose(file); - - if((use_existing_file == false) && (save_okay == true)) { save_okay = diskio::safe_rename(tmp_name, spec.filename); } - - return save_okay; - } - #else - { - arma_ignore(x); - arma_ignore(spec); - arma_ignore(err_msg); - - arma_stop_logic_error("Cube::save(): use of HDF5 must be enabled"); - - return false; - } - #endif - } - - - -//! Load a cube as raw text (no header, human readable). -//! NOTE: this is much slower than reading a file with a header. -template -inline -bool -diskio::load_raw_ascii(Cube& x, const std::string& name, std::string& err_msg) - { - arma_debug_sigprint(); - - Mat tmp; - const bool load_okay = diskio::load_raw_ascii(tmp, name, err_msg); - - if(load_okay) - { - if(tmp.is_empty() == false) - { - try { x.set_size(tmp.n_rows, tmp.n_cols, 1); } catch(...) { err_msg = "not enough memory"; return false; } - - x.slice(0) = tmp; - } - else - { - x.reset(); - } - } - - return load_okay; - } - - - -//! Load a cube as raw text (no header, human readable). -//! NOTE: this is much slower than reading a file with a header. -template -inline -bool -diskio::load_raw_ascii(Cube& x, std::istream& f, std::string& err_msg) - { - arma_debug_sigprint(); - - Mat tmp; - const bool load_okay = diskio::load_raw_ascii(tmp, f, err_msg); - - if(load_okay) - { - if(tmp.is_empty() == false) - { - try { x.set_size(tmp.n_rows, tmp.n_cols, 1); } catch(...) { err_msg = "not enough memory"; return false; } - - x.slice(0) = tmp; - } - else - { - x.reset(); - } - } - - return load_okay; - } - - - -//! Load a cube in binary format (no header); -//! the cube is assumed to have one slice with one column -template -inline -bool -diskio::load_raw_binary(Cube& x, const std::string& name, std::string& err_msg) - { - arma_debug_sigprint(); - - std::ifstream f; - f.open(name, std::fstream::binary); - - bool load_okay = f.is_open(); - - if(load_okay) - { - load_okay = diskio::load_raw_binary(x, f, err_msg); - f.close(); - } - - return load_okay; - } - - - -template -inline -bool -diskio::load_raw_binary(Cube& x, std::istream& f, std::string& err_msg) - { - arma_debug_sigprint(); - - f.clear(); - const std::streampos pos1 = f.tellg(); - - f.clear(); - f.seekg(0, ios::end); - - f.clear(); - const std::streampos pos2 = f.tellg(); - - const uword N = ( (pos1 >= 0) && (pos2 >= 0) ) ? uword(pos2 - pos1) : 0; - - f.clear(); - //f.seekg(0, ios::beg); - f.seekg(pos1); - - try { x.set_size(N / uword(sizeof(eT)), 1, 1); } catch(...) { err_msg = "not enough memory"; return false; } - - f.clear(); - f.read( reinterpret_cast(x.memptr()), std::streamsize(x.n_elem * uword(sizeof(eT))) ); - - return f.good(); - } - - - -//! Load a cube in text format (human readable), -//! with a header that indicates the cube type as well as its dimensions -template -inline -bool -diskio::load_arma_ascii(Cube& x, const std::string& name, std::string& err_msg) - { - arma_debug_sigprint(); - - std::ifstream f; - - (arma_config::text_as_binary) ? f.open(name, std::fstream::binary) : f.open(name); - - bool load_okay = f.is_open(); - - if(load_okay) - { - load_okay = diskio::load_arma_ascii(x, f, err_msg); - f.close(); - } - - return load_okay; - } - - - -//! Load a cube in text format (human readable), -//! with a header that indicates the cube type as well as its dimensions -template -inline -bool -diskio::load_arma_ascii(Cube& x, std::istream& f, std::string& err_msg) - { - arma_debug_sigprint(); - - std::streampos pos = f.tellg(); - - bool load_okay = true; - - std::string f_header; - uword f_n_rows; - uword f_n_cols; - uword f_n_slices; - - f >> f_header; - f >> f_n_rows; - f >> f_n_cols; - f >> f_n_slices; - - if(f_header == diskio::gen_txt_header(x)) - { - try { x.set_size(f_n_rows, f_n_cols, f_n_slices); } catch(...) { err_msg = "not enough memory"; return false; } - - for(uword slice = 0; slice < x.n_slices; ++slice) - for(uword row = 0; row < x.n_rows; ++row ) - for(uword col = 0; col < x.n_cols; ++col ) - { - f >> x.at(row,col,slice); - } - - load_okay = f.good(); - } - else - { - load_okay = false; - err_msg = "incorrect header"; - } - - - // allow automatic conversion of u32/s32 cubes into u64/s64 cubes - - if(load_okay == false) - { - if( (sizeof(eT) == 8) && is_same_type::yes ) - { - Cube tmp; - std::string junk; - - f.clear(); - f.seekg(pos); - - load_okay = diskio::load_arma_ascii(tmp, f, junk); - - if(load_okay) { x = conv_to< Cube >::from(tmp); } - } - else - if( (sizeof(eT) == 8) && is_same_type::yes ) - { - Cube tmp; - std::string junk; - - f.clear(); - f.seekg(pos); - - load_okay = diskio::load_arma_ascii(tmp, f, junk); - - if(load_okay) { x = conv_to< Cube >::from(tmp); } - } - } - - return load_okay; - } - - - -//! Load a cube in binary format, -//! with a header that indicates the cube type as well as its dimensions -template -inline -bool -diskio::load_arma_binary(Cube& x, const std::string& name, std::string& err_msg) - { - arma_debug_sigprint(); - - std::ifstream f; - f.open(name, std::fstream::binary); - - bool load_okay = f.is_open(); - - if(load_okay) - { - load_okay = diskio::load_arma_binary(x, f, err_msg); - f.close(); - } - - return load_okay; - } - - - -template -inline -bool -diskio::load_arma_binary(Cube& x, std::istream& f, std::string& err_msg) - { - arma_debug_sigprint(); - - std::streampos pos = f.tellg(); - - bool load_okay = true; - - std::string f_header; - uword f_n_rows; - uword f_n_cols; - uword f_n_slices; - - f >> f_header; - f >> f_n_rows; - f >> f_n_cols; - f >> f_n_slices; - - if(f_header == diskio::gen_bin_header(x)) - { - //f.seekg(1, ios::cur); // NOTE: this may not be portable, as on a Windows machine a newline could be two characters - f.get(); - - try { x.set_size(f_n_rows, f_n_cols, f_n_slices); } catch(...) { err_msg = "not enough memory"; return false; } - - f.read( reinterpret_cast(x.memptr()), std::streamsize(x.n_elem*sizeof(eT)) ); - - load_okay = f.good(); - } - else - { - load_okay = false; - err_msg = "incorrect header"; - } - - - // allow automatic conversion of u32/s32 cubes into u64/s64 cubes - - if(load_okay == false) - { - if( (sizeof(eT) == 8) && is_same_type::yes ) - { - Cube tmp; - std::string junk; - - f.clear(); - f.seekg(pos); - - load_okay = diskio::load_arma_binary(tmp, f, junk); - - if(load_okay) { x = conv_to< Cube >::from(tmp); } - } - else - if( (sizeof(eT) == 8) && is_same_type::yes ) - { - Cube tmp; - std::string junk; - - f.clear(); - f.seekg(pos); - - load_okay = diskio::load_arma_binary(tmp, f, junk); - - if(load_okay) { x = conv_to< Cube >::from(tmp); } - } - } - - return load_okay; - } - - - -//! Load a HDF5 file as a cube -template -inline -bool -diskio::load_hdf5_binary(Cube& x, const hdf5_name& spec, std::string& err_msg) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_HDF5) - { - if(diskio::is_readable(spec.filename) == false) { return false; } - - hdf5_misc::hdf5_suspend_printing_errors hdf5_print_suspender; - - bool load_okay = false; - - hid_t fid = H5Fopen(spec.filename.c_str(), H5F_ACC_RDONLY, H5P_DEFAULT); - - if(fid >= 0) - { - // MATLAB HDF5 dataset names are user-specified; - // Octave tends to store the datasets in a group, with the actual dataset being referred to as "value". - // If the user hasn't specified a dataset, we will search for "dataset" and "value", - // and if those are not found we will take the first dataset we do find. - - std::vector searchNames; - - const bool exact = (spec.dsname.empty() == false); - - if(exact) - { - searchNames.push_back(spec.dsname); - } - else - { - searchNames.push_back("dataset"); - searchNames.push_back("value" ); - } - - hid_t dataset = hdf5_misc::search_hdf5_file(searchNames, fid, 3, exact); - - if(dataset >= 0) - { - hid_t filespace = H5Dget_space(dataset); - - // This must be <= 3 due to our search rules. - const int ndims = H5Sget_simple_extent_ndims(filespace); - - hsize_t dims[3]; - const herr_t query_status = H5Sget_simple_extent_dims(filespace, dims, NULL); - - // arma_check(query_status < 0, "Cube::load(): cannot get size of HDF5 dataset"); - if(query_status < 0) - { - err_msg = "cannot get size of HDF5 dataset"; - - H5Sclose(filespace); - H5Dclose(dataset); - H5Fclose(fid); - - return false; - } - - if(ndims == 1) { dims[1] = 1; dims[2] = 1; } // Vector case; one row/colum, several slices - if(ndims == 2) { dims[2] = 1; } // Matrix case; one column, several rows/slices - - try { x.set_size(dims[2], dims[1], dims[0]); } catch(...) { err_msg = "not enough memory"; return false; } - - // Now we have to see what type is stored to figure out how to load it. - hid_t datatype = H5Dget_type(dataset); - hid_t mat_type = hdf5_misc::get_hdf5_type(); - - // If these are the same type, it is simple. - if(H5Tequal(datatype, mat_type) > 0) - { - // Load directly; H5S_ALL used so that we load the entire dataset. - hid_t read_status = H5Dread(dataset, datatype, H5S_ALL, H5S_ALL, H5P_DEFAULT, void_ptr(x.memptr())); - - if(read_status >= 0) { load_okay = true; } - } - else - { - // Load into another array and convert its type accordingly. - hid_t read_status = hdf5_misc::load_and_convert_hdf5(x.memptr(), dataset, datatype, x.n_elem); - - if(read_status >= 0) { load_okay = true; } - } - - // Now clean up. - H5Tclose(datatype); - H5Tclose(mat_type); - H5Sclose(filespace); - } - - H5Dclose(dataset); - - H5Fclose(fid); - - if(load_okay == false) - { - err_msg = "unsupported or missing HDF5 data"; - } - } - else - { - err_msg = "cannot open"; - } - - return load_okay; - } - #else - { - arma_ignore(x); - arma_ignore(spec); - arma_ignore(err_msg); - - arma_stop_logic_error("Cube::load(): use of HDF5 must be enabled"); - - return false; - } - #endif - } - - - -//! Try to load a cube by automatically determining its type -template -inline -bool -diskio::load_auto_detect(Cube& x, const std::string& name, std::string& err_msg) - { - arma_debug_sigprint(); - - if(diskio::is_readable(name) == false) { return false; } - - #if defined(ARMA_USE_HDF5) - // We're currently using the C bindings for the HDF5 library, which don't support C++ streams - if( H5Fis_hdf5(name.c_str()) ) { return load_hdf5_binary(x, name, err_msg); } - #endif - - std::fstream f; - f.open(name, std::fstream::in | std::fstream::binary); - - bool load_okay = f.is_open(); - - if(load_okay) - { - load_okay = diskio::load_auto_detect(x, f, err_msg); - f.close(); - } - - return load_okay; - } - - - -//! Try to load a cube by automatically determining its type -template -inline -bool -diskio::load_auto_detect(Cube& x, std::istream& f, std::string& err_msg) - { - arma_debug_sigprint(); - - const char* ARMA_CUB_TXT_str = "ARMA_CUB_TXT"; - const char* ARMA_CUB_BIN_str = "ARMA_CUB_BIN"; - const char* P6_str = "P6"; - - const uword ARMA_CUB_TXT_len = uword(12); - const uword ARMA_CUB_BIN_len = uword(12); - const uword P6_len = uword(2); - - podarray header(ARMA_CUB_TXT_len + 1); - - char* header_mem = header.memptr(); - - std::streampos pos = f.tellg(); - - f.read( header_mem, std::streamsize(ARMA_CUB_TXT_len) ); - f.clear(); - f.seekg(pos); - - header_mem[ARMA_CUB_TXT_len] = '\0'; - - if( std::strncmp(ARMA_CUB_TXT_str, header_mem, size_t(ARMA_CUB_TXT_len)) == 0 ) - { - return load_arma_ascii(x, f, err_msg); - } - else - if( std::strncmp(ARMA_CUB_BIN_str, header_mem, size_t(ARMA_CUB_BIN_len)) == 0 ) - { - return load_arma_binary(x, f, err_msg); - } - else - if( std::strncmp(P6_str, header_mem, size_t(P6_len)) == 0 ) - { - return load_ppm_binary(x, f, err_msg); - } - else - { - const file_type ft = guess_file_type_internal(f); - - switch(ft) - { - // case csv_ascii: - // return load_csv_ascii(x, f, err_msg); - // break; - - case raw_binary: - return load_raw_binary(x, f, err_msg); - break; - - case raw_ascii: - return load_raw_ascii(x, f, err_msg); - break; - - default: - err_msg = "unknown data"; - return false; - } - } - - return false; - } - - - - - -// fields - - - -template -inline -bool -diskio::save_arma_binary(const field& x, const std::string& final_name) - { - arma_debug_sigprint(); - - const std::string tmp_name = diskio::gen_tmp_name(final_name); - - std::ofstream f( tmp_name, std::fstream::binary ); - - bool save_okay = f.is_open(); - - if(save_okay) - { - save_okay = diskio::save_arma_binary(x, f); - - f.flush(); - f.close(); - - if(save_okay) { save_okay = diskio::safe_rename(tmp_name, final_name); } - } - - return save_okay; - } - - - -template -inline -bool -diskio::save_arma_binary(const field& x, std::ostream& f) - { - arma_debug_sigprint(); - - arma_type_check(( (is_Mat::value == false) && (is_Cube::value == false) )); - - if(x.n_slices <= 1) - { - f << "ARMA_FLD_BIN" << '\n'; - f << x.n_rows << '\n'; - f << x.n_cols << '\n'; - } - else - { - f << "ARMA_FL3_BIN" << '\n'; - f << x.n_rows << '\n'; - f << x.n_cols << '\n'; - f << x.n_slices << '\n'; - } - - bool save_okay = true; - - for(uword i=0; i -inline -bool -diskio::load_arma_binary(field& x, const std::string& name, std::string& err_msg) - { - arma_debug_sigprint(); - - std::ifstream f( name, std::fstream::binary ); - - bool load_okay = f.is_open(); - - if(load_okay) - { - load_okay = diskio::load_arma_binary(x, f, err_msg); - f.close(); - } - - return load_okay; - } - - - -template -inline -bool -diskio::load_arma_binary(field& x, std::istream& f, std::string& err_msg) - { - arma_debug_sigprint(); - - arma_type_check(( (is_Mat::value == false) && (is_Cube::value == false) )); - - bool load_okay = true; - - std::string f_type; - f >> f_type; - - if(f_type == "ARMA_FLD_BIN") - { - uword f_n_rows; - uword f_n_cols; - - f >> f_n_rows; - f >> f_n_cols; - - try { x.set_size(f_n_rows, f_n_cols); } catch(...) { err_msg = "not enough memory"; return false; } - - f.get(); - - for(uword i=0; i> f_n_rows; - f >> f_n_cols; - f >> f_n_slices; - - try { x.set_size(f_n_rows, f_n_cols, f_n_slices); } catch(...) { err_msg = "not enough memory"; return false; } - - f.get(); - - for(uword i=0; i& x, const std::string& final_name) - { - arma_debug_sigprint(); - - const std::string tmp_name = diskio::gen_tmp_name(final_name); - - std::ofstream f( tmp_name, std::fstream::binary ); - - bool save_okay = f.is_open(); - - if(save_okay) - { - save_okay = diskio::save_std_string(x, f); - - f.flush(); - f.close(); - - if(save_okay) { save_okay = diskio::safe_rename(tmp_name, final_name); } - } - - return save_okay; - } - - - -inline -bool -diskio::save_std_string(const field& x, std::ostream& f) - { - arma_debug_sigprint(); - - for(uword row=0; row& x, const std::string& name, std::string& err_msg) - { - arma_debug_sigprint(); - - std::ifstream f(name); - - bool load_okay = f.is_open(); - - if(load_okay) - { - load_okay = diskio::load_std_string(x, f, err_msg); - f.close(); - } - - return load_okay; - } - - - -inline -bool -diskio::load_std_string(field& x, std::istream& f, std::string& err_msg) - { - arma_debug_sigprint(); - - bool load_okay = true; - - // - // work out the size - - uword f_n_rows = 0; - uword f_n_cols = 0; - - bool f_n_cols_found = false; - - std::string line_string; - std::string token; - - while( f.good() && load_okay ) - { - std::getline(f, line_string); - - if(line_string.size() == 0) { break; } - - std::stringstream line_stream(line_string); - - uword line_n_cols = 0; - - while(line_stream >> token) { line_n_cols++; } - - if(f_n_cols_found == false) - { - f_n_cols = line_n_cols; - f_n_cols_found = true; - } - else - { - if(line_n_cols != f_n_cols) - { - load_okay = false; - err_msg = "inconsistent number of columns"; - } - } - - ++f_n_rows; - } - - if(load_okay) - { - f.clear(); - f.seekg(0, ios::beg); - //f.seekg(start); - - try { x.set_size(f_n_rows, f_n_cols); } catch(...) { err_msg = "not enough memory"; return false; } - - for(uword row=0; row < x.n_rows; ++row) - for(uword col=0; col < x.n_cols; ++col) - { - f >> x.at(row,col); - } - } - - if(f.good() == false) { load_okay = false; } - - return load_okay; - } - - - -//! Try to load a field by automatically determining its type -template -inline -bool -diskio::load_auto_detect(field& x, const std::string& name, std::string& err_msg) - { - arma_debug_sigprint(); - - std::fstream f; - f.open(name, std::fstream::in | std::fstream::binary); - - bool load_okay = f.is_open(); - - if(load_okay) - { - load_okay = diskio::load_auto_detect(x, f, err_msg); - f.close(); - } - - return load_okay; - } - - - -//! Try to load a field by automatically determining its type -template -inline -bool -diskio::load_auto_detect(field& x, std::istream& f, std::string& err_msg) - { - arma_debug_sigprint(); - - arma_type_check(( is_Mat::value == false )); - - static const std::string ARMA_FLD_BIN = "ARMA_FLD_BIN"; - static const std::string ARMA_FL3_BIN = "ARMA_FL3_BIN"; - static const std::string P6 = "P6"; - - podarray raw_header(uword(ARMA_FLD_BIN.length()) + 1); - - std::streampos pos = f.tellg(); - - f.read( raw_header.memptr(), std::streamsize(ARMA_FLD_BIN.length()) ); - - f.clear(); - f.seekg(pos); - - raw_header[uword(ARMA_FLD_BIN.length())] = '\0'; - - const std::string header = raw_header.mem; - - if(ARMA_FLD_BIN == header.substr(0, ARMA_FLD_BIN.length())) - { - return load_arma_binary(x, f, err_msg); - } - else - if(ARMA_FL3_BIN == header.substr(0, ARMA_FL3_BIN.length())) - { - return load_arma_binary(x, f, err_msg); - } - else - if(P6 == header.substr(0, P6.length())) - { - return load_ppm_binary(x, f, err_msg); - } - else - { - err_msg = "unsupported header"; - return false; - } - } - - - -// -// handling of PPM images by cubes - - -template -inline -bool -diskio::load_ppm_binary(Cube& x, const std::string& name, std::string& err_msg) - { - arma_debug_sigprint(); - - std::fstream f; - f.open(name, std::fstream::in | std::fstream::binary); - - bool load_okay = f.is_open(); - - if(load_okay) - { - load_okay = diskio::load_ppm_binary(x, f, err_msg); - f.close(); - } - - return load_okay; - } - - - -template -inline -bool -diskio::load_ppm_binary(Cube& x, std::istream& f, std::string& err_msg) - { - arma_debug_sigprint(); - - bool load_okay = true; - - std::string f_header; - - f >> f_header; - - if(f_header == "P6") - { - uword f_n_rows = 0; - uword f_n_cols = 0; - int f_maxval = 0; - - diskio::pnm_skip_comments(f); - - f >> f_n_cols; - diskio::pnm_skip_comments(f); - - f >> f_n_rows; - diskio::pnm_skip_comments(f); - - f >> f_maxval; - f.get(); - - if( (f_maxval > 0) && (f_maxval <= 65535) ) - { - try { x.set_size(f_n_rows, f_n_cols, 3); } catch(...) { err_msg = "not enough memory"; return false; } - - if(f_maxval <= 255) - { - const uword n_elem = 3*f_n_cols*f_n_rows; - podarray tmp(n_elem); - - f.read( reinterpret_cast(tmp.memptr()), std::streamsize(n_elem) ); - - uword i = 0; - - //cout << "f_n_cols = " << f_n_cols << endl; - //cout << "f_n_rows = " << f_n_rows << endl; - - for(uword row=0; row < f_n_rows; ++row) - for(uword col=0; col < f_n_cols; ++col) - { - x.at(row,col,0) = eT(tmp[i+0]); - x.at(row,col,1) = eT(tmp[i+1]); - x.at(row,col,2) = eT(tmp[i+2]); - i+=3; - } - } - else - { - const uword n_elem = 3*f_n_cols*f_n_rows; - podarray tmp(n_elem); - - f.read( reinterpret_cast(tmp.memptr()), std::streamsize(2*n_elem) ); - - uword i = 0; - - for(uword row=0; row < f_n_rows; ++row) - for(uword col=0; col < f_n_cols; ++col) - { - x.at(row,col,0) = eT(tmp[i+0]); - x.at(row,col,1) = eT(tmp[i+1]); - x.at(row,col,2) = eT(tmp[i+2]); - i+=3; - } - } - } - else - { - load_okay = false; - err_msg = "functionality unimplemented"; - } - - if(f.good() == false) { load_okay = false; } - } - else - { - load_okay = false; - err_msg = "unsupported header"; - } - - return load_okay; - } - - - -template -inline -bool -diskio::save_ppm_binary(const Cube& x, const std::string& final_name) - { - arma_debug_sigprint(); - - const std::string tmp_name = diskio::gen_tmp_name(final_name); - - std::ofstream f( tmp_name, std::fstream::binary ); - - bool save_okay = f.is_open(); - - if(save_okay) - { - save_okay = diskio::save_ppm_binary(x, f); - - f.flush(); - f.close(); - - if(save_okay) { save_okay = diskio::safe_rename(tmp_name, final_name); } - } - - return save_okay; - } - - - -template -inline -bool -diskio::save_ppm_binary(const Cube& x, std::ostream& f) - { - arma_debug_sigprint(); - - arma_conform_check( (x.n_slices != 3), "diskio::save_ppm_binary(): given cube must have exactly 3 slices" ); - - const uword n_elem = 3 * x.n_rows * x.n_cols; - podarray tmp(n_elem); - - uword i = 0; - for(uword row=0; row < x.n_rows; ++row) - { - for(uword col=0; col < x.n_cols; ++col) - { - tmp[i+0] = u8( access::tmp_real( x.at(row,col,0) ) ); - tmp[i+1] = u8( access::tmp_real( x.at(row,col,1) ) ); - tmp[i+2] = u8( access::tmp_real( x.at(row,col,2) ) ); - - i+=3; - } - } - - f << "P6" << '\n'; - f << x.n_cols << '\n'; - f << x.n_rows << '\n'; - f << 255 << '\n'; - - f.write( reinterpret_cast(tmp.mem), std::streamsize(n_elem) ); - - return f.good(); - } - - - -// -// handling of PPM images by fields - - - -template -inline -bool -diskio::load_ppm_binary(field& x, const std::string& name, std::string& err_msg) - { - arma_debug_sigprint(); - - std::fstream f; - f.open(name, std::fstream::in | std::fstream::binary); - - bool load_okay = f.is_open(); - - if(load_okay) - { - load_okay = diskio::load_ppm_binary(x, f, err_msg); - f.close(); - } - - return load_okay; - } - - - -template -inline -bool -diskio::load_ppm_binary(field& x, std::istream& f, std::string& err_msg) - { - arma_debug_sigprint(); - - arma_type_check(( is_Mat::value == false )); - typedef typename T1::elem_type eT; - - bool load_okay = true; - - std::string f_header; - - f >> f_header; - - if(f_header == "P6") - { - uword f_n_rows = 0; - uword f_n_cols = 0; - int f_maxval = 0; - - diskio::pnm_skip_comments(f); - - f >> f_n_cols; - diskio::pnm_skip_comments(f); - - f >> f_n_rows; - diskio::pnm_skip_comments(f); - - f >> f_maxval; - f.get(); - - if( (f_maxval > 0) && (f_maxval <= 65535) ) - { - x.set_size(3); - Mat& R = x(0); - Mat& G = x(1); - Mat& B = x(2); - - try { R.set_size(f_n_rows,f_n_cols); } catch(...) { err_msg = "not enough memory"; return false; } - try { G.set_size(f_n_rows,f_n_cols); } catch(...) { err_msg = "not enough memory"; return false; } - try { B.set_size(f_n_rows,f_n_cols); } catch(...) { err_msg = "not enough memory"; return false; } - - if(f_maxval <= 255) - { - const uword n_elem = 3*f_n_cols*f_n_rows; - podarray tmp(n_elem); - - f.read( reinterpret_cast(tmp.memptr()), std::streamsize(n_elem) ); - - uword i = 0; - - //cout << "f_n_cols = " << f_n_cols << endl; - //cout << "f_n_rows = " << f_n_rows << endl; - - - for(uword row=0; row < f_n_rows; ++row) - { - for(uword col=0; col < f_n_cols; ++col) - { - R.at(row,col) = eT(tmp[i+0]); - G.at(row,col) = eT(tmp[i+1]); - B.at(row,col) = eT(tmp[i+2]); - i+=3; - } - - } - } - else - { - const uword n_elem = 3*f_n_cols*f_n_rows; - podarray tmp(n_elem); - - f.read( reinterpret_cast(tmp.memptr()), std::streamsize(2*n_elem) ); - - uword i = 0; - - for(uword row=0; row < f_n_rows; ++row) - for(uword col=0; col < f_n_cols; ++col) - { - R.at(row,col) = eT(tmp[i+0]); - G.at(row,col) = eT(tmp[i+1]); - B.at(row,col) = eT(tmp[i+2]); - i+=3; - } - } - } - else - { - load_okay = false; - err_msg = "functionality unimplemented"; - } - - if(f.good() == false) { load_okay = false; } - } - else - { - load_okay = false; - err_msg = "unsupported header"; - } - - return load_okay; - } - - - -template -inline -bool -diskio::save_ppm_binary(const field& x, const std::string& final_name) - { - arma_debug_sigprint(); - - const std::string tmp_name = diskio::gen_tmp_name(final_name); - std::ofstream f( tmp_name, std::fstream::binary ); - - bool save_okay = f.is_open(); - - if(save_okay) - { - save_okay = diskio::save_ppm_binary(x, f); - - f.flush(); - f.close(); - - if(save_okay) { save_okay = diskio::safe_rename(tmp_name, final_name); } - } - - return save_okay; - } - - - -template -inline -bool -diskio::save_ppm_binary(const field& x, std::ostream& f) - { - arma_debug_sigprint(); - - arma_type_check(( is_Mat::value == false )); - - typedef typename T1::elem_type eT; - - arma_conform_check( (x.n_elem != 3), "diskio::save_ppm_binary(): given field must have exactly 3 matrices of equal size" ); - - bool same_size = true; - for(uword i=1; i<3; ++i) - { - if( (x(0).n_rows != x(i).n_rows) || (x(0).n_cols != x(i).n_cols) ) - { - same_size = false; - break; - } - } - - arma_conform_check( (same_size != true), "diskio::save_ppm_binary(): given field must have exactly 3 matrices of equal size" ); - - const Mat& R = x(0); - const Mat& G = x(1); - const Mat& B = x(2); - - f << "P6" << '\n'; - f << R.n_cols << '\n'; - f << R.n_rows << '\n'; - f << 255 << '\n'; - - const uword n_elem = 3 * R.n_rows * R.n_cols; - podarray tmp(n_elem); - - uword i = 0; - for(uword row=0; row < R.n_rows; ++row) - for(uword col=0; col < R.n_cols; ++col) - { - tmp[i+0] = u8( access::tmp_real( R.at(row,col) ) ); - tmp[i+1] = u8( access::tmp_real( G.at(row,col) ) ); - tmp[i+2] = u8( access::tmp_real( B.at(row,col) ) ); - - i+=3; - } - - f.write( reinterpret_cast(tmp.mem), std::streamsize(n_elem) ); - - return f.good(); - } - - - -//! @} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/distr_param.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/distr_param.hpp deleted file mode 100644 index 61f3c2346..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/distr_param.hpp +++ /dev/null @@ -1,91 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup distr_param -//! @{ - - - -class distr_param - { - public: - - const uword state; - - private: - - int a_int; - int b_int; - - double a_double; - double b_double; - - public: - - inline distr_param() - : state (0) - , a_int (0) - , b_int (0) - , a_double(0) - , b_double(0) - { - } - - - inline explicit distr_param(const int a, const int b) - : state (1) - , a_int (a) - , b_int (b) - , a_double(double(a)) - , b_double(double(b)) - { - } - - - inline explicit distr_param(const double a, const double b) - : state (2) - , a_int (int(a)) - , b_int (int(b)) - , a_double(a) - , b_double(b) - { - } - - - inline void get_int_vals(int& out_a, int& out_b) const - { - if(state == 0) { return; } - - out_a = a_int; - out_b = b_int; - } - - - inline void get_double_vals(double& out_a, double& out_b) const - { - if(state == 0) { return; } - - out_a = a_double; - out_b = b_double; - } - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eGlueCube_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eGlueCube_bones.hpp deleted file mode 100644 index 8c157d8f5..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eGlueCube_bones.hpp +++ /dev/null @@ -1,54 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup eGlueCube -//! @{ - - -template -class eGlueCube : public BaseCube< typename T1::elem_type, eGlueCube > - { - public: - - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool use_at = (ProxyCube::use_at || ProxyCube::use_at ); - static constexpr bool use_mp = (ProxyCube::use_mp || ProxyCube::use_mp ); - static constexpr bool has_subview = (ProxyCube::has_subview || ProxyCube::has_subview); - - arma_aligned const ProxyCube P1; - arma_aligned const ProxyCube P2; - - arma_inline ~eGlueCube(); - arma_inline eGlueCube(const T1& in_A, const T2& in_B); - - arma_inline uword get_n_rows() const; - arma_inline uword get_n_cols() const; - arma_inline uword get_n_elem_slice() const; - arma_inline uword get_n_slices() const; - arma_inline uword get_n_elem() const; - - arma_inline elem_type operator[] (const uword i) const; - arma_inline elem_type at (const uword row, const uword col, const uword slice) const; - arma_inline elem_type at_alt (const uword i) const; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eGlueCube_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eGlueCube_meat.hpp deleted file mode 100644 index 00a87439b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eGlueCube_meat.hpp +++ /dev/null @@ -1,153 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup eGlueCube -//! @{ - - - -template -arma_inline -eGlueCube::~eGlueCube() - { - arma_debug_sigprint(); - } - - - -template -arma_inline -eGlueCube::eGlueCube(const T1& in_A, const T2& in_B) - : P1(in_A) - , P2(in_B) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size - ( - P1.get_n_rows(), P1.get_n_cols(), P1.get_n_slices(), - P2.get_n_rows(), P2.get_n_cols(), P2.get_n_slices(), - eglue_type::text() - ); - } - - - -template -arma_inline -uword -eGlueCube::get_n_rows() const - { - return P1.get_n_rows(); - } - - - -template -arma_inline -uword -eGlueCube::get_n_cols() const - { - return P1.get_n_cols(); - } - - - -template -arma_inline -uword -eGlueCube::get_n_slices() const - { - return P1.get_n_slices(); - } - - - -template -arma_inline -uword -eGlueCube::get_n_elem_slice() const - { - return P1.get_n_elem_slice(); - } - - - -template -arma_inline -uword -eGlueCube::get_n_elem() const - { - return P1.get_n_elem(); - } - - - -template -arma_inline -typename T1::elem_type -eGlueCube::operator[] (const uword i) const - { - // the optimiser will keep only one return statement - - typedef typename T1::elem_type eT; - - if(is_same_type::yes) { return P1[i] + P2[i]; } - else if(is_same_type::yes) { return P1[i] - P2[i]; } - else if(is_same_type::yes) { return P1[i] / P2[i]; } - else if(is_same_type::yes) { return P1[i] * P2[i]; } - else return eT(0); - } - - -template -arma_inline -typename T1::elem_type -eGlueCube::at(const uword row, const uword col, const uword slice) const - { - // the optimiser will keep only one return statement - - typedef typename T1::elem_type eT; - - if(is_same_type::yes) { return P1.at(row,col,slice) + P2.at(row,col,slice); } - else if(is_same_type::yes) { return P1.at(row,col,slice) - P2.at(row,col,slice); } - else if(is_same_type::yes) { return P1.at(row,col,slice) / P2.at(row,col,slice); } - else if(is_same_type::yes) { return P1.at(row,col,slice) * P2.at(row,col,slice); } - else return eT(0); - } - - - -template -arma_inline -typename T1::elem_type -eGlueCube::at_alt(const uword i) const - { - // the optimiser will keep only one return statement - - typedef typename T1::elem_type eT; - - if(is_same_type::yes) { return P1.at_alt(i) + P2.at_alt(i); } - else if(is_same_type::yes) { return P1.at_alt(i) - P2.at_alt(i); } - else if(is_same_type::yes) { return P1.at_alt(i) / P2.at_alt(i); } - else if(is_same_type::yes) { return P1.at_alt(i) * P2.at_alt(i); } - else return eT(0); - } - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eGlue_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eGlue_bones.hpp deleted file mode 100644 index 097dc6cb8..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eGlue_bones.hpp +++ /dev/null @@ -1,58 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup eGlue -//! @{ - - -template -class eGlue : public Base< typename T1::elem_type, eGlue > - { - public: - - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef Proxy proxy1_type; - typedef Proxy proxy2_type; - - static constexpr bool use_at = (Proxy::use_at || Proxy::use_at ); - static constexpr bool use_mp = (Proxy::use_mp || Proxy::use_mp ); - static constexpr bool has_subview = (Proxy::has_subview || Proxy::has_subview); - - static constexpr bool is_col = (Proxy::is_col || Proxy::is_col ); - static constexpr bool is_row = (Proxy::is_row || Proxy::is_row ); - static constexpr bool is_xvec = (Proxy::is_xvec || Proxy::is_xvec); - - arma_aligned const Proxy P1; - arma_aligned const Proxy P2; - - arma_inline ~eGlue(); - arma_inline eGlue(const T1& in_A, const T2& in_B); - - arma_inline uword get_n_rows() const; - arma_inline uword get_n_cols() const; - arma_inline uword get_n_elem() const; - - arma_inline elem_type operator[] (const uword ii) const; - arma_inline elem_type at (const uword row, const uword col) const; - arma_inline elem_type at_alt (const uword ii) const; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eGlue_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eGlue_meat.hpp deleted file mode 100644 index 04eb6ba23..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eGlue_meat.hpp +++ /dev/null @@ -1,136 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup eGlue -//! @{ - - - -template -arma_inline -eGlue::~eGlue() - { - arma_debug_sigprint(); - } - - - -template -arma_inline -eGlue::eGlue(const T1& in_A, const T2& in_B) - : P1(in_A) - , P2(in_B) - { - arma_debug_sigprint(); - - // arma_conform_assert_same_size( P1, P2, eglue_type::text() ); - arma_conform_assert_same_size - ( - P1.get_n_rows(), P1.get_n_cols(), - P2.get_n_rows(), P2.get_n_cols(), - eglue_type::text() - ); - } - - - -template -arma_inline -uword -eGlue::get_n_rows() const - { - return is_row ? 1 : P1.get_n_rows(); - } - - - -template -arma_inline -uword -eGlue::get_n_cols() const - { - return is_col ? 1 : P1.get_n_cols(); - } - - - -template -arma_inline -uword -eGlue::get_n_elem() const - { - return P1.get_n_elem(); - } - - - -template -arma_inline -typename T1::elem_type -eGlue::operator[] (const uword ii) const - { - // the optimiser will keep only one return statement - - typedef typename T1::elem_type eT; - - if(is_same_type::yes) { return P1[ii] + P2[ii]; } - else if(is_same_type::yes) { return P1[ii] - P2[ii]; } - else if(is_same_type::yes) { return P1[ii] / P2[ii]; } - else if(is_same_type::yes) { return P1[ii] * P2[ii]; } - else return eT(0); - } - - - -template -arma_inline -typename T1::elem_type -eGlue::at(const uword row, const uword col) const - { - // the optimiser will keep only one return statement - - typedef typename T1::elem_type eT; - - if(is_same_type::yes) { return P1.at(row,col) + P2.at(row,col); } - else if(is_same_type::yes) { return P1.at(row,col) - P2.at(row,col); } - else if(is_same_type::yes) { return P1.at(row,col) / P2.at(row,col); } - else if(is_same_type::yes) { return P1.at(row,col) * P2.at(row,col); } - else return eT(0); - } - - - -template -arma_inline -typename T1::elem_type -eGlue::at_alt(const uword ii) const - { - // the optimiser will keep only one return statement - - typedef typename T1::elem_type eT; - - if(is_same_type::yes) { return P1.at_alt(ii) + P2.at_alt(ii); } - else if(is_same_type::yes) { return P1.at_alt(ii) - P2.at_alt(ii); } - else if(is_same_type::yes) { return P1.at_alt(ii) / P2.at_alt(ii); } - else if(is_same_type::yes) { return P1.at_alt(ii) * P2.at_alt(ii); } - else return eT(0); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eOpCube_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eOpCube_bones.hpp deleted file mode 100644 index b6bcaba45..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eOpCube_bones.hpp +++ /dev/null @@ -1,62 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup eOpCube -//! @{ - - - -template -class eOpCube : public BaseCube< typename T1::elem_type, eOpCube > - { - public: - - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool use_at = ProxyCube::use_at; - static constexpr bool use_mp = ProxyCube::use_mp || eop_type::use_mp; - static constexpr bool has_subview = ProxyCube::has_subview; - - arma_aligned const ProxyCube P; - arma_aligned elem_type aux; //!< storage of auxiliary data, user defined format - arma_aligned uword aux_uword_a; //!< storage of auxiliary data, uword format - arma_aligned uword aux_uword_b; //!< storage of auxiliary data, uword format - arma_aligned uword aux_uword_c; //!< storage of auxiliary data, uword format - - inline ~eOpCube(); - inline explicit eOpCube(const BaseCube& in_m); - inline eOpCube(const BaseCube& in_m, const elem_type in_aux); - inline eOpCube(const BaseCube& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b); - inline eOpCube(const BaseCube& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b, const uword in_aux_uword_c); - inline eOpCube(const BaseCube& in_m, const elem_type in_aux, const uword in_aux_uword_a, const uword in_aux_uword_b, const uword in_aux_uword_c); - - arma_inline uword get_n_rows() const; - arma_inline uword get_n_cols() const; - arma_inline uword get_n_elem_slice() const; - arma_inline uword get_n_slices() const; - arma_inline uword get_n_elem() const; - - arma_inline elem_type operator[] (const uword i) const; - arma_inline elem_type at (const uword row, const uword col, const uword slice) const; - arma_inline elem_type at_alt (const uword i) const; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eOpCube_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eOpCube_meat.hpp deleted file mode 100644 index 22443c1c2..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eOpCube_meat.hpp +++ /dev/null @@ -1,173 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup eOpCube -//! @{ - - - -template -inline -eOpCube::eOpCube(const BaseCube& in_m) - : P (in_m.get_ref()) - { - arma_debug_sigprint(); - } - - - -template -inline -eOpCube::eOpCube(const BaseCube& in_m, const typename T1::elem_type in_aux) - : P (in_m.get_ref()) - , aux (in_aux) - { - arma_debug_sigprint(); - } - - - -template -inline -eOpCube::eOpCube(const BaseCube& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b) - : P (in_m.get_ref()) - , aux_uword_a (in_aux_uword_a) - , aux_uword_b (in_aux_uword_b) - { - arma_debug_sigprint(); - } - - - -template -inline -eOpCube::eOpCube(const BaseCube& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b, const uword in_aux_uword_c) - : P (in_m.get_ref()) - , aux_uword_a (in_aux_uword_a) - , aux_uword_b (in_aux_uword_b) - , aux_uword_c (in_aux_uword_c) - { - arma_debug_sigprint(); - } - - - -template -inline -eOpCube::eOpCube(const BaseCube& in_m, const typename T1::elem_type in_aux, const uword in_aux_uword_a, const uword in_aux_uword_b, const uword in_aux_uword_c) - : P (in_m.get_ref()) - , aux (in_aux) - , aux_uword_a (in_aux_uword_a) - , aux_uword_b (in_aux_uword_b) - , aux_uword_c (in_aux_uword_c) - { - arma_debug_sigprint(); - } - - - -template -inline -eOpCube::~eOpCube() - { - arma_debug_sigprint(); - } - - - -template -arma_inline -uword -eOpCube::get_n_rows() const - { - return P.get_n_rows(); - } - - - -template -arma_inline -uword -eOpCube::get_n_cols() const - { - return P.get_n_cols(); - } - - - -template -arma_inline -uword -eOpCube::get_n_elem_slice() const - { - return P.get_n_elem_slice(); - } - - - -template -arma_inline -uword -eOpCube::get_n_slices() const - { - return P.get_n_slices(); - } - - - -template -arma_inline -uword -eOpCube::get_n_elem() const - { - return P.get_n_elem(); - } - - - -template -arma_inline -typename T1::elem_type -eOpCube::operator[] (const uword i) const - { - return eop_core::process(P[i], aux); - } - - - -template -arma_inline -typename T1::elem_type -eOpCube::at(const uword row, const uword col, const uword slice) const - { - return eop_core::process(P.at(row, col, slice), aux); - } - - - -template -arma_inline -typename T1::elem_type -eOpCube::at_alt(const uword i) const - { - return eop_core::process(P.at_alt(i), aux); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eOp_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eOp_bones.hpp deleted file mode 100644 index d32abddbd..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eOp_bones.hpp +++ /dev/null @@ -1,64 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup eOp -//! @{ - - - -template -class eOp : public Base< typename T1::elem_type, eOp > - { - public: - - typedef typename T1::elem_type elem_type; - typedef typename get_pod_type::result pod_type; - typedef Proxy proxy_type; - - static constexpr bool use_at = Proxy::use_at; - static constexpr bool use_mp = Proxy::use_mp || eop_type::use_mp; - static constexpr bool has_subview = Proxy::has_subview; - - static constexpr bool is_row = Proxy::is_row; - static constexpr bool is_col = Proxy::is_col; - static constexpr bool is_xvec = Proxy::is_xvec; - - arma_aligned const Proxy P; - - arma_aligned elem_type aux; //!< storage of auxiliary data, user defined format - arma_aligned uword aux_uword_a; //!< storage of auxiliary data, uword format - arma_aligned uword aux_uword_b; //!< storage of auxiliary data, uword format - - inline ~eOp(); - inline explicit eOp(const T1& in_m); - inline eOp(const T1& in_m, const elem_type in_aux); - inline eOp(const T1& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b); - inline eOp(const T1& in_m, const elem_type in_aux, const uword in_aux_uword_a, const uword in_aux_uword_b); - - arma_inline uword get_n_rows() const; - arma_inline uword get_n_cols() const; - arma_inline uword get_n_elem() const; - - arma_inline elem_type operator[] (const uword ii) const; - arma_inline elem_type at (const uword row, const uword col) const; - arma_inline elem_type at_alt (const uword ii) const; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eOp_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eOp_meat.hpp deleted file mode 100644 index 75dfec022..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eOp_meat.hpp +++ /dev/null @@ -1,151 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup eOp -//! @{ - - - -template -inline -eOp::eOp(const T1& in_m) - : P(in_m) - { - arma_debug_sigprint(); - } - - - -template -inline -eOp::eOp(const T1& in_m, const typename T1::elem_type in_aux) - : P(in_m) - , aux(in_aux) - { - arma_debug_sigprint(); - } - - - -template -inline -eOp::eOp(const T1& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b) - : P(in_m) - , aux_uword_a(in_aux_uword_a) - , aux_uword_b(in_aux_uword_b) - { - arma_debug_sigprint(); - } - - - -template -inline -eOp::eOp(const T1& in_m, const typename T1::elem_type in_aux, const uword in_aux_uword_a, const uword in_aux_uword_b) - : P(in_m) - , aux(in_aux) - , aux_uword_a(in_aux_uword_a) - , aux_uword_b(in_aux_uword_b) - { - arma_debug_sigprint(); - } - - - -template -inline -eOp::~eOp() - { - arma_debug_sigprint(); - } - - - -template -arma_inline -uword -eOp::get_n_rows() const - { - return is_row ? 1 : P.get_n_rows(); - } - - - -template -arma_inline -uword -eOp::get_n_cols() const - { - return is_col ? 1 : P.get_n_cols(); - } - - - -template -arma_inline -uword -eOp::get_n_elem() const - { - return P.get_n_elem(); - } - - - -template -arma_inline -typename T1::elem_type -eOp::operator[] (const uword ii) const - { - return eop_core::process(P[ii], aux); - } - - - -template -arma_inline -typename T1::elem_type -eOp::at(const uword row, const uword col) const - { - if(is_row) - { - return eop_core::process(P.at(0, col), aux); - } - else - if(is_col) - { - return eop_core::process(P.at(row, 0), aux); - } - else - { - return eop_core::process(P.at(row, col), aux); - } - } - - - -template -arma_inline -typename T1::elem_type -eOp::at_alt(const uword ii) const - { - return eop_core::process(P.at_alt(ii), aux); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eglue_core_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eglue_core_bones.hpp deleted file mode 100644 index 67db24385..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eglue_core_bones.hpp +++ /dev/null @@ -1,86 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup eglue_core -//! @{ - - - -template -struct eglue_core - { - - // matrices - - template arma_hot inline static void apply(outT& out, const eGlue& x); - - template arma_hot inline static void apply_inplace_plus (Mat& out, const eGlue& x); - template arma_hot inline static void apply_inplace_minus(Mat& out, const eGlue& x); - template arma_hot inline static void apply_inplace_schur(Mat& out, const eGlue& x); - template arma_hot inline static void apply_inplace_div (Mat& out, const eGlue& x); - - - // cubes - - template arma_hot inline static void apply(Cube& out, const eGlueCube& x); - - template arma_hot inline static void apply_inplace_plus (Cube& out, const eGlueCube& x); - template arma_hot inline static void apply_inplace_minus(Cube& out, const eGlueCube& x); - template arma_hot inline static void apply_inplace_schur(Cube& out, const eGlueCube& x); - template arma_hot inline static void apply_inplace_div (Cube& out, const eGlueCube& x); - }; - - - -class eglue_plus : public eglue_core - { - public: - - inline static const char* text() { return "addition"; } - }; - - - -class eglue_minus : public eglue_core - { - public: - - inline static const char* text() { return "subtraction"; } - }; - - - -class eglue_div : public eglue_core - { - public: - - inline static const char* text() { return "element-wise division"; } - }; - - - -class eglue_schur : public eglue_core - { - public: - - inline static const char* text() { return "element-wise multiplication"; } - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eglue_core_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eglue_core_meat.hpp deleted file mode 100644 index bc81b85cc..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eglue_core_meat.hpp +++ /dev/null @@ -1,1250 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup eglue_core -//! @{ - - - -#undef arma_applier_1u -#undef arma_applier_1a -#undef arma_applier_2 -#undef arma_applier_3 -#undef operatorA -#undef operatorB - -#undef arma_applier_1_mp -#undef arma_applier_2_mp -#undef arma_applier_3_mp - - -#if defined(ARMA_SIMPLE_LOOPS) - #define arma_applier_1u(operatorA, operatorB) \ - {\ - for(uword i=0; i -template -inline -void -eglue_core::apply(outT& out, const eGlue& x) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - constexpr bool use_at = (Proxy::use_at || Proxy::use_at); - constexpr bool use_mp = (Proxy::use_mp || Proxy::use_mp) && (arma_config::openmp); - - // NOTE: we're assuming that the matrix has already been set to the correct size and there is no aliasing; - // size setting and alias checking is done by either the Mat contructor or operator=() - - - eT* out_mem = out.memptr(); - - if(use_at == false) - { - const uword n_elem = x.get_n_elem(); - - if(use_mp && mp_gate::use_mp && Proxy::use_mp)>::eval(n_elem)) - { - typename Proxy::ea_type P1 = x.P1.get_ea(); - typename Proxy::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1_mp(=, +); } - else if(is_same_type::yes) { arma_applier_1_mp(=, -); } - else if(is_same_type::yes) { arma_applier_1_mp(=, /); } - else if(is_same_type::yes) { arma_applier_1_mp(=, *); } - } - else - { - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - if(x.P1.is_aligned() && x.P2.is_aligned()) - { - typename Proxy::aligned_ea_type P1 = x.P1.get_aligned_ea(); - typename Proxy::aligned_ea_type P2 = x.P2.get_aligned_ea(); - - if(is_same_type::yes) { arma_applier_1a(=, +); } - else if(is_same_type::yes) { arma_applier_1a(=, -); } - else if(is_same_type::yes) { arma_applier_1a(=, /); } - else if(is_same_type::yes) { arma_applier_1a(=, *); } - } - else - { - typename Proxy::ea_type P1 = x.P1.get_ea(); - typename Proxy::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1u(=, +); } - else if(is_same_type::yes) { arma_applier_1u(=, -); } - else if(is_same_type::yes) { arma_applier_1u(=, /); } - else if(is_same_type::yes) { arma_applier_1u(=, *); } - } - } - else - { - typename Proxy::ea_type P1 = x.P1.get_ea(); - typename Proxy::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1u(=, +); } - else if(is_same_type::yes) { arma_applier_1u(=, -); } - else if(is_same_type::yes) { arma_applier_1u(=, /); } - else if(is_same_type::yes) { arma_applier_1u(=, *); } - } - } - } - else - { - const uword n_rows = x.get_n_rows(); - const uword n_cols = x.get_n_cols(); - - const Proxy& P1 = x.P1; - const Proxy& P2 = x.P2; - - if(use_mp && mp_gate::use_mp && Proxy::use_mp)>::eval(x.get_n_elem())) - { - if(is_same_type::yes) { arma_applier_2_mp(=, +); } - else if(is_same_type::yes) { arma_applier_2_mp(=, -); } - else if(is_same_type::yes) { arma_applier_2_mp(=, /); } - else if(is_same_type::yes) { arma_applier_2_mp(=, *); } - } - else - { - if(is_same_type::yes) { arma_applier_2(=, +); } - else if(is_same_type::yes) { arma_applier_2(=, -); } - else if(is_same_type::yes) { arma_applier_2(=, /); } - else if(is_same_type::yes) { arma_applier_2(=, *); } - } - } - } - - - -template -template -inline -void -eglue_core::apply_inplace_plus(Mat& out, const eGlue& x) - { - arma_debug_sigprint(); - - const uword n_rows = x.get_n_rows(); - const uword n_cols = x.get_n_cols(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, n_rows, n_cols, "addition"); - - typedef typename T1::elem_type eT; - - eT* out_mem = out.memptr(); - - constexpr bool use_at = (Proxy::use_at || Proxy::use_at); - constexpr bool use_mp = (Proxy::use_mp || Proxy::use_mp) && (arma_config::openmp); - - if(use_at == false) - { - const uword n_elem = x.get_n_elem(); - - if(use_mp && mp_gate::use_mp && Proxy::use_mp)>::eval(n_elem)) - { - typename Proxy::ea_type P1 = x.P1.get_ea(); - typename Proxy::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1_mp(+=, +); } - else if(is_same_type::yes) { arma_applier_1_mp(+=, -); } - else if(is_same_type::yes) { arma_applier_1_mp(+=, /); } - else if(is_same_type::yes) { arma_applier_1_mp(+=, *); } - } - else - { - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - if(x.P1.is_aligned() && x.P2.is_aligned()) - { - typename Proxy::aligned_ea_type P1 = x.P1.get_aligned_ea(); - typename Proxy::aligned_ea_type P2 = x.P2.get_aligned_ea(); - - if(is_same_type::yes) { arma_applier_1a(+=, +); } - else if(is_same_type::yes) { arma_applier_1a(+=, -); } - else if(is_same_type::yes) { arma_applier_1a(+=, /); } - else if(is_same_type::yes) { arma_applier_1a(+=, *); } - } - else - { - typename Proxy::ea_type P1 = x.P1.get_ea(); - typename Proxy::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1u(+=, +); } - else if(is_same_type::yes) { arma_applier_1u(+=, -); } - else if(is_same_type::yes) { arma_applier_1u(+=, /); } - else if(is_same_type::yes) { arma_applier_1u(+=, *); } - } - } - else - { - typename Proxy::ea_type P1 = x.P1.get_ea(); - typename Proxy::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1u(+=, +); } - else if(is_same_type::yes) { arma_applier_1u(+=, -); } - else if(is_same_type::yes) { arma_applier_1u(+=, /); } - else if(is_same_type::yes) { arma_applier_1u(+=, *); } - } - } - } - else - { - const Proxy& P1 = x.P1; - const Proxy& P2 = x.P2; - - if(use_mp && mp_gate::use_mp && Proxy::use_mp)>::eval(x.get_n_elem())) - { - if(is_same_type::yes) { arma_applier_2_mp(+=, +); } - else if(is_same_type::yes) { arma_applier_2_mp(+=, -); } - else if(is_same_type::yes) { arma_applier_2_mp(+=, /); } - else if(is_same_type::yes) { arma_applier_2_mp(+=, *); } - } - else - { - if(is_same_type::yes) { arma_applier_2(+=, +); } - else if(is_same_type::yes) { arma_applier_2(+=, -); } - else if(is_same_type::yes) { arma_applier_2(+=, /); } - else if(is_same_type::yes) { arma_applier_2(+=, *); } - } - } - } - - - -template -template -inline -void -eglue_core::apply_inplace_minus(Mat& out, const eGlue& x) - { - arma_debug_sigprint(); - - const uword n_rows = x.get_n_rows(); - const uword n_cols = x.get_n_cols(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, n_rows, n_cols, "subtraction"); - - typedef typename T1::elem_type eT; - - eT* out_mem = out.memptr(); - - constexpr bool use_at = (Proxy::use_at || Proxy::use_at); - constexpr bool use_mp = (Proxy::use_mp || Proxy::use_mp) && (arma_config::openmp); - - if(use_at == false) - { - const uword n_elem = x.get_n_elem(); - - if(use_mp && mp_gate::use_mp && Proxy::use_mp)>::eval(n_elem)) - { - typename Proxy::ea_type P1 = x.P1.get_ea(); - typename Proxy::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1_mp(-=, +); } - else if(is_same_type::yes) { arma_applier_1_mp(-=, -); } - else if(is_same_type::yes) { arma_applier_1_mp(-=, /); } - else if(is_same_type::yes) { arma_applier_1_mp(-=, *); } - } - else - { - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - if(x.P1.is_aligned() && x.P2.is_aligned()) - { - typename Proxy::aligned_ea_type P1 = x.P1.get_aligned_ea(); - typename Proxy::aligned_ea_type P2 = x.P2.get_aligned_ea(); - - if(is_same_type::yes) { arma_applier_1a(-=, +); } - else if(is_same_type::yes) { arma_applier_1a(-=, -); } - else if(is_same_type::yes) { arma_applier_1a(-=, /); } - else if(is_same_type::yes) { arma_applier_1a(-=, *); } - } - else - { - typename Proxy::ea_type P1 = x.P1.get_ea(); - typename Proxy::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1u(-=, +); } - else if(is_same_type::yes) { arma_applier_1u(-=, -); } - else if(is_same_type::yes) { arma_applier_1u(-=, /); } - else if(is_same_type::yes) { arma_applier_1u(-=, *); } - } - } - else - { - typename Proxy::ea_type P1 = x.P1.get_ea(); - typename Proxy::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1u(-=, +); } - else if(is_same_type::yes) { arma_applier_1u(-=, -); } - else if(is_same_type::yes) { arma_applier_1u(-=, /); } - else if(is_same_type::yes) { arma_applier_1u(-=, *); } - } - } - } - else - { - const Proxy& P1 = x.P1; - const Proxy& P2 = x.P2; - - if(use_mp && mp_gate::use_mp && Proxy::use_mp)>::eval(x.get_n_elem())) - { - if(is_same_type::yes) { arma_applier_2_mp(-=, +); } - else if(is_same_type::yes) { arma_applier_2_mp(-=, -); } - else if(is_same_type::yes) { arma_applier_2_mp(-=, /); } - else if(is_same_type::yes) { arma_applier_2_mp(-=, *); } - } - else - { - if(is_same_type::yes) { arma_applier_2(-=, +); } - else if(is_same_type::yes) { arma_applier_2(-=, -); } - else if(is_same_type::yes) { arma_applier_2(-=, /); } - else if(is_same_type::yes) { arma_applier_2(-=, *); } - } - } - } - - - -template -template -inline -void -eglue_core::apply_inplace_schur(Mat& out, const eGlue& x) - { - arma_debug_sigprint(); - - const uword n_rows = x.get_n_rows(); - const uword n_cols = x.get_n_cols(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, n_rows, n_cols, "element-wise multiplication"); - - typedef typename T1::elem_type eT; - - eT* out_mem = out.memptr(); - - constexpr bool use_at = (Proxy::use_at || Proxy::use_at); - constexpr bool use_mp = (Proxy::use_mp || Proxy::use_mp) && (arma_config::openmp); - - if(use_at == false) - { - const uword n_elem = x.get_n_elem(); - - if(use_mp && mp_gate::use_mp && Proxy::use_mp)>::eval(n_elem)) - { - typename Proxy::ea_type P1 = x.P1.get_ea(); - typename Proxy::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1_mp(*=, +); } - else if(is_same_type::yes) { arma_applier_1_mp(*=, -); } - else if(is_same_type::yes) { arma_applier_1_mp(*=, /); } - else if(is_same_type::yes) { arma_applier_1_mp(*=, *); } - } - else - { - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - if(x.P1.is_aligned() && x.P2.is_aligned()) - { - typename Proxy::aligned_ea_type P1 = x.P1.get_aligned_ea(); - typename Proxy::aligned_ea_type P2 = x.P2.get_aligned_ea(); - - if(is_same_type::yes) { arma_applier_1a(*=, +); } - else if(is_same_type::yes) { arma_applier_1a(*=, -); } - else if(is_same_type::yes) { arma_applier_1a(*=, /); } - else if(is_same_type::yes) { arma_applier_1a(*=, *); } - } - else - { - typename Proxy::ea_type P1 = x.P1.get_ea(); - typename Proxy::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1u(*=, +); } - else if(is_same_type::yes) { arma_applier_1u(*=, -); } - else if(is_same_type::yes) { arma_applier_1u(*=, /); } - else if(is_same_type::yes) { arma_applier_1u(*=, *); } - } - } - else - { - typename Proxy::ea_type P1 = x.P1.get_ea(); - typename Proxy::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1u(*=, +); } - else if(is_same_type::yes) { arma_applier_1u(*=, -); } - else if(is_same_type::yes) { arma_applier_1u(*=, /); } - else if(is_same_type::yes) { arma_applier_1u(*=, *); } - } - } - } - else - { - const Proxy& P1 = x.P1; - const Proxy& P2 = x.P2; - - if(use_mp && mp_gate::use_mp && Proxy::use_mp)>::eval(x.get_n_elem())) - { - if(is_same_type::yes) { arma_applier_2_mp(*=, +); } - else if(is_same_type::yes) { arma_applier_2_mp(*=, -); } - else if(is_same_type::yes) { arma_applier_2_mp(*=, /); } - else if(is_same_type::yes) { arma_applier_2_mp(*=, *); } - } - else - { - if(is_same_type::yes) { arma_applier_2(*=, +); } - else if(is_same_type::yes) { arma_applier_2(*=, -); } - else if(is_same_type::yes) { arma_applier_2(*=, /); } - else if(is_same_type::yes) { arma_applier_2(*=, *); } - } - } - } - - - -template -template -inline -void -eglue_core::apply_inplace_div(Mat& out, const eGlue& x) - { - arma_debug_sigprint(); - - const uword n_rows = x.get_n_rows(); - const uword n_cols = x.get_n_cols(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, n_rows, n_cols, "element-wise division"); - - typedef typename T1::elem_type eT; - - eT* out_mem = out.memptr(); - - constexpr bool use_at = (Proxy::use_at || Proxy::use_at); - constexpr bool use_mp = (Proxy::use_mp || Proxy::use_mp) && (arma_config::openmp); - - if(use_at == false) - { - const uword n_elem = x.get_n_elem(); - - if(use_mp && mp_gate::use_mp && Proxy::use_mp)>::eval(n_elem)) - { - typename Proxy::ea_type P1 = x.P1.get_ea(); - typename Proxy::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1_mp(/=, +); } - else if(is_same_type::yes) { arma_applier_1_mp(/=, -); } - else if(is_same_type::yes) { arma_applier_1_mp(/=, /); } - else if(is_same_type::yes) { arma_applier_1_mp(/=, *); } - } - else - { - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - if(x.P1.is_aligned() && x.P2.is_aligned()) - { - typename Proxy::aligned_ea_type P1 = x.P1.get_aligned_ea(); - typename Proxy::aligned_ea_type P2 = x.P2.get_aligned_ea(); - - if(is_same_type::yes) { arma_applier_1a(/=, +); } - else if(is_same_type::yes) { arma_applier_1a(/=, -); } - else if(is_same_type::yes) { arma_applier_1a(/=, /); } - else if(is_same_type::yes) { arma_applier_1a(/=, *); } - } - else - { - typename Proxy::ea_type P1 = x.P1.get_ea(); - typename Proxy::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1u(/=, +); } - else if(is_same_type::yes) { arma_applier_1u(/=, -); } - else if(is_same_type::yes) { arma_applier_1u(/=, /); } - else if(is_same_type::yes) { arma_applier_1u(/=, *); } - } - } - else - { - typename Proxy::ea_type P1 = x.P1.get_ea(); - typename Proxy::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1u(/=, +); } - else if(is_same_type::yes) { arma_applier_1u(/=, -); } - else if(is_same_type::yes) { arma_applier_1u(/=, /); } - else if(is_same_type::yes) { arma_applier_1u(/=, *); } - } - } - } - else - { - const Proxy& P1 = x.P1; - const Proxy& P2 = x.P2; - - if(use_mp && mp_gate::use_mp && Proxy::use_mp)>::eval(x.get_n_elem())) - { - if(is_same_type::yes) { arma_applier_2_mp(/=, +); } - else if(is_same_type::yes) { arma_applier_2_mp(/=, -); } - else if(is_same_type::yes) { arma_applier_2_mp(/=, /); } - else if(is_same_type::yes) { arma_applier_2_mp(/=, *); } - } - else - { - if(is_same_type::yes) { arma_applier_2(/=, +); } - else if(is_same_type::yes) { arma_applier_2(/=, -); } - else if(is_same_type::yes) { arma_applier_2(/=, /); } - else if(is_same_type::yes) { arma_applier_2(/=, *); } - } - } - } - - - -// -// cubes - - - -template -template -inline -void -eglue_core::apply(Cube& out, const eGlueCube& x) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - constexpr bool use_at = (ProxyCube::use_at || ProxyCube::use_at); - constexpr bool use_mp = (ProxyCube::use_mp || ProxyCube::use_mp) && (arma_config::openmp); - - // NOTE: we're assuming that the cube has already been set to the correct size and there is no aliasing; - // size setting and alias checking is done by either the Cube contructor or operator=() - - - eT* out_mem = out.memptr(); - - if(use_at == false) - { - const uword n_elem = out.n_elem; - - if(use_mp && mp_gate::use_mp && ProxyCube::use_mp)>::eval(n_elem)) - { - typename ProxyCube::ea_type P1 = x.P1.get_ea(); - typename ProxyCube::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1_mp(=, +); } - else if(is_same_type::yes) { arma_applier_1_mp(=, -); } - else if(is_same_type::yes) { arma_applier_1_mp(=, /); } - else if(is_same_type::yes) { arma_applier_1_mp(=, *); } - } - else - { - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - if(x.P1.is_aligned() && x.P2.is_aligned()) - { - typename ProxyCube::aligned_ea_type P1 = x.P1.get_aligned_ea(); - typename ProxyCube::aligned_ea_type P2 = x.P2.get_aligned_ea(); - - if(is_same_type::yes) { arma_applier_1a(=, +); } - else if(is_same_type::yes) { arma_applier_1a(=, -); } - else if(is_same_type::yes) { arma_applier_1a(=, /); } - else if(is_same_type::yes) { arma_applier_1a(=, *); } - } - else - { - typename ProxyCube::ea_type P1 = x.P1.get_ea(); - typename ProxyCube::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1u(=, +); } - else if(is_same_type::yes) { arma_applier_1u(=, -); } - else if(is_same_type::yes) { arma_applier_1u(=, /); } - else if(is_same_type::yes) { arma_applier_1u(=, *); } - } - } - else - { - typename ProxyCube::ea_type P1 = x.P1.get_ea(); - typename ProxyCube::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1u(=, +); } - else if(is_same_type::yes) { arma_applier_1u(=, -); } - else if(is_same_type::yes) { arma_applier_1u(=, /); } - else if(is_same_type::yes) { arma_applier_1u(=, *); } - } - } - } - else - { - const uword n_rows = x.get_n_rows(); - const uword n_cols = x.get_n_cols(); - const uword n_slices = x.get_n_slices(); - - const ProxyCube& P1 = x.P1; - const ProxyCube& P2 = x.P2; - - if(use_mp && mp_gate::use_mp && ProxyCube::use_mp)>::eval(x.get_n_elem())) - { - if(is_same_type::yes) { arma_applier_3_mp(=, +); } - else if(is_same_type::yes) { arma_applier_3_mp(=, -); } - else if(is_same_type::yes) { arma_applier_3_mp(=, /); } - else if(is_same_type::yes) { arma_applier_3_mp(=, *); } - } - else - { - if(is_same_type::yes) { arma_applier_3(=, +); } - else if(is_same_type::yes) { arma_applier_3(=, -); } - else if(is_same_type::yes) { arma_applier_3(=, /); } - else if(is_same_type::yes) { arma_applier_3(=, *); } - } - } - } - - - -template -template -inline -void -eglue_core::apply_inplace_plus(Cube& out, const eGlueCube& x) - { - arma_debug_sigprint(); - - const uword n_rows = x.get_n_rows(); - const uword n_cols = x.get_n_cols(); - const uword n_slices = x.get_n_slices(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, out.n_slices, n_rows, n_cols, n_slices, "addition"); - - typedef typename T1::elem_type eT; - - eT* out_mem = out.memptr(); - - constexpr bool use_at = (ProxyCube::use_at || ProxyCube::use_at); - constexpr bool use_mp = (ProxyCube::use_mp || ProxyCube::use_mp) && (arma_config::openmp); - - if(use_at == false) - { - const uword n_elem = out.n_elem; - - if(use_mp && mp_gate::use_mp && ProxyCube::use_mp)>::eval(n_elem)) - { - typename ProxyCube::ea_type P1 = x.P1.get_ea(); - typename ProxyCube::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1_mp(+=, +); } - else if(is_same_type::yes) { arma_applier_1_mp(+=, -); } - else if(is_same_type::yes) { arma_applier_1_mp(+=, /); } - else if(is_same_type::yes) { arma_applier_1_mp(+=, *); } - } - else - { - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - if(x.P1.is_aligned() && x.P2.is_aligned()) - { - typename ProxyCube::aligned_ea_type P1 = x.P1.get_aligned_ea(); - typename ProxyCube::aligned_ea_type P2 = x.P2.get_aligned_ea(); - - if(is_same_type::yes) { arma_applier_1a(+=, +); } - else if(is_same_type::yes) { arma_applier_1a(+=, -); } - else if(is_same_type::yes) { arma_applier_1a(+=, /); } - else if(is_same_type::yes) { arma_applier_1a(+=, *); } - } - else - { - typename ProxyCube::ea_type P1 = x.P1.get_ea(); - typename ProxyCube::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1u(+=, +); } - else if(is_same_type::yes) { arma_applier_1u(+=, -); } - else if(is_same_type::yes) { arma_applier_1u(+=, /); } - else if(is_same_type::yes) { arma_applier_1u(+=, *); } - } - } - else - { - typename ProxyCube::ea_type P1 = x.P1.get_ea(); - typename ProxyCube::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1u(+=, +); } - else if(is_same_type::yes) { arma_applier_1u(+=, -); } - else if(is_same_type::yes) { arma_applier_1u(+=, /); } - else if(is_same_type::yes) { arma_applier_1u(+=, *); } - } - } - } - else - { - const ProxyCube& P1 = x.P1; - const ProxyCube& P2 = x.P2; - - if(use_mp && mp_gate::use_mp && ProxyCube::use_mp)>::eval(x.get_n_elem())) - { - if(is_same_type::yes) { arma_applier_3_mp(+=, +); } - else if(is_same_type::yes) { arma_applier_3_mp(+=, -); } - else if(is_same_type::yes) { arma_applier_3_mp(+=, /); } - else if(is_same_type::yes) { arma_applier_3_mp(+=, *); } - } - else - { - if(is_same_type::yes) { arma_applier_3(+=, +); } - else if(is_same_type::yes) { arma_applier_3(+=, -); } - else if(is_same_type::yes) { arma_applier_3(+=, /); } - else if(is_same_type::yes) { arma_applier_3(+=, *); } - } - } - } - - - -template -template -inline -void -eglue_core::apply_inplace_minus(Cube& out, const eGlueCube& x) - { - arma_debug_sigprint(); - - const uword n_rows = x.get_n_rows(); - const uword n_cols = x.get_n_cols(); - const uword n_slices = x.get_n_slices(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, out.n_slices, n_rows, n_cols, n_slices, "subtraction"); - - typedef typename T1::elem_type eT; - - eT* out_mem = out.memptr(); - - constexpr bool use_at = (ProxyCube::use_at || ProxyCube::use_at); - constexpr bool use_mp = (ProxyCube::use_mp || ProxyCube::use_mp) && (arma_config::openmp); - - if(use_at == false) - { - const uword n_elem = out.n_elem; - - if(use_mp && mp_gate::use_mp && ProxyCube::use_mp)>::eval(n_elem)) - { - typename ProxyCube::ea_type P1 = x.P1.get_ea(); - typename ProxyCube::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1_mp(-=, +); } - else if(is_same_type::yes) { arma_applier_1_mp(-=, -); } - else if(is_same_type::yes) { arma_applier_1_mp(-=, /); } - else if(is_same_type::yes) { arma_applier_1_mp(-=, *); } - } - else - { - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - if(x.P1.is_aligned() && x.P2.is_aligned()) - { - typename ProxyCube::aligned_ea_type P1 = x.P1.get_aligned_ea(); - typename ProxyCube::aligned_ea_type P2 = x.P2.get_aligned_ea(); - - if(is_same_type::yes) { arma_applier_1a(-=, +); } - else if(is_same_type::yes) { arma_applier_1a(-=, -); } - else if(is_same_type::yes) { arma_applier_1a(-=, /); } - else if(is_same_type::yes) { arma_applier_1a(-=, *); } - } - else - { - typename ProxyCube::ea_type P1 = x.P1.get_ea(); - typename ProxyCube::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1u(-=, +); } - else if(is_same_type::yes) { arma_applier_1u(-=, -); } - else if(is_same_type::yes) { arma_applier_1u(-=, /); } - else if(is_same_type::yes) { arma_applier_1u(-=, *); } - } - } - else - { - typename ProxyCube::ea_type P1 = x.P1.get_ea(); - typename ProxyCube::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1u(-=, +); } - else if(is_same_type::yes) { arma_applier_1u(-=, -); } - else if(is_same_type::yes) { arma_applier_1u(-=, /); } - else if(is_same_type::yes) { arma_applier_1u(-=, *); } - } - } - } - else - { - const ProxyCube& P1 = x.P1; - const ProxyCube& P2 = x.P2; - - if(use_mp && mp_gate::use_mp && ProxyCube::use_mp)>::eval(x.get_n_elem())) - { - if(is_same_type::yes) { arma_applier_3_mp(-=, +); } - else if(is_same_type::yes) { arma_applier_3_mp(-=, -); } - else if(is_same_type::yes) { arma_applier_3_mp(-=, /); } - else if(is_same_type::yes) { arma_applier_3_mp(-=, *); } - } - else - { - if(is_same_type::yes) { arma_applier_3(-=, +); } - else if(is_same_type::yes) { arma_applier_3(-=, -); } - else if(is_same_type::yes) { arma_applier_3(-=, /); } - else if(is_same_type::yes) { arma_applier_3(-=, *); } - } - } - } - - - -template -template -inline -void -eglue_core::apply_inplace_schur(Cube& out, const eGlueCube& x) - { - arma_debug_sigprint(); - - const uword n_rows = x.get_n_rows(); - const uword n_cols = x.get_n_cols(); - const uword n_slices = x.get_n_slices(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, out.n_slices, n_rows, n_cols, n_slices, "element-wise multiplication"); - - typedef typename T1::elem_type eT; - - eT* out_mem = out.memptr(); - - constexpr bool use_at = (ProxyCube::use_at || ProxyCube::use_at); - constexpr bool use_mp = (ProxyCube::use_mp || ProxyCube::use_mp) && (arma_config::openmp); - - if(use_at == false) - { - const uword n_elem = out.n_elem; - - if(use_mp && mp_gate::use_mp && ProxyCube::use_mp)>::eval(n_elem)) - { - typename ProxyCube::ea_type P1 = x.P1.get_ea(); - typename ProxyCube::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1_mp(*=, +); } - else if(is_same_type::yes) { arma_applier_1_mp(*=, -); } - else if(is_same_type::yes) { arma_applier_1_mp(*=, /); } - else if(is_same_type::yes) { arma_applier_1_mp(*=, *); } - } - else - { - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - if(x.P1.is_aligned() && x.P2.is_aligned()) - { - typename ProxyCube::aligned_ea_type P1 = x.P1.get_aligned_ea(); - typename ProxyCube::aligned_ea_type P2 = x.P2.get_aligned_ea(); - - if(is_same_type::yes) { arma_applier_1a(*=, +); } - else if(is_same_type::yes) { arma_applier_1a(*=, -); } - else if(is_same_type::yes) { arma_applier_1a(*=, /); } - else if(is_same_type::yes) { arma_applier_1a(*=, *); } - } - else - { - typename ProxyCube::ea_type P1 = x.P1.get_ea(); - typename ProxyCube::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1u(*=, +); } - else if(is_same_type::yes) { arma_applier_1u(*=, -); } - else if(is_same_type::yes) { arma_applier_1u(*=, /); } - else if(is_same_type::yes) { arma_applier_1u(*=, *); } - } - } - else - { - typename ProxyCube::ea_type P1 = x.P1.get_ea(); - typename ProxyCube::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1u(*=, +); } - else if(is_same_type::yes) { arma_applier_1u(*=, -); } - else if(is_same_type::yes) { arma_applier_1u(*=, /); } - else if(is_same_type::yes) { arma_applier_1u(*=, *); } - } - } - } - else - { - const ProxyCube& P1 = x.P1; - const ProxyCube& P2 = x.P2; - - if(use_mp && mp_gate::use_mp && ProxyCube::use_mp)>::eval(x.get_n_elem())) - { - if(is_same_type::yes) { arma_applier_3_mp(*=, +); } - else if(is_same_type::yes) { arma_applier_3_mp(*=, -); } - else if(is_same_type::yes) { arma_applier_3_mp(*=, /); } - else if(is_same_type::yes) { arma_applier_3_mp(*=, *); } - } - else - { - if(is_same_type::yes) { arma_applier_3(*=, +); } - else if(is_same_type::yes) { arma_applier_3(*=, -); } - else if(is_same_type::yes) { arma_applier_3(*=, /); } - else if(is_same_type::yes) { arma_applier_3(*=, *); } - } - } - } - - - -template -template -inline -void -eglue_core::apply_inplace_div(Cube& out, const eGlueCube& x) - { - arma_debug_sigprint(); - - const uword n_rows = x.get_n_rows(); - const uword n_cols = x.get_n_cols(); - const uword n_slices = x.get_n_slices(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, out.n_slices, n_rows, n_cols, n_slices, "element-wise division"); - - typedef typename T1::elem_type eT; - - eT* out_mem = out.memptr(); - - constexpr bool use_at = (ProxyCube::use_at || ProxyCube::use_at); - constexpr bool use_mp = (ProxyCube::use_mp || ProxyCube::use_mp) && (arma_config::openmp); - - if(use_at == false) - { - const uword n_elem = out.n_elem; - - if(use_mp && mp_gate::use_mp && ProxyCube::use_mp)>::eval(n_elem)) - { - typename ProxyCube::ea_type P1 = x.P1.get_ea(); - typename ProxyCube::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1_mp(/=, +); } - else if(is_same_type::yes) { arma_applier_1_mp(/=, -); } - else if(is_same_type::yes) { arma_applier_1_mp(/=, /); } - else if(is_same_type::yes) { arma_applier_1_mp(/=, *); } - } - else - { - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - if(x.P1.is_aligned() && x.P2.is_aligned()) - { - typename ProxyCube::aligned_ea_type P1 = x.P1.get_aligned_ea(); - typename ProxyCube::aligned_ea_type P2 = x.P2.get_aligned_ea(); - - if(is_same_type::yes) { arma_applier_1a(/=, +); } - else if(is_same_type::yes) { arma_applier_1a(/=, -); } - else if(is_same_type::yes) { arma_applier_1a(/=, /); } - else if(is_same_type::yes) { arma_applier_1a(/=, *); } - } - else - { - typename ProxyCube::ea_type P1 = x.P1.get_ea(); - typename ProxyCube::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1u(/=, +); } - else if(is_same_type::yes) { arma_applier_1u(/=, -); } - else if(is_same_type::yes) { arma_applier_1u(/=, /); } - else if(is_same_type::yes) { arma_applier_1u(/=, *); } - } - } - else - { - typename ProxyCube::ea_type P1 = x.P1.get_ea(); - typename ProxyCube::ea_type P2 = x.P2.get_ea(); - - if(is_same_type::yes) { arma_applier_1u(/=, +); } - else if(is_same_type::yes) { arma_applier_1u(/=, -); } - else if(is_same_type::yes) { arma_applier_1u(/=, /); } - else if(is_same_type::yes) { arma_applier_1u(/=, *); } - } - } - } - else - { - const ProxyCube& P1 = x.P1; - const ProxyCube& P2 = x.P2; - - if(use_mp && mp_gate::use_mp && ProxyCube::use_mp)>::eval(x.get_n_elem())) - { - if(is_same_type::yes) { arma_applier_3_mp(/=, +); } - else if(is_same_type::yes) { arma_applier_3_mp(/=, -); } - else if(is_same_type::yes) { arma_applier_3_mp(/=, /); } - else if(is_same_type::yes) { arma_applier_3_mp(/=, *); } - } - else - { - if(is_same_type::yes) { arma_applier_3(/=, +); } - else if(is_same_type::yes) { arma_applier_3(/=, -); } - else if(is_same_type::yes) { arma_applier_3(/=, /); } - else if(is_same_type::yes) { arma_applier_3(/=, *); } - } - } - } - - - -#undef arma_applier_1u -#undef arma_applier_1a -#undef arma_applier_2 -#undef arma_applier_3 - -#undef arma_applier_1_mp -#undef arma_applier_2_mp -#undef arma_applier_3_mp - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eop_aux.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eop_aux.hpp deleted file mode 100644 index b63eba661..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eop_aux.hpp +++ /dev/null @@ -1,195 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup eop_aux -//! @{ - - - -//! use of the SFINAE approach to work around compiler limitations -//! http://en.wikipedia.org/wiki/SFINAE - -class eop_aux - { - public: - - template arma_inline static typename arma_integral_only::result acos (const eT x) { return eT( std::acos(double(x)) ); } - template arma_inline static typename arma_integral_only::result asin (const eT x) { return eT( std::asin(double(x)) ); } - template arma_inline static typename arma_integral_only::result atan (const eT x) { return eT( std::atan(double(x)) ); } - - template arma_inline static typename arma_real_only::result acos (const eT x) { return std::acos(x); } - template arma_inline static typename arma_real_only::result asin (const eT x) { return std::asin(x); } - template arma_inline static typename arma_real_only::result atan (const eT x) { return std::atan(x); } - - template arma_inline static typename arma_cx_only::result acos (const eT x) { return std::acos(x); } - template arma_inline static typename arma_cx_only::result asin (const eT x) { return std::asin(x); } - template arma_inline static typename arma_cx_only::result atan (const eT x) { return std::atan(x); } - - template arma_inline static typename arma_integral_only::result acosh (const eT x) { return eT( std::acosh(double(x)) ); } - template arma_inline static typename arma_integral_only::result asinh (const eT x) { return eT( std::asinh(double(x)) ); } - template arma_inline static typename arma_integral_only::result atanh (const eT x) { return eT( std::atanh(double(x)) ); } - - template arma_inline static typename arma_real_or_cx_only::result acosh (const eT x) { return std::acosh(x); } - template arma_inline static typename arma_real_or_cx_only::result asinh (const eT x) { return std::asinh(x); } - template arma_inline static typename arma_real_or_cx_only::result atanh (const eT x) { return std::atanh(x); } - - template arma_inline static typename arma_not_cx::result conj(const eT x) { return x; } - template arma_inline static std::complex conj(const std::complex& x) { return std::conj(x); } - - template arma_inline static typename arma_integral_only::result sqrt (const eT x) { return eT( std::sqrt (double(x)) ); } - template arma_inline static typename arma_integral_only::result log10 (const eT x) { return eT( std::log10(double(x)) ); } - template arma_inline static typename arma_integral_only::result log (const eT x) { return eT( std::log (double(x)) ); } - template arma_inline static typename arma_integral_only::result exp (const eT x) { return eT( std::exp (double(x)) ); } - template arma_inline static typename arma_integral_only::result cos (const eT x) { return eT( std::cos (double(x)) ); } - template arma_inline static typename arma_integral_only::result sin (const eT x) { return eT( std::sin (double(x)) ); } - template arma_inline static typename arma_integral_only::result tan (const eT x) { return eT( std::tan (double(x)) ); } - template arma_inline static typename arma_integral_only::result cosh (const eT x) { return eT( std::cosh (double(x)) ); } - template arma_inline static typename arma_integral_only::result sinh (const eT x) { return eT( std::sinh (double(x)) ); } - template arma_inline static typename arma_integral_only::result tanh (const eT x) { return eT( std::tanh (double(x)) ); } - - template arma_inline static typename arma_real_or_cx_only::result sqrt (const eT x) { return std::sqrt (x); } - template arma_inline static typename arma_real_or_cx_only::result log10 (const eT x) { return std::log10(x); } - template arma_inline static typename arma_real_or_cx_only::result log (const eT x) { return std::log (x); } - template arma_inline static typename arma_real_or_cx_only::result exp (const eT x) { return std::exp (x); } - template arma_inline static typename arma_real_or_cx_only::result cos (const eT x) { return std::cos (x); } - template arma_inline static typename arma_real_or_cx_only::result sin (const eT x) { return std::sin (x); } - template arma_inline static typename arma_real_or_cx_only::result tan (const eT x) { return std::tan (x); } - template arma_inline static typename arma_real_or_cx_only::result cosh (const eT x) { return std::cosh (x); } - template arma_inline static typename arma_real_or_cx_only::result sinh (const eT x) { return std::sinh (x); } - template arma_inline static typename arma_real_or_cx_only::result tanh (const eT x) { return std::tanh (x); } - - template arma_inline static typename arma_unsigned_integral_only::result neg (const eT x) { return static_cast(-1 * x); } // TODO: not sure how to best handle this - template arma_inline static typename arma_signed_only::result neg (const eT x) { return -x; } - - template arma_inline static typename arma_integral_only::result floor (const eT x) { return x; } - template arma_inline static typename arma_real_only::result floor (const eT x) { return std::floor(x); } - template arma_inline static typename arma_cx_only::result floor (const eT& x) { return eT( std::floor(x.real()), std::floor(x.imag()) ); } - - template arma_inline static typename arma_integral_only::result ceil (const eT x) { return x; } - template arma_inline static typename arma_real_only::result ceil (const eT x) { return std::ceil(x); } - template arma_inline static typename arma_cx_only::result ceil (const eT& x) { return eT( std::ceil(x.real()), std::ceil(x.imag()) ); } - - template arma_inline static typename arma_integral_only::result round (const eT x) { return x; } - template arma_inline static typename arma_real_only::result round (const eT x) { return std::round(x); } - template arma_inline static typename arma_cx_only::result round (const eT& x) { return eT( std::round(x.real()), std::round(x.imag()) ); } - - template arma_inline static typename arma_integral_only::result trunc (const eT x) { return x; } - template arma_inline static typename arma_real_only::result trunc (const eT x) { return std::trunc(x); } - template arma_inline static typename arma_cx_only::result trunc (const eT& x) { return eT( std::trunc(x.real()), std::trunc(x.imag()) ); } - - template arma_inline static typename arma_integral_only::result log2 (const eT x) { return eT( std::log2(double(x)) ); } - template arma_inline static typename arma_real_only::result log2 (const eT x) { return std::log2(x); } - template arma_inline static typename arma_cx_only::result log2 (const eT& x) { typedef typename get_pod_type::result T; return std::log(x) / T(0.69314718055994530942); } - - template arma_inline static typename arma_integral_only::result log1p (const eT x) { return eT( std::log1p(double(x)) ); } - template arma_inline static typename arma_real_only::result log1p (const eT x) { return std::log1p(x); } - template arma_inline static typename arma_cx_only::result log1p (const eT& x) { arma_ignore(x); return eT(0); } - - template arma_inline static typename arma_integral_only::result exp2 (const eT x) { return eT( std::exp2(double(x)) ); } - template arma_inline static typename arma_real_only::result exp2 (const eT x) { return std::exp2(x); } - template arma_inline static typename arma_cx_only::result exp2 (const eT& x) { typedef typename get_pod_type::result T; return std::pow( T(2), x); } - - template arma_inline static typename arma_integral_only::result exp10 (const eT x) { return eT( std::pow(double(10), double(x)) ); } - template arma_inline static typename arma_real_or_cx_only::result exp10 (const eT x) { typedef typename get_pod_type::result T; return std::pow( T(10), x); } - - template arma_inline static typename arma_integral_only::result expm1 (const eT x) { return eT( std::expm1(double(x)) ); } - template arma_inline static typename arma_real_only::result expm1 (const eT x) { return std::expm1(x); } - template arma_inline static typename arma_cx_only::result expm1 (const eT& x) { arma_ignore(x); return eT(0); } - - template arma_inline static typename arma_unsigned_integral_only::result arma_abs (const eT x) { return x; } - template arma_inline static typename arma_signed_integral_only::result arma_abs (const eT x) { return std::abs(x); } - template arma_inline static typename arma_real_only::result arma_abs (const eT x) { return std::abs(x); } - template arma_inline static typename arma_real_only< T>::result arma_abs (const std::complex& x) { return std::abs(x); } - - template arma_inline static typename arma_integral_only::result cbrt (const eT x) { return eT( std::cbrt(double(x)) ); } - template arma_inline static typename arma_real_only::result cbrt (const eT x) { return std::cbrt(x); } - template arma_inline static typename arma_cx_only::result cbrt (const eT& x) { arma_ignore(x); return eT(0); } - - template arma_inline static typename arma_integral_only::result erf (const eT x) { return eT( std::erf(double(x)) ); } - template arma_inline static typename arma_real_only::result erf (const eT x) { return std::erf(x); } - template arma_inline static typename arma_cx_only::result erf (const eT& x) { arma_ignore(x); return eT(0); } - - template arma_inline static typename arma_integral_only::result erfc (const eT x) { return eT( std::erfc(double(x)) ); } - template arma_inline static typename arma_real_only::result erfc (const eT x) { return std::erfc(x); } - template arma_inline static typename arma_cx_only::result erfc (const eT& x) { arma_ignore(x); return eT(0); } - - template arma_inline static typename arma_integral_only::result lgamma (const eT x) { return eT( std::lgamma(double(x)) ); } - template arma_inline static typename arma_real_only::result lgamma (const eT x) { return std::lgamma(x); } - template arma_inline static typename arma_cx_only::result lgamma (const eT& x) { arma_ignore(x); return eT(0); } - - template arma_inline static typename arma_integral_only::result tgamma (const eT x) { return eT( std::tgamma(double(x)) ); } - template arma_inline static typename arma_real_only::result tgamma (const eT x) { return std::tgamma(x); } - template arma_inline static typename arma_cx_only::result tgamma (const eT& x) { arma_ignore(x); return eT(0); } - - template arma_inline static typename arma_integral_only::result pow (const T1 base, const T2 exponent) { return T1( std::pow( double(base), double(exponent) ) ); } - template arma_inline static typename arma_real_or_cx_only::result pow (const T1 base, const T2 exponent) { return T1( std::pow( base, exponent ) ); } - - - template - arma_inline - static - typename arma_integral_only::result - direct_eps(const eT) - { - return eT(0); - } - - - template - inline - static - typename arma_real_only::result - direct_eps(const eT x) - { - //arma_debug_sigprint(); - - // acording to IEEE Standard for Floating-Point Arithmetic (IEEE 754) - // the mantissa length for double is 53 bits = std::numeric_limits::digits - // the mantissa length for float is 24 bits = std::numeric_limits::digits - - //return std::pow( std::numeric_limits::radix, (std::floor(std::log10(std::abs(x))/std::log10(std::numeric_limits::radix))-(std::numeric_limits::digits-1)) ); - - const eT radix_eT = eT(std::numeric_limits::radix); - const eT digits_m1_eT = eT(std::numeric_limits::digits - 1); - - // return std::pow( radix_eT, eT(std::floor(std::log10(std::abs(x))/std::log10(radix_eT)) - digits_m1_eT) ); - return eop_aux::pow( radix_eT, eT(std::floor(std::log10(std::abs(x))/std::log10(radix_eT)) - digits_m1_eT) ); - } - - - template - inline - static - typename arma_real_only::result - direct_eps(const std::complex& x) - { - //arma_debug_sigprint(); - - //return std::pow( std::numeric_limits::radix, (std::floor(std::log10(std::abs(x))/std::log10(std::numeric_limits::radix))-(std::numeric_limits::digits-1)) ); - - const T radix_T = T(std::numeric_limits::radix); - const T digits_m1_T = T(std::numeric_limits::digits - 1); - - return std::pow( radix_T, T(std::floor(std::log10(std::abs(x))/std::log10(radix_T)) - digits_m1_T) ); - } - }; - - - -//! @} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eop_core_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eop_core_bones.hpp deleted file mode 100644 index 246635045..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eop_core_bones.hpp +++ /dev/null @@ -1,117 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup eop_core -//! @{ - - - -template -class eop_core - { - public: - - // matrices - - template arma_hot inline static void apply(outT& out, const eOp& x); - - template arma_hot inline static void apply_inplace_plus (Mat& out, const eOp& x); - template arma_hot inline static void apply_inplace_minus(Mat& out, const eOp& x); - template arma_hot inline static void apply_inplace_schur(Mat& out, const eOp& x); - template arma_hot inline static void apply_inplace_div (Mat& out, const eOp& x); - - - // cubes - - template arma_hot inline static void apply(Cube& out, const eOpCube& x); - - template arma_hot inline static void apply_inplace_plus (Cube& out, const eOpCube& x); - template arma_hot inline static void apply_inplace_minus(Cube& out, const eOpCube& x); - template arma_hot inline static void apply_inplace_schur(Cube& out, const eOpCube& x); - template arma_hot inline static void apply_inplace_div (Cube& out, const eOpCube& x); - - - // common - - template arma_inline static eT process(const eT val, const eT k); - }; - - -struct eop_use_mp_true { static constexpr bool use_mp = true; }; -struct eop_use_mp_false { static constexpr bool use_mp = false; }; - - -class eop_neg : public eop_core , public eop_use_mp_false {}; -class eop_scalar_plus : public eop_core , public eop_use_mp_false {}; -class eop_scalar_minus_pre : public eop_core , public eop_use_mp_false {}; -class eop_scalar_minus_post : public eop_core , public eop_use_mp_false {}; -class eop_scalar_times : public eop_core , public eop_use_mp_false {}; -class eop_scalar_div_pre : public eop_core , public eop_use_mp_false {}; -class eop_scalar_div_post : public eop_core , public eop_use_mp_false {}; -class eop_square : public eop_core , public eop_use_mp_false {}; -class eop_sqrt : public eop_core , public eop_use_mp_true {}; -class eop_pow : public eop_core , public eop_use_mp_false {}; // for pow(), use_mp is selectively enabled in eop_core_meat.hpp -class eop_log : public eop_core , public eop_use_mp_true {}; -class eop_log2 : public eop_core , public eop_use_mp_true {}; -class eop_log10 : public eop_core , public eop_use_mp_true {}; -class eop_trunc_log : public eop_core , public eop_use_mp_true {}; -class eop_log1p : public eop_core , public eop_use_mp_true {}; -class eop_exp : public eop_core , public eop_use_mp_true {}; -class eop_exp2 : public eop_core , public eop_use_mp_true {}; -class eop_exp10 : public eop_core , public eop_use_mp_true {}; -class eop_trunc_exp : public eop_core , public eop_use_mp_true {}; -class eop_expm1 : public eop_core , public eop_use_mp_true {}; -class eop_cos : public eop_core , public eop_use_mp_true {}; -class eop_sin : public eop_core , public eop_use_mp_true {}; -class eop_tan : public eop_core , public eop_use_mp_true {}; -class eop_acos : public eop_core , public eop_use_mp_true {}; -class eop_asin : public eop_core , public eop_use_mp_true {}; -class eop_atan : public eop_core , public eop_use_mp_true {}; -class eop_cosh : public eop_core , public eop_use_mp_true {}; -class eop_sinh : public eop_core , public eop_use_mp_true {}; -class eop_tanh : public eop_core , public eop_use_mp_true {}; -class eop_acosh : public eop_core , public eop_use_mp_true {}; -class eop_asinh : public eop_core , public eop_use_mp_true {}; -class eop_atanh : public eop_core , public eop_use_mp_true {}; -class eop_sinc : public eop_core , public eop_use_mp_true {}; -class eop_eps : public eop_core , public eop_use_mp_true {}; -class eop_abs : public eop_core , public eop_use_mp_false {}; -class eop_arg : public eop_core , public eop_use_mp_false {}; -class eop_conj : public eop_core , public eop_use_mp_false {}; -class eop_floor : public eop_core , public eop_use_mp_false {}; -class eop_ceil : public eop_core , public eop_use_mp_false {}; -class eop_round : public eop_core , public eop_use_mp_false {}; -class eop_trunc : public eop_core , public eop_use_mp_false {}; -class eop_sign : public eop_core , public eop_use_mp_false {}; -class eop_cbrt : public eop_core , public eop_use_mp_true {}; -class eop_erf : public eop_core , public eop_use_mp_true {}; -class eop_erfc : public eop_core , public eop_use_mp_true {}; -class eop_lgamma : public eop_core , public eop_use_mp_true {}; -class eop_tgamma : public eop_core , public eop_use_mp_true {}; - - - -// the classes below are currently not used; reserved for potential future use -class eop_log_approx {}; -class eop_exp_approx {}; -class eop_approx_log {}; -class eop_approx_exp {}; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eop_core_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eop_core_meat.hpp deleted file mode 100644 index 48c27a0c8..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/eop_core_meat.hpp +++ /dev/null @@ -1,1163 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup eop_core -//! @{ - - -#undef arma_applier_1u -#undef arma_applier_1a -#undef arma_applier_2 -#undef arma_applier_3 -#undef operatorA - -#undef arma_applier_1_mp -#undef arma_applier_2_mp -#undef arma_applier_3_mp - - -#if defined(ARMA_SIMPLE_LOOPS) - #define arma_applier_1u(operatorA) \ - {\ - for(uword i=0; i::process(P[i], k);\ - }\ - } -#else - #define arma_applier_1u(operatorA) \ - {\ - uword i,j;\ - \ - for(i=0, j=1; j::process(tmp_i, k);\ - tmp_j = eop_core::process(tmp_j, k);\ - \ - out_mem[i] operatorA tmp_i;\ - out_mem[j] operatorA tmp_j;\ - }\ - \ - if(i < n_elem)\ - {\ - out_mem[i] operatorA eop_core::process(P[i], k);\ - }\ - } -#endif - - - -#if defined(ARMA_SIMPLE_LOOPS) - #define arma_applier_1a(operatorA) \ - {\ - for(uword i=0; i::process(P.at_alt(i), k);\ - }\ - } -#else - #define arma_applier_1a(operatorA) \ - {\ - uword i,j;\ - \ - for(i=0, j=1; j::process(tmp_i, k);\ - tmp_j = eop_core::process(tmp_j, k);\ - \ - out_mem[i] operatorA tmp_i;\ - out_mem[j] operatorA tmp_j;\ - }\ - \ - if(i < n_elem)\ - {\ - out_mem[i] operatorA eop_core::process(P.at_alt(i), k);\ - }\ - } -#endif - - -#define arma_applier_2(operatorA) \ - {\ - if(n_rows != 1)\ - {\ - for(uword col=0; col::process(tmp_i, k);\ - tmp_j = eop_core::process(tmp_j, k);\ - \ - *out_mem operatorA tmp_i; out_mem++;\ - *out_mem operatorA tmp_j; out_mem++;\ - }\ - \ - if(i < n_rows)\ - {\ - *out_mem operatorA eop_core::process(P.at(i,col), k); out_mem++;\ - }\ - }\ - }\ - else\ - {\ - for(uword count=0; count < n_cols; ++count)\ - {\ - out_mem[count] operatorA eop_core::process(P.at(0,count), k);\ - }\ - }\ - } - - - -#define arma_applier_3(operatorA) \ - {\ - for(uword slice=0; slice::process(tmp_i, k);\ - tmp_j = eop_core::process(tmp_j, k);\ - \ - *out_mem operatorA tmp_i; out_mem++; \ - *out_mem operatorA tmp_j; out_mem++; \ - }\ - \ - if(i < n_rows)\ - {\ - *out_mem operatorA eop_core::process(P.at(i,col,slice), k); out_mem++; \ - }\ - }\ - }\ - } - - - -#if defined(ARMA_USE_OPENMP) - - #define arma_applier_1_mp(operatorA) \ - {\ - const int n_threads = mp_thread_limit::get();\ - _Pragma("omp parallel for schedule(static) num_threads(n_threads)")\ - for(uword i=0; i::process(P[i], k);\ - }\ - } - - #define arma_applier_2_mp(operatorA) \ - {\ - const int n_threads = mp_thread_limit::get();\ - if(n_cols == 1)\ - {\ - _Pragma("omp parallel for schedule(static) num_threads(n_threads)")\ - for(uword count=0; count < n_rows; ++count)\ - {\ - out_mem[count] operatorA eop_core::process(P.at(count,0), k);\ - }\ - }\ - else\ - if(n_rows == 1)\ - {\ - _Pragma("omp parallel for schedule(static) num_threads(n_threads)")\ - for(uword count=0; count < n_cols; ++count)\ - {\ - out_mem[count] operatorA eop_core::process(P.at(0,count), k);\ - }\ - }\ - else\ - {\ - _Pragma("omp parallel for schedule(static) num_threads(n_threads)")\ - for(uword col=0; col < n_cols; ++col)\ - {\ - for(uword row=0; row < n_rows; ++row)\ - {\ - out.at(row,col) operatorA eop_core::process(P.at(row,col), k);\ - }\ - }\ - }\ - } - - #define arma_applier_3_mp(operatorA) \ - {\ - const int n_threads = mp_thread_limit::get();\ - _Pragma("omp parallel for schedule(static) num_threads(n_threads)")\ - for(uword slice=0; slice::process(P.at(row,col,slice), k);\ - }\ - }\ - } - -#else - - #define arma_applier_1_mp(operatorA) arma_applier_1u(operatorA) - #define arma_applier_2_mp(operatorA) arma_applier_2(operatorA) - #define arma_applier_3_mp(operatorA) arma_applier_3(operatorA) - -#endif - - - -// -// matrices - - - -template -template -inline -void -eop_core::apply(outT& out, const eOp& x) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - // NOTE: we're assuming that the matrix has already been set to the correct size and there is no aliasing; - // size setting and alias checking is done by either the Mat contructor or operator=() - - const eT k = x.aux; - eT* out_mem = out.memptr(); - - const bool use_mp = (arma_config::openmp) && (eOp::use_mp || (is_same_type::value && (is_cx::yes || x.aux != eT(2)))); - - if(Proxy::use_at == false) - { - const uword n_elem = x.get_n_elem(); - - if(use_mp && mp_gate::eval(n_elem)) - { - typename Proxy::ea_type P = x.P.get_ea(); - - arma_applier_1_mp(=); - } - else - { - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - if(x.P.is_aligned()) - { - typename Proxy::aligned_ea_type P = x.P.get_aligned_ea(); - - arma_applier_1a(=); - } - else - { - typename Proxy::ea_type P = x.P.get_ea(); - - arma_applier_1u(=); - } - } - else - { - typename Proxy::ea_type P = x.P.get_ea(); - - arma_applier_1u(=); - } - } - } - else - { - const uword n_rows = x.get_n_rows(); - const uword n_cols = x.get_n_cols(); - - const Proxy& P = x.P; - - if(use_mp && mp_gate::eval(x.get_n_elem())) - { - arma_applier_2_mp(=); - } - else - { - arma_applier_2(=); - } - } - } - - - -template -template -inline -void -eop_core::apply_inplace_plus(Mat& out, const eOp& x) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_rows = x.get_n_rows(); - const uword n_cols = x.get_n_cols(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, n_rows, n_cols, "addition"); - - const eT k = x.aux; - eT* out_mem = out.memptr(); - - const bool use_mp = (arma_config::openmp) && (eOp::use_mp || (is_same_type::value && (is_cx::yes || x.aux != eT(2)))); - - if(Proxy::use_at == false) - { - const uword n_elem = x.get_n_elem(); - - if(use_mp && mp_gate::eval(n_elem)) - { - typename Proxy::ea_type P = x.P.get_ea(); - - arma_applier_1_mp(+=); - } - else - { - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - if(x.P.is_aligned()) - { - typename Proxy::aligned_ea_type P = x.P.get_aligned_ea(); - - arma_applier_1a(+=); - } - else - { - typename Proxy::ea_type P = x.P.get_ea(); - - arma_applier_1u(+=); - } - } - else - { - typename Proxy::ea_type P = x.P.get_ea(); - - arma_applier_1u(+=); - } - } - } - else - { - const Proxy& P = x.P; - - if(use_mp && mp_gate::eval(x.get_n_elem())) - { - arma_applier_2_mp(+=); - } - else - { - arma_applier_2(+=); - } - } - } - - - -template -template -inline -void -eop_core::apply_inplace_minus(Mat& out, const eOp& x) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_rows = x.get_n_rows(); - const uword n_cols = x.get_n_cols(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, n_rows, n_cols, "subtraction"); - - const eT k = x.aux; - eT* out_mem = out.memptr(); - - const bool use_mp = (arma_config::openmp) && (eOp::use_mp || (is_same_type::value && (is_cx::yes || x.aux != eT(2)))); - - if(Proxy::use_at == false) - { - const uword n_elem = x.get_n_elem(); - - if(use_mp && mp_gate::eval(n_elem)) - { - typename Proxy::ea_type P = x.P.get_ea(); - - arma_applier_1_mp(-=); - } - else - { - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - if(x.P.is_aligned()) - { - typename Proxy::aligned_ea_type P = x.P.get_aligned_ea(); - - arma_applier_1a(-=); - } - else - { - typename Proxy::ea_type P = x.P.get_ea(); - - arma_applier_1u(-=); - } - } - else - { - typename Proxy::ea_type P = x.P.get_ea(); - - arma_applier_1u(-=); - } - } - } - else - { - const Proxy& P = x.P; - - if(use_mp && mp_gate::eval(x.get_n_elem())) - { - arma_applier_2_mp(-=); - } - else - { - arma_applier_2(-=); - } - } - } - - - -template -template -inline -void -eop_core::apply_inplace_schur(Mat& out, const eOp& x) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_rows = x.get_n_rows(); - const uword n_cols = x.get_n_cols(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, n_rows, n_cols, "element-wise multiplication"); - - const eT k = x.aux; - eT* out_mem = out.memptr(); - - const bool use_mp = (arma_config::openmp) && (eOp::use_mp || (is_same_type::value && (is_cx::yes || x.aux != eT(2)))); - - if(Proxy::use_at == false) - { - const uword n_elem = x.get_n_elem(); - - if(use_mp && mp_gate::eval(n_elem)) - { - typename Proxy::ea_type P = x.P.get_ea(); - - arma_applier_1_mp(*=); - } - else - { - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - if(x.P.is_aligned()) - { - typename Proxy::aligned_ea_type P = x.P.get_aligned_ea(); - - arma_applier_1a(*=); - } - else - { - typename Proxy::ea_type P = x.P.get_ea(); - - arma_applier_1u(*=); - } - } - else - { - typename Proxy::ea_type P = x.P.get_ea(); - - arma_applier_1u(*=); - } - } - } - else - { - const Proxy& P = x.P; - - if(use_mp && mp_gate::eval(x.get_n_elem())) - { - arma_applier_2_mp(*=); - } - else - { - arma_applier_2(*=); - } - } - } - - - -template -template -inline -void -eop_core::apply_inplace_div(Mat& out, const eOp& x) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_rows = x.get_n_rows(); - const uword n_cols = x.get_n_cols(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, n_rows, n_cols, "element-wise division"); - - const eT k = x.aux; - eT* out_mem = out.memptr(); - - const bool use_mp = (arma_config::openmp) && (eOp::use_mp || (is_same_type::value && (is_cx::yes || x.aux != eT(2)))); - - if(Proxy::use_at == false) - { - const uword n_elem = x.get_n_elem(); - - if(use_mp && mp_gate::eval(n_elem)) - { - typename Proxy::ea_type P = x.P.get_ea(); - - arma_applier_1_mp(/=); - } - else - { - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - if(x.P.is_aligned()) - { - typename Proxy::aligned_ea_type P = x.P.get_aligned_ea(); - - arma_applier_1a(/=); - } - else - { - typename Proxy::ea_type P = x.P.get_ea(); - - arma_applier_1u(/=); - } - } - else - { - typename Proxy::ea_type P = x.P.get_ea(); - - arma_applier_1u(/=); - } - } - } - else - { - const Proxy& P = x.P; - - if(use_mp && mp_gate::eval(x.get_n_elem())) - { - arma_applier_2_mp(/=); - } - else - { - arma_applier_2(/=); - } - } - } - - - -// -// cubes - - - -template -template -inline -void -eop_core::apply(Cube& out, const eOpCube& x) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - // NOTE: we're assuming that the matrix has already been set to the correct size and there is no aliasing; - // size setting and alias checking is done by either the Mat contructor or operator=() - - const eT k = x.aux; - eT* out_mem = out.memptr(); - - const bool use_mp = (arma_config::openmp) && (eOpCube::use_mp || (is_same_type::value && (is_cx::yes || x.aux != eT(2)))); - - if(ProxyCube::use_at == false) - { - const uword n_elem = out.n_elem; - - if(use_mp && mp_gate::eval(n_elem)) - { - typename ProxyCube::ea_type P = x.P.get_ea(); - - arma_applier_1_mp(=); - } - else - { - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - if(x.P.is_aligned()) - { - typename ProxyCube::aligned_ea_type P = x.P.get_aligned_ea(); - - arma_applier_1a(=); - } - else - { - typename ProxyCube::ea_type P = x.P.get_ea(); - - arma_applier_1u(=); - } - } - else - { - typename ProxyCube::ea_type P = x.P.get_ea(); - - arma_applier_1u(=); - } - } - } - else - { - const uword n_rows = x.get_n_rows(); - const uword n_cols = x.get_n_cols(); - const uword n_slices = x.get_n_slices(); - - const ProxyCube& P = x.P; - - if(use_mp && mp_gate::eval(x.get_n_elem())) - { - arma_applier_3_mp(=); - } - else - { - arma_applier_3(=); - } - } - } - - - -template -template -inline -void -eop_core::apply_inplace_plus(Cube& out, const eOpCube& x) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_rows = x.get_n_rows(); - const uword n_cols = x.get_n_cols(); - const uword n_slices = x.get_n_slices(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, out.n_slices, n_rows, n_cols, n_slices, "addition"); - - const eT k = x.aux; - eT* out_mem = out.memptr(); - - const bool use_mp = (arma_config::openmp) && (eOpCube::use_mp || (is_same_type::value && (is_cx::yes || x.aux != eT(2)))); - - if(ProxyCube::use_at == false) - { - const uword n_elem = out.n_elem; - - if(use_mp && mp_gate::eval(n_elem)) - { - typename ProxyCube::ea_type P = x.P.get_ea(); - - arma_applier_1_mp(+=); - } - else - { - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - if(x.P.is_aligned()) - { - typename ProxyCube::aligned_ea_type P = x.P.get_aligned_ea(); - - arma_applier_1a(+=); - } - else - { - typename ProxyCube::ea_type P = x.P.get_ea(); - - arma_applier_1u(+=); - } - } - else - { - typename ProxyCube::ea_type P = x.P.get_ea(); - - arma_applier_1u(+=); - } - } - } - else - { - const ProxyCube& P = x.P; - - if(use_mp && mp_gate::eval(x.get_n_elem())) - { - arma_applier_3_mp(+=); - } - else - { - arma_applier_3(+=); - } - } - } - - - -template -template -inline -void -eop_core::apply_inplace_minus(Cube& out, const eOpCube& x) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_rows = x.get_n_rows(); - const uword n_cols = x.get_n_cols(); - const uword n_slices = x.get_n_slices(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, out.n_slices, n_rows, n_cols, n_slices, "subtraction"); - - const eT k = x.aux; - eT* out_mem = out.memptr(); - - const bool use_mp = (arma_config::openmp) && (eOpCube::use_mp || (is_same_type::value && (is_cx::yes || x.aux != eT(2)))); - - if(ProxyCube::use_at == false) - { - const uword n_elem = out.n_elem; - - if(use_mp && mp_gate::eval(n_elem)) - { - typename ProxyCube::ea_type P = x.P.get_ea(); - - arma_applier_1_mp(-=); - } - else - { - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - if(x.P.is_aligned()) - { - typename ProxyCube::aligned_ea_type P = x.P.get_aligned_ea(); - - arma_applier_1a(-=); - } - else - { - typename ProxyCube::ea_type P = x.P.get_ea(); - - arma_applier_1u(-=); - } - } - else - { - typename ProxyCube::ea_type P = x.P.get_ea(); - - arma_applier_1u(-=); - } - } - } - else - { - const ProxyCube& P = x.P; - - if(use_mp && mp_gate::eval(x.get_n_elem())) - { - arma_applier_3_mp(-=); - } - else - { - arma_applier_3(-=); - } - } - } - - - -template -template -inline -void -eop_core::apply_inplace_schur(Cube& out, const eOpCube& x) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_rows = x.get_n_rows(); - const uword n_cols = x.get_n_cols(); - const uword n_slices = x.get_n_slices(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, out.n_slices, n_rows, n_cols, n_slices, "element-wise multiplication"); - - const eT k = x.aux; - eT* out_mem = out.memptr(); - - const bool use_mp = (arma_config::openmp) && (eOpCube::use_mp || (is_same_type::value && (is_cx::yes || x.aux != eT(2)))); - - if(ProxyCube::use_at == false) - { - const uword n_elem = out.n_elem; - - if(use_mp && mp_gate::eval(n_elem)) - { - typename ProxyCube::ea_type P = x.P.get_ea(); - - arma_applier_1_mp(*=); - } - else - { - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - if(x.P.is_aligned()) - { - typename ProxyCube::aligned_ea_type P = x.P.get_aligned_ea(); - - arma_applier_1a(*=); - } - else - { - typename ProxyCube::ea_type P = x.P.get_ea(); - - arma_applier_1u(*=); - } - } - else - { - typename ProxyCube::ea_type P = x.P.get_ea(); - - arma_applier_1u(*=); - } - } - } - else - { - const ProxyCube& P = x.P; - - if(use_mp && mp_gate::eval(x.get_n_elem())) - { - arma_applier_3_mp(*=); - } - else - { - arma_applier_3(*=); - } - } - } - - - -template -template -inline -void -eop_core::apply_inplace_div(Cube& out, const eOpCube& x) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_rows = x.get_n_rows(); - const uword n_cols = x.get_n_cols(); - const uword n_slices = x.get_n_slices(); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, out.n_slices, n_rows, n_cols, n_slices, "element-wise division"); - - const eT k = x.aux; - eT* out_mem = out.memptr(); - - const bool use_mp = (arma_config::openmp) && (eOpCube::use_mp || (is_same_type::value && (is_cx::yes || x.aux != eT(2)))); - - if(ProxyCube::use_at == false) - { - const uword n_elem = out.n_elem; - - if(use_mp && mp_gate::eval(n_elem)) - { - typename ProxyCube::ea_type P = x.P.get_ea(); - - arma_applier_1_mp(/=); - } - else - { - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - if(x.P.is_aligned()) - { - typename ProxyCube::aligned_ea_type P = x.P.get_aligned_ea(); - - arma_applier_1a(/=); - } - else - { - typename ProxyCube::ea_type P = x.P.get_ea(); - - arma_applier_1u(/=); - } - } - else - { - typename ProxyCube::ea_type P = x.P.get_ea(); - - arma_applier_1u(/=); - } - } - } - else - { - const ProxyCube& P = x.P; - - if(use_mp && mp_gate::eval(x.get_n_elem())) - { - arma_applier_3_mp(/=); - } - else - { - arma_applier_3(/=); - } - } - } - - - -// -// common - - - -template -template -arma_inline -eT -eop_core::process(const eT, const eT) - { - arma_stop_logic_error("eop_core::process(): unhandled eop_type"); - return eT(0); - } - - - -template<> template arma_inline eT -eop_core::process(const eT val, const eT k) { return val + k; } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT k) { return k - val; } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT k) { return val - k; } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT k) { return val * k; } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT k) { return k / val; } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT k) { return val / k; } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return val*val; } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::neg(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::sqrt(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::log(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::log2(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::log10(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return arma::trunc_log(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::log1p(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::exp(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::exp2(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::exp10(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return arma::trunc_exp(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::expm1(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::cos(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::sin(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::tan(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::acos(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::asin(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::atan(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::cosh(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::sinh(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::tanh(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::acosh(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::asinh(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::atanh(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return arma_sinc(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::direct_eps(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::arma_abs(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return arma_arg::eval(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::conj(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT k) { return eop_aux::pow(val, k); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::floor(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::ceil(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::round(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::trunc(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return arma_sign(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::cbrt(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::erf(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::erfc(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::lgamma(val); } - -template<> template arma_inline eT -eop_core::process(const eT val, const eT ) { return eop_aux::tgamma(val); } - - -#undef arma_applier_1u -#undef arma_applier_1a -#undef arma_applier_2 -#undef arma_applier_3 - -#undef arma_applier_1_mp -#undef arma_applier_2_mp -#undef arma_applier_3_mp - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fft_engine_fftw3.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fft_engine_fftw3.hpp deleted file mode 100644 index a50706486..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fft_engine_fftw3.hpp +++ /dev/null @@ -1,134 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// -// ------------------------------------------------------------------------ - - -//! \addtogroup fft_engine_fftw3 -//! @{ - - -#if defined(ARMA_USE_FFTW3) - -struct fft_engine_fftw3_aux - { - #if defined(ARMA_USE_STD_MUTEX) - static inline std::mutex& get_plan_mutex() { static std::mutex plan_mutex; return plan_mutex; } - #endif - }; - -template -class fft_engine_fftw3 - { - public: - - constexpr static int fftw3_sign_forward = -1; - constexpr static int fftw3_sign_backward = +1; - - constexpr static unsigned int fftw3_flag_destroy = (1u << 0); - constexpr static unsigned int fftw3_flag_preserve = (1u << 4); - constexpr static unsigned int fftw3_flag_estimate = (1u << 6); - - const uword N; - - void_ptr fftw3_plan; - - podarray X_work; // for storing copy of input (can be overwritten by FFTW3) - podarray Y_work; // for storing output - - inline - ~fft_engine_fftw3() - { - arma_debug_sigprint(); - - if(fftw3_plan != nullptr) { fftw3::destroy_plan(fftw3_plan); } - - // fftw3::cleanup(); // NOTE: this also removes any wisdom acquired by FFTW3 - } - - inline - fft_engine_fftw3(const uword in_N) - : N (in_N ) - , fftw3_plan(nullptr) - { - arma_debug_sigprint(); - - if(N == 0) { return; } - - if(N > uword(std::numeric_limits::max())) - { - arma_stop_runtime_error("integer overflow: FFT size too large for integer type used by FFTW3"); - } - - arma_debug_print("fft_engine_fftw3::constructor: allocating work arrays"); - X_work.set_size(N); - Y_work.set_size(N); - - const int fftw3_sign = (inverse) ? fftw3_sign_backward : fftw3_sign_forward; - const int fftw3_flags = fftw3_flag_destroy | fftw3_flag_estimate; - - arma_debug_print("fft_engine_fftw3::constructor: generating 1D plan"); - - // only fftw3::execute() is thread safe, as per FFTW docs: - // https://www.fftw.org/fftw3_doc/Thread-safety.html - - #if defined(ARMA_USE_OPENMP) - { - #pragma omp critical (arma_fft_engine_fftw3) - { - fftw3_plan = fftw3::plan_dft_1d(N, X_work.memptr(), Y_work.memptr(), fftw3_sign, fftw3_flags); - } - } - #elif defined(ARMA_USE_STD_MUTEX) - { - std::mutex& plan_mutex = fft_engine_fftw3_aux::get_plan_mutex(); - - const std::lock_guard lock(plan_mutex); - - fftw3_plan = fftw3::plan_dft_1d(N, X_work.memptr(), Y_work.memptr(), fftw3_sign, fftw3_flags); - } - #else - { - fftw3_plan = fftw3::plan_dft_1d(N, X_work.memptr(), Y_work.memptr(), fftw3_sign, fftw3_flags); - } - #endif - - if(fftw3_plan == nullptr) { arma_stop_runtime_error("fft_engine_fftw3::constructor: failed to create plan"); } - } - - inline - void - run(cx_type* Y, const cx_type* X) - { - arma_debug_sigprint(); - - if(fftw3_plan == nullptr) { return; } - - arma_debug_print("fft_engine_fftw3::run(): copying input array"); - arrayops::copy(X_work.memptr(), X, N); - - arma_debug_print("fft_engine_fftw3::run(): executing plan"); - fftw3::execute(fftw3_plan); - - arma_debug_print("fft_engine_fftw3::run(): copying output array"); - arrayops::copy(Y, Y_work.memptr(), N); - } - }; - -#endif - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fft_engine_kissfft.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fft_engine_kissfft.hpp deleted file mode 100644 index 9d528ca2e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fft_engine_kissfft.hpp +++ /dev/null @@ -1,392 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 AND BSD-3-Clause -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// -// ------------------------------------------------------------------------ -// -// This file includes portions of Kiss FFT software, -// licensed under the following conditions. -// -// Copyright (c) 2003-2010 Mark Borgerding -// All rights reserved. -// -// Redistribution and use in source and binary forms, with or without modification, -// are permitted provided that the following conditions are met: -// -// * Redistributions of source code must retain the above copyright notice, -// this list of conditions and the following disclaimer. -// -// * Redistributions in binary form must reproduce the above copyright notice, -// this list of conditions and the following disclaimer in the documentation -// and/or other materials provided with the distribution. -// -// * Neither the author nor the names of any contributors may be used to -// endorse or promote products derived from this software without specific -// prior written permission. -// -// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, -// THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -// PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR -// CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, -// EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -// PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; -// OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -// WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE -// OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, -// EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -// -// ------------------------------------------------------------------------ - - -//! \addtogroup fft_engine_kissfft -//! @{ - - -template -class fft_engine_kissfft - { - public: - - typedef typename get_pod_type::result T; - - const uword N; - - podarray coeffs_array; - podarray tmp_array; - - podarray residue; - podarray radix; - - - template - inline - uword - calc_radix() - { - uword i = 0; - - for(uword n = N, r=4; n >= 2; ++i) - { - while( (n % r) > 0 ) - { - switch(r) - { - case 2: r = 3; break; - case 4: r = 2; break; - default: r += 2; break; - } - - if(r*r > n) { r = n; } - } - - n /= r; - - if(fill) - { - residue[i] = n; - radix[i] = r; - } - } - - return i; - } - - - - inline - fft_engine_kissfft(const uword in_N) - : N(in_N) - { - arma_debug_sigprint(); - - const uword len = calc_radix(); - - residue.set_size(len); - radix.set_size(len); - - calc_radix(); - - - // calculate the constant coefficients - - coeffs_array.set_size(N); - - cx_type* coeffs = coeffs_array.memptr(); - - const T k = T( (inverse) ? +2 : -2 ) * std::acos( T(-1) ) / T(N); - - for(uword i=0; i < N; ++i) { coeffs[i] = std::exp( cx_type(T(0), i*k) ); } - } - - - - arma_hot - inline - void - butterfly_2(cx_type* Y, const uword stride, const uword m) const - { - // arma_debug_sigprint(); - - const cx_type* coeffs = coeffs_array.memptr(); - - for(uword i=0; i < m; ++i) - { - const cx_type t = Y[i+m] * coeffs[i*stride]; - - Y[i+m] = Y[i] - t; - Y[i ] += t; - } - } - - - - arma_hot - inline - void - butterfly_3(cx_type* Y, const uword stride, const uword m) const - { - // arma_debug_sigprint(); - - arma_aligned cx_type tmp[5]; - - const cx_type* coeffs1 = coeffs_array.memptr(); - const cx_type* coeffs2 = coeffs1; - - const T coeff_sm_imag = coeffs1[stride*m].imag(); - - const uword n = m*2; - - // TODO: rearrange the indices within tmp[] into a more sane order - - for(uword i = m; i > 0; --i) - { - tmp[1] = Y[m] * (*coeffs1); - tmp[2] = Y[n] * (*coeffs2); - - tmp[0] = tmp[1] - tmp[2]; - tmp[0] *= coeff_sm_imag; - - tmp[3] = tmp[1] + tmp[2]; - - Y[m] = cx_type( (Y[0].real() - (T(0.5)*tmp[3].real())), (Y[0].imag() - (T(0.5)*tmp[3].imag())) ); - - Y[0] += tmp[3]; - - - Y[n] = cx_type( (Y[m].real() + tmp[0].imag()), (Y[m].imag() - tmp[0].real()) ); - - Y[m] += cx_type( -tmp[0].imag(), tmp[0].real() ); - - Y++; - - coeffs1 += stride; - coeffs2 += stride*2; - } - } - - - - arma_hot - inline - void - butterfly_4(cx_type* Y, const uword stride, const uword m) const - { - // arma_debug_sigprint(); - - arma_aligned cx_type tmp[7]; - - const cx_type* coeffs = coeffs_array.memptr(); - - const uword m2 = m*2; - const uword m3 = m*3; - - // TODO: rearrange the indices within tmp[] into a more sane order - - for(uword i=0; i < m; ++i) - { - tmp[0] = Y[i + m ] * coeffs[i*stride ]; - tmp[2] = Y[i + m3] * coeffs[i*stride*3]; - tmp[3] = tmp[0] + tmp[2]; - - //tmp[4] = tmp[0] - tmp[2]; - //tmp[4] = (inverse) ? cx_type( -(tmp[4].imag()), tmp[4].real() ) : cx_type( tmp[4].imag(), -tmp[4].real() ); - - tmp[4] = (inverse) - ? cx_type( (tmp[2].imag() - tmp[0].imag()), (tmp[0].real() - tmp[2].real()) ) - : cx_type( (tmp[0].imag() - tmp[2].imag()), (tmp[2].real() - tmp[0].real()) ); - - tmp[1] = Y[i + m2] * coeffs[i*stride*2]; - tmp[5] = Y[i] - tmp[1]; - - - Y[i ] += tmp[1]; - Y[i + m2] = Y[i] - tmp[3]; - Y[i ] += tmp[3]; - Y[i + m ] = tmp[5] + tmp[4]; - Y[i + m3] = tmp[5] - tmp[4]; - } - } - - - - arma_hot - inline - void - butterfly_5(cx_type* Y, const uword stride, const uword m) const - { - // arma_debug_sigprint(); - - arma_aligned cx_type tmp[13]; - - const cx_type* coeffs = coeffs_array.memptr(); - - const T a_real = coeffs[stride*1*m].real(); - const T a_imag = coeffs[stride*1*m].imag(); - - const T b_real = coeffs[stride*2*m].real(); - const T b_imag = coeffs[stride*2*m].imag(); - - cx_type* Y0 = Y; - cx_type* Y1 = Y + 1*m; - cx_type* Y2 = Y + 2*m; - cx_type* Y3 = Y + 3*m; - cx_type* Y4 = Y + 4*m; - - for(uword i=0; i < m; ++i) - { - tmp[0] = (*Y0); - - tmp[1] = (*Y1) * coeffs[stride*1*i]; - tmp[2] = (*Y2) * coeffs[stride*2*i]; - tmp[3] = (*Y3) * coeffs[stride*3*i]; - tmp[4] = (*Y4) * coeffs[stride*4*i]; - - tmp[7] = tmp[1] + tmp[4]; - tmp[8] = tmp[2] + tmp[3]; - tmp[9] = tmp[2] - tmp[3]; - tmp[10] = tmp[1] - tmp[4]; - - (*Y0) += tmp[7]; - (*Y0) += tmp[8]; - - tmp[5] = tmp[0] + cx_type( ( (tmp[7].real() * a_real) + (tmp[8].real() * b_real) ), ( (tmp[7].imag() * a_real) + (tmp[8].imag() * b_real) ) ); - - tmp[6] = cx_type( ( (tmp[10].imag() * a_imag) + (tmp[9].imag() * b_imag) ), ( -(tmp[10].real() * a_imag) - (tmp[9].real() * b_imag) ) ); - - (*Y1) = tmp[5] - tmp[6]; - (*Y4) = tmp[5] + tmp[6]; - - tmp[11] = tmp[0] + cx_type( ( (tmp[7].real() * b_real) + (tmp[8].real() * a_real) ), ( (tmp[7].imag() * b_real) + (tmp[8].imag() * a_real) ) ); - - tmp[12] = cx_type( ( -(tmp[10].imag() * b_imag) + (tmp[9].imag() * a_imag) ), ( (tmp[10].real() * b_imag) - (tmp[9].real() * a_imag) ) ); - - (*Y2) = tmp[11] + tmp[12]; - (*Y3) = tmp[11] - tmp[12]; - - Y0++; - Y1++; - Y2++; - Y3++; - Y4++; - } - } - - - - arma_hot - inline - void - butterfly_N(cx_type* Y, const uword stride, const uword m, const uword r) - { - // arma_debug_sigprint(); - - const cx_type* coeffs = coeffs_array.memptr(); - - tmp_array.set_min_size(r); - cx_type* tmp = tmp_array.memptr(); - - for(uword u=0; u < m; ++u) - { - uword k = u; - - for(uword v=0; v < r; ++v) - { - tmp[v] = Y[k]; - k += m; - } - - k = u; - - for(uword v=0; v < r; ++v) - { - Y[k] = tmp[0]; - - uword j = 0; - - for(uword w=1; w < r; ++w) - { - j += stride * k; - - if(j >= N) { j -= N; } - - Y[k] += tmp[w] * coeffs[j]; - } - - k += m; - } - } - } - - - - inline - void - run(cx_type* Y, const cx_type* X, const uword stage = 0, const uword stride = 1) - { - arma_debug_sigprint(); - - const uword m = residue[stage]; - const uword r = radix[stage]; - - const cx_type *Y_end = Y + r*m; - - if(m == 1) - { - for(cx_type* Yi = Y; Yi != Y_end; Yi++, X += stride) { (*Yi) = (*X); } - } - else - { - const uword next_stage = stage + 1; - const uword next_stride = stride * r; - - for(cx_type* Yi = Y; Yi != Y_end; Yi += m, X += stride) { run(Yi, X, next_stage, next_stride); } - } - - switch(r) - { - case 2: butterfly_2(Y, stride, m ); break; - case 3: butterfly_3(Y, stride, m ); break; - case 4: butterfly_4(Y, stride, m ); break; - case 5: butterfly_5(Y, stride, m ); break; - default: butterfly_N(Y, stride, m, r); break; - } - } - - - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/field_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/field_bones.hpp deleted file mode 100644 index d3d2b053a..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/field_bones.hpp +++ /dev/null @@ -1,357 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup field -//! @{ - - - -struct field_prealloc_n_elem - { - static constexpr uword val = 16; - }; - - - -//! A lightweight 1D/2D/3D container for arbitrary objects -//! (the objects must have a copy constructor) - -template -class field - { - public: - - typedef oT object_type; - - const uword n_rows; //!< number of rows (read-only) - const uword n_cols; //!< number of columns (read-only) - const uword n_slices; //!< number of slices (read-only) - const uword n_elem; //!< number of elements (read-only) - - - private: - - arma_aligned oT** mem; //!< pointers to stored objects - arma_aligned oT* mem_local[ field_prealloc_n_elem::val ]; //!< local storage, for small fields - - - public: - - inline ~field(); - inline field(); - - inline field(const field& x); - inline field& operator=(const field& x); - - inline field(const subview_field& x); - inline field& operator=(const subview_field& x); - - inline explicit field(const uword n_elem_in); - inline explicit field(const uword n_rows_in, const uword n_cols_in); - inline explicit field(const uword n_rows_in, const uword n_cols_in, const uword n_slices_in); - inline explicit field(const SizeMat& s); - inline explicit field(const SizeCube& s); - - inline field& set_size(const uword n_obj_in); - inline field& set_size(const uword n_rows_in, const uword n_cols_in); - inline field& set_size(const uword n_rows_in, const uword n_cols_in, const uword n_slices_in); - inline field& set_size(const SizeMat& s); - inline field& set_size(const SizeCube& s); - - inline field(const std::vector& x); - inline field& operator=(const std::vector& x); - - inline field(const std::initializer_list& list); - inline field& operator=(const std::initializer_list& list); - - inline field(const std::initializer_list< std::initializer_list >& list); - inline field& operator=(const std::initializer_list< std::initializer_list >& list); - - inline field(field&& X); - inline field& operator=(field&& X); - - template - inline field& copy_size(const field& x); - - arma_warn_unused arma_inline oT& operator[](const uword i); - arma_warn_unused arma_inline const oT& operator[](const uword i) const; - - arma_warn_unused arma_inline oT& at(const uword i); - arma_warn_unused arma_inline const oT& at(const uword i) const; - - arma_warn_unused arma_inline oT& operator()(const uword i); - arma_warn_unused arma_inline const oT& operator()(const uword i) const; - - #if defined(__cpp_multidimensional_subscript) - arma_warn_unused arma_inline oT& operator[](const uword row, const uword col); - arma_warn_unused arma_inline const oT& operator[](const uword row, const uword col) const; - #endif - - arma_warn_unused arma_inline oT& at(const uword row, const uword col); - arma_warn_unused arma_inline const oT& at(const uword row, const uword col) const; - - #if defined(__cpp_multidimensional_subscript) - arma_warn_unused arma_inline oT& operator[](const uword row, const uword col, const uword slice); - arma_warn_unused arma_inline const oT& operator[](const uword row, const uword col, const uword slice) const; - #endif - - arma_warn_unused arma_inline oT& at(const uword row, const uword col, const uword slice); - arma_warn_unused arma_inline const oT& at(const uword row, const uword col, const uword slice) const; - - arma_warn_unused arma_inline oT& operator()(const uword row, const uword col); - arma_warn_unused arma_inline const oT& operator()(const uword row, const uword col) const; - - arma_warn_unused arma_inline oT& operator()(const uword row, const uword col, const uword slice); - arma_warn_unused arma_inline const oT& operator()(const uword row, const uword col, const uword slice) const; - - - arma_warn_unused arma_inline oT& front(); - arma_warn_unused arma_inline const oT& front() const; - - arma_warn_unused arma_inline oT& back(); - arma_warn_unused arma_inline const oT& back() const; - - - arma_frown("use braced initialiser list instead") inline field_injector operator<<(const oT& val); - arma_frown("use braced initialiser list instead") inline field_injector operator<<(const injector_end_of_row<>& x); - - - inline subview_field row(const uword row_num); - inline const subview_field row(const uword row_num) const; - - inline subview_field col(const uword col_num); - inline const subview_field col(const uword col_num) const; - - inline subview_field slice(const uword slice_num); - inline const subview_field slice(const uword slice_num) const; - - inline subview_field rows(const uword in_row1, const uword in_row2); - inline const subview_field rows(const uword in_row1, const uword in_row2) const; - - inline subview_field cols(const uword in_col1, const uword in_col2); - inline const subview_field cols(const uword in_col1, const uword in_col2) const; - - inline subview_field slices(const uword in_slice1, const uword in_slice2); - inline const subview_field slices(const uword in_slice1, const uword in_slice2) const; - - inline subview_field subfield(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2); - inline const subview_field subfield(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2) const; - - inline subview_field subfield(const uword in_row1, const uword in_col1, const uword in_slice1, const uword in_row2, const uword in_col2, const uword in_slice2); - inline const subview_field subfield(const uword in_row1, const uword in_col1, const uword in_slice1, const uword in_row2, const uword in_col2, const uword in_slice2) const; - - inline subview_field subfield(const uword in_row1, const uword in_col1, const SizeMat& s); - inline const subview_field subfield(const uword in_row1, const uword in_col1, const SizeMat& s) const; - - inline subview_field subfield(const uword in_row1, const uword in_col1, const uword in_slice1, const SizeCube& s); - inline const subview_field subfield(const uword in_row1, const uword in_col1, const uword in_slice1, const SizeCube& s) const; - - inline subview_field subfield(const span& row_span, const span& col_span); - inline const subview_field subfield(const span& row_span, const span& col_span) const; - - inline subview_field subfield(const span& row_span, const span& col_span, const span& slice_span); - inline const subview_field subfield(const span& row_span, const span& col_span, const span& slice_span) const; - - inline subview_field operator()(const span& row_span, const span& col_span); - inline const subview_field operator()(const span& row_span, const span& col_span) const; - - inline subview_field operator()(const span& row_span, const span& col_span, const span& slice_span); - inline const subview_field operator()(const span& row_span, const span& col_span, const span& slice_span) const; - - inline subview_field operator()(const uword in_row1, const uword in_col1, const SizeMat& s); - inline const subview_field operator()(const uword in_row1, const uword in_col1, const SizeMat& s) const; - - inline subview_field operator()(const uword in_row1, const uword in_col1, const uword in_slice1, const SizeCube& s); - inline const subview_field operator()(const uword in_row1, const uword in_col1, const uword in_slice1, const SizeCube& s) const; - - - arma_cold inline void print( const std::string extra_text = "") const; - arma_cold inline void print(std::ostream& user_stream, const std::string extra_text = "") const; - - inline field& for_each(const std::function< void( oT&) >& F); - inline const field& for_each(const std::function< void(const oT&) >& F) const; - - inline field& fill(const oT& x); - - inline void reset(); - inline void reset_objects(); - - arma_warn_unused arma_inline bool is_empty() const; - - - arma_warn_unused arma_inline bool in_range(const uword i) const; - arma_warn_unused arma_inline bool in_range(const span& x) const; - - arma_warn_unused arma_inline bool in_range(const uword in_row, const uword in_col) const; - arma_warn_unused arma_inline bool in_range(const span& row_span, const uword in_col) const; - arma_warn_unused arma_inline bool in_range(const uword in_row, const span& col_span) const; - arma_warn_unused arma_inline bool in_range(const span& row_span, const span& col_span) const; - - arma_warn_unused arma_inline bool in_range(const uword in_row, const uword in_col, const SizeMat& s) const; - - arma_warn_unused arma_inline bool in_range(const uword in_row, const uword in_col, const uword in_slice) const; - arma_warn_unused arma_inline bool in_range(const span& row_span, const span& col_span, const span& slice_span) const; - - arma_warn_unused arma_inline bool in_range(const uword in_row, const uword in_col, const uword in_slice, const SizeCube& s) const; - - - arma_cold inline bool save(const std::string name, const file_type type = arma_binary) const; - arma_cold inline bool save( std::ostream& os, const file_type type = arma_binary) const; - - arma_cold inline bool load(const std::string name, const file_type type = auto_detect); - arma_cold inline bool load( std::istream& is, const file_type type = auto_detect); - - - arma_deprecated inline bool quiet_save(const std::string name, const file_type type = arma_binary) const; - arma_deprecated inline bool quiet_save( std::ostream& os, const file_type type = arma_binary) const; - - arma_deprecated inline bool quiet_load(const std::string name, const file_type type = auto_detect); - arma_deprecated inline bool quiet_load( std::istream& is, const file_type type = auto_detect); - - - // for container-like functionality - - typedef oT value_type; - typedef uword size_type; - - - class iterator - { - public: - - inline iterator(field& in_M, const bool at_end = false); - - inline oT& operator* (); - - inline iterator& operator++(); - inline void operator++(int); - - inline iterator& operator--(); - inline void operator--(int); - - inline bool operator!=(const iterator& X) const; - inline bool operator==(const iterator& X) const; - - arma_aligned field& M; - arma_aligned uword i; - }; - - - class const_iterator - { - public: - - const_iterator(const field& in_M, const bool at_end = false); - const_iterator(const iterator& X); - - inline const oT& operator*() const; - - inline const_iterator& operator++(); - inline void operator++(int); - - inline const_iterator& operator--(); - inline void operator--(int); - - inline bool operator!=(const const_iterator& X) const; - inline bool operator==(const const_iterator& X) const; - - arma_aligned const field& M; - arma_aligned uword i; - }; - - inline iterator begin(); - inline const_iterator begin() const; - inline const_iterator cbegin() const; - - inline iterator end(); - inline const_iterator end() const; - inline const_iterator cend() const; - - inline void clear(); - inline bool empty() const; - inline uword size() const; - - - private: - - inline void init(const field& x); - inline void init(const uword n_rows_in, const uword n_cols_in); - inline void init(const uword n_rows_in, const uword n_cols_in, const uword n_slices_in); - - inline void delete_objects(); - inline void create_objects(); - - friend class field_aux; - friend class subview_field; - - - public: - - #if defined(ARMA_EXTRA_FIELD_PROTO) - #include ARMA_INCFILE_WRAP(ARMA_EXTRA_FIELD_PROTO) - #endif - }; - - - -class field_aux - { - public: - - template inline static void reset_objects(field< oT >& x); - template inline static void reset_objects(field< Mat >& x); - template inline static void reset_objects(field< Col >& x); - template inline static void reset_objects(field< Row >& x); - template inline static void reset_objects(field< Cube >& x); - inline static void reset_objects(field< std::string >& x); - - - template inline static bool save(const field< oT >& x, const std::string& name, const file_type type, std::string& err_msg); - template inline static bool save(const field< oT >& x, std::ostream& os, const file_type type, std::string& err_msg); - template inline static bool load( field< oT >& x, const std::string& name, const file_type type, std::string& err_msg); - template inline static bool load( field< oT >& x, std::istream& is, const file_type type, std::string& err_msg); - - template inline static bool save(const field< Mat >& x, const std::string& name, const file_type type, std::string& err_msg); - template inline static bool save(const field< Mat >& x, std::ostream& os, const file_type type, std::string& err_msg); - template inline static bool load( field< Mat >& x, const std::string& name, const file_type type, std::string& err_msg); - template inline static bool load( field< Mat >& x, std::istream& is, const file_type type, std::string& err_msg); - - template inline static bool save(const field< Col >& x, const std::string& name, const file_type type, std::string& err_msg); - template inline static bool save(const field< Col >& x, std::ostream& os, const file_type type, std::string& err_msg); - template inline static bool load( field< Col >& x, const std::string& name, const file_type type, std::string& err_msg); - template inline static bool load( field< Col >& x, std::istream& is, const file_type type, std::string& err_msg); - - template inline static bool save(const field< Row >& x, const std::string& name, const file_type type, std::string& err_msg); - template inline static bool save(const field< Row >& x, std::ostream& os, const file_type type, std::string& err_msg); - template inline static bool load( field< Row >& x, const std::string& name, const file_type type, std::string& err_msg); - template inline static bool load( field< Row >& x, std::istream& is, const file_type type, std::string& err_msg); - - template inline static bool save(const field< Cube >& x, const std::string& name, const file_type type, std::string& err_msg); - template inline static bool save(const field< Cube >& x, std::ostream& os, const file_type type, std::string& err_msg); - template inline static bool load( field< Cube >& x, const std::string& name, const file_type type, std::string& err_msg); - template inline static bool load( field< Cube >& x, std::istream& is, const file_type type, std::string& err_msg); - - inline static bool save(const field< std::string >& x, const std::string& name, const file_type type, std::string& err_msg); - inline static bool save(const field< std::string >& x, std::ostream& os, const file_type type, std::string& err_msg); - inline static bool load( field< std::string >& x, const std::string& name, const file_type type, std::string& err_msg); - inline static bool load( field< std::string >& x, std::istream& is, const file_type type, std::string& err_msg); - - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/field_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/field_meat.hpp deleted file mode 100644 index 1ae7cce14..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/field_meat.hpp +++ /dev/null @@ -1,2999 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup field -//! @{ - - -template -inline -field::~field() - { - arma_debug_sigprint_this(this); - - delete_objects(); - - if(n_elem > field_prealloc_n_elem::val) { delete [] mem; } - - // try to expose buggy user code that accesses deleted objects - mem = nullptr; - } - - - -template -inline -field::field() - : n_rows(0) - , n_cols(0) - , n_slices(0) - , n_elem(0) - , mem(nullptr) - { - arma_debug_sigprint_this(this); - } - - - -//! construct a field from a given field -template -inline -field::field(const field& x) - : n_rows(0) - , n_cols(0) - , n_slices(0) - , n_elem(0) - , mem(nullptr) - { - arma_debug_sigprint(arma_str::format("this: %x; x: %x") % this % &x); - - init(x); - } - - - -//! construct a field from a given field -template -inline -field& -field::operator=(const field& x) - { - arma_debug_sigprint(); - - init(x); - - return *this; - } - - - -//! construct a field from subview_field (eg. construct a field from a delayed subfield operation) -template -inline -field::field(const subview_field& X) - : n_rows(0) - , n_cols(0) - , n_slices(0) - , n_elem(0) - , mem(nullptr) - { - arma_debug_sigprint_this(this); - - this->operator=(X); - } - - - -//! construct a field from subview_field (eg. construct a field from a delayed subfield operation) -template -inline -field& -field::operator=(const subview_field& X) - { - arma_debug_sigprint(); - - subview_field::extract(*this, X); - - return *this; - } - - - -//! construct the field with the specified number of elements, -//! assuming a column-major layout -template -inline -field::field(const uword n_elem_in) - : n_rows(0) - , n_cols(0) - , n_slices(0) - , n_elem(0) - , mem(nullptr) - { - arma_debug_sigprint_this(this); - - init(n_elem_in, 1); - } - - - -//! construct the field with the specified dimensions -template -inline -field::field(const uword n_rows_in, const uword n_cols_in) - : n_rows(0) - , n_cols(0) - , n_slices(0) - , n_elem(0) - , mem(nullptr) - { - arma_debug_sigprint_this(this); - - init(n_rows_in, n_cols_in); - } - - - -//! construct the field with the specified dimensions -template -inline -field::field(const uword n_rows_in, const uword n_cols_in, const uword n_slices_in) - : n_rows(0) - , n_cols(0) - , n_slices(0) - , n_elem(0) - , mem(nullptr) - { - arma_debug_sigprint_this(this); - - init(n_rows_in, n_cols_in, n_slices_in); - } - - - -template -inline -field::field(const SizeMat& s) - : n_rows(0) - , n_cols(0) - , n_slices(0) - , n_elem(0) - , mem(nullptr) - { - arma_debug_sigprint_this(this); - - init(s.n_rows, s.n_cols); - } - - - -template -inline -field::field(const SizeCube& s) - : n_rows(0) - , n_cols(0) - , n_slices(0) - , n_elem(0) - , mem(nullptr) - { - arma_debug_sigprint_this(this); - - init(s.n_rows, s.n_cols, s.n_slices); - } - - - -//! change the field to have the specified number of elements, -//! assuming a column-major layout (data is not preserved) -template -inline -field& -field::set_size(const uword n_elem_in) - { - arma_debug_sigprint(arma_str::format("n_elem_in: %u") % n_elem_in); - - init(n_elem_in, 1); - - return *this; - } - - - -//! change the field to have the specified dimensions (data is not preserved) -template -inline -field& -field::set_size(const uword n_rows_in, const uword n_cols_in) - { - arma_debug_sigprint(arma_str::format("n_rows_in: %u; n_cols_in: %u") % n_rows_in % n_cols_in); - - init(n_rows_in, n_cols_in); - - return *this; - } - - - -//! change the field to have the specified dimensions (data is not preserved) -template -inline -field& -field::set_size(const uword n_rows_in, const uword n_cols_in, const uword n_slices_in) - { - arma_debug_sigprint(arma_str::format("n_rows_in: %u; n_cols_in: %u; n_slices_in: %u") % n_rows_in % n_cols_in % n_slices_in); - - init(n_rows_in, n_cols_in, n_slices_in); - - return *this; - } - - - -template -inline -field& -field::set_size(const SizeMat& s) - { - arma_debug_sigprint(); - - init(s.n_rows, s.n_cols); - - return *this; - } - - - -template -inline -field& -field::set_size(const SizeCube& s) - { - arma_debug_sigprint(); - - init(s.n_rows, s.n_cols, s.n_slices); - - return *this; - } - - - -template -inline -field::field(const std::vector& x) - : n_rows (0) - , n_cols (0) - , n_slices(0) - , n_elem (0) - { - arma_debug_sigprint_this(this); - - (*this).operator=(x); - } - - - -template -inline -field& -field::operator=(const std::vector& x) - { - arma_debug_sigprint(); - - const uword N = uword(x.size()); - - set_size(N, 1); - - for(uword i=0; i -inline -field::field(const std::initializer_list& list) - : n_rows (0) - , n_cols (0) - , n_slices(0) - , n_elem (0) - { - arma_debug_sigprint_this(this); - - (*this).operator=(list); - } - - - -template -inline -field& -field::operator=(const std::initializer_list& list) - { - arma_debug_sigprint(); - - const uword N = uword(list.size()); - - set_size(1, N); - - const oT* item_ptr = list.begin(); - - for(uword i=0; i -inline -field::field(const std::initializer_list< std::initializer_list >& list) - : n_rows (0) - , n_cols (0) - , n_slices(0) - , n_elem (0) - { - arma_debug_sigprint_this(this); - - (*this).operator=(list); - } - - - -template -inline -field& -field::operator=(const std::initializer_list< std::initializer_list >& list) - { - arma_debug_sigprint(); - - uword x_n_rows = uword(list.size()); - uword x_n_cols = 0; - - auto it = list.begin(); - auto it_end = list.end(); - - for(; it != it_end; ++it) { x_n_cols = (std::max)(x_n_cols, uword((*it).size())); } - - field& t = (*this); - - t.set_size(x_n_rows, x_n_cols); - - uword row_num = 0; - - auto row_it = list.begin(); - auto row_it_end = list.end(); - - for(; row_it != row_it_end; ++row_it) - { - uword col_num = 0; - - auto col_it = (*row_it).begin(); - auto col_it_end = (*row_it).end(); - - for(; col_it != col_it_end; ++col_it) - { - t.at(row_num, col_num) = (*col_it); - ++col_num; - } - - for(uword c=col_num; c < x_n_cols; ++c) - { - t.at(row_num, c) = oT(); - } - - ++row_num; - } - - return *this; - } - - - -template -inline -field::field(field&& X) - : n_rows (X.n_rows ) - , n_cols (X.n_cols ) - , n_slices(X.n_slices) - , n_elem (X.n_elem ) - { - arma_debug_sigprint(arma_str::format("this: %x; X: %x") % this % &X); - - if(n_elem > field_prealloc_n_elem::val) - { - mem = X.mem; - } - else - { - arrayops::copy(&mem_local[0], &X.mem_local[0], n_elem); - mem = mem_local; - } - - access::rw(X.n_rows ) = 0; - access::rw(X.n_cols ) = 0; - access::rw(X.n_slices) = 0; - access::rw(X.n_elem ) = 0; - access::rw(X.mem ) = nullptr; - } - - - -template -inline -field& -field::operator=(field&& X) - { - arma_debug_sigprint(arma_str::format("this: %x; X: %x") % this % &X); - - if(this == &X) { return *this; } - - reset(); - - access::rw(n_rows ) = X.n_rows; - access::rw(n_cols ) = X.n_cols; - access::rw(n_slices) = X.n_slices; - access::rw(n_elem ) = X.n_elem; - - if(n_elem > field_prealloc_n_elem::val) - { - mem = X.mem; - } - else - { - arrayops::copy(&mem_local[0], &X.mem_local[0], n_elem); - mem = mem_local; - } - - access::rw(X.n_rows ) = 0; - access::rw(X.n_cols ) = 0; - access::rw(X.n_elem ) = 0; - access::rw(X.n_slices) = 0; - access::rw(X.mem ) = nullptr; - - return *this; - } - - - -//! change the field to have the specified dimensions (data is not preserved) -template -template -inline -field& -field::copy_size(const field& x) - { - arma_debug_sigprint(); - - init(x.n_rows, x.n_cols, x.n_slices); - - return *this; - } - - - -//! linear element accessor (treats the field as a vector); no bounds check -template -arma_inline -oT& -field::operator[] (const uword i) - { - return (*mem[i]); - } - - - -//! linear element accessor (treats the field as a vector); no bounds check -template -arma_inline -const oT& -field::operator[] (const uword i) const - { - return (*mem[i]); - } - - - -//! linear element accessor (treats the field as a vector); no bounds check -template -arma_inline -oT& -field::at(const uword i) - { - return (*mem[i]); - } - - - -//! linear element accessor (treats the field as a vector); no bounds check -template -arma_inline -const oT& -field::at(const uword i) const - { - return (*mem[i]); - } - - - -//! linear element accessor (treats the field as a vector); bounds checking not done when ARMA_NO_DEBUG is defined -template -arma_inline -oT& -field::operator() (const uword i) - { - arma_conform_check_bounds( (i >= n_elem), "field::operator(): index out of bounds" ); - - return (*mem[i]); - } - - - -//! linear element accessor (treats the field as a vector); bounds checking not done when ARMA_NO_DEBUG is defined -template -arma_inline -const oT& -field::operator() (const uword i) const - { - arma_conform_check_bounds( (i >= n_elem), "field::operator(): index out of bounds" ); - - return (*mem[i]); - } - - - -//! element accessor; bounds checking not done when ARMA_NO_DEBUG is defined -template -arma_inline -oT& -field::operator() (const uword in_row, const uword in_col) - { - arma_conform_check_bounds( ((in_row >= n_rows) || (in_col >= n_cols) || (0 >= n_slices) ), "field::operator(): index out of bounds" ); - - return (*mem[in_row + in_col*n_rows]); - } - - - -//! element accessor; bounds checking not done when ARMA_NO_DEBUG is defined -template -arma_inline -const oT& -field::operator() (const uword in_row, const uword in_col) const - { - arma_conform_check_bounds( ((in_row >= n_rows) || (in_col >= n_cols) || (0 >= n_slices) ), "field::operator(): index out of bounds" ); - - return (*mem[in_row + in_col*n_rows]); - } - - - -//! element accessor; bounds checking not done when ARMA_NO_DEBUG is defined -template -arma_inline -oT& -field::operator() (const uword in_row, const uword in_col, const uword in_slice) - { - arma_conform_check_bounds( ((in_row >= n_rows) || (in_col >= n_cols) || (in_slice >= n_slices)), "field::operator(): index out of bounds" ); - - return (*mem[in_row + in_col*n_rows + in_slice*(n_rows*n_cols)]); - } - - - -//! element accessor; bounds checking not done when ARMA_NO_DEBUG is defined -template -arma_inline -const oT& -field::operator() (const uword in_row, const uword in_col, const uword in_slice) const - { - arma_conform_check_bounds( ((in_row >= n_rows) || (in_col >= n_cols) || (in_slice >= n_slices)), "field::operator(): index out of bounds" ); - - return (*mem[in_row + in_col*n_rows + in_slice*(n_rows*n_cols)]); - } - - - -#if defined(__cpp_multidimensional_subscript) - - //! element accessor; no bounds check - template - arma_inline - oT& - field::operator[] (const uword in_row, const uword in_col) - { - return (*mem[in_row + in_col*n_rows]); - } - - - - //! element accessor; no bounds check - template - arma_inline - const oT& - field::operator[] (const uword in_row, const uword in_col) const - { - return (*mem[in_row + in_col*n_rows]); - } - -#endif - - - -//! element accessor; no bounds check -template -arma_inline -oT& -field::at(const uword in_row, const uword in_col) - { - return (*mem[in_row + in_col*n_rows]); - } - - - -//! element accessor; no bounds check -template -arma_inline -const oT& -field::at(const uword in_row, const uword in_col) const - { - return (*mem[in_row + in_col*n_rows]); - } - - - -#if defined(__cpp_multidimensional_subscript) - - //! element accessor; no bounds check - template - arma_inline - oT& - field::operator[] (const uword in_row, const uword in_col, const uword in_slice) - { - return (*mem[in_row + in_col*n_rows + in_slice*(n_rows*n_cols)]); - } - - - - //! element accessor; no bounds check - template - arma_inline - const oT& - field::operator[] (const uword in_row, const uword in_col, const uword in_slice) const - { - return (*mem[in_row + in_col*n_rows + in_slice*(n_rows*n_cols)]); - } - -#endif - - - -//! element accessor; no bounds check -template -arma_inline -oT& -field::at(const uword in_row, const uword in_col, const uword in_slice) - { - return (*mem[in_row + in_col*n_rows + in_slice*(n_rows*n_cols)]); - } - - - -//! element accessor; no bounds check -template -arma_inline -const oT& -field::at(const uword in_row, const uword in_col, const uword in_slice) const - { - return (*mem[in_row + in_col*n_rows + in_slice*(n_rows*n_cols)]); - } - - - -template -arma_inline -oT& -field::front() - { - arma_conform_check( (n_elem == 0), "field::front(): field is empty" ); - - return (*mem[0]); - } - - - -template -arma_inline -const oT& -field::front() const - { - arma_conform_check( (n_elem == 0), "field::front(): field is empty" ); - - return (*mem[0]); - } - - - -template -arma_inline -oT& -field::back() - { - arma_conform_check( (n_elem == 0), "field::back(): field is empty" ); - - return (*mem[n_elem-1]); - } - - - -template -arma_inline -const oT& -field::back() const - { - arma_conform_check( (n_elem == 0), "field::back(): field is empty" ); - - return (*mem[n_elem-1]); - } - - - -template -inline -field_injector< field > -field::operator<<(const oT& val) - { - return field_injector< field >(*this, val); - } - - - -template -inline -field_injector< field > -field::operator<<(const injector_end_of_row<>& x) - { - return field_injector< field >(*this, x); - } - - - -//! creation of subview_field (row of a field) -template -inline -subview_field -field::row(const uword row_num) - { - arma_debug_sigprint(); - - arma_conform_check( (n_slices >= 2), "field::row(): field must be 2D" ); - - arma_conform_check_bounds( (row_num >= n_rows), "field::row(): row out of bounds" ); - - return subview_field(*this, row_num, 0, 1, n_cols); - } - - - -//! creation of subview_field (row of a field) -template -inline -const subview_field -field::row(const uword row_num) const - { - arma_debug_sigprint(); - - arma_conform_check( (n_slices >= 2), "field::row(): field must be 2D" ); - - arma_conform_check_bounds( (row_num >= n_rows), "field::row(): row out of bounds" ); - - return subview_field(*this, row_num, 0, 1, n_cols); - } - - - -//! creation of subview_field (column of a field) -template -inline -subview_field -field::col(const uword col_num) - { - arma_debug_sigprint(); - - arma_conform_check( (n_slices >= 2), "field::col(): field must be 2D" ); - - arma_conform_check_bounds( (col_num >= n_cols), "field::col(): out of bounds" ); - - return subview_field(*this, 0, col_num, n_rows, 1); - } - - - -//! creation of subview_field (column of a field) -template -inline -const subview_field -field::col(const uword col_num) const - { - arma_debug_sigprint(); - - arma_conform_check( (n_slices >= 2), "field::col(): field must be 2D" ); - - arma_conform_check_bounds( (col_num >= n_cols), "field::col(): out of bounds" ); - - return subview_field(*this, 0, col_num, n_rows, 1); - } - - - -//! creation of subview_field (slice of a field) -template -inline -subview_field -field::slice(const uword slice_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (slice_num >= n_slices), "field::slice(): out of bounds" ); - - return subview_field(*this, 0, 0, slice_num, n_rows, n_cols, 1); - } - - - -//! creation of subview_field (slice of a field) -template -inline -const subview_field -field::slice(const uword slice_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (slice_num >= n_slices), "field::slice(): out of bounds" ); - - return subview_field(*this, 0, 0, slice_num, n_rows, n_cols, 1); - } - - - -//! creation of subview_field (subfield comprised of specified rows) -template -inline -subview_field -field::rows(const uword in_row1, const uword in_row2) - { - arma_debug_sigprint(); - - arma_conform_check( (n_slices >= 2), "field::rows(): field must be 2D" ); - - arma_conform_check_bounds - ( - ( (in_row1 > in_row2) || (in_row2 >= n_rows) ), - "field::rows(): indicies out of bounds or incorrectly used" - ); - - const uword sub_n_rows = in_row2 - in_row1 + 1; - - return subview_field(*this, in_row1, 0, sub_n_rows, n_cols); - } - - - -//! creation of subview_field (subfield comprised of specified rows) -template -inline -const subview_field -field::rows(const uword in_row1, const uword in_row2) const - { - arma_debug_sigprint(); - - arma_conform_check( (n_slices >= 2), "field::rows(): field must be 2D" ); - - arma_conform_check_bounds - ( - ( (in_row1 > in_row2) || (in_row2 >= n_rows) ), - "field::rows(): indicies out of bounds or incorrectly used" - ); - - const uword sub_n_rows = in_row2 - in_row1 + 1; - - return subview_field(*this, in_row1, 0, sub_n_rows, n_cols); - } - - - -//! creation of subview_field (subfield comprised of specified columns) -template -inline -subview_field -field::cols(const uword in_col1, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check( (n_slices >= 2), "field::cols(): field must be 2D" ); - - arma_conform_check_bounds - ( - ( (in_col1 > in_col2) || (in_col2 >= n_cols) ), - "field::cols(): indicies out of bounds or incorrectly used" - ); - - const uword sub_n_cols = in_col2 - in_col1 + 1; - - return subview_field(*this, 0, in_col1, n_rows, sub_n_cols); - } - - - -//! creation of subview_field (subfield comprised of specified columns) -template -inline -const subview_field -field::cols(const uword in_col1, const uword in_col2) const - { - arma_debug_sigprint(); - - arma_conform_check( (n_slices >= 2), "field::cols(): field must be 2D" ); - - arma_conform_check_bounds - ( - ( (in_col1 > in_col2) || (in_col2 >= n_cols) ), - "field::cols(): indicies out of bounds or incorrectly used" - ); - - const uword sub_n_cols = in_col2 - in_col1 + 1; - - return subview_field(*this, 0, in_col1, n_rows, sub_n_cols); - } - - - -//! creation of subview_field (subfield comprised of specified slices) -template -inline -subview_field -field::slices(const uword in_slice1, const uword in_slice2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - ( (in_slice1 > in_slice2) || (in_slice2 >= n_slices) ), - "field::slices(): indicies out of bounds or incorrectly used" - ); - - const uword sub_n_slices = in_slice2 - in_slice1 + 1; - - return subview_field(*this, 0, 0, in_slice1, n_rows, n_cols, sub_n_slices); - } - - - -//! creation of subview_field (subfield comprised of specified slices) -template -inline -const subview_field -field::slices(const uword in_slice1, const uword in_slice2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - ( (in_slice1 > in_slice2) || (in_slice2 >= n_slices) ), - "field::slices(): indicies out of bounds or incorrectly used" - ); - - const uword sub_n_slices = in_slice2 - in_slice1 + 1; - - return subview_field(*this, 0, 0, in_slice1, n_rows, n_cols, sub_n_slices); - } - - - -//! creation of subview_field (subfield with arbitrary dimensions) -template -inline -subview_field -field::subfield(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check( (n_slices >= 2), "field::subfield(): field must be 2D" ); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_col1 > in_col2) || (in_row2 >= n_rows) || (in_col2 >= n_cols), - "field::subfield(): indices out of bounds or incorrectly used" - ); - - const uword sub_n_rows = in_row2 - in_row1 + 1; - const uword sub_n_cols = in_col2 - in_col1 + 1; - - return subview_field(*this, in_row1, in_col1, sub_n_rows, sub_n_cols); - } - - - -//! creation of subview_field (subfield with arbitrary dimensions) -template -inline -const subview_field -field::subfield(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2) const - { - arma_debug_sigprint(); - - arma_conform_check( (n_slices >= 2), "field::subfield(): field must be 2D" ); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_col1 > in_col2) || (in_row2 >= n_rows) || (in_col2 >= n_cols), - "field::subfield(): indices out of bounds or incorrectly used" - ); - - const uword sub_n_rows = in_row2 - in_row1 + 1; - const uword sub_n_cols = in_col2 - in_col1 + 1; - - return subview_field(*this, in_row1, in_col1, sub_n_rows, sub_n_cols); - } - - - -//! creation of subview_field (subfield with arbitrary dimensions) -template -inline -subview_field -field::subfield(const uword in_row1, const uword in_col1, const uword in_slice1, const uword in_row2, const uword in_col2, const uword in_slice2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_col1 > in_col2) || (in_slice1 > in_slice2) || (in_row2 >= n_rows) || (in_col2 >= n_cols) || (in_slice2 >= n_slices), - "field::subfield(): indices out of bounds or incorrectly used" - ); - - const uword sub_n_rows = in_row2 - in_row1 + 1; - const uword sub_n_cols = in_col2 - in_col1 + 1; - const uword sub_n_slices = in_slice2 - in_slice1 + 1; - - return subview_field(*this, in_row1, in_col1, in_slice1, sub_n_rows, sub_n_cols, sub_n_slices); - } - - - -//! creation of subview_field (subfield with arbitrary dimensions) -template -inline -const subview_field -field::subfield(const uword in_row1, const uword in_col1, const uword in_slice1, const uword in_row2, const uword in_col2, const uword in_slice2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_col1 > in_col2) || (in_slice1 > in_slice2) || (in_row2 >= n_rows) || (in_col2 >= n_cols) || (in_slice2 >= n_slices), - "field::subfield(): indices out of bounds or incorrectly used" - ); - - const uword sub_n_rows = in_row2 - in_row1 + 1; - const uword sub_n_cols = in_col2 - in_col1 + 1; - const uword sub_n_slices = in_slice2 - in_slice1 + 1; - - return subview_field(*this, in_row1, in_col1, in_slice1, sub_n_rows, sub_n_cols, sub_n_slices); - } - - - -//! creation of subview_field (subfield with arbitrary dimensions) -template -inline -subview_field -field::subfield(const uword in_row1, const uword in_col1, const SizeMat& s) - { - arma_debug_sigprint(); - - arma_conform_check( (n_slices >= 2), "field::subfield(): field must be 2D" ); - - const uword l_n_rows = n_rows; - const uword l_n_cols = n_cols; - - const uword s_n_rows = s.n_rows; - const uword s_n_cols = s.n_cols; - - arma_conform_check_bounds - ( - ((in_row1 >= l_n_rows) || (in_col1 >= l_n_cols) || ((in_row1 + s_n_rows) > l_n_rows) || ((in_col1 + s_n_cols) > l_n_cols)), - "field::subfield(): indices or size out of bounds" - ); - - return subview_field(*this, in_row1, in_col1, s_n_rows, s_n_cols); - } - - - -//! creation of subview_field (subfield with arbitrary dimensions) -template -inline -const subview_field -field::subfield(const uword in_row1, const uword in_col1, const SizeMat& s) const - { - arma_debug_sigprint(); - - arma_conform_check( (n_slices >= 2), "field::subfield(): field must be 2D" ); - - const uword l_n_rows = n_rows; - const uword l_n_cols = n_cols; - - const uword s_n_rows = s.n_rows; - const uword s_n_cols = s.n_cols; - - arma_conform_check_bounds - ( - ((in_row1 >= l_n_rows) || (in_col1 >= l_n_cols) || ((in_row1 + s_n_rows) > l_n_rows) || ((in_col1 + s_n_cols) > l_n_cols)), - "field::subfield(): indices or size out of bounds" - ); - - return subview_field(*this, in_row1, in_col1, s_n_rows, s_n_cols); - } - - - -//! creation of subview_field (subfield with arbitrary dimensions) -template -inline -subview_field -field::subfield(const uword in_row1, const uword in_col1, const uword in_slice1, const SizeCube& s) - { - arma_debug_sigprint(); - - const uword l_n_rows = n_rows; - const uword l_n_cols = n_cols; - const uword l_n_slices = n_slices; - - const uword s_n_rows = s.n_rows; - const uword s_n_cols = s.n_cols; - const uword sub_n_slices = s.n_slices; - - arma_conform_check_bounds - ( - ((in_row1 >= l_n_rows) || (in_col1 >= l_n_cols) || (in_slice1 >= l_n_slices) || ((in_row1 + s_n_rows) > l_n_rows) || ((in_col1 + s_n_cols) > l_n_cols) || ((in_slice1 + sub_n_slices) > l_n_slices)), - "field::subfield(): indices or size out of bounds" - ); - - return subview_field(*this, in_row1, in_col1, in_slice1, s_n_rows, s_n_cols, sub_n_slices); - } - - - -//! creation of subview_field (subfield with arbitrary dimensions) -template -inline -const subview_field -field::subfield(const uword in_row1, const uword in_col1, const uword in_slice1, const SizeCube& s) const - { - arma_debug_sigprint(); - - const uword l_n_rows = n_rows; - const uword l_n_cols = n_cols; - const uword l_n_slices = n_slices; - - const uword s_n_rows = s.n_rows; - const uword s_n_cols = s.n_cols; - const uword sub_n_slices = s.n_slices; - - arma_conform_check_bounds - ( - ((in_row1 >= l_n_rows) || (in_col1 >= l_n_cols) || (in_slice1 >= l_n_slices) || ((in_row1 + s_n_rows) > l_n_rows) || ((in_col1 + s_n_cols) > l_n_cols) || ((in_slice1 + sub_n_slices) > l_n_slices)), - "field::subfield(): indices or size out of bounds" - ); - - return subview_field(*this, in_row1, in_col1, in_slice1, s_n_rows, s_n_cols, sub_n_slices); - } - - - -//! creation of subview_field (subfield with arbitrary dimensions) -template -inline -subview_field -field::subfield(const span& row_span, const span& col_span) - { - arma_debug_sigprint(); - - arma_conform_check( (n_slices >= 2), "field::subfield(): field must be 2D" ); - - const bool row_all = row_span.whole; - const bool col_all = col_span.whole; - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword sub_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword sub_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - arma_conform_check_bounds - ( - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - , - "field::subfield(): indices out of bounds or incorrectly used" - ); - - return subview_field(*this, in_row1, in_col1, sub_n_rows, sub_n_cols); - } - - - -//! creation of subview_field (subfield with arbitrary dimensions) -template -inline -const subview_field -field::subfield(const span& row_span, const span& col_span) const - { - arma_debug_sigprint(); - - arma_conform_check( (n_slices >= 2), "field::subfield(): field must be 2D" ); - - const bool row_all = row_span.whole; - const bool col_all = col_span.whole; - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword sub_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword sub_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - arma_conform_check_bounds - ( - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - , - "field::subfield(): indices out of bounds or incorrectly used" - ); - - return subview_field(*this, in_row1, in_col1, sub_n_rows, sub_n_cols); - } - - - -//! creation of subview_field (subfield with arbitrary dimensions) -template -inline -subview_field -field::subfield(const span& row_span, const span& col_span, const span& slice_span) - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - const bool col_all = col_span.whole; - const bool slice_all = slice_span.whole; - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - const uword local_n_slices = n_slices; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword sub_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword sub_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - const uword in_slice1 = slice_all ? 0 : slice_span.a; - const uword in_slice2 = slice_span.b; - const uword sub_n_slices = slice_all ? local_n_slices : in_slice2 - in_slice1 + 1; - - arma_conform_check_bounds - ( - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - || - ( slice_all ? false : ((in_slice1 > in_slice2) || (in_slice2 >= local_n_slices)) ) - , - "field::subfield(): indices out of bounds or incorrectly used" - ); - - return subview_field(*this, in_row1, in_col1, in_slice1, sub_n_rows, sub_n_cols, sub_n_slices); - } - - - -//! creation of subview_field (subfield with arbitrary dimensions) -template -inline -const subview_field -field::subfield(const span& row_span, const span& col_span, const span& slice_span) const - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - const bool col_all = col_span.whole; - const bool slice_all = slice_span.whole; - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - const uword local_n_slices = n_slices; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword sub_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword sub_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - const uword in_slice1 = slice_all ? 0 : slice_span.a; - const uword in_slice2 = slice_span.b; - const uword sub_n_slices = slice_all ? local_n_slices : in_slice2 - in_slice1 + 1; - - arma_conform_check_bounds - ( - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - || - ( slice_all ? false : ((in_slice1 > in_slice2) || (in_slice2 >= local_n_slices)) ) - , - "field::subfield(): indices out of bounds or incorrectly used" - ); - - return subview_field(*this, in_row1, in_col1, in_slice1, sub_n_rows, sub_n_cols, sub_n_slices); - } - - - -template -inline -subview_field -field::operator()(const span& row_span, const span& col_span) - { - arma_debug_sigprint(); - - return (*this).subfield(row_span, col_span); - } - - - -template -inline -const subview_field -field::operator()(const span& row_span, const span& col_span) const - { - arma_debug_sigprint(); - - return (*this).subfield(row_span, col_span); - } - - - -template -inline -subview_field -field::operator()(const span& row_span, const span& col_span, const span& slice_span) - { - arma_debug_sigprint(); - - return (*this).subfield(row_span, col_span, slice_span); - } - - - -template -inline -const subview_field -field::operator()(const span& row_span, const span& col_span, const span& slice_span) const - { - arma_debug_sigprint(); - - return (*this).subfield(row_span, col_span, slice_span); - } - - - -template -inline -subview_field -field::operator()(const uword in_row1, const uword in_col1, const SizeMat& s) - { - arma_debug_sigprint(); - - return (*this).subfield(in_row1, in_col1, s); - } - - - -template -inline -const subview_field -field::operator()(const uword in_row1, const uword in_col1, const SizeMat& s) const - { - arma_debug_sigprint(); - - return (*this).subfield(in_row1, in_col1, s); - } - - - -template -inline -subview_field -field::operator()(const uword in_row1, const uword in_col1, const uword in_slice1, const SizeCube& s) - { - arma_debug_sigprint(); - - return (*this).subfield(in_row1, in_col1, in_slice1, s); - } - - - -template -inline -const subview_field -field::operator()(const uword in_row1, const uword in_col1, const uword in_slice1, const SizeCube& s) const - { - arma_debug_sigprint(); - - return (*this).subfield(in_row1, in_col1, in_slice1, s); - } - - - -//! print contents of the field (to the cout stream), -//! optionally preceding with a user specified line of text. -//! the field class preserves the stream's flags -//! but the associated operator<< function for type oT -//! may still modify the stream's parameters. -//! NOTE: this function assumes that type oT can be printed, -//! ie. the function "std::ostream& operator<< (std::ostream&, const oT&)" -//! has been defined. - -template -inline -void -field::print(const std::string extra_text) const - { - arma_debug_sigprint(); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = get_cout_stream().width(); - - get_cout_stream() << extra_text << '\n'; - - get_cout_stream().width(orig_width); - } - - arma_ostream::print(get_cout_stream(), *this); - } - - - -//! print contents of the field to a user specified stream, -//! optionally preceding with a user specified line of text. -//! the field class preserves the stream's flags -//! but the associated operator<< function for type oT -//! may still modify the stream's parameters. -//! NOTE: this function assumes that type oT can be printed, -//! ie. the function "std::ostream& operator<< (std::ostream&, const oT&)" -//! has been defined. - -template -inline -void -field::print(std::ostream& user_stream, const std::string extra_text) const - { - arma_debug_sigprint(); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = user_stream.width(); - - user_stream << extra_text << '\n'; - - user_stream.width(orig_width); - } - - arma_ostream::print(user_stream, *this); - } - - - -//! apply a lambda function to each object -template -inline -field& -field::for_each(const std::function< void(oT&) >& F) - { - arma_debug_sigprint(); - - for(uword i=0; i < n_elem; ++i) { F(operator[](i)); } - - return *this; - } - - - -template -inline -const field& -field::for_each(const std::function< void(const oT&) >& F) const - { - arma_debug_sigprint(); - - for(uword i=0; i < n_elem; ++i) { F(operator[](i)); } - - return *this; - } - - - -//! fill the field with an object -template -inline -field& -field::fill(const oT& x) - { - arma_debug_sigprint(); - - field& t = *this; - - for(uword i=0; i -inline -void -field::reset() - { - arma_debug_sigprint(); - - init(0,0,0); - } - - - -//! reset each object -template -inline -void -field::reset_objects() - { - arma_debug_sigprint(); - - field_aux::reset_objects(*this); - } - - - -//! returns true if the field has no objects -template -arma_inline -bool -field::is_empty() const - { - return (n_elem == 0); - } - - - -//! returns true if the given index is currently in range -template -arma_inline -bool -field::in_range(const uword i) const - { - return (i < n_elem); - } - - - -//! returns true if the given start and end indices are currently in range -template -arma_inline -bool -field::in_range(const span& x) const - { - arma_debug_sigprint(); - - if(x.whole) - { - return true; - } - else - { - const uword a = x.a; - const uword b = x.b; - - return ( (a <= b) && (b < n_elem) ); - } - } - - - -//! returns true if the given location is currently in range -template -arma_inline -bool -field::in_range(const uword in_row, const uword in_col) const - { - return ( (in_row < n_rows) && (in_col < n_cols) ); - } - - - -template -arma_inline -bool -field::in_range(const span& row_span, const uword in_col) const - { - arma_debug_sigprint(); - - if(row_span.whole) - { - return (in_col < n_cols); - } - else - { - const uword in_row1 = row_span.a; - const uword in_row2 = row_span.b; - - return ( (in_row1 <= in_row2) && (in_row2 < n_rows) && (in_col < n_cols) ); - } - } - - - -template -arma_inline -bool -field::in_range(const uword in_row, const span& col_span) const - { - arma_debug_sigprint(); - - if(col_span.whole) - { - return (in_row < n_rows); - } - else - { - const uword in_col1 = col_span.a; - const uword in_col2 = col_span.b; - - return ( (in_row < n_rows) && (in_col1 <= in_col2) && (in_col2 < n_cols) ); - } - } - - - -template -arma_inline -bool -field::in_range(const span& row_span, const span& col_span) const - { - arma_debug_sigprint(); - - const uword in_row1 = row_span.a; - const uword in_row2 = row_span.b; - - const uword in_col1 = col_span.a; - const uword in_col2 = col_span.b; - - const bool rows_ok = row_span.whole ? true : ( (in_row1 <= in_row2) && (in_row2 < n_rows) ); - const bool cols_ok = col_span.whole ? true : ( (in_col1 <= in_col2) && (in_col2 < n_cols) ); - - return ( rows_ok && cols_ok ); - } - - - -template -arma_inline -bool -field::in_range(const uword in_row, const uword in_col, const SizeMat& s) const - { - const uword l_n_rows = n_rows; - const uword l_n_cols = n_cols; - - if( (in_row >= l_n_rows) || (in_col >= l_n_cols) || ((in_row + s.n_rows) > l_n_rows) || ((in_col + s.n_cols) > l_n_cols) ) - { - return false; - } - else - { - return true; - } - } - - - -template -arma_inline -bool -field::in_range(const uword in_row, const uword in_col, const uword in_slice) const - { - return ( (in_row < n_rows) && (in_col < n_cols) && (in_slice < n_slices) ); - } - - - -template -arma_inline -bool -field::in_range(const span& row_span, const span& col_span, const span& slice_span) const - { - arma_debug_sigprint(); - - const uword in_row1 = row_span.a; - const uword in_row2 = row_span.b; - - const uword in_col1 = col_span.a; - const uword in_col2 = col_span.b; - - const uword in_slice1 = slice_span.a; - const uword in_slice2 = slice_span.b; - - const bool rows_ok = row_span.whole ? true : ( (in_row1 <= in_row2 ) && (in_row2 < n_rows ) ); - const bool cols_ok = col_span.whole ? true : ( (in_col1 <= in_col2 ) && (in_col2 < n_cols ) ); - const bool slices_ok = slice_span.whole ? true : ( (in_slice1 <= in_slice2) && (in_slice2 < n_slices) ); - - return ( rows_ok && cols_ok && slices_ok ); - } - - - -template -arma_inline -bool -field::in_range(const uword in_row, const uword in_col, const uword in_slice, const SizeCube& s) const - { - const uword l_n_rows = n_rows; - const uword l_n_cols = n_cols; - const uword l_n_slices = n_slices; - - if( (in_row >= l_n_rows) || (in_col >= l_n_cols) || (in_slice >= l_n_slices) || ((in_row + s.n_rows) > l_n_rows) || ((in_col + s.n_cols) > l_n_cols) || ((in_slice + s.n_slices) > l_n_slices) ) - { - return false; - } - else - { - return true; - } - } - - - -template -inline -bool -field::save(const std::string name, const file_type type) const - { - arma_debug_sigprint(); - - std::string err_msg; - - const bool save_okay = field_aux::save(*this, name, type, err_msg); - - if(save_okay == false) - { - if(err_msg.length() > 0) - { - arma_warn(3, "field::save(): ", err_msg, "; file: ", name); - } - else - { - arma_warn(3, "field::save(): write failed; file: ", name); - } - } - - return save_okay; - } - - - -template -inline -bool -field::save(std::ostream& os, const file_type type) const - { - arma_debug_sigprint(); - - std::string err_msg; - - const bool save_okay = field_aux::save(*this, os, type, err_msg); - - if(save_okay == false) - { - if(err_msg.length() > 0) - { - arma_warn(3, "field::save(): ", err_msg); - } - else - { - arma_warn(3, "field::save(): stream write failed"); - } - } - - return save_okay; - } - - - -template -inline -bool -field::load(const std::string name, const file_type type) - { - arma_debug_sigprint(); - - std::string err_msg; - - const bool load_okay = field_aux::load(*this, name, type, err_msg); - - if(load_okay == false) - { - if(err_msg.length() > 0) - { - arma_warn(3, "field::load(): ", err_msg, "; file: ", name); - } - else - { - arma_warn(3, "field::load(): read failed; file: ", name); - } - } - - if(load_okay == false) { (*this).reset(); } - - return load_okay; - } - - - -template -inline -bool -field::load(std::istream& is, const file_type type) - { - arma_debug_sigprint(); - - std::string err_msg; - const bool load_okay = field_aux::load(*this, is, type, err_msg); - - if(load_okay == false) - { - if(err_msg.length() > 0) - { - arma_warn(3, "field::load(): ", err_msg); - } - else - { - arma_warn(3, "field::load(): stream read failed"); - } - } - - if(load_okay == false) { (*this).reset(); } - - return load_okay; - } - - - -template -inline -bool -field::quiet_save(const std::string name, const file_type type) const - { - arma_debug_sigprint(); - - return (*this).save(name, type); - } - - - -template -inline -bool -field::quiet_save(std::ostream& os, const file_type type) const - { - arma_debug_sigprint(); - - return (*this).save(os, type); - } - - - -template -inline -bool -field::quiet_load(const std::string name, const file_type type) - { - arma_debug_sigprint(); - - return (*this).load(name, type); - } - - - -template -inline -bool -field::quiet_load(std::istream& is, const file_type type) - { - arma_debug_sigprint(); - - return (*this).load(is, type); - } - - - -//! construct a field from a given field -template -inline -void -field::init(const field& x) - { - arma_debug_sigprint(); - - if(this != &x) - { - const uword x_n_rows = x.n_rows; - const uword x_n_cols = x.n_cols; - const uword x_n_slices = x.n_slices; - - init(x_n_rows, x_n_cols, x_n_slices); - - field& t = *this; - - if(x_n_slices == 1) - { - for(uword ucol=0; ucol < x_n_cols; ++ucol) - for(uword urow=0; urow < x_n_rows; ++urow) - { - t.at(urow,ucol) = x.at(urow,ucol); - } - } - else - { - for(uword uslice=0; uslice < x_n_slices; ++uslice) - for(uword ucol=0; ucol < x_n_cols; ++ucol ) - for(uword urow=0; urow < x_n_rows; ++urow ) - { - t.at(urow,ucol,uslice) = x.at(urow,ucol,uslice); - } - } - } - } - - - -template -inline -void -field::init(const uword n_rows_in, const uword n_cols_in) - { - (*this).init(n_rows_in, n_cols_in, 1); - } - - - -template -inline -void -field::init(const uword n_rows_in, const uword n_cols_in, const uword n_slices_in) - { - arma_debug_sigprint( arma_str::format("n_rows_in: %u; n_cols_in: %u; n_slices_in: %u") % n_rows_in % n_cols_in % n_slices_in ); - - #if defined(ARMA_64BIT_WORD) - const char* error_message = "field::init(): requested size is too large"; - #else - const char* error_message = "field::init(): requested size is too large; suggest to enable ARMA_64BIT_WORD"; - #endif - - arma_conform_check - ( - ( - ( (n_rows_in > 0x0FFF) || (n_cols_in > 0x0FFF) || (n_slices_in > 0xFF) ) - ? ( (double(n_rows_in) * double(n_cols_in) * double(n_slices_in)) > double(ARMA_MAX_UWORD) ) - : false - ), - error_message - ); - - const uword n_elem_new = n_rows_in * n_cols_in * n_slices_in; - - if(n_elem == n_elem_new) - { - // delete_objects(); - // create_objects(); - access::rw(n_rows) = n_rows_in; - access::rw(n_cols) = n_cols_in; - access::rw(n_slices) = n_slices_in; - } - else - { - delete_objects(); - - if(n_elem > field_prealloc_n_elem::val) { delete [] mem; } - - if(n_elem_new <= field_prealloc_n_elem::val) - { - mem = (n_elem_new == 0) ? nullptr : mem_local; - } - else - { - mem = new(std::nothrow) oT* [n_elem_new]; - - arma_check_bad_alloc( (mem == nullptr), "field::init(): out of memory" ); - } - - access::rw(n_rows) = n_rows_in; - access::rw(n_cols) = n_cols_in; - access::rw(n_slices) = n_slices_in; - access::rw(n_elem) = n_elem_new; - - create_objects(); - } - } - - - -template -inline -void -field::delete_objects() - { - arma_debug_sigprint( arma_str::format("n_elem: %u") % n_elem ); - - for(uword i=0; i -inline -void -field::create_objects() - { - arma_debug_sigprint( arma_str::format("n_elem: %u") % n_elem ); - - for(uword i=0; i -inline -field::iterator::iterator(field& in_M, const bool at_end) - : M(in_M) - , i( (at_end == false) ? 0 : in_M.n_elem ) - { - arma_debug_sigprint(); - } - - - -template -inline -oT& -field::iterator::operator*() - { - return M[i]; - } - - - -template -inline -typename field::iterator& -field::iterator::operator++() - { - ++i; - - return *this; - } - - - -template -inline -void -field::iterator::operator++(int) - { - operator++(); - } - - - -template -inline -typename field::iterator& -field::iterator::operator--() - { - if(i > 0) { --i; } - - return *this; - } - - - -template -inline -void -field::iterator::operator--(int) - { - operator--(); - } - - - -template -inline -bool -field::iterator::operator!=(const typename field::iterator& X) const - { - return (i != X.i); - } - - - -template -inline -bool -field::iterator::operator==(const typename field::iterator& X) const - { - return (i == X.i); - } - - - -template -inline -field::const_iterator::const_iterator(const field& in_M, const bool at_end) - : M(in_M) - , i( (at_end == false) ? 0 : in_M.n_elem ) - { - arma_debug_sigprint(); - } - - - -template -inline -field::const_iterator::const_iterator(const typename field::iterator& X) - : M(X.M) - , i(X.i) - { - arma_debug_sigprint(); - } - - - -template -inline -const oT& -field::const_iterator::operator*() const - { - return M[i]; - } - - - -template -inline -typename field::const_iterator& -field::const_iterator::operator++() - { - ++i; - - return *this; - } - - - -template -inline -void -field::const_iterator::operator++(int) - { - operator++(); - } - - - -template -inline -typename field::const_iterator& -field::const_iterator::operator--() - { - if(i > 0) { --i; } - - return *this; - } - - - -template -inline -void -field::const_iterator::operator--(int) - { - operator--(); - } - - - -template -inline -bool -field::const_iterator::operator!=(const typename field::const_iterator& X) const - { - return (i != X.i); - } - - - -template -inline -bool -field::const_iterator::operator==(const typename field::const_iterator& X) const - { - return (i == X.i); - } - - - -template -inline -typename field::iterator -field::begin() - { - arma_debug_sigprint(); - - return field::iterator(*this); - } - - - -template -inline -typename field::const_iterator -field::begin() const - { - arma_debug_sigprint(); - - return field::const_iterator(*this); - } - - - -template -inline -typename field::const_iterator -field::cbegin() const - { - arma_debug_sigprint(); - - return field::const_iterator(*this); - } - - - -template -inline -typename field::iterator -field::end() - { - arma_debug_sigprint(); - - return field::iterator(*this, true); - } - - - -template -inline -typename field::const_iterator -field::end() const - { - arma_debug_sigprint(); - - return field::const_iterator(*this, true); - } - - - -template -inline -typename field::const_iterator -field::cend() const - { - arma_debug_sigprint(); - - return field::const_iterator(*this, true); - } - - - -template -inline -void -field::clear() - { - reset(); - } - - - -template -inline -bool -field::empty() const - { - return (n_elem == 0); - } - - - -template -inline -uword -field::size() const - { - return n_elem; - } - - - -// -// -// - - - -template -inline -void -field_aux::reset_objects(field& x) - { - arma_debug_sigprint(); - - x.delete_objects(); - x.create_objects(); - } - - - -template -inline -void -field_aux::reset_objects(field< Mat >& x) - { - arma_debug_sigprint(); - - for(uword i=0; i < x.n_elem; ++i) { (*(x.mem[i])).reset(); } - } - - - -template -inline -void -field_aux::reset_objects(field< Col >& x) - { - arma_debug_sigprint(); - - for(uword i=0; i < x.n_elem; ++i) { (*(x.mem[i])).reset(); } - } - - - -template -inline -void -field_aux::reset_objects(field< Row >& x) - { - arma_debug_sigprint(); - - for(uword i=0; i < x.n_elem; ++i) { (*(x.mem[i])).reset(); } - } - - - -template -inline -void -field_aux::reset_objects(field< Cube >& x) - { - arma_debug_sigprint(); - - for(uword i=0; i < x.n_elem; ++i) { (*(x.mem[i])).reset(); } - } - - - -inline -void -field_aux::reset_objects(field< std::string >& x) - { - arma_debug_sigprint(); - - for(uword i=0; i < x.n_elem; ++i) { (*(x.mem[i])).clear(); } - } - - - -// -// -// - - - -template -inline -bool -field_aux::save(const field&, const std::string&, const file_type, std::string& err_msg) - { - arma_debug_sigprint(); - - err_msg = "saving/loading this type of field is currently not supported"; - - return false; - } - - - -template -inline -bool -field_aux::save(const field&, std::ostream&, const file_type, std::string& err_msg) - { - arma_debug_sigprint(); - - err_msg = "saving/loading this type of field is currently not supported"; - - return false; - } - - - -template -inline -bool -field_aux::load(field&, const std::string&, const file_type, std::string& err_msg) - { - arma_debug_sigprint(); - - err_msg = "saving/loading this type of field is currently not supported"; - - return false; - } - - - -template -inline -bool -field_aux::load(field&, std::istream&, const file_type, std::string& err_msg) - { - arma_debug_sigprint(); - - err_msg = "saving/loading this type of field is currently not supported"; - - return false; - } - - - -template -inline -bool -field_aux::save(const field< Mat >& x, const std::string& name, const file_type type, std::string& err_msg) - { - arma_debug_sigprint(); - - switch(type) - { - case arma_binary: - return diskio::save_arma_binary(x, name); - break; - - case ppm_binary: - return diskio::save_ppm_binary(x, name); - break; - - default: - err_msg = "unsupported type"; - return false; - } - } - - - -template -inline -bool -field_aux::save(const field< Mat >& x, std::ostream& os, const file_type type, std::string& err_msg) - { - arma_debug_sigprint(); - - switch(type) - { - case arma_binary: - return diskio::save_arma_binary(x, os); - break; - - case ppm_binary: - return diskio::save_ppm_binary(x, os); - break; - - default: - err_msg = "unsupported type"; - return false; - } - } - - - -template -inline -bool -field_aux::load(field< Mat >& x, const std::string& name, const file_type type, std::string& err_msg) - { - arma_debug_sigprint(); - - switch(type) - { - case auto_detect: - return diskio::load_auto_detect(x, name, err_msg); - break; - - case arma_binary: - return diskio::load_arma_binary(x, name, err_msg); - break; - - case ppm_binary: - return diskio::load_ppm_binary(x, name, err_msg); - break; - - default: - err_msg = "unsupported type"; - return false; - } - } - - - -template -inline -bool -field_aux::load(field< Mat >& x, std::istream& is, const file_type type, std::string& err_msg) - { - arma_debug_sigprint(); - - switch(type) - { - case auto_detect: - return diskio::load_auto_detect(x, is, err_msg); - break; - - case arma_binary: - return diskio::load_arma_binary(x, is, err_msg); - break; - - case ppm_binary: - return diskio::load_ppm_binary(x, is, err_msg); - break; - - default: - err_msg = "unsupported type"; - return false; - } - } - - - -template -inline -bool -field_aux::save(const field< Col >& x, const std::string& name, const file_type type, std::string& err_msg) - { - arma_debug_sigprint(); - - switch(type) - { - case arma_binary: - return diskio::save_arma_binary(x, name); - break; - - case ppm_binary: - return diskio::save_ppm_binary(x, name); - break; - - default: - err_msg = "unsupported type"; - return false; - } - } - - - -template -inline -bool -field_aux::save(const field< Col >& x, std::ostream& os, const file_type type, std::string& err_msg) - { - arma_debug_sigprint(); - - switch(type) - { - case arma_binary: - return diskio::save_arma_binary(x, os); - break; - - case ppm_binary: - return diskio::save_ppm_binary(x, os); - break; - - default: - err_msg = "unsupported type"; - return false; - } - } - - - -template -inline -bool -field_aux::load(field< Col >& x, const std::string& name, const file_type type, std::string& err_msg) - { - arma_debug_sigprint(); - - switch(type) - { - case auto_detect: - return diskio::load_auto_detect(x, name, err_msg); - break; - - case arma_binary: - return diskio::load_arma_binary(x, name, err_msg); - break; - - case ppm_binary: - return diskio::load_ppm_binary(x, name, err_msg); - break; - - default: - err_msg = "unsupported type"; - return false; - } - } - - - -template -inline -bool -field_aux::load(field< Col >& x, std::istream& is, const file_type type, std::string& err_msg) - { - arma_debug_sigprint(); - - switch(type) - { - case auto_detect: - return diskio::load_auto_detect(x, is, err_msg); - break; - - case arma_binary: - return diskio::load_arma_binary(x, is, err_msg); - break; - - case ppm_binary: - return diskio::load_ppm_binary(x, is, err_msg); - break; - - default: - err_msg = "unsupported type"; - return false; - } - } - - - -template -inline -bool -field_aux::save(const field< Row >& x, const std::string& name, const file_type type, std::string& err_msg) - { - arma_debug_sigprint(); - - switch(type) - { - case arma_binary: - return diskio::save_arma_binary(x, name); - break; - - case ppm_binary: - return diskio::save_ppm_binary(x, name); - break; - - default: - err_msg = "unsupported type"; - return false; - } - } - - - -template -inline -bool -field_aux::save(const field< Row >& x, std::ostream& os, const file_type type, std::string& err_msg) - { - arma_debug_sigprint(); - - switch(type) - { - case arma_binary: - return diskio::save_arma_binary(x, os); - break; - - case ppm_binary: - return diskio::save_ppm_binary(x, os); - break; - - default: - err_msg = "unsupported type"; - return false; - } - } - - - -template -inline -bool -field_aux::load(field< Row >& x, const std::string& name, const file_type type, std::string& err_msg) - { - arma_debug_sigprint(); - - switch(type) - { - case auto_detect: - return diskio::load_auto_detect(x, name, err_msg); - break; - - case arma_binary: - return diskio::load_arma_binary(x, name, err_msg); - break; - - case ppm_binary: - return diskio::load_ppm_binary(x, name, err_msg); - break; - - default: - err_msg = "unsupported type"; - return false; - } - } - - - -template -inline -bool -field_aux::load(field< Row >& x, std::istream& is, const file_type type, std::string& err_msg) - { - arma_debug_sigprint(); - - switch(type) - { - case auto_detect: - return diskio::load_auto_detect(x, is, err_msg); - break; - - case arma_binary: - return diskio::load_arma_binary(x, is, err_msg); - break; - - case ppm_binary: - return diskio::load_ppm_binary(x, is, err_msg); - break; - - default: - err_msg = "unsupported type"; - return false; - } - } - - - -template -inline -bool -field_aux::save(const field< Cube >& x, const std::string& name, const file_type type, std::string& err_msg) - { - arma_debug_sigprint(); - - switch(type) - { - case arma_binary: - return diskio::save_arma_binary(x, name); - break; - - default: - err_msg = "unsupported type"; - return false; - } - } - - - -template -inline -bool -field_aux::save(const field< Cube >& x, std::ostream& os, const file_type type, std::string& err_msg) - { - arma_debug_sigprint(); - - switch(type) - { - case arma_binary: - return diskio::save_arma_binary(x, os); - break; - - default: - err_msg = "unsupported type"; - return false; - } - } - - - -template -inline -bool -field_aux::load(field< Cube >& x, const std::string& name, const file_type type, std::string& err_msg) - { - arma_debug_sigprint(); - - switch(type) - { - case auto_detect: - case arma_binary: - return diskio::load_arma_binary(x, name, err_msg); - break; - - default: - err_msg = "unsupported type"; - return false; - } - } - - - -template -inline -bool -field_aux::load(field< Cube >& x, std::istream& is, const file_type type, std::string& err_msg) - { - arma_debug_sigprint(); - - switch(type) - { - case auto_detect: - case arma_binary: - return diskio::load_arma_binary(x, is, err_msg); - break; - - default: - err_msg = "unsupported type"; - return false; - } - } - - - -inline -bool -field_aux::save(const field< std::string >& x, const std::string& name, const file_type type, std::string& err_msg) - { - arma_debug_sigprint(); - - arma_ignore(type); - - err_msg.clear(); - - return diskio::save_std_string(x, name); - } - - - -inline -bool -field_aux::save(const field< std::string >& x, std::ostream& os, const file_type type, std::string& err_msg) - { - arma_debug_sigprint(); - - arma_ignore(type); - - err_msg.clear(); - - return diskio::save_std_string(x, os); - } - - - -inline -bool -field_aux::load(field< std::string >& x, const std::string& name, const file_type type, std::string& err_msg) - { - arma_debug_sigprint(); - - arma_ignore(type); - - return diskio::load_std_string(x, name, err_msg); - } - - - -inline -bool -field_aux::load(field< std::string >& x, std::istream& is, const file_type type, std::string& err_msg) - { - arma_debug_sigprint(); - - arma_ignore(type); - - return diskio::load_std_string(x, is, err_msg); - } - - - -#if defined(ARMA_EXTRA_FIELD_MEAT) - #include ARMA_INCFILE_WRAP(ARMA_EXTRA_FIELD_MEAT) -#endif - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fill.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fill.hpp deleted file mode 100644 index 8b4109777..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fill.hpp +++ /dev/null @@ -1,116 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fill -//! @{ - - -namespace fill - { - struct fill_none {}; - struct fill_zeros {}; - struct fill_ones {}; - struct fill_eye {}; - struct fill_randu {}; - struct fill_randn {}; - - template - struct fill_class { inline constexpr fill_class() {} }; - - static constexpr fill_class none; - static constexpr fill_class zeros; - static constexpr fill_class ones; - static constexpr fill_class eye; - static constexpr fill_class randu; - static constexpr fill_class randn; - - // - - template - struct allow_conversion - { - static constexpr bool value = true; - }; - - template<> struct allow_conversion, double> { static constexpr bool value = false; }; - template<> struct allow_conversion, float > { static constexpr bool value = false; }; - template<> struct allow_conversion, u64 > { static constexpr bool value = false; }; - template<> struct allow_conversion, s64 > { static constexpr bool value = false; }; - template<> struct allow_conversion, u32 > { static constexpr bool value = false; }; - template<> struct allow_conversion, s32 > { static constexpr bool value = false; }; - template<> struct allow_conversion, u16 > { static constexpr bool value = false; }; - template<> struct allow_conversion, s16 > { static constexpr bool value = false; }; - template<> struct allow_conversion, u8 > { static constexpr bool value = false; }; - template<> struct allow_conversion, s8 > { static constexpr bool value = false; }; - - template<> struct allow_conversion, double> { static constexpr bool value = false; }; - template<> struct allow_conversion, float > { static constexpr bool value = false; }; - template<> struct allow_conversion, u64 > { static constexpr bool value = false; }; - template<> struct allow_conversion, s64 > { static constexpr bool value = false; }; - template<> struct allow_conversion, u32 > { static constexpr bool value = false; }; - template<> struct allow_conversion, s32 > { static constexpr bool value = false; }; - template<> struct allow_conversion, u16 > { static constexpr bool value = false; }; - template<> struct allow_conversion, s16 > { static constexpr bool value = false; }; - template<> struct allow_conversion, u8 > { static constexpr bool value = false; }; - template<> struct allow_conversion, s8 > { static constexpr bool value = false; }; - - // - - template inline bool isfinite_wrapper(eT ) { return true; } - template<> inline bool isfinite_wrapper(float x) { return std::isfinite(x); } - template<> inline bool isfinite_wrapper(double x) { return std::isfinite(x); } - template inline bool isfinite_wrapper(std::complex& x) { return std::isfinite(x.real()) && std::isfinite(x.imag()); } - - // - - template - struct scalar_holder - { - const scalar_type1 scalar; - - inline explicit scalar_holder(const scalar_type1& in_scalar) : scalar(in_scalar) {} - - inline scalar_holder() = delete; - - template - < - typename scalar_type2, - typename arma::enable_if2::value, int>::result = 0 - > - inline - operator scalar_holder() const - { - const bool ok_conversion = (std::is_integral::value && std::is_floating_point::value) ? isfinite_wrapper(scalar) : true; - - return scalar_holder( ok_conversion ? scalar_type2(scalar) : scalar_type2(0) ); - } - }; - - // - - template - inline - typename enable_if2< is_supported_elem_type::value, scalar_holder >::result - value(const scalar_type& in_scalar) - { - return scalar_holder(in_scalar); - } - } - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_accu.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_accu.hpp deleted file mode 100644 index 9a3cec424..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_accu.hpp +++ /dev/null @@ -1,1193 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_accu -//! @{ - - - -template -arma_hot -inline -typename T1::elem_type -accu_proxy_linear(const Proxy& P) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - eT val = eT(0); - - typename Proxy::ea_type Pea = P.get_ea(); - - const uword n_elem = P.get_n_elem(); - - if( arma_config::openmp && Proxy::use_mp && mp_gate::eval(n_elem) ) - { - #if defined(ARMA_USE_OPENMP) - { - // NOTE: using parallelisation with manual reduction workaround to take into account complex numbers; - // NOTE: OpenMP versions lower than 4.0 do not support user-defined reduction - - const int n_threads_max = mp_thread_limit::get(); - const uword n_threads_use = (std::min)(uword(podarray_prealloc_n_elem::val), uword(n_threads_max)); - const uword chunk_size = n_elem / n_threads_use; - - podarray partial_accs(n_threads_use); - - #pragma omp parallel for schedule(static) num_threads(int(n_threads_use)) - for(uword thread_id=0; thread_id < n_threads_use; ++thread_id) - { - const uword start = (thread_id+0) * chunk_size; - const uword endp1 = (thread_id+1) * chunk_size; - - eT acc = eT(0); - for(uword i=start; i < endp1; ++i) { acc += Pea[i]; } - - partial_accs[thread_id] = acc; - } - - for(uword thread_id=0; thread_id < n_threads_use; ++thread_id) { val += partial_accs[thread_id]; } - - for(uword i=(n_threads_use*chunk_size); i < n_elem; ++i) { val += Pea[i]; } - } - #endif - } - else - { - #if defined(__FAST_MATH__) - { - if(P.is_aligned()) - { - typename Proxy::aligned_ea_type Pea_aligned = P.get_aligned_ea(); - - for(uword i=0; i -arma_hot -inline -typename T1::elem_type -accu_proxy_at_mp(const Proxy& P) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - eT val = eT(0); - - #if defined(ARMA_USE_OPENMP) - { - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - if(n_cols == 1) - { - const int n_threads_max = mp_thread_limit::get(); - const uword n_threads_use = (std::min)(uword(podarray_prealloc_n_elem::val), uword(n_threads_max)); - const uword chunk_size = n_rows / n_threads_use; - - podarray partial_accs(n_threads_use); - - #pragma omp parallel for schedule(static) num_threads(int(n_threads_use)) - for(uword thread_id=0; thread_id < n_threads_use; ++thread_id) - { - const uword start = (thread_id+0) * chunk_size; - const uword endp1 = (thread_id+1) * chunk_size; - - eT acc = eT(0); - for(uword i=start; i < endp1; ++i) { acc += P.at(i,0); } - - partial_accs[thread_id] = acc; - } - - for(uword thread_id=0; thread_id < n_threads_use; ++thread_id) { val += partial_accs[thread_id]; } - - for(uword i=(n_threads_use*chunk_size); i < n_rows; ++i) { val += P.at(i,0); } - } - else - if(n_rows == 1) - { - const int n_threads_max = mp_thread_limit::get(); - const uword n_threads_use = (std::min)(uword(podarray_prealloc_n_elem::val), uword(n_threads_max)); - const uword chunk_size = n_cols / n_threads_use; - - podarray partial_accs(n_threads_use); - - #pragma omp parallel for schedule(static) num_threads(int(n_threads_use)) - for(uword thread_id=0; thread_id < n_threads_use; ++thread_id) - { - const uword start = (thread_id+0) * chunk_size; - const uword endp1 = (thread_id+1) * chunk_size; - - eT acc = eT(0); - for(uword i=start; i < endp1; ++i) { acc += P.at(0,i); } - - partial_accs[thread_id] = acc; - } - - for(uword thread_id=0; thread_id < n_threads_use; ++thread_id) { val += partial_accs[thread_id]; } - - for(uword i=(n_threads_use*chunk_size); i < n_cols; ++i) { val += P.at(0,i); } - } - else - { - podarray col_accs(n_cols); - - const int n_threads = mp_thread_limit::get(); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword col=0; col < n_cols; ++col) - { - eT val1 = eT(0); - eT val2 = eT(0); - - uword i,j; - for(i=0, j=1; j < n_rows; i+=2, j+=2) { val1 += P.at(i,col); val2 += P.at(j,col); } - - if(i < n_rows) { val1 += P.at(i,col); } - - col_accs[col] = val1 + val2; - } - - val = arrayops::accumulate(col_accs.memptr(), n_cols); - } - } - #else - { - arma_ignore(P); - } - #endif - - return val; - } - - - -template -arma_hot -inline -typename T1::elem_type -accu_proxy_at(const Proxy& P) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(arma_config::openmp && Proxy::use_mp && mp_gate::eval(P.get_n_elem())) - { - return accu_proxy_at_mp(P); - } - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - eT val = eT(0); - - if(n_rows != 1) - { - eT val1 = eT(0); - eT val2 = eT(0); - - for(uword col=0; col < n_cols; ++col) - { - uword i,j; - for(i=0, j=1; j < n_rows; i+=2, j+=2) { val1 += P.at(i,col); val2 += P.at(j,col); } - - if(i < n_rows) { val1 += P.at(i,col); } - } - - val = val1 + val2; - } - else - { - for(uword col=0; col < n_cols; ++col) { val += P.at(0,col); } - } - - return val; - } - - - -//! accumulate the elements of a matrix -template -arma_warn_unused -arma_hot -inline -typename enable_if2< is_arma_type::value, typename T1::elem_type >::result -accu(const T1& X) - { - arma_debug_sigprint(); - - const Proxy P(X); - - if(is_Mat::stored_type>::value || is_subview_col::stored_type>::value) - { - const quasi_unwrap::stored_type> tmp(P.Q); - - return arrayops::accumulate(tmp.M.memptr(), tmp.M.n_elem); - } - - return (Proxy::use_at) ? accu_proxy_at(P) : accu_proxy_linear(P); - } - - - -//! explicit handling of multiply-and-accumulate -template -arma_warn_unused -inline -typename T1::elem_type -accu(const eGlue& expr) - { - arma_debug_sigprint(); - - typedef eGlue expr_type; - - typedef typename expr_type::proxy1_type::stored_type P1_stored_type; - typedef typename expr_type::proxy2_type::stored_type P2_stored_type; - - constexpr bool is_sv = (is_subview::value) || (is_subview::value); - - if( (is_sv) && (expr.get_n_rows() >= 4) ) - { - arma_debug_print("accu(): eglue_schur subview optimisation"); - - typedef typename T1::elem_type eT; - - const sv_keep_unwrap& UA(expr.P1.Q); - const sv_keep_unwrap& UB(expr.P2.Q); - - typedef typename sv_keep_unwrap::stored_type UA_M_type; - typedef typename sv_keep_unwrap::stored_type UB_M_type; - - const UA_M_type& A = UA.M; - const UB_M_type& B = UB.M; - - // A and B have the same size (checked by the eGlue constructor) - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - eT acc = eT(0); - - for(uword c=0; c < A_n_cols; ++c) { acc += op_dot::direct_dot(A_n_rows, A.colptr(c), B.colptr(c)); } - - return acc; - } - - constexpr bool have_direct_mem_1 = (is_Mat::value) || (is_subview_col::value); - constexpr bool have_direct_mem_2 = (is_Mat::value) || (is_subview_col::value); - - if(have_direct_mem_1 && have_direct_mem_2) - { - arma_debug_print("accu(): eglue_schur direct_mem optimisation"); - - const quasi_unwrap tmp1(expr.P1.Q); - const quasi_unwrap tmp2(expr.P2.Q); - - return op_dot::direct_dot(tmp1.M.n_elem, tmp1.M.memptr(), tmp2.M.memptr()); - } - - const Proxy P(expr); - - return (Proxy::use_at) ? accu_proxy_at(P) : accu_proxy_linear(P); - } - - - -template -arma_warn_unused -inline -uword -accu(const mtOp& X, const typename arma_op_rel_only::result* junk1 = nullptr, const typename arma_not_cx::result* junk2 = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - typedef typename T1::elem_type eT; - - const eT k = X.aux; - - const Proxy P(X.m); - - uword count = 0; - - if(Proxy::use_at == false) - { - typedef typename Proxy::ea_type ea_type; - - ea_type A = P.get_ea(); - const uword n_elem = P.get_n_elem(); - - for(uword i=0; i::yes) { condition = (val == k ); } - else if(is_same_type::yes) { condition = (val != k ); } - else if(is_same_type::yes) { condition = (k < val); } - else if(is_same_type::yes) { condition = (val < k ); } - else if(is_same_type::yes) { condition = (k > val); } - else if(is_same_type::yes) { condition = (val > k ); } - else if(is_same_type::yes) { condition = (k <= val); } - else if(is_same_type::yes) { condition = (val <= k ); } - else if(is_same_type::yes) { condition = (k >= val); } - else if(is_same_type::yes) { condition = (val >= k ); } - else { condition = false; } - - count += (condition) ? uword(1) : uword(0); - } - } - else - { - const uword P_n_cols = P.get_n_cols(); - const uword P_n_rows = P.get_n_rows(); - - for(uword col=0; col < P_n_cols; ++col) - for(uword row=0; row < P_n_rows; ++row) - { - const eT val = P.at(row,col); - - bool condition; - - if(is_same_type::yes) { condition = (val == k ); } - else if(is_same_type::yes) { condition = (val != k ); } - else if(is_same_type::yes) { condition = (k < val); } - else if(is_same_type::yes) { condition = (val < k ); } - else if(is_same_type::yes) { condition = (k > val); } - else if(is_same_type::yes) { condition = (val > k ); } - else if(is_same_type::yes) { condition = (k <= val); } - else if(is_same_type::yes) { condition = (val <= k ); } - else if(is_same_type::yes) { condition = (k >= val); } - else if(is_same_type::yes) { condition = (val >= k ); } - else { condition = false; } - - count += (condition) ? uword(1) : uword(0); - } - } - - return count; - } - - - -template -arma_warn_unused -inline -uword -accu(const mtOp& X, const typename arma_op_rel_only::result* junk1 = nullptr, const typename arma_cx_only::result* junk2 = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - typedef typename T1::elem_type eT; - - const eT k = X.aux; - - const Proxy P(X.m); - - uword count = 0; - - if(Proxy::use_at == false) - { - typedef typename Proxy::ea_type ea_type; - - ea_type A = P.get_ea(); - const uword n_elem = P.get_n_elem(); - - for(uword i=0; i::yes) { condition = (val == k); } - else if(is_same_type::yes) { condition = (val != k); } - else { condition = false; } - - count += (condition) ? uword(1) : uword(0); - } - } - else - { - const uword P_n_cols = P.get_n_cols(); - const uword P_n_rows = P.get_n_rows(); - - for(uword col=0; col < P_n_cols; ++col) - for(uword row=0; row < P_n_rows; ++row) - { - const eT val = P.at(row,col); - - bool condition; - - if(is_same_type::yes) { condition = (val == k); } - else if(is_same_type::yes) { condition = (val != k); } - else { condition = false; } - - count += (condition) ? uword(1) : uword(0); - } - } - - return count; - } - - - -template -arma_warn_unused -inline -uword -accu(const mtGlue& X) - { - arma_debug_sigprint(); - - const Proxy PA(X.A); - const Proxy PB(X.B); - - arma_conform_assert_same_size(PA, PB, "operator!="); - - uword n_nonzero = 0; - - if( (Proxy::use_at == false) && (Proxy::use_at == false) ) - { - typedef typename Proxy::ea_type PA_ea_type; - typedef typename Proxy::ea_type PB_ea_type; - - PA_ea_type A = PA.get_ea(); - PB_ea_type B = PB.get_ea(); - const uword n_elem = PA.get_n_elem(); - - for(uword i=0; i < n_elem; ++i) - { - n_nonzero += (A[i] != B[i]) ? uword(1) : uword(0); - } - } - else - { - const uword PA_n_cols = PA.get_n_cols(); - const uword PA_n_rows = PA.get_n_rows(); - - if(PA_n_rows == 1) - { - for(uword col=0; col < PA_n_cols; ++col) - { - n_nonzero += (PA.at(0,col) != PB.at(0,col)) ? uword(1) : uword(0); - } - } - else - { - for(uword col=0; col < PA_n_cols; ++col) - for(uword row=0; row < PA_n_rows; ++row) - { - n_nonzero += (PA.at(row,col) != PB.at(row,col)) ? uword(1) : uword(0); - } - } - } - - return n_nonzero; - } - - - -template -arma_warn_unused -inline -uword -accu(const mtGlue& X) - { - arma_debug_sigprint(); - - const Proxy PA(X.A); - const Proxy PB(X.B); - - arma_conform_assert_same_size(PA, PB, "operator=="); - - uword n_nonzero = 0; - - if( (Proxy::use_at == false) && (Proxy::use_at == false) ) - { - typedef typename Proxy::ea_type PA_ea_type; - typedef typename Proxy::ea_type PB_ea_type; - - PA_ea_type A = PA.get_ea(); - PB_ea_type B = PB.get_ea(); - const uword n_elem = PA.get_n_elem(); - - for(uword i=0; i < n_elem; ++i) - { - n_nonzero += (A[i] == B[i]) ? uword(1) : uword(0); - } - } - else - { - const uword PA_n_cols = PA.get_n_cols(); - const uword PA_n_rows = PA.get_n_rows(); - - if(PA_n_rows == 1) - { - for(uword col=0; col < PA_n_cols; ++col) - { - n_nonzero += (PA.at(0,col) == PB.at(0,col)) ? uword(1) : uword(0); - } - } - else - { - for(uword col=0; col < PA_n_cols; ++col) - for(uword row=0; row < PA_n_rows; ++row) - { - n_nonzero += (PA.at(row,col) == PB.at(row,col)) ? uword(1) : uword(0); - } - } - } - - return n_nonzero; - } - - - -//! accumulate the elements of a subview (submatrix) -template -arma_warn_unused -arma_hot -inline -eT -accu(const subview& X) - { - arma_debug_sigprint(); - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(X_n_rows == 1) - { - const Mat& m = X.m; - - const uword col_offset = X.aux_col1; - const uword row_offset = X.aux_row1; - - eT val1 = eT(0); - eT val2 = eT(0); - - uword i,j; - for(i=0, j=1; j < X_n_cols; i+=2, j+=2) - { - val1 += m.at(row_offset, col_offset + i); - val2 += m.at(row_offset, col_offset + j); - } - - if(i < X_n_cols) { val1 += m.at(row_offset, col_offset + i); } - - return val1 + val2; - } - - if(X_n_cols == 1) { return arrayops::accumulate( X.colptr(0), X_n_rows ); } - - eT val = eT(0); - - for(uword col=0; col < X_n_cols; ++col) - { - val += arrayops::accumulate( X.colptr(col), X_n_rows ); - } - - return val; - } - - - -template -arma_warn_unused -arma_hot -inline -eT -accu(const subview_col& X) - { - arma_debug_sigprint(); - - return arrayops::accumulate( X.colmem, X.n_rows ); - } - - - -// - - - -template -arma_hot -inline -typename T1::elem_type -accu_cube_proxy_linear(const ProxyCube& P) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - eT val = eT(0); - - typename ProxyCube::ea_type Pea = P.get_ea(); - - const uword n_elem = P.get_n_elem(); - - if( arma_config::openmp && ProxyCube::use_mp && mp_gate::eval(n_elem) ) - { - #if defined(ARMA_USE_OPENMP) - { - // NOTE: using parallelisation with manual reduction workaround to take into account complex numbers; - // NOTE: OpenMP versions lower than 4.0 do not support user-defined reduction - - const int n_threads_max = mp_thread_limit::get(); - const uword n_threads_use = (std::min)(uword(podarray_prealloc_n_elem::val), uword(n_threads_max)); - const uword chunk_size = n_elem / n_threads_use; - - podarray partial_accs(n_threads_use); - - #pragma omp parallel for schedule(static) num_threads(int(n_threads_use)) - for(uword thread_id=0; thread_id < n_threads_use; ++thread_id) - { - const uword start = (thread_id+0) * chunk_size; - const uword endp1 = (thread_id+1) * chunk_size; - - eT acc = eT(0); - for(uword i=start; i < endp1; ++i) { acc += Pea[i]; } - - partial_accs[thread_id] = acc; - } - - for(uword thread_id=0; thread_id < n_threads_use; ++thread_id) { val += partial_accs[thread_id]; } - - for(uword i=(n_threads_use*chunk_size); i < n_elem; ++i) { val += Pea[i]; } - } - #endif - } - else - { - #if defined(__FAST_MATH__) - { - if(P.is_aligned()) - { - typename ProxyCube::aligned_ea_type Pea_aligned = P.get_aligned_ea(); - - for(uword i=0; i -arma_hot -inline -typename T1::elem_type -accu_cube_proxy_at_mp(const ProxyCube& P) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - eT val = eT(0); - - #if defined(ARMA_USE_OPENMP) - { - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - const uword n_slices = P.get_n_slices(); - - podarray slice_accs(n_slices); - - const int n_threads = mp_thread_limit::get(); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword slice = 0; slice < n_slices; ++slice) - { - eT val1 = eT(0); - eT val2 = eT(0); - - for(uword col = 0; col < n_cols; ++col) - { - uword i,j; - for(i=0, j=1; j -arma_hot -inline -typename T1::elem_type -accu_cube_proxy_at(const ProxyCube& P) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(arma_config::openmp && ProxyCube::use_mp && mp_gate::eval(P.get_n_elem())) - { - return accu_cube_proxy_at_mp(P); - } - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - const uword n_slices = P.get_n_slices(); - - eT val1 = eT(0); - eT val2 = eT(0); - - for(uword slice = 0; slice < n_slices; ++slice) - for(uword col = 0; col < n_cols; ++col ) - { - uword i,j; - for(i=0, j=1; j -arma_warn_unused -arma_hot -inline -typename T1::elem_type -accu(const BaseCube& X) - { - arma_debug_sigprint(); - - const ProxyCube P(X.get_ref()); - - if(is_Cube::stored_type>::value) - { - unwrap_cube::stored_type> tmp(P.Q); - - return arrayops::accumulate(tmp.M.memptr(), tmp.M.n_elem); - } - - return (ProxyCube::use_at) ? accu_cube_proxy_at(P) : accu_cube_proxy_linear(P); - } - - - -//! explicit handling of multiply-and-accumulate (cube version) -template -arma_warn_unused -inline -typename T1::elem_type -accu(const eGlueCube& expr) - { - arma_debug_sigprint(); - - typedef eGlueCube expr_type; - - typedef typename ProxyCube::stored_type P1_stored_type; - typedef typename ProxyCube::stored_type P2_stored_type; - - if(is_Cube::value && is_Cube::value) - { - const unwrap_cube tmp1(expr.P1.Q); - const unwrap_cube tmp2(expr.P2.Q); - - return op_dot::direct_dot(tmp1.M.n_elem, tmp1.M.memptr(), tmp2.M.memptr()); - } - - const ProxyCube P(expr); - - return (ProxyCube::use_at) ? accu_cube_proxy_at(P) : accu_cube_proxy_linear(P); - } - - - -// - - - -template -arma_warn_unused -inline -typename arma_scalar_only::result -accu(const T& x) - { - return x; - } - - - -//! accumulate values in a sparse object -template -arma_warn_unused -inline -typename T1::elem_type -accu(const SpBase& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const SpProxy P(expr.get_ref()); - - const uword N = P.get_n_nonzero(); - - if(N == 0) { return eT(0); } - - if(SpProxy::use_iterator == false) - { - // direct counting - return arrayops::accumulate(P.get_values(), N); - } - - if(is_SpSubview::stored_type>::value) - { - const SpSubview& sv = reinterpret_cast< const SpSubview& >(P.Q); - - if(sv.n_rows == sv.m.n_rows) - { - const SpMat& m = sv.m; - const uword col = sv.aux_col1; - - return arrayops::accumulate(&(m.values[ m.col_ptrs[col] ]), N); - } - } - - typename SpProxy::const_iterator_type it = P.begin(); - - eT val = eT(0); - - for(uword i=0; i < N; ++i) { val += (*it); ++it; } - - return val; - } - - - -//! explicit handling of accu(A + B), where A and B are sparse matrices -template -arma_warn_unused -inline -typename T1::elem_type -accu(const SpGlue& expr) - { - arma_debug_sigprint(); - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - arma_conform_assert_same_size(UA.M.n_rows, UA.M.n_cols, UB.M.n_rows, UB.M.n_cols, "addition"); - - return (accu(UA.M) + accu(UB.M)); - } - - - -//! explicit handling of accu(A - B), where A and B are sparse matrices -template -arma_warn_unused -inline -typename T1::elem_type -accu(const SpGlue& expr) - { - arma_debug_sigprint(); - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - arma_conform_assert_same_size(UA.M.n_rows, UA.M.n_cols, UB.M.n_rows, UB.M.n_cols, "subtraction"); - - return (accu(UA.M) - accu(UB.M)); - } - - - -//! explicit handling of accu(A % B), where A and B are sparse matrices -template -arma_warn_unused -inline -typename T1::elem_type -accu(const SpGlue& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const SpProxy px(expr.A); - const SpProxy py(expr.B); - - typename SpProxy::const_iterator_type x_it = px.begin(); - typename SpProxy::const_iterator_type x_it_end = px.end(); - - typename SpProxy::const_iterator_type y_it = py.begin(); - typename SpProxy::const_iterator_type y_it_end = py.end(); - - eT acc = eT(0); - - while( (x_it != x_it_end) || (y_it != y_it_end) ) - { - if(x_it == y_it) - { - acc += ((*x_it) * (*y_it)); - - ++x_it; - ++y_it; - } - else - { - const uword x_it_col = x_it.col(); - const uword x_it_row = x_it.row(); - - const uword y_it_col = y_it.col(); - const uword y_it_row = y_it.row(); - - if((x_it_col < y_it_col) || ((x_it_col == y_it_col) && (x_it_row < y_it_row))) // if y is closer to the end - { - ++x_it; - } - else // x is closer to the end - { - ++y_it; - } - } - } - - return acc; - } - - - -template -arma_warn_unused -inline -typename T1::elem_type -accu(const SpOp& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - constexpr bool is_vectorise = \ - (is_same_type::yes) - || (is_same_type::yes) - || (is_same_type::yes); - - if(is_vectorise) { return accu(expr.m); } - - const SpMat tmp = expr; - - return accu(tmp); - } - - - -template -arma_warn_unused -inline -uword -accu(const mtSpOp& X, const typename arma_spop_rel_only::result* junk1 = nullptr, const typename arma_not_cx::result* junk2 = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - typedef typename T1::elem_type eT; - - const eT k = X.aux; - - const SpProxy P(X.m); - - const uword n_zeros = P.get_n_elem() - P.get_n_nonzero(); - - const eT zero = eT(0); - - // shortcuts - - if( (is_same_type::yes) && (k == zero) ) { return n_zeros; } - if( (is_same_type::yes) && (k == zero) ) { return P.get_n_nonzero(); } - - // take into account all implicit zeros - - bool use_n_zeros; - - if(is_same_type::yes) { use_n_zeros = (zero == k ); } - else if(is_same_type::yes) { use_n_zeros = (zero != k ); } - else if(is_same_type::yes) { use_n_zeros = (k < zero); } - else if(is_same_type::yes) { use_n_zeros = (zero < k ); } - else if(is_same_type::yes) { use_n_zeros = (k > zero); } - else if(is_same_type::yes) { use_n_zeros = (zero > k ); } - else if(is_same_type::yes) { use_n_zeros = (k <= zero); } - else if(is_same_type::yes) { use_n_zeros = (zero <= k ); } - else if(is_same_type::yes) { use_n_zeros = (k >= zero); } - else if(is_same_type::yes) { use_n_zeros = (zero >= k ); } - else { use_n_zeros = false; } - - uword count = (use_n_zeros) ? n_zeros : 0; - - typename SpProxy::const_iterator_type it = P.begin(); - typename SpProxy::const_iterator_type it_end = P.end(); - - // take into account all non-zero elements - - for(; it != it_end; ++it) - { - const eT val = (*it); - - bool condition; - - if(is_same_type::yes) { condition = (val == k ); } - else if(is_same_type::yes) { condition = (val != k ); } - else if(is_same_type::yes) { condition = (k < val); } - else if(is_same_type::yes) { condition = (val < k ); } - else if(is_same_type::yes) { condition = (k > val); } - else if(is_same_type::yes) { condition = (val > k ); } - else if(is_same_type::yes) { condition = (k <= val); } - else if(is_same_type::yes) { condition = (val <= k ); } - else if(is_same_type::yes) { condition = (k >= val); } - else if(is_same_type::yes) { condition = (val >= k ); } - else { condition = false; } - - count += (condition) ? uword(1) : uword(0); - } - - return count; - } - - - -template -arma_warn_unused -inline -uword -accu(const mtSpOp& X, const typename arma_spop_rel_only::result* junk1 = nullptr, const typename arma_cx_only::result* junk2 = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - typedef typename T1::elem_type eT; - - const eT k = X.aux; - - const SpProxy P(X.m); - - const uword n_zeros = P.get_n_elem() - P.get_n_nonzero(); - - const eT zero = eT(0); - - // shortcuts - - if( (is_same_type::yes) && (k == zero) ) { return n_zeros; } - if( (is_same_type::yes) && (k == zero) ) { return P.get_n_nonzero(); } - - // take into account all implicit zeros - - bool use_n_zeros; - - if(is_same_type::yes) { use_n_zeros = (zero == k); } - else if(is_same_type::yes) { use_n_zeros = (zero != k); } - else { use_n_zeros = false; } - - uword count = (use_n_zeros) ? n_zeros : 0; - - typename SpProxy::const_iterator_type it = P.begin(); - typename SpProxy::const_iterator_type it_end = P.end(); - - // take into account all non-zero elements - - for(; it != it_end; ++it) - { - const eT val = (*it); - - bool condition; - - if(is_same_type::yes) { condition = (val == k); } - else if(is_same_type::yes) { condition = (val != k); } - else { condition = false; } - - count += (condition) ? uword(1) : uword(0); - } - - return count; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_all.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_all.hpp deleted file mode 100644 index 5263e60ef..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_all.hpp +++ /dev/null @@ -1,95 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_all -//! @{ - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::yes, - bool - >::result -all(const T1& X) - { - arma_debug_sigprint(); - - return op_all::all_vec(X); - } - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::no, - const mtOp - >::result -all(const T1& X) - { - arma_debug_sigprint(); - - return mtOp(X, 0, 0); - } - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value, - const mtOp - >::result -all(const T1& X, const uword dim) - { - arma_debug_sigprint(); - - return mtOp(X, dim, 0); - } - - - -//! for compatibility purposes: allows compiling user code designed for earlier versions of Armadillo -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_supported_elem_type::value, - bool - >::result -all(const T& val) - { - return (val != T(0)); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_any.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_any.hpp deleted file mode 100644 index 3685b4808..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_any.hpp +++ /dev/null @@ -1,95 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_any -//! @{ - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::yes, - bool - >::result -any(const T1& X) - { - arma_debug_sigprint(); - - return op_any::any_vec(X); - } - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::no, - const mtOp - >::result -any(const T1& X) - { - arma_debug_sigprint(); - - return mtOp(X, 0, 0); - } - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value, - const mtOp - >::result -any(const T1& X, const uword dim) - { - arma_debug_sigprint(); - - return mtOp(X, dim, 0); - } - - - -//! for compatibility purposes: allows compiling user code designed for earlier versions of Armadillo -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_supported_elem_type::value, - bool - >::result -any(const T& val) - { - return (val != T(0)); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_approx_equal.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_approx_equal.hpp deleted file mode 100644 index 91f239488..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_approx_equal.hpp +++ /dev/null @@ -1,471 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_approx_equal -//! @{ - - - -template -arma_inline -bool -internal_approx_equal_abs_diff(const eT& x, const eT& y, const typename get_pod_type::result tol) - { - typedef typename get_pod_type::result T; - - if(x != y) - { - if(is_real::value) // also true for eT = std::complex or eT = std::complex - { - if( arma_isnan(x) || arma_isnan(y) || (eop_aux::arma_abs(x - y) > tol) ) { return false; } - } - else - { - if( eop_aux::arma_abs( ( cond_rel< is_cx::no >::gt(x, y) ) ? (x-y) : (y-x) ) > tol ) { return false; } - } - } - - return true; - } - - - -template -arma_inline -bool -internal_approx_equal_rel_diff(const eT& a, const eT& b, const typename get_pod_type::result tol) - { - typedef typename get_pod_type::result T; - - if(a != b) - { - if(is_real::value) // also true for eT = std::complex or eT = std::complex - { - if( arma_isnan(a) || arma_isnan(b) ) { return false; } - - const T abs_a = eop_aux::arma_abs(a); - const T abs_b = eop_aux::arma_abs(b); - - const T max_c = (std::max)(abs_a,abs_b); - - const T abs_d = eop_aux::arma_abs(a - b); - - if(max_c >= T(1)) - { - if( abs_d > (tol * max_c) ) { return false; } - } - else - { - if( (abs_d / max_c) > tol ) { return false; } - } - } - else - { - const T abs_a = eop_aux::arma_abs(a); - const T abs_b = eop_aux::arma_abs(b); - - const T max_c = (std::max)(abs_a,abs_b); - - const T abs_d = eop_aux::arma_abs( ( cond_rel< is_cx::no >::gt(a, b) ) ? (a-b) : (b-a) ); - - if( abs_d > (tol * max_c) ) { return false; } - } - } - - return true; - } - - - -template -inline -bool -internal_approx_equal_worker - ( - const Base& A, - const Base& B, - const typename T1::pod_type abs_tol, - const typename T1::pod_type rel_tol - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - arma_conform_check( ((use_abs_diff == false) && (use_rel_diff == false)), "internal_approx_equal_worker(): both 'use_abs_diff' and 'use_rel_diff' are false" ); - - if(use_abs_diff) { arma_conform_check( cond_rel< is_signed::value >::lt(abs_tol, T(0)), "approx_equal(): argument 'abs_tol' must be >= 0" ); } - if(use_rel_diff) { arma_conform_check( cond_rel< is_signed::value >::lt(rel_tol, T(0)), "approx_equal(): argument 'rel_tol' must be >= 0" ); } - - const Proxy PA(A.get_ref()); - const Proxy PB(B.get_ref()); - - if( (PA.get_n_rows() != PB.get_n_rows()) || (PA.get_n_cols() != PB.get_n_cols()) ) { return false; } - - if( (Proxy::use_at == false) && (Proxy::use_at == false) ) - { - const uword N = PA.get_n_elem(); - - const typename Proxy::ea_type PA_ea = PA.get_ea(); - const typename Proxy::ea_type PB_ea = PB.get_ea(); - - for(uword i=0; i -inline -bool -internal_approx_equal_worker - ( - const BaseCube& A, - const BaseCube& B, - const typename T1::pod_type abs_tol, - const typename T1::pod_type rel_tol - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - arma_conform_check( ((use_abs_diff == false) && (use_rel_diff == false)), "internal_approx_equal_worker(): both 'use_abs_diff' and 'use_rel_diff' are false" ); - - if(use_abs_diff) { arma_conform_check( cond_rel< is_signed::value >::lt(abs_tol, T(0)), "approx_equal(): argument 'abs_tol' must be >= 0" ); } - if(use_rel_diff) { arma_conform_check( cond_rel< is_signed::value >::lt(rel_tol, T(0)), "approx_equal(): argument 'rel_tol' must be >= 0" ); } - - const ProxyCube PA(A.get_ref()); - const ProxyCube PB(B.get_ref()); - - if( (PA.get_n_rows() != PB.get_n_rows()) || (PA.get_n_cols() != PB.get_n_cols()) || (PA.get_n_slices() != PB.get_n_slices()) ) { return false; } - - if( (ProxyCube::use_at == false) && (ProxyCube::use_at == false) ) - { - const uword N = PA.get_n_elem(); - - const typename ProxyCube::ea_type PA_ea = PA.get_ea(); - const typename ProxyCube::ea_type PB_ea = PB.get_ea(); - - for(uword i=0; i -inline -bool -internal_approx_equal_handler(const T1& A, const T2& B, const char* method, const typename T1::pod_type abs_tol, const typename T1::pod_type rel_tol) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - const char sig = (method != nullptr) ? method[0] : char(0); - - arma_conform_check( ((sig != 'a') && (sig != 'r') && (sig != 'b')), "approx_equal(): argument 'method' must be \"absdiff\" or \"reldiff\" or \"both\"" ); - - bool status = false; - - if(sig == 'a') - { - status = internal_approx_equal_worker(A, B, abs_tol, T(0)); - } - else - if(sig == 'r') - { - status = internal_approx_equal_worker(A, B, T(0), rel_tol); - } - else - if(sig == 'b') - { - status = internal_approx_equal_worker(A, B, abs_tol, rel_tol); - } - - return status; - } - - - -template -inline -bool -internal_approx_equal_handler(const T1& A, const T2& B, const char* method, const typename T1::pod_type tol) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - const char sig = (method != nullptr) ? method[0] : char(0); - - arma_conform_check( ((sig != 'a') && (sig != 'r') && (sig != 'b')), "approx_equal(): argument 'method' must be \"absdiff\" or \"reldiff\" or \"both\"" ); - - arma_conform_check( (sig == 'b'), "approx_equal(): argument 'method' is \"both\", but only one 'tol' argument has been given" ); - - bool status = false; - - if(sig == 'a') - { - status = internal_approx_equal_worker(A, B, tol, T(0)); - } - else - if(sig == 'r') - { - status = internal_approx_equal_worker(A, B, T(0), tol); - } - - return status; - } - - - -template -arma_warn_unused -inline -bool -approx_equal(const Base& A, const Base& B, const char* method, const typename T1::pod_type tol) - { - arma_debug_sigprint(); - - return internal_approx_equal_handler(A.get_ref(), B.get_ref(), method, tol); - } - - - -template -arma_warn_unused -inline -bool -approx_equal(const BaseCube& A, const BaseCube& B, const char* method, const typename T1::pod_type tol) - { - arma_debug_sigprint(); - - return internal_approx_equal_handler(A.get_ref(), B.get_ref(), method, tol); - } - - - -template -arma_warn_unused -inline -bool -approx_equal(const Base& A, const Base& B, const char* method, const typename T1::pod_type abs_tol, const typename T1::pod_type rel_tol) - { - arma_debug_sigprint(); - - return internal_approx_equal_handler(A.get_ref(), B.get_ref(), method, abs_tol, rel_tol); - } - - - -template -arma_warn_unused -inline -bool -approx_equal(const BaseCube& A, const BaseCube& B, const char* method, const typename T1::pod_type abs_tol, const typename T1::pod_type rel_tol) - { - arma_debug_sigprint(); - - return internal_approx_equal_handler(A.get_ref(), B.get_ref(), method, abs_tol, rel_tol); - } - - - -template -arma_warn_unused -inline -bool -approx_equal(const SpBase& A, const SpBase& B, const char* method, const typename T1::pod_type tol) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const char sig = (method != nullptr) ? method[0] : char(0); - - arma_conform_check( ((sig != 'a') && (sig != 'r') && (sig != 'b')), "approx_equal(): argument 'method' must be \"absdiff\" or \"reldiff\" or \"both\"" ); - - arma_conform_check( (sig == 'b'), "approx_equal(): argument 'method' is \"both\", but only one 'tol' argument has been given" ); - - arma_conform_check( (sig == 'r'), "approx_equal(): only the \"absdiff\" method is currently implemented for sparse matrices" ); - - arma_conform_check( cond_rel< is_signed::value >::lt(tol, T(0)), "approx_equal(): argument 'tol' must be >= 0" ); - - const unwrap_spmat UA(A.get_ref()); - const unwrap_spmat UB(B.get_ref()); - - if( (UA.M.n_rows != UB.M.n_rows) || (UA.M.n_cols != UB.M.n_cols) ) { return false; } - - const SpMat C = UA.M - UB.M; - - typename SpMat::const_iterator it = C.begin(); - typename SpMat::const_iterator it_end = C.end(); - - while(it != it_end) - { - const eT val = (*it); - - if( arma_isnan(val) || (eop_aux::arma_abs(val) > tol) ) { return false; } - - ++it; - } - - return true; - } - - - -template -arma_warn_unused -inline -bool -approx_equal(const SpBase& A, const SpBase& B, const char* method, const typename T1::pod_type abs_tol, const typename T1::pod_type rel_tol) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - const char sig = (method != nullptr) ? method[0] : char(0); - - arma_conform_check( ((sig != 'a') && (sig != 'r') && (sig != 'b')), "approx_equal(): argument 'method' must be \"absdiff\" or \"reldiff\" or \"both\"" ); - - arma_conform_check( ((sig == 'r') || (sig == 'b')), "approx_equal(): only the \"absdiff\" method is currently implemented for sparse matrices" ); - - arma_conform_check( cond_rel< is_signed::value >::lt(abs_tol, T(0)), "approx_equal(): argument 'abs_tol' must be >= 0" ); - arma_conform_check( cond_rel< is_signed::value >::lt(rel_tol, T(0)), "approx_equal(): argument 'rel_tol' must be >= 0" ); - - return approx_equal(A.get_ref(), B.get_ref(), "abs", abs_tol); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_as_scalar.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_as_scalar.hpp deleted file mode 100644 index 7b5c9b2de..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_as_scalar.hpp +++ /dev/null @@ -1,448 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_as_scalar -//! @{ - - - -struct as_scalar_errmsg - { - arma_cold - arma_noinline - static - std::string - incompat_size_string(const uword n_rows, const uword n_cols) - { - std::ostringstream tmp; - - tmp << "as_scalar(): expected 1x1 matrix; got " << n_rows << 'x' << n_cols; - - return tmp.str(); - } - - arma_cold - arma_noinline - static - std::string - incompat_size_string(const uword n_rows, const uword n_cols, const uword n_slices) - { - std::ostringstream tmp; - - tmp << "as_scalar(): expected 1x1x1 cube; got " << n_rows << 'x' << n_cols << 'x' << n_slices; - - return tmp.str(); - } - }; - - - -template -struct as_scalar_redirect - { - template - inline static typename T1::elem_type apply(const T1& X); - }; - - - -template<> -struct as_scalar_redirect<2> - { - template - inline static typename T1::elem_type apply(const Glue& X); - - inline static void check_size(const uword A_n_rows, const uword A_n_cols, const uword B_n_rows, const uword B_n_cols); - }; - - -template<> -struct as_scalar_redirect<3> - { - template - inline static typename T1::elem_type apply(const Glue< Glue, T3, glue_times>& X); - }; - - - -template -template -inline -typename T1::elem_type -as_scalar_redirect::apply(const T1& X) - { - arma_debug_sigprint(); - - const Proxy P(X); - - if( (arma_config::check_conform) && (P.get_n_elem() != 1) ) - { - arma_conform_check_bounds( true, as_scalar_errmsg::incompat_size_string(P.get_n_rows(), P.get_n_cols()) ); - } - - return (Proxy::use_at) ? P.at(0,0) : P[0]; - } - - - -template -inline -typename T1::elem_type -as_scalar_redirect<2>::apply(const Glue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - // T1 must result in a matrix with one row - // T2 must result in a matrix with one column - // element type must non-complex - - constexpr bool proxy_is_mat = (is_Mat::stored_type>::value && is_Mat::stored_type>::value); - - constexpr bool use_at = (Proxy::use_at) || (Proxy::use_at); - - constexpr bool fast_unwrap = (partial_unwrap::is_fast && partial_unwrap::is_fast); - - if(proxy_is_mat || use_at || fast_unwrap) - { - const partial_unwrap tmp1(X.A); - const partial_unwrap tmp2(X.B); - - typedef typename partial_unwrap::stored_type TA; - typedef typename partial_unwrap::stored_type TB; - - const TA& A = tmp1.M; - const TB& B = tmp2.M; - - const uword A_n_rows = (tmp1.do_trans == false) ? (TA::is_row ? 1 : A.n_rows) : (TA::is_col ? 1 : A.n_cols); - const uword A_n_cols = (tmp1.do_trans == false) ? (TA::is_col ? 1 : A.n_cols) : (TA::is_row ? 1 : A.n_rows); - - const uword B_n_rows = (tmp2.do_trans == false) ? (TB::is_row ? 1 : B.n_rows) : (TB::is_col ? 1 : B.n_cols); - const uword B_n_cols = (tmp2.do_trans == false) ? (TB::is_col ? 1 : B.n_cols) : (TB::is_row ? 1 : B.n_rows); - - if( (arma_config::check_conform) && ((A_n_rows != 1) || (B_n_cols != 1) || (A_n_cols != B_n_rows)) ) - { - as_scalar_redirect<2>::check_size(A_n_rows, A_n_cols, B_n_rows, B_n_cols); - } - - const eT val = op_dot::direct_dot(A.n_elem, A.memptr(), B.memptr()); - - return (tmp1.do_times || tmp2.do_times) ? (val * tmp1.get_val() * tmp2.get_val()) : val; - } - else - { - const Proxy PA(X.A); - const Proxy PB(X.B); - - const uword A_n_rows = PA.get_n_rows(); - const uword A_n_cols = PA.get_n_cols(); - - const uword B_n_rows = PB.get_n_rows(); - const uword B_n_cols = PB.get_n_cols(); - - if( (arma_config::check_conform) && ((A_n_rows != 1) || (B_n_cols != 1) || (A_n_cols != B_n_rows)) ) - { - as_scalar_redirect<2>::check_size(A_n_rows, A_n_cols, B_n_rows, B_n_cols); - } - - return op_dot::apply_proxy_linear(PA,PB); - } - } - - - -inline -void -as_scalar_redirect<2>::check_size(const uword A_n_rows, const uword A_n_cols, const uword B_n_rows, const uword B_n_cols) - { - arma_conform_assert_mul_size(A_n_rows, A_n_cols, B_n_rows, B_n_cols, "matrix multiplication"); - - arma_conform_check_bounds( ((A_n_rows != 1) || (B_n_cols != 1)), as_scalar_errmsg::incompat_size_string(A_n_rows, B_n_cols) ); - } - - - -template -inline -typename T1::elem_type -as_scalar_redirect<3>::apply(const Glue< Glue, T3, glue_times >& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - // T1 * T2 must result in a matrix with one row - // T3 must result in a matrix with one column - // element type must non-complex - - typedef typename strip_inv ::stored_type T2_stripped_1; - typedef typename strip_diagmat::stored_type T2_stripped_2; - - const strip_inv strip1(X.A.B); - const strip_diagmat strip2(strip1.M); - - constexpr bool tmp2_do_inv_gen = strip1.do_inv_gen && arma_config::optimise_invexpr; - constexpr bool tmp2_do_diagmat = strip2.do_diagmat; - - if(tmp2_do_diagmat == false) - { - const Mat tmp(X); - - if( (arma_config::check_conform) && (tmp.n_elem != 1) ) - { - arma_conform_check_bounds(true, as_scalar_errmsg::incompat_size_string(tmp.n_rows, tmp.n_cols) ); - } - - return tmp[0]; - } - else - { - const partial_unwrap tmp1(X.A.A); - const partial_unwrap tmp2(strip2.M); - const partial_unwrap tmp3(X.B); - - const Mat& A = tmp1.M; - const Mat& B = tmp2.M; - const Mat& C = tmp3.M; - - const uword A_n_rows = (tmp1.do_trans == false) ? A.n_rows : A.n_cols; - const uword A_n_cols = (tmp1.do_trans == false) ? A.n_cols : A.n_rows; - - const bool B_is_vec = B.is_vec(); - - const uword B_n_rows = (B_is_vec) ? B.n_elem : ( (tmp2.do_trans == false) ? B.n_rows : B.n_cols ); - const uword B_n_cols = (B_is_vec) ? B.n_elem : ( (tmp2.do_trans == false) ? B.n_cols : B.n_rows ); - - const uword C_n_rows = (tmp3.do_trans == false) ? C.n_rows : C.n_cols; - const uword C_n_cols = (tmp3.do_trans == false) ? C.n_cols : C.n_rows; - - const eT val = tmp1.get_val() * tmp2.get_val() * tmp3.get_val(); - - arma_conform_check_bounds - ( - (A_n_rows != 1) || - (C_n_cols != 1) || - (A_n_cols != B_n_rows) || - (B_n_cols != C_n_rows) - , - "as_scalar(): expected 1x1 matrix" - ); - - - if(B_is_vec) - { - if(tmp2_do_inv_gen) - { - return val * op_dotext::direct_rowvec_invdiagvec_colvec(A.mem, B, C.mem); - } - else - { - return val * op_dot::direct_dot(A.n_elem, A.mem, B.mem, C.mem); - } - } - else - { - if(tmp2_do_inv_gen) - { - return val * op_dotext::direct_rowvec_invdiagmat_colvec(A.mem, B, C.mem); - } - else - { - return val * op_dotext::direct_rowvec_diagmat_colvec(A.mem, B, C.mem); - } - } - } - } - - - -template -inline -typename T1::elem_type -as_scalar_diag(const Base& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap tmp(X.get_ref()); - const Mat& A = tmp.M; - - arma_conform_check_bounds( (A.n_elem != 1), "as_scalar(): expected 1x1 matrix" ); - - return A.mem[0]; - } - - - -template -inline -typename T1::elem_type -as_scalar_diag(const Glue< Glue, T3, glue_times >& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - // T1 * T2 must result in a matrix with one row - // T3 must result in a matrix with one column - - typedef typename strip_diagmat::stored_type T2_stripped; - - const strip_diagmat strip(X.A.B); - - const partial_unwrap tmp1(X.A.A); - const partial_unwrap tmp2(strip.M); - const partial_unwrap tmp3(X.B); - - const Mat& A = tmp1.M; - const Mat& B = tmp2.M; - const Mat& C = tmp3.M; - - - const uword A_n_rows = (tmp1.do_trans == false) ? A.n_rows : A.n_cols; - const uword A_n_cols = (tmp1.do_trans == false) ? A.n_cols : A.n_rows; - - const bool B_is_vec = B.is_vec(); - - const uword B_n_rows = (B_is_vec) ? B.n_elem : ( (tmp2.do_trans == false) ? B.n_rows : B.n_cols ); - const uword B_n_cols = (B_is_vec) ? B.n_elem : ( (tmp2.do_trans == false) ? B.n_cols : B.n_rows ); - - const uword C_n_rows = (tmp3.do_trans == false) ? C.n_rows : C.n_cols; - const uword C_n_cols = (tmp3.do_trans == false) ? C.n_cols : C.n_rows; - - const eT val = tmp1.get_val() * tmp2.get_val() * tmp3.get_val(); - - arma_conform_check_bounds - ( - (A_n_rows != 1) || - (C_n_cols != 1) || - (A_n_cols != B_n_rows) || - (B_n_cols != C_n_rows) - , - "as_scalar(): expected 1x1 matrix" - ); - - - if(B_is_vec) - { - return val * op_dot::direct_dot(A.n_elem, A.mem, B.mem, C.mem); - } - else - { - return val * op_dotext::direct_rowvec_diagmat_colvec(A.mem, B, C.mem); - } - } - - - -template -arma_warn_unused -inline -typename T1::elem_type -as_scalar(const Glue& X, const typename arma_not_cx::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - if(is_glue_times_diag::value) { return as_scalar_diag(X); } - - constexpr uword N_mat = 1 + depth_lhs< glue_times, Glue >::num; - - arma_debug_print(arma_str::format("N_mat: %u") % N_mat); - - return as_scalar_redirect::apply(X); - } - - - -template -arma_warn_unused -inline -typename T1::elem_type -as_scalar(const Base& X) - { - arma_debug_sigprint(); - - const Proxy P(X.get_ref()); - - if( (arma_config::check_conform) && (P.get_n_elem() != 1) ) - { - arma_conform_check_bounds( true, as_scalar_errmsg::incompat_size_string(P.get_n_rows(), P.get_n_cols()) ); - } - - return (Proxy::use_at) ? P.at(0,0) : P[0]; - } - - -template -arma_warn_unused -inline -typename T1::elem_type -as_scalar(const BaseCube& X) - { - arma_debug_sigprint(); - - const ProxyCube P(X.get_ref()); - - if( (arma_config::check_conform) && (P.get_n_elem() != 1) ) - { - arma_conform_check_bounds( true, as_scalar_errmsg::incompat_size_string(P.get_n_rows(), P.get_n_cols(), P.get_n_slices()) ); - } - - return (ProxyCube::use_at) ? P.at(0,0,0) : P[0]; - } - - - -template -arma_warn_unused -arma_inline -typename arma_scalar_only::result -as_scalar(const T& x) - { - return x; - } - - - -template -arma_warn_unused -inline -typename T1::elem_type -as_scalar(const SpBase& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat tmp(X.get_ref()); - const SpMat& A = tmp.M; - - if( (arma_config::check_conform) && (A.n_elem != 1) ) - { - arma_conform_check_bounds(true, as_scalar_errmsg::incompat_size_string(A.n_rows, A.n_cols) ); - } - - return A.at(0,0); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_chi2rnd.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_chi2rnd.hpp deleted file mode 100644 index 4e185785e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_chi2rnd.hpp +++ /dev/null @@ -1,182 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_chi2rnd -//! @{ - - - -arma_warn_unused -inline -double -chi2rnd(const double df) - { - arma_debug_sigprint(); - - op_chi2rnd_varying_df generator; - - return generator(df); - } - - - -template -arma_warn_unused -inline -typename arma_real_only::result -chi2rnd(const eT df) - { - arma_debug_sigprint(); - - op_chi2rnd_varying_df generator; - - return generator(df); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_arma_type::value && is_real::value), - const Op - >::result -chi2rnd(const T1& expr) - { - arma_debug_sigprint(); - - return Op(expr); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_Mat::value && is_real::value), - obj_type - >::result -chi2rnd(const typename obj_type::elem_type df, const uword n_rows, const uword n_cols) - { - arma_debug_sigprint(); - - if(is_Col::value) - { - arma_conform_check( (n_cols != 1), "chi2rnd(): incompatible size" ); - } - else - if(is_Row::value) - { - arma_conform_check( (n_rows != 1), "chi2rnd(): incompatible size" ); - } - - obj_type out(n_rows, n_cols, arma_nozeros_indicator()); - - op_chi2rnd::fill_constant_df(out, df); - - return out; - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_Mat::value && is_real::value), - obj_type - >::result -chi2rnd(const typename obj_type::elem_type df, const SizeMat& s) - { - arma_debug_sigprint(); - - return chi2rnd(df, s.n_rows, s.n_cols); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_Mat::value && is_real::value), - obj_type - >::result -chi2rnd(const typename obj_type::elem_type df, const uword n_elem) - { - arma_debug_sigprint(); - - if(is_Row::value) - { - return chi2rnd(df, 1, n_elem); - } - else - { - return chi2rnd(df, n_elem, 1); - } - } - - - -arma_warn_unused -inline -mat -chi2rnd(const double df, const uword n_rows, const uword n_cols) - { - arma_debug_sigprint(); - - return chi2rnd(df, n_rows, n_cols); - } - - - -arma_warn_unused -inline -mat -chi2rnd(const double df, const SizeMat& s) - { - arma_debug_sigprint(); - - return chi2rnd(df, s.n_rows, s.n_cols); - } - - - -arma_warn_unused -inline -vec -chi2rnd(const double df, const uword n_elem) - { - arma_debug_sigprint(); - - return chi2rnd(df, n_elem, 1); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_chol.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_chol.hpp deleted file mode 100644 index 00b640d14..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_chol.hpp +++ /dev/null @@ -1,149 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_chol -//! @{ - - - -template -arma_warn_unused -inline -typename enable_if2< is_supported_blas_type::value, const Op >::result -chol - ( - const Base& X, - const char* layout = "upper" - ) - { - arma_debug_sigprint(); - - const char sig = (layout != nullptr) ? layout[0] : char(0); - - arma_conform_check( ((sig != 'u') && (sig != 'l')), "chol(): layout must be \"upper\" or \"lower\"" ); - - return Op(X.get_ref(), ((sig == 'u') ? 0 : 1), 0 ); - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -chol - ( - Mat& out, - const Base& X, - const char* layout = "upper" - ) - { - arma_debug_sigprint(); - - const char sig = (layout != nullptr) ? layout[0] : char(0); - - arma_conform_check( ((sig != 'u') && (sig != 'l')), "chol(): layout must be \"upper\" or \"lower\"" ); - - const bool status = op_chol::apply_direct(out, X.get_ref(), ((sig == 'u') ? 0 : 1)); - - if(status == false) - { - out.soft_reset(); - arma_warn(3, "chol(): decomposition failed"); - } - - return status; - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -chol - ( - Mat& out, - Mat& P, - const Base& X, - const char* layout = "upper", - const char* P_mode = "matrix" - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const char sig_layout = (layout != nullptr) ? layout[0] : char(0); - const char sig_P_mode = (P_mode != nullptr) ? P_mode[0] : char(0); - - arma_conform_check( ((sig_layout != 'u') && (sig_layout != 'l')), "chol(): argument 'layout' must be \"upper\" or \"lower\"" ); - arma_conform_check( ((sig_P_mode != 'm') && (sig_P_mode != 'v')), "chol(): argument 'P_mode' must be \"vector\" or \"matrix\"" ); - - out = X.get_ref(); - - arma_conform_check( (out.is_square() == false), "chol(): given matrix must be square sized", [&](){ out.soft_reset(); } ); - - if(out.is_empty()) - { - P.reset(); - return true; - } - - if((arma_config::check_conform) && (auxlib::rudimentary_sym_check(out) == false)) - { - if(is_cx::no ) { arma_warn(1, "chol(): given matrix is not symmetric"); } - if(is_cx::yes) { arma_warn(1, "chol(): given matrix is not hermitian"); } - } - - bool status = false; - - if(sig_P_mode == 'v') - { - status = auxlib::chol_pivot(out, P, ((sig_layout == 'u') ? 0 : 1)); - } - else - if(sig_P_mode == 'm') - { - Mat P_vec; - - status = auxlib::chol_pivot(out, P_vec, ((sig_layout == 'u') ? 0 : 1)); - - if(status) - { - // construct P - - const uword N = P_vec.n_rows; - - P.zeros(N,N); - - for(uword i=0; i < N; ++i) { P.at(P_vec[i], i) = uword(1); } - } - } - - if(status == false) - { - out.soft_reset(); - P.soft_reset(); - arma_warn(3, "chol(): decomposition failed"); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_clamp.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_clamp.hpp deleted file mode 100644 index f7c53c707..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_clamp.hpp +++ /dev/null @@ -1,117 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_clamp -//! @{ - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && is_cx::no, - const mtOp - >::result -clamp(const T1& X, const typename T1::elem_type min_val, const typename T1::elem_type max_val) - { - arma_debug_sigprint(); - - return mtOp(mtOp_dual_aux_indicator(), X, min_val, max_val); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && is_cx::yes, - const mtOp - >::result -clamp(const T1& X, const typename T1::elem_type min_val, const typename T1::elem_type max_val) - { - arma_debug_sigprint(); - - return mtOp(mtOp_dual_aux_indicator(), X, min_val, max_val); - } - - - -template -arma_warn_unused -inline -const mtOpCube -clamp(const BaseCube& X, const typename T1::elem_type min_val, const typename T1::elem_type max_val, typename arma_not_cx::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return mtOpCube(mtOpCube_dual_aux_indicator(), X.get_ref(), min_val, max_val); - } - - - -template -arma_warn_unused -inline -const mtOpCube -clamp(const BaseCube& X, const typename T1::elem_type min_val, const typename T1::elem_type max_val, typename arma_cx_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return mtOpCube(mtOpCube_dual_aux_indicator(), X.get_ref(), min_val, max_val); - } - - - -template -arma_warn_unused -inline -SpMat -clamp(const SpBase& X, const typename T1::elem_type min_val, const typename T1::elem_type max_val) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(is_cx::no) - { - arma_conform_check( (access::tmp_real(min_val) > access::tmp_real(max_val)), "clamp(): min_val must be less than max_val" ); - } - else - { - arma_conform_check( (access::tmp_real(min_val) > access::tmp_real(max_val)), "clamp(): real(min_val) must be less than real(max_val)" ); - arma_conform_check( (access::tmp_imag(min_val) > access::tmp_imag(max_val)), "clamp(): imag(min_val) must be less than imag(max_val)" ); - } - - SpMat out = X.get_ref(); - - out.clamp(min_val, max_val); - - return out; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_cond_rcond.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_cond_rcond.hpp deleted file mode 100644 index 2d7c1d8d1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_cond_rcond.hpp +++ /dev/null @@ -1,63 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_cond -//! @{ - - - -template -arma_warn_unused -inline -typename enable_if2::value, typename T1::pod_type>::result -cond(const Base& X) - { - arma_debug_sigprint(); - - return op_cond::apply(X.get_ref()); - } - - - -template -arma_warn_unused -inline -typename enable_if2::value, typename T1::pod_type>::result -rcond(const Base& X) - { - arma_debug_sigprint(); - - return op_rcond::apply(X.get_ref()); - } - - - -// template -// arma_warn_unused -// inline -// typename enable_if2::value, typename T1::pod_type>::result -// rcond(const SpBase& X) -// { -// arma_debug_sigprint(); -// -// return sp_auxlib::rcond(X.get_ref()); -// } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_conv.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_conv.hpp deleted file mode 100644 index cc47e2dbf..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_conv.hpp +++ /dev/null @@ -1,74 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_conv -//! @{ - - - -//! Convolution, which is also equivalent to polynomial multiplication and FIR digital filtering. - -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value && is_same_type::value), - const Glue - >::result -conv(const T1& A, const T2& B, const char* shape = "full") - { - arma_debug_sigprint(); - - const char sig = (shape != nullptr) ? shape[0] : char(0); - - arma_conform_check( ((sig != 'f') && (sig != 's')), "conv(): unsupported value of 'shape' parameter" ); - - const uword mode = (sig == 's') ? uword(1) : uword(0); - - return Glue(A, B, mode); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value && is_same_type::value), - const Glue - >::result -conv2(const T1& A, const T2& B, const char* shape = "full") - { - arma_debug_sigprint(); - - const char sig = (shape != nullptr) ? shape[0] : char(0); - - arma_conform_check( ((sig != 'f') && (sig != 's')), "conv2(): unsupported value of 'shape' parameter" ); - - const uword mode = (sig == 's') ? uword(1) : uword(0); - - return Glue(A, B, mode); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_conv_to.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_conv_to.hpp deleted file mode 100644 index 3639fdd36..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_conv_to.hpp +++ /dev/null @@ -1,936 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_conv_to -//! @{ - - - -//! conversion from Armadillo Base and BaseCube objects to scalars -//! NOTE: use as_scalar() instead; this functionality is kept only for compatibility with old user code -template -class conv_to - { - public: - - template - arma_frown("use as_scalar() instead") inline static out_eT from(const Base& in, const typename arma_not_cx::result* junk = nullptr); - - template - arma_frown("use as_scalar() instead") inline static out_eT from(const Base& in, const typename arma_cx_only::result* junk = nullptr); - - template - arma_frown("use as_scalar() instead") inline static out_eT from(const BaseCube& in, const typename arma_not_cx::result* junk = nullptr); - - template - arma_frown("use as_scalar() instead") inline static out_eT from(const BaseCube& in, const typename arma_cx_only::result* junk = nullptr); - }; - - - -template -template -arma_warn_unused -inline -out_eT -conv_to::from(const Base& in, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - arma_type_check(( is_supported_elem_type::value == false )); - - const Proxy P(in.get_ref()); - - arma_conform_check( (P.get_n_elem() != 1), "conv_to(): expected 1x1 matrix" ); - - return out_eT(Proxy::use_at ? P.at(0,0) : P[0]); - } - - - -template -template -arma_warn_unused -inline -out_eT -conv_to::from(const Base& in, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - arma_type_check(( is_supported_elem_type::value == false )); - - const Proxy P(in.get_ref()); - - arma_conform_check( (P.get_n_elem() != 1), "conv_to(): expected 1x1 matrix" ); - - out_eT out; - - arrayops::convert_cx_scalar(out, (Proxy::use_at ? P.at(0,0) : P[0])); - - return out; - } - - - -template -template -arma_warn_unused -inline -out_eT -conv_to::from(const BaseCube& in, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - arma_type_check(( is_supported_elem_type::value == false )); - - const ProxyCube P(in.get_ref()); - - arma_conform_check( (P.get_n_elem() != 1), "conv_to(): expected 1x1x1 cube" ); - - return out_eT(ProxyCube::use_at ? P.at(0,0,0) : P[0]); - } - - - -template -template -arma_warn_unused -inline -out_eT -conv_to::from(const BaseCube& in, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - arma_type_check(( is_supported_elem_type::value == false )); - - const ProxyCube P(in.get_ref()); - - arma_conform_check( (P.get_n_elem() != 1), "conv_to(): expected 1x1x1 cube" ); - - out_eT out; - - arrayops::convert_cx_scalar(out, (ProxyCube::use_at ? P.at(0,0,0) : P[0])); - - return out; - } - - - -//! conversion to Armadillo matrices from Armadillo Base objects, as well as from std::vector -template -class conv_to< Mat > - { - public: - - template - inline static Mat from(const Base& in, const typename arma_not_cx::result* junk = nullptr); - - template - inline static Mat from(const Base& in, const typename arma_cx_only::result* junk = nullptr); - - // - - template - inline static Mat from(const SpBase& in, const typename arma_not_cx::result* junk = nullptr); - - template - inline static Mat from(const SpBase& in, const typename arma_cx_only::result* junk = nullptr); - - // - - template - inline static Mat from(const std::vector& in, const typename arma_not_cx::result* junk = nullptr); - - template - inline static Mat from(const std::vector& in, const typename arma_cx_only::result* junk = nullptr); - }; - - - -template -template -arma_warn_unused -inline -Mat -conv_to< Mat >::from(const Base& in, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const quasi_unwrap tmp(in.get_ref()); - const Mat& X = tmp.M; - - Mat out(X.n_rows, X.n_cols, arma_nozeros_indicator()); - - arrayops::convert( out.memptr(), X.memptr(), X.n_elem ); - - return out; - } - - - -template -template -arma_warn_unused -inline -Mat -conv_to< Mat >::from(const Base& in, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const quasi_unwrap tmp(in.get_ref()); - const Mat& X = tmp.M; - - Mat out(X.n_rows, X.n_cols, arma_nozeros_indicator()); - - arrayops::convert_cx( out.memptr(), X.memptr(), X.n_elem ); - - return out; - } - - - -template -template -arma_warn_unused -inline -Mat -conv_to< Mat >::from(const SpBase& in, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const unwrap_spmat U(in.get_ref()); - const SpMat& X = U.M; - - Mat out(X.n_rows, X.n_cols, arma_zeros_indicator()); - - podarray tmp(X.n_nonzero); - - arrayops::convert( tmp.memptr(), X.values, X.n_nonzero ); - - typename SpMat::const_iterator it = X.begin(); - typename SpMat::const_iterator it_end = X.end(); - - for(uword count=0; it != it_end; ++it, ++count) { out.at(it.row(), it.col()) = tmp[count]; } - - return out; - } - - - -template -template -arma_warn_unused -inline -Mat -conv_to< Mat >::from(const SpBase& in, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const unwrap_spmat U(in.get_ref()); - const SpMat& X = U.M; - - Mat out(X.n_rows, X.n_cols, arma_zeros_indicator()); - - podarray tmp(X.n_nonzero); - - arrayops::convert_cx( tmp.memptr(), X.values, X.n_nonzero ); - - typename SpMat::const_iterator it = X.begin(); - typename SpMat::const_iterator it_end = X.end(); - - for(uword count=0; it != it_end; ++it, ++count) { out.at(it.row(), it.col()) = tmp[count]; } - - return out; - } - - - -template -template -arma_warn_unused -inline -Mat -conv_to< Mat >::from(const std::vector& in, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const uword N = uword( in.size() ); - - Mat out(N, 1, arma_nozeros_indicator()); - - if(N > 0) - { - arrayops::convert( out.memptr(), &(in[0]), N ); - } - - return out; - } - - - -template -template -arma_warn_unused -inline -Mat -conv_to< Mat >::from(const std::vector& in, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const uword N = uword( in.size() ); - - Mat out(N, 1, arma_nozeros_indicator()); - - if(N > 0) - { - arrayops::convert_cx( out.memptr(), &(in[0]), N ); - } - - return out; - } - - - -//! conversion to Armadillo row vectors from Armadillo Base objects, as well as from std::vector -template -class conv_to< Row > - { - public: - - template - inline static Row from(const Base& in, const typename arma_not_cx::result* junk = nullptr); - - template - inline static Row from(const Base& in, const typename arma_cx_only::result* junk = nullptr); - - // - - template - inline static Row from(const std::vector& in, const typename arma_not_cx::result* junk = nullptr); - - template - inline static Row from(const std::vector& in, const typename arma_cx_only::result* junk = nullptr); - }; - - - -template -template -arma_warn_unused -inline -Row -conv_to< Row >::from(const Base& in, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const quasi_unwrap tmp(in.get_ref()); - const Mat& X = tmp.M; - - arma_conform_check( ( (X.is_vec() == false) && (X.is_empty() == false) ), "conv_to(): given object cannot be interpreted as a vector" ); - - Row out(X.n_elem, arma_nozeros_indicator()); - - arrayops::convert( out.memptr(), X.memptr(), X.n_elem ); - - return out; - } - - - -template -template -arma_warn_unused -inline -Row -conv_to< Row >::from(const Base& in, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const quasi_unwrap tmp(in.get_ref()); - const Mat& X = tmp.M; - - arma_conform_check( ( (X.is_vec() == false) && (X.is_empty() == false) ), "conv_to(): given object cannot be interpreted as a vector" ); - - Row out(X.n_rows, X.n_cols, arma_nozeros_indicator()); - - arrayops::convert_cx( out.memptr(), X.memptr(), X.n_elem ); - - return out; - } - - - -template -template -arma_warn_unused -inline -Row -conv_to< Row >::from(const std::vector& in, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const uword N = uword( in.size() ); - - Row out(N, arma_nozeros_indicator()); - - if(N > 0) - { - arrayops::convert( out.memptr(), &(in[0]), N ); - } - - return out; - } - - - -template -template -arma_warn_unused -inline -Row -conv_to< Row >::from(const std::vector& in, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const uword N = uword( in.size() ); - - Row out(N, arma_nozeros_indicator()); - - if(N > 0) - { - arrayops::convert_cx( out.memptr(), &(in[0]), N ); - } - - return out; - } - - - -//! conversion to Armadillo column vectors from Armadillo Base objects, as well as from std::vector -template -class conv_to< Col > - { - public: - - template - inline static Col from(const Base& in, const typename arma_not_cx::result* junk = nullptr); - - template - inline static Col from(const Base& in, const typename arma_cx_only::result* junk = nullptr); - - // - - template - inline static Col from(const std::vector& in, const typename arma_not_cx::result* junk = nullptr); - - template - inline static Col from(const std::vector& in, const typename arma_cx_only::result* junk = nullptr); - }; - - - -template -template -arma_warn_unused -inline -Col -conv_to< Col >::from(const Base& in, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const quasi_unwrap tmp(in.get_ref()); - const Mat& X = tmp.M; - - arma_conform_check( ( (X.is_vec() == false) && (X.is_empty() == false) ), "conv_to(): given object cannot be interpreted as a vector" ); - - Col out(X.n_elem, arma_nozeros_indicator()); - - arrayops::convert( out.memptr(), X.memptr(), X.n_elem ); - - return out; - } - - - -template -template -arma_warn_unused -inline -Col -conv_to< Col >::from(const Base& in, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const quasi_unwrap tmp(in.get_ref()); - const Mat& X = tmp.M; - - arma_conform_check( ( (X.is_vec() == false) && (X.is_empty() == false) ), "conv_to(): given object cannot be interpreted as a vector" ); - - Col out(X.n_rows, X.n_cols, arma_nozeros_indicator()); - - arrayops::convert_cx( out.memptr(), X.memptr(), X.n_elem ); - - return out; - } - - - -template -template -arma_warn_unused -inline -Col -conv_to< Col >::from(const std::vector& in, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const uword N = uword( in.size() ); - - Col out(N, arma_nozeros_indicator()); - - if(N > 0) - { - arrayops::convert( out.memptr(), &(in[0]), N ); - } - - return out; - } - - - -template -template -arma_warn_unused -inline -Col -conv_to< Col >::from(const std::vector& in, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const uword N = uword( in.size() ); - - Col out(N, arma_nozeros_indicator()); - - if(N > 0) - { - arrayops::convert_cx( out.memptr(), &(in[0]), N ); - } - - return out; - } - - - -//! convert between SpMat types -template -class conv_to< SpMat > - { - public: - - template - inline static SpMat from(const SpBase& in, const typename arma_not_cx::result* junk = nullptr); - - template - inline static SpMat from(const SpBase& in, const typename arma_cx_only::result* junk = nullptr); - - // - - template - inline static SpMat from(const Base& in, const typename arma_not_cx::result* junk = nullptr); - - template - inline static SpMat from(const Base& in, const typename arma_cx_only::result* junk = nullptr); - }; - - - -template -template -arma_warn_unused -inline -SpMat -conv_to< SpMat >::from(const SpBase& in, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const unwrap_spmat tmp(in.get_ref()); - const SpMat& X = tmp.M; - - SpMat out(arma_layout_indicator(), X); - - arrayops::convert( access::rwp(out.values), X.values, X.n_nonzero ); - - out.remove_zeros(); - - return out; - } - - - -template -template -arma_warn_unused -inline -SpMat -conv_to< SpMat >::from(const SpBase& in, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const unwrap_spmat tmp(in.get_ref()); - const SpMat& X = tmp.M; - - SpMat out(arma_layout_indicator(), X); - - arrayops::convert_cx( access::rwp(out.values), X.values, X.n_nonzero ); - - out.remove_zeros(); - - return out; - } - - - -template -template -arma_warn_unused -inline -SpMat -conv_to< SpMat >::from(const Base& in, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - SpMat out; - - const quasi_unwrap U(in.get_ref()); - const Mat& X = U.M; - - if(is_same_type::yes) - { - const Mat& Y = reinterpret_cast&>(X); - - SpMat tmp(Y); - - out.steal_mem(tmp); - } - else - { - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - const uword X_n_elem = X.n_elem; - - const in_eT* X_mem = X.memptr(); - - uword X_nnz = 0; - - for(uword i=0; i < X_n_elem; ++i) { X_nnz += (X_mem[i] != in_eT(0)) ? uword(1) : uword(0); } - - podarray< in_eT> X_nonzeros(X_nnz); - podarray Y_nonzeros(X_nnz); - - for(uword i=0,count=0; i < X_n_elem; ++i) - { - const in_eT X_val = X_mem[i]; - - if(X_val != in_eT(0)) { X_nonzeros[count] = X_val; ++count; } - } - - arrayops::convert( Y_nonzeros.memptr(), X_nonzeros.memptr(), X_nnz ); - - if(X_nnz == 0) - { - out.set_size(X_n_rows, X.n_cols); - } - else - { - SpMat tmp(arma_reserve_indicator(), X_n_rows, X_n_cols, X_nnz); - - uword count = 0; - - for(uword c=0; c < X_n_cols; ++c) - for(uword r=0; r < X_n_rows; ++r) - { - const in_eT X_val = (*X_mem); ++X_mem; - - if(X_val != in_eT(0)) - { - access::rw(tmp.values[count]) = Y_nonzeros[count]; - access::rw(tmp.row_indices[count]) = r; - access::rw(tmp.col_ptrs[c + 1])++; - ++count; - } - } - - // Sum column counts to be column pointers. - for(uword c=1; c <= tmp.n_cols; ++c) - { - access::rw(tmp.col_ptrs[c]) += tmp.col_ptrs[c - 1]; - } - - tmp.remove_zeros(); // in case conversion resulted in an element equal to zero - - out.steal_mem(tmp); - } - } - - return out; - } - - - -template -template -arma_warn_unused -inline -SpMat -conv_to< SpMat >::from(const Base& in, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - SpMat out; - - const quasi_unwrap U(in.get_ref()); - const Mat& X = U.M; - - if(is_same_type::yes) - { - const Mat& Y = reinterpret_cast&>(X); - - SpMat tmp(Y); - - out.steal_mem(tmp); - } - else - { - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - const uword X_n_elem = X.n_elem; - - const in_eT* X_mem = X.memptr(); - - uword X_nnz = 0; - - for(uword i=0; i < X_n_elem; ++i) { X_nnz += (X_mem[i] != in_eT(0)) ? uword(1) : uword(0); } - - podarray< in_eT> X_nonzeros(X_nnz); - podarray Y_nonzeros(X_nnz); - - for(uword i=0,count=0; i < X_n_elem; ++i) - { - const in_eT X_val = X_mem[i]; - - if(X_val != in_eT(0)) { X_nonzeros[count] = X_val; ++count; } - } - - arrayops::convert_cx( Y_nonzeros.memptr(), X_nonzeros.memptr(), X_nnz ); - - if(X_nnz == 0) - { - out.set_size(X_n_rows, X.n_cols); - } - else - { - SpMat tmp(arma_reserve_indicator(), X_n_rows, X_n_cols, X_nnz); - - uword count = 0; - - for(uword c=0; c < X_n_cols; ++c) - for(uword r=0; r < X_n_rows; ++r) - { - const in_eT X_val = (*X_mem); ++X_mem; - - if(X_val != in_eT(0)) - { - access::rw(tmp.values[count]) = Y_nonzeros[count]; - access::rw(tmp.row_indices[count]) = r; - access::rw(tmp.col_ptrs[c + 1])++; - ++count; - } - } - - // Sum column counts to be column pointers. - for(uword c=1; c <= tmp.n_cols; ++c) - { - access::rw(tmp.col_ptrs[c]) += tmp.col_ptrs[c - 1]; - } - - tmp.remove_zeros(); // in case conversion resulted in an element equal to zero - - out.steal_mem(tmp); - } - } - - return out; - } - - - -//! conversion to Armadillo cubes from Armadillo BaseCube objects -template -class conv_to< Cube > - { - public: - - template - inline static Cube from(const BaseCube& in, const typename arma_not_cx::result* junk = nullptr); - - template - inline static Cube from(const BaseCube& in, const typename arma_cx_only::result* junk = nullptr); - }; - - - -template -template -arma_warn_unused -inline -Cube -conv_to< Cube >::from(const BaseCube& in, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const unwrap_cube tmp( in.get_ref() ); - const Cube& X = tmp.M; - - Cube out(X.n_rows, X.n_cols, X.n_slices, arma_nozeros_indicator()); - - arrayops::convert( out.memptr(), X.memptr(), X.n_elem ); - - return out; - } - - - -template -template -arma_warn_unused -inline -Cube -conv_to< Cube >::from(const BaseCube& in, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const unwrap_cube tmp( in.get_ref() ); - const Cube& X = tmp.M; - - Cube out(X.n_rows, X.n_cols, X.n_slices, arma_nozeros_indicator()); - - arrayops::convert_cx( out.memptr(), X.memptr(), X.n_elem ); - - return out; - } - - - -//! conversion to std::vector from Armadillo Base objects -template -class conv_to< std::vector > - { - public: - - template - inline static std::vector from(const Base& in, const typename arma_not_cx::result* junk = nullptr); - - template - inline static std::vector from(const Base& in, const typename arma_cx_only::result* junk = nullptr); - }; - - - -template -template -arma_warn_unused -inline -std::vector -conv_to< std::vector >::from(const Base& in, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const quasi_unwrap tmp(in.get_ref()); - const Mat& X = tmp.M; - - arma_conform_check( ( (X.is_vec() == false) && (X.is_empty() == false) ), "conv_to(): given object cannot be interpreted as a vector" ); - - const uword N = X.n_elem; - - std::vector out(N); - - if(N > 0) - { - arrayops::convert( &(out[0]), X.memptr(), N ); - } - - return out; - } - - - -template -template -arma_warn_unused -inline -std::vector -conv_to< std::vector >::from(const Base& in, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const quasi_unwrap tmp(in.get_ref()); - const Mat& X = tmp.M; - - arma_conform_check( ( (X.is_vec() == false) && (X.is_empty() == false) ), "conv_to(): given object cannot be interpreted as a vector" ); - - const uword N = X.n_elem; - - std::vector out(N); - - if(N > 0) - { - arrayops::convert_cx( &(out[0]), X.memptr(), N ); - } - - return out; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_cor.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_cor.hpp deleted file mode 100644 index 5b33e4066..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_cor.hpp +++ /dev/null @@ -1,54 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_cor -//! @{ - - - -template -arma_warn_unused -inline -const Op -cor(const Base& X, const uword norm_type = 0) - { - arma_debug_sigprint(); - - arma_conform_check( (norm_type > 1), "cor(): parameter 'norm_type' must be 0 or 1" ); - - return Op(X.get_ref(), norm_type, 0); - } - - - -template -arma_warn_unused -inline -const Glue -cor(const Base& A, const Base& B, const uword norm_type = 0) - { - arma_debug_sigprint(); - - arma_conform_check( (norm_type > 1), "cor(): parameter 'norm_type' must be 0 or 1" ); - - return Glue(A.get_ref(), B.get_ref(), norm_type); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_cov.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_cov.hpp deleted file mode 100644 index c8596bcb8..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_cov.hpp +++ /dev/null @@ -1,54 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_cov -//! @{ - - - -template -arma_warn_unused -inline -const Op -cov(const Base& X, const uword norm_type = 0) - { - arma_debug_sigprint(); - - arma_conform_check( (norm_type > 1), "cov(): parameter 'norm_type' must be 0 or 1" ); - - return Op(X.get_ref(), norm_type, 0); - } - - - -template -arma_warn_unused -inline -const Glue -cov(const Base& A, const Base& B, const uword norm_type = 0) - { - arma_debug_sigprint(); - - arma_conform_check( (norm_type > 1), "cov(): parameter 'norm_type' must be 0 or 1" ); - - return Glue(A.get_ref(), B.get_ref(), norm_type); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_cross.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_cross.hpp deleted file mode 100644 index 4c15b2bdb..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_cross.hpp +++ /dev/null @@ -1,43 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_cross -//! @{ - - - -//! cross product (only valid for 3 dimensional vectors) -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && is_arma_type::value && is_same_type::value, - const Glue - >::result -cross(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - return Glue(X, Y); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_cumprod.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_cumprod.hpp deleted file mode 100644 index adbcbadff..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_cumprod.hpp +++ /dev/null @@ -1,89 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_cumprod -//! @{ - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::yes, - const Op - >::result -cumprod(const T1& X) - { - arma_debug_sigprint(); - - return Op(X); - } - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::no, - const Op - >::result -cumprod(const T1& X) - { - arma_debug_sigprint(); - - return Op(X, 0, 0); - } - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value, - const Op - >::result -cumprod(const T1& X, const uword dim) - { - arma_debug_sigprint(); - - return Op(X, dim, 0); - } - - - -template -arma_warn_unused -arma_inline -typename arma_scalar_only::result -cumprod(const T& x) - { - return x; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_cumsum.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_cumsum.hpp deleted file mode 100644 index 8c8253382..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_cumsum.hpp +++ /dev/null @@ -1,89 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_cumsum -//! @{ - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::yes, - const Op - >::result -cumsum(const T1& X) - { - arma_debug_sigprint(); - - return Op(X); - } - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::no, - const Op - >::result -cumsum(const T1& X) - { - arma_debug_sigprint(); - - return Op(X, 0, 0); - } - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value, - const Op - >::result -cumsum(const T1& X, const uword dim) - { - arma_debug_sigprint(); - - return Op(X, dim, 0); - } - - - -template -arma_warn_unused -arma_inline -typename arma_scalar_only::result -cumsum(const T& x) - { - return x; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_det.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_det.hpp deleted file mode 100644 index 244bdf811..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_det.hpp +++ /dev/null @@ -1,82 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_det -//! @{ - - - -template -arma_warn_unused -inline -typename enable_if2< is_supported_blas_type::value, typename T1::elem_type >::result -det(const Base& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - eT out_val = eT(0); - - const bool status = op_det::apply_direct(out_val, X.get_ref()); - - if(status == false) - { - out_val = eT(0); - arma_stop_runtime_error("det(): failed to find determinant"); - } - - return out_val; - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -det(typename T1::elem_type& out_val, const Base& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const bool status = op_det::apply_direct(out_val, X.get_ref()); - - if(status == false) - { - out_val = eT(0); - arma_warn(3, "det(): failed to find determinant"); - } - - return status; - } - - - -template -arma_warn_unused -arma_inline -typename arma_scalar_only::result -det(const T& x) - { - return x; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_diagmat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_diagmat.hpp deleted file mode 100644 index 1d8ce09bb..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_diagmat.hpp +++ /dev/null @@ -1,93 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_diagmat -//! @{ - - -//! interpret a matrix or a vector as a diagonal matrix (ie. off-diagonal entries are zero) -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value, - const Op - >::result -diagmat(const T1& X) - { - arma_debug_sigprint(); - - return Op(X); - } - - - -//! create a matrix with the k-th diagonal set to the given vector -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value, - const Op - >::result -diagmat(const T1& X, const sword k) - { - arma_debug_sigprint(); - - const uword row_offset = (k < 0) ? uword(-k) : uword(0); - const uword col_offset = (k > 0) ? uword( k) : uword(0); - - return Op(X, row_offset, col_offset); - } - - - -template -arma_warn_unused -inline -const SpOp -diagmat(const SpBase& X) - { - arma_debug_sigprint(); - - return SpOp(X.get_ref()); - } - - - -template -arma_warn_unused -inline -const SpOp -diagmat(const SpBase& X, const sword k) - { - arma_debug_sigprint(); - - const uword row_offset = (k < 0) ? uword(-k) : uword(0); - const uword col_offset = (k > 0) ? uword( k) : uword(0); - - return SpOp(X.get_ref(), row_offset, col_offset); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_diags_spdiags.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_diags_spdiags.hpp deleted file mode 100644 index 36b94e855..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_diags_spdiags.hpp +++ /dev/null @@ -1,134 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_diags_spdiags -//! @{ - - - -template -inline -Mat -diags(const Base& V_expr, const Base& D_expr, const uword n_rows, const uword n_cols) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap UV(V_expr.get_ref()); - const Mat& V = UV.M; - - const quasi_unwrap UD(D_expr.get_ref()); - const Mat& D = UD.M; - - arma_conform_check( ((D.is_vec() == false) && (D.is_empty() == false)), "D must be a vector" ); - - arma_conform_check( (V.n_cols != D.n_elem), "number of colums in matrix V must match the length of vector D" ); - - Mat out(n_rows, n_cols, fill::zeros); - - for(uword i=0; i < D.n_elem; ++i) - { - const sword diag_id = D[i]; - - const uword row_offset = (diag_id < 0) ? uword(-diag_id) : 0; - const uword col_offset = (diag_id > 0) ? uword( diag_id) : 0; - - arma_conform_check_bounds - ( - ((row_offset > 0) && (row_offset >= n_rows)) || ((col_offset > 0) && (col_offset >= n_cols)), - "diags(): requested diagonal out of bounds" - ); - - const uword diag_len = (std::min)(n_rows - row_offset, n_cols - col_offset); - - const uword V_start = (diag_id < 0) ? uword(0) : uword(diag_id); - - const eT* V_colmem = V.colptr(i); - - for(uword j=0; j < diag_len; ++j) - { - const uword V_index = V_start + j; - - if(V_index >= V.n_rows) { break; } - - out.at(j + row_offset, j + col_offset) = V_colmem[V_index]; - } - } - - return out; - } - - - -template -inline -SpMat -spdiags(const Base& V_expr, const Base& D_expr, const uword n_rows, const uword n_cols) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap UV(V_expr.get_ref()); - const Mat& V = UV.M; - - const quasi_unwrap UD(D_expr.get_ref()); - const Mat& D = UD.M; - - arma_conform_check( ((D.is_vec() == false) && (D.is_empty() == false)), "D must be a vector" ); - - arma_conform_check( (V.n_cols != D.n_elem), "number of colums in matrix V must match the length of vector D" ); - - MapMat tmp(n_rows, n_cols); - - for(uword i=0; i < D.n_elem; ++i) - { - const sword diag_id = D[i]; - - const uword row_offset = (diag_id < 0) ? uword(-diag_id) : 0; - const uword col_offset = (diag_id > 0) ? uword( diag_id) : 0; - - arma_conform_check_bounds - ( - ((row_offset > 0) && (row_offset >= n_rows)) || ((col_offset > 0) && (col_offset >= n_cols)), - "diags(): requested diagonal out of bounds" - ); - - const uword diag_len = (std::min)(n_rows - row_offset, n_cols - col_offset); - - const uword V_start = (diag_id < 0) ? uword(0) : uword(diag_id); - - const eT* V_colmem = V.colptr(i); - - for(uword j=0; j < diag_len; ++j) - { - const uword V_index = V_start + j; - - if(V_index >= V.n_rows) { break; } - - tmp.at(j + row_offset, j + col_offset) = V_colmem[V_index]; - } - } - - return SpMat(tmp); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_diagvec.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_diagvec.hpp deleted file mode 100644 index 3665a09d7..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_diagvec.hpp +++ /dev/null @@ -1,64 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_diagvec -//! @{ - - -//! extract main diagonal from matrix -template -arma_warn_unused -arma_inline -const Op -diagvec(const Base& X) - { - arma_debug_sigprint(); - - return Op(X.get_ref()); - } - - - -//! extract arbitrary diagonal from matrix -template -arma_warn_unused -arma_inline -const Op -diagvec(const Base& X, const sword diag_id) - { - arma_debug_sigprint(); - - return Op(X.get_ref(), ((diag_id < 0) ? -diag_id : diag_id), ((diag_id < 0) ? 1 : 0) ); - } - - - -template -arma_warn_unused -arma_inline -const mtSpReduceOp -diagvec(const SpBase& X, const sword diag_id = 0) - { - arma_debug_sigprint(); - - return mtSpReduceOp(X.get_ref(), ((diag_id < 0) ? -diag_id : diag_id), ((diag_id < 0) ? 1 : 0) ); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_diff.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_diff.hpp deleted file mode 100644 index 9c5383638..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_diff.hpp +++ /dev/null @@ -1,91 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_diff -//! @{ - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::yes, - const Op - >::result -diff - ( - const T1& X, - const uword k = 1 - ) - { - arma_debug_sigprint(); - - return Op(X, k, 0); - } - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::no, - const Op - >::result -diff - ( - const T1& X, - const uword k = 1 - ) - { - arma_debug_sigprint(); - - return Op(X, k, 0); - } - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value, - const Op - >::result -diff - ( - const T1& X, - const uword k, - const uword dim - ) - { - arma_debug_sigprint(); - - return Op(X, k, dim); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_dot.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_dot.hpp deleted file mode 100644 index a9c26ca5b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_dot.hpp +++ /dev/null @@ -1,360 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_dot -//! @{ - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && is_arma_type::value && is_same_type::yes, - typename T1::elem_type - >::result -dot - ( - const T1& A, - const T2& B - ) - { - arma_debug_sigprint(); - - return op_dot::apply(A,B); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && is_arma_type::value && is_same_type::no, - typename promote_type::result - >::result -dot - ( - const T1& A, - const T2& B - ) - { - arma_debug_sigprint(); - - return op_dot_mixed::apply(A,B); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && is_arma_type::value && is_same_type::value, - typename T1::elem_type - >::result -norm_dot - ( - const T1& A, - const T2& B - ) - { - arma_debug_sigprint(); - - return op_norm_dot::apply(A,B); - } - - - -// -// cdot - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && is_arma_type::value && is_same_type::value && is_cx::no, - typename T1::elem_type - >::result -cdot - ( - const T1& A, - const T2& B - ) - { - arma_debug_sigprint(); - - return op_dot::apply(A,B); - } - - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && is_arma_type::value && is_same_type::value && is_cx::yes, - typename T1::elem_type - >::result -cdot - ( - const T1& A, - const T2& B - ) - { - arma_debug_sigprint(); - - return op_cdot::apply(A,B); - } - - - -// convert dot(htrans(x), y) to cdot(x,y) - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && is_same_type::value && is_cx::yes, - typename T1::elem_type - >::result -dot - ( - const Op& A, - const T2& B - ) - { - arma_debug_sigprint(); - - return cdot(A.m, B); - } - - - -// -// for sparse matrices -// - - - -namespace priv - { - - template - arma_hot - inline - typename T1::elem_type - dot_helper(const SpProxy& pa, const SpProxy& pb) - { - typedef typename T1::elem_type eT; - - // Iterate over both objects and see when they are the same - eT result = eT(0); - - typename SpProxy::const_iterator_type a_it = pa.begin(); - typename SpProxy::const_iterator_type a_end = pa.end(); - - typename SpProxy::const_iterator_type b_it = pb.begin(); - typename SpProxy::const_iterator_type b_end = pb.end(); - - while((a_it != a_end) && (b_it != b_end)) - { - if(a_it == b_it) - { - result += (*a_it) * (*b_it); - - ++a_it; - ++b_it; - } - else if((a_it.col() < b_it.col()) || ((a_it.col() == b_it.col()) && (a_it.row() < b_it.row()))) - { - // a_it is "behind" - ++a_it; - } - else - { - // b_it is "behind" - ++b_it; - } - } - - return result; - } - - } - - - -//! dot product of two sparse objects -template -arma_warn_unused -arma_hot -inline -typename -enable_if2 - <(is_arma_sparse_type::value) && (is_arma_sparse_type::value) && (is_same_type::value), - typename T1::elem_type - >::result -dot - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - const SpProxy pa(x); - const SpProxy pb(y); - - arma_conform_assert_same_size(pa.get_n_rows(), pa.get_n_cols(), pb.get_n_rows(), pb.get_n_cols(), "dot()"); - - typedef typename T1::elem_type eT; - - typedef typename SpProxy::stored_type pa_Q_type; - typedef typename SpProxy::stored_type pb_Q_type; - - if( - ( (SpProxy::use_iterator == false) && (SpProxy::use_iterator == false) ) - && ( (is_SpMat::value == true ) && (is_SpMat::value == true ) ) - ) - { - const unwrap_spmat tmp_a(pa.Q); - const unwrap_spmat tmp_b(pb.Q); - - const SpMat& A = tmp_a.M; - const SpMat& B = tmp_b.M; - - if( &A == &B ) - { - // We can do it directly! - return op_dot::direct_dot_arma(A.n_nonzero, A.values, A.values); - } - else - { - return priv::dot_helper(pa,pb); - } - } - else - { - return priv::dot_helper(pa,pb); - } - } - - - -//! dot product of one dense and one sparse object -template -arma_warn_unused -arma_hot -inline -typename -enable_if2 - <(is_arma_type::value) && (is_arma_sparse_type::value) && (is_same_type::value), - typename T1::elem_type - >::result -dot - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(is_SpSubview_col::value) - { - // TODO: refactor to use C++17 "if constexpr" to avoid reinterpret_cast shenanigans - - const SpSubview_col& yy = reinterpret_cast< const SpSubview_col& >(y); - - if(yy.n_rows == yy.m.n_rows) - { - arma_debug_print("using sparse column vector specialisation"); - - const quasi_unwrap U(x); - - arma_conform_assert_same_size(U.M.n_elem, uword(1), yy.n_elem, uword(1), "dot()"); - - yy.m.sync(); - - return dense_sparse_helper::dot(U.M.memptr(), yy.m, yy.aux_col1); - } - } - - const Proxy pa(x); - const SpProxy pb(y); - - arma_conform_assert_same_size(pa.get_n_rows(), pa.get_n_cols(), pb.get_n_rows(), pb.get_n_cols(), "dot()"); - - eT result = eT(0); - - typename SpProxy::const_iterator_type it = pb.begin(); - typename SpProxy::const_iterator_type it_end = pb.end(); - - // use_at == false won't save us operations - while(it != it_end) - { - result += (*it) * pa.at(it.row(), it.col()); - ++it; - } - - return result; - } - - - -//! dot product of one sparse and one dense object -template -arma_warn_unused -arma_hot -inline -typename -enable_if2 - <(is_arma_sparse_type::value) && (is_arma_type::value) && (is_same_type::value), - typename T1::elem_type - >::result -dot - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - // this is commutative - return dot(y, x); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_eig_gen.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_eig_gen.hpp deleted file mode 100644 index 06a1d4a08..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_eig_gen.hpp +++ /dev/null @@ -1,170 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_eig_gen -//! @{ - - -template -arma_warn_unused -inline -typename enable_if2< is_supported_blas_type::value, Col< std::complex > >::result -eig_gen - ( - const Base& expr, - const char* option = "nobalance" - ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - typedef typename std::complex eT; - - const char sig = (option != nullptr) ? option[0] : char(0); - - arma_conform_check( ((sig != 'n') && (sig != 'b')), "eig_gen(): unknown option" ); - - if( auxlib::crippled_lapack(expr) && (sig == 'b') ) { arma_warn(1, "eig_gen(): 'balance' option ignored due to linking with crippled lapack"); } - - Col eigvals; - Mat eigvecs; - - const bool status = (sig == 'b') ? auxlib::eig_gen_balance(eigvals, eigvecs, false, expr.get_ref()) : auxlib::eig_gen(eigvals, eigvecs, false, expr.get_ref()); - - if(status == false) - { - eigvals.soft_reset(); - arma_stop_runtime_error("eig_gen(): decomposition failed"); - } - - return eigvals; - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -eig_gen - ( - Col< std::complex >& eigvals, - const Base< typename T1::elem_type, T1>& expr, - const char* option = "nobalance" - ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - typedef typename std::complex eT; - - const char sig = (option != nullptr) ? option[0] : char(0); - - arma_conform_check( ((sig != 'n') && (sig != 'b')), "eig_gen(): unknown option" ); - - if( auxlib::crippled_lapack(expr) && (sig == 'b') ) { arma_warn(1, "eig_gen(): 'balance' option ignored due to linking with crippled lapack"); } - - Mat eigvecs; - - const bool status = (sig == 'b') ? auxlib::eig_gen_balance(eigvals, eigvecs, false, expr.get_ref()) : auxlib::eig_gen(eigvals, eigvecs, false, expr.get_ref()); - - if(status == false) - { - eigvals.soft_reset(); - arma_warn(3, "eig_gen(): decomposition failed"); - } - - return status; - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -eig_gen - ( - Col< std::complex >& eigvals, - Mat< std::complex >& eigvecs, - const Base& expr, - const char* option = "nobalance" - ) - { - arma_debug_sigprint(); - - arma_conform_check( (void_ptr(&eigvals) == void_ptr(&eigvecs)), "eig_gen(): parameter 'eigval' is an alias of parameter 'eigvec'" ); - - const char sig = (option != nullptr) ? option[0] : char(0); - - arma_conform_check( ((sig != 'n') && (sig != 'b')), "eig_gen(): unknown option" ); - - if( auxlib::crippled_lapack(expr) && (sig == 'b') ) { arma_warn(1, "eig_gen(): 'balance' option ignored due to linking with crippled lapack"); } - - const bool status = (sig == 'b') ? auxlib::eig_gen_balance(eigvals, eigvecs, true, expr.get_ref()) : auxlib::eig_gen(eigvals, eigvecs, true, expr.get_ref()); - - if(status == false) - { - eigvals.soft_reset(); - eigvecs.soft_reset(); - arma_warn(3, "eig_gen(): decomposition failed"); - } - - return status; - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -eig_gen - ( - Col< std::complex >& eigvals, - Mat< std::complex >& leigvecs, - Mat< std::complex >& reigvecs, - const Base& expr, - const char* option = "nobalance" - ) - { - arma_debug_sigprint(); - - arma_conform_check( (void_ptr(&eigvals) == void_ptr(&leigvecs)), "eig_gen(): parameter 'eigval' is an alias of parameter 'leigvec'" ); - arma_conform_check( (void_ptr(&eigvals) == void_ptr(&reigvecs)), "eig_gen(): parameter 'eigval' is an alias of parameter 'reigvec'" ); - arma_conform_check( (void_ptr(&leigvecs) == void_ptr(&reigvecs)), "eig_gen(): parameter 'leigvec' is an alias of parameter 'reigvec'" ); - - const char sig = (option != nullptr) ? option[0] : char(0); - - arma_conform_check( ((sig != 'n') && (sig != 'b')), "eig_gen(): unknown option" ); - - if( auxlib::crippled_lapack(expr) && (sig == 'b') ) { arma_warn(1, "eig_gen(): 'balance' option ignored due to linking with crippled lapack"); } - - const bool status = (sig == 'b') ? auxlib::eig_gen_twosided_balance(eigvals, leigvecs, reigvecs, expr.get_ref()) : auxlib::eig_gen_twosided(eigvals, leigvecs, reigvecs, expr.get_ref()); - - if(status == false) - { - eigvals.soft_reset(); - leigvecs.soft_reset(); - reigvecs.soft_reset(); - arma_warn(3, "eig_gen(): decomposition failed"); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_eig_pair.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_eig_pair.hpp deleted file mode 100644 index d641a01c1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_eig_pair.hpp +++ /dev/null @@ -1,144 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_eig_pair -//! @{ - - -template -arma_warn_unused -inline -typename enable_if2< is_supported_blas_type::value, Col< std::complex > >::result -eig_pair - ( - const Base& A_expr, - const Base& B_expr - ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - Col< std::complex > eigvals; - Mat< std::complex > eigvecs; - - const bool status = auxlib::eig_pair(eigvals, eigvecs, false, A_expr.get_ref(), B_expr.get_ref()); - - if(status == false) - { - eigvals.soft_reset(); - arma_stop_runtime_error("eig_pair(): decomposition failed"); - } - - return eigvals; - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -eig_pair - ( - Col< std::complex >& eigvals, - const Base< typename T1::elem_type, T1 >& A_expr, - const Base< typename T1::elem_type, T2 >& B_expr - ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - Mat< std::complex > eigvecs; - - const bool status = auxlib::eig_pair(eigvals, eigvecs, false, A_expr.get_ref(), B_expr.get_ref()); - - if(status == false) - { - eigvals.soft_reset(); - arma_warn(3, "eig_pair(): decomposition failed"); - } - - return status; - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -eig_pair - ( - Col< std::complex >& eigvals, - Mat< std::complex >& eigvecs, - const Base< typename T1::elem_type, T1 >& A_expr, - const Base< typename T1::elem_type, T2 >& B_expr - ) - { - arma_debug_sigprint(); - - arma_conform_check( (void_ptr(&eigvals) == void_ptr(&eigvecs)), "eig_pair(): parameter 'eigval' is an alias of parameter 'eigvec'" ); - - const bool status = auxlib::eig_pair(eigvals, eigvecs, true, A_expr.get_ref(), B_expr.get_ref()); - - if(status == false) - { - eigvals.soft_reset(); - eigvecs.soft_reset(); - arma_warn(3, "eig_pair(): decomposition failed"); - } - - return status; - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -eig_pair - ( - Col< std::complex >& eigvals, - Mat< std::complex >& leigvecs, - Mat< std::complex >& reigvecs, - const Base< typename T1::elem_type, T1 >& A_expr, - const Base< typename T1::elem_type, T2 >& B_expr - ) - { - arma_debug_sigprint(); - - arma_conform_check( (void_ptr(&eigvals) == void_ptr(&leigvecs)), "eig_pair(): parameter 'eigval' is an alias of parameter 'leigvec'" ); - arma_conform_check( (void_ptr(&eigvals) == void_ptr(&reigvecs)), "eig_pair(): parameter 'eigval' is an alias of parameter 'reigvec'" ); - arma_conform_check( (void_ptr(&leigvecs) == void_ptr(&reigvecs)), "eig_pair(): parameter 'leigvec' is an alias of parameter 'reigvec'" ); - - const bool status = auxlib::eig_pair_twosided(eigvals, leigvecs, reigvecs, A_expr.get_ref(), B_expr.get_ref()); - - if(status == false) - { - eigvals.soft_reset(); - leigvecs.soft_reset(); - reigvecs.soft_reset(); - arma_warn(3, "eig_pair(): decomposition failed"); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_eig_sym.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_eig_sym.hpp deleted file mode 100644 index 6e5370f6c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_eig_sym.hpp +++ /dev/null @@ -1,161 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_eig_sym -//! @{ - - -//! Eigenvalues of real/complex symmetric/hermitian matrix X -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -eig_sym - ( - Col& eigval, - const Base& X - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - Mat A(X.get_ref()); - - const bool status = auxlib::eig_sym(eigval, A); - - if(status == false) - { - eigval.soft_reset(); - arma_warn(3, "eig_sym(): decomposition failed"); - } - - return status; - } - - - -//! Eigenvalues of real/complex symmetric/hermitian matrix X -template -arma_warn_unused -inline -typename enable_if2< is_supported_blas_type::value, Col >::result -eig_sym - ( - const Base& X - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - Col< T> eigval; - Mat A(X.get_ref()); - - const bool status = auxlib::eig_sym(eigval, A); - - if(status == false) - { - eigval.reset(); - arma_stop_runtime_error("eig_sym(): decomposition failed"); - } - - return eigval; - } - - - -//! internal helper function -template -inline -bool -eig_sym_helper - ( - Col::result>& eigval, - Mat& eigvec, - const Mat& X, - const char method_sig, - const char* caller_sig - ) - { - arma_debug_sigprint(); - - if((arma_config::check_conform) && (auxlib::rudimentary_sym_check(X) == false)) - { - if(is_cx::no ) { arma_warn(1, caller_sig, ": given matrix is not symmetric"); } - if(is_cx::yes) { arma_warn(1, caller_sig, ": given matrix is not hermitian"); } - } - - bool status = false; - - if(method_sig == 'd') { status = auxlib::eig_sym_dc(eigval, eigvec, X); } - - if(status == false) { status = auxlib::eig_sym(eigval, eigvec, X); } - - return status; - } - - - -//! Eigenvalues and eigenvectors of real/complex symmetric/hermitian matrix X -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -eig_sym - ( - Col& eigval, - Mat& eigvec, - const Base& expr, - const char* method = "dc" - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const char sig = (method != nullptr) ? method[0] : char(0); - - arma_conform_check( ((sig != 's') && (sig != 'd')), "eig_sym(): unknown method specified" ); - arma_conform_check( void_ptr(&eigval) == void_ptr(&eigvec), "eig_sym(): parameter 'eigval' is an alias of parameter 'eigvec'" ); - - const quasi_unwrap U(expr.get_ref()); - - const bool is_alias = U.is_alias(eigvec); - - Mat eigvec_tmp; - Mat& eigvec_out = (is_alias == false) ? eigvec : eigvec_tmp; - - const bool status = eig_sym_helper(eigval, eigvec_out, U.M, sig, "eig_sym()"); - - if(status == false) - { - eigval.soft_reset(); - eigvec.soft_reset(); - arma_warn(3, "eig_sym(): decomposition failed"); - } - else - { - if(is_alias) { eigvec.steal_mem(eigvec_tmp); } - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_eigs_gen.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_eigs_gen.hpp deleted file mode 100644 index 685dcaa93..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_eigs_gen.hpp +++ /dev/null @@ -1,425 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_eigs_gen -//! @{ - - -//! eigenvalues of general sparse matrix X -template -arma_warn_unused -inline -typename enable_if2< is_real::value, Col< std::complex > >::result -eigs_gen - ( - const SpBase& X, - const uword n_eigvals, - const char* form = "lm", - const eigs_opts opts = eigs_opts() - ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - Mat< std::complex > eigvec; - Col< std::complex > eigval; - - sp_auxlib::form_type form_val = sp_auxlib::interpret_form_str(form); - - const bool status = sp_auxlib::eigs_gen(eigval, eigvec, X, n_eigvals, form_val, opts); - - if(status == false) - { - eigval.soft_reset(); - arma_stop_runtime_error("eigs_gen(): decomposition failed"); - } - - return eigval; - } - - - -//! this form is deprecated; use eigs_gen(X, n_eigvals, form, opts) instead -template -arma_deprecated -inline -typename enable_if2< is_real::value, Col< std::complex > >::result -eigs_gen - ( - const SpBase& X, - const uword n_eigvals, - const char* form, - const typename T1::pod_type tol - ) - { - arma_debug_sigprint(); - - eigs_opts opts; - opts.tol = tol; - - return eigs_gen(X, n_eigvals, form, opts); - } - - - -template -arma_warn_unused -inline -typename enable_if2< is_real::value, Col< std::complex > >::result -eigs_gen - ( - const SpBase& X, - const uword n_eigvals, - const std::complex sigma, - const eigs_opts opts = eigs_opts() - ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - Mat< std::complex > eigvec; - Col< std::complex > eigval; - - bool status = false; - - // If X is real and sigma is truly complex, treat X as complex. - // The reason is that we are still not able to apply truly complex shifts to real matrices - if( (is_real::yes) && (std::imag(sigma) != T(0)) ) - { - status = sp_auxlib::eigs_gen(eigval, eigvec, conv_to< SpMat< std::complex > >::from(X), n_eigvals, sigma, opts); - } - else - { - status = sp_auxlib::eigs_gen(eigval, eigvec, X, n_eigvals, sigma, opts); - } - - if(status == false) - { - eigval.soft_reset(); - arma_stop_runtime_error("eigs_gen(): decomposition failed"); - } - - return eigval; - } - - - -template -arma_warn_unused -inline -typename enable_if2< is_real::value, Col< std::complex > >::result -eigs_gen - ( - const SpBase& X, - const uword n_eigvals, - const double sigma, - const eigs_opts opts = eigs_opts() - ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - Mat< std::complex > eigvec; - Col< std::complex > eigval; - - const bool status = sp_auxlib::eigs_gen(eigval, eigvec, X, n_eigvals, std::complex(T(sigma)), opts); - - if(status == false) - { - eigval.soft_reset(); - arma_stop_runtime_error("eigs_gen(): decomposition failed"); - } - - return eigval; - } - - - -//! eigenvalues of general sparse matrix X -template -inline -typename enable_if2< is_real::value, bool >::result -eigs_gen - ( - Col< std::complex >& eigval, - const SpBase& X, - const uword n_eigvals, - const char* form = "lm", - const eigs_opts opts = eigs_opts() - ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - Mat< std::complex > eigvec; - - sp_auxlib::form_type form_val = sp_auxlib::interpret_form_str(form); - - const bool status = sp_auxlib::eigs_gen(eigval, eigvec, X, n_eigvals, form_val, opts); - - if(status == false) - { - eigval.soft_reset(); - arma_warn(3, "eigs_gen(): decomposition failed"); - } - - return status; - } - - - -//! this form is deprecated; use eigs_gen(eigval, X, n_eigvals, form, opts) instead -template -arma_deprecated -inline -typename enable_if2< is_real::value, bool >::result -eigs_gen - ( - Col< std::complex >& eigval, - const SpBase& X, - const uword n_eigvals, - const char* form, - const typename T1::pod_type tol - ) - { - arma_debug_sigprint(); - - eigs_opts opts; - opts.tol = tol; - - return eigs_gen(eigval, X, n_eigvals, form, opts); - } - - - -template -inline -typename enable_if2< is_real::value, bool >::result -eigs_gen - ( - Col< std::complex >& eigval, - const SpBase& X, - const uword n_eigvals, - const std::complex sigma, - const eigs_opts opts = eigs_opts() - ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - Mat< std::complex > eigvec; - - bool status = false; - - // If X is real and sigma is truly complex, treat X as complex. - // The reason is that we are still not able to apply truly complex shifts to real matrices - if( (is_real::yes) && (std::imag(sigma) != T(0)) ) - { - status = sp_auxlib::eigs_gen(eigval, eigvec, conv_to< SpMat< std::complex > >::from(X), n_eigvals, sigma, opts); - } - else - { - status = sp_auxlib::eigs_gen(eigval, eigvec, X, n_eigvals, sigma, opts); - } - - if(status == false) - { - eigval.soft_reset(); - arma_warn(3, "eigs_gen(): decomposition failed"); - } - - return status; - } - - - -template -inline -typename enable_if2< is_real::value, bool >::result -eigs_gen - ( - Col< std::complex >& eigval, - const SpBase& X, - const uword n_eigvals, - const double sigma, - const eigs_opts opts = eigs_opts() - ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - Mat< std::complex > eigvec; - - const bool status = sp_auxlib::eigs_gen(eigval, eigvec, X, n_eigvals, std::complex(T(sigma)), opts); - - if(status == false) - { - eigval.soft_reset(); - arma_warn(3, "eigs_gen(): decomposition failed"); - } - - return status; - } - - - -//! eigenvalues and eigenvectors of general sparse matrix X -template -inline -typename enable_if2< is_real::value, bool >::result -eigs_gen - ( - Col< std::complex >& eigval, - Mat< std::complex >& eigvec, - const SpBase& X, - const uword n_eigvals, - const char* form = "lm", - const eigs_opts opts = eigs_opts() - ) - { - arma_debug_sigprint(); - - // typedef typename T1::pod_type T; - - arma_conform_check( void_ptr(&eigval) == void_ptr(&eigvec), "eigs_gen(): parameter 'eigval' is an alias of parameter 'eigvec'" ); - - sp_auxlib::form_type form_val = sp_auxlib::interpret_form_str(form); - - const bool status = sp_auxlib::eigs_gen(eigval, eigvec, X, n_eigvals, form_val, opts); - - if(status == false) - { - eigval.soft_reset(); - eigvec.soft_reset(); - arma_warn(3, "eigs_gen(): decomposition failed"); - } - - return status; - } - - - -//! this form is deprecated; use eigs_gen(eigval, eigvec, X, n_eigvals, form, opts) instead -template -arma_deprecated -inline -typename enable_if2< is_real::value, bool >::result -eigs_gen - ( - Col< std::complex >& eigval, - Mat< std::complex >& eigvec, - const SpBase& X, - const uword n_eigvals, - const char* form, - const typename T1::pod_type tol - ) - { - arma_debug_sigprint(); - - eigs_opts opts; - opts.tol = tol; - - return eigs_gen(eigval, eigvec, X, n_eigvals, form, opts); - } - - - -template -inline -typename enable_if2< is_real::value, bool >::result -eigs_gen - ( - Col< std::complex >& eigval, - Mat< std::complex >& eigvec, - const SpBase& X, - const uword n_eigvals, - const std::complex sigma, - const eigs_opts opts = eigs_opts() - ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - arma_conform_check( void_ptr(&eigval) == void_ptr(&eigvec), "eigs_gen(): parameter 'eigval' is an alias of parameter 'eigvec'" ); - - bool status = false; - - // If X is real and sigma is truly complex, treat X as complex. - // The reason is that we are still not able to apply truly complex shifts to real matrices - if( (is_real::yes) && (std::imag(sigma) != T(0)) ) - { - status = sp_auxlib::eigs_gen(eigval, eigvec, conv_to< SpMat< std::complex > >::from(X), n_eigvals, sigma, opts); - } - else - { - status = sp_auxlib::eigs_gen(eigval, eigvec, X, n_eigvals, sigma, opts); - } - - if(status == false) - { - eigval.soft_reset(); - eigvec.soft_reset(); - arma_warn(3, "eigs_gen(): decomposition failed"); - } - - return status; - } - - - -template -inline -typename enable_if2< is_real::value, bool >::result -eigs_gen - ( - Col< std::complex >& eigval, - Mat< std::complex >& eigvec, - const SpBase& X, - const uword n_eigvals, - const double sigma, - const eigs_opts opts = eigs_opts() - ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - arma_conform_check( void_ptr(&eigval) == void_ptr(&eigvec), "eigs_gen(): parameter 'eigval' is an alias of parameter 'eigvec'" ); - - const bool status = sp_auxlib::eigs_gen(eigval, eigvec, X, n_eigvals, std::complex(T(sigma)), opts); - - if(status == false) - { - eigval.soft_reset(); - eigvec.soft_reset(); - arma_warn(3, "eigs_gen(): decomposition failed"); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_eigs_sym.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_eigs_sym.hpp deleted file mode 100644 index 0503f4fb0..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_eigs_sym.hpp +++ /dev/null @@ -1,290 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_eigs_sym -//! @{ - - -//! eigenvalues of symmetric real sparse matrix X -template -arma_warn_unused -inline -typename enable_if2< is_real::value, Col >::result -eigs_sym - ( - const SpBase& X, - const uword n_eigvals, - const char* form = "lm", - const eigs_opts opts = eigs_opts() - ) - { - arma_debug_sigprint(); - - Mat eigvec; - Col eigval; - - sp_auxlib::form_type form_val = sp_auxlib::interpret_form_str(form); - - const bool status = sp_auxlib::eigs_sym(eigval, eigvec, X, n_eigvals, form_val, opts); - - if(status == false) - { - eigval.soft_reset(); - arma_stop_runtime_error("eigs_sym(): decomposition failed"); - } - - return eigval; - } - - - -//! this form is deprecated; use eigs_sym(X, n_eigvals, form, opts) instead -template -arma_deprecated -inline -typename enable_if2< is_real::value, Col >::result -eigs_sym - ( - const SpBase& X, - const uword n_eigvals, - const char* form, - const typename T1::elem_type tol - ) - { - arma_debug_sigprint(); - - eigs_opts opts; - opts.tol = tol; - - return eigs_sym(X, n_eigvals, form, opts); - } - - - -template -arma_warn_unused -inline -typename enable_if2< is_real::value, Col >::result -eigs_sym - ( - const SpBase& X, - const uword n_eigvals, - const double sigma, - const eigs_opts opts = eigs_opts() - ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - Mat eigvec; - Col eigval; - - const bool status = sp_auxlib::eigs_sym(eigval, eigvec, X, n_eigvals, T(sigma), opts); - - if(status == false) - { - eigval.soft_reset(); - arma_stop_runtime_error("eigs_sym(): decomposition failed"); - } - - return eigval; - } - - - -//! eigenvalues of symmetric real sparse matrix X -template -inline -typename enable_if2< is_real::value, bool >::result -eigs_sym - ( - Col& eigval, - const SpBase& X, - const uword n_eigvals, - const char* form = "lm", - const eigs_opts opts = eigs_opts() - ) - { - arma_debug_sigprint(); - - Mat eigvec; - - sp_auxlib::form_type form_val = sp_auxlib::interpret_form_str(form); - - const bool status = sp_auxlib::eigs_sym(eigval, eigvec, X, n_eigvals, form_val, opts); - - if(status == false) - { - eigval.soft_reset(); - arma_warn(3, "eigs_sym(): decomposition failed"); - } - - return status; - } - - - -//! this form is deprecated; use eigs_sym(eigval, X, n_eigvals, form, opts) instead -template -arma_deprecated -inline -typename enable_if2< is_real::value, bool >::result -eigs_sym - ( - Col& eigval, - const SpBase& X, - const uword n_eigvals, - const char* form, - const typename T1::elem_type tol - ) - { - arma_debug_sigprint(); - - eigs_opts opts; - opts.tol = tol; - - return eigs_sym(eigval, X, n_eigvals, form, opts); - } - - - -template -inline -typename enable_if2< is_real::value, bool >::result -eigs_sym - ( - Col& eigval, - const SpBase& X, - const uword n_eigvals, - const double sigma, - const eigs_opts opts = eigs_opts() - ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - Mat eigvec; - - const bool status = sp_auxlib::eigs_sym(eigval, eigvec, X, n_eigvals, T(sigma), opts); - - if(status == false) - { - eigval.soft_reset(); - arma_warn(3, "eigs_sym(): decomposition failed"); - } - - return status; - } - - - -//! eigenvalues and eigenvectors of symmetric real sparse matrix X -template -inline -typename enable_if2< is_real::value, bool >::result -eigs_sym - ( - Col& eigval, - Mat& eigvec, - const SpBase& X, - const uword n_eigvals, - const char* form = "lm", - const eigs_opts opts = eigs_opts() - ) - { - arma_debug_sigprint(); - - arma_conform_check( void_ptr(&eigval) == void_ptr(&eigvec), "eigs_sym(): parameter 'eigval' is an alias of parameter 'eigvec'" ); - - sp_auxlib::form_type form_val = sp_auxlib::interpret_form_str(form); - - const bool status = sp_auxlib::eigs_sym(eigval, eigvec, X, n_eigvals, form_val, opts); - - if(status == false) - { - eigval.soft_reset(); - eigvec.soft_reset(); - arma_warn(3, "eigs_sym(): decomposition failed"); - } - - return status; - } - - - -//! this form is deprecated; use eigs_sym(eigval, eigvec, X, n_eigvals, form, opts) instead -template -arma_deprecated -inline -typename enable_if2< is_real::value, bool >::result -eigs_sym - ( - Col& eigval, - Mat& eigvec, - const SpBase& X, - const uword n_eigvals, - const char* form, - const typename T1::elem_type tol - ) - { - arma_debug_sigprint(); - - eigs_opts opts; - opts.tol = tol; - - return eigs_sym(eigval, eigvec, X, n_eigvals, form, opts); - } - - - -template -inline -typename enable_if2< is_real::value, bool >::result -eigs_sym - ( - Col& eigval, - Mat& eigvec, - const SpBase& X, - const uword n_eigvals, - const double sigma, - const eigs_opts opts = eigs_opts() - ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - arma_conform_check( void_ptr(&eigval) == void_ptr(&eigvec), "eigs_sym(): parameter 'eigval' is an alias of parameter 'eigvec'" ); - - const bool status = sp_auxlib::eigs_sym(eigval, eigvec, X, n_eigvals, T(sigma), opts); - - if(status == false) - { - eigval.soft_reset(); - eigvec.soft_reset(); - arma_warn(3, "eigs_sym(): decomposition failed"); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_elem.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_elem.hpp deleted file mode 100644 index 0a9649f6f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_elem.hpp +++ /dev/null @@ -1,1209 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_elem -//! @{ - - -// -// real - -template -arma_warn_unused -arma_inline -typename enable_if2< (is_arma_type::value && is_cx::no), const T1& >::result -real(const T1& X) - { - arma_debug_sigprint(); - - return X; - } - - - -template -arma_warn_unused -arma_inline -const T1& -real(const BaseCube& X) - { - arma_debug_sigprint(); - - return X.get_ref(); - } - - - -template -arma_warn_unused -arma_inline -const T1& -real(const SpBase& A) - { - arma_debug_sigprint(); - - return A.get_ref(); - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_arma_type::value && is_cx::yes), const mtOp >::result -real(const T1& X) - { - arma_debug_sigprint(); - - return mtOp( X ); - } - - - -template -arma_warn_unused -inline -const mtOpCube -real(const BaseCube, T1>& X) - { - arma_debug_sigprint(); - - return mtOpCube( X.get_ref() ); - } - - - -template -arma_warn_unused -arma_inline -const mtSpOp -real(const SpBase,T1>& A) - { - arma_debug_sigprint(); - - return mtSpOp(A.get_ref()); - } - - - -// -// imag - -template -arma_warn_unused -inline -const Gen< Mat, gen_zeros > -imag(const Base& X) - { - arma_debug_sigprint(); - - const Proxy A(X.get_ref()); - - return Gen< Mat, gen_zeros>(A.get_n_rows(), A.get_n_cols()); - } - - - -template -arma_warn_unused -inline -const GenCube -imag(const BaseCube& X) - { - arma_debug_sigprint(); - - const ProxyCube A(X.get_ref()); - - return GenCube(A.get_n_rows(), A.get_n_cols(), A.get_n_slices()); - } - - - -template -arma_warn_unused -inline -SpMat -imag(const SpBase& A) - { - arma_debug_sigprint(); - - const SpProxy P(A.get_ref()); - - return SpMat(P.get_n_rows(), P.get_n_cols()); - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_arma_type::value && is_cx::yes), const mtOp >::result -imag(const T1& X) - { - arma_debug_sigprint(); - - return mtOp( X ); - } - - - -template -arma_warn_unused -inline -const mtOpCube -imag(const BaseCube,T1>& X) - { - arma_debug_sigprint(); - - return mtOpCube( X.get_ref() ); - } - - - -template -arma_warn_unused -arma_inline -const mtSpOp -imag(const SpBase,T1>& A) - { - arma_debug_sigprint(); - - return mtSpOp(A.get_ref()); - } - - - -// -// log - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -log(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -log(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// -// log2 - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -log2(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -log2(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// -// log10 - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -log10(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -log10(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// -// log1p - -template -arma_warn_unused -arma_inline -typename enable_if2< (is_arma_type::value && is_cx::no), const eOp >::result -log1p(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_cx::no, const eOpCube >::result -log1p(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// -// exp - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -exp(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -exp(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// exp2 - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -exp2(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -exp2(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// exp10 - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -exp10(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -exp10(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// expm1 - -template -arma_warn_unused -arma_inline -typename enable_if2< (is_arma_type::value && is_cx::no), const eOp >::result -expm1(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_cx::no, const eOpCube >::result -expm1(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// -// abs - - -template -arma_warn_unused -arma_inline -typename enable_if2< (is_arma_type::value && is_cx::no), const eOp >::result -abs(const T1& X) - { - arma_debug_sigprint(); - - return eOp(X); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -abs(const BaseCube& X, const typename arma_not_cx::result* junk = nullptr) - { - arma_debug_sigprint(); - - arma_ignore(junk); - - return eOpCube(X.get_ref()); - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_arma_type::value && is_cx::yes), const mtOp >::result -abs(const T1& X) - { - arma_debug_sigprint(); - - return mtOp(X); - } - - - -template -arma_warn_unused -inline -const mtOpCube -abs(const BaseCube< std::complex,T1>& X, const typename arma_cx_only::result* junk = nullptr) - { - arma_debug_sigprint(); - - arma_ignore(junk); - - return mtOpCube( X.get_ref() ); - } - - - -template -arma_warn_unused -arma_inline -const SpOp -abs(const SpBase& X, const typename arma_not_cx::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return SpOp(X.get_ref()); - } - - - -template -arma_warn_unused -arma_inline -const mtSpOp -abs(const SpBase< std::complex, T1>& X, const typename arma_cx_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return mtSpOp(X.get_ref()); - } - - - -// -// arg - - -template -arma_warn_unused -arma_inline -typename enable_if2< (is_arma_type::value && is_cx::no), const eOp >::result -arg(const T1& X) - { - arma_debug_sigprint(); - - return eOp(X); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -arg(const BaseCube& X, const typename arma_not_cx::result* junk = nullptr) - { - arma_debug_sigprint(); - - arma_ignore(junk); - - return eOpCube(X.get_ref()); - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_arma_type::value && is_cx::yes), const mtOp >::result -arg(const T1& X) - { - arma_debug_sigprint(); - - return mtOp(X); - } - - - -template -arma_warn_unused -inline -const mtOpCube -arg(const BaseCube< std::complex,T1>& X, const typename arma_cx_only::result* junk = nullptr) - { - arma_debug_sigprint(); - - arma_ignore(junk); - - return mtOpCube( X.get_ref() ); - } - - - -template -arma_warn_unused -arma_inline -const SpOp -arg(const SpBase& X, const typename arma_not_cx::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return SpOp(X.get_ref()); - } - - - -template -arma_warn_unused -arma_inline -const mtSpOp -arg(const SpBase< std::complex, T1>& X, const typename arma_cx_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return mtSpOp(X.get_ref()); - } - - - -// -// square - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -square(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -square(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -template -arma_warn_unused -arma_inline -const SpOp -square(const SpBase& A) - { - arma_debug_sigprint(); - - return SpOp(A.get_ref()); - } - - - -// -// sqrt - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -sqrt(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -sqrt(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -template -arma_warn_unused -arma_inline -const SpOp -sqrt(const SpBase& A) - { - arma_debug_sigprint(); - - return SpOp(A.get_ref()); - } - - - -// -// cbrt - -template -arma_warn_unused -arma_inline -typename enable_if2< (is_arma_type::value && is_cx::no), const eOp >::result -cbrt(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_cx::no, const eOpCube >::result -cbrt(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_cx::no, const SpOp >::result -cbrt(const SpBase& A) - { - arma_debug_sigprint(); - - return SpOp(A.get_ref()); - } - - - -// -// conj - -template -arma_warn_unused -arma_inline -const T1& -conj(const Base& A) - { - arma_debug_sigprint(); - - return A.get_ref(); - } - - - -template -arma_warn_unused -arma_inline -const T1& -conj(const BaseCube& A) - { - arma_debug_sigprint(); - - return A.get_ref(); - } - - - -template -arma_warn_unused -arma_inline -const T1& -conj(const SpBase& A) - { - arma_debug_sigprint(); - - return A.get_ref(); - } - - - -template -arma_warn_unused -arma_inline -const eOp -conj(const Base,T1>& A) - { - arma_debug_sigprint(); - - return eOp(A.get_ref()); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -conj(const BaseCube,T1>& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -template -arma_warn_unused -arma_inline -const SpOp -conj(const SpBase,T1>& A) - { - arma_debug_sigprint(); - - return SpOp(A.get_ref()); - } - - - -// pow - -template -arma_warn_unused -arma_inline -const eOp -pow(const Base& A, const typename T1::elem_type exponent) - { - arma_debug_sigprint(); - - return eOp(A.get_ref(), exponent); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -pow(const BaseCube& A, const typename T1::elem_type exponent) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref(), exponent); - } - - - -// pow, specialised handling (non-complex exponent for complex matrices) - -template -arma_warn_unused -arma_inline -const eOp -pow(const Base& A, const typename T1::elem_type::value_type exponent) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - return eOp(A.get_ref(), eT(exponent)); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -pow(const BaseCube& A, const typename T1::elem_type::value_type exponent) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - return eOpCube(A.get_ref(), eT(exponent)); - } - - - -// -// floor - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -floor(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -floor(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -template -arma_warn_unused -arma_inline -const SpOp -floor(const SpBase& X) - { - arma_debug_sigprint(); - - return SpOp(X.get_ref()); - } - - - -// -// ceil - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -ceil(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -ceil(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -template -arma_warn_unused -arma_inline -const SpOp -ceil(const SpBase& X) - { - arma_debug_sigprint(); - - return SpOp(X.get_ref()); - } - - - -// -// round - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -round(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -round(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -template -arma_warn_unused -arma_inline -const SpOp -round(const SpBase& X) - { - arma_debug_sigprint(); - - return SpOp(X.get_ref()); - } - - - -// -// trunc - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -trunc(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -trunc(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -template -arma_warn_unused -arma_inline -const SpOp -trunc(const SpBase& X) - { - arma_debug_sigprint(); - - return SpOp(X.get_ref()); - } - - - -// -// sign - -template -arma_warn_unused -arma_inline -typename arma_scalar_only::result -sign(const eT x) - { - arma_debug_sigprint(); - - return arma_sign(x); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -sign(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -sign(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -template -arma_warn_unused -arma_inline -const SpOp -sign(const SpBase& X) - { - arma_debug_sigprint(); - - return SpOp(X.get_ref()); - } - - - -// -// erf - -template -arma_warn_unused -arma_inline -typename enable_if2< (is_arma_type::value && is_cx::no), const eOp >::result -erf(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_cx::no, const eOpCube >::result -erf(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// -// erfc - -template -arma_warn_unused -arma_inline -typename enable_if2< (is_arma_type::value && is_cx::no), const eOp >::result -erfc(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_cx::no, const eOpCube >::result -erfc(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// -// lgamma - -template -arma_warn_unused -arma_inline -typename enable_if2< (is_arma_type::value && is_cx::no), const eOp >::result -lgamma(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_cx::no, const eOpCube >::result -lgamma(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// -// tgamma - -template -arma_warn_unused -arma_inline -typename enable_if2< (is_arma_type::value && is_cx::no), const eOp >::result -tgamma(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_cx::no, const eOpCube >::result -tgamma(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// the functions below are currently unused; reserved for potential future use - -template void exp_approx(const T1&) { arma_stop_logic_error("unimplemented"); } -template void log_approx(const T1&) { arma_stop_logic_error("unimplemented"); } -template void approx_exp(const T1&) { arma_stop_logic_error("unimplemented"); } -template void approx_log(const T1&) { arma_stop_logic_error("unimplemented"); } - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_eps.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_eps.hpp deleted file mode 100644 index 09bd034b4..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_eps.hpp +++ /dev/null @@ -1,106 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup fn_eps -//! @{ - - - -template -arma_warn_unused -inline -const eOp -eps(const Base& X, const typename arma_not_cx::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return eOp(X.get_ref()); - } - - - -template -arma_warn_unused -inline -Mat< typename T1::pod_type > -eps(const Base< std::complex, T1>& X, const typename arma_cx_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::pod_type T; - typedef typename T1::elem_type eT; - - const unwrap tmp(X.get_ref()); - const Mat& A = tmp.M; - - Mat out(A.n_rows, A.n_cols, arma_nozeros_indicator()); - - T* out_mem = out.memptr(); - const eT* A_mem = A.memptr(); - - const uword n_elem = A.n_elem; - - for(uword i=0; i -arma_warn_unused -arma_inline -typename arma_integral_only::result -eps(const eT& x) - { - arma_ignore(x); - - return eT(0); - } - - - -template -arma_warn_unused -arma_inline -typename arma_real_only::result -eps(const eT& x) - { - return eop_aux::direct_eps(x); - } - - - -template -arma_warn_unused -arma_inline -typename arma_real_only::result -eps(const std::complex& x) - { - return eop_aux::direct_eps(x); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_expmat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_expmat.hpp deleted file mode 100644 index cab6891be..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_expmat.hpp +++ /dev/null @@ -1,103 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_expmat -//! @{ - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_real::value, - const Op - >::result -expmat(const Base& A) - { - arma_debug_sigprint(); - - return Op(A.get_ref()); - } - - - -template -inline -typename -enable_if2 - < - is_real::value, - bool - >::result -expmat(Mat& B, const Base& A) - { - arma_debug_sigprint(); - - const bool status = op_expmat::apply_direct(B, A); - - if(status == false) - { - B.soft_reset(); - arma_warn(3, "expmat(): given matrix appears ill-conditioned"); - } - - return status; - } - - - -// - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_supported_blas_type::value, const Op >::result -expmat_sym(const Base& X) - { - arma_debug_sigprint(); - - return Op(X.get_ref()); - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -expmat_sym(Mat& Y, const Base& X) - { - arma_debug_sigprint(); - - const bool status = op_expmat_sym::apply_direct(Y, X.get_ref()); - - if(status == false) - { - Y.soft_reset(); - arma_warn(3, "expmat_sym(): transformation failed"); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_eye.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_eye.hpp deleted file mode 100644 index 87f9ffef5..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_eye.hpp +++ /dev/null @@ -1,114 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_eye -//! @{ - - - -arma_warn_unused -arma_inline -const Gen -eye(const uword n_rows, const uword n_cols) - { - arma_debug_sigprint(); - - return Gen(n_rows, n_cols); - } - - - -arma_warn_unused -arma_inline -const Gen -eye(const SizeMat& s) - { - arma_debug_sigprint(); - - return Gen(s.n_rows, s.n_cols); - } - - - -template -arma_warn_unused -arma_inline -const Gen -eye(const uword n_rows, const uword n_cols, const typename arma_Mat_Col_Row_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - if(is_Col::value) { arma_conform_check( (n_cols != 1), "eye(): incompatible size" ); } - if(is_Row::value) { arma_conform_check( (n_rows != 1), "eye(): incompatible size" ); } - - return Gen(n_rows, n_cols); - } - - - -template -arma_warn_unused -arma_inline -const Gen -eye(const SizeMat& s, const typename arma_Mat_Col_Row_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return eye(s.n_rows, s.n_cols); - } - - - -template -arma_warn_unused -inline -obj_type -eye(const uword n_rows, const uword n_cols, const typename arma_SpMat_SpCol_SpRow_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - if(is_SpCol::value) { arma_conform_check( (n_cols != 1), "eye(): incompatible size" ); } - if(is_SpRow::value) { arma_conform_check( (n_rows != 1), "eye(): incompatible size" ); } - - obj_type out; - - out.eye(n_rows, n_cols); - - return out; - } - - - -template -arma_warn_unused -inline -obj_type -eye(const SizeMat& s, const typename arma_SpMat_SpCol_SpRow_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return eye(s.n_rows, s.n_cols); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_fft.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_fft.hpp deleted file mode 100644 index 16420f2a2..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_fft.hpp +++ /dev/null @@ -1,136 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_fft -//! @{ - - - -// 1D FFT & 1D IFFT - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_arma_type::value && is_real::value), - const mtOp, T1, op_fft_real> - >::result -fft(const T1& A) - { - arma_debug_sigprint(); - - return mtOp, T1, op_fft_real>(A, uword(0), uword(1)); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_arma_type::value && is_real::value), - const mtOp, T1, op_fft_real> - >::result -fft(const T1& A, const uword N) - { - arma_debug_sigprint(); - - return mtOp, T1, op_fft_real>(A, N, uword(0)); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_arma_type::value && (is_cx_float::yes || is_cx_double::yes)), - const Op - >::result -fft(const T1& A) - { - arma_debug_sigprint(); - - return Op(A, uword(0), uword(1)); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_arma_type::value && (is_cx_float::yes || is_cx_double::yes)), - const Op - >::result -fft(const T1& A, const uword N) - { - arma_debug_sigprint(); - - return Op(A, N, uword(0)); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_arma_type::value && (is_cx_float::yes || is_cx_double::yes)), - const Op - >::result -ifft(const T1& A) - { - arma_debug_sigprint(); - - return Op(A, uword(0), uword(1)); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_arma_type::value && (is_cx_float::yes || is_cx_double::yes)), - const Op - >::result -ifft(const T1& A, const uword N) - { - arma_debug_sigprint(); - - return Op(A, N, uword(0)); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_fft2.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_fft2.hpp deleted file mode 100644 index 1927029db..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_fft2.hpp +++ /dev/null @@ -1,136 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_fft2 -//! @{ - - - -// 2D FFT & 2D IFFT - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value, - Mat< std::complex > - >::result -fft2(const T1& A) - { - arma_debug_sigprint(); - - // not exactly efficient, but "better-than-nothing" implementation - - typedef typename T1::pod_type T; - - Mat< std::complex > B = fft(A); - - // for square matrices, strans() will work out that an inplace transpose can be done, - // hence we can potentially avoid creating a temporary matrix - - B = strans(B); - - return strans( fft(B) ); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value, - Mat< std::complex > - >::result -fft2(const T1& A, const uword n_rows, const uword n_cols) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap tmp(A); - const Mat& B = tmp.M; - - const bool do_resize = (B.n_rows != n_rows) || (B.n_cols != n_cols); - - return (do_resize) ? fft2(resize(B,n_rows,n_cols)) : fft2(B); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_arma_type::value && (is_cx_float::yes || is_cx_double::yes)), - Mat< std::complex > - >::result -ifft2(const T1& A) - { - arma_debug_sigprint(); - - // not exactly efficient, but "better-than-nothing" implementation - - typedef typename T1::pod_type T; - - Mat< std::complex > B = ifft(A); - - // for square matrices, strans() will work out that an inplace transpose can be done, - // hence we can potentially avoid creating a temporary matrix - - B = strans(B); - - return strans( ifft(B) ); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_arma_type::value && (is_cx_float::yes || is_cx_double::yes)), - Mat< std::complex > - >::result -ifft2(const T1& A, const uword n_rows, const uword n_cols) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap tmp(A); - const Mat& B = tmp.M; - - const bool do_resize = (B.n_rows != n_rows) || (B.n_cols != n_cols); - - return (do_resize) ? ifft2(resize(B,n_rows,n_cols)) : ifft2(B); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_find.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_find.hpp deleted file mode 100644 index 5d5d46be9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_find.hpp +++ /dev/null @@ -1,469 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_find -//! @{ - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value, - const mtOp - >::result -find(const T1& X) - { - arma_debug_sigprint(); - - return mtOp(X); - } - - - -template -arma_warn_unused -inline -const mtOp -find(const Base& X, const uword k, const char* direction = "first") - { - arma_debug_sigprint(); - - const char sig = (direction != nullptr) ? direction[0] : char(0); - - arma_conform_check - ( - ( (sig != 'f') && (sig != 'F') && (sig != 'l') && (sig != 'L') ), - "find(): direction must be \"first\" or \"last\"" - ); - - const uword type = ( (sig == 'f') || (sig == 'F') ) ? 0 : 1; - - return mtOp(X.get_ref(), k, type); - } - - - -// - - - -template -arma_warn_unused -inline -uvec -find(const BaseCube& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_cube tmp(X.get_ref()); - - const Mat R( const_cast< eT* >(tmp.M.memptr()), tmp.M.n_elem, 1, false ); - - return find(R); - } - - - -template -arma_warn_unused -inline -uvec -find(const BaseCube& X, const uword k, const char* direction = "first") - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_cube tmp(X.get_ref()); - - const Mat R( const_cast< eT* >(tmp.M.memptr()), tmp.M.n_elem, 1, false ); - - return find(R, k, direction); - } - - - -template -arma_warn_unused -inline -uvec -find(const mtOpCube& X, const uword k = 0, const char* direction = "first") - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_cube tmp(X.m); - - const Mat R( const_cast< eT* >(tmp.M.memptr()), tmp.M.n_elem, 1, false ); - - return find( mtOp, op_rel_type>(R, X.aux), k, direction ); - } - - - -template -arma_warn_unused -inline -uvec -find(const mtGlueCube& X, const uword k = 0, const char* direction = "first") - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - const unwrap_cube tmp1(X.A); - const unwrap_cube tmp2(X.B); - - arma_conform_assert_same_size( tmp1.M, tmp2.M, "relational operator" ); - - const Mat R1( const_cast< eT1* >(tmp1.M.memptr()), tmp1.M.n_elem, 1, false ); - const Mat R2( const_cast< eT2* >(tmp2.M.memptr()), tmp2.M.n_elem, 1, false ); - - return find( mtGlue, Mat, glue_rel_type>(R1, R2), k, direction ); - } - - - -// - - - -template -arma_warn_unused -inline -Col -find(const SpBase& X, const uword k = 0) - { - arma_debug_sigprint(); - - const SpProxy P(X.get_ref()); - - const uword n_rows = P.get_n_rows(); - const uword n_nz = P.get_n_nonzero(); - - Mat tmp(n_nz, 1, arma_nozeros_indicator()); - - uword* tmp_mem = tmp.memptr(); - - typename SpProxy::const_iterator_type it = P.begin(); - - for(uword i=0; i out; - - const uword count = (k == 0) ? uword(n_nz) : uword( (std::min)(n_nz, k) ); - - out.steal_mem_col(tmp, count); - - return out; - } - - - -template -arma_warn_unused -inline -Col -find(const SpBase& X, const uword k, const char* direction) - { - arma_debug_sigprint(); - - arma_ignore(X); - arma_ignore(k); - arma_ignore(direction); - - arma_check(true, "find(SpBase,k,direction): not implemented yet"); // TODO - - Col out; - - return out; - } - - - -// - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value, - const mtOp - >::result -find_finite(const T1& X) - { - arma_debug_sigprint(); - - return mtOp(X); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value, - const mtOp - >::result -find_nonfinite(const T1& X) - { - arma_debug_sigprint(); - - return mtOp(X); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value, - const mtOp - >::result -find_nan(const T1& X) - { - arma_debug_sigprint(); - - return mtOp(X); - } - - - -// - - - -template -arma_warn_unused -inline -uvec -find_finite(const BaseCube& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_cube tmp(X.get_ref()); - - const Mat R( const_cast< eT* >(tmp.M.memptr()), tmp.M.n_elem, 1, false ); - - return find_finite(R); - } - - - -template -arma_warn_unused -inline -uvec -find_nonfinite(const BaseCube& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_cube tmp(X.get_ref()); - - const Mat R( const_cast< eT* >(tmp.M.memptr()), tmp.M.n_elem, 1, false ); - - return find_nonfinite(R); - } - - - -template -arma_warn_unused -inline -uvec -find_nan(const BaseCube& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_cube tmp(X.get_ref()); - - const Mat R( const_cast< eT* >(tmp.M.memptr()), tmp.M.n_elem, 1, false ); - - return find_nan(R); - } - - - -// - - - -template -arma_warn_unused -inline -Col -find_finite(const SpBase& X) - { - arma_debug_sigprint(); - - const SpProxy P(X.get_ref()); - - const uword n_rows = P.get_n_rows(); - const uword n_nz = P.get_n_nonzero(); - - Mat tmp(n_nz, 1, arma_nozeros_indicator()); - - uword* tmp_mem = tmp.memptr(); - - typename SpProxy::const_iterator_type it = P.begin(); - - uword count = 0; - - for(uword i=0; i out; - - if(count > 0) { out.steal_mem_col(tmp, count); } - - return out; - } - - - -template -arma_warn_unused -inline -Col -find_nonfinite(const SpBase& X) - { - arma_debug_sigprint(); - - const SpProxy P(X.get_ref()); - - const uword n_rows = P.get_n_rows(); - const uword n_nz = P.get_n_nonzero(); - - Mat tmp(n_nz, 1, arma_nozeros_indicator()); - - uword* tmp_mem = tmp.memptr(); - - typename SpProxy::const_iterator_type it = P.begin(); - - uword count = 0; - - for(uword i=0; i out; - - if(count > 0) { out.steal_mem_col(tmp, count); } - - return out; - } - - - -template -arma_warn_unused -inline -Col -find_nan(const SpBase& X) - { - arma_debug_sigprint(); - - const SpProxy P(X.get_ref()); - - const uword n_rows = P.get_n_rows(); - const uword n_nz = P.get_n_nonzero(); - - Mat tmp(n_nz, 1, arma_nozeros_indicator()); - - uword* tmp_mem = tmp.memptr(); - - typename SpProxy::const_iterator_type it = P.begin(); - - uword count = 0; - - for(uword i=0; i out; - - if(count > 0) { out.steal_mem_col(tmp, count); } - - return out; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_find_unique.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_find_unique.hpp deleted file mode 100644 index 646b7b277..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_find_unique.hpp +++ /dev/null @@ -1,69 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_find_unique -//! @{ - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value, - const mtOp - >::result -find_unique - ( - const T1& X, - const bool ascending_indices = true - ) - { - arma_debug_sigprint(); - - return mtOp(X, ((ascending_indices) ? uword(1) : uword(0)), uword(0)); - } - - - -template -arma_warn_unused -inline -uvec -find_unique - ( - const BaseCube& X, - const bool ascending_indices = true - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_cube tmp(X.get_ref()); - - const Mat R( const_cast< eT* >(tmp.M.memptr()), tmp.M.n_elem, 1, false ); - - return find_unique(R,ascending_indices); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_flip.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_flip.hpp deleted file mode 100644 index 7b39a0134..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_flip.hpp +++ /dev/null @@ -1,76 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_flip -//! @{ - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const Op >::result -flipud(const T1& X) - { - arma_debug_sigprint(); - - return Op(X); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const Op >::result -fliplr(const T1& X) - { - arma_debug_sigprint(); - - return Op(X); - } - - - -template -arma_warn_unused -arma_inline -const SpOp -flipud(const SpBase& X) - { - arma_debug_sigprint(); - - return SpOp(X.get_ref()); - } - - - -template -arma_warn_unused -arma_inline -const SpOp -fliplr(const SpBase& X) - { - arma_debug_sigprint(); - - return SpOp(X.get_ref()); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_hess.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_hess.hpp deleted file mode 100644 index c93bc7c9d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_hess.hpp +++ /dev/null @@ -1,174 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_hess -//! @{ - - -template -inline -bool -hess - ( - Mat& H, - const Base& X, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - - Col tao; - - const bool status = auxlib::hess(H, X.get_ref(), tao); - - if(H.n_rows > 2) - { - for(uword i=0; i < H.n_rows-2; ++i) - { - H(span(i+2, H.n_rows-1), i).zeros(); - } - } - - if(status == false) - { - H.soft_reset(); - arma_warn(3, "hess(): decomposition failed"); - } - - return status; - } - - - -template -arma_warn_unused -inline -Mat -hess - ( - const Base& X, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - - Mat H; - Col tao; - - const bool status = auxlib::hess(H, X.get_ref(), tao); - - if(H.n_rows > 2) - { - for(uword i=0; i < H.n_rows-2; ++i) - { - H(span(i+2, H.n_rows-1), i).zeros(); - } - } - - if(status == false) - { - H.soft_reset(); - arma_stop_runtime_error("hess(): decomposition failed"); - } - - return H; - } - - - -template -inline -bool -hess - ( - Mat& U, - Mat& H, - const Base& X, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - arma_conform_check( void_ptr(&U) == void_ptr(&H), "hess(): 'U' is an alias of 'H'" ); - - typedef typename T1::elem_type eT; - - Col tao; - - const bool status = auxlib::hess(H, X.get_ref(), tao); - - if(H.n_rows == 0) - { - U.reset(); - } - else - if(H.n_rows == 1) - { - U.ones(1, 1); - } - else - if(H.n_rows == 2) - { - U.eye(2, 2); - } - else - { - U.eye(size(H)); - - Col v; - - for(uword i=0; i < H.n_rows-2; ++i) - { - // TODO: generate v in a more efficient manner; - // TODO: the .ones() operation is an overkill, as most of v is overwritten afterwards - - v.ones(H.n_rows-i-1); - - v(span(1, H.n_rows-i-2)) = H(span(i+2, H.n_rows-1), i); - - U(span::all, span(i+1, H.n_rows-1)) -= tao(i) * (U(span::all, span(i+1, H.n_rows-1)) * v * v.t()); - } - - U(span::all, H.n_rows-1) = U(span::all, H.n_rows-1) * (eT(1) - tao(H.n_rows-2)); - - for(uword i=0; i < H.n_rows-2; ++i) - { - H(span(i+2, H.n_rows-1), i).zeros(); - } - } - - if(status == false) - { - U.soft_reset(); - H.soft_reset(); - arma_warn(3, "hess(): decomposition failed"); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_hist.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_hist.hpp deleted file mode 100644 index 1924d37c4..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_hist.hpp +++ /dev/null @@ -1,76 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_hist -//! @{ - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && is_cx::no, - const mtOp - >::result -hist(const T1& A, const uword n_bins = 10) - { - arma_debug_sigprint(); - - return mtOp(A, n_bins, 0); - } - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && is_arma_type::value && is_cx::no && is_same_type::value, - const mtGlue - >::result -hist(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - return mtGlue(X, Y); - } - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && is_arma_type::value && is_cx::no && is_same_type::value, - const mtGlue - >::result -hist(const T1& X, const T2& Y, const uword dim) - { - arma_debug_sigprint(); - - return mtGlue(X, Y, dim); - } - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_histc.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_histc.hpp deleted file mode 100644 index c5f812221..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_histc.hpp +++ /dev/null @@ -1,58 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_histc -//! @{ - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && is_arma_type::value && is_cx::no && is_same_type::value, - const mtGlue - >::result -histc(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - return mtGlue(X, Y); - } - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && is_arma_type::value && is_cx::no && is_same_type::value, - const mtGlue - >::result -histc(const T1& X, const T2& Y, const uword dim) - { - arma_debug_sigprint(); - - return mtGlue(X, Y, dim); - } - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_index_max.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_index_max.hpp deleted file mode 100644 index 86c12f543..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_index_max.hpp +++ /dev/null @@ -1,164 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_index_max -//! @{ - - -template -arma_warn_unused -inline -typename enable_if2< is_arma_type::value && resolves_to_vector::yes, uword>::result -index_max(const T1& X) - { - arma_debug_sigprint(); - - return X.index_max(); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value && resolves_to_vector::no, const mtOp >::result -index_max(const T1& X) - { - arma_debug_sigprint(); - - return mtOp(X, 0, 0); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const mtOp >::result -index_max(const T1& X, const uword dim) - { - arma_debug_sigprint(); - - return mtOp(X, dim, 0); - } - - - -template -arma_warn_unused -arma_inline -const mtOpCube -index_max - ( - const BaseCube& X, - const uword dim = 0 - ) - { - arma_debug_sigprint(); - - return mtOpCube(X.get_ref(), dim, 0, 0); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value && resolves_to_sparse_vector::yes, - typename T1::elem_type - >::result -index_max(const T1& x) - { - arma_debug_sigprint(); - - return x.index_max(); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value && resolves_to_sparse_vector::no, - Mat - >::result -index_max(const T1& X) - { - arma_debug_sigprint(); - - Mat out; - - op_index_max::apply(out, X, 0); - - return out; - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value, - Mat - >::result -index_max(const T1& X, const uword dim) - { - arma_debug_sigprint(); - - Mat out; - - op_index_max::apply(out, X, dim); - - return out; - } - - - -arma_warn_unused -inline -uword -index_max(const SizeMat& s) - { - return (s.n_rows >= s.n_cols) ? uword(0) : uword(1); - } - - - -arma_warn_unused -inline -uword -index_max(const SizeCube& s) - { - const uword tmp_val = (s.n_rows >= s.n_cols) ? s.n_rows : s.n_cols; - const uword tmp_index = (s.n_rows >= s.n_cols) ? uword(0) : uword(1); - - return (tmp_val >= s.n_slices) ? tmp_index : uword(2); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_index_min.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_index_min.hpp deleted file mode 100644 index b85222500..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_index_min.hpp +++ /dev/null @@ -1,164 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_index_min -//! @{ - - -template -arma_warn_unused -inline -typename enable_if2< is_arma_type::value && resolves_to_vector::yes, uword>::result -index_min(const T1& X) - { - arma_debug_sigprint(); - - return X.index_min(); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value && resolves_to_vector::no, const mtOp >::result -index_min(const T1& X) - { - arma_debug_sigprint(); - - return mtOp(X, 0, 0); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const mtOp >::result -index_min(const T1& X, const uword dim) - { - arma_debug_sigprint(); - - return mtOp(X, dim, 0); - } - - - -template -arma_warn_unused -arma_inline -const mtOpCube -index_min - ( - const BaseCube& X, - const uword dim = 0 - ) - { - arma_debug_sigprint(); - - return mtOpCube(X.get_ref(), dim, 0, 0); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value && resolves_to_sparse_vector::yes, - typename T1::elem_type - >::result -index_min(const T1& x) - { - arma_debug_sigprint(); - - return x.index_min(); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value && resolves_to_sparse_vector::no, - Mat - >::result -index_min(const T1& X) - { - arma_debug_sigprint(); - - Mat out; - - op_index_min::apply(out, X, 0); - - return out; - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value, - Mat - >::result -index_min(const T1& X, const uword dim) - { - arma_debug_sigprint(); - - Mat out; - - op_index_min::apply(out, X, dim); - - return out; - } - - - -arma_warn_unused -inline -uword -index_min(const SizeMat& s) - { - return (s.n_rows <= s.n_cols) ? uword(0) : uword(1); - } - - - -arma_warn_unused -inline -uword -index_min(const SizeCube& s) - { - const uword tmp_val = (s.n_rows <= s.n_cols) ? s.n_rows : s.n_cols; - const uword tmp_index = (s.n_rows <= s.n_cols) ? uword(0) : uword(1); - - return (tmp_val <= s.n_slices) ? tmp_index : uword(2); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_inplace_strans.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_inplace_strans.hpp deleted file mode 100644 index 22ead93b0..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_inplace_strans.hpp +++ /dev/null @@ -1,95 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_inplace_strans -//! @{ - - - -template -inline -void -inplace_strans - ( - Mat& X, - const char* method = "std" - ) - { - arma_debug_sigprint(); - - const char sig = (method != nullptr) ? method[0] : char(0); - - arma_conform_check( ((sig != 's') && (sig != 'l')), "inplace_strans(): unknown method specified" ); - - const bool low_memory = (sig == 'l'); - - if( (low_memory == false) || (X.n_rows == X.n_cols) ) - { - op_strans::apply_mat_inplace(X); - } - else - { - // in-place algorithm inspired by: - // Fred G. Gustavson, Tadeusz Swirszcz. - // In-Place Transposition of Rectangular Matrices. - // Applied Parallel Computing. State of the Art in Scientific Computing. - // Lecture Notes in Computer Science. Volume 4699, pp. 560-569, 2007. - - - // X.set_size() will check whether we can change the dimensions of X; - // X.set_size() will also reuse existing memory, as the number of elements hasn't changed - - X.set_size(X.n_cols, X.n_rows); - - const uword m = X.n_cols; - const uword n = X.n_rows; - - std::vector visited(X.n_elem); // TODO: replace std::vector with a better implementation - - for(uword col = 0; col < m; ++col) - for(uword row = 0; row < n; ++row) - { - const uword pos = col*n + row; - - if(visited[pos] == false) - { - uword curr_pos = pos; - - eT val = X.at(row, col); - - while(visited[curr_pos] == false) - { - visited[curr_pos] = true; - - const uword j = curr_pos / m; - const uword i = curr_pos - m * j; - - const eT tmp = X.at(j, i); - X.at(j, i) = val; - val = tmp; - - curr_pos = i*n + j; - } - } - } - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_inplace_trans.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_inplace_trans.hpp deleted file mode 100644 index 53d180a05..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_inplace_trans.hpp +++ /dev/null @@ -1,131 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_inplace_trans -//! @{ - - - -template -inline -typename -enable_if2 - < - is_cx::no, - void - >::result -inplace_htrans - ( - Mat& X, - const char* method = "std" - ) - { - arma_debug_sigprint(); - - inplace_strans(X, method); - } - - - -template -inline -typename -enable_if2 - < - is_cx::yes, - void - >::result -inplace_htrans - ( - Mat& X, - const char* method = "std" - ) - { - arma_debug_sigprint(); - - const char sig = (method != nullptr) ? method[0] : char(0); - - arma_conform_check( ((sig != 's') && (sig != 'l')), "inplace_htrans(): unknown method specified" ); - - const bool low_memory = (sig == 'l'); - - if( (low_memory == false) || (X.n_rows == X.n_cols) ) - { - op_htrans::apply_mat_inplace(X); - } - else - { - inplace_strans(X, method); - - X = conj(X); - } - } - - - -template -inline -typename -enable_if2 - < - is_cx::no, - void - >::result -inplace_trans - ( - Mat& X, - const char* method = "std" - ) - { - arma_debug_sigprint(); - - const char sig = (method != nullptr) ? method[0] : char(0); - - arma_conform_check( ((sig != 's') && (sig != 'l')), "inplace_trans(): unknown method specified" ); - - inplace_strans(X, method); - } - - - -template -inline -typename -enable_if2 - < - is_cx::yes, - void - >::result -inplace_trans - ( - Mat& X, - const char* method = "std" - ) - { - arma_debug_sigprint(); - - const char sig = (method != nullptr) ? method[0] : char(0); - - arma_conform_check( ((sig != 's') && (sig != 'l')), "inplace_trans(): unknown method specified" ); - - inplace_htrans(X, method); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_interp1.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_interp1.hpp deleted file mode 100644 index a7e370760..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_interp1.hpp +++ /dev/null @@ -1,351 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_interp1 -//! @{ - - - -template -inline -void -interp1_helper_nearest(const Mat& XG, const Mat& YG, const Mat& XI, Mat& YI, const eT extrap_val) - { - arma_debug_sigprint(); - - const eT XG_min = XG.min(); - const eT XG_max = XG.max(); - - YI.copy_size(XI); - - const eT* XG_mem = XG.memptr(); - const eT* YG_mem = YG.memptr(); - const eT* XI_mem = XI.memptr(); - eT* YI_mem = YI.memptr(); - - const uword NG = XG.n_elem; - const uword NI = XI.n_elem; - - uword best_j = 0; - - for(uword i=0; i::inf; - - const eT XI_val = XI_mem[i]; - - if((XI_val < XG_min) || (XI_val > XG_max)) - { - YI_mem[i] = extrap_val; - } - else - if(arma_isnan(XI_val)) - { - YI_mem[i] = Datum::nan; - } - else - { - // XG and XI are guaranteed to be sorted in ascending manner, - // so start searching XG from last known optimum position - - for(uword j=best_j; j= eT(0)) ? tmp : -tmp; - - if(err >= best_err) - { - // error is going up, so we have found the optimum position - break; - } - else - { - best_err = err; - best_j = j; // remember the optimum position - } - } - - YI_mem[i] = YG_mem[best_j]; - } - } - } - - - -template -inline -void -interp1_helper_linear(const Mat& XG, const Mat& YG, const Mat& XI, Mat& YI, const eT extrap_val) - { - arma_debug_sigprint(); - - const eT XG_min = XG.min(); - const eT XG_max = XG.max(); - - YI.copy_size(XI); - - const eT* XG_mem = XG.memptr(); - const eT* YG_mem = YG.memptr(); - const eT* XI_mem = XI.memptr(); - eT* YI_mem = YI.memptr(); - - const uword NG = XG.n_elem; - const uword NI = XI.n_elem; - - uword a_best_j = 0; - uword b_best_j = 0; - - for(uword i=0; i XG_max)) - { - YI_mem[i] = extrap_val; - } - else - if(arma_isnan(XI_val)) - { - YI_mem[i] = Datum::nan; - } - else - { - // XG and XI are guaranteed to be sorted in ascending manner, - // so start searching XG from last known optimum position - - eT a_best_err = Datum::inf; - eT b_best_err = Datum::inf; - - for(uword j=a_best_j; j= eT(0)) ? tmp : -tmp; - - if(err >= a_best_err) - { - break; - } - else - { - a_best_err = err; - a_best_j = j; - } - } - - if( (XG_mem[a_best_j] - XI_val) <= eT(0) ) - { - // a_best_j is to the left of the interpolated position - - b_best_j = ( (a_best_j+1) < NG) ? (a_best_j+1) : a_best_j; - } - else - { - // a_best_j is to the right of the interpolated position - - b_best_j = (a_best_j >= 1) ? (a_best_j-1) : a_best_j; - } - - b_best_err = std::abs( XG_mem[b_best_j] - XI_val ); - - if(a_best_j > b_best_j) - { - std::swap(a_best_j, b_best_j ); - std::swap(a_best_err, b_best_err); - } - - const eT weight = (a_best_err > eT(0)) ? (a_best_err / (a_best_err + b_best_err)) : eT(0); - - YI_mem[i] = (eT(1) - weight)*YG_mem[a_best_j] + (weight)*YG_mem[b_best_j]; - } - } - } - - - -template -inline -void -interp1_helper(const Mat& X, const Mat& Y, const Mat& XI, Mat& YI, const uword sig, const eT extrap_val) - { - arma_debug_sigprint(); - - arma_conform_check( ((X.is_vec() == false) || (Y.is_vec() == false) || (XI.is_vec() == false)), "interp1(): currently only vectors are supported" ); - - arma_conform_check( (X.n_elem != Y.n_elem), "interp1(): X and Y must have the same number of elements" ); - - arma_conform_check( (X.n_elem < 2), "interp1(): X must have at least two unique elements" ); - - // sig = 10: nearest neighbour - // sig = 11: nearest neighbour, assume monotonic increase in X and XI - // - // sig = 20: linear - // sig = 21: linear, assume monotonic increase in X and XI - - if(sig == 11) { interp1_helper_nearest(X, Y, XI, YI, extrap_val); return; } - if(sig == 21) { interp1_helper_linear (X, Y, XI, YI, extrap_val); return; } - - uvec X_indices; - - try { X_indices = find_unique(X,false); } catch(...) { } - - // NOTE: find_unique(X,false) provides indices of elements sorted in ascending order - // NOTE: find_unique(X,false) will reset X_indices if X has NaN - - const uword N_subset = X_indices.n_elem; - - arma_conform_check( (N_subset < 2), "interp1(): X must have at least two unique elements" ); - - Mat X_sanitised(N_subset, 1, arma_nozeros_indicator()); - Mat Y_sanitised(N_subset, 1, arma_nozeros_indicator()); - - eT* X_sanitised_mem = X_sanitised.memptr(); - eT* Y_sanitised_mem = Y_sanitised.memptr(); - - const eT* X_mem = X.memptr(); - const eT* Y_mem = Y.memptr(); - - const uword* X_indices_mem = X_indices.memptr(); - - for(uword i=0; i XI_tmp; - uvec XI_indices; - - const bool XI_is_sorted = XI.is_sorted(); // NOTE: .is_sorted() currently doesn't detect NaN - - if(XI_is_sorted == false) - { - XI_indices = sort_index(XI); // NOTE: sort_index() will throw if XI has NaN - - const uword N = XI.n_elem; - - XI_tmp.copy_size(XI); - - const uword* XI_indices_mem = XI_indices.memptr(); - - const eT* XI_mem = XI.memptr(); - eT* XI_tmp_mem = XI_tmp.memptr(); - - for(uword i=0; i& XI_sorted = (XI_is_sorted) ? XI : XI_tmp; - - // NOTE: XI_sorted may have NaN - - - if(sig == 10) { interp1_helper_nearest(X_sanitised, Y_sanitised, XI_sorted, YI, extrap_val); } - else if(sig == 20) { interp1_helper_linear (X_sanitised, Y_sanitised, XI_sorted, YI, extrap_val); } - - - if( (XI_is_sorted == false) && (YI.n_elem > 0) ) - { - Mat YI_unsorted; - - YI_unsorted.copy_size(YI); - - const eT* YI_mem = YI.memptr(); - eT* YI_unsorted_mem = YI_unsorted.memptr(); - - const uword N = XI_sorted.n_elem; - const uword* XI_indices_mem = XI_indices.memptr(); - - for(uword i=0; i -inline -typename -enable_if2 - < - is_real::value, - void - >::result -interp1 - ( - const Base& X, - const Base& Y, - const Base& XI, - Mat& YI, - const char* method = "linear", - const typename T1::elem_type extrap_val = Datum::nan - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - uword sig = 0; - - if(method != nullptr) - if(method[0] != char(0)) - if(method[1] != char(0)) - { - const char c1 = method[0]; - const char c2 = method[1]; - - if(c1 == 'n') { sig = 10; } // nearest neighbour - else if(c1 == 'l') { sig = 20; } // linear - else - { - if( (c1 == '*') && (c2 == 'n') ) { sig = 11; } // nearest neighour, assume monotonic increase in X and XI - if( (c1 == '*') && (c2 == 'l') ) { sig = 21; } // linear, assume monotonic increase in X and XI - } - } - - arma_conform_check( (sig == 0), "interp1(): unsupported interpolation type" ); - - const quasi_unwrap X_tmp( X.get_ref()); - const quasi_unwrap Y_tmp( Y.get_ref()); - const quasi_unwrap XI_tmp(XI.get_ref()); - - if( X_tmp.is_alias(YI) || Y_tmp.is_alias(YI) || XI_tmp.is_alias(YI) ) - { - Mat tmp; - - interp1_helper(X_tmp.M, Y_tmp.M, XI_tmp.M, tmp, sig, extrap_val); - - YI.steal_mem(tmp); - } - else - { - interp1_helper(X_tmp.M, Y_tmp.M, XI_tmp.M, YI, sig, extrap_val); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_interp2.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_interp2.hpp deleted file mode 100644 index 90521a84f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_interp2.hpp +++ /dev/null @@ -1,264 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_interp2 -//! @{ - - - -template -inline -void -interp2_helper_nearest(const Mat& XG, const Mat& ZG, const Mat& XI, Mat& ZI, const eT extrap_val, const uword mode) - { - arma_debug_sigprint(); - - const eT XG_min = XG.min(); - const eT XG_max = XG.max(); - - // mode = 0: interpolate across rows (eg. expand in vertical direction) - // mode = 1: interpolate across columns (eg. expand in horizontal direction) - - if(mode == 0) { ZI.set_size(XI.n_elem, ZG.n_cols); } - if(mode == 1) { ZI.set_size(ZG.n_rows, XI.n_elem); } - - const eT* XG_mem = XG.memptr(); - const eT* XI_mem = XI.memptr(); - - const uword NG = XG.n_elem; - const uword NI = XI.n_elem; - - uword best_j = 0; - - for(uword i=0; i::inf; - - const eT XI_val = XI_mem[i]; - - if((XI_val < XG_min) || (XI_val > XG_max)) - { - if(mode == 0) { ZI.row(i).fill(extrap_val); } - if(mode == 1) { ZI.col(i).fill(extrap_val); } - } - else - { - // XG and XI are guaranteed to be sorted in ascending manner, - // so start searching XG from last known optimum position - - for(uword j=best_j; j= eT(0)) ? tmp : -tmp; - - if(err >= best_err) - { - // error is going up, so we have found the optimum position - break; - } - else - { - best_err = err; - best_j = j; // remember the optimum position - } - } - - if(mode == 0) { ZI.row(i) = ZG.row(best_j); } - if(mode == 1) { ZI.col(i) = ZG.col(best_j); } - } - } - } - - - -template -inline -void -interp2_helper_linear(const Mat& XG, const Mat& ZG, const Mat& XI, Mat& ZI, const eT extrap_val, const uword mode) - { - arma_debug_sigprint(); - - const eT XG_min = XG.min(); - const eT XG_max = XG.max(); - - // mode = 0: interpolate across rows (eg. expand in vertical direction) - // mode = 1: interpolate across columns (eg. expand in horizontal direction) - - if(mode == 0) { ZI.set_size(XI.n_elem, ZG.n_cols); } - if(mode == 1) { ZI.set_size(ZG.n_rows, XI.n_elem); } - - const eT* XG_mem = XG.memptr(); - const eT* XI_mem = XI.memptr(); - - const uword NG = XG.n_elem; - const uword NI = XI.n_elem; - - uword a_best_j = 0; - uword b_best_j = 0; - - for(uword i=0; i XG_max)) - { - if(mode == 0) { ZI.row(i).fill(extrap_val); } - if(mode == 1) { ZI.col(i).fill(extrap_val); } - } - else - { - // XG and XI are guaranteed to be sorted in ascending manner, - // so start searching XG from last known optimum position - - eT a_best_err = Datum::inf; - eT b_best_err = Datum::inf; - - for(uword j=a_best_j; j= eT(0)) ? tmp : -tmp; - - if(err >= a_best_err) - { - break; - } - else - { - a_best_err = err; - a_best_j = j; - } - } - - if( (XG_mem[a_best_j] - XI_val) <= eT(0) ) - { - // a_best_j is to the left of the interpolated position - - b_best_j = ( (a_best_j+1) < NG) ? (a_best_j+1) : a_best_j; - } - else - { - // a_best_j is to the right of the interpolated position - - b_best_j = (a_best_j >= 1) ? (a_best_j-1) : a_best_j; - } - - b_best_err = std::abs( XG_mem[b_best_j] - XI_val ); - - if(a_best_j > b_best_j) - { - std::swap(a_best_j, b_best_j ); - std::swap(a_best_err, b_best_err); - } - - const eT weight = (a_best_err > eT(0)) ? (a_best_err / (a_best_err + b_best_err)) : eT(0); - - if(mode == 0) { ZI.row(i) = (eT(1) - weight)*ZG.row(a_best_j) + (weight)*ZG.row(b_best_j); } - if(mode == 1) { ZI.col(i) = (eT(1) - weight)*ZG.col(a_best_j) + (weight)*ZG.col(b_best_j); } - } - } - } - - - -template -inline -typename -enable_if2< is_real::value, void >::result -interp2 - ( - const Base& X, - const Base& Y, - const Base& Z, - const Base& XI, - const Base& YI, - Mat& ZI, - const char* method = "linear", - const typename T1::elem_type extrap_val = Datum::nan - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const char sig = (method != nullptr) ? method[0] : char(0); - - arma_conform_check( ((sig != 'n') && (sig != 'l')), "interp2(): unsupported interpolation type" ); - - const quasi_unwrap UXG( X.get_ref() ); - const quasi_unwrap UYG( Y.get_ref() ); - const quasi_unwrap UZG( Z.get_ref() ); - const quasi_unwrap UXI( XI.get_ref() ); - const quasi_unwrap UYI( YI.get_ref() ); - - arma_conform_check( (UXG.M.is_vec() == false), "interp2(): X must resolve to a vector" ); - arma_conform_check( (UYG.M.is_vec() == false), "interp2(): Y must resolve to a vector" ); - - arma_conform_check( (UXI.M.is_vec() == false), "interp2(): XI must resolve to a vector" ); - arma_conform_check( (UYI.M.is_vec() == false), "interp2(): YI must resolve to a vector" ); - - arma_conform_check( (UXG.M.n_elem < 2), "interp2(): X must have at least two unique elements" ); - arma_conform_check( (UYG.M.n_elem < 2), "interp2(): Y must have at least two unique elements" ); - - arma_conform_check( (UXG.M.n_elem != UZG.M.n_cols), "interp2(): number of elements in X must equal the number of columns in Z" ); - arma_conform_check( (UYG.M.n_elem != UZG.M.n_rows), "interp2(): number of elements in Y must equal the number of rows in Z" ); - - arma_conform_check( (UXG.M.is_sorted("strictascend") == false), "interp2(): X must be monotonically increasing" ); - arma_conform_check( (UYG.M.is_sorted("strictascend") == false), "interp2(): Y must be monotonically increasing" ); - - arma_conform_check( (UXI.M.is_sorted("strictascend") == false), "interp2(): XI must be monotonically increasing" ); - arma_conform_check( (UYI.M.is_sorted("strictascend") == false), "interp2(): YI must be monotonically increasing" ); - - Mat tmp; - - if( UXG.is_alias(ZI) || UXI.is_alias(ZI) ) - { - Mat out; - - if(sig == 'n') - { - interp2_helper_nearest(UYG.M, UZG.M, UYI.M, tmp, extrap_val, 0); - interp2_helper_nearest(UXG.M, tmp, UXI.M, out, extrap_val, 1); - } - else - if(sig == 'l') - { - interp2_helper_linear(UYG.M, UZG.M, UYI.M, tmp, extrap_val, 0); - interp2_helper_linear(UXG.M, tmp, UXI.M, out, extrap_val, 1); - } - - ZI.steal_mem(out); - } - else - { - if(sig == 'n') - { - interp2_helper_nearest(UYG.M, UZG.M, UYI.M, tmp, extrap_val, 0); - interp2_helper_nearest(UXG.M, tmp, UXI.M, ZI, extrap_val, 1); - } - else - if(sig == 'l') - { - interp2_helper_linear(UYG.M, UZG.M, UYI.M, tmp, extrap_val, 0); - interp2_helper_linear(UXG.M, tmp, UXI.M, ZI, extrap_val, 1); - } - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_intersect.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_intersect.hpp deleted file mode 100644 index 6d8141c46..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_intersect.hpp +++ /dev/null @@ -1,65 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_intersect -//! @{ - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - ( is_arma_type::value && is_arma_type::value && is_same_type::value ), - const Glue - >::result -intersect - ( - const T1& A, - const T2& B - ) - { - arma_debug_sigprint(); - - return Glue(A, B); - } - - - -template -inline -void -intersect - ( - Mat& C, - uvec& iA, - uvec& iB, - const Base& A, - const Base& B - ) - { - arma_debug_sigprint(); - - glue_intersect::apply(C, iA, iB, A.get_ref(), B.get_ref(), true); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_inv.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_inv.hpp deleted file mode 100644 index ba6109129..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_inv.hpp +++ /dev/null @@ -1,138 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_inv -//! @{ - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_supported_blas_type::value, const Op >::result -inv - ( - const Base& X - ) - { - arma_debug_sigprint(); - - return Op(X.get_ref()); - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -inv - ( - Mat& out, - const Base& X - ) - { - arma_debug_sigprint(); - - const bool status = op_inv_gen_default::apply_direct(out, X.get_ref(), "inv()"); - - if(status == false) - { - out.soft_reset(); - arma_warn(3, "inv(): matrix is singular"); - } - - return status; - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_supported_blas_type::value, const Op >::result -inv - ( - const Base& X, - const inv_opts::opts& opts - ) - { - arma_debug_sigprint(); - - return Op(X.get_ref(), opts.flags, uword(0)); - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -inv - ( - Mat& out, - const Base& X, - const inv_opts::opts& opts - ) - { - arma_debug_sigprint(); - - const bool status = op_inv_gen_full::apply_direct(out, X.get_ref(), "inv()", opts.flags); - - if(status == false) - { - out.soft_reset(); - arma_warn(3, "inv(): matrix is singular"); - } - - return status; - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -inv - ( - Mat& out_inv, - typename T1::pod_type& out_rcond, - const Base& X - ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - op_inv_gen_state inv_state; - - const bool status = op_inv_gen_rcond::apply_direct(out_inv, inv_state, X.get_ref()); - - out_rcond = inv_state.rcond; - - if(status == false) - { - out_rcond = T(0); - out_inv.soft_reset(); - arma_warn(3, "inv(): matrix is singular"); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_inv_sympd.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_inv_sympd.hpp deleted file mode 100644 index a179638fd..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_inv_sympd.hpp +++ /dev/null @@ -1,138 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_inv_sympd -//! @{ - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_supported_blas_type::value, const Op >::result -inv_sympd - ( - const Base& X - ) - { - arma_debug_sigprint(); - - return Op(X.get_ref()); - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -inv_sympd - ( - Mat& out, - const Base& X - ) - { - arma_debug_sigprint(); - - const bool status = op_inv_spd_default::apply_direct(out, X.get_ref()); - - if(status == false) - { - out.soft_reset(); - arma_warn(3, "inv_sympd(): matrix is singular or not positive definite"); - } - - return status; - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_supported_blas_type::value, const Op >::result -inv_sympd - ( - const Base& X, - const inv_opts::opts& opts - ) - { - arma_debug_sigprint(); - - return Op(X.get_ref(), opts.flags, uword(0)); - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -inv_sympd - ( - Mat& out, - const Base& X, - const inv_opts::opts& opts - ) - { - arma_debug_sigprint(); - - const bool status = op_inv_spd_full::apply_direct(out, X.get_ref(), opts.flags); - - if(status == false) - { - out.soft_reset(); - arma_warn(3, "inv_sympd(): matrix is singular or not positive definite"); - } - - return status; - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -inv_sympd - ( - Mat& out_inv, - typename T1::pod_type& out_rcond, - const Base& X - ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - op_inv_spd_state inv_state; - - const bool status = op_inv_spd_rcond::apply_direct(out_inv, inv_state, X.get_ref()); - - out_rcond = inv_state.rcond; - - if(status == false) - { - out_rcond = T(0); - out_inv.soft_reset(); - arma_warn(3, "inv_sympd(): matrix is singular or not positive definite"); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_join.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_join.hpp deleted file mode 100644 index ac521baca..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_join.hpp +++ /dev/null @@ -1,502 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_join -//! @{ - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value && is_same_type::value), - const Glue - >::result -join_cols(const T1& A, const T2& B) - { - arma_debug_sigprint(); - - return Glue(A, B); - } - - - -template -arma_warn_unused -inline -Mat -join_cols(const Base& A, const Base& B, const Base& C) - { - arma_debug_sigprint(); - - Mat out; - - glue_join_cols::apply(out, A.get_ref(), B.get_ref(), C.get_ref()); - - return out; - } - - - -template -arma_warn_unused -inline -Mat -join_cols(const Base& A, const Base& B, const Base& C, const Base& D) - { - arma_debug_sigprint(); - - Mat out; - - glue_join_cols::apply(out, A.get_ref(), B.get_ref(), C.get_ref(), D.get_ref()); - - return out; - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value && is_same_type::value), - const Glue - >::result -join_vert(const T1& A, const T2& B) - { - arma_debug_sigprint(); - - return Glue(A, B); - } - - - -template -arma_warn_unused -inline -Mat -join_vert(const Base& A, const Base& B, const Base& C) - { - arma_debug_sigprint(); - - Mat out; - - glue_join_cols::apply(out, A.get_ref(), B.get_ref(), C.get_ref()); - - return out; - } - - - -template -arma_warn_unused -inline -Mat -join_vert(const Base& A, const Base& B, const Base& C, const Base& D) - { - arma_debug_sigprint(); - - Mat out; - - glue_join_cols::apply(out, A.get_ref(), B.get_ref(), C.get_ref(), D.get_ref()); - - return out; - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value && is_same_type::value), - const Glue - >::result -join_rows(const T1& A, const T2& B) - { - arma_debug_sigprint(); - - return Glue(A, B); - } - - - -template -arma_warn_unused -inline -Mat -join_rows(const Base& A, const Base& B, const Base& C) - { - arma_debug_sigprint(); - - Mat out; - - glue_join_rows::apply(out, A.get_ref(), B.get_ref(), C.get_ref()); - - return out; - } - - - -template -arma_warn_unused -inline -Mat -join_rows(const Base& A, const Base& B, const Base& C, const Base& D) - { - arma_debug_sigprint(); - - Mat out; - - glue_join_rows::apply(out, A.get_ref(), B.get_ref(), C.get_ref(), D.get_ref()); - - return out; - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value && is_same_type::value), - const Glue - >::result -join_horiz(const T1& A, const T2& B) - { - arma_debug_sigprint(); - - return Glue(A, B); - } - - - -template -arma_warn_unused -inline -Mat -join_horiz(const Base& A, const Base& B, const Base& C) - { - arma_debug_sigprint(); - - Mat out; - - glue_join_rows::apply(out, A.get_ref(), B.get_ref(), C.get_ref()); - - return out; - } - - - -template -arma_warn_unused -inline -Mat -join_horiz(const Base& A, const Base& B, const Base& C, const Base& D) - { - arma_debug_sigprint(); - - Mat out; - - glue_join_rows::apply(out, A.get_ref(), B.get_ref(), C.get_ref(), D.get_ref()); - - return out; - } - - - -// -// for cubes - -template -arma_warn_unused -inline -const GlueCube -join_slices(const BaseCube& A, const BaseCube& B) - { - arma_debug_sigprint(); - - return GlueCube(A.get_ref(), B.get_ref()); - } - - - -template -arma_warn_unused -inline -Cube -join_slices(const Base& A, const Base& B) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap UA(A.get_ref()); - const quasi_unwrap UB(B.get_ref()); - - arma_conform_assert_same_size(UA.M.n_rows, UA.M.n_cols, UB.M.n_rows, UB.M.n_cols, "join_slices(): incompatible dimensions"); - - Cube out(UA.M.n_rows, UA.M.n_cols, 2, arma_nozeros_indicator()); - - arrayops::copy(out.slice_memptr(0), UA.M.memptr(), UA.M.n_elem); - arrayops::copy(out.slice_memptr(1), UB.M.memptr(), UB.M.n_elem); - - return out; - } - - - -template -arma_warn_unused -inline -Cube -join_slices(const Base& A, const BaseCube& B) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap U(A.get_ref()); - - const Cube M(const_cast(U.M.memptr()), U.M.n_rows, U.M.n_cols, 1, false); - - return join_slices(M,B); - } - - - -template -arma_warn_unused -inline -Cube -join_slices(const BaseCube& A, const Base& B) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap U(B.get_ref()); - - const Cube M(const_cast(U.M.memptr()), U.M.n_rows, U.M.n_cols, 1, false); - - return join_slices(A,M); - } - - - -// -// for sparse matrices - -template -arma_warn_unused -inline -const SpGlue -join_cols(const SpBase& A, const SpBase& B) - { - arma_debug_sigprint(); - - return SpGlue(A.get_ref(), B.get_ref()); - } - - - -template -arma_warn_unused -inline -SpMat -join_cols(const SpBase& A, const SpBase& B, const SpBase& C) - { - arma_debug_sigprint(); - - SpMat out; - - spglue_join_cols::apply(out, A.get_ref(), B.get_ref(), C.get_ref()); - - return out; - } - - - -template -arma_warn_unused -inline -SpMat -join_cols(const SpBase& A, const SpBase& B, const SpBase& C, const SpBase& D) - { - arma_debug_sigprint(); - - SpMat out; - - spglue_join_cols::apply(out, A.get_ref(), B.get_ref(), C.get_ref(), D.get_ref()); - - return out; - } - - - -template -arma_warn_unused -inline -const SpGlue -join_vert(const SpBase& A, const SpBase& B) - { - arma_debug_sigprint(); - - return SpGlue(A.get_ref(), B.get_ref()); - } - - - -template -arma_warn_unused -inline -SpMat -join_vert(const SpBase& A, const SpBase& B, const SpBase& C) - { - arma_debug_sigprint(); - - SpMat out; - - spglue_join_cols::apply(out, A.get_ref(), B.get_ref(), C.get_ref()); - - return out; - } - - - -template -arma_warn_unused -inline -SpMat -join_vert(const SpBase& A, const SpBase& B, const SpBase& C, const SpBase& D) - { - arma_debug_sigprint(); - - SpMat out; - - spglue_join_cols::apply(out, A.get_ref(), B.get_ref(), C.get_ref(), D.get_ref()); - - return out; - } - - - -template -arma_warn_unused -inline -const SpGlue -join_rows(const SpBase& A, const SpBase& B) - { - arma_debug_sigprint(); - - return SpGlue(A.get_ref(), B.get_ref()); - } - - - -template -arma_warn_unused -inline -SpMat -join_rows(const SpBase& A, const SpBase& B, const SpBase& C) - { - arma_debug_sigprint(); - - SpMat out; - - spglue_join_rows::apply(out, A.get_ref(), B.get_ref(), C.get_ref()); - - return out; - } - - - -template -arma_warn_unused -inline -SpMat -join_rows(const SpBase& A, const SpBase& B, const SpBase& C, const SpBase& D) - { - arma_debug_sigprint(); - - SpMat out; - - spglue_join_rows::apply(out, A.get_ref(), B.get_ref(), C.get_ref(), D.get_ref()); - - return out; - } - - - -template -arma_warn_unused -inline -const SpGlue -join_horiz(const SpBase& A, const SpBase& B) - { - arma_debug_sigprint(); - - return SpGlue(A.get_ref(), B.get_ref()); - } - - - -template -arma_warn_unused -inline -SpMat -join_horiz(const SpBase& A, const SpBase& B, const SpBase& C) - { - arma_debug_sigprint(); - - SpMat out; - - spglue_join_rows::apply(out, A.get_ref(), B.get_ref(), C.get_ref()); - - return out; - } - - - -template -arma_warn_unused -inline -SpMat -join_horiz(const SpBase& A, const SpBase& B, const SpBase& C, const SpBase& D) - { - arma_debug_sigprint(); - - SpMat out; - - spglue_join_rows::apply(out, A.get_ref(), B.get_ref(), C.get_ref(), D.get_ref()); - - return out; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_kmeans.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_kmeans.hpp deleted file mode 100644 index 56fb5c363..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_kmeans.hpp +++ /dev/null @@ -1,59 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_kmeans -//! @{ - - - -template -inline -typename enable_if2::value, bool>::result -kmeans - ( - Mat& means, - const Base& data, - const uword k, - const gmm_seed_mode& seed_mode, - const uword n_iter, - const bool print_mode - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - gmm_priv::gmm_diag model; - - const bool status = model.kmeans_wrapper(means, data.get_ref(), k, seed_mode, n_iter, print_mode); - - if(status) - { - means = model.means; - } - else - { - means.soft_reset(); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_kron.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_kron.hpp deleted file mode 100644 index 4e4956101..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_kron.hpp +++ /dev/null @@ -1,104 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_kron -//! @{ - - - -template -arma_warn_unused -arma_inline -const Glue -kron(const Base& A, const Base& B) - { - arma_debug_sigprint(); - - return Glue(A.get_ref(), B.get_ref()); - } - - - -template -arma_warn_unused -inline -Mat::eT> -kron(const Base,T1>& X, const Base& Y) - { - arma_debug_sigprint(); - - typedef typename std::complex eT1; - - promote_type::check(); - - const quasi_unwrap tmp1(X.get_ref()); - const quasi_unwrap tmp2(Y.get_ref()); - - const Mat& A = tmp1.M; - const Mat& B = tmp2.M; - - Mat out; - - glue_kron::direct_kron(out, A, B); - - return out; - } - - - -template -arma_warn_unused -inline -Mat::eT> -kron(const Base& X, const Base,T2>& Y) - { - arma_debug_sigprint(); - - typedef typename std::complex eT2; - - promote_type::check(); - - const quasi_unwrap tmp1(X.get_ref()); - const quasi_unwrap tmp2(Y.get_ref()); - - const Mat& A = tmp1.M; - const Mat& B = tmp2.M; - - Mat out; - - glue_kron::direct_kron(out, A, B); - - return out; - } - - - -template -arma_warn_unused -arma_inline -const SpGlue -kron(const SpBase& A, const SpBase& B) - { - arma_debug_sigprint(); - - return SpGlue(A.get_ref(), B.get_ref()); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_log_det.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_log_det.hpp deleted file mode 100644 index b94c0f4db..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_log_det.hpp +++ /dev/null @@ -1,157 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_log_det -//! @{ - - - -//! log determinant of mat -template -inline -bool -log_det - ( - typename T1::elem_type& out_val, - typename T1::pod_type& out_sign, - const Base& X, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const bool status = op_log_det::apply_direct(out_val, out_sign, X.get_ref()); - - if(status == false) - { - out_val = eT(Datum::nan); - out_sign = T(0); - - arma_warn(3, "log_det(): failed to find determinant"); - } - - return status; - } - - - -template -arma_warn_unused -inline -std::complex -log_det - ( - const Base& X, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - eT out_val = eT(0); - T out_sign = T(0); - - const bool status = op_log_det::apply_direct(out_val, out_sign, X.get_ref()); - - if(status == false) - { - out_val = eT(Datum::nan); - out_sign = T(0); - - arma_stop_runtime_error("log_det(): failed to find determinant"); - } - - return (out_sign >= T(1)) ? std::complex(out_val) : (out_val + std::complex(T(0),Datum::pi)); - } - - - -// - - - -template -inline -bool -log_det_sympd - ( - typename T1::pod_type& out_val, - const Base& X, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::pod_type T; - - out_val = T(0); - - const bool status = op_log_det_sympd::apply_direct(out_val, X.get_ref()); - - if(status == false) - { - out_val = Datum::nan; - - arma_warn(3, "log_det_sympd(): given matrix is not symmetric positive definite"); - } - - return status; - } - - - -template -arma_warn_unused -inline -typename T1::pod_type -log_det_sympd - ( - const Base& X, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::pod_type T; - - T out_val = T(0); - - const bool status = op_log_det_sympd::apply_direct(out_val, X.get_ref()); - - if(status == false) - { - out_val = Datum::nan; - - arma_stop_runtime_error("log_det_sympd(): given matrix is not symmetric positive definite"); - } - - return out_val; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_log_normpdf.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_log_normpdf.hpp deleted file mode 100644 index 651846e6a..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_log_normpdf.hpp +++ /dev/null @@ -1,205 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_log_normpdf -//! @{ - - - -template -inline -typename enable_if2< (is_real::value), void >::result -log_normpdf_helper(Mat& out, const Base& X_expr, const Base& M_expr, const Base& S_expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(Proxy::use_at || Proxy::use_at || Proxy::use_at) - { - const quasi_unwrap UX(X_expr.get_ref()); - const quasi_unwrap UM(M_expr.get_ref()); - const quasi_unwrap US(S_expr.get_ref()); - - log_normpdf_helper(out, UX.M, UM.M, US.M); - - return; - } - - const Proxy PX(X_expr.get_ref()); - const Proxy PM(M_expr.get_ref()); - const Proxy PS(S_expr.get_ref()); - - arma_conform_check( ( (PX.get_n_rows() != PM.get_n_rows()) || (PX.get_n_cols() != PM.get_n_cols()) || (PM.get_n_rows() != PS.get_n_rows()) || (PM.get_n_cols() != PS.get_n_cols()) ), "log_normpdf(): size mismatch" ); - - out.set_size(PX.get_n_rows(), PX.get_n_cols()); - - eT* out_mem = out.memptr(); - - const uword N = PX.get_n_elem(); - - typename Proxy::ea_type X_ea = PX.get_ea(); - typename Proxy::ea_type M_ea = PM.get_ea(); - typename Proxy::ea_type S_ea = PS.get_ea(); - - const bool use_mp = arma_config::openmp && mp_gate::eval(N); - - if(use_mp) - { - #if defined(ARMA_USE_OPENMP) - { - const int n_threads = mp_thread_limit::get(); - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword i=0; i::log_sqrt2pi); - } - } - #endif - } - else - { - for(uword i=0; i::log_sqrt2pi); - } - } - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_real::value), eT >::result -log_normpdf(const eT x) - { - const eT out = (eT(-0.5) * (x*x)) - Datum::log_sqrt2pi; - - return out; - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_real::value), eT >::result -log_normpdf(const eT x, const eT mu, const eT sigma) - { - const eT tmp = (x - mu) / sigma; - - const eT out = (eT(-0.5) * (tmp*tmp)) - (std::log(sigma) + Datum::log_sqrt2pi); - - return out; - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_real::value), Mat >::result -log_normpdf(const eT x, const Base& M_expr, const Base& S_expr) - { - arma_debug_sigprint(); - - const quasi_unwrap UM(M_expr.get_ref()); - const Mat& M = UM.M; - - Mat out; - - log_normpdf_helper(out, x*ones< Mat >(arma::size(M)), M, S_expr.get_ref()); - - return out; - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_real::value), Mat >::result -log_normpdf(const Base& X_expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap UX(X_expr.get_ref()); - const Mat& X = UX.M; - - Mat out; - - log_normpdf_helper(out, X, zeros< Mat >(arma::size(X)), ones< Mat >(arma::size(X))); - - return out; - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_real::value), Mat >::result -log_normpdf(const Base& X_expr, const typename T1::elem_type mu, const typename T1::elem_type sigma) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap UX(X_expr.get_ref()); - const Mat& X = UX.M; - - Mat out; - - log_normpdf_helper(out, X, mu*ones< Mat >(arma::size(X)), sigma*ones< Mat >(arma::size(X))); - - return out; - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_real::value), Mat >::result -log_normpdf(const Base& X_expr, const Base& M_expr, const Base& S_expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - Mat out; - - log_normpdf_helper(out, X_expr.get_ref(), M_expr.get_ref(), S_expr.get_ref()); - - return out; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_logmat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_logmat.hpp deleted file mode 100644 index f7ea56d06..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_logmat.hpp +++ /dev/null @@ -1,127 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_logmat -//! @{ - - - -template -arma_warn_unused -arma_inline -typename enable_if2< (is_supported_blas_type::value && is_cx::no), const mtOp, T1, op_logmat> >::result -logmat(const Base& X, const uword n_iters = 100u) - { - arma_debug_sigprint(); - - return mtOp, T1, op_logmat>(X.get_ref(), n_iters, uword(0)); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< (is_supported_blas_type::value && is_cx::yes), const Op >::result -logmat(const Base& X, const uword n_iters = 100u) - { - arma_debug_sigprint(); - - return Op(X.get_ref(), n_iters, uword(0)); - } - - - -template -inline -typename enable_if2< (is_supported_blas_type::value && is_cx::no), bool >::result -logmat(Mat< std::complex >& Y, const Base& X, const uword n_iters = 100u) - { - arma_debug_sigprint(); - - const bool status = op_logmat::apply_direct(Y, X.get_ref(), n_iters); - - if(status == false) - { - Y.soft_reset(); - arma_warn(3, "logmat(): transformation failed"); - } - - return status; - } - - - -template -inline -typename enable_if2< (is_supported_blas_type::value && is_cx::yes), bool >::result -logmat(Mat& Y, const Base& X, const uword n_iters = 100u) - { - arma_debug_sigprint(); - - const bool status = op_logmat_cx::apply_direct(Y, X.get_ref(), n_iters); - - if(status == false) - { - Y.soft_reset(); - arma_warn(3, "logmat(): transformation failed"); - } - - return status; - } - - - -// - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_supported_blas_type::value, const Op >::result -logmat_sympd(const Base& X) - { - arma_debug_sigprint(); - - return Op(X.get_ref()); - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -logmat_sympd(Mat& Y, const Base& X) - { - arma_debug_sigprint(); - - const bool status = op_logmat_sympd::apply_direct(Y, X.get_ref()); - - if(status == false) - { - Y.soft_reset(); - arma_warn(3, "logmat_sympd(): transformation failed"); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_lu.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_lu.hpp deleted file mode 100644 index 2a08b1839..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_lu.hpp +++ /dev/null @@ -1,88 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_lu -//! @{ - - - -//! immediate lower upper decomposition, permutation info is embedded into L (similar to Matlab/Octave) -template -inline -bool -lu - ( - Mat& L, - Mat& U, - const Base& X, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - arma_conform_check( (&L == &U), "lu(): L and U are the same object" ); - - const bool status = auxlib::lu(L, U, X); - - if(status == false) - { - L.soft_reset(); - U.soft_reset(); - arma_warn(3, "lu(): decomposition failed"); - } - - return status; - } - - - -//! immediate lower upper decomposition, also providing the permutation matrix -template -inline -bool -lu - ( - Mat& L, - Mat& U, - Mat& P, - const Base& X, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - arma_conform_check( ( (&L == &U) || (&L == &P) || (&U == &P) ), "lu(): two or more output objects are the same object" ); - - const bool status = auxlib::lu(L, U, P, X); - - if(status == false) - { - L.soft_reset(); - U.soft_reset(); - P.soft_reset(); - arma_warn(3, "lu(): decomposition failed"); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_max.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_max.hpp deleted file mode 100644 index 39337b221..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_max.hpp +++ /dev/null @@ -1,277 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_max -//! @{ - - -template -arma_warn_unused -inline -typename enable_if2< is_arma_type::value && resolves_to_vector::yes, typename T1::elem_type >::result -max(const T1& X) - { - arma_debug_sigprint(); - - return op_max::max(X); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value && resolves_to_vector::no, const Op >::result -max(const T1& X) - { - arma_debug_sigprint(); - - return Op(X, 0, 0); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const Op >::result -max(const T1& X, const uword dim) - { - arma_debug_sigprint(); - - return Op(X, dim, 0); - } - - - -template -arma_warn_unused -arma_inline -typename arma_scalar_only::result -max(const T& x) - { - return x; - } - - - -//! element-wise maximum -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - ( is_arma_type::value && is_arma_type::value && is_same_type::value ), - const Glue - >::result -max - ( - const T1& X, - const T2& Y - ) - { - arma_debug_sigprint(); - - return Glue(X, Y); - } - - - -template -arma_warn_unused -arma_inline -const OpCube -max - ( - const BaseCube& X, - const uword dim = 0 - ) - { - arma_debug_sigprint(); - - return OpCube(X.get_ref(), dim, 0); - } - - - -template -arma_warn_unused -arma_inline -const GlueCube -max - ( - const BaseCube& X, - const BaseCube& Y - ) - { - arma_debug_sigprint(); - - return GlueCube(X.get_ref(), Y.get_ref()); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value && resolves_to_sparse_vector::yes, - typename T1::elem_type - >::result -max(const T1& x) - { - arma_debug_sigprint(); - - return op_sp_max::vector_max(x); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value && resolves_to_sparse_vector::no, - const mtSpReduceOp - >::result -max(const T1& X) - { - arma_debug_sigprint(); - - return mtSpReduceOp(X, 0, 0); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value, - const mtSpReduceOp - >::result -max(const T1& X, const uword dim) - { - arma_debug_sigprint(); - - return mtSpReduceOp(X, dim, 0); - } - - - -// elementwise sparse max -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_sparse_type::value && is_same_type::value), - const SpGlue - >::result -max(const T1& x, const T2& y) - { - arma_debug_sigprint(); - - return SpGlue(x, y); - } - - - -//! elementwise max of dense and sparse objects with the same element type -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_sparse_type::value && is_same_type::value), - Mat - >::result -max - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - Mat out; - - spglue_max::dense_sparse_max(out, x, y); - - return out; - } - - - -//! elementwise max of sparse and dense objects with the same element type -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_type::value && is_same_type::value), - Mat - >::result -max - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - Mat out; - - // Just call the other order (these operations are commutative) - // TODO: if there is a matrix size mismatch, the debug assert will print the matrix sizes in wrong order - spglue_max::dense_sparse_max(out, y, x); - - return out; - } - - - -arma_warn_unused -inline -uword -max(const SizeMat& s) - { - return (std::max)(s.n_rows, s.n_cols); - } - - - -arma_warn_unused -inline -uword -max(const SizeCube& s) - { - return (std::max)( (std::max)(s.n_rows, s.n_cols), s.n_slices ); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_mean.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_mean.hpp deleted file mode 100644 index 23416280e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_mean.hpp +++ /dev/null @@ -1,145 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_mean -//! @{ - - - -template -arma_warn_unused -inline -typename enable_if2< is_arma_type::value && resolves_to_vector::yes, typename T1::elem_type >::result -mean(const T1& X) - { - arma_debug_sigprint(); - - return op_mean::mean_all(X); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value && resolves_to_vector::no, const Op >::result -mean(const T1& X) - { - arma_debug_sigprint(); - - return Op(X, 0, 0); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const Op >::result -mean(const T1& X, const uword dim) - { - arma_debug_sigprint(); - - return Op(X, dim, 0); - } - - - -template -arma_warn_unused -arma_inline -typename arma_scalar_only::result -mean(const T& x) - { - return x; - } - - - -template -arma_warn_unused -arma_inline -const OpCube -mean - ( - const BaseCube& X, - const uword dim = 0 - ) - { - arma_debug_sigprint(); - - return OpCube(X.get_ref(), dim, 0); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value && resolves_to_sparse_vector::yes, - typename T1::elem_type - >::result -mean(const T1& x) - { - arma_debug_sigprint(); - - return op_sp_mean::mean_all(x); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value && resolves_to_sparse_vector::no, - const mtSpReduceOp - >::result -mean(const T1& x) - { - arma_debug_sigprint(); - - return mtSpReduceOp(x, 0, 0); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value, - const mtSpReduceOp - >::result -mean(const T1& x, const uword dim) - { - arma_debug_sigprint(); - - return mtSpReduceOp(x, dim, 0); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_median.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_median.hpp deleted file mode 100644 index 80a7d7aea..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_median.hpp +++ /dev/null @@ -1,73 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_median -//! @{ - - -template -arma_warn_unused -inline -typename enable_if2< is_arma_type::value && resolves_to_vector::yes, typename T1::elem_type >::result -median(const T1& X) - { - arma_debug_sigprint(); - - return op_median::median_vec(X); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value && resolves_to_vector::no, const Op >::result -median(const T1& X) - { - arma_debug_sigprint(); - - return Op(X, 0, 0); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const Op >::result -median(const T1& X, const uword dim) - { - arma_debug_sigprint(); - - return Op(X, dim, 0); - } - - - -template -arma_warn_unused -arma_inline -typename arma_scalar_only::result -median(const T& x) - { - return x; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_min.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_min.hpp deleted file mode 100644 index f5f230e2f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_min.hpp +++ /dev/null @@ -1,277 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_min -//! @{ - - -template -arma_warn_unused -inline -typename enable_if2< is_arma_type::value && resolves_to_vector::yes, typename T1::elem_type >::result -min(const T1& X) - { - arma_debug_sigprint(); - - return op_min::min(X); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value && resolves_to_vector::no, const Op >::result -min(const T1& X) - { - arma_debug_sigprint(); - - return Op(X, 0, 0); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const Op >::result -min(const T1& X, const uword dim) - { - arma_debug_sigprint(); - - return Op(X, dim, 0); - } - - - -template -arma_warn_unused -arma_inline -typename arma_scalar_only::result -min(const T& x) - { - return x; - } - - - -//! element-wise minimum -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - ( is_arma_type::value && is_arma_type::value && is_same_type::value ), - const Glue - >::result -min - ( - const T1& X, - const T2& Y - ) - { - arma_debug_sigprint(); - - return Glue(X, Y); - } - - - -template -arma_warn_unused -arma_inline -const OpCube -min - ( - const BaseCube& X, - const uword dim = 0 - ) - { - arma_debug_sigprint(); - - return OpCube(X.get_ref(), dim, 0); - } - - - -template -arma_warn_unused -arma_inline -const GlueCube -min - ( - const BaseCube& X, - const BaseCube& Y - ) - { - arma_debug_sigprint(); - - return GlueCube(X.get_ref(), Y.get_ref()); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value && resolves_to_sparse_vector::yes, - typename T1::elem_type - >::result -min(const T1& x) - { - arma_debug_sigprint(); - - return op_sp_min::vector_min(x); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value && resolves_to_sparse_vector::no, - const mtSpReduceOp - >::result -min(const T1& X) - { - arma_debug_sigprint(); - - return mtSpReduceOp(X, 0, 0); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value, - const mtSpReduceOp - >::result -min(const T1& X, const uword dim) - { - arma_debug_sigprint(); - - return mtSpReduceOp(X, dim, 0); - } - - - -// elementwise sparse min -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_sparse_type::value && is_same_type::value), - const SpGlue - >::result -min(const T1& x, const T2& y) - { - arma_debug_sigprint(); - - return SpGlue(x, y); - } - - - -//! elementwise min of dense and sparse objects with the same element type -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_sparse_type::value && is_same_type::value), - Mat - >::result -min - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - Mat out; - - spglue_min::dense_sparse_min(out, x, y); - - return out; - } - - - -//! elementwise min of sparse and dense objects with the same element type -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_type::value && is_same_type::value), - Mat - >::result -min - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - Mat out; - - // Just call the other order (these operations are commutative) - // TODO: if there is a matrix size mismatch, the debug assert will print the matrix sizes in wrong order - spglue_min::dense_sparse_min(out, y, x); - - return out; - } - - - -arma_warn_unused -inline -uword -min(const SizeMat& s) - { - return (std::min)(s.n_rows, s.n_cols); - } - - - -arma_warn_unused -inline -uword -min(const SizeCube& s) - { - return (std::min)( (std::min)(s.n_rows, s.n_cols), s.n_slices ); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_misc.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_misc.hpp deleted file mode 100644 index d441b26da..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_misc.hpp +++ /dev/null @@ -1,587 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_misc -//! @{ - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_Mat::value, - out_type - >::result -linspace - ( - const typename out_type::pod_type start, - const typename out_type::pod_type end, - const uword num = 100u - ) - { - arma_debug_sigprint(); - - typedef typename out_type::elem_type eT; - typedef typename out_type::pod_type T; - - out_type x; - - if(num == 1) - { - x.set_size(1); - - x[0] = eT(end); - } - else - if(num >= 2) - { - x.set_size(num); - - eT* x_mem = x.memptr(); - - const uword num_m1 = num - 1; - - if(is_non_integral::value) - { - const T delta = (end-start)/T(num_m1); - - for(uword i=0; i= start) ? double(end-start)/double(num_m1) : -double(start-end)/double(num_m1); - - for(uword i=0; i(start, end, num); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_Mat::value && is_real::value), - out_type - >::result -logspace - ( - const typename out_type::pod_type A, - const typename out_type::pod_type B, - const uword N = 50u - ) - { - arma_debug_sigprint(); - - typedef typename out_type::elem_type eT; - typedef typename out_type::pod_type T; - - out_type x = linspace(A,B,N); - - const uword n_elem = x.n_elem; - - eT* x_mem = x.memptr(); - - for(uword i=0; i < n_elem; ++i) - { - x_mem[i] = std::pow(T(10), x_mem[i]); - } - - return x; - } - - - -arma_warn_unused -inline -vec -logspace(const double A, const double B, const uword N = 50u) - { - arma_debug_sigprint(); - return logspace(A, B, N); - } - - - -// -// log_exp_add - -template -arma_warn_unused -inline -typename arma_real_only::result -log_add_exp(eT log_a, eT log_b) - { - if(log_a < log_b) - { - std::swap(log_a, log_b); - } - - const eT negdelta = log_b - log_a; - - if( (negdelta < Datum::log_min) || (arma_isfinite(negdelta) == false) ) - { - return log_a; - } - else - { - return (log_a + std::log1p(std::exp(negdelta))); - } - } - - - -// for compatibility with earlier versions -template -arma_warn_unused -inline -typename arma_real_only::result -log_add(eT log_a, eT log_b) - { - return log_add_exp(log_a, log_b); - } - - - -//! kept for compatibility with old user code -template -arma_warn_unused -arma_inline -bool -is_finite(const eT x, const typename arma_scalar_only::result* junk = nullptr) - { - arma_ignore(junk); - - return arma_isfinite(x); - } - - - -//! kept for compatibility with old user code -template -arma_warn_unused -inline -bool -is_finite(const Base& X) - { - arma_debug_sigprint(); - - return X.is_finite(); - } - - - -//! kept for compatibility with old user code -template -arma_warn_unused -inline -bool -is_finite(const SpBase& X) - { - arma_debug_sigprint(); - - return X.is_finite(); - } - - - -//! kept for compatibility with old user code -template -arma_warn_unused -inline -bool -is_finite(const BaseCube& X) - { - arma_debug_sigprint(); - - return X.is_finite(); - } - - - -template -inline -void -swap(Mat& A, Mat& B) - { - arma_debug_sigprint(); - - A.swap(B); - } - - - -template -inline -void -swap(Cube& A, Cube& B) - { - arma_debug_sigprint(); - - A.swap(B); - } - - - -arma_warn_unused -inline -uvec -ind2sub(const SizeMat& s, const uword i) - { - arma_debug_sigprint(); - - const uword s_n_rows = s.n_rows; - - arma_conform_check( (i >= (s_n_rows * s.n_cols) ), "ind2sub(): index out of range" ); - - const uword row = i % s_n_rows; - const uword col = i / s_n_rows; - - uvec out(2, arma_nozeros_indicator()); - - uword* out_mem = out.memptr(); - - out_mem[0] = row; - out_mem[1] = col; - - return out; - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_arma_type::value && is_same_type::yes), umat >::result -ind2sub(const SizeMat& s, const T1& indices) - { - arma_debug_sigprint(); - - const uword s_n_rows = s.n_rows; - const uword s_n_elem = s_n_rows * s.n_cols; - - const Proxy P(indices); - - const uword P_n_rows = P.get_n_rows(); - const uword P_n_cols = P.get_n_cols(); - const uword P_n_elem = P.get_n_elem(); - - const bool P_is_empty = (P_n_elem == 0); - const bool P_is_vec = ((P_n_rows == 1) || (P_n_cols == 1)); - - arma_conform_check( ((P_is_empty == false) && (P_is_vec == false)), "ind2sub(): parameter 'indices' must be a vector" ); - - umat out(2, P_n_elem, arma_nozeros_indicator()); - - if(Proxy::use_at == false) - { - typename Proxy::ea_type Pea = P.get_ea(); - - for(uword count=0; count < P_n_elem; ++count) - { - const uword i = Pea[count]; - - arma_conform_check( (i >= s_n_elem), "ind2sub(): index out of range" ); - - const uword row = i % s_n_rows; - const uword col = i / s_n_rows; - - uword* out_colptr = out.colptr(count); - - out_colptr[0] = row; - out_colptr[1] = col; - } - } - else - { - if(P_n_rows == 1) - { - for(uword count=0; count < P_n_cols; ++count) - { - const uword i = P.at(0,count); - - arma_conform_check( (i >= s_n_elem), "ind2sub(): index out of range" ); - - const uword row = i % s_n_rows; - const uword col = i / s_n_rows; - - uword* out_colptr = out.colptr(count); - - out_colptr[0] = row; - out_colptr[1] = col; - } - } - else - if(P_n_cols == 1) - { - for(uword count=0; count < P_n_rows; ++count) - { - const uword i = P.at(count,0); - - arma_conform_check( (i >= s_n_elem), "ind2sub(): index out of range" ); - - const uword row = i % s_n_rows; - const uword col = i / s_n_rows; - - uword* out_colptr = out.colptr(count); - - out_colptr[0] = row; - out_colptr[1] = col; - } - } - } - - return out; - } - - - -arma_warn_unused -inline -uvec -ind2sub(const SizeCube& s, const uword i) - { - arma_debug_sigprint(); - - const uword s_n_rows = s.n_rows; - const uword s_n_elem_slice = s_n_rows * s.n_cols; - - arma_conform_check( (i >= (s_n_elem_slice * s.n_slices) ), "ind2sub(): index out of range" ); - - const uword slice = i / s_n_elem_slice; - const uword j = i - (slice * s_n_elem_slice); - const uword row = j % s_n_rows; - const uword col = j / s_n_rows; - - uvec out(3, arma_nozeros_indicator()); - - uword* out_mem = out.memptr(); - - out_mem[0] = row; - out_mem[1] = col; - out_mem[2] = slice; - - return out; - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_arma_type::value && is_same_type::yes), umat >::result -ind2sub(const SizeCube& s, const T1& indices) - { - arma_debug_sigprint(); - - const uword s_n_rows = s.n_rows; - const uword s_n_elem_slice = s_n_rows * s.n_cols; - const uword s_n_elem = s.n_slices * s_n_elem_slice; - - const quasi_unwrap U(indices); - - arma_conform_check( ((U.M.is_empty() == false) && (U.M.is_vec() == false)), "ind2sub(): parameter 'indices' must be a vector" ); - - const uword U_n_elem = U.M.n_elem; - const uword* U_mem = U.M.memptr(); - - umat out(3, U_n_elem, arma_nozeros_indicator()); - - for(uword count=0; count < U_n_elem; ++count) - { - const uword i = U_mem[count]; - - arma_conform_check( (i >= s_n_elem), "ind2sub(): index out of range" ); - - const uword slice = i / s_n_elem_slice; - const uword j = i - (slice * s_n_elem_slice); - const uword row = j % s_n_rows; - const uword col = j / s_n_rows; - - uword* out_colptr = out.colptr(count); - - out_colptr[0] = row; - out_colptr[1] = col; - out_colptr[2] = slice; - } - - return out; - } - - - -arma_warn_unused -arma_inline -uword -sub2ind(const SizeMat& s, const uword row, const uword col) - { - arma_debug_sigprint(); - - const uword s_n_rows = s.n_rows; - - arma_conform_check( ((row >= s_n_rows) || (col >= s.n_cols)), "sub2ind(): subscript out of range" ); - - return uword(row + col*s_n_rows); - } - - - -template -arma_warn_unused -inline -uvec -sub2ind(const SizeMat& s, const Base& subscripts) - { - arma_debug_sigprint(); - - const uword s_n_rows = s.n_rows; - const uword s_n_cols = s.n_cols; - - const quasi_unwrap U(subscripts.get_ref()); - - arma_conform_check( (U.M.n_rows != 2), "sub2ind(): matrix of subscripts must have 2 rows" ); - - const uword U_M_n_cols = U.M.n_cols; - - uvec out(U_M_n_cols, arma_nozeros_indicator()); - - uword* out_mem = out.memptr(); - const uword* U_M_mem = U.M.memptr(); - - for(uword count=0; count < U_M_n_cols; ++count) - { - const uword row = U_M_mem[0]; - const uword col = U_M_mem[1]; - - U_M_mem += 2; // next column - - arma_conform_check( ((row >= s_n_rows) || (col >= s_n_cols)), "sub2ind(): subscript out of range" ); - - out_mem[count] = uword(row + col*s_n_rows); - } - - return out; - } - - - -arma_warn_unused -arma_inline -uword -sub2ind(const SizeCube& s, const uword row, const uword col, const uword slice) - { - arma_debug_sigprint(); - - const uword s_n_rows = s.n_rows; - const uword s_n_cols = s.n_cols; - - arma_conform_check( ((row >= s_n_rows) || (col >= s_n_cols) || (slice >= s.n_slices)), "sub2ind(): subscript out of range" ); - - return uword( (slice * s_n_rows * s_n_cols) + (col * s_n_rows) + row ); - } - - - -template -arma_warn_unused -inline -uvec -sub2ind(const SizeCube& s, const Base& subscripts) - { - arma_debug_sigprint(); - - const uword s_n_rows = s.n_rows; - const uword s_n_cols = s.n_cols; - const uword s_n_slices = s.n_slices; - - const quasi_unwrap U(subscripts.get_ref()); - - arma_conform_check( (U.M.n_rows != 3), "sub2ind(): matrix of subscripts must have 3 rows" ); - - const uword U_M_n_cols = U.M.n_cols; - - uvec out(U_M_n_cols, arma_nozeros_indicator()); - - uword* out_mem = out.memptr(); - const uword* U_M_mem = U.M.memptr(); - - for(uword count=0; count < U_M_n_cols; ++count) - { - const uword row = U_M_mem[0]; - const uword col = U_M_mem[1]; - const uword slice = U_M_mem[2]; - - U_M_mem += 3; // next column - - arma_conform_check( ((row >= s_n_rows) || (col >= s_n_cols) || (slice >= s_n_slices)), "sub2ind(): subscript out of range" ); - - out_mem[count] = uword( (slice * s_n_rows * s_n_cols) + (col * s_n_rows) + row ); - } - - return out; - } - - - -template -arma_inline -typename -enable_if2 - < - (is_arma_type::value && is_same_type::value), - const Glue - >::result -affmul(const T1& A, const T2& B) - { - arma_debug_sigprint(); - - return Glue(A,B); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_mvnrnd.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_mvnrnd.hpp deleted file mode 100644 index a2814d378..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_mvnrnd.hpp +++ /dev/null @@ -1,110 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_mvnrnd -//! @{ - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_real::value, - const Glue - >::result -mvnrnd(const Base& M, const Base& C) - { - arma_debug_sigprint(); - - return Glue(M.get_ref(), C.get_ref()); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_real::value, - const Glue - >::result -mvnrnd(const Base& M, const Base& C, const uword N) - { - arma_debug_sigprint(); - - return Glue(M.get_ref(), C.get_ref(), N); - } - - - -template -inline -typename -enable_if2 - < - is_real::value, - bool - >::result -mvnrnd(Mat& out, const Base& M, const Base& C) - { - arma_debug_sigprint(); - - const bool status = glue_mvnrnd::apply_direct(out, M.get_ref(), C.get_ref(), uword(1)); - - if(status == false) - { - out.soft_reset(); - arma_warn(3, "mvnrnd(): given covariance matrix is not symmetric positive semi-definite"); - } - - return status; - } - - - -template -inline -typename -enable_if2 - < - is_real::value, - bool - >::result -mvnrnd(Mat& out, const Base& M, const Base& C, const uword N) - { - arma_debug_sigprint(); - - const bool status = glue_mvnrnd::apply_direct(out, M.get_ref(), C.get_ref(), N); - - if(status == false) - { - out.soft_reset(); - arma_warn(3, "mvnrnd(): given covariance matrix is not symmetric positive semi-definite"); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_n_unique.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_n_unique.hpp deleted file mode 100644 index a7e5de6de..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_n_unique.hpp +++ /dev/null @@ -1,132 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_n_unique -//! @{ - - -//! \brief -//! Get the number of unique nonzero elements in two sparse matrices. -//! This is very useful for determining the amount of memory necessary before -//! a sparse matrix operation on two matrices. - -template -inline -uword -n_unique - ( - const SpBase& x, - const SpBase& y, - const op_n_unique_type junk - ) - { - arma_debug_sigprint(); - - const SpProxy pa(x.get_ref()); - const SpProxy pb(y.get_ref()); - - return n_unique(pa,pb,junk); - } - - - -template -arma_hot -inline -uword -n_unique - ( - const SpProxy& pa, - const SpProxy& pb, - const op_n_unique_type junk - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typename SpProxy::const_iterator_type x_it = pa.begin(); - typename SpProxy::const_iterator_type x_it_end = pa.end(); - - typename SpProxy::const_iterator_type y_it = pb.begin(); - typename SpProxy::const_iterator_type y_it_end = pb.end(); - - uword total_n_nonzero = 0; - - while( (x_it != x_it_end) || (y_it != y_it_end) ) - { - if(x_it == y_it) - { - if(op_n_unique_type::eval((*x_it), (*y_it)) != typename T1::elem_type(0)) - { - ++total_n_nonzero; - } - - ++x_it; - ++y_it; - } - else - { - if((x_it.col() < y_it.col()) || ((x_it.col() == y_it.col()) && (x_it.row() < y_it.row()))) // if y is closer to the end - { - if(op_n_unique_type::eval((*x_it), typename T1::elem_type(0)) != typename T1::elem_type(0)) - { - ++total_n_nonzero; - } - - ++x_it; - } - else // x is closer to the end - { - if(op_n_unique_type::eval(typename T1::elem_type(0), (*y_it)) != typename T1::elem_type(0)) - { - ++total_n_nonzero; - } - - ++y_it; - } - } - } - - return total_n_nonzero; - } - - -// Simple operators. -struct op_n_unique_add - { - template inline static eT eval(const eT& l, const eT& r) { return (l + r); } - }; - -struct op_n_unique_sub - { - template inline static eT eval(const eT& l, const eT& r) { return (l - r); } - }; - -struct op_n_unique_mul - { - template inline static eT eval(const eT& l, const eT& r) { return (l * r); } - }; - -struct op_n_unique_count - { - template inline static eT eval(const eT&, const eT&) { return eT(1); } - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_nonzeros.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_nonzeros.hpp deleted file mode 100644 index b724444ab..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_nonzeros.hpp +++ /dev/null @@ -1,49 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_nonzeros -//! @{ - - -template -arma_warn_unused -inline -const Op -nonzeros(const Base& X) - { - arma_debug_sigprint(); - - return Op(X.get_ref()); - } - - - -template -arma_warn_unused -inline -const SpToDOp -nonzeros(const SpBase& X) - { - arma_debug_sigprint(); - - return SpToDOp(X.get_ref()); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_norm.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_norm.hpp deleted file mode 100644 index bf17bafa0..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_norm.hpp +++ /dev/null @@ -1,342 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_norm -//! @{ - - - -template -arma_warn_unused -inline -typename enable_if2< is_arma_type::value, typename T1::pod_type >::result -norm - ( - const T1& X, - const uword k = uword(2), - const typename arma_real_or_cx_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::pod_type T; - - const Proxy P(X); - - if(P.get_n_elem() == 0) { return T(0); } - - const bool is_vec = (T1::is_xvec) || (T1::is_row) || (T1::is_col) || (P.get_n_rows() == 1) || (P.get_n_cols() == 1); - - if(is_vec) - { - if(k == uword(1)) { return op_norm::vec_norm_1(P); } - if(k == uword(2)) { return op_norm::vec_norm_2(P); } - - arma_conform_check( (k == 0), "norm(): unsupported vector norm type" ); - - return op_norm::vec_norm_k(P, int(k)); - } - else - { - const quasi_unwrap::stored_type> U(P.Q); - - if(k == uword(1)) { return op_norm::mat_norm_1(U.M); } - if(k == uword(2)) { return op_norm::mat_norm_2(U.M); } - - arma_stop_logic_error("norm(): unsupported matrix norm type"); - } - - return T(0); - } - - - -template -arma_warn_unused -inline -typename enable_if2< is_arma_type::value, typename T1::pod_type >::result -norm - ( - const T1& X, - const char* method, - const typename arma_real_or_cx_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::pod_type T; - - const Proxy P(X); - - if(P.get_n_elem() == 0) { return T(0); } - - const char sig = (method != nullptr) ? method[0] : char(0); - const bool is_vec = (T1::is_xvec) || (T1::is_row) || (T1::is_col) || (P.get_n_rows() == 1) || (P.get_n_cols() == 1); - - if(is_vec) - { - if( (sig == 'i') || (sig == 'I') || (sig == '+') ) { return op_norm::vec_norm_max(P); } - if( (sig == '-') ) { return op_norm::vec_norm_min(P); } - if( (sig == 'f') || (sig == 'F') ) { return op_norm::vec_norm_2(P); } - - arma_stop_logic_error("norm(): unsupported vector norm type"); - } - else - { - if( (sig == 'i') || (sig == 'I') || (sig == '+') ) // inf norm - { - const quasi_unwrap::stored_type> U(P.Q); - - return op_norm::mat_norm_inf(U.M); - } - else - if( (sig == 'f') || (sig == 'F') ) - { - return op_norm::vec_norm_2(P); - } - - arma_stop_logic_error("norm(): unsupported matrix norm type"); - } - - return T(0); - } - - - -template -arma_warn_unused -inline -typename enable_if2< is_arma_type::value, double >::result -norm - ( - const T1& X, - const uword k = uword(2), - const typename arma_integral_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - if(resolves_to_colvector::value) { return norm(conv_to< Col >::from(X), k); } - if(resolves_to_rowvector::value) { return norm(conv_to< Row >::from(X), k); } - - return norm(conv_to< Mat >::from(X), k); - } - - - -template -arma_warn_unused -inline -typename enable_if2< is_arma_type::value, double >::result -norm - ( - const T1& X, - const char* method, - const typename arma_integral_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - if(resolves_to_colvector::value) { return norm(conv_to< Col >::from(X), method); } - if(resolves_to_rowvector::value) { return norm(conv_to< Row >::from(X), method); } - - return norm(conv_to< Mat >::from(X), method); - } - - - -// -// norms for sparse matrices - - -template -arma_warn_unused -inline -typename enable_if2< is_arma_sparse_type::value, typename T1::pod_type >::result -norm - ( - const T1& expr, - const uword k = uword(2), - const typename arma_real_or_cx_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - if(is_SpSubview_col::value) - { - const SpSubview_col& sv = reinterpret_cast< const SpSubview_col& >(expr); - - if(sv.n_rows == sv.m.n_rows) - { - const SpMat& m = sv.m; - const uword col = sv.aux_col1; - const eT* mem = &(m.values[ m.col_ptrs[col] ]); - - return spop_norm::vec_norm_k(mem, sv.n_nonzero, k); - } - } - - const unwrap_spmat U(expr); - const SpMat& X = U.M; - - if(X.n_nonzero == 0) { return T(0); } - - const bool is_vec = (T1::is_xvec) || (T1::is_row) || (T1::is_col) || (X.n_rows == 1) || (X.n_cols == 1); - - if(is_vec) - { - return spop_norm::vec_norm_k(X.values, X.n_nonzero, k); - } - else - { - if(k == uword(1)) { return spop_norm::mat_norm_1(X); } - if(k == uword(2)) { return spop_norm::mat_norm_2(X); } - - arma_stop_logic_error("norm(): unsupported or unimplemented norm type for sparse matrices"); - } - - return T(0); - } - - - -template -arma_warn_unused -inline -typename enable_if2< is_arma_sparse_type::value, typename T1::pod_type >::result -norm - ( - const T1& expr, - const char* method, - const typename arma_real_or_cx_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const unwrap_spmat U(expr); - const SpMat& X = U.M; - - if(X.n_nonzero == 0) { return T(0); } - - // create a fake dense vector to allow reuse of code for dense vectors - Col fake_vector( access::rwp(X.values), X.n_nonzero, false ); - - const Proxy< Col > P_fake_vector(fake_vector); - - - const char sig = (method != nullptr) ? method[0] : char(0); - const bool is_vec = (T1::is_xvec) || (T1::is_row) || (T1::is_col) || (X.n_rows == 1) || (X.n_cols == 1); - - if(is_vec) - { - if( (sig == 'i') || (sig == 'I') || (sig == '+') ) // max norm - { - return op_norm::vec_norm_max(P_fake_vector); - } - else - if(sig == '-') // min norm - { - const T val = op_norm::vec_norm_min(P_fake_vector); - - return (X.n_nonzero < X.n_elem) ? T((std::min)(T(0), val)) : T(val); - } - else - if( (sig == 'f') || (sig == 'F') ) - { - return op_norm::vec_norm_2(P_fake_vector); - } - - arma_stop_logic_error("norm(): unsupported vector norm type"); - } - else - { - if( (sig == 'i') || (sig == 'I') || (sig == '+') ) // inf norm - { - return spop_norm::mat_norm_inf(X); - } - else - if( (sig == 'f') || (sig == 'F') ) - { - return op_norm::vec_norm_2(P_fake_vector); - } - - arma_stop_logic_error("norm(): unsupported matrix norm type"); - } - - return T(0); - } - - - -// -// approximate norms - - -template -arma_warn_unused -inline -typename T1::pod_type -norm2est - ( - const Base& X, - const typename T1::pod_type tolerance = 0, - const uword max_iter = 100, - const typename arma_real_or_cx_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return op_norm2est::norm2est(X.get_ref(), tolerance, max_iter); - } - - - -template -arma_warn_unused -inline -typename T1::pod_type -norm2est - ( - const SpBase& X, - const typename T1::pod_type tolerance = 0, - const uword max_iter = 100, - const typename arma_real_or_cx_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return op_norm2est::norm2est(X.get_ref(), tolerance, max_iter); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_normalise.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_normalise.hpp deleted file mode 100644 index 38295de20..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_normalise.hpp +++ /dev/null @@ -1,116 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_normalise -//! @{ - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::yes, - const Op - >::result -normalise - ( - const T1& X, - const uword p = uword(2), - const arma_empty_class junk1 = arma_empty_class(), - const typename arma_real_or_cx_only::result* junk2 = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - return Op(X, p, 0); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::no, - const Op - >::result -normalise - ( - const T1& X, - const uword p = uword(2), - const uword dim = 0, - const typename arma_real_or_cx_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return Op(X, p, dim); - } - - - -template -arma_warn_unused -inline -const SpOp -normalise - ( - const SpBase& expr, - const uword p = uword(2), - const uword dim = 0, - const typename arma_real_or_cx_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return SpOp(expr.get_ref(), p, dim); - } - - - -//! for compatibility purposes: allows compiling user code designed for earlier versions of Armadillo -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_supported_blas_type::value, - Col - >::result -normalise(const T& val) - { - Col out(1, arma_nozeros_indicator()); - - out[0] = (val != T(0)) ? T(val / (std::abs)(val)) : T(val); - - return out; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_normcdf.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_normcdf.hpp deleted file mode 100644 index d2d4e557d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_normcdf.hpp +++ /dev/null @@ -1,201 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_normcdf -//! @{ - - - -template -inline -typename enable_if2< (is_real::value), void >::result -normcdf_helper(Mat& out, const Base& X_expr, const Base& M_expr, const Base& S_expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(Proxy::use_at || Proxy::use_at || Proxy::use_at) - { - const quasi_unwrap UX(X_expr.get_ref()); - const quasi_unwrap UM(M_expr.get_ref()); - const quasi_unwrap US(S_expr.get_ref()); - - normcdf_helper(out, UX.M, UM.M, US.M); - - return; - } - - const Proxy PX(X_expr.get_ref()); - const Proxy PM(M_expr.get_ref()); - const Proxy PS(S_expr.get_ref()); - - arma_conform_check( ( (PX.get_n_rows() != PM.get_n_rows()) || (PX.get_n_cols() != PM.get_n_cols()) || (PM.get_n_rows() != PS.get_n_rows()) || (PM.get_n_cols() != PS.get_n_cols()) ), "normcdf(): size mismatch" ); - - out.set_size(PX.get_n_rows(), PX.get_n_cols()); - - eT* out_mem = out.memptr(); - - const uword N = PX.get_n_elem(); - - typename Proxy::ea_type X_ea = PX.get_ea(); - typename Proxy::ea_type M_ea = PM.get_ea(); - typename Proxy::ea_type S_ea = PS.get_ea(); - - const bool use_mp = arma_config::openmp && mp_gate::eval(N); - - if(use_mp) - { - #if defined(ARMA_USE_OPENMP) - { - const int n_threads = mp_thread_limit::get(); - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword i=0; i::sqrt2)); - - out_mem[i] = eT(0.5) * std::erfc(tmp); - } - } - #endif - } - else - { - for(uword i=0; i::sqrt2)); - - out_mem[i] = eT(0.5) * std::erfc(tmp); - } - } - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_real::value), eT >::result -normcdf(const eT x) - { - const eT out = eT(0.5) * std::erfc( x / (-Datum::sqrt2) ); - - return out; - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_real::value), eT >::result -normcdf(const eT x, const eT mu, const eT sigma) - { - const eT tmp = (x - mu) / (sigma * (-Datum::sqrt2)); - - const eT out = eT(0.5) * std::erfc(tmp); - - return out; - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_real::value), Mat >::result -normcdf(const eT x, const Base& M_expr, const Base& S_expr) - { - arma_debug_sigprint(); - - const quasi_unwrap UM(M_expr.get_ref()); - const Mat& M = UM.M; - - Mat out; - - normcdf_helper(out, x*ones< Mat >(arma::size(M)), M, S_expr.get_ref()); - - return out; - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_real::value), Mat >::result -normcdf(const Base& X_expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap UX(X_expr.get_ref()); - const Mat& X = UX.M; - - Mat out; - - normcdf_helper(out, X, zeros< Mat >(arma::size(X)), ones< Mat >(arma::size(X))); - - return out; - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_real::value), Mat >::result -normcdf(const Base& X_expr, const typename T1::elem_type mu, const typename T1::elem_type sigma) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap UX(X_expr.get_ref()); - const Mat& X = UX.M; - - Mat out; - - normcdf_helper(out, X, mu*ones< Mat >(arma::size(X)), sigma*ones< Mat >(arma::size(X))); - - return out; - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_real::value), Mat >::result -normcdf(const Base& X_expr, const Base& M_expr, const Base& S_expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - Mat out; - - normcdf_helper(out, X_expr.get_ref(), M_expr.get_ref(), S_expr.get_ref()); - - return out; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_normpdf.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_normpdf.hpp deleted file mode 100644 index a3edf3906..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_normpdf.hpp +++ /dev/null @@ -1,205 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_normpdf -//! @{ - - - -template -inline -typename enable_if2< (is_real::value), void >::result -normpdf_helper(Mat& out, const Base& X_expr, const Base& M_expr, const Base& S_expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(Proxy::use_at || Proxy::use_at || Proxy::use_at) - { - const quasi_unwrap UX(X_expr.get_ref()); - const quasi_unwrap UM(M_expr.get_ref()); - const quasi_unwrap US(S_expr.get_ref()); - - normpdf_helper(out, UX.M, UM.M, US.M); - - return; - } - - const Proxy PX(X_expr.get_ref()); - const Proxy PM(M_expr.get_ref()); - const Proxy PS(S_expr.get_ref()); - - arma_conform_check( ( (PX.get_n_rows() != PM.get_n_rows()) || (PX.get_n_cols() != PM.get_n_cols()) || (PM.get_n_rows() != PS.get_n_rows()) || (PM.get_n_cols() != PS.get_n_cols()) ), "normpdf(): size mismatch" ); - - out.set_size(PX.get_n_rows(), PX.get_n_cols()); - - eT* out_mem = out.memptr(); - - const uword N = PX.get_n_elem(); - - typename Proxy::ea_type X_ea = PX.get_ea(); - typename Proxy::ea_type M_ea = PM.get_ea(); - typename Proxy::ea_type S_ea = PS.get_ea(); - - const bool use_mp = arma_config::openmp && mp_gate::eval(N); - - if(use_mp) - { - #if defined(ARMA_USE_OPENMP) - { - const int n_threads = mp_thread_limit::get(); - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword i=0; i::sqrt2pi); - } - } - #endif - } - else - { - for(uword i=0; i::sqrt2pi); - } - } - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_real::value), eT >::result -normpdf(const eT x) - { - const eT out = std::exp(eT(-0.5) * (x*x)) / Datum::sqrt2pi; - - return out; - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_real::value), eT >::result -normpdf(const eT x, const eT mu, const eT sigma) - { - const eT tmp = (x - mu) / sigma; - - const eT out = std::exp(eT(-0.5) * (tmp*tmp)) / (sigma * Datum::sqrt2pi); - - return out; - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_real::value), Mat >::result -normpdf(const eT x, const Base& M_expr, const Base& S_expr) - { - arma_debug_sigprint(); - - const quasi_unwrap UM(M_expr.get_ref()); - const Mat& M = UM.M; - - Mat out; - - normpdf_helper(out, x*ones< Mat >(arma::size(M)), M, S_expr.get_ref()); - - return out; - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_real::value), Mat >::result -normpdf(const Base& X_expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap UX(X_expr.get_ref()); - const Mat& X = UX.M; - - Mat out; - - normpdf_helper(out, X, zeros< Mat >(arma::size(X)), ones< Mat >(arma::size(X))); - - return out; - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_real::value), Mat >::result -normpdf(const Base& X_expr, const typename T1::elem_type mu, const typename T1::elem_type sigma) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap UX(X_expr.get_ref()); - const Mat& X = UX.M; - - Mat out; - - normpdf_helper(out, X, mu*ones< Mat >(arma::size(X)), sigma*ones< Mat >(arma::size(X))); - - return out; - } - - - -template -arma_warn_unused -inline -typename enable_if2< (is_real::value), Mat >::result -normpdf(const Base& X_expr, const Base& M_expr, const Base& S_expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - Mat out; - - normpdf_helper(out, X_expr.get_ref(), M_expr.get_ref(), S_expr.get_ref()); - - return out; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_numel.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_numel.hpp deleted file mode 100644 index 6006402b4..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_numel.hpp +++ /dev/null @@ -1,95 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_numel -//! @{ - - - -template -arma_warn_unused -inline -typename enable_if2< is_arma_type::value, uword >::result -numel(const T1& X) - { - arma_debug_sigprint(); - - const Proxy P(X); - - return P.get_n_elem(); - } - - - -template -arma_warn_unused -inline -typename enable_if2< is_arma_cube_type::value, uword >::result -numel(const T1& X) - { - arma_debug_sigprint(); - - const ProxyCube P(X); - - return P.get_n_elem(); - } - - - -template -arma_warn_unused -inline -typename enable_if2< is_arma_sparse_type::value, uword >::result -numel(const T1& X) - { - arma_debug_sigprint(); - - const SpProxy P(X); - - return P.get_n_elem(); - } - - - -template -arma_warn_unused -inline -uword -numel(const field& X) - { - arma_debug_sigprint(); - - return X.n_elem; - } - - - -template -arma_warn_unused -inline -uword -numel(const subview_field& X) - { - arma_debug_sigprint(); - - return X.n_elem; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_ones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_ones.hpp deleted file mode 100644 index 4fd9d828e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_ones.hpp +++ /dev/null @@ -1,161 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_ones -//! @{ - - - -arma_warn_unused -arma_inline -const Gen -ones(const uword n_elem) - { - arma_debug_sigprint(); - - return Gen(n_elem, 1); - } - - - -template -arma_warn_unused -arma_inline -const Gen -ones(const uword n_elem, const arma_empty_class junk1 = arma_empty_class(), const typename arma_Mat_Col_Row_only::result* junk2 = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - const uword n_rows = (is_Row::value) ? uword(1) : n_elem; - const uword n_cols = (is_Row::value) ? n_elem : uword(1); - - return Gen(n_rows, n_cols); - } - - - -arma_warn_unused -arma_inline -const Gen -ones(const uword n_rows, const uword n_cols) - { - arma_debug_sigprint(); - - return Gen(n_rows, n_cols); - } - - - -arma_warn_unused -arma_inline -const Gen -ones(const SizeMat& s) - { - arma_debug_sigprint(); - - return Gen(s.n_rows, s.n_cols); - } - - - -template -arma_warn_unused -inline -const Gen -ones(const uword n_rows, const uword n_cols, const typename arma_Mat_Col_Row_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - if(is_Col::value) { arma_conform_check( (n_cols != 1), "ones(): incompatible size" ); } - if(is_Row::value) { arma_conform_check( (n_rows != 1), "ones(): incompatible size" ); } - - return Gen(n_rows, n_cols); - } - - - -template -arma_warn_unused -inline -const Gen -ones(const SizeMat& s, const typename arma_Mat_Col_Row_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return ones(s.n_rows, s.n_cols); - } - - - -arma_warn_unused -arma_inline -const GenCube -ones(const uword n_rows, const uword n_cols, const uword n_slices) - { - arma_debug_sigprint(); - - return GenCube(n_rows, n_cols, n_slices); - } - - - -arma_warn_unused -arma_inline -const GenCube -ones(const SizeCube& s) - { - arma_debug_sigprint(); - - return GenCube(s.n_rows, s.n_cols, s.n_slices); - } - - - -template -arma_warn_unused -arma_inline -const GenCube -ones(const uword n_rows, const uword n_cols, const uword n_slices, const typename arma_Cube_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return GenCube(n_rows, n_cols, n_slices); - } - - - -template -arma_warn_unused -arma_inline -const GenCube -ones(const SizeCube& s, const typename arma_Cube_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return GenCube(s.n_rows, s.n_cols, s.n_slices); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_orth_null.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_orth_null.hpp deleted file mode 100644 index 36060a9cf..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_orth_null.hpp +++ /dev/null @@ -1,98 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_orth_null -//! @{ - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_real::value, const Op >::result -orth(const Base& X, const typename T1::pod_type tol = 0.0) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - return Op(X.get_ref(), eT(tol)); - } - - - -template -inline -typename enable_if2< is_real::value, bool >::result -orth(Mat& out, const Base& X, const typename T1::pod_type tol = 0.0) - { - arma_debug_sigprint(); - - const bool status = op_orth::apply_direct(out, X.get_ref(), tol); - - if(status == false) - { - out.soft_reset(); - arma_warn(3, "orth(): svd failed"); - } - - return status; - } - - - -// - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_real::value, const Op >::result -null(const Base& X, const typename T1::pod_type tol = 0.0) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - return Op(X.get_ref(), eT(tol)); - } - - - -template -inline -typename enable_if2< is_real::value, bool >::result -null(Mat& out, const Base& X, const typename T1::pod_type tol = 0.0) - { - arma_debug_sigprint(); - - const bool status = op_null::apply_direct(out, X.get_ref(), tol); - - if(status == false) - { - out.soft_reset(); - arma_warn(3, "null(): svd failed"); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_pinv.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_pinv.hpp deleted file mode 100644 index 76181561f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_pinv.hpp +++ /dev/null @@ -1,110 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_pinv -//! @{ - - - -template -arma_warn_unused -inline -typename enable_if2< is_real::value, const Op >::result -pinv - ( - const Base& X - ) - { - arma_debug_sigprint(); - - return Op(X.get_ref()); - } - - - -template -arma_warn_unused -inline -typename enable_if2< is_real::value, const Op >::result -pinv - ( - const Base& X, - const typename T1::pod_type tol, - const char* method = nullptr - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - uword method_id = 0; // default setting - - if(method != nullptr) - { - const char sig = method[0]; - - arma_conform_check( ((sig != 's') && (sig != 'd')), "pinv(): unknown method specified" ); - - if(sig == 's') { method_id = 1; } - if(sig == 'd') { method_id = 2; } - } - - return Op(X.get_ref(), eT(tol), method_id, uword(0)); - } - - - -template -inline -typename enable_if2< is_real::value, bool >::result -pinv - ( - Mat& out, - const Base& X, - const typename T1::pod_type tol = 0.0, - const char* method = nullptr - ) - { - arma_debug_sigprint(); - - uword method_id = 0; // default setting - - if(method != nullptr) - { - const char sig = method[0]; - - arma_conform_check( ((sig != 's') && (sig != 'd')), "pinv(): unknown method specified" ); - - if(sig == 's') { method_id = 1; } - if(sig == 'd') { method_id = 2; } - } - - const bool status = op_pinv::apply_direct(out, X.get_ref(), tol, method_id); - - if(status == false) - { - out.soft_reset(); - arma_warn(3, "pinv(): svd failed"); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_polyfit.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_polyfit.hpp deleted file mode 100644 index 38aa0b68d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_polyfit.hpp +++ /dev/null @@ -1,67 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_polyfit -//! @{ - - - -template -inline -typename -enable_if2 - < - is_supported_blas_type::value, - bool - >::result -polyfit(Mat& out, const Base& X, const Base& Y, const uword N) - { - arma_debug_sigprint(); - - const bool status = glue_polyfit::apply_direct(out, X.get_ref(), Y.get_ref(), N); - - if(status == false) - { - out.soft_reset(); - arma_warn(3, "polyfit(): failed"); - } - - return status; - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_supported_blas_type::value, - const Glue - >::result -polyfit(const Base& X, const Base& Y, const uword N) - { - arma_debug_sigprint(); - - return Glue(X.get_ref(), Y.get_ref(), N); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_polyval.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_polyval.hpp deleted file mode 100644 index 0b3339686..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_polyval.hpp +++ /dev/null @@ -1,42 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_polyval -//! @{ - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_supported_blas_type::value && is_arma_type::value && is_same_type::value), - const Glue - >::result -polyval(const Base& P, const T2& X) - { - arma_debug_sigprint(); - - return Glue(P.get_ref(), X); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_powext.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_powext.hpp deleted file mode 100644 index 5223004b3..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_powext.hpp +++ /dev/null @@ -1,179 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_powext -//! @{ - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value, - const Glue - >::result -pow - ( - const T1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return Glue(X, Y.get_ref()); - } - - - -template -arma_warn_unused -inline -Mat -pow - ( - const subview_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return glue_powext::apply(X,Y); - } - - - -template -arma_warn_unused -arma_inline -const GlueCube -pow - ( - const BaseCube& X, - const BaseCube& Y - ) - { - arma_debug_sigprint(); - - return GlueCube(X.get_ref(), Y.get_ref()); - } - - - -template -arma_warn_unused -inline -Cube -pow - ( - const subview_cube_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return glue_powext::apply(X,Y); - } - - - -// - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - ( is_arma_type::value && is_cx::yes ), - const mtGlue - >::result -pow - ( - const T1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return mtGlue(X, Y.get_ref()); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_cx::yes, - Mat - >::result -pow - ( - const subview_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return glue_powext_cx::apply(X,Y); - } - - - -template -arma_warn_unused -arma_inline -const mtGlueCube -pow - ( - const BaseCube< std::complex, T1>& X, - const BaseCube< typename T1::pod_type , T2>& Y - ) - { - arma_debug_sigprint(); - - return mtGlueCube(X.get_ref(), Y.get_ref()); - } - - - -template -arma_warn_unused -inline -Cube< std::complex > -pow - ( - const subview_cube_each1< std::complex >& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return glue_powext_cx::apply(X,Y); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_powmat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_powmat.hpp deleted file mode 100644 index 4b58b97b3..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_powmat.hpp +++ /dev/null @@ -1,108 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_powmat -//! @{ - - -template -arma_warn_unused -inline -typename enable_if2< is_supported_blas_type::value, const Op >::result -powmat(const Base& X, const int y) - { - arma_debug_sigprint(); - - const uword aux_a = (y < int(0)) ? uword(-y) : uword(y); - const uword aux_b = (y < int(0)) ? uword(1) : uword(0); - - return Op(X.get_ref(), aux_a, aux_b); - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -powmat - ( - Mat& out, - const Base& X, - const int y - ) - { - arma_debug_sigprint(); - - const uword y_val = (y < int(0)) ? uword(-y) : uword(y); - const bool y_neg = (y < int(0)); - - const bool status = op_powmat::apply_direct(out, X.get_ref(), y_val, y_neg); - - if(status == false) - { - out.soft_reset(); - arma_warn(3, "powmat(): transformation failed"); - } - - return status; - } - - - -template -arma_warn_unused -inline -typename enable_if2< is_supported_blas_type::value, const mtOp,T1,op_powmat_cx> >::result -powmat(const Base& X, const double y) - { - arma_debug_sigprint(); - - typedef std::complex out_eT; - - return mtOp('j', X.get_ref(), out_eT(y)); - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -powmat - ( - Mat< std::complex >& out, - const Base& X, - const double y - ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - const bool status = op_powmat_cx::apply_direct(out, X.get_ref(), T(y)); - - if(status == false) - { - out.soft_reset(); - arma_warn(3, "powmat(): transformation failed"); - } - - return status; - } - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_princomp.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_princomp.hpp deleted file mode 100644 index dc8ec4299..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_princomp.hpp +++ /dev/null @@ -1,180 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_princomp -//! @{ - - - -//! \brief -//! principal component analysis -- 4 arguments version -//! coeff_out -> principal component coefficients -//! score_out -> projected samples -//! latent_out -> eigenvalues of principal vectors -//! tsquared_out -> Hotelling's T^2 statistic -template -inline -bool -princomp - ( - Mat& coeff_out, - Mat& score_out, - Col& latent_out, - Col& tsquared_out, - const Base& X, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const bool status = op_princomp::direct_princomp(coeff_out, score_out, latent_out, tsquared_out, X); - - if(status == false) - { - coeff_out.soft_reset(); - score_out.soft_reset(); - latent_out.soft_reset(); - tsquared_out.soft_reset(); - - arma_warn(3, "princomp(): decomposition failed"); - } - - return status; - } - - - -//! \brief -//! principal component analysis -- 3 arguments version -//! coeff_out -> principal component coefficients -//! score_out -> projected samples -//! latent_out -> eigenvalues of principal vectors -template -inline -bool -princomp - ( - Mat& coeff_out, - Mat& score_out, - Col& latent_out, - const Base& X, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const bool status = op_princomp::direct_princomp(coeff_out, score_out, latent_out, X); - - if(status == false) - { - coeff_out.soft_reset(); - score_out.soft_reset(); - latent_out.soft_reset(); - - arma_warn(3, "princomp(): decomposition failed"); - } - - return status; - } - - - -//! \brief -//! principal component analysis -- 2 arguments version -//! coeff_out -> principal component coefficients -//! score_out -> projected samples -template -inline -bool -princomp - ( - Mat& coeff_out, - Mat& score_out, - const Base& X, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const bool status = op_princomp::direct_princomp(coeff_out, score_out, X); - - if(status == false) - { - coeff_out.soft_reset(); - score_out.soft_reset(); - - arma_warn(3, "princomp(): decomposition failed"); - } - - return status; - } - - - -//! \brief -//! principal component analysis -- 1 argument version -//! coeff_out -> principal component coefficients -template -inline -bool -princomp - ( - Mat& coeff_out, - const Base& X, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const bool status = op_princomp::direct_princomp(coeff_out, X); - - if(status == false) - { - coeff_out.soft_reset(); - - arma_warn(3, "princomp(): decomposition failed"); - } - - return status; - } - - - -template -arma_warn_unused -inline -const Op -princomp - ( - const Base& X, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return Op(X.get_ref()); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_prod.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_prod.hpp deleted file mode 100644 index 18977dcd6..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_prod.hpp +++ /dev/null @@ -1,81 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_prod -//! @{ - - -//! \brief -//! Delayed product of elements of a matrix along a specified dimension (either rows or columns). -//! The result is stored in a dense matrix that has either one column or one row. -//! For dim = 0, find the sum of each column (ie. traverse across rows) -//! For dim = 1, find the sum of each row (ie. traverse across columns) -//! The default is dim = 0. -//! NOTE: this function works differently than in Matlab/Octave. - -template -arma_warn_unused -inline -typename enable_if2< is_arma_type::value && resolves_to_vector::yes, typename T1::elem_type >::result -prod(const T1& X) - { - arma_debug_sigprint(); - - return op_prod::prod(X); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value && resolves_to_vector::no, const Op >::result -prod(const T1& X) - { - arma_debug_sigprint(); - - return Op(X, 0, 0); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const Op >::result -prod(const T1& X, const uword dim) - { - arma_debug_sigprint(); - - return Op(X, dim, 0); - } - - - -template -arma_warn_unused -arma_inline -typename arma_scalar_only::result -prod(const T& x) - { - return x; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_qr.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_qr.hpp deleted file mode 100644 index 3049cd870..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_qr.hpp +++ /dev/null @@ -1,145 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_qr -//! @{ - - - -//! QR decomposition -template -inline -bool -qr - ( - Mat& Q, - Mat& R, - const Base& X, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - arma_conform_check( (&Q == &R), "qr(): Q and R are the same object" ); - - const bool status = auxlib::qr(Q, R, X); - - if(status == false) - { - Q.soft_reset(); - R.soft_reset(); - arma_warn(3, "qr(): decomposition failed"); - } - - return status; - } - - - -//! economical QR decomposition -template -inline -bool -qr_econ - ( - Mat& Q, - Mat& R, - const Base& X, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - arma_conform_check( (&Q == &R), "qr_econ(): Q and R are the same object" ); - - const bool status = auxlib::qr_econ(Q, R, X); - - if(status == false) - { - Q.soft_reset(); - R.soft_reset(); - arma_warn(3, "qr_econ(): decomposition failed"); - } - - return status; - } - - - -//! QR decomposition with pivoting -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -qr - ( - Mat& Q, - Mat& R, - Mat& P, - const Base& X, - const char* P_mode = "matrix" - ) - { - arma_debug_sigprint(); - - arma_conform_check( (&Q == &R), "qr(): Q and R are the same object" ); - - const char sig = (P_mode != nullptr) ? P_mode[0] : char(0); - - arma_conform_check( ((sig != 'm') && (sig != 'v')), "qr(): argument 'P_mode' must be \"vector\" or \"matrix\"" ); - - bool status = false; - - if(sig == 'v') - { - status = auxlib::qr_pivot(Q, R, P, X); - } - else - if(sig == 'm') - { - Mat P_vec; - - status = auxlib::qr_pivot(Q, R, P_vec, X); - - if(status) - { - // construct P - - const uword N = P_vec.n_rows; - - P.zeros(N,N); - - for(uword row=0; row < N; ++row) { P.at(P_vec[row], row) = uword(1); } - } - } - - if(status == false) - { - Q.soft_reset(); - R.soft_reset(); - P.soft_reset(); - arma_warn(3, "qr(): decomposition failed"); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_quantile.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_quantile.hpp deleted file mode 100644 index 7ac59fa06..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_quantile.hpp +++ /dev/null @@ -1,58 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_quantile -//! @{ - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && is_cx::no && is_real::value, - const mtGlue - >::result -quantile(const T1& X, const Base& P) - { - arma_debug_sigprint(); - - return mtGlue(X, P.get_ref()); - } - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && is_cx::no && is_real::value, - const mtGlue - >::result -quantile(const T1& X, const Base& P, const uword dim) - { - arma_debug_sigprint(); - - return mtGlue(X, P.get_ref(), dim); - } - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_qz.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_qz.hpp deleted file mode 100644 index 4b2a1551e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_qz.hpp +++ /dev/null @@ -1,66 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_qz -//! @{ - - - -//! QZ decomposition for pair of N-by-N general matrices A and B -template -inline -typename -enable_if2 - < - is_supported_blas_type::value, - bool - >::result -qz - ( - Mat& AA, - Mat& BB, - Mat& Q, - Mat& Z, - const Base& A_expr, - const Base& B_expr, - const char* select = "none" - ) - { - arma_debug_sigprint(); - - const char sig = (select != nullptr) ? select[0] : char(0); - - arma_conform_check( ( (sig != 'n') && (sig != 'l') && (sig != 'r') && (sig != 'i') && (sig != 'o') ), "qz(): unknown select form" ); - - const bool status = auxlib::qz(AA, BB, Q, Z, A_expr.get_ref(), B_expr.get_ref(), sig); - - if(status == false) - { - AA.soft_reset(); - BB.soft_reset(); - Q.soft_reset(); - Z.soft_reset(); - arma_warn(3, "qz(): decomposition failed"); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_randg.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_randg.hpp deleted file mode 100644 index 551af3452..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_randg.hpp +++ /dev/null @@ -1,241 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_randg -//! @{ - - - -template -arma_warn_unused -inline -obj_type -randg(const uword n_rows, const uword n_cols, const distr_param& param = distr_param(), const typename arma_Mat_Col_Row_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename obj_type::elem_type eT; - - if(is_Col::value) - { - arma_conform_check( (n_cols != 1), "randg(): incompatible size" ); - } - else - if(is_Row::value) - { - arma_conform_check( (n_rows != 1), "randg(): incompatible size" ); - } - - double a = double(1); - double b = double(1); - - param.get_double_vals(a,b); - - arma_conform_check( ((a <= double(0)) || (b <= double(0))), "randg(): incorrect distribution parameters; a and b must be greater than zero" ); - - obj_type out(n_rows, n_cols, arma_nozeros_indicator()); - - arma_rng::randg::fill(out.memptr(), out.n_elem, a, b); - - return out; - } - - - -template -arma_warn_unused -inline -obj_type -randg(const SizeMat& s, const distr_param& param = distr_param(), const typename arma_Mat_Col_Row_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return randg(s.n_rows, s.n_cols, param); - } - - - -template -arma_warn_unused -inline -obj_type -randg(const uword n_elem, const distr_param& param = distr_param(), const arma_empty_class junk1 = arma_empty_class(), const typename arma_Mat_Col_Row_only::result* junk2 = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - const uword n_rows = (is_Row::value) ? uword(1) : n_elem; - const uword n_cols = (is_Row::value) ? n_elem : uword(1); - - return randg(n_rows, n_cols, param); - } - - - -arma_warn_unused -inline -mat -randg(const uword n_rows, const uword n_cols, const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - return randg(n_rows, n_cols, param); - } - - - -arma_warn_unused -inline -mat -randg(const SizeMat& s, const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - return randg(s.n_rows, s.n_cols, param); - } - - - -arma_warn_unused -inline -vec -randg(const uword n_elem, const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - return randg(n_elem, uword(1), param); - } - - - -arma_warn_unused -inline -double -randg(const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - double a = double(1); - double b = double(1); - - param.get_double_vals(a,b); - - arma_conform_check( ((a <= double(0)) || (b <= double(0))), "randg(): incorrect distribution parameters; a and b must be greater than zero" ); - - double out_val = double(0); - - arma_rng::randg::fill(&out_val, uword(1), a, b); - - return out_val; - } - - - -template -arma_warn_unused -inline -typename arma_real_or_cx_only::result -randg(const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - double a = double(1); - double b = double(1); - - param.get_double_vals(a,b); - - arma_conform_check( ((a <= double(0)) || (b <= double(0))), "randg(): incorrect distribution parameters; a and b must be greater than zero" ); - - eT out_val = eT(0); - - arma_rng::randg::fill(&out_val, uword(1), a, b); - - return out_val; - } - - - -template -arma_warn_unused -inline -cube_type -randg(const uword n_rows, const uword n_cols, const uword n_slices, const distr_param& param = distr_param(), const typename arma_Cube_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename cube_type::elem_type eT; - - double a = double(1); - double b = double(1); - - param.get_double_vals(a,b); - - arma_conform_check( ((a <= double(0)) || (b <= double(0))), "randg(): incorrect distribution parameters; a and b must be greater than zero" ); - - cube_type out(n_rows, n_cols, n_slices, arma_nozeros_indicator()); - - arma_rng::randg::fill(out.memptr(), out.n_elem, a, b); - - return out; - } - - - -template -arma_warn_unused -inline -cube_type -randg(const SizeCube& s, const distr_param& param = distr_param(), const typename arma_Cube_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return randg(s.n_rows, s.n_cols, s.n_slices, param); - } - - - -arma_warn_unused -inline -cube -randg(const uword n_rows, const uword n_cols, const uword n_slices, const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - return randg(n_rows, n_cols, n_slices, param); - } - - - -arma_warn_unused -inline -cube -randg(const SizeCube& s, const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - return randg(s.n_rows, s.n_cols, s.n_slices, param); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_randi.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_randi.hpp deleted file mode 100644 index 706851ba5..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_randi.hpp +++ /dev/null @@ -1,270 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_randi -//! @{ - - - -template -arma_warn_unused -inline -obj_type -randi(const uword n_rows, const uword n_cols, const distr_param& param = distr_param(), const typename arma_Mat_Col_Row_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename obj_type::elem_type eT; - - if(is_Col::value) - { - arma_conform_check( (n_cols != 1), "randi(): incompatible size" ); - } - else - if(is_Row::value) - { - arma_conform_check( (n_rows != 1), "randi(): incompatible size" ); - } - - int a = 0; - int b = arma_rng::randi::max_val(); - - param.get_int_vals(a,b); - - arma_conform_check( (a > b), "randi(): incorrect distribution parameters; a must be less than b" ); - - obj_type out(n_rows, n_cols, arma_nozeros_indicator()); - - arma_rng::randi::fill(out.memptr(), out.n_elem, a, b); - - return out; - } - - - -template -arma_warn_unused -inline -obj_type -randi(const SizeMat& s, const distr_param& param = distr_param(), const typename arma_Mat_Col_Row_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return randi(s.n_rows, s.n_cols, param); - } - - - -template -arma_warn_unused -inline -obj_type -randi(const uword n_elem, const distr_param& param = distr_param(), const arma_empty_class junk1 = arma_empty_class(), const typename arma_Mat_Col_Row_only::result* junk2 = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - if(is_Row::value) - { - return randi(1, n_elem, param); - } - else - { - return randi(n_elem, 1, param); - } - } - - - -arma_warn_unused -inline -imat -randi(const uword n_rows, const uword n_cols, const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - return randi(n_rows, n_cols, param); - } - - - -arma_warn_unused -inline -imat -randi(const SizeMat& s, const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - return randi(s.n_rows, s.n_cols, param); - } - - - -arma_warn_unused -inline -ivec -randi(const uword n_elem, const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - return randi(n_elem, uword(1), param); - } - - - -arma_warn_unused -inline -sword -randi(const distr_param& param) - { - arma_debug_sigprint(); - - int a = 0; - int b = arma_rng::randi::max_val(); - - param.get_int_vals(a,b); - - arma_conform_check( (a > b), "randi(): incorrect distribution parameters; a must be less than b" ); - - sword out_val = sword(0); - - arma_rng::randi::fill(&out_val, uword(1), a, b); - - return out_val; - } - - - -template -arma_warn_unused -inline -typename arma_scalar_only::result -randi(const distr_param& param) - { - arma_debug_sigprint(); - - int a = 0; - int b = arma_rng::randi::max_val(); - - param.get_int_vals(a,b); - - arma_conform_check( (a > b), "randi(): incorrect distribution parameters; a must be less than b" ); - - eT out_val = eT(0); - - arma_rng::randi::fill(&out_val, uword(1), a, b); - - return out_val; - } - - - -arma_warn_unused -inline -sword -randi() - { - arma_debug_sigprint(); - - return sword( arma_rng::randi() ); - } - - - -template -arma_warn_unused -inline -typename arma_scalar_only::result -randi() - { - arma_debug_sigprint(); - - return eT( arma_rng::randi() ); - } - - - -template -arma_warn_unused -inline -cube_type -randi(const uword n_rows, const uword n_cols, const uword n_slices, const distr_param& param = distr_param(), const typename arma_Cube_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename cube_type::elem_type eT; - - int a = 0; - int b = arma_rng::randi::max_val(); - - param.get_int_vals(a,b); - - arma_conform_check( (a > b), "randi(): incorrect distribution parameters; a must be less than b" ); - - cube_type out(n_rows, n_cols, n_slices, arma_nozeros_indicator()); - - arma_rng::randi::fill(out.memptr(), out.n_elem, a, b); - - return out; - } - - - -template -arma_warn_unused -inline -cube_type -randi(const SizeCube& s, const distr_param& param = distr_param(), const typename arma_Cube_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return randi(s.n_rows, s.n_cols, s.n_slices, param); - } - - - -arma_warn_unused -inline -icube -randi(const uword n_rows, const uword n_cols, const uword n_slices, const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - return randi(n_rows, n_cols, n_slices, param); - } - - - -arma_warn_unused -inline -icube -randi(const SizeCube& s, const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - return randi(s.n_rows, s.n_cols, s.n_slices, param); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_randn.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_randn.hpp deleted file mode 100644 index ad1733abd..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_randn.hpp +++ /dev/null @@ -1,357 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_randn -//! @{ - - - -// scalars - -arma_warn_unused -inline -double -randn() - { - arma_debug_sigprint(); - - return double(arma_rng::randn()); - } - - - -template -arma_warn_unused -inline -typename arma_real_or_cx_only::result -randn() - { - arma_debug_sigprint(); - - return eT(arma_rng::randn()); - } - - - -arma_warn_unused -inline -double -randn(const distr_param& param) - { - arma_debug_sigprint(); - - if(param.state == 0) { return double(arma_rng::randn()); } - - double mu = double(0); - double sd = double(1); - - param.get_double_vals(mu,sd); - - arma_conform_check( (sd <= double(0)), "randn(): incorrect distribution parameters; standard deviation must be > 0" ); - - const double val = double(arma_rng::randn()); - - return ((val * sd) + mu); - } - - - -template -arma_warn_unused -inline -typename arma_real_or_cx_only::result -randn(const distr_param& param) - { - arma_debug_sigprint(); - - if(param.state == 0) { return eT(arma_rng::randn()); } - - double mu = double(0); - double sd = double(1); - - param.get_double_vals(mu,sd); - - arma_conform_check( (sd <= double(0)), "randn(): incorrect distribution parameters; standard deviation must be > 0" ); - - eT val = eT(0); - - arma_rng::randn::fill(&val, 1, mu, sd); // using fill() as eT can be complex - - return val; - } - - - -// vectors - -arma_warn_unused -inline -vec -randn(const uword n_elem, const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - vec out(n_elem, arma_nozeros_indicator()); - - if(param.state == 0) - { - arma_rng::randn::fill(out.memptr(), n_elem); - } - else - { - double mu = double(0); - double sd = double(1); - - param.get_double_vals(mu,sd); - - arma_conform_check( (sd <= double(0)), "randn(): incorrect distribution parameters; standard deviation must be > 0" ); - - arma_rng::randn::fill(out.memptr(), n_elem, mu, sd); - } - - return out; - } - - - -template -arma_warn_unused -inline -obj_type -randn(const uword n_elem, const distr_param& param = distr_param(), const typename arma_Mat_Col_Row_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename obj_type::elem_type eT; - - const uword n_rows = (is_Row::value) ? uword(1) : n_elem; - const uword n_cols = (is_Row::value) ? n_elem : uword(1); - - obj_type out(n_rows, n_cols, arma_nozeros_indicator()); - - if(param.state == 0) - { - arma_rng::randn::fill(out.memptr(), out.n_elem); - } - else - { - double mu = double(0); - double sd = double(1); - - param.get_double_vals(mu,sd); - - arma_conform_check( (sd <= double(0)), "randn(): incorrect distribution parameters; standard deviation must be > 0" ); - - arma_rng::randn::fill(out.memptr(), out.n_elem, mu, sd); - } - - return out; - } - - - -// matrices - -arma_warn_unused -inline -mat -randn(const uword n_rows, const uword n_cols, const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - mat out(n_rows, n_cols, arma_nozeros_indicator()); - - if(param.state == 0) - { - arma_rng::randn::fill(out.memptr(), out.n_elem); - } - else - { - double mu = double(0); - double sd = double(1); - - param.get_double_vals(mu,sd); - - arma_conform_check( (sd <= double(0)), "randn(): incorrect distribution parameters; standard deviation must be > 0" ); - - arma_rng::randn::fill(out.memptr(), out.n_elem, mu, sd); - } - - return out; - } - - - -arma_warn_unused -inline -mat -randn(const SizeMat& s, const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - return randn(s.n_rows, s.n_cols, param); - } - - - -template -arma_warn_unused -inline -obj_type -randn(const uword n_rows, const uword n_cols, const distr_param& param = distr_param(), const typename arma_Mat_Col_Row_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename obj_type::elem_type eT; - - if(is_Col::value) { arma_conform_check( (n_cols != 1), "randn(): incompatible size" ); } - if(is_Row::value) { arma_conform_check( (n_rows != 1), "randn(): incompatible size" ); } - - obj_type out(n_rows, n_cols, arma_nozeros_indicator()); - - if(param.state == 0) - { - arma_rng::randn::fill(out.memptr(), out.n_elem); - } - else - { - double mu = double(0); - double sd = double(1); - - param.get_double_vals(mu,sd); - - arma_conform_check( (sd <= double(0)), "randn(): incorrect distribution parameters; standard deviation must be > 0" ); - - arma_rng::randn::fill(out.memptr(), out.n_elem, mu, sd); - } - - return out; - } - - - -template -arma_warn_unused -inline -obj_type -randn(const SizeMat& s, const distr_param& param = distr_param(), const typename arma_Mat_Col_Row_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return randn(s.n_rows, s.n_cols, param); - } - - - -// cubes - - -arma_warn_unused -inline -cube -randn(const uword n_rows, const uword n_cols, const uword n_slices, const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - cube out(n_rows, n_cols, n_slices, arma_nozeros_indicator()); - - if(param.state == 0) - { - arma_rng::randn::fill(out.memptr(), out.n_elem); - } - else - { - double mu = double(0); - double sd = double(1); - - param.get_double_vals(mu,sd); - - arma_conform_check( (sd <= double(0)), "randn(): incorrect distribution parameters; standard deviation must be > 0" ); - - arma_rng::randn::fill(out.memptr(), out.n_elem, mu, sd); - } - - return out; - } - - - -arma_warn_unused -inline -cube -randn(const SizeCube& s, const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - return randn(s.n_rows, s.n_cols, s.n_slices, param); - } - - - -template -arma_warn_unused -inline -cube_type -randn(const uword n_rows, const uword n_cols, const uword n_slices, const distr_param& param = distr_param(), const typename arma_Cube_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename cube_type::elem_type eT; - - cube_type out(n_rows, n_cols, n_slices, arma_nozeros_indicator()); - - if(param.state == 0) - { - arma_rng::randn::fill(out.memptr(), out.n_elem); - } - else - { - double mu = double(0); - double sd = double(1); - - param.get_double_vals(mu,sd); - - arma_conform_check( (sd <= double(0)), "randn(): incorrect distribution parameters; standard deviation must be > 0" ); - - arma_rng::randn::fill(out.memptr(), out.n_elem, mu, sd); - } - - return out; - } - - - -template -arma_warn_unused -inline -cube_type -randn(const SizeCube& s, const distr_param& param = distr_param(), const typename arma_Cube_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return randn(s.n_rows, s.n_cols, s.n_slices, param); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_randperm.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_randperm.hpp deleted file mode 100644 index 5fb55bb75..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_randperm.hpp +++ /dev/null @@ -1,153 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_randperm -//! @{ - - - -template -inline -void -internal_randperm_helper(obj_type& x, const uword N, const uword N_keep) - { - arma_debug_sigprint(); - - typedef typename obj_type::elem_type eT; - - // see op_sort_index_bones.hpp for the definition of arma_sort_index_packet - // and the associated comparison functor - - typedef arma_sort_index_packet packet; - - std::vector packet_vec(N); - - for(uword i=0; i < N; ++i) - { - packet_vec[i].val = int(arma_rng::randi()); - packet_vec[i].index = i; - } - - arma_sort_index_helper_ascend comparator; - - if(N >= 2) - { - if(N_keep < N) - { - typename std::vector::iterator first = packet_vec.begin(); - typename std::vector::iterator nth = first + N_keep; - typename std::vector::iterator pastlast = packet_vec.end(); - - std::partial_sort(first, nth, pastlast, comparator); - } - else - { - std::sort( packet_vec.begin(), packet_vec.end(), comparator ); - } - } - - if(is_Row::value) - { - x.set_size(1,N_keep); - } - else - { - x.set_size(N_keep,1); - } - - eT* x_mem = x.memptr(); - - for(uword i=0; i < N_keep; ++i) - { - x_mem[i] = eT( packet_vec[i].index ); - } - } - - - -template -arma_warn_unused -inline -typename enable_if2< is_Mat::value, obj_type >::result -randperm(const uword N) - { - arma_debug_sigprint(); - - obj_type x; - - if(N > 0) { internal_randperm_helper(x, N, N); } - - return x; - } - - - -arma_warn_unused -inline -uvec -randperm(const uword N) - { - arma_debug_sigprint(); - - uvec x; - - if(N > 0) { internal_randperm_helper(x, N, N); } - - return x; - } - - - -template -arma_warn_unused -inline -typename enable_if2< is_Mat::value, obj_type >::result -randperm(const uword N, const uword M) - { - arma_debug_sigprint(); - - arma_conform_check( (M > N), "randperm(): 'M' must be less than or equal to 'N'" ); - - obj_type x; - - if( (N > 0) && (M > 0) ) { internal_randperm_helper(x, N, M); } - - return x; - } - - - -arma_warn_unused -inline -uvec -randperm(const uword N, const uword M) - { - arma_debug_sigprint(); - - arma_conform_check( (M > N), "randperm(): 'M' must be less than or equal to 'N'" ); - - uvec x; - - if( (N > 0) && (M > 0) ) { internal_randperm_helper(x, N, M); } - - return x; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_randu.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_randu.hpp deleted file mode 100644 index 14518100d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_randu.hpp +++ /dev/null @@ -1,357 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_randu -//! @{ - - - -// scalars - -arma_warn_unused -inline -double -randu() - { - arma_debug_sigprint(); - - return double(arma_rng::randu()); - } - - - -template -arma_warn_unused -inline -typename arma_real_or_cx_only::result -randu() - { - arma_debug_sigprint(); - - return eT(arma_rng::randu()); - } - - - -arma_warn_unused -inline -double -randu(const distr_param& param) - { - arma_debug_sigprint(); - - if(param.state == 0) { return double(arma_rng::randu()); } - - double a = double(0); - double b = double(1); - - param.get_double_vals(a,b); - - arma_conform_check( (a >= b), "randu(): incorrect distribution parameters; a must be less than b" ); - - const double val = double(arma_rng::randu()); - - return ((val * (b - a)) + a); - } - - - -template -arma_warn_unused -inline -typename arma_real_or_cx_only::result -randu(const distr_param& param) - { - arma_debug_sigprint(); - - if(param.state == 0) { return eT(arma_rng::randu()); } - - double a = double(0); - double b = double(1); - - param.get_double_vals(a,b); - - arma_conform_check( (a >= b), "randu(): incorrect distribution parameters; a must be less than b" ); - - eT val = eT(0); - - arma_rng::randu::fill(&val, 1, a, b); // using fill() as eT can be complex - - return val; - } - - - -// vectors - -arma_warn_unused -inline -vec -randu(const uword n_elem, const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - vec out(n_elem, arma_nozeros_indicator()); - - if(param.state == 0) - { - arma_rng::randu::fill(out.memptr(), n_elem); - } - else - { - double a = double(0); - double b = double(1); - - param.get_double_vals(a,b); - - arma_conform_check( (a >= b), "randu(): incorrect distribution parameters; a must be less than b" ); - - arma_rng::randu::fill(out.memptr(), n_elem, a, b); - } - - return out; - } - - - -template -arma_warn_unused -inline -obj_type -randu(const uword n_elem, const distr_param& param = distr_param(), const typename arma_Mat_Col_Row_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename obj_type::elem_type eT; - - const uword n_rows = (is_Row::value) ? uword(1) : n_elem; - const uword n_cols = (is_Row::value) ? n_elem : uword(1); - - obj_type out(n_rows, n_cols, arma_nozeros_indicator()); - - if(param.state == 0) - { - arma_rng::randu::fill(out.memptr(), out.n_elem); - } - else - { - double a = double(0); - double b = double(1); - - param.get_double_vals(a,b); - - arma_conform_check( (a >= b), "randu(): incorrect distribution parameters; a must be less than b" ); - - arma_rng::randu::fill(out.memptr(), out.n_elem, a, b); - } - - return out; - } - - - -// matrices - -arma_warn_unused -inline -mat -randu(const uword n_rows, const uword n_cols, const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - mat out(n_rows, n_cols, arma_nozeros_indicator()); - - if(param.state == 0) - { - arma_rng::randu::fill(out.memptr(), out.n_elem); - } - else - { - double a = double(0); - double b = double(1); - - param.get_double_vals(a,b); - - arma_conform_check( (a >= b), "randu(): incorrect distribution parameters; a must be less than b" ); - - arma_rng::randu::fill(out.memptr(), out.n_elem, a, b); - } - - return out; - } - - - -arma_warn_unused -inline -mat -randu(const SizeMat& s, const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - return randu(s.n_rows, s.n_cols, param); - } - - - -template -arma_warn_unused -inline -obj_type -randu(const uword n_rows, const uword n_cols, const distr_param& param = distr_param(), const typename arma_Mat_Col_Row_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename obj_type::elem_type eT; - - if(is_Col::value) { arma_conform_check( (n_cols != 1), "randu(): incompatible size" ); } - if(is_Row::value) { arma_conform_check( (n_rows != 1), "randu(): incompatible size" ); } - - obj_type out(n_rows, n_cols, arma_nozeros_indicator()); - - if(param.state == 0) - { - arma_rng::randu::fill(out.memptr(), out.n_elem); - } - else - { - double a = double(0); - double b = double(1); - - param.get_double_vals(a,b); - - arma_conform_check( (a >= b), "randu(): incorrect distribution parameters; a must be less than b" ); - - arma_rng::randu::fill(out.memptr(), out.n_elem, a, b); - } - - return out; - } - - - -template -arma_warn_unused -inline -obj_type -randu(const SizeMat& s, const distr_param& param = distr_param(), const typename arma_Mat_Col_Row_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return randu(s.n_rows, s.n_cols, param); - } - - - -// cubes - - -arma_warn_unused -inline -cube -randu(const uword n_rows, const uword n_cols, const uword n_slices, const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - cube out(n_rows, n_cols, n_slices, arma_nozeros_indicator()); - - if(param.state == 0) - { - arma_rng::randu::fill(out.memptr(), out.n_elem); - } - else - { - double a = double(0); - double b = double(1); - - param.get_double_vals(a,b); - - arma_conform_check( (a >= b), "randu(): incorrect distribution parameters; a must be less than b" ); - - arma_rng::randu::fill(out.memptr(), out.n_elem, a, b); - } - - return out; - } - - - -arma_warn_unused -inline -cube -randu(const SizeCube& s, const distr_param& param = distr_param()) - { - arma_debug_sigprint(); - - return randu(s.n_rows, s.n_cols, s.n_slices, param); - } - - - -template -arma_warn_unused -inline -cube_type -randu(const uword n_rows, const uword n_cols, const uword n_slices, const distr_param& param = distr_param(), const typename arma_Cube_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename cube_type::elem_type eT; - - cube_type out(n_rows, n_cols, n_slices, arma_nozeros_indicator()); - - if(param.state == 0) - { - arma_rng::randu::fill(out.memptr(), out.n_elem); - } - else - { - double a = double(0); - double b = double(1); - - param.get_double_vals(a,b); - - arma_conform_check( (a >= b), "randu(): incorrect distribution parameters; a must be less than b" ); - - arma_rng::randu::fill(out.memptr(), out.n_elem, a, b); - } - - return out; - } - - - -template -arma_warn_unused -inline -cube_type -randu(const SizeCube& s, const distr_param& param = distr_param(), const typename arma_Cube_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return randu(s.n_rows, s.n_cols, s.n_slices, param); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_range.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_range.hpp deleted file mode 100644 index 3d4171ad7..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_range.hpp +++ /dev/null @@ -1,62 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_range -//! @{ - - -template -arma_warn_unused -inline -typename enable_if2< is_arma_type::value && resolves_to_vector::yes, typename T1::elem_type >::result -range(const T1& X) - { - arma_debug_sigprint(); - - return op_range::vector_range(X); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value && resolves_to_vector::no, const Op >::result -range(const T1& X) - { - arma_debug_sigprint(); - - return Op(X, 0, 0); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const Op >::result -range(const T1& X, const uword dim) - { - arma_debug_sigprint(); - - return Op(X, dim, 0); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_rank.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_rank.hpp deleted file mode 100644 index a90bfbdfb..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_rank.hpp +++ /dev/null @@ -1,57 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_rank -//! @{ - - - -template -arma_warn_unused -inline -typename enable_if2< is_supported_blas_type::value, uword >::result -rank(const Base& expr, const typename T1::pod_type tol = 0) - { - arma_debug_sigprint(); - - uword out = uword(0); - - const bool status = op_rank::apply(out, expr.get_ref(), tol); - - if(status == false) { arma_stop_runtime_error("rank(): failed"); return uword(0); } - - return out; - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -rank(uword& out, const Base& expr, const typename T1::pod_type tol = 0) - { - arma_debug_sigprint(); - - out = uword(0); - - return op_rank::apply(out, expr.get_ref(), tol); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_regspace.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_regspace.hpp deleted file mode 100644 index e91d10302..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_regspace.hpp +++ /dev/null @@ -1,265 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_regspace -//! @{ - - - -template -inline -void -internal_regspace_default_delta - ( - Mat& x, - const typename Mat::pod_type start, - const typename Mat::pod_type end - ) - { - arma_debug_sigprint(); - - typedef typename Mat::pod_type T; - - const bool ascend = (start <= end); - - const uword N = uword(1) + uword((ascend) ? (end-start) : (start-end)); - - x.set_size(N); - - eT* x_mem = x.memptr(); - - if(ascend) - { - for(uword i=0; i < N; ++i) { x_mem[i] = eT(start + T(i)); } - } - else - { - for(uword i=0; i < N; ++i) { x_mem[i] = eT(start - T(i)); } - } - } - - - -template -inline -typename enable_if2< (is_signed::value == true), void >::result -internal_regspace_var_delta - ( - Mat& x, - const typename Mat::pod_type start, - const sT delta, - const typename Mat::pod_type end - ) - { - arma_debug_sigprint(); - arma_debug_print("internal_regspace_var_delta(): signed version"); - - typedef typename Mat::pod_type T; - - if( ((start < end) && (delta < sT(0))) || ((start > end) && (delta > sT(0))) || (delta == sT(0)) ) { return; } - - const bool ascend = (start <= end); - - const T inc = (delta < sT(0)) ? T(-delta) : T(delta); - - const T M = ((ascend) ? T(end-start) : T(start-end)) / T(inc); - - const uword N = uword(1) + ( (is_non_integral::value) ? uword(std::floor(double(M))) : uword(M) ); - - x.set_size(N); - - eT* x_mem = x.memptr(); - - if(ascend) - { - for(uword i=0; i < N; ++i) { x_mem[i] = eT( start + T(i*inc) ); } - } - else - { - for(uword i=0; i < N; ++i) { x_mem[i] = eT( start - T(i*inc) ); } - } - } - - - -template -inline -typename enable_if2< (is_signed::value == false), void >::result -internal_regspace_var_delta - ( - Mat& x, - const typename Mat::pod_type start, - const uT delta, - const typename Mat::pod_type end - ) - { - arma_debug_sigprint(); - arma_debug_print("internal_regspace_var_delta(): unsigned version"); - - typedef typename Mat::pod_type T; - - if( ((start > end) && (delta > uT(0))) || (delta == uT(0)) ) { return; } - - const bool ascend = (start <= end); - - const T inc = T(delta); - - const T M = ((ascend) ? T(end-start) : T(start-end)) / T(inc); - - const uword N = uword(1) + ( (is_non_integral::value) ? uword(std::floor(double(M))) : uword(M) ); - - x.set_size(N); - - eT* x_mem = x.memptr(); - - if(ascend) - { - for(uword i=0; i < N; ++i) { x_mem[i] = eT( start + T(i*inc) ); } - } - else - { - for(uword i=0; i < N; ++i) { x_mem[i] = eT( start - T(i*inc) ); } - } - } - - - -template -inline -typename enable_if2< is_Mat::value && (is_signed::value == true), vec_type >::result -regspace - ( - const typename vec_type::pod_type start, - const sT delta, - const typename vec_type::pod_type end - ) - { - arma_debug_sigprint(); - arma_debug_print("regspace(): signed version"); - - vec_type x; - - if( ((delta == sT(+1)) && (start <= end)) || ((delta == sT(-1)) && (start > end)) ) - { - internal_regspace_default_delta(x, start, end); - } - else - { - internal_regspace_var_delta(x, start, delta, end); - } - - if(x.n_elem == 0) - { - if(is_Mat_only::value) { x.set_size(1,0); } - } - - return x; - } - - - -template -inline -typename enable_if2< is_Mat::value && (is_signed::value == false), vec_type >::result -regspace - ( - const typename vec_type::pod_type start, - const uT delta, - const typename vec_type::pod_type end - ) - { - arma_debug_sigprint(); - arma_debug_print("regspace(): unsigned version"); - - vec_type x; - - if( (delta == uT(+1)) && (start <= end) ) - { - internal_regspace_default_delta(x, start, end); - } - else - { - internal_regspace_var_delta(x, start, delta, end); - } - - if(x.n_elem == 0) - { - if(is_Mat_only::value) { x.set_size(1,0); } - } - - return x; - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_Mat::value, - vec_type - >::result -regspace - ( - const typename vec_type::pod_type start, - const typename vec_type::pod_type end - ) - { - arma_debug_sigprint(); - - vec_type x; - - internal_regspace_default_delta(x, start, end); - - if(x.n_elem == 0) - { - if(is_Mat_only::value) { x.set_size(1,0); } - } - - return x; - } - - - -arma_warn_unused -inline -vec -regspace(const double start, const double delta, const double end) - { - arma_debug_sigprint(); - - return regspace(start, delta, end); - } - - - -arma_warn_unused -inline -vec -regspace(const double start, const double end) - { - arma_debug_sigprint(); - - return regspace(start, end); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_repelem.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_repelem.hpp deleted file mode 100644 index d24292729..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_repelem.hpp +++ /dev/null @@ -1,55 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup fn_repelem -//! @{ - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value, - const Op - >::result -repelem(const T1& A, const uword r, const uword c) - { - arma_debug_sigprint(); - - return Op(A, r, c); - } - - - -template -arma_warn_unused -arma_inline -const SpOp -repelem(const SpBase& A, const uword r, const uword c) - { - arma_debug_sigprint(); - - return SpOp(A.get_ref(), r, c); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_repmat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_repmat.hpp deleted file mode 100644 index c662be134..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_repmat.hpp +++ /dev/null @@ -1,55 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup fn_repmat -//! @{ - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value, - const Op - >::result -repmat(const T1& A, const uword r, const uword c) - { - arma_debug_sigprint(); - - return Op(A, r, c); - } - - - -template -arma_warn_unused -arma_inline -const SpOp -repmat(const SpBase& A, const uword r, const uword c) - { - arma_debug_sigprint(); - - return SpOp(A.get_ref(), r, c); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_reshape.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_reshape.hpp deleted file mode 100644 index d64603f3a..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_reshape.hpp +++ /dev/null @@ -1,138 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_reshape -//! @{ - - - -template -arma_warn_unused -inline -typename enable_if2< is_arma_type::value, const Op >::result -reshape(const T1& X, const uword new_n_rows, const uword new_n_cols) - { - arma_debug_sigprint(); - - return Op(X, new_n_rows, new_n_cols); - } - - - -template -arma_warn_unused -inline -typename enable_if2< is_arma_type::value, const Op >::result -reshape(const T1& X, const SizeMat& s) - { - arma_debug_sigprint(); - - return Op(X, s.n_rows, s.n_cols); - } - - - -template -arma_frown("don't use this form: it will be removed") -inline -Mat -reshape(const Base& X, const uword new_n_rows, const uword new_n_cols, const uword dim) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - arma_conform_check( (dim > 1), "reshape(): parameter 'dim' must be 0 or 1" ); - - const quasi_unwrap U(X.get_ref()); - const Mat& A = U.M; - - Mat out; - - if(dim == 0) - { - op_reshape::apply_mat_noalias(out, A, new_n_rows, new_n_cols); - } - else - if(dim == 1) - { - Mat tmp; - - op_strans::apply_mat_noalias(tmp, A); - - op_reshape::apply_mat_noalias(out, tmp, new_n_rows, new_n_cols); - } - - return out; - } - - - -template -arma_warn_unused -inline -const OpCube -reshape(const BaseCube& X, const uword new_n_rows, const uword new_n_cols, const uword new_n_slices) - { - arma_debug_sigprint(); - - return OpCube(X.get_ref(), new_n_rows, new_n_cols, new_n_slices); - } - - - -template -arma_warn_unused -inline -const OpCube -reshape(const BaseCube& X, const SizeCube& s) - { - arma_debug_sigprint(); - - return OpCube(X.get_ref(), s.n_rows, s.n_cols, s.n_slices); - } - - - -template -arma_warn_unused -inline -const SpOp -reshape(const SpBase& X, const uword new_n_rows, const uword new_n_cols) - { - arma_debug_sigprint(); - - return SpOp(X.get_ref(), new_n_rows, new_n_cols); - } - - - -template -arma_warn_unused -inline -const SpOp -reshape(const SpBase& X, const SizeMat& s) - { - arma_debug_sigprint(); - - return SpOp(X.get_ref(), s.n_rows, s.n_cols); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_resize.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_resize.hpp deleted file mode 100644 index c61bd268d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_resize.hpp +++ /dev/null @@ -1,102 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_resize -//! @{ - - - -template -arma_warn_unused -inline -const Op -resize(const Base& X, const uword in_n_rows, const uword in_n_cols) - { - arma_debug_sigprint(); - - return Op(X.get_ref(), in_n_rows, in_n_cols); - } - - - -template -arma_warn_unused -inline -const Op -resize(const Base& X, const SizeMat& s) - { - arma_debug_sigprint(); - - return Op(X.get_ref(), s.n_rows, s.n_cols); - } - - - -template -arma_warn_unused -inline -const OpCube -resize(const BaseCube& X, const uword in_n_rows, const uword in_n_cols, const uword in_n_slices) - { - arma_debug_sigprint(); - - return OpCube(X.get_ref(), in_n_rows, in_n_cols, in_n_slices); - } - - - -template -arma_warn_unused -inline -const OpCube -resize(const BaseCube& X, const SizeCube& s) - { - arma_debug_sigprint(); - - return OpCube(X.get_ref(), s.n_rows, s.n_cols, s.n_slices); - } - - - -template -arma_warn_unused -inline -const SpOp -resize(const SpBase& X, const uword in_n_rows, const uword in_n_cols) - { - arma_debug_sigprint(); - - return SpOp(X.get_ref(), in_n_rows, in_n_cols); - } - - - -template -arma_warn_unused -inline -const SpOp -resize(const SpBase& X, const SizeMat& s) - { - arma_debug_sigprint(); - - return SpOp(X.get_ref(), s.n_rows, s.n_cols); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_reverse.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_reverse.hpp deleted file mode 100644 index 46d50beac..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_reverse.hpp +++ /dev/null @@ -1,100 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_reverse -//! @{ - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::yes, - const Op - >::result -reverse - ( - const T1& X - ) - { - arma_debug_sigprint(); - - return Op(X); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::no, - const Op - >::result -reverse - ( - const T1& X - ) - { - arma_debug_sigprint(); - - return Op(X, 0, 0); - } - - - -template -arma_warn_unused -inline -typename enable_if2< is_arma_type::value, const Op >::result -reverse - ( - const T1& X, - const uword dim - ) - { - arma_debug_sigprint(); - - return Op(X, dim, 0); - } - - - -template -arma_warn_unused -inline -const SpOp -reverse - ( - const SpBase& X, - const uword dim = 0 - ) - { - arma_debug_sigprint(); - - return SpOp(X.get_ref(), dim, 0); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_roots.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_roots.hpp deleted file mode 100644 index 4779aaaf4..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_roots.hpp +++ /dev/null @@ -1,67 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_roots -//! @{ - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_supported_blas_type::value, - const mtOp, T1, op_roots> - >::result -roots(const Base& X) - { - arma_debug_sigprint(); - - return mtOp, T1, op_roots>(X.get_ref()); - } - - - -template -inline -typename -enable_if2 - < - is_supported_blas_type::value, - bool - >::result -roots(Mat< std::complex >& out, const Base& X) - { - arma_debug_sigprint(); - - const bool status = op_roots::apply_direct(out, X.get_ref()); - - if(status == false) - { - out.soft_reset(); - arma_warn(3, "roots(): eigen decomposition failed"); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_schur.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_schur.hpp deleted file mode 100644 index 1dcfc9082..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_schur.hpp +++ /dev/null @@ -1,114 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_schur -//! @{ - - -template -inline -bool -schur - ( - Mat& S, - const Base& X, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - - Mat U; - - const bool status = auxlib::schur(U, S, X.get_ref(), false); - - if(status == false) - { - S.soft_reset(); - arma_warn(3, "schur(): decomposition failed"); - } - - return status; - } - - - -template -arma_warn_unused -inline -Mat -schur - ( - const Base& X, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - - Mat S; - Mat U; - - const bool status = auxlib::schur(U, S, X.get_ref(), false); - - if(status == false) - { - S.soft_reset(); - arma_stop_runtime_error("schur(): decomposition failed"); - } - - return S; - } - - - -template -inline -bool -schur - ( - Mat& U, - Mat& S, - const Base& X, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - arma_conform_check( void_ptr(&U) == void_ptr(&S), "schur(): 'U' is an alias of 'S'" ); - - const bool status = auxlib::schur(U, S, X.get_ref(), true); - - if(status == false) - { - U.soft_reset(); - S.soft_reset(); - arma_warn(3, "schur(): decomposition failed"); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_shift.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_shift.hpp deleted file mode 100644 index 3ee13a213..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_shift.hpp +++ /dev/null @@ -1,153 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup fn_shift -//! @{ - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::yes, - const Op - >::result -shift - ( - const T1& X, - const sword N - ) - { - arma_debug_sigprint(); - - const uword len = (N < 0) ? uword(-N) : uword(N); - const uword neg = (N < 0) ? uword( 1) : uword(0); - - return Op(X, len, neg); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::no, - Mat - >::result -shift - ( - const T1& X, - const sword N - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword len = (N < 0) ? uword(-N) : uword(N); - const uword neg = (N < 0) ? uword( 1) : uword(0); - - quasi_unwrap U(X); - - Mat out; - - op_shift::apply_noalias(out, U.M, len, neg, 0); - - return out; - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - (is_arma_type::value), - Mat - >::result -shift - ( - const T1& X, - const sword N, - const uword dim - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - arma_conform_check( (dim > 1), "shift(): parameter 'dim' must be 0 or 1" ); - - const uword len = (N < 0) ? uword(-N) : uword(N); - const uword neg = (N < 0) ? uword( 1) : uword(0); - - quasi_unwrap U(X); - - Mat out; - - op_shift::apply_noalias(out, U.M, len, neg, dim); - - return out; - } - - - -// - - - -template -arma_warn_unused -inline -SpMat -shift - ( - const SpBase& expr, - const sword N, - const uword dim = 0 - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - arma_conform_check( (dim > 1), "shift(): parameter 'dim' must be 0 or 1" ); - - const uword len = (N < 0) ? uword(-N) : uword(N); - const uword neg = (N < 0) ? uword( 1) : uword(0); - - unwrap_spmat U(expr.get_ref()); - - SpMat out; - - spop_shift::apply_noalias(out, U.M, len, neg, dim); - - return out; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_shuffle.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_shuffle.hpp deleted file mode 100644 index 2cd46314d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_shuffle.hpp +++ /dev/null @@ -1,88 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup fn_shuffle -//! @{ - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::yes, - const Op - >::result -shuffle - ( - const T1& X - ) - { - arma_debug_sigprint(); - - return Op(X); - } - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::no, - const Op - >::result -shuffle - ( - const T1& X - ) - { - arma_debug_sigprint(); - - return Op(X, 0, 0); - } - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - (is_arma_type::value), - const Op - >::result -shuffle - ( - const T1& X, - const uword dim - ) - { - arma_debug_sigprint(); - - return Op(X, dim, 0); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_size.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_size.hpp deleted file mode 100644 index 50258d2c9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_size.hpp +++ /dev/null @@ -1,327 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_size -//! @{ - - - -arma_warn_unused -inline -const SizeMat -size(const uword n_rows, const uword n_cols) - { - arma_debug_sigprint(); - - return SizeMat(n_rows, n_cols); - } - - - -template -arma_warn_unused -inline -const SizeMat -size(const Base& X) - { - arma_debug_sigprint(); - - const Proxy P(X.get_ref()); - - return SizeMat( P.get_n_rows(), P.get_n_cols() ); - } - - - -// explicit overload to workround ADL issues with C++17 std::size() -template -arma_warn_unused -inline -const SizeMat -size(const Mat& X) - { - arma_debug_sigprint(); - - return SizeMat( X.n_rows, X.n_cols ); - } - - - -// explicit overload to workround ADL issues with C++17 std::size() -template -arma_warn_unused -inline -const SizeMat -size(const Row& X) - { - arma_debug_sigprint(); - - return SizeMat( X.n_rows, X.n_cols ); - } - - - -// explicit overload to workround ADL issues with C++17 std::size() -template -arma_warn_unused -inline -const SizeMat -size(const Col& X) - { - arma_debug_sigprint(); - - return SizeMat( X.n_rows, X.n_cols ); - } - - - -arma_warn_unused -inline -const SizeMat -size(const arma::span& row_span, const arma::span& col_span) - { - arma_debug_sigprint(); - - uword n_rows = 0; - uword n_cols = 0; - - if(row_span.whole || col_span.whole) - { - arma_conform_check(true, "size(): span::all not supported"); - } - else - { - if((row_span.a > row_span.b) || (col_span.a > col_span.b)) - { - arma_conform_check_bounds(true, "size(): span indices incorrectly used"); - } - else - { - n_rows = row_span.b - row_span.a + 1; - n_cols = col_span.b - col_span.a + 1; - } - } - - return SizeMat(n_rows, n_cols); - } - - - -template -arma_warn_unused -inline -uword -size(const Base& X, const uword dim) - { - arma_debug_sigprint(); - - const Proxy P(X.get_ref()); - - return SizeMat( P.get_n_rows(), P.get_n_cols() )( dim ); - } - - - -arma_warn_unused -inline -const SizeCube -size(const uword n_rows, const uword n_cols, const uword n_slices) - { - arma_debug_sigprint(); - - return SizeCube(n_rows, n_cols, n_slices); - } - - - -template -arma_warn_unused -inline -const SizeCube -size(const BaseCube& X) - { - arma_debug_sigprint(); - - const ProxyCube P(X.get_ref()); - - return SizeCube( P.get_n_rows(), P.get_n_cols(), P.get_n_slices() ); - } - - - -// explicit overload to workround ADL issues with C++17 std::size() -template -arma_warn_unused -inline -const SizeCube -size(const Cube& X) - { - arma_debug_sigprint(); - - return SizeCube( X.n_rows, X.n_cols, X.n_slices ); - } - - - -template -arma_warn_unused -inline -uword -size(const BaseCube& X, const uword dim) - { - arma_debug_sigprint(); - - const ProxyCube P(X.get_ref()); - - return SizeCube( P.get_n_rows(), P.get_n_cols(), P.get_n_slices() )( dim ); - } - - - -arma_warn_unused -inline -const SizeCube -size(const arma::span& row_span, const arma::span& col_span, const arma::span& slice_span) - { - arma_debug_sigprint(); - - uword n_rows = 0; - uword n_cols = 0; - uword n_slices = 0; - - if(row_span.whole || col_span.whole || slice_span.whole) - { - arma_conform_check(true, "size(): span::all not supported"); - } - else - { - if((row_span.a > row_span.b) || (col_span.a > col_span.b) || (slice_span.a > slice_span.b)) - { - arma_conform_check_bounds(true, "size(): span indices incorrectly used"); - } - else - { - n_rows = row_span.b - row_span.a + 1; - n_cols = col_span.b - col_span.a + 1; - n_slices = slice_span.b - slice_span.a + 1; - } - } - - return SizeCube(n_rows, n_cols, n_slices); - } - - - -template -arma_warn_unused -inline -const SizeMat -size(const SpBase& X) - { - arma_debug_sigprint(); - - const SpProxy P(X.get_ref()); - - return SizeMat( P.get_n_rows(), P.get_n_cols() ); - } - - - -// explicit overload to workround ADL issues with C++17 std::size() -template -arma_warn_unused -inline -const SizeMat -size(const SpMat& X) - { - arma_debug_sigprint(); - - return SizeMat( X.n_rows, X.n_cols ); - } - - - -template -arma_warn_unused -inline -uword -size(const SpBase& X, const uword dim) - { - arma_debug_sigprint(); - - const SpProxy P(X.get_ref()); - - return SizeMat( P.get_n_rows(), P.get_n_cols() )( dim ); - } - - - - -template -arma_warn_unused -inline -const SizeCube -size(const field& X) - { - arma_debug_sigprint(); - - return SizeCube( X.n_rows, X.n_cols, X.n_slices ); - } - - - -template -arma_warn_unused -inline -uword -size(const field& X, const uword dim) - { - arma_debug_sigprint(); - - return SizeCube( X.n_rows, X.n_cols, X.n_slices )( dim ); - } - - - -template -arma_warn_unused -inline -const SizeCube -size(const subview_field& X) - { - arma_debug_sigprint(); - - return SizeCube( X.n_rows, X.n_cols, X.n_slices ); - } - - - -template -arma_warn_unused -inline -uword -size(const subview_field& X, const uword dim) - { - arma_debug_sigprint(); - - return SizeCube( X.n_rows, X.n_cols, X.n_slices )( dim ); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_solve.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_solve.hpp deleted file mode 100644 index 7c16612d4..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_solve.hpp +++ /dev/null @@ -1,224 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_solve -//! @{ - - - -// -// solve_gen - - -template -arma_warn_unused -inline -typename enable_if2< is_supported_blas_type::value, const Glue >::result -solve - ( - const Base& A, - const Base& B - ) - { - arma_debug_sigprint(); - - return Glue(A.get_ref(), B.get_ref()); - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -solve - ( - Mat& out, - const Base& A, - const Base& B - ) - { - arma_debug_sigprint(); - - const bool status = glue_solve_gen_default::apply(out, A.get_ref(), B.get_ref()); - - if(status == false) - { - out.soft_reset(); - arma_warn(3, "solve(): solution not found"); - } - - return status; - } - - - -template -arma_warn_unused -inline -typename enable_if2< is_supported_blas_type::value, const Glue >::result -solve - ( - const Base& A, - const Base& B, - const solve_opts::opts& opts - ) - { - arma_debug_sigprint(); - - return Glue(A.get_ref(), B.get_ref(), opts.flags); - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -solve - ( - Mat& out, - const Base& A, - const Base& B, - const solve_opts::opts& opts - ) - { - arma_debug_sigprint(); - - const bool status = glue_solve_gen_full::apply(out, A.get_ref(), B.get_ref(), opts.flags); - - if(status == false) - { - out.soft_reset(); - arma_warn(3, "solve(): solution not found"); - } - - return status; - } - - - -// -// solve_tri - - -template -arma_warn_unused -inline -typename enable_if2< is_supported_blas_type::value, const Glue >::result -solve - ( - const Op& A, - const Base& B - ) - { - arma_debug_sigprint(); - - uword flags = uword(0); - - if(A.aux_uword_a == 0) { flags |= solve_opts::flag_triu; } - if(A.aux_uword_a == 1) { flags |= solve_opts::flag_tril; } - - return Glue(A.m, B.get_ref(), flags); - } - - - -template -arma_warn_unused -inline -typename enable_if2< is_supported_blas_type::value, const Glue >::result -solve - ( - const Op& A, - const Base& B, - const solve_opts::opts& opts - ) - { - arma_debug_sigprint(); - - uword flags = opts.flags; - - if(A.aux_uword_a == 0) { flags |= solve_opts::flag_triu; } - if(A.aux_uword_a == 1) { flags |= solve_opts::flag_tril; } - - return Glue(A.m, B.get_ref(), flags); - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -solve - ( - Mat& out, - const Op& A, - const Base& B - ) - { - arma_debug_sigprint(); - - uword flags = uword(0); - - if(A.aux_uword_a == 0) { flags |= solve_opts::flag_triu; } - if(A.aux_uword_a == 1) { flags |= solve_opts::flag_tril; } - - const bool status = glue_solve_tri_default::apply(out, A.m, B.get_ref(), flags); - - if(status == false) - { - out.soft_reset(); - arma_warn(3, "solve(): solution not found"); - } - - return status; - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -solve - ( - Mat& out, - const Op& A, - const Base& B, - const solve_opts::opts& opts - ) - { - arma_debug_sigprint(); - - uword flags = opts.flags; - - if(A.aux_uword_a == 0) { flags |= solve_opts::flag_triu; } - if(A.aux_uword_a == 1) { flags |= solve_opts::flag_tril; } - - const bool status = glue_solve_tri_full::apply(out, A.m, B.get_ref(), flags); - - if(status == false) - { - out.soft_reset(); - arma_warn(3, "solve(): solution not found"); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_sort.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_sort.hpp deleted file mode 100644 index f773223e2..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_sort.hpp +++ /dev/null @@ -1,151 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_sort -//! @{ - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::yes, - const Op - >::result -sort - ( - const T1& X - ) - { - arma_debug_sigprint(); - - return Op(X, 0, 0); - } - - - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::no, - const Op - >::result -sort - ( - const T1& X - ) - { - arma_debug_sigprint(); - - return Op(X, 0, 0); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::yes && is_same_type::value, - const Op - >::result -sort - ( - const T1& X, - const T2* sort_direction - ) - { - arma_debug_sigprint(); - - const char sig = (sort_direction != nullptr) ? sort_direction[0] : char(0); - - arma_conform_check( (sig != 'a') && (sig != 'd'), "sort(): unknown sort direction" ); - - const uword sort_type = (sig == 'a') ? 0 : 1; - - return Op(X, sort_type, 0); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::no && is_same_type::value, - const Op - >::result -sort - ( - const T1& X, - const T2* sort_direction - ) - { - arma_debug_sigprint(); - - const char sig = (sort_direction != nullptr) ? sort_direction[0] : char(0); - - arma_conform_check( (sig != 'a') && (sig != 'd'), "sort(): unknown sort direction" ); - - const uword sort_type = (sig == 'a') ? 0 : 1; - - return Op(X, sort_type, 0); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - ( (is_arma_type::value) && (is_same_type::value) ), - const Op - >::result -sort - ( - const T1& X, - const T2* sort_direction, - const uword dim - ) - { - arma_debug_sigprint(); - - const char sig = (sort_direction != nullptr) ? sort_direction[0] : char(0); - - arma_conform_check( (sig != 'a') && (sig != 'd'), "sort(): unknown sort direction" ); - - const uword sort_type = (sig == 'a') ? 0 : 1; - - return Op(X, sort_type, dim); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_sort_index.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_sort_index.hpp deleted file mode 100644 index 6796a9b6a..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_sort_index.hpp +++ /dev/null @@ -1,112 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_sort_index -//! @{ - - - -template -arma_warn_unused -arma_inline -const mtOp -sort_index - ( - const Base& X - ) - { - arma_debug_sigprint(); - - return mtOp(X.get_ref(), uword(0), uword(0)); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - ( (is_arma_type::value) && (is_same_type::value) ), - const mtOp - >::result -sort_index - ( - const T1& X, - const T2* sort_direction - ) - { - arma_debug_sigprint(); - - const char sig = (sort_direction != nullptr) ? sort_direction[0] : char(0); - - arma_conform_check( ((sig != 'a') && (sig != 'd')), "sort_index(): unknown sort direction" ); - - return mtOp(X, ((sig == 'a') ? uword(0) : uword(1)), uword(0)); - } - - - -// - - - -template -arma_warn_unused -arma_inline -const mtOp -stable_sort_index - ( - const Base& X - ) - { - arma_debug_sigprint(); - - return mtOp(X.get_ref(), uword(0), uword(0)); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - ( (is_arma_type::value) && (is_same_type::value) ), - const mtOp - >::result -stable_sort_index - ( - const T1& X, - const T2* sort_direction - ) - { - arma_debug_sigprint(); - - const char sig = (sort_direction != nullptr) ? sort_direction[0] : char(0); - - arma_conform_check( ((sig != 'a') && (sig != 'd')), "stable_sort_index(): unknown sort direction" ); - - return mtOp(X, ((sig == 'a') ? uword(0) : uword(1)), uword(0)); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_speye.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_speye.hpp deleted file mode 100644 index 680d361bc..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_speye.hpp +++ /dev/null @@ -1,93 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_speye -//! @{ - - - -//! Generate a sparse matrix with the values along the main diagonal set to one -template -arma_warn_unused -inline -obj_type -speye(const uword n_rows, const uword n_cols, const typename arma_SpMat_SpCol_SpRow_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - if(is_SpCol::value) { arma_conform_check( (n_cols != 1), "speye(): incompatible size" ); } - if(is_SpRow::value) { arma_conform_check( (n_rows != 1), "speye(): incompatible size" ); } - - obj_type out; - - out.eye(n_rows, n_cols); - - return out; - } - - - -template -arma_warn_unused -inline -obj_type -speye(const SizeMat& s, const typename arma_SpMat_SpCol_SpRow_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return speye(s.n_rows, s.n_cols); - } - - - -// Convenience shortcut method (no template parameter necessary) -arma_warn_unused -inline -sp_mat -speye(const uword n_rows, const uword n_cols) - { - arma_debug_sigprint(); - - sp_mat out; - - out.eye(n_rows, n_cols); - - return out; - } - - - -arma_warn_unused -inline -sp_mat -speye(const SizeMat& s) - { - arma_debug_sigprint(); - - sp_mat out; - - out.eye(s.n_rows, s.n_cols); - - return out; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_spones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_spones.hpp deleted file mode 100644 index e3f4ac485..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_spones.hpp +++ /dev/null @@ -1,47 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_spones -//! @{ - - - -//! Generate a sparse matrix with the non-zero values in the same locations as in the given sparse matrix X, -//! with the non-zero values set to one -template -arma_warn_unused -inline -SpMat -spones(const SpBase& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat U(X.get_ref()); - - SpMat out(arma_layout_indicator(), U.M); - - arrayops::inplace_set( access::rwp(out.values), eT(1), out.n_nonzero ); - - return out; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_sprandn.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_sprandn.hpp deleted file mode 100644 index 4e39278d9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_sprandn.hpp +++ /dev/null @@ -1,127 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_sprandn -//! @{ - - - -//! Generate a sparse matrix with a randomly selected subset of the elements -//! set to random values from a Gaussian distribution with zero mean and unit variance -template -arma_warn_unused -inline -obj_type -sprandn - ( - const uword n_rows, - const uword n_cols, - const double density, - const typename arma_SpMat_SpCol_SpRow_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - if(is_SpCol::value) - { - arma_conform_check( (n_cols != 1), "sprandn(): incompatible size" ); - } - else - if(is_SpRow::value) - { - arma_conform_check( (n_rows != 1), "sprandn(): incompatible size" ); - } - - obj_type out; - - out.sprandn(n_rows, n_cols, density); - - return out; - } - - - -template -arma_warn_unused -inline -obj_type -sprandn(const SizeMat& s, const double density, const typename arma_SpMat_SpCol_SpRow_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return sprandn(s.n_rows, s.n_cols, density); - } - - - -arma_warn_unused -inline -sp_mat -sprandn(const uword n_rows, const uword n_cols, const double density) - { - arma_debug_sigprint(); - - sp_mat out; - - out.sprandn(n_rows, n_cols, density); - - return out; - } - - - -arma_warn_unused -inline -sp_mat -sprandn(const SizeMat& s, const double density) - { - arma_debug_sigprint(); - - sp_mat out; - - out.sprandn(s.n_rows, s.n_cols, density); - - return out; - } - - - -//! Generate a sparse matrix with the non-zero values in the same locations as in the given sparse matrix X, -//! with the non-zero values set to random values from a Gaussian distribution with zero mean and unit variance -template -arma_warn_unused -inline -SpMat -sprandn(const SpBase& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - SpMat out( X.get_ref() ); - - arma_rng::randn::fill( access::rwp(out.values), out.n_nonzero ); - - return out; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_sprandu.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_sprandu.hpp deleted file mode 100644 index 7540d5627..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_sprandu.hpp +++ /dev/null @@ -1,127 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_sprandu -//! @{ - - - -//! Generate a sparse matrix with a randomly selected subset of the elements -//! set to random values in the [0,1] interval (uniform distribution) -template -arma_warn_unused -inline -obj_type -sprandu - ( - const uword n_rows, - const uword n_cols, - const double density, - const typename arma_SpMat_SpCol_SpRow_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - if(is_SpCol::value) - { - arma_conform_check( (n_cols != 1), "sprandu(): incompatible size" ); - } - else - if(is_SpRow::value) - { - arma_conform_check( (n_rows != 1), "sprandu(): incompatible size" ); - } - - obj_type out; - - out.sprandu(n_rows, n_cols, density); - - return out; - } - - - -template -arma_warn_unused -inline -obj_type -sprandu(const SizeMat& s, const double density, const typename arma_SpMat_SpCol_SpRow_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return sprandu(s.n_rows, s.n_cols, density); - } - - - -arma_warn_unused -inline -sp_mat -sprandu(const uword n_rows, const uword n_cols, const double density) - { - arma_debug_sigprint(); - - sp_mat out; - - out.sprandu(n_rows, n_cols, density); - - return out; - } - - - -arma_warn_unused -inline -sp_mat -sprandu(const SizeMat& s, const double density) - { - arma_debug_sigprint(); - - sp_mat out; - - out.sprandu(s.n_rows, s.n_cols, density); - - return out; - } - - - -//! Generate a sparse matrix with the non-zero values in the same locations as in the given sparse matrix X, -//! with the non-zero values set to random values in the [0,1] interval (uniform distribution) -template -arma_warn_unused -inline -SpMat -sprandu(const SpBase& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - SpMat out( X.get_ref() ); - - arma_rng::randu::fill( access::rwp(out.values), out.n_nonzero ); - - return out; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_spsolve.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_spsolve.hpp deleted file mode 100644 index f8ba54ec4..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_spsolve.hpp +++ /dev/null @@ -1,192 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_spsolve -//! @{ - - - -template -inline -bool -spsolve_helper - ( - Mat& out, - const SpBase& A, - const Base& B, - const char* solver, - const spsolve_opts_base& settings, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::pod_type T; - typedef typename T1::elem_type eT; - - const char sig = (solver != nullptr) ? solver[0] : char(0); - - arma_conform_check( ((sig != 'l') && (sig != 's')), "spsolve(): unknown solver" ); - - T rcond = T(0); - - bool status = false; - - superlu_opts superlu_opts_default; - - // if(is_float ::value) { superlu_opts_default.refine = superlu_opts::REF_SINGLE; } - // if(is_double::value) { superlu_opts_default.refine = superlu_opts::REF_DOUBLE; } - - const superlu_opts& opts = (settings.id == 1) ? static_cast(settings) : superlu_opts_default; - - arma_conform_check( ( (opts.pivot_thresh < double(0)) || (opts.pivot_thresh > double(1)) ), "spsolve(): pivot_thresh must be in the [0,1] interval" ); - - if(sig == 's') // SuperLU solver - { - if( (opts.equilibrate == false) && (opts.refine == superlu_opts::REF_NONE) ) - { - status = sp_auxlib::spsolve_simple(out, A.get_ref(), B.get_ref(), opts); - } - else - { - status = sp_auxlib::spsolve_refine(out, rcond, A.get_ref(), B.get_ref(), opts); - } - } - else - if(sig == 'l') // brutal LAPACK solver - { - if( (settings.id != 0) && ((opts.symmetric) || (opts.pivot_thresh != double(1))) ) - { - arma_warn(1, "spsolve(): ignoring settings not applicable to LAPACK based solver"); - } - - Mat AA; - - bool conversion_ok = false; - - try - { - Mat tmp(A.get_ref()); // conversion from sparse to dense can throw std::bad_alloc - - AA.steal_mem(tmp); - - conversion_ok = true; - } - catch(...) - { - arma_warn(1, "spsolve(): not enough memory to use LAPACK based solver"); - } - - if(conversion_ok) - { - arma_conform_check( (AA.n_rows != AA.n_cols), "spsolve(): matrix A must be square sized" ); - - uword flags = solve_opts::flag_none; - - if(opts.refine != superlu_opts::REF_NONE) { flags |= solve_opts::flag_refine; } - if(opts.equilibrate == true ) { flags |= solve_opts::flag_equilibrate; } - if(opts.allow_ugly == true ) { flags |= solve_opts::flag_allow_ugly; } - - status = glue_solve_gen_full::apply(out, AA, B.get_ref(), flags); - } - } - - - if( (status == false) && (rcond > T(0)) ) - { - arma_warn(2, "spsolve(): system is singular (rcond: ", rcond, ")"); - } - - if( (status == true) && (rcond > T(0)) && (rcond < std::numeric_limits::epsilon()) ) - { - arma_warn(2, "solve(): solution computed, but system is singular to working precision (rcond: ", rcond, ")"); - } - - return status; - } - - - -// - - - -template -inline -bool -spsolve - ( - Mat& out, - const SpBase& A, - const Base& B, - const char* solver = "superlu", - const spsolve_opts_base& settings = spsolve_opts_none(), - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const bool status = spsolve_helper(out, A.get_ref(), B.get_ref(), solver, settings); - - if(status == false) - { - out.soft_reset(); - arma_warn(3, "spsolve(): solution not found"); - } - - return status; - } - - - -template -arma_warn_unused -inline -Mat -spsolve - ( - const SpBase& A, - const Base& B, - const char* solver = "superlu", - const spsolve_opts_base& settings = spsolve_opts_none(), - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - - Mat out; - - const bool status = spsolve_helper(out, A.get_ref(), B.get_ref(), solver, settings); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("spsolve(): solution not found"); - } - - return out; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_sqrtmat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_sqrtmat.hpp deleted file mode 100644 index 354e39a04..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_sqrtmat.hpp +++ /dev/null @@ -1,125 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_sqrtmat -//! @{ - - - -template -arma_warn_unused -arma_inline -typename enable_if2< (is_supported_blas_type::value && is_cx::no), const mtOp, T1, op_sqrtmat> >::result -sqrtmat(const Base& X) - { - arma_debug_sigprint(); - - return mtOp, T1, op_sqrtmat>(X.get_ref()); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< (is_supported_blas_type::value && is_cx::yes), const Op >::result -sqrtmat(const Base& X) - { - arma_debug_sigprint(); - - return Op(X.get_ref()); - } - - - -template -inline -typename enable_if2< (is_supported_blas_type::value && is_cx::no), bool >::result -sqrtmat(Mat< std::complex >& Y, const Base& X) - { - arma_debug_sigprint(); - - const bool status = op_sqrtmat::apply_direct(Y, X.get_ref()); - - if(status == false) - { - arma_warn(3, "sqrtmat(): given matrix is singular; may not have a square root"); - } - - return status; - } - - - -template -inline -typename enable_if2< (is_supported_blas_type::value && is_cx::yes), bool >::result -sqrtmat(Mat& Y, const Base& X) - { - arma_debug_sigprint(); - - const bool status = op_sqrtmat_cx::apply_direct(Y, X.get_ref()); - - if(status == false) - { - arma_warn(3, "sqrtmat(): given matrix is singular; may not have a square root"); - } - - return status; - } - - - -// - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_supported_blas_type::value, const Op >::result -sqrtmat_sympd(const Base& X) - { - arma_debug_sigprint(); - - return Op(X.get_ref()); - } - - - -template -inline -typename enable_if2< is_supported_blas_type::value, bool >::result -sqrtmat_sympd(Mat& Y, const Base& X) - { - arma_debug_sigprint(); - - const bool status = op_sqrtmat_sympd::apply_direct(Y, X.get_ref()); - - if(status == false) - { - Y.soft_reset(); - arma_warn(3, "sqrtmat_sympd(): transformation failed"); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_stddev.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_stddev.hpp deleted file mode 100644 index cb8e2785c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_stddev.hpp +++ /dev/null @@ -1,143 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_stddev -//! @{ - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::yes, - typename T1::pod_type - >::result -stddev(const T1& X, const uword norm_type = 0) - { - arma_debug_sigprint(); - - return op_stddev::stddev_vec(X, norm_type); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::no, - const mtOp - >::result -stddev(const T1& X, const uword norm_type = 0) - { - arma_debug_sigprint(); - - return mtOp(X, norm_type, 0); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value, - const mtOp - >::result -stddev(const T1& X, const uword norm_type, const uword dim) - { - arma_debug_sigprint(); - - return mtOp(X, norm_type, dim); - } - - - -template -arma_warn_unused -inline -typename arma_scalar_only::result -stddev(const T&) - { - return T(0); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value && resolves_to_sparse_vector::yes, - typename T1::pod_type - >::result -stddev(const T1& X, const uword norm_type = 0) - { - arma_debug_sigprint(); - - return op_sp_stddev::stddev_vec(X, norm_type); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value && resolves_to_sparse_vector::no, - const mtSpReduceOp - >::result -stddev(const T1& X, const uword norm_type = 0) - { - arma_debug_sigprint(); - - return mtSpReduceOp(X, norm_type, 0); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value, - const mtSpReduceOp - >::result -stddev(const T1& X, const uword norm_type, const uword dim) - { - arma_debug_sigprint(); - - return mtSpReduceOp(X, norm_type, dim); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_strans.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_strans.hpp deleted file mode 100644 index 9ce812f74..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_strans.hpp +++ /dev/null @@ -1,110 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_strans -//! @{ - - - -template -arma_warn_unused -arma_inline -const Op -strans - ( - const T1& X, - const typename enable_if< is_arma_type::value >::result* junk1 = nullptr, - const typename arma_cx_only::result* junk2 = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - return Op(X); - } - - - -// NOTE: for non-complex objects, deliberately returning op_htrans instead of op_strans, -// NOTE: due to currently more optimisations available when using op_htrans, especially by glue_times -template -arma_warn_unused -arma_inline -const Op -strans - ( - const T1& X, - const typename enable_if< is_arma_type::value >::result* junk1 = nullptr, - const typename arma_not_cx::result* junk2 = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - return Op(X); - } - - - -// -// handling of sparse matrices - - -template -arma_warn_unused -arma_inline -const SpOp -strans - ( - const T1& X, - const typename enable_if< is_arma_sparse_type::value >::result* junk1 = nullptr, - const typename arma_cx_only::result* junk2 = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - return SpOp(X); - } - - - -template -arma_warn_unused -arma_inline -const SpOp -strans - ( - const T1& X, - const typename enable_if< is_arma_sparse_type::value >::result* junk1 = nullptr, - const typename arma_not_cx::result* junk2 = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - return SpOp(X); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_sum.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_sum.hpp deleted file mode 100644 index c27b1c4a9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_sum.hpp +++ /dev/null @@ -1,147 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_sum -//! @{ - - -template -arma_warn_unused -inline -typename enable_if2< is_arma_type::value && resolves_to_vector::yes, typename T1::elem_type >::result -sum(const T1& X) - { - arma_debug_sigprint(); - - return accu(X); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value && resolves_to_vector::no, const Op >::result -sum(const T1& X) - { - arma_debug_sigprint(); - - return Op(X, 0, 0); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const Op >::result -sum(const T1& X, const uword dim) - { - arma_debug_sigprint(); - - return Op(X, dim, 0); - } - - - -template -arma_warn_unused -arma_inline -typename arma_scalar_only::result -sum(const T& x) - { - return x; - } - - - -//! sum of cube -template -arma_warn_unused -arma_inline -const OpCube -sum - ( - const BaseCube& X, - const uword dim = 0 - ) - { - arma_debug_sigprint(); - - return OpCube(X.get_ref(), dim, 0); - } - - - -//! sum of sparse object -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value && resolves_to_sparse_vector::yes, - typename T1::elem_type - >::result -sum(const T1& x) - { - arma_debug_sigprint(); - - // sum elements - return accu(x); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value && resolves_to_sparse_vector::no, - const mtSpReduceOp - >::result -sum(const T1& x) - { - arma_debug_sigprint(); - - return mtSpReduceOp(x, 0, 0); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value, - const mtSpReduceOp - >::result -sum(const T1& x, const uword dim) - { - arma_debug_sigprint(); - - return mtSpReduceOp(x, dim, 0); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_svd.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_svd.hpp deleted file mode 100644 index f7c494af3..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_svd.hpp +++ /dev/null @@ -1,206 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_svd -//! @{ - - - -template -inline -bool -svd - ( - Col& S, - const Base& X, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - - Mat A(X.get_ref()); - - const bool status = auxlib::svd_dc(S, A); - - if(status == false) - { - S.soft_reset(); - arma_warn(3, "svd(): decomposition failed"); - } - - return status; - } - - - -template -arma_warn_unused -inline -Col -svd - ( - const Base& X, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - Col out; - - Mat A(X.get_ref()); - - const bool status = auxlib::svd_dc(out, A); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("svd(): decomposition failed"); - } - - return out; - } - - - -template -inline -bool -svd - ( - Mat& U, - Col& S, - Mat& V, - const Base& X, - const char* method = "dc", - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - - arma_conform_check - ( - ( ((void*)(&U) == (void*)(&S)) || (&U == &V) || ((void*)(&S) == (void*)(&V)) ), - "svd(): two or more output objects are the same object" - ); - - const char sig = (method != nullptr) ? method[0] : char(0); - - arma_conform_check( ((sig != 's') && (sig != 'd')), "svd(): unknown method specified" ); - - Mat A(X.get_ref()); - - const bool status = (sig == 'd') ? auxlib::svd_dc(U, S, V, A) : auxlib::svd(U, S, V, A); - - if(status == false) - { - U.soft_reset(); - S.soft_reset(); - V.soft_reset(); - arma_warn(3, "svd(): decomposition failed"); - } - - return status; - } - - - -template -inline -bool -svd_econ - ( - Mat& U, - Col& S, - Mat& V, - const Base& X, - const char mode, - const char* method = "dc", - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - - arma_conform_check - ( - ( ((void*)(&U) == (void*)(&S)) || (&U == &V) || ((void*)(&S) == (void*)(&V)) ), - "svd_econ(): two or more output objects are the same object" - ); - - arma_conform_check - ( - ( (mode != 'l') && (mode != 'r') && (mode != 'b') ), - "svd_econ(): parameter 'mode' is incorrect" - ); - - const char sig = (method != nullptr) ? method[0] : char(0); - - arma_conform_check( ((sig != 's') && (sig != 'd')), "svd_econ(): unknown method specified" ); - - Mat A(X.get_ref()); - - const bool status = ((mode == 'b') && (sig == 'd')) ? auxlib::svd_dc_econ(U, S, V, A) : auxlib::svd_econ(U, S, V, A, mode); - - if(status == false) - { - U.soft_reset(); - S.soft_reset(); - V.soft_reset(); - arma_warn(3, "svd_econ(): decomposition failed"); - } - - return status; - } - - - -template -inline -bool -svd_econ - ( - Mat& U, - Col& S, - Mat& V, - const Base& X, - const char* mode = "both", - const char* method = "dc", - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return svd_econ(U, S, V, X, ((mode != nullptr) ? mode[0] : char(0)), method); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_svds.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_svds.hpp deleted file mode 100644 index 06288443e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_svds.hpp +++ /dev/null @@ -1,352 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_svds -//! @{ - - -template -inline -bool -svds_helper - ( - Mat& U, - Col& S, - Mat& V, - const SpBase& X, - const uword k, - const typename T1::pod_type tol, - const bool calc_UV, - const typename arma_real_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - arma_conform_check - ( - ( ((void*)(&U) == (void*)(&S)) || (&U == &V) || ((void*)(&S) == (void*)(&V)) ), - "svds(): two or more output objects are the same object" - ); - - arma_conform_check( (tol < T(0)), "svds(): tol must be >= 0" ); - - const unwrap_spmat tmp(X.get_ref()); - const SpMat& A = tmp.M; - - const uword kk = (std::min)( (std::min)(A.n_rows, A.n_cols), k ); - - const T A_max = (A.n_nonzero > 0) ? T(max(abs(Col(const_cast(A.values), A.n_nonzero, false)))) : T(0); - - if(A_max == T(0)) - { - // TODO: use reset instead ? - S.zeros(kk); - - if(calc_UV) - { - U.eye(A.n_rows, kk); - V.eye(A.n_cols, kk); - } - } - else - { - SpMat C( (A.n_rows + A.n_cols), (A.n_rows + A.n_cols) ); - - SpMat B = A / A_max; - SpMat Bt = B.t(); - - C(0, A.n_rows, arma::size(B) ) = B; - C(A.n_rows, 0, arma::size(Bt)) = Bt; - - Bt.reset(); - B.reset(); - - Col eigval; - Mat eigvec; - - eigs_opts opts; - opts.tol = (tol / Datum::sqrt2); - - const bool status = eigs_sym(eigval, eigvec, C, kk, "la", opts); - - if(status == false) - { - U.soft_reset(); - S.soft_reset(); - V.soft_reset(); - - return false; - } - - const T A_norm = max(eigval); - - const T tol2 = tol / Datum::sqrt2 * A_norm; - - uvec indices = find(eigval > tol2); - - if(indices.n_elem > kk) - { - indices = indices.subvec(0,kk-1); - } - else - if(indices.n_elem < kk) - { - const uvec indices2 = find(abs(eigval) <= tol2); - - const uword N_extra = (std::min)( indices2.n_elem, (kk - indices.n_elem) ); - - if(N_extra > 0) { indices = join_cols(indices, indices2.subvec(0,N_extra-1)); } - } - - const uvec sorted_indices = sort_index(eigval, "descend"); - - S = eigval.elem(sorted_indices); S *= A_max; - - if(calc_UV) - { - uvec U_row_indices(A.n_rows, arma_nozeros_indicator()); for(uword i=0; i < A.n_rows; ++i) { U_row_indices[i] = i; } - uvec V_row_indices(A.n_cols, arma_nozeros_indicator()); for(uword i=0; i < A.n_cols; ++i) { V_row_indices[i] = i + A.n_rows; } - - U = Datum::sqrt2 * eigvec(U_row_indices, sorted_indices); - V = Datum::sqrt2 * eigvec(V_row_indices, sorted_indices); - } - } - - if(S.n_elem < k) { arma_warn(1, "svds(): found fewer singular values than specified"); } - - return true; - } - - - -template -inline -bool -svds_helper - ( - Mat& U, - Col& S, - Mat& V, - const SpBase& X, - const uword k, - const typename T1::pod_type tol, - const bool calc_UV, - const typename arma_cx_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - if(arma_config::arpack == false) - { - arma_stop_logic_error("svds(): use of ARPACK must be enabled for decomposition of complex matrices"); - return false; - } - - arma_conform_check - ( - ( ((void*)(&U) == (void*)(&S)) || (&U == &V) || ((void*)(&S) == (void*)(&V)) ), - "svds(): two or more output objects are the same object" - ); - - arma_conform_check( (tol < T(0)), "svds(): tol must be >= 0" ); - - const unwrap_spmat tmp(X.get_ref()); - const SpMat& A = tmp.M; - - const uword kk = (std::min)( (std::min)(A.n_rows, A.n_cols), k ); - - const T A_max = (A.n_nonzero > 0) ? T(max(abs(Col(const_cast(A.values), A.n_nonzero, false)))) : T(0); - - if(A_max == T(0)) - { - // TODO: use reset instead ? - S.zeros(kk); - - if(calc_UV) - { - U.eye(A.n_rows, kk); - V.eye(A.n_cols, kk); - } - } - else - { - SpMat C( (A.n_rows + A.n_cols), (A.n_rows + A.n_cols) ); - - SpMat B = A / A_max; - SpMat Bt = B.t(); - - C(0, A.n_rows, arma::size(B) ) = B; - C(A.n_rows, 0, arma::size(Bt)) = Bt; - - Bt.reset(); - B.reset(); - - Col eigval_tmp; - Mat eigvec; - - eigs_opts opts; - opts.tol = (tol / Datum::sqrt2); - - const bool status = eigs_gen(eigval_tmp, eigvec, C, kk, "lr", opts); - - if(status == false) - { - U.soft_reset(); - S.soft_reset(); - V.soft_reset(); - - return false; - } - - const Col eigval = real(eigval_tmp); - - const T A_norm = max(eigval); - - const T tol2 = tol / Datum::sqrt2 * A_norm; - - uvec indices = find(eigval > tol2); - - if(indices.n_elem > kk) - { - indices = indices.subvec(0,kk-1); - } - else - if(indices.n_elem < kk) - { - const uvec indices2 = find(abs(eigval) <= tol2); - - const uword N_extra = (std::min)( indices2.n_elem, (kk - indices.n_elem) ); - - if(N_extra > 0) { indices = join_cols(indices, indices2.subvec(0,N_extra-1)); } - } - - const uvec sorted_indices = sort_index(eigval, "descend"); - - S = eigval.elem(sorted_indices); S *= A_max; - - if(calc_UV) - { - uvec U_row_indices(A.n_rows, arma_nozeros_indicator()); for(uword i=0; i < A.n_rows; ++i) { U_row_indices[i] = i; } - uvec V_row_indices(A.n_cols, arma_nozeros_indicator()); for(uword i=0; i < A.n_cols; ++i) { V_row_indices[i] = i + A.n_rows; } - - U = Datum::sqrt2 * eigvec(U_row_indices, sorted_indices); - V = Datum::sqrt2 * eigvec(V_row_indices, sorted_indices); - } - } - - if(S.n_elem < k) { arma_warn(1, "svds(): found fewer singular values than specified"); } - - return true; - } - - - -//! find the k largest singular values and corresponding singular vectors of sparse matrix X -template -inline -bool -svds - ( - Mat& U, - Col& S, - Mat& V, - const SpBase& X, - const uword k, - const typename T1::pod_type tol = 0.0, - const typename arma_real_or_cx_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const bool status = svds_helper(U, S, V, X.get_ref(), k, tol, true); - - if(status == false) { arma_warn(3, "svds(): decomposition failed"); } - - return status; - } - - - -//! find the k largest singular values of sparse matrix X -template -inline -bool -svds - ( - Col& S, - const SpBase& X, - const uword k, - const typename T1::pod_type tol = 0.0, - const typename arma_real_or_cx_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - Mat U; - Mat V; - - const bool status = svds_helper(U, S, V, X.get_ref(), k, tol, false); - - if(status == false) { arma_warn(3, "svds(): decomposition failed"); } - - return status; - } - - - -//! find the k largest singular values of sparse matrix X -template -arma_warn_unused -inline -Col -svds - ( - const SpBase& X, - const uword k, - const typename T1::pod_type tol = 0.0, - const typename arma_real_or_cx_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - Col S; - - Mat U; - Mat V; - - const bool status = svds_helper(U, S, V, X.get_ref(), k, tol, false); - - if(status == false) { arma_stop_runtime_error("svds(): decomposition failed"); } - - return S; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_sylvester.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_sylvester.hpp deleted file mode 100644 index 323c9e863..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_sylvester.hpp +++ /dev/null @@ -1,137 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_syl_lyap -//! @{ - - -//! find the solution of the Sylvester equation AX + XB = C -template -inline -bool -syl - ( - Mat & out, - const Base& in_A, - const Base& in_B, - const Base& in_C, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - - const unwrap_check tmp_A(in_A.get_ref(), out); - const unwrap_check tmp_B(in_B.get_ref(), out); - const unwrap_check tmp_C(in_C.get_ref(), out); - - const Mat& A = tmp_A.M; - const Mat& B = tmp_B.M; - const Mat& C = tmp_C.M; - - const bool status = auxlib::syl(out, A, B, C); - - if(status == false) - { - out.soft_reset(); - arma_warn(3, "syl(): solution not found"); - } - - return status; - } - - - -template -inline -bool -sylvester - ( - Mat & out, - const Base& in_A, - const Base& in_B, - const Base& in_C, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_ignore(junk); - return syl(out, in_A, in_B, in_C); - } - - - -template -arma_warn_unused -inline -Mat -syl - ( - const Base& in_A, - const Base& in_B, - const Base& in_C, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - - const unwrap tmp_A( in_A.get_ref() ); - const unwrap tmp_B( in_B.get_ref() ); - const unwrap tmp_C( in_C.get_ref() ); - - const Mat& A = tmp_A.M; - const Mat& B = tmp_B.M; - const Mat& C = tmp_C.M; - - Mat out; - - const bool status = auxlib::syl(out, A, B, C); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("syl(): solution not found"); - } - - return out; - } - - - -template -arma_warn_unused -inline -Mat -sylvester - ( - const Base& in_A, - const Base& in_B, - const Base& in_C, - const typename arma_blas_type_only::result* junk = nullptr - ) - { - arma_ignore(junk); - return syl(in_A, in_B, in_C); - } - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_symmat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_symmat.hpp deleted file mode 100644 index 54b7cb63e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_symmat.hpp +++ /dev/null @@ -1,135 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_symmat -//! @{ - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_cx::no, const Op >::result -symmatu(const Base& X, const bool do_conj = false) - { - arma_debug_sigprint(); - arma_ignore(do_conj); - - return Op(X.get_ref()); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_cx::no, const Op >::result -symmatl(const Base& X, const bool do_conj = false) - { - arma_debug_sigprint(); - arma_ignore(do_conj); - - return Op(X.get_ref()); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_cx::yes, const Op >::result -symmatu(const Base& X, const bool do_conj = true) - { - arma_debug_sigprint(); - - return Op(X.get_ref(), 0, (do_conj ? 1 : 0)); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_cx::yes, const Op >::result -symmatl(const Base& X, const bool do_conj = true) - { - arma_debug_sigprint(); - - return Op(X.get_ref(), 0, (do_conj ? 1 : 0)); - } - - - -// - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_cx::no, const SpOp >::result -symmatu(const SpBase& X, const bool do_conj = false) - { - arma_debug_sigprint(); - arma_ignore(do_conj); - - return SpOp(X.get_ref(), 0, 0); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_cx::no, const SpOp >::result -symmatl(const SpBase& X, const bool do_conj = false) - { - arma_debug_sigprint(); - arma_ignore(do_conj); - - return SpOp(X.get_ref(), 1, 0); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_cx::yes, const SpOp >::result -symmatu(const SpBase& X, const bool do_conj = true) - { - arma_debug_sigprint(); - - return SpOp(X.get_ref(), 0, (do_conj ? 1 : 0)); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_cx::yes, const SpOp >::result -symmatl(const SpBase& X, const bool do_conj = true) - { - arma_debug_sigprint(); - - return SpOp(X.get_ref(), 1, (do_conj ? 1 : 0)); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_toeplitz.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_toeplitz.hpp deleted file mode 100644 index 66c921b36..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_toeplitz.hpp +++ /dev/null @@ -1,63 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_toeplitz -//! @{ - - - -template -arma_warn_unused -inline -const Op -toeplitz(const Base& X) - { - arma_debug_sigprint(); - - return Op( X.get_ref() ); - } - - - -template -arma_warn_unused -inline -const Op -circ_toeplitz(const Base& X) - { - arma_debug_sigprint(); - - return Op( X.get_ref() ); - } - - - -template -arma_warn_unused -inline -const Glue -toeplitz(const Base& X, const Base& Y) - { - arma_debug_sigprint(); - - return Glue( X.get_ref(), Y.get_ref() ); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_trace.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_trace.hpp deleted file mode 100644 index 4ec04f2c7..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_trace.hpp +++ /dev/null @@ -1,663 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_trace -//! @{ - - -template -arma_warn_unused -inline -typename T1::elem_type -trace(const Base& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const Proxy P(X.get_ref()); - - const uword N = (std::min)(P.get_n_rows(), P.get_n_cols()); - - eT val1 = eT(0); - eT val2 = eT(0); - - uword i,j; - for(i=0, j=1; j -arma_warn_unused -inline -typename T1::elem_type -trace(const Op& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const diagmat_proxy A(X.m); - - const uword N = (std::min)(A.n_rows, A.n_cols); - - eT val = eT(0); - - for(uword i=0; i -arma_warn_unused -inline -typename enable_if2< is_cx::no, typename T1::elem_type>::result -trace(const Glue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const partial_unwrap tmp1(X.A); - const partial_unwrap tmp2(X.B); - - const typename partial_unwrap::stored_type& A = tmp1.M; - const typename partial_unwrap::stored_type& B = tmp2.M; - - const bool use_alpha = partial_unwrap::do_times || partial_unwrap::do_times; - const eT alpha = use_alpha ? (tmp1.get_val() * tmp2.get_val()) : eT(0); - - arma_conform_assert_trans_mul_size< partial_unwrap::do_trans, partial_unwrap::do_trans >(A.n_rows, A.n_cols, B.n_rows, B.n_cols, "matrix multiplication"); - - if( (A.n_elem == 0) || (B.n_elem == 0) ) { return eT(0); } - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - eT acc = eT(0); - - if( (partial_unwrap::do_trans == false) && (partial_unwrap::do_trans == false) ) - { - const uword N = (std::min)(A_n_rows, B_n_cols); - - eT acc1 = eT(0); - eT acc2 = eT(0); - - for(uword k=0; k < N; ++k) - { - const eT* B_colptr = B.colptr(k); - - // condition: A_n_cols = B_n_rows - - uword j; - - for(j=1; j < A_n_cols; j+=2) - { - const uword i = (j-1); - - const eT tmp_i = B_colptr[i]; - const eT tmp_j = B_colptr[j]; - - acc1 += A.at(k, i) * tmp_i; - acc2 += A.at(k, j) * tmp_j; - } - - const uword i = (j-1); - - if(i < A_n_cols) - { - acc1 += A.at(k, i) * B_colptr[i]; - } - } - - acc = (acc1 + acc2); - } - else - if( (partial_unwrap::do_trans == true ) && (partial_unwrap::do_trans == false) ) - { - const uword N = (std::min)(A_n_cols, B_n_cols); - - for(uword k=0; k < N; ++k) - { - const eT* A_colptr = A.colptr(k); - const eT* B_colptr = B.colptr(k); - - // condition: A_n_rows = B_n_rows - acc += op_dot::direct_dot(A_n_rows, A_colptr, B_colptr); - } - } - else - if( (partial_unwrap::do_trans == false) && (partial_unwrap::do_trans == true ) ) - { - const uword N = (std::min)(A_n_rows, B_n_rows); - - for(uword k=0; k < N; ++k) - { - // condition: A_n_cols = B_n_cols - for(uword i=0; i < A_n_cols; ++i) - { - acc += A.at(k,i) * B.at(k,i); - } - } - } - else - if( (partial_unwrap::do_trans == true ) && (partial_unwrap::do_trans == true ) ) - { - const uword N = (std::min)(A_n_cols, B_n_rows); - - for(uword k=0; k < N; ++k) - { - const eT* A_colptr = A.colptr(k); - - // condition: A_n_rows = B_n_cols - for(uword i=0; i < A_n_rows; ++i) - { - acc += A_colptr[i] * B.at(k,i); - } - } - } - - return (use_alpha) ? (alpha * acc) : acc; - } - - - -//! speedup for trace(A*B); complex elements -template -arma_warn_unused -inline -typename enable_if2< is_cx::yes, typename T1::elem_type>::result -trace(const Glue& X) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - typedef typename T1::elem_type eT; - - const partial_unwrap tmp1(X.A); - const partial_unwrap tmp2(X.B); - - const typename partial_unwrap::stored_type& A = tmp1.M; - const typename partial_unwrap::stored_type& B = tmp2.M; - - const bool use_alpha = partial_unwrap::do_times || partial_unwrap::do_times; - const eT alpha = use_alpha ? (tmp1.get_val() * tmp2.get_val()) : eT(0); - - arma_conform_assert_trans_mul_size< partial_unwrap::do_trans, partial_unwrap::do_trans >(A.n_rows, A.n_cols, B.n_rows, B.n_cols, "matrix multiplication"); - - if( (A.n_elem == 0) || (B.n_elem == 0) ) { return eT(0); } - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - eT acc = eT(0); - - if( (partial_unwrap::do_trans == false) && (partial_unwrap::do_trans == false) ) - { - const uword N = (std::min)(A_n_rows, B_n_cols); - - T acc_real = T(0); - T acc_imag = T(0); - - for(uword k=0; k < N; ++k) - { - const eT* B_colptr = B.colptr(k); - - // condition: A_n_cols = B_n_rows - - for(uword i=0; i < A_n_cols; ++i) - { - // acc += A.at(k, i) * B_colptr[i]; - - const std::complex& xx = A.at(k, i); - const std::complex& yy = B_colptr[i]; - - const T a = xx.real(); - const T b = xx.imag(); - - const T c = yy.real(); - const T d = yy.imag(); - - acc_real += (a*c) - (b*d); - acc_imag += (a*d) + (b*c); - } - } - - acc = std::complex(acc_real, acc_imag); - } - else - if( (partial_unwrap::do_trans == true) && (partial_unwrap::do_trans == false) ) - { - const uword N = (std::min)(A_n_cols, B_n_cols); - - T acc_real = T(0); - T acc_imag = T(0); - - for(uword k=0; k < N; ++k) - { - const eT* A_colptr = A.colptr(k); - const eT* B_colptr = B.colptr(k); - - // condition: A_n_rows = B_n_rows - - for(uword i=0; i < A_n_rows; ++i) - { - // acc += std::conj(A_colptr[i]) * B_colptr[i]; - - const std::complex& xx = A_colptr[i]; - const std::complex& yy = B_colptr[i]; - - const T a = xx.real(); - const T b = xx.imag(); - - const T c = yy.real(); - const T d = yy.imag(); - - // take into account the complex conjugate of xx - - acc_real += (a*c) + (b*d); - acc_imag += (a*d) - (b*c); - } - } - - acc = std::complex(acc_real, acc_imag); - } - else - if( (partial_unwrap::do_trans == false) && (partial_unwrap::do_trans == true) ) - { - const uword N = (std::min)(A_n_rows, B_n_rows); - - T acc_real = T(0); - T acc_imag = T(0); - - for(uword k=0; k < N; ++k) - { - // condition: A_n_cols = B_n_cols - for(uword i=0; i < A_n_cols; ++i) - { - // acc += A.at(k,i) * std::conj(B.at(k,i)); - - const std::complex& xx = A.at(k, i); - const std::complex& yy = B.at(k, i); - - const T a = xx.real(); - const T b = xx.imag(); - - const T c = yy.real(); - const T d = -yy.imag(); // take the conjugate - - acc_real += (a*c) - (b*d); - acc_imag += (a*d) + (b*c); - } - } - - acc = std::complex(acc_real, acc_imag); - } - else - if( (partial_unwrap::do_trans == true) && (partial_unwrap::do_trans == true) ) - { - const uword N = (std::min)(A_n_cols, B_n_rows); - - T acc_real = T(0); - T acc_imag = T(0); - - for(uword k=0; k < N; ++k) - { - const eT* A_colptr = A.colptr(k); - - // condition: A_n_rows = B_n_cols - for(uword i=0; i < A_n_rows; ++i) - { - // acc += std::conj(A_colptr[i]) * std::conj(B.at(k,i)); - - const std::complex& xx = A_colptr[i]; - const std::complex& yy = B.at(k, i); - - const T a = xx.real(); - const T b = -xx.imag(); // take the conjugate - - const T c = yy.real(); - const T d = -yy.imag(); // take the conjugate - - acc_real += (a*c) - (b*d); - acc_imag += (a*d) + (b*c); - } - } - - acc = std::complex(acc_real, acc_imag); - } - - return (use_alpha) ? eT(alpha * acc) : eT(acc); - } - - - -//! trace of sparse object; generic version -template -arma_warn_unused -inline -typename T1::elem_type -trace(const SpBase& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const SpProxy P(expr.get_ref()); - - const uword N = (std::min)(P.get_n_rows(), P.get_n_cols()); - - eT acc = eT(0); - - if( (is_SpMat::stored_type>::value) && (P.get_n_nonzero() >= 5*N) ) - { - const unwrap_spmat::stored_type> U(P.Q); - - const SpMat& X = U.M; - - for(uword i=0; i < N; ++i) - { - acc += X.at(i,i); // use binary search - } - } - else - { - typename SpProxy::const_iterator_type it = P.begin(); - - const uword P_n_nz = P.get_n_nonzero(); - - for(uword i=0; i < P_n_nz; ++i) - { - if(it.row() == it.col()) { acc += (*it); } - - ++it; - } - } - - return acc; - } - - - -//! trace of sparse object; speedup for trace(A + B) -template -arma_warn_unused -inline -typename T1::elem_type -trace(const SpGlue& expr) - { - arma_debug_sigprint(); - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - arma_conform_assert_same_size(UA.M.n_rows, UA.M.n_cols, UB.M.n_rows, UB.M.n_cols, "addition"); - - return (trace(UA.M) + trace(UB.M)); - } - - - -//! trace of sparse object; speedup for trace(A - B) -template -arma_warn_unused -inline -typename T1::elem_type -trace(const SpGlue& expr) - { - arma_debug_sigprint(); - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - arma_conform_assert_same_size(UA.M.n_rows, UA.M.n_cols, UB.M.n_rows, UB.M.n_cols, "subtraction"); - - return (trace(UA.M) - trace(UB.M)); - } - - - -//! trace of sparse object; speedup for trace(A % B) -template -arma_warn_unused -inline -typename T1::elem_type -trace(const SpGlue& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - - arma_conform_assert_same_size(A.n_rows, A.n_cols, B.n_rows, B.n_cols, "element-wise multiplication"); - - const uword N = (std::min)(A.n_rows, A.n_cols); - - eT acc = eT(0); - - for(uword i=0; i -arma_warn_unused -inline -typename T1::elem_type -trace(const SpGlue& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - // better-than-nothing implementation - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - - arma_conform_assert_mul_size(A.n_rows, A.n_cols, B.n_rows, B.n_cols, "matrix multiplication"); - - if( (A.n_nonzero == 0) || (B.n_nonzero == 0) ) { return eT(0); } - - const uword N = (std::min)(A.n_rows, B.n_cols); - - eT acc = eT(0); - - // TODO: the threshold may need tuning for complex matrices - if( (A.n_nonzero >= 5*N) || (B.n_nonzero >= 5*N) ) - { - for(uword k=0; k < N; ++k) - { - typename SpMat::const_col_iterator B_it = B.begin_col_no_sync(k); - typename SpMat::const_col_iterator B_it_end = B.end_col_no_sync(k); - - while(B_it != B_it_end) - { - const eT B_val = (*B_it); - const uword i = B_it.row(); - - acc += A.at(k,i) * B_val; - - ++B_it; - } - } - } - else - { - const SpMat AB = A * B; - - acc = trace(AB); - } - - return acc; - } - - - -//! trace of sparse object; speedup for trace(A.t()*B); non-complex elements -template -arma_warn_unused -inline -typename enable_if2< is_cx::no, typename T1::elem_type>::result -trace(const SpGlue, T2, spglue_times>& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat UA(expr.A.m); - const unwrap_spmat UB(expr.B); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - - // NOTE: deliberately swapped A.n_rows and A.n_cols to take into account the requested transpose operation - arma_conform_assert_mul_size(A.n_cols, A.n_rows, B.n_rows, B.n_cols, "matrix multiplication"); - - if( (A.n_nonzero == 0) || (B.n_nonzero == 0) ) { return eT(0); } - - const uword N = (std::min)(A.n_cols, B.n_cols); - - eT acc = eT(0); - - if( (A.n_nonzero >= 5*N) || (B.n_nonzero >= 5*N) ) - { - for(uword k=0; k < N; ++k) - { - typename SpMat::const_col_iterator B_it = B.begin_col_no_sync(k); - typename SpMat::const_col_iterator B_it_end = B.end_col_no_sync(k); - - while(B_it != B_it_end) - { - const eT B_val = (*B_it); - const uword i = B_it.row(); - - acc += A.at(i,k) * B_val; - - ++B_it; - } - } - } - else - { - const SpMat AtB = A.t() * B; - - acc = trace(AtB); - } - - return acc; - } - - - -//! trace of sparse object; speedup for trace(A.t()*B); complex elements -template -arma_warn_unused -inline -typename enable_if2< is_cx::yes, typename T1::elem_type>::result -trace(const SpGlue, T2, spglue_times>& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat UA(expr.A.m); - const unwrap_spmat UB(expr.B); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - - // NOTE: deliberately swapped A.n_rows and A.n_cols to take into account the requested transpose operation - arma_conform_assert_mul_size(A.n_cols, A.n_rows, B.n_rows, B.n_cols, "matrix multiplication"); - - if( (A.n_nonzero == 0) || (B.n_nonzero == 0) ) { return eT(0); } - - const uword N = (std::min)(A.n_cols, B.n_cols); - - eT acc = eT(0); - - // TODO: the threshold may need tuning for complex matrices - if( (A.n_nonzero >= 5*N) || (B.n_nonzero >= 5*N) ) - { - for(uword k=0; k < N; ++k) - { - typename SpMat::const_col_iterator B_it = B.begin_col_no_sync(k); - typename SpMat::const_col_iterator B_it_end = B.end_col_no_sync(k); - - while(B_it != B_it_end) - { - const eT B_val = (*B_it); - const uword i = B_it.row(); - - acc += std::conj(A.at(i,k)) * B_val; - - ++B_it; - } - } - } - else - { - const SpMat AtB = A.t() * B; - - acc = trace(AtB); - } - - return acc; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_trans.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_trans.hpp deleted file mode 100644 index b3d1993bf..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_trans.hpp +++ /dev/null @@ -1,99 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_trans -//! @{ - - -template -arma_warn_unused -arma_inline -const Op -trans - ( - const T1& X, - const typename enable_if< is_arma_type::value >::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return Op(X); - } - - - -template -arma_warn_unused -arma_inline -const Op -htrans - ( - const T1& X, - const typename enable_if< is_arma_type::value >::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return Op(X); - } - - - -// -// handling of sparse matrices - - -template -arma_warn_unused -arma_inline -const SpOp -trans - ( - const T1& X, - const typename enable_if< is_arma_sparse_type::value >::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return SpOp(X); - } - - - -template -arma_warn_unused -arma_inline -const SpOp -htrans - ( - const T1& X, - const typename enable_if< is_arma_sparse_type::value >::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return SpOp(X); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_trapz.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_trapz.hpp deleted file mode 100644 index 964b09def..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_trapz.hpp +++ /dev/null @@ -1,59 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_trapz -//! @{ - - - -template -arma_warn_unused -inline -const Glue -trapz - ( - const Base& X, - const Base& Y, - const uword dim = 0 - ) - { - arma_debug_sigprint(); - - return Glue(X.get_ref(), Y.get_ref(), dim); - } - - - -template -arma_warn_unused -inline -const Op -trapz - ( - const Base& Y, - const uword dim = 0 - ) - { - arma_debug_sigprint(); - - return Op(Y.get_ref(), dim, uword(0)); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_trig.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_trig.hpp deleted file mode 100644 index 4227df7a4..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_trig.hpp +++ /dev/null @@ -1,493 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_trig -//! @{ - - -// single argument trigonometric functions: -// cos family: cos, acos, cosh, acosh -// sin family: sin, asin, sinh, asinh -// tan family: tan, atan, tanh, atanh -// -// misc functions: -// sinc -// -// dual argument trigonometric functions: -// atan2 -// hypot - - - -// -// cos - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -cos(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -cos(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// -// acos - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -acos(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -acos(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// -// cosh - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -cosh(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -cosh(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// -// acosh - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -acosh(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -acosh(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// -// sin - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -sin(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -sin(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// -// asin - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -asin(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -asin(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// -// sinh - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -sinh(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -sinh(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// -// asinh - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -asinh(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -asinh(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// -// tan - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -tan(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -tan(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// -// atan - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -atan(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -atan(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// -// tanh - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -tanh(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -tanh(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// -// atanh - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -atanh(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -atanh(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// -// sinc - -template -arma_warn_unused -arma_inline -typename arma_scalar_only::result -sinc(const T x) - { - return arma_sinc(x); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -sinc(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -sinc(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -// -// atan2 - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value && is_real::value && is_same_type::value), - const Glue - >::result -atan2(const T1& Y, const T2& X) - { - arma_debug_sigprint(); - - return Glue(Y, X); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_real::value, const GlueCube >::result -atan2(const BaseCube& Y, const BaseCube& X) - { - arma_debug_sigprint(); - - return GlueCube(Y.get_ref(), X.get_ref()); - } - - - -// -// hypot - -template -arma_warn_unused -arma_inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value && is_real::value && is_same_type::value), - const Glue - >::result -hypot(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - return Glue(X, Y); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_real::value, const GlueCube >::result -hypot(const BaseCube& X, const BaseCube& Y) - { - arma_debug_sigprint(); - - return GlueCube(X.get_ref(), Y.get_ref()); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_trimat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_trimat.hpp deleted file mode 100644 index ec409a0f4..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_trimat.hpp +++ /dev/null @@ -1,143 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_trimat -//! @{ - - -template -arma_warn_unused -arma_inline -const Op -trimatu(const Base& X) - { - arma_debug_sigprint(); - - return Op(X.get_ref(), 0, 0); - } - - - -template -arma_warn_unused -arma_inline -const Op -trimatl(const Base& X) - { - arma_debug_sigprint(); - - return Op(X.get_ref(), 1, 0); - } - - - -template -arma_warn_unused -arma_inline -const SpOp -trimatu(const SpBase& X) - { - arma_debug_sigprint(); - - return SpOp(X.get_ref(), 0, 0); - } - - - -template -arma_warn_unused -arma_inline -const SpOp -trimatl(const SpBase& X) - { - arma_debug_sigprint(); - - return SpOp(X.get_ref(), 1, 0); - } - - - -// - - - -template -arma_warn_unused -arma_inline -const Op -trimatl(const Base& X, const sword k) - { - arma_debug_sigprint(); - - const uword row_offset = (k < 0) ? uword(-k) : uword(0); - const uword col_offset = (k > 0) ? uword( k) : uword(0); - - return Op(X.get_ref(), row_offset, col_offset); - } - - - -template -arma_warn_unused -arma_inline -const Op -trimatu(const Base& X, const sword k) - { - arma_debug_sigprint(); - - const uword row_offset = (k < 0) ? uword(-k) : uword(0); - const uword col_offset = (k > 0) ? uword( k) : uword(0); - - return Op(X.get_ref(), row_offset, col_offset); - } - - - -template -arma_warn_unused -arma_inline -const SpOp -trimatu(const SpBase& X, const sword k) - { - arma_debug_sigprint(); - - const uword row_offset = (k < 0) ? uword(-k) : uword(0); - const uword col_offset = (k > 0) ? uword( k) : uword(0); - - return SpOp(X.get_ref(), row_offset, col_offset); - } - - - -template -arma_warn_unused -arma_inline -const SpOp -trimatl(const SpBase& X, const sword k) - { - arma_debug_sigprint(); - - const uword row_offset = (k < 0) ? uword(-k) : uword(0); - const uword col_offset = (k > 0) ? uword( k) : uword(0); - - return SpOp(X.get_ref(), row_offset, col_offset); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_trimat_ind.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_trimat_ind.hpp deleted file mode 100644 index e83c08894..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_trimat_ind.hpp +++ /dev/null @@ -1,139 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_trimat_ind -//! @{ - - -arma_warn_unused -inline -uvec -trimatu_ind(const SizeMat& s, const sword k = 0) - { - arma_debug_sigprint(); - - const uword n_rows = s.n_rows; - const uword n_cols = s.n_cols; - - const uword row_offset = (k < 0) ? uword(-k) : uword(0); - const uword col_offset = (k > 0) ? uword( k) : uword(0); - - arma_conform_check_bounds( ((row_offset > 0) && (row_offset >= n_rows)) || ((col_offset > 0) && (col_offset >= n_cols)), "trimatu_ind(): requested diagonal is out of bounds" ); - - const uword N = (std::min)(n_rows - row_offset, n_cols - col_offset); - - uvec tmp(n_rows * n_cols, arma_nozeros_indicator()); // worst case scenario - uword* tmp_mem = tmp.memptr(); - uword count = 0; - - for(uword i=0; i < n_cols; ++i) - { - const uword col = i + col_offset; - - if(i < N) - { - const uword end_row = i + row_offset; - - const uword index_offset = (n_rows * col); - - for(uword row=0; row <= end_row; ++row) - { - tmp_mem[count] = index_offset + row; - ++count; - } - } - else - { - if(col < n_cols) - { - const uword index_offset = (n_rows * col); - - for(uword row=0; row < n_rows; ++row) - { - tmp_mem[count] = index_offset + row; - ++count; - } - } - } - } - - uvec out; - - out.steal_mem_col(tmp, count); - - return out; - } - - - -arma_warn_unused -inline -uvec -trimatl_ind(const SizeMat& s, const sword k = 0) - { - arma_debug_sigprint(); - - const uword n_rows = s.n_rows; - const uword n_cols = s.n_cols; - - const uword row_offset = (k < 0) ? uword(-k) : uword(0); - const uword col_offset = (k > 0) ? uword( k) : uword(0); - - arma_conform_check_bounds( ((row_offset > 0) && (row_offset >= n_rows)) || ((col_offset > 0) && (col_offset >= n_cols)), "trimatl_ind(): requested diagonal is out of bounds" ); - - const uword N = (std::min)(n_rows - row_offset, n_cols - col_offset); - - uvec tmp(n_rows * n_cols, arma_nozeros_indicator()); // worst case scenario - uword* tmp_mem = tmp.memptr(); - uword count = 0; - - for(uword col=0; col < col_offset; ++col) - { - const uword index_offset = (n_rows * col); - - for(uword row=0; row < n_rows; ++row) - { - tmp_mem[count] = index_offset + row; - ++count; - } - } - - for(uword i=0; i -arma_warn_unused -inline -static -typename arma_real_only::result -trunc_exp(const eT x) - { - if(std::numeric_limits::is_iec559 && (x >= Datum::log_max )) - { - return std::numeric_limits::max(); - } - else - { - return std::exp(x); - } - } - - - -template -arma_warn_unused -inline -static -typename arma_integral_only::result -trunc_exp(const eT x) - { - return eT( trunc_exp( double(x) ) ); - } - - - -template -arma_warn_unused -inline -static -std::complex -trunc_exp(const std::complex& x) - { - return std::polar( trunc_exp( x.real() ), x.imag() ); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -trunc_exp(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -trunc_exp(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_trunc_log.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_trunc_log.hpp deleted file mode 100644 index de02b9781..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_trunc_log.hpp +++ /dev/null @@ -1,100 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_trunc_log -//! @{ - - - -template -arma_warn_unused -inline -static -typename arma_real_only::result -trunc_log(const eT x) - { - if(std::numeric_limits::is_iec559) - { - if(x == std::numeric_limits::infinity()) - { - return Datum::log_max; - } - else - { - return (x <= eT(0)) ? Datum::log_min : std::log(x); - } - } - else - { - return std::log(x); - } - } - - - -template -arma_warn_unused -inline -static -typename arma_integral_only::result -trunc_log(const eT x) - { - return eT( trunc_log( double(x) ) ); - } - - - -template -arma_warn_unused -inline -static -std::complex -trunc_log(const std::complex& x) - { - return std::complex( trunc_log( std::abs(x) ), std::arg(x) ); - } - - - -template -arma_warn_unused -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -trunc_log(const T1& A) - { - arma_debug_sigprint(); - - return eOp(A); - } - - - -template -arma_warn_unused -arma_inline -const eOpCube -trunc_log(const BaseCube& A) - { - arma_debug_sigprint(); - - return eOpCube(A.get_ref()); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_unique.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_unique.hpp deleted file mode 100644 index 7bfaa7d80..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_unique.hpp +++ /dev/null @@ -1,57 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_unique -//! @{ - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::yes, - const Op - >::result -unique(const T1& A) - { - arma_debug_sigprint(); - - return Op(A); - } - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::no, - const Op - >::result -unique(const T1& A) - { - arma_debug_sigprint(); - - return Op(A); - } - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_var.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_var.hpp deleted file mode 100644 index 1902e30a1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_var.hpp +++ /dev/null @@ -1,143 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_var -//! @{ - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::yes, - typename T1::pod_type - >::result -var(const T1& X, const uword norm_type = 0) - { - arma_debug_sigprint(); - - return op_var::var_vec(X, norm_type); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::no, - const mtOp - >::result -var(const T1& X, const uword norm_type = 0) - { - arma_debug_sigprint(); - - return mtOp(X, norm_type, 0); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value, - const mtOp - >::result -var(const T1& X, const uword norm_type, const uword dim) - { - arma_debug_sigprint(); - - return mtOp(X, norm_type, dim); - } - - - -template -arma_warn_unused -inline -typename arma_scalar_only::result -var(const T&) - { - return T(0); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value && resolves_to_sparse_vector::yes, - typename T1::pod_type - >::result -var(const T1& X, const uword norm_type = 0) - { - arma_debug_sigprint(); - - return op_sp_var::var_vec(X, norm_type); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value && resolves_to_sparse_vector::no, - const mtSpReduceOp - >::result -var(const T1& X, const uword norm_type = 0) - { - arma_debug_sigprint(); - - return mtSpReduceOp(X, norm_type, 0); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value, - const mtSpReduceOp - >::result -var(const T1& X, const uword norm_type, const uword dim) - { - arma_debug_sigprint(); - - return mtSpReduceOp(X, norm_type, dim); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_vecnorm.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_vecnorm.hpp deleted file mode 100644 index 4cfc2d99d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_vecnorm.hpp +++ /dev/null @@ -1,385 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_vecnorm -//! @{ - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::yes, - typename T1::pod_type - >::result -vecnorm - ( - const T1& X, - const uword k = uword(2), - const arma_empty_class junk1 = arma_empty_class(), - const typename arma_real_or_cx_only::result* junk2 = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - typedef typename T1::pod_type T; - - const Proxy P(X); - - if(P.get_n_elem() == 0) { return T(0); } - - if(k == uword(1)) { return op_norm::vec_norm_1(P); } - if(k == uword(2)) { return op_norm::vec_norm_2(P); } - - arma_conform_check( (k == 0), "vecnorm(): unsupported vector norm type" ); - - return op_norm::vec_norm_k(P, int(k)); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::no, - const mtOp - >::result -vecnorm - ( - const T1& X, - const uword k = uword(2), - const arma_empty_class junk1 = arma_empty_class(), - const typename arma_real_or_cx_only::result* junk2 = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - const uword dim = 0; - - return mtOp(X, k, dim); - } - - - -template -arma_warn_unused -inline -const mtOp -vecnorm - ( - const Base& X, - const uword k, - const uword dim, - const typename arma_real_or_cx_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return mtOp(X.get_ref(), k, dim); - } - - - -// - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::yes, - typename T1::pod_type - >::result -vecnorm - ( - const T1& X, - const char* method, - const arma_empty_class junk1 = arma_empty_class(), - const typename arma_real_or_cx_only::result* junk2 = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - typedef typename T1::pod_type T; - - const Proxy P(X); - - if(P.get_n_elem() == 0) { return T(0); } - - const char sig = (method != nullptr) ? method[0] : char(0); - - if( (sig == 'i') || (sig == 'I') || (sig == '+') ) { return op_norm::vec_norm_max(P); } - if( (sig == '-') ) { return op_norm::vec_norm_min(P); } - - arma_stop_logic_error("vecnorm(): unsupported vector norm type"); - - return T(0); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value && resolves_to_vector::no, - const mtOp - >::result -vecnorm - ( - const T1& X, - const char* method, - const arma_empty_class junk1 = arma_empty_class(), - const typename arma_real_or_cx_only::result* junk2 = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - const char sig = (method != nullptr) ? method[0] : char(0); - - uword method_id = 0; - - if( (sig == 'i') || (sig == 'I') || (sig == '+') ) { method_id = 1; } - if( (sig == '-') ) { method_id = 2; } - - const uword dim = 0; - - return mtOp(X, method_id, dim); - } - - - -template -arma_warn_unused -inline -const mtOp -vecnorm - ( - const Base& X, - const char* method, - const uword dim, - const typename arma_real_or_cx_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const char sig = (method != nullptr) ? method[0] : char(0); - - uword method_id = 0; - - if( (sig == 'i') || (sig == 'I') || (sig == '+') ) { method_id = 1; } - if( (sig == '-') ) { method_id = 2; } - - return mtOp(X.get_ref(), method_id, dim); - } - - - -// -// norms for sparse matrices - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value && resolves_to_sparse_vector::yes, - typename T1::pod_type - >::result -vecnorm - ( - const T1& X, - const uword k = uword(2), - const arma_empty_class junk1 = arma_empty_class(), - const typename arma_real_or_cx_only::result* junk2 = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - return arma::norm(X, k); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value && resolves_to_sparse_vector::no, - const mtSpReduceOp - >::result -vecnorm - ( - const T1& X, - const uword k = uword(2), - const arma_empty_class junk1 = arma_empty_class(), - const typename arma_real_or_cx_only::result* junk2 = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - const uword dim = 0; - - return mtSpReduceOp(X, k, dim); - } - - - -template -arma_warn_unused -inline -const mtSpReduceOp -vecnorm - ( - const SpBase& X, - const uword k, - const uword dim, - const typename arma_real_or_cx_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return mtSpReduceOp(X.get_ref(), k, dim); - } - - - -// - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value && resolves_to_sparse_vector::yes, - typename T1::pod_type - >::result -vecnorm - ( - const T1& X, - const char* method, - const arma_empty_class junk1 = arma_empty_class(), - const typename arma_real_or_cx_only::result* junk2 = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - return arma::norm(X, method); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value && resolves_to_sparse_vector::no, - const mtSpReduceOp - >::result -vecnorm - ( - const T1& X, - const char* method, - const arma_empty_class junk1 = arma_empty_class(), - const typename arma_real_or_cx_only::result* junk2 = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - const char sig = (method != nullptr) ? method[0] : char(0); - - uword method_id = 0; - - if( (sig == 'i') || (sig == 'I') || (sig == '+') ) { method_id = 1; } - if( (sig == '-') ) { method_id = 2; } - - const uword dim = 0; - - return mtSpReduceOp(X, method_id, dim); - } - - - -template -arma_warn_unused -inline -const mtSpReduceOp -vecnorm - ( - const SpBase& X, - const char* method, - const uword dim, - const typename arma_real_or_cx_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const char sig = (method != nullptr) ? method[0] : char(0); - - uword method_id = 0; - - if( (sig == 'i') || (sig == 'I') || (sig == '+') ) { method_id = 1; } - if( (sig == '-') ) { method_id = 2; } - - return mtSpReduceOp(X.get_ref(), method_id, dim); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_vectorise.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_vectorise.hpp deleted file mode 100644 index 78cd1b46b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_vectorise.hpp +++ /dev/null @@ -1,114 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_vectorise -//! @{ - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value, - const Op - >::result -vectorise(const T1& X) - { - arma_debug_sigprint(); - - return Op(X); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_type::value, - const Op - >::result -vectorise(const T1& X, const uword dim) - { - arma_debug_sigprint(); - - arma_conform_check( (dim > 1), "vectorise(): parameter 'dim' must be 0 or 1" ); - - return Op(X, dim, 0); - } - - - -template -arma_warn_unused -inline -CubeToMatOp -vectorise(const BaseCube& X) - { - arma_debug_sigprint(); - - return CubeToMatOp(X.get_ref()); - } - - - -//! Vectorization for sparse objects. -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value, - const SpOp - >::result -vectorise(const T1& X) - { - arma_debug_sigprint(); - - return SpOp(X); - } - - - -//! Vectorization for sparse objects. -template -arma_warn_unused -inline -typename -enable_if2 - < - is_arma_sparse_type::value, - const SpOp - >::result -vectorise(const T1& X, const uword dim) - { - arma_debug_sigprint(); - - arma_conform_check( (dim > 1), "vectorise(): parameter 'dim' must be 0 or 1" ); - - return SpOp(X, dim, 0); - } - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_wishrnd.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_wishrnd.hpp deleted file mode 100644 index 76a2d629c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_wishrnd.hpp +++ /dev/null @@ -1,204 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_wishrnd -//! @{ - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_real::value, - const Op - >::result -wishrnd(const Base& S, typename T1::elem_type df) - { - arma_debug_sigprint(); - - return Op(S.get_ref(), df, uword(1), uword(0)); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_real::value, - const Op - >::result -wishrnd(const Base& S, typename T1::elem_type df, const Base& D) - { - arma_debug_sigprint(); - arma_ignore(S); - - return Op(D.get_ref(), df, uword(2), uword(0)); - } - - - -template -inline -typename -enable_if2 - < - is_real::value, - bool - >::result -wishrnd(Mat& W, const Base& S, typename T1::elem_type df) - { - arma_debug_sigprint(); - - const bool status = op_wishrnd::apply_direct(W, S.get_ref(), df, uword(1)); - - if(status == false) - { - W.soft_reset(); - arma_warn(3, "wishrnd(): given matrix is not symmetric positive definite"); - } - - return status; - } - - - -template -inline -typename -enable_if2 - < - is_real::value, - bool - >::result -wishrnd(Mat& W, const Base& S, typename T1::elem_type df, const Base& D) - { - arma_debug_sigprint(); - arma_ignore(S); - - const bool status = op_wishrnd::apply_direct(W, D.get_ref(), df, uword(2)); - - if(status == false) - { - W.soft_reset(); - arma_warn(3, "wishrnd(): problem with given 'D' matrix"); - } - - return status; - } - - - -// - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_real::value, - const Op - >::result -iwishrnd(const Base& T, typename T1::elem_type df) - { - arma_debug_sigprint(); - - return Op(T.get_ref(), df, uword(1), uword(0)); - } - - - -template -arma_warn_unused -inline -typename -enable_if2 - < - is_real::value, - const Op - >::result -iwishrnd(const Base& T, typename T1::elem_type df, const Base& Dinv) - { - arma_debug_sigprint(); - arma_ignore(T); - - return Op(Dinv.get_ref(), df, uword(2), uword(0)); - } - - - -template -inline -typename -enable_if2 - < - is_real::value, - bool - >::result -iwishrnd(Mat& W, const Base& T, typename T1::elem_type df) - { - arma_debug_sigprint(); - - const bool status = op_iwishrnd::apply_direct(W, T.get_ref(), df, uword(1)); - - if(status == false) - { - W.soft_reset(); - arma_warn(3, "iwishrnd(): given matrix is not symmetric positive definite and/or df is too low"); - } - - return status; - } - - - -template -inline -typename -enable_if2 - < - is_real::value, - bool - >::result -iwishrnd(Mat& W, const Base& T, typename T1::elem_type df, const Base& Dinv) - { - arma_debug_sigprint(); - arma_ignore(T); - - const bool status = op_iwishrnd::apply_direct(W, Dinv.get_ref(), df, uword(2)); - - if(status == false) - { - W.soft_reset(); - arma_warn(3, "wishrnd(): problem with given 'Dinv' matrix and/or df is too low"); - } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_zeros.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_zeros.hpp deleted file mode 100644 index d6f8d868c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/fn_zeros.hpp +++ /dev/null @@ -1,192 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup fn_zeros -//! @{ - - - -arma_warn_unused -arma_inline -const Gen -zeros(const uword n_elem) - { - arma_debug_sigprint(); - - return Gen(n_elem, 1); - } - - - -template -arma_warn_unused -arma_inline -const Gen -zeros(const uword n_elem, const arma_empty_class junk1 = arma_empty_class(), const typename arma_Mat_Col_Row_only::result* junk2 = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - const uword n_rows = (is_Row::value) ? uword(1) : n_elem; - const uword n_cols = (is_Row::value) ? n_elem : uword(1); - - return Gen(n_rows, n_cols); - } - - - -arma_warn_unused -arma_inline -const Gen -zeros(const uword n_rows, const uword n_cols) - { - arma_debug_sigprint(); - - return Gen(n_rows, n_cols); - } - - - -arma_warn_unused -arma_inline -const Gen -zeros(const SizeMat& s) - { - arma_debug_sigprint(); - - return Gen(s.n_rows, s.n_cols); - } - - - -template -arma_warn_unused -arma_inline -const Gen -zeros(const uword n_rows, const uword n_cols, const typename arma_Mat_Col_Row_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - if(is_Col::value) { arma_conform_check( (n_cols != 1), "zeros(): incompatible size" ); } - if(is_Row::value) { arma_conform_check( (n_rows != 1), "zeros(): incompatible size" ); } - - return Gen(n_rows, n_cols); - } - - - -template -arma_warn_unused -arma_inline -const Gen -zeros(const SizeMat& s, const typename arma_Mat_Col_Row_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return zeros(s.n_rows, s.n_cols); - } - - - -arma_warn_unused -arma_inline -const GenCube -zeros(const uword n_rows, const uword n_cols, const uword n_slices) - { - arma_debug_sigprint(); - - return GenCube(n_rows, n_cols, n_slices); - } - - - -arma_warn_unused -arma_inline -const GenCube -zeros(const SizeCube& s) - { - arma_debug_sigprint(); - - return GenCube(s.n_rows, s.n_cols, s.n_slices); - } - - - -template -arma_warn_unused -arma_inline -const GenCube -zeros(const uword n_rows, const uword n_cols, const uword n_slices, const typename arma_Cube_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return GenCube(n_rows, n_cols, n_slices); - } - - - -template -arma_warn_unused -arma_inline -const GenCube -zeros(const SizeCube& s, const typename arma_Cube_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return GenCube(s.n_rows, s.n_cols, s.n_slices); - } - - - -template -arma_warn_unused -inline -sp_obj_type -zeros(const uword n_rows, const uword n_cols, const typename arma_SpMat_SpCol_SpRow_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - if(is_SpCol::value) { arma_conform_check( (n_cols != 1), "zeros(): incompatible size" ); } - if(is_SpRow::value) { arma_conform_check( (n_rows != 1), "zeros(): incompatible size" ); } - - return sp_obj_type(n_rows, n_cols); - } - - - -template -arma_warn_unused -inline -sp_obj_type -zeros(const SizeMat& s, const typename arma_SpMat_SpCol_SpRow_only::result* junk = nullptr) - { - arma_debug_sigprint(); - arma_ignore(junk); - - return zeros(s.n_rows, s.n_cols); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_affmul_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_affmul_bones.hpp deleted file mode 100644 index 5284b6ccd..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_affmul_bones.hpp +++ /dev/null @@ -1,55 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_affmul -//! @{ - - - -class glue_affmul - { - public: - - template - struct traits - { - static constexpr bool is_row = T1::is_row; - static constexpr bool is_col = T2::is_col; - static constexpr bool is_xvec = false; - }; - - template - inline static void apply(Mat& out, const Glue& X); - - template - inline static void apply_noalias(Mat& out, const T1& A, const T2& B); - - template - inline static void apply_noalias_square(Mat& out, const T1& A, const T2& B); - - template - inline static void apply_noalias_rectangle(Mat& out, const T1& A, const T2& B); - - template - inline static void apply_noalias_generic(Mat& out, const T1& A, const T2& B); - }; - - - -//! @} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_affmul_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_affmul_meat.hpp deleted file mode 100644 index 9549aec2d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_affmul_meat.hpp +++ /dev/null @@ -1,490 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_affmul -//! @{ - - - -template -inline -void -glue_affmul::apply(Mat& out, const Glue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap U1(X.A); - const quasi_unwrap U2(X.B); - - const bool is_alias = (U1.is_alias(out) || U2.is_alias(out)); - - if(is_alias == false) - { - glue_affmul::apply_noalias(out, U1.M, U2.M); - } - else - { - Mat tmp; - - glue_affmul::apply_noalias(tmp, U1.M, U2.M); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -glue_affmul::apply_noalias(Mat& out, const T1& A, const T2& B) - { - arma_debug_sigprint(); - - const uword A_n_cols = A.n_cols; - const uword A_n_rows = A.n_rows; - const uword B_n_rows = B.n_rows; - - arma_conform_check( (A_n_cols != B_n_rows+1), "affmul(): size mismatch" ); - - if(A_n_rows == A_n_cols) - { - glue_affmul::apply_noalias_square(out, A, B); - } - else - if(A_n_rows == B_n_rows) - { - glue_affmul::apply_noalias_rectangle(out, A, B); - } - else - { - glue_affmul::apply_noalias_generic(out, A, B); - } - } - - - -template -inline -void -glue_affmul::apply_noalias_square(Mat& out, const T1& A, const T2& B) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - // assuming that A is square sized, and A.n_cols = B.n_rows+1 - - const uword N = A.n_rows; - const uword B_n_cols = B.n_cols; - - out.set_size(N, B_n_cols); - - if(out.n_elem == 0) { return; } - - const eT* A_mem = A.memptr(); - - switch(N) - { - case 0: - break; - - case 1: // A is 1x1 - out.fill(A_mem[0]); - break; - - case 2: // A is 2x2 - { - if(B_n_cols == 1) - { - const eT* B_mem = B.memptr(); - eT* out_mem = out.memptr(); - - const eT x = B_mem[0]; - - out_mem[0] = A_mem[0]*x + A_mem[2]; - out_mem[1] = A_mem[1]*x + A_mem[3]; - } - else - for(uword col=0; col < B_n_cols; ++col) - { - const eT* B_mem = B.colptr(col); - eT* out_mem = out.colptr(col); - - const eT x = B_mem[0]; - - out_mem[0] = A_mem[0]*x + A_mem[2]; - out_mem[1] = A_mem[1]*x + A_mem[3]; - } - } - break; - - case 3: // A is 3x3 - { - if(B_n_cols == 1) - { - const eT* B_mem = B.memptr(); - eT* out_mem = out.memptr(); - - const eT x = B_mem[0]; - const eT y = B_mem[1]; - - out_mem[0] = A_mem[0]*x + A_mem[3]*y + A_mem[6]; - out_mem[1] = A_mem[1]*x + A_mem[4]*y + A_mem[7]; - out_mem[2] = A_mem[2]*x + A_mem[5]*y + A_mem[8]; - } - else - for(uword col=0; col < B_n_cols; ++col) - { - const eT* B_mem = B.colptr(col); - eT* out_mem = out.colptr(col); - - const eT x = B_mem[0]; - const eT y = B_mem[1]; - - out_mem[0] = A_mem[0]*x + A_mem[3]*y + A_mem[6]; - out_mem[1] = A_mem[1]*x + A_mem[4]*y + A_mem[7]; - out_mem[2] = A_mem[2]*x + A_mem[5]*y + A_mem[8]; - } - } - break; - - case 4: // A is 4x4 - { - if(B_n_cols == 1) - { - const eT* B_mem = B.memptr(); - eT* out_mem = out.memptr(); - - const eT x = B_mem[0]; - const eT y = B_mem[1]; - const eT z = B_mem[2]; - - out_mem[0] = A_mem[ 0]*x + A_mem[ 4]*y + A_mem[ 8]*z + A_mem[12]; - out_mem[1] = A_mem[ 1]*x + A_mem[ 5]*y + A_mem[ 9]*z + A_mem[13]; - out_mem[2] = A_mem[ 2]*x + A_mem[ 6]*y + A_mem[10]*z + A_mem[14]; - out_mem[3] = A_mem[ 3]*x + A_mem[ 7]*y + A_mem[11]*z + A_mem[15]; - } - else - for(uword col=0; col < B_n_cols; ++col) - { - const eT* B_mem = B.colptr(col); - eT* out_mem = out.colptr(col); - - const eT x = B_mem[0]; - const eT y = B_mem[1]; - const eT z = B_mem[2]; - - out_mem[0] = A_mem[ 0]*x + A_mem[ 4]*y + A_mem[ 8]*z + A_mem[12]; - out_mem[1] = A_mem[ 1]*x + A_mem[ 5]*y + A_mem[ 9]*z + A_mem[13]; - out_mem[2] = A_mem[ 2]*x + A_mem[ 6]*y + A_mem[10]*z + A_mem[14]; - out_mem[3] = A_mem[ 3]*x + A_mem[ 7]*y + A_mem[11]*z + A_mem[15]; - } - } - break; - - case 5: // A is 5x5 - { - if(B_n_cols == 1) - { - const eT* B_mem = B.memptr(); - eT* out_mem = out.memptr(); - - const eT x = B_mem[0]; - const eT y = B_mem[1]; - const eT z = B_mem[2]; - const eT w = B_mem[3]; - - out_mem[0] = A_mem[ 0]*x + A_mem[ 5]*y + A_mem[10]*z + A_mem[15]*w + A_mem[20]; - out_mem[1] = A_mem[ 1]*x + A_mem[ 6]*y + A_mem[11]*z + A_mem[16]*w + A_mem[21]; - out_mem[2] = A_mem[ 2]*x + A_mem[ 7]*y + A_mem[12]*z + A_mem[17]*w + A_mem[22]; - out_mem[3] = A_mem[ 3]*x + A_mem[ 8]*y + A_mem[13]*z + A_mem[18]*w + A_mem[23]; - out_mem[4] = A_mem[ 4]*x + A_mem[ 9]*y + A_mem[14]*z + A_mem[19]*w + A_mem[24]; - } - else - for(uword col=0; col < B_n_cols; ++col) - { - const eT* B_mem = B.colptr(col); - eT* out_mem = out.colptr(col); - - const eT x = B_mem[0]; - const eT y = B_mem[1]; - const eT z = B_mem[2]; - const eT w = B_mem[3]; - - out_mem[0] = A_mem[ 0]*x + A_mem[ 5]*y + A_mem[10]*z + A_mem[15]*w + A_mem[20]; - out_mem[1] = A_mem[ 1]*x + A_mem[ 6]*y + A_mem[11]*z + A_mem[16]*w + A_mem[21]; - out_mem[2] = A_mem[ 2]*x + A_mem[ 7]*y + A_mem[12]*z + A_mem[17]*w + A_mem[22]; - out_mem[3] = A_mem[ 3]*x + A_mem[ 8]*y + A_mem[13]*z + A_mem[18]*w + A_mem[23]; - out_mem[4] = A_mem[ 4]*x + A_mem[ 9]*y + A_mem[14]*z + A_mem[19]*w + A_mem[24]; - } - } - break; - - default: - { - if(B_n_cols == 1) - { - Col tmp(N, arma_nozeros_indicator()); - eT* tmp_mem = tmp.memptr(); - - arrayops::copy(tmp_mem, B.memptr(), N-1); - - tmp_mem[N-1] = eT(1); - - out = A * tmp; - } - else - { - Mat tmp(N, B_n_cols, arma_nozeros_indicator()); - - for(uword col=0; col < B_n_cols; ++col) - { - const eT* B_mem = B.colptr(col); - eT* tmp_mem = tmp.colptr(col); - - arrayops::copy(tmp_mem, B_mem, N-1); - - tmp_mem[N-1] = eT(1); - } - - out = A * tmp; - } - } - } - } - - - -template -inline -void -glue_affmul::apply_noalias_rectangle(Mat& out, const T1& A, const T2& B) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - // assuming that A.n_rows = A.n_cols-1, and A.n_cols = B.n_rows+1 - // (A and B have the same number of rows) - - const uword A_n_rows = A.n_rows; - const uword B_n_cols = B.n_cols; - - out.set_size(A_n_rows, B_n_cols); - - if(out.n_elem == 0) { return; } - - const eT* A_mem = A.memptr(); - - switch(A_n_rows) - { - case 0: - break; - - case 1: // A is 1x2 - { - if(B_n_cols == 1) - { - const eT* B_mem = B.memptr(); - eT* out_mem = out.memptr(); - - const eT x = B_mem[0]; - - out_mem[0] = A_mem[0]*x + A_mem[1]; - } - else - for(uword col=0; col < B_n_cols; ++col) - { - const eT* B_mem = B.colptr(col); - eT* out_mem = out.colptr(col); - - const eT x = B_mem[0]; - - out_mem[0] = A_mem[0]*x + A_mem[1]; - } - } - break; - - case 2: // A is 2x3 - { - if(B_n_cols == 1) - { - const eT* B_mem = B.memptr(); - eT* out_mem = out.memptr(); - - const eT x = B_mem[0]; - const eT y = B_mem[1]; - - out_mem[0] = A_mem[0]*x + A_mem[2]*y + A_mem[4]; - out_mem[1] = A_mem[1]*x + A_mem[3]*y + A_mem[5]; - } - else - for(uword col=0; col < B_n_cols; ++col) - { - const eT* B_mem = B.colptr(col); - eT* out_mem = out.colptr(col); - - const eT x = B_mem[0]; - const eT y = B_mem[1]; - - out_mem[0] = A_mem[0]*x + A_mem[2]*y + A_mem[4]; - out_mem[1] = A_mem[1]*x + A_mem[3]*y + A_mem[5]; - } - } - break; - - case 3: // A is 3x4 - { - if(B_n_cols == 1) - { - const eT* B_mem = B.memptr(); - eT* out_mem = out.memptr(); - - const eT x = B_mem[0]; - const eT y = B_mem[1]; - const eT z = B_mem[2]; - - out_mem[0] = A_mem[ 0]*x + A_mem[ 3]*y + A_mem[ 6]*z + A_mem[ 9]; - out_mem[1] = A_mem[ 1]*x + A_mem[ 4]*y + A_mem[ 7]*z + A_mem[10]; - out_mem[2] = A_mem[ 2]*x + A_mem[ 5]*y + A_mem[ 8]*z + A_mem[11]; - } - else - for(uword col=0; col < B_n_cols; ++col) - { - const eT* B_mem = B.colptr(col); - eT* out_mem = out.colptr(col); - - const eT x = B_mem[0]; - const eT y = B_mem[1]; - const eT z = B_mem[2]; - - out_mem[0] = A_mem[ 0]*x + A_mem[ 3]*y + A_mem[ 6]*z + A_mem[ 9]; - out_mem[1] = A_mem[ 1]*x + A_mem[ 4]*y + A_mem[ 7]*z + A_mem[10]; - out_mem[2] = A_mem[ 2]*x + A_mem[ 5]*y + A_mem[ 8]*z + A_mem[11]; - } - } - break; - - case 4: // A is 4x5 - { - if(B_n_cols == 1) - { - const eT* B_mem = B.memptr(); - eT* out_mem = out.memptr(); - - const eT x = B_mem[0]; - const eT y = B_mem[1]; - const eT z = B_mem[2]; - const eT w = B_mem[3]; - - out_mem[0] = A_mem[ 0]*x + A_mem[ 4]*y + A_mem[ 8]*z + A_mem[12]*w + A_mem[16]; - out_mem[1] = A_mem[ 1]*x + A_mem[ 5]*y + A_mem[ 9]*z + A_mem[13]*w + A_mem[17]; - out_mem[2] = A_mem[ 2]*x + A_mem[ 6]*y + A_mem[10]*z + A_mem[14]*w + A_mem[18]; - out_mem[3] = A_mem[ 3]*x + A_mem[ 7]*y + A_mem[11]*z + A_mem[15]*w + A_mem[19]; - } - else - for(uword col=0; col < B_n_cols; ++col) - { - const eT* B_mem = B.colptr(col); - eT* out_mem = out.colptr(col); - - const eT x = B_mem[0]; - const eT y = B_mem[1]; - const eT z = B_mem[2]; - const eT w = B_mem[3]; - - out_mem[0] = A_mem[ 0]*x + A_mem[ 4]*y + A_mem[ 8]*z + A_mem[12]*w + A_mem[16]; - out_mem[1] = A_mem[ 1]*x + A_mem[ 5]*y + A_mem[ 9]*z + A_mem[13]*w + A_mem[17]; - out_mem[2] = A_mem[ 2]*x + A_mem[ 6]*y + A_mem[10]*z + A_mem[14]*w + A_mem[18]; - out_mem[3] = A_mem[ 3]*x + A_mem[ 7]*y + A_mem[11]*z + A_mem[15]*w + A_mem[19]; - } - } - break; - - default: - { - const uword A_n_cols = A.n_cols; - - if(B_n_cols == 1) - { - Col tmp(A_n_cols, arma_nozeros_indicator()); - eT* tmp_mem = tmp.memptr(); - - arrayops::copy(tmp_mem, B.memptr(), A_n_cols-1); - - tmp_mem[A_n_cols-1] = eT(1); - - out = A * tmp; - } - else - { - Mat tmp(A_n_cols, B_n_cols, arma_nozeros_indicator()); - - for(uword col=0; col < B_n_cols; ++col) - { - const eT* B_mem = B.colptr(col); - eT* tmp_mem = tmp.colptr(col); - - arrayops::copy(tmp_mem, B_mem, A_n_cols-1); - - tmp_mem[A_n_cols-1] = eT(1); - } - - out = A * tmp; - } - } - } - } - - - -template -inline -void -glue_affmul::apply_noalias_generic(Mat& out, const T1& A, const T2& B) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - // assuming that A.n_cols = B.n_rows+1 - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - Mat tmp(B_n_rows+1, B_n_cols, arma_nozeros_indicator()); - - for(uword col=0; col < B_n_cols; ++col) - { - const eT* B_mem = B.colptr(col); - eT* tmp_mem = tmp.colptr(col); - - arrayops::copy(tmp_mem, B_mem, B_n_rows); - - tmp_mem[B_n_rows] = eT(1); - } - - out = A * tmp; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_atan2_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_atan2_bones.hpp deleted file mode 100644 index f60e7830c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_atan2_bones.hpp +++ /dev/null @@ -1,47 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup glue_atan2 -//! @{ - - - -class glue_atan2 - : public traits_glue_or - { - public: - - - // matrices - - template inline static void apply(Mat& out, const Glue& expr); - - template inline static void apply_noalias(Mat& out, const Proxy& P1, const Proxy& P2); - - - // cubes - - template inline static void apply(Cube& out, const GlueCube& expr); - - template inline static void apply_noalias(Cube& out, const ProxyCube& P1, const ProxyCube& P2); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_atan2_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_atan2_meat.hpp deleted file mode 100644 index 9408e0e40..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_atan2_meat.hpp +++ /dev/null @@ -1,228 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_atan2 -//! @{ - - - -template -inline -void -glue_atan2::apply(Mat& out, const Glue& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const Proxy P1(expr.A); - const Proxy P2(expr.B); - - arma_assert_same_size(P1, P2, "atan2()"); - - const bool bad_alias = ( (Proxy::has_subview && P1.is_alias(out)) || (Proxy::has_subview && P2.is_alias(out)) ); - - if(bad_alias == false) - { - glue_atan2::apply_noalias(out, P1, P2); - } - else - { - Mat tmp; - - glue_atan2::apply_noalias(tmp, P1, P2); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -glue_atan2::apply_noalias(Mat& out, const Proxy& P1, const Proxy& P2) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_rows = P1.get_n_rows(); - const uword n_cols = P1.get_n_cols(); - const uword n_elem = P1.get_n_elem(); - - out.set_size(n_rows, n_cols); - - eT* out_mem = out.memptr(); - - const bool use_mp = arma_config::openmp && mp_gate::use_mp || Proxy::use_mp)>::eval(n_elem); - constexpr bool use_at = Proxy::use_at || Proxy::use_at; - - if(use_at == false) - { - typename Proxy::ea_type eaP1 = P1.get_ea(); - typename Proxy::ea_type eaP2 = P2.get_ea(); - - if(use_mp) - { - #if defined(ARMA_USE_OPENMP) - { - const int n_threads = mp_thread_limit::get(); - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword i=0; i::stored_type> U1(P1.Q); - const unwrap::stored_type> U2(P2.Q); - - out = arma::atan2(U1.M, U2.M); - } - else - { - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - *out_mem = std::atan2( P1.at(row,col), P2.at(row,col) ); - out_mem++; - } - } - } - } - - - -template -inline -void -glue_atan2::apply(Cube& out, const GlueCube& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const ProxyCube P1(expr.A); - const ProxyCube P2(expr.B); - - arma_assert_same_size(P1, P2, "atan2()"); - - const bool bad_alias = ( (ProxyCube::has_subview && P1.is_alias(out)) || (ProxyCube::has_subview && P2.is_alias(out)) ); - - if(bad_alias == false) - { - glue_atan2::apply_noalias(out, P1, P2); - } - else - { - Cube tmp; - - glue_atan2::apply_noalias(tmp, P1, P2); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -glue_atan2::apply_noalias(Cube& out, const ProxyCube& P1, const ProxyCube& P2) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_rows = P1.get_n_rows(); - const uword n_cols = P1.get_n_cols(); - const uword n_slices = P1.get_n_slices(); - const uword n_elem = P1.get_n_elem(); - - out.set_size(n_rows, n_cols, n_slices); - - eT* out_mem = out.memptr(); - - const bool use_mp = arma_config::openmp && mp_gate::use_mp || ProxyCube::use_mp)>::eval(n_elem); - constexpr bool use_at = ProxyCube::use_at || ProxyCube::use_at; - - if(use_at == false) - { - typename ProxyCube::ea_type eaP1 = P1.get_ea(); - typename ProxyCube::ea_type eaP2 = P2.get_ea(); - - if(use_mp) - { - #if defined(ARMA_USE_OPENMP) - { - const int n_threads = mp_thread_limit::get(); - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword i=0; i::stored_type> U1(P1.Q); - const unwrap_cube::stored_type> U2(P2.Q); - - out = arma::atan2(U1.M, U2.M); - } - else - { - for(uword slice=0; slice < n_slices; ++slice) - for(uword col=0; col < n_cols; ++col ) - for(uword row=0; row < n_rows; ++row ) - { - *out_mem = std::atan2( P1.at(row,col,slice), P2.at(row,col,slice) ); - out_mem++; - } - } - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_conv_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_conv_bones.hpp deleted file mode 100644 index 5382f84cd..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_conv_bones.hpp +++ /dev/null @@ -1,57 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup glue_conv -//! @{ - - - -class glue_conv - { - public: - - template - struct traits - { - static constexpr bool is_row = T1::is_row; - static constexpr bool is_col = T1::is_col; - static constexpr bool is_xvec = T1::is_xvec; - }; - - template inline static void apply(Mat& out, const Mat& A, const Mat& B, const bool A_is_col); - - template inline static void apply(Mat& out, const Glue& X); - }; - - - -class glue_conv2 - : public traits_glue_default - { - public: - - template inline static void apply(Mat& out, const Mat& A, const Mat& B); - - template inline static void apply(Mat& out, const Glue& expr); - }; - - - -//! @} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_conv_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_conv_meat.hpp deleted file mode 100644 index 86726422e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_conv_meat.hpp +++ /dev/null @@ -1,385 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_conv -//! @{ - - - -// TODO: this implementation of conv() is rudimentary; replace with faster version -template -inline -void -glue_conv::apply(Mat& out, const Mat& A, const Mat& B, const bool A_is_col) - { - arma_debug_sigprint(); - - const Mat& h = (A.n_elem <= B.n_elem) ? A : B; - const Mat& x = (A.n_elem <= B.n_elem) ? B : A; - - const uword h_n_elem = h.n_elem; - const uword h_n_elem_m1 = h_n_elem - 1; - const uword x_n_elem = x.n_elem; - const uword out_n_elem = ((h_n_elem + x_n_elem) > 0) ? (h_n_elem + x_n_elem - 1) : uword(0); - - if( (h_n_elem == 0) || (x_n_elem == 0) ) { out.zeros(); return; } - - - Col hh(h_n_elem, arma_nozeros_indicator()); // flipped version of h - - const eT* h_mem = h.memptr(); - eT* hh_mem = hh.memptr(); - - for(uword i=0; i < h_n_elem; ++i) - { - hh_mem[h_n_elem_m1-i] = h_mem[i]; - } - - - Col xx( (x_n_elem + 2*h_n_elem_m1), arma_zeros_indicator() ); // zero padded version of x - - const eT* x_mem = x.memptr(); - eT* xx_mem = xx.memptr(); - - arrayops::copy( &(xx_mem[h_n_elem_m1]), x_mem, x_n_elem ); - - - (A_is_col) ? out.set_size(out_n_elem, 1) : out.set_size(1, out_n_elem); - - eT* out_mem = out.memptr(); - - if( (arma_config::openmp) && (x_n_elem >= 128) && (h_n_elem >= 64) && (mp_thread_limit::in_parallel() == false) ) - { - #if defined(ARMA_USE_OPENMP) - { - const int n_threads = mp_thread_limit::get(); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword i=0; i < out_n_elem; ++i) - { - out_mem[i] = op_dot::direct_dot( h_n_elem, hh_mem, &(xx_mem[i]) ); - } - } - #endif - } - else - { - for(uword i=0; i < out_n_elem; ++i) - { - // out_mem[i] = dot( hh, xx.subvec(i, (i + h_n_elem_m1)) ); - - out_mem[i] = op_dot::direct_dot( h_n_elem, hh_mem, &(xx_mem[i]) ); - } - } - } - - - -// // alternative implementation of 1d convolution -// template -// inline -// void -// glue_conv::apply(Mat& out, const Mat& A, const Mat& B, const bool A_is_col) -// { -// arma_debug_sigprint(); -// -// const Mat& h = (A.n_elem <= B.n_elem) ? A : B; -// const Mat& x = (A.n_elem <= B.n_elem) ? B : A; -// -// const uword h_n_elem = h.n_elem; -// const uword h_n_elem_m1 = h_n_elem - 1; -// const uword x_n_elem = x.n_elem; -// const uword out_n_elem = ((h_n_elem + x_n_elem) > 0) ? (h_n_elem + x_n_elem - 1) : uword(0); -// -// if( (h_n_elem == 0) || (x_n_elem == 0) ) { out.zeros(); return; } -// -// -// Col hh(h_n_elem, arma_nozeros_indicator()); // flipped version of h -// -// const eT* h_mem = h.memptr(); -// eT* hh_mem = hh.memptr(); -// -// for(uword i=0; i < h_n_elem; ++i) -// { -// hh_mem[h_n_elem_m1-i] = h_mem[i]; -// } -// -// // construct HH matrix, with the column containing shifted versions of hh; -// // upper limit for number of zeros is about 50%; may not be optimal -// const uword N_copies = (std::min)(uword(10), h_n_elem); -// -// const uword HH_n_rows = h_n_elem + (N_copies-1); -// -// Mat HH(HH_n_rows, N_copies, arma_zeros_indicator()); -// -// for(uword i=0; i xx( (x_n_elem + 2*h_n_elem_m1), arma_zeros_indicator() ); // zero padded version of x -// -// const eT* x_mem = x.memptr(); -// eT* xx_mem = xx.memptr(); -// -// arrayops::copy( &(xx_mem[h_n_elem_m1]), x_mem, x_n_elem ); -// -// -// (A_is_col) ? out.set_size(out_n_elem, 1) : out.set_size(1, out_n_elem); -// -// eT* out_mem = out.memptr(); -// -// uword last_i = 0; -// bool last_i_done = false; -// -// for(uword i=0; i < xx.n_elem; i += N_copies) -// { -// if( ((i + HH_n_rows) <= xx.n_elem) && ((i + N_copies) <= out_n_elem) ) -// { -// const Row xx_sub(xx_mem + i, HH_n_rows, false, true); -// -// Row out_sub(out_mem + i, N_copies, false, true); -// -// out_sub = xx_sub * HH; -// -// last_i_done = true; -// } -// else -// { -// last_i = i; -// last_i_done = false; -// break; -// } -// } -// -// if(last_i_done == false) -// { -// for(uword i=last_i; i < out_n_elem; ++i) -// { -// // out_mem[i] = dot( hh, xx.subvec(i, (i + h_n_elem_m1)) ); -// -// out_mem[i] = op_dot::direct_dot( h_n_elem, hh_mem, &(xx_mem[i]) ); -// } -// } -// } - - - -template -inline -void -glue_conv::apply(Mat& out, const Glue& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap UA(expr.A); - const quasi_unwrap UB(expr.B); - - const Mat& A = UA.M; - const Mat& B = UB.M; - - arma_conform_check - ( - ( ((A.is_vec() == false) && (A.is_empty() == false)) || ((B.is_vec() == false) && (B.is_empty() == false)) ), - "conv(): given object must be a vector" - ); - - const bool A_is_col = ((T1::is_col) || (A.n_cols == 1)); - - const uword mode = expr.aux_uword; - - if(mode == 0) // full convolution - { - glue_conv::apply(out, A, B, A_is_col); - } - else - if(mode == 1) // same size as A - { - Mat tmp; - - glue_conv::apply(tmp, A, B, A_is_col); - - if( (tmp.is_empty() == false) && (A.is_empty() == false) && (B.is_empty() == false) ) - { - const uword start = uword( std::floor( double(B.n_elem) / double(2) ) ); - - out = (A_is_col) ? tmp(start, 0, arma::size(A)) : tmp(0, start, arma::size(A)); - } - else - { - out.zeros( arma::size(A) ); - } - } - } - - - -/// - - - -// TODO: this implementation of conv2() is rudimentary; replace with faster version -template -inline -void -glue_conv2::apply(Mat& out, const Mat& A, const Mat& B) - { - arma_debug_sigprint(); - - const Mat& G = (A.n_elem <= B.n_elem) ? A : B; // unflipped filter coefficients - const Mat& W = (A.n_elem <= B.n_elem) ? B : A; // original 2D image - - const uword out_n_rows = ((W.n_rows + G.n_rows) > 0) ? (W.n_rows + G.n_rows - 1) : uword(0); - const uword out_n_cols = ((W.n_cols + G.n_cols) > 0) ? (W.n_cols + G.n_cols - 1) : uword(0); - - if(G.is_empty() || W.is_empty()) { out.zeros(); return; } - - - Mat H(G.n_rows, G.n_cols, arma_nozeros_indicator()); // flipped filter coefficients - - const uword H_n_rows = H.n_rows; - const uword H_n_cols = H.n_cols; - - const uword H_n_rows_m1 = H_n_rows - 1; - const uword H_n_cols_m1 = H_n_cols - 1; - - for(uword col=0; col < H_n_cols; ++col) - { - eT* H_colptr = H.colptr(H_n_cols_m1 - col); - const eT* G_colptr = G.colptr(col); - - for(uword row=0; row < H_n_rows; ++row) - { - H_colptr[H_n_rows_m1 - row] = G_colptr[row]; - } - } - - - Mat X( (W.n_rows + 2*H_n_rows_m1), (W.n_cols + 2*H_n_cols_m1), arma_zeros_indicator() ); - - X( H_n_rows_m1, H_n_cols_m1, arma::size(W) ) = W; // zero padded version of 2D image - - - out.set_size( out_n_rows, out_n_cols ); - - if( (arma_config::openmp) && (out_n_cols >= 2) && (mp_thread_limit::in_parallel() == false) ) - { - #if defined(ARMA_USE_OPENMP) - { - const int n_threads = mp_thread_limit::get(); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword col=0; col < out_n_cols; ++col) - { - eT* out_colptr = out.colptr(col); - - for(uword row=0; row < out_n_rows; ++row) - { - // out.at(row, col) = accu( H % X(row, col, size(H)) ); - - eT acc = eT(0); - - for(uword H_col = 0; H_col < H_n_cols; ++H_col) - { - const eT* X_colptr = X.colptr(col + H_col); - - acc += op_dot::direct_dot( H_n_rows, H.colptr(H_col), &(X_colptr[row]) ); - } - - out_colptr[row] = acc; - } - } - } - #endif - } - else - { - for(uword col=0; col < out_n_cols; ++col) - { - eT* out_colptr = out.colptr(col); - - for(uword row=0; row < out_n_rows; ++row) - { - // out.at(row, col) = accu( H % X(row, col, size(H)) ); - - eT acc = eT(0); - - for(uword H_col = 0; H_col < H_n_cols; ++H_col) - { - const eT* X_colptr = X.colptr(col + H_col); - - acc += op_dot::direct_dot( H_n_rows, H.colptr(H_col), &(X_colptr[row]) ); - } - - out_colptr[row] = acc; - } - } - } - } - - - -template -inline -void -glue_conv2::apply(Mat& out, const Glue& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap UA(expr.A); - const quasi_unwrap UB(expr.B); - - const Mat& A = UA.M; - const Mat& B = UB.M; - - const uword mode = expr.aux_uword; - - if(mode == 0) // full convolution - { - glue_conv2::apply(out, A, B); - } - else - if(mode == 1) // same size as A - { - Mat tmp; - - glue_conv2::apply(tmp, A, B); - - if( (tmp.is_empty() == false) && (A.is_empty() == false) && (B.is_empty() == false) ) - { - const uword start_row = uword( std::floor( double(B.n_rows) / double(2) ) ); - const uword start_col = uword( std::floor( double(B.n_cols) / double(2) ) ); - - out = tmp(start_row, start_col, arma::size(A)); - } - else - { - out.zeros( arma::size(A) ); - } - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_cor_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_cor_bones.hpp deleted file mode 100644 index eabb89771..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_cor_bones.hpp +++ /dev/null @@ -1,43 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup glue_cor -//! @{ - - - -class glue_cor - { - public: - - template - struct traits - { - static constexpr bool is_row = false; // T1::is_col; // TODO: check - static constexpr bool is_col = false; // T2::is_col; // TODO: check - static constexpr bool is_xvec = false; - }; - - template inline static void apply(Mat& out, const Glue& X); - }; - - - -//! @} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_cor_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_cor_meat.hpp deleted file mode 100644 index 7bc30ca76..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_cor_meat.hpp +++ /dev/null @@ -1,71 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_cor -//! @{ - - - -template -inline -void -glue_cor::apply(Mat& out, const Glue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword norm_type = X.aux_uword; - - const unwrap UA(X.A); - const unwrap UB(X.B); - - const Mat& A = UA.M; - const Mat& B = UB.M; - - const Mat& AA = (A.n_rows == 1) - ? Mat(const_cast(A.memptr()), A.n_cols, A.n_rows, false, false) - : Mat(const_cast(A.memptr()), A.n_rows, A.n_cols, false, false); - - const Mat& BB = (B.n_rows == 1) - ? Mat(const_cast(B.memptr()), B.n_cols, B.n_rows, false, false) - : Mat(const_cast(B.memptr()), B.n_rows, B.n_cols, false, false); - - arma_conform_assert_mul_size(AA, BB, true, false, "cor()"); - - if( (AA.n_elem == 0) || (BB.n_elem == 0) ) - { - out.reset(); - return; - } - - const uword N = AA.n_rows; - const eT norm_val = (norm_type == 0) ? ( (N > 1) ? eT(N-1) : eT(1) ) : eT(N); - - const Mat tmp1 = AA.each_row() - mean(AA,0); - const Mat tmp2 = BB.each_row() - mean(BB,0); - - out = tmp1.t() * tmp2; - out /= norm_val; - - out /= conv_to< Mat >::from( stddev(AA).t() * stddev(BB) ); // TODO: check for zeros? - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_cov_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_cov_bones.hpp deleted file mode 100644 index 385dd7a03..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_cov_bones.hpp +++ /dev/null @@ -1,43 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup glue_cov -//! @{ - - - -class glue_cov - { - public: - - template - struct traits - { - static constexpr bool is_row = false; // T1::is_col; // TODO: check - static constexpr bool is_col = false; // T2::is_col; // TODO: check - static constexpr bool is_xvec = false; - }; - - template inline static void apply(Mat& out, const Glue& X); - }; - - - -//! @} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_cov_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_cov_meat.hpp deleted file mode 100644 index 17f5e7504..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_cov_meat.hpp +++ /dev/null @@ -1,69 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_cov -//! @{ - - - -template -inline -void -glue_cov::apply(Mat& out, const Glue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword norm_type = X.aux_uword; - - const unwrap UA(X.A); - const unwrap UB(X.B); - - const Mat& A = UA.M; - const Mat& B = UB.M; - - const Mat& AA = (A.n_rows == 1) - ? Mat(const_cast(A.memptr()), A.n_cols, A.n_rows, false, false) - : Mat(const_cast(A.memptr()), A.n_rows, A.n_cols, false, false); - - const Mat& BB = (B.n_rows == 1) - ? Mat(const_cast(B.memptr()), B.n_cols, B.n_rows, false, false) - : Mat(const_cast(B.memptr()), B.n_rows, B.n_cols, false, false); - - arma_conform_assert_mul_size(AA, BB, true, false, "cov()"); - - if( (A.n_elem == 0) || (B.n_elem == 0) ) - { - out.reset(); - return; - } - - const uword N = AA.n_rows; - const eT norm_val = (norm_type == 0) ? ( (N > 1) ? eT(N-1) : eT(1) ) : eT(N); - - const Mat tmp1 = AA.each_row() - mean(AA,0); - const Mat tmp2 = BB.each_row() - mean(BB,0); - - out = tmp1.t() * tmp2; - out /= norm_val; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_cross_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_cross_bones.hpp deleted file mode 100644 index 469e2e7c7..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_cross_bones.hpp +++ /dev/null @@ -1,42 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup glue_cross -//! @{ - - - -class glue_cross - { - public: - - template - struct traits - { - static constexpr bool is_row = T1::is_row; - static constexpr bool is_col = T1::is_col; - static constexpr bool is_xvec = true; - }; - - template inline static void apply(Mat& out, const Glue& X); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_cross_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_cross_meat.hpp deleted file mode 100644 index c2d266e2d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_cross_meat.hpp +++ /dev/null @@ -1,81 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup glue_cross -//! @{ - - - -template -inline -void -glue_cross::apply(Mat& out, const Glue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const Proxy PA(X.A); - const Proxy PB(X.B); - - arma_conform_check( ((PA.get_n_elem() != 3) || (PB.get_n_elem() != 3)), "cross(): each vector must have 3 elements" ); - - out.set_size(PA.get_n_rows(), PA.get_n_cols()); - - eT* out_mem = out.memptr(); - - if( (Proxy::use_at == false) && (Proxy::use_at == false) ) - { - typename Proxy::ea_type A = PA.get_ea(); - typename Proxy::ea_type B = PB.get_ea(); - - const eT ax = A[0]; - const eT ay = A[1]; - const eT az = A[2]; - - const eT bx = B[0]; - const eT by = B[1]; - const eT bz = B[2]; - - out_mem[0] = ay*bz - az*by; - out_mem[1] = az*bx - ax*bz; - out_mem[2] = ax*by - ay*bx; - } - else - { - const bool PA_is_col = Proxy::is_col ? true : (PA.get_n_cols() == 1); - const bool PB_is_col = Proxy::is_col ? true : (PB.get_n_cols() == 1); - - const eT ax = PA.at(0,0); - const eT ay = PA_is_col ? PA.at(1,0) : PA.at(0,1); - const eT az = PA_is_col ? PA.at(2,0) : PA.at(0,2); - - const eT bx = PB.at(0,0); - const eT by = PB_is_col ? PB.at(1,0) : PB.at(0,1); - const eT bz = PB_is_col ? PB.at(2,0) : PB.at(0,2); - - out_mem[0] = ay*bz - az*by; - out_mem[1] = az*bx - ax*bz; - out_mem[2] = ax*by - ay*bx; - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_hist_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_hist_bones.hpp deleted file mode 100644 index 2d0535884..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_hist_bones.hpp +++ /dev/null @@ -1,54 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_hist -//! @{ - - -class glue_hist - : public traits_glue_default - { - public: - - template - inline static void apply_noalias(Mat& out, const Mat& X, const Mat& C, const uword dim); - - template - inline static void apply(Mat& out, const mtGlue& expr); - }; - - - -class glue_hist_default - { - public: - - template - struct traits - { - static constexpr bool is_row = T1::is_row; - static constexpr bool is_col = T1::is_col; - static constexpr bool is_xvec = T1::is_xvec; - }; - - template - inline static void apply(Mat& out, const mtGlue& expr); - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_hist_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_hist_meat.hpp deleted file mode 100644 index 9984f9bdf..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_hist_meat.hpp +++ /dev/null @@ -1,253 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_hist -//! @{ - - -template -inline -void -glue_hist::apply_noalias(Mat& out, const Mat& X, const Mat& C, const uword dim) - { - arma_debug_sigprint(); - - arma_conform_check( ((C.is_vec() == false) && (C.is_empty() == false)), "hist(): parameter 'centers' must be a vector" ); - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - const uword C_n_elem = C.n_elem; - - if( C_n_elem == 0 ) { out.reset(); return; } - - arma_conform_check - ( - ((Col(const_cast(C.memptr()), C_n_elem, false, false)).is_sorted("strictascend") == false), - "hist(): given 'centers' vector does not contain monotonically increasing values" - ); - - const eT* C_mem = C.memptr(); - const eT center_0 = C_mem[0]; - - if(dim == 0) - { - out.zeros(C_n_elem, X_n_cols); - - for(uword col=0; col < X_n_cols; ++col) - { - const eT* X_coldata = X.colptr(col); - uword* out_coldata = out.colptr(col); - - for(uword row=0; row < X_n_rows; ++row) - { - const eT val = X_coldata[row]; - - if(arma_isfinite(val)) - { - eT opt_dist = (center_0 >= val) ? (center_0 - val) : (val - center_0); - uword opt_index = 0; - - for(uword j=1; j < C_n_elem; ++j) - { - const eT center = C_mem[j]; - const eT dist = (center >= val) ? (center - val) : (val - center); - - if(dist < opt_dist) - { - opt_dist = dist; - opt_index = j; - } - else - { - break; - } - } - - out_coldata[opt_index]++; - } - else - { - // -inf - if(val < eT(0)) { out_coldata[0]++; } - - // +inf - if(val > eT(0)) { out_coldata[C_n_elem-1]++; } - - // ignore NaN - } - } - } - } - else - if(dim == 1) - { - out.zeros(X_n_rows, C_n_elem); - - if(X_n_rows == 1) - { - const uword X_n_elem = X.n_elem; - const eT* X_mem = X.memptr(); - uword* out_mem = out.memptr(); - - for(uword i=0; i < X_n_elem; ++i) - { - const eT val = X_mem[i]; - - if(is_finite(val)) - { - eT opt_dist = (val >= center_0) ? (val - center_0) : (center_0 - val); - uword opt_index = 0; - - for(uword j=1; j < C_n_elem; ++j) - { - const eT center = C_mem[j]; - const eT dist = (val >= center) ? (val - center) : (center - val); - - if(dist < opt_dist) - { - opt_dist = dist; - opt_index = j; - } - else - { - break; - } - } - - out_mem[opt_index]++; - } - else - { - // -inf - if(val < eT(0)) { out_mem[0]++; } - - // +inf - if(val > eT(0)) { out_mem[C_n_elem-1]++; } - - // ignore NaN - } - } - } - else - { - for(uword row=0; row < X_n_rows; ++row) - { - for(uword col=0; col < X_n_cols; ++col) - { - const eT val = X.at(row,col); - - if(arma_isfinite(val)) - { - eT opt_dist = (center_0 >= val) ? (center_0 - val) : (val - center_0); - uword opt_index = 0; - - for(uword j=1; j < C_n_elem; ++j) - { - const eT center = C_mem[j]; - const eT dist = (center >= val) ? (center - val) : (val - center); - - if(dist < opt_dist) - { - opt_dist = dist; - opt_index = j; - } - else - { - break; - } - } - - out.at(row,opt_index)++; - } - else - { - // -inf - if(val < eT(0)) { out.at(row,0)++; } - - // +inf - if(val > eT(0)) { out.at(row,C_n_elem-1)++; } - - // ignore NaN - } - } - } - } - } - } - - - -template -inline -void -glue_hist::apply(Mat& out, const mtGlue& expr) - { - arma_debug_sigprint(); - - const uword dim = expr.aux_uword; - - arma_conform_check( (dim > 1), "hist(): parameter 'dim' must be 0 or 1" ); - - const quasi_unwrap UA(expr.A); - const quasi_unwrap UB(expr.B); - - if(UA.is_alias(out) || UB.is_alias(out)) - { - Mat tmp; - - glue_hist::apply_noalias(tmp, UA.M, UB.M, dim); - - out.steal_mem(tmp); - } - else - { - glue_hist::apply_noalias(out, UA.M, UB.M, dim); - } - } - - - -template -inline -void -glue_hist_default::apply(Mat& out, const mtGlue& expr) - { - arma_debug_sigprint(); - - const quasi_unwrap UA(expr.A); - const quasi_unwrap UB(expr.B); - - const uword dim = (T1::is_xvec) ? uword(UA.M.is_rowvec() ? 1 : 0) : uword((T1::is_row) ? 1 : 0); - - if(UA.is_alias(out) || UB.is_alias(out)) - { - Mat tmp; - - glue_hist::apply_noalias(tmp, UA.M, UB.M, dim); - - out.steal_mem(tmp); - } - else - { - glue_hist::apply_noalias(out, UA.M, UB.M, dim); - } - } - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_histc_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_histc_bones.hpp deleted file mode 100644 index c1cc68752..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_histc_bones.hpp +++ /dev/null @@ -1,54 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_histc -//! @{ - - -class glue_histc - : public traits_glue_default - { - public: - - template - inline static void apply_noalias(Mat& C, const Mat& A, const Mat& B, const uword dim); - - template - inline static void apply(Mat& C, const mtGlue& expr); - }; - - - -class glue_histc_default - { - public: - - template - struct traits - { - static constexpr bool is_row = T1::is_row; - static constexpr bool is_col = T1::is_col; - static constexpr bool is_xvec = T1::is_xvec; - }; - - template - inline static void apply(Mat& C, const mtGlue& expr); - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_histc_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_histc_meat.hpp deleted file mode 100644 index 79d9ebfde..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_histc_meat.hpp +++ /dev/null @@ -1,167 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_histc -//! @{ - - -template -inline -void -glue_histc::apply_noalias(Mat& C, const Mat& A, const Mat& B, const uword dim) - { - arma_debug_sigprint(); - - arma_conform_check( ((B.is_vec() == false) && (B.is_empty() == false)), "histc(): parameter 'edges' must be a vector" ); - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const uword B_n_elem = B.n_elem; - - if( B_n_elem == uword(0) ) { C.reset(); return; } - - arma_conform_check - ( - ((Col(const_cast(B.memptr()), B_n_elem, false, false)).is_sorted("strictascend") == false), - "hist(): given 'edges' vector does not contain monotonically increasing values" - ); - - const eT* B_mem = B.memptr(); - const uword B_n_elem_m1 = B_n_elem - 1; - - if(dim == uword(0)) - { - C.zeros(B_n_elem, A_n_cols); - - for(uword col=0; col < A_n_cols; ++col) - { - const eT* A_coldata = A.colptr(col); - uword* C_coldata = C.colptr(col); - - for(uword row=0; row < A_n_rows; ++row) - { - const eT x = A_coldata[row]; - - for(uword i=0; i < B_n_elem_m1; ++i) - { - if( (B_mem[i] <= x) && (x < B_mem[i+1]) ) { C_coldata[i]++; break; } - else if( B_mem[B_n_elem_m1] == x ) { C_coldata[B_n_elem_m1]++; break; } // for compatibility with Matlab - } - } - } - } - else - if(dim == uword(1)) - { - C.zeros(A_n_rows, B_n_elem); - - if(A.n_rows == 1) - { - const uword A_n_elem = A.n_elem; - const eT* A_mem = A.memptr(); - uword* C_mem = C.memptr(); - - for(uword j=0; j < A_n_elem; ++j) - { - const eT x = A_mem[j]; - - for(uword i=0; i < B_n_elem_m1; ++i) - { - if( (B_mem[i] <= x) && (x < B_mem[i+1]) ) { C_mem[i]++; break; } - else if( B_mem[B_n_elem_m1] == x ) { C_mem[B_n_elem_m1]++; break; } // for compatibility with Matlab - } - } - } - else - { - for(uword row=0; row < A_n_rows; ++row) - for(uword col=0; col < A_n_cols; ++col) - { - const eT x = A.at(row,col); - - for(uword i=0; i < B_n_elem_m1; ++i) - { - if( (B_mem[i] <= x) && (x < B_mem[i+1]) ) { C.at(row,i)++; break; } - else if( B_mem[B_n_elem_m1] == x ) { C.at(row,B_n_elem_m1)++; break; } // for compatibility with Matlab - } - } - } - } - } - - - -template -inline -void -glue_histc::apply(Mat& C, const mtGlue& expr) - { - arma_debug_sigprint(); - - const uword dim = expr.aux_uword; - - arma_conform_check( (dim > 1), "histc(): parameter 'dim' must be 0 or 1" ); - - const quasi_unwrap UA(expr.A); - const quasi_unwrap UB(expr.B); - - if(UA.is_alias(C) || UB.is_alias(C)) - { - Mat tmp; - - glue_histc::apply_noalias(tmp, UA.M, UB.M, dim); - - C.steal_mem(tmp); - } - else - { - glue_histc::apply_noalias(C, UA.M, UB.M, dim); - } - } - - - -template -inline -void -glue_histc_default::apply(Mat& C, const mtGlue& expr) - { - arma_debug_sigprint(); - - const quasi_unwrap UA(expr.A); - const quasi_unwrap UB(expr.B); - - const uword dim = (T1::is_xvec) ? uword(UA.M.is_rowvec() ? 1 : 0) : uword((T1::is_row) ? 1 : 0); - - if(UA.is_alias(C) || UB.is_alias(C)) - { - Mat tmp; - - glue_histc::apply_noalias(tmp, UA.M, UB.M, dim); - - C.steal_mem(tmp); - } - else - { - glue_histc::apply_noalias(C, UA.M, UB.M, dim); - } - } - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_hypot_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_hypot_bones.hpp deleted file mode 100644 index 53985cc33..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_hypot_bones.hpp +++ /dev/null @@ -1,47 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup glue_hypot -//! @{ - - - -class glue_hypot - : public traits_glue_or - { - public: - - - // matrices - - template inline static void apply(Mat& out, const Glue& expr); - - template inline static void apply_noalias(Mat& out, const Proxy& P1, const Proxy& P2); - - - // cubes - - template inline static void apply(Cube& out, const GlueCube& expr); - - template inline static void apply_noalias(Cube& out, const ProxyCube& P1, const ProxyCube& P2); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_hypot_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_hypot_meat.hpp deleted file mode 100644 index 193f83a1e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_hypot_meat.hpp +++ /dev/null @@ -1,172 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_hypot -//! @{ - - - -template -inline -void -glue_hypot::apply(Mat& out, const Glue& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const Proxy P1(expr.A); - const Proxy P2(expr.B); - - arma_assert_same_size(P1, P2, "hypot()"); - - const bool bad_alias = ( (Proxy::has_subview && P1.is_alias(out)) || (Proxy::has_subview && P2.is_alias(out)) ); - - if(bad_alias == false) - { - glue_hypot::apply_noalias(out, P1, P2); - } - else - { - Mat tmp; - - glue_hypot::apply_noalias(tmp, P1, P2); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -glue_hypot::apply_noalias(Mat& out, const Proxy& P1, const Proxy& P2) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_rows = P1.get_n_rows(); - const uword n_cols = P1.get_n_cols(); - - out.set_size(n_rows, n_cols); - - eT* out_mem = out.memptr(); - - if( (Proxy::use_at == false) && (Proxy::use_at == false) ) - { - typename Proxy::ea_type eaP1 = P1.get_ea(); - typename Proxy::ea_type eaP2 = P2.get_ea(); - - const uword N = P1.get_n_elem(); - - for(uword i=0; i -inline -void -glue_hypot::apply(Cube& out, const GlueCube& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const ProxyCube P1(expr.A); - const ProxyCube P2(expr.B); - - arma_assert_same_size(P1, P2, "hypot()"); - - const bool bad_alias = ( (ProxyCube::has_subview && P1.is_alias(out)) || (ProxyCube::has_subview && P2.is_alias(out)) ); - - if(bad_alias == false) - { - glue_hypot::apply_noalias(out, P1, P2); - } - else - { - Cube tmp; - - glue_hypot::apply_noalias(tmp, P1, P2); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -glue_hypot::apply_noalias(Cube& out, const ProxyCube& P1, const ProxyCube& P2) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_rows = P1.get_n_rows(); - const uword n_cols = P1.get_n_cols(); - const uword n_slices = P1.get_n_slices(); - - out.set_size(n_rows, n_cols, n_slices); - - eT* out_mem = out.memptr(); - - if( (ProxyCube::use_at == false) && (ProxyCube::use_at == false) ) - { - typename ProxyCube::ea_type eaP1 = P1.get_ea(); - typename ProxyCube::ea_type eaP2 = P2.get_ea(); - - const uword N = P1.get_n_elem(); - - for(uword i=0; i - struct traits - { - static constexpr bool is_row = (T1::is_row && T2::is_row); - static constexpr bool is_col = (T1::is_col || T2::is_col); - static constexpr bool is_xvec = false; - }; - - template - inline static void apply(Mat& out, const Glue& X); - - template - inline static void apply(Mat& out, uvec& iA, uvec& iB, const Base& A_expr, const Base& B_expr, const bool calc_indx); - }; - - - -//! @} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_intersect_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_intersect_meat.hpp deleted file mode 100644 index 16952058d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_intersect_meat.hpp +++ /dev/null @@ -1,148 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_intersect -//! @{ - - - -template -inline -void -glue_intersect::apply(Mat& out, const Glue& X) - { - arma_debug_sigprint(); - - uvec iA; - uvec iB; - - glue_intersect::apply(out, iA, iB, X.A, X.B, false); - } - - - -template -inline -void -glue_intersect::apply(Mat& out, uvec& iA, uvec& iB, const Base& A_expr, const Base& B_expr, const bool calc_indx) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap UA(A_expr.get_ref()); - const quasi_unwrap UB(B_expr.get_ref()); - - if(UA.M.is_empty() || UB.M.is_empty()) - { - out.reset(); - iA.reset(); - iB.reset(); - return; - } - - uvec A_uniq_indx; - uvec B_uniq_indx; - - Mat A_uniq; - Mat B_uniq; - - if(calc_indx) - { - A_uniq_indx = find_unique(UA.M); - B_uniq_indx = find_unique(UB.M); - - A_uniq = UA.M.elem(A_uniq_indx); - B_uniq = UB.M.elem(B_uniq_indx); - } - else - { - A_uniq = unique(UA.M); - B_uniq = unique(UB.M); - } - - const uword C_n_elem = A_uniq.n_elem + B_uniq.n_elem; - - Col C(C_n_elem, arma_nozeros_indicator()); - - arrayops::copy(C.memptr(), A_uniq.memptr(), A_uniq.n_elem); - arrayops::copy(C.memptr() + A_uniq.n_elem, B_uniq.memptr(), B_uniq.n_elem); - - uvec C_sorted_indx; - Col C_sorted; - - if(calc_indx) - { - C_sorted_indx = stable_sort_index(C); - C_sorted = C.elem(C_sorted_indx); - } - else - { - C_sorted = sort(C); - } - - const eT* C_sorted_mem = C_sorted.memptr(); - - uvec jj(C_n_elem, arma_nozeros_indicator()); // worst case length - - uword* jj_mem = jj.memptr(); - uword jj_count = 0; - - for(uword i=0; i < (C_n_elem-1); ++i) - { - if( C_sorted_mem[i] == C_sorted_mem[i+1] ) - { - jj_mem[jj_count] = i; - ++jj_count; - } - } - - if(jj_count == 0) - { - out.reset(); - iA.reset(); - iB.reset(); - return; - } - - const uvec ii(jj.memptr(), jj_count, false); - - if(UA.M.is_rowvec() && UB.M.is_rowvec()) - { - out.set_size(1, ii.n_elem); - - Mat out_alias(out.memptr(), ii.n_elem, 1, false, true); - - // NOTE: this relies on .elem() not changing the size of the output and not reallocating memory for the output - out_alias = C_sorted.elem(ii); - } - else - { - out = C_sorted.elem(ii); - } - - if(calc_indx) - { - iA = A_uniq_indx.elem(C_sorted_indx.elem(ii ) ); - iB = B_uniq_indx.elem(C_sorted_indx.elem(ii+1) - A_uniq.n_elem); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_join_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_join_bones.hpp deleted file mode 100644 index b84116a01..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_join_bones.hpp +++ /dev/null @@ -1,90 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup glue_join -//! @{ - - - -class glue_join_cols - { - public: - - template - struct traits - { - static constexpr bool is_row = false; - static constexpr bool is_col = (T1::is_col && T2::is_col); - static constexpr bool is_xvec = false; - }; - - template - inline static void apply(Mat& out, const Glue& X); - - template - inline static void apply_noalias(Mat& out, const Proxy& A, const Proxy& B); - - template - inline static void apply(Mat& out, const Base& A, const Base& B, const Base& C); - - template - inline static void apply(Mat& out, const Base& A, const Base& B, const Base& C, const Base& D); - }; - - - -class glue_join_rows - { - public: - - template - struct traits - { - static constexpr bool is_row = (T1::is_row && T2::is_row); - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - }; - - template - inline static void apply(Mat& out, const Glue& X); - - template - inline static void apply_noalias(Mat& out, const Proxy& A, const Proxy& B); - - template - inline static void apply(Mat& out, const Base& A, const Base& B, const Base& C); - - template - inline static void apply(Mat& out, const Base& A, const Base& B, const Base& C, const Base& D); - }; - - - -class glue_join_slices - { - public: - - template - inline static void apply(Cube& out, const GlueCube& X); - }; - - - -//! @} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_join_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_join_meat.hpp deleted file mode 100644 index ede0be90b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_join_meat.hpp +++ /dev/null @@ -1,379 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_join -//! @{ - - - -template -inline -void -glue_join_cols::apply_noalias(Mat& out, const Proxy& A, const Proxy& B) - { - arma_debug_sigprint(); - - const uword A_n_rows = A.get_n_rows(); - const uword A_n_cols = A.get_n_cols(); - - const uword B_n_rows = B.get_n_rows(); - const uword B_n_cols = B.get_n_cols(); - - arma_conform_check - ( - ( (A_n_cols != B_n_cols) && ( (A_n_rows > 0) || (A_n_cols > 0) ) && ( (B_n_rows > 0) || (B_n_cols > 0) ) ), - "join_cols() / join_vert(): number of columns must be the same" - ); - - out.set_size( A_n_rows + B_n_rows, (std::max)(A_n_cols, B_n_cols) ); - - if( out.n_elem > 0 ) - { - if(A.get_n_elem() > 0) - { - out.submat(0, 0, A_n_rows-1, out.n_cols-1) = A.Q; - } - - if(B.get_n_elem() > 0) - { - out.submat(A_n_rows, 0, out.n_rows-1, out.n_cols-1) = B.Q; - } - } - } - - - - -template -inline -void -glue_join_cols::apply(Mat& out, const Glue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const Proxy A(X.A); - const Proxy B(X.B); - - if( (A.is_alias(out) == false) && (B.is_alias(out) == false) ) - { - glue_join_cols::apply_noalias(out, A, B); - } - else - { - Mat tmp; - - glue_join_cols::apply_noalias(tmp, A, B); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -glue_join_cols::apply(Mat& out, const Base& A_expr, const Base& B_expr, const Base& C_expr) - { - arma_debug_sigprint(); - - const quasi_unwrap UA(A_expr.get_ref()); - const quasi_unwrap UB(B_expr.get_ref()); - const quasi_unwrap UC(C_expr.get_ref()); - - const Mat& A = UA.M; - const Mat& B = UB.M; - const Mat& C = UC.M; - - const uword out_n_rows = A.n_rows + B.n_rows + C.n_rows; - const uword out_n_cols = (std::max)((std::max)(A.n_cols, B.n_cols), C.n_cols); - - arma_conform_check( ((A.n_cols != out_n_cols) && ((A.n_rows > 0) || (A.n_cols > 0))), "join_cols() / join_vert(): number of columns must be the same" ); - arma_conform_check( ((B.n_cols != out_n_cols) && ((B.n_rows > 0) || (B.n_cols > 0))), "join_cols() / join_vert(): number of columns must be the same" ); - arma_conform_check( ((C.n_cols != out_n_cols) && ((C.n_rows > 0) || (C.n_cols > 0))), "join_cols() / join_vert(): number of columns must be the same" ); - - out.set_size(out_n_rows, out_n_cols); - - if(out.n_elem == 0) { return; } - - uword row_start = 0; - uword row_end_p1 = 0; - - if(A.n_elem > 0) { row_end_p1 += A.n_rows; out.rows(row_start, row_end_p1 - 1) = A; } - - row_start = row_end_p1; - - if(B.n_elem > 0) { row_end_p1 += B.n_rows; out.rows(row_start, row_end_p1 - 1) = B; } - - row_start = row_end_p1; - - if(C.n_elem > 0) { row_end_p1 += C.n_rows; out.rows(row_start, row_end_p1 - 1) = C; } - } - - - -template -inline -void -glue_join_cols::apply(Mat& out, const Base& A_expr, const Base& B_expr, const Base& C_expr, const Base& D_expr) - { - arma_debug_sigprint(); - - const quasi_unwrap UA(A_expr.get_ref()); - const quasi_unwrap UB(B_expr.get_ref()); - const quasi_unwrap UC(C_expr.get_ref()); - const quasi_unwrap UD(D_expr.get_ref()); - - const Mat& A = UA.M; - const Mat& B = UB.M; - const Mat& C = UC.M; - const Mat& D = UD.M; - - const uword out_n_rows = A.n_rows + B.n_rows + C.n_rows + D.n_rows; - const uword out_n_cols = (std::max)(((std::max)((std::max)(A.n_cols, B.n_cols), C.n_cols)), D.n_cols); - - arma_conform_check( ((A.n_cols != out_n_cols) && ((A.n_rows > 0) || (A.n_cols > 0))), "join_cols() / join_vert(): number of columns must be the same" ); - arma_conform_check( ((B.n_cols != out_n_cols) && ((B.n_rows > 0) || (B.n_cols > 0))), "join_cols() / join_vert(): number of columns must be the same" ); - arma_conform_check( ((C.n_cols != out_n_cols) && ((C.n_rows > 0) || (C.n_cols > 0))), "join_cols() / join_vert(): number of columns must be the same" ); - arma_conform_check( ((D.n_cols != out_n_cols) && ((D.n_rows > 0) || (D.n_cols > 0))), "join_cols() / join_vert(): number of columns must be the same" ); - - out.set_size(out_n_rows, out_n_cols); - - if(out.n_elem == 0) { return; } - - uword row_start = 0; - uword row_end_p1 = 0; - - if(A.n_elem > 0) { row_end_p1 += A.n_rows; out.rows(row_start, row_end_p1 - 1) = A; } - - row_start = row_end_p1; - - if(B.n_elem > 0) { row_end_p1 += B.n_rows; out.rows(row_start, row_end_p1 - 1) = B; } - - row_start = row_end_p1; - - if(C.n_elem > 0) { row_end_p1 += C.n_rows; out.rows(row_start, row_end_p1 - 1) = C; } - - row_start = row_end_p1; - - if(D.n_elem > 0) { row_end_p1 += D.n_rows; out.rows(row_start, row_end_p1 - 1) = D; } - } - - - -template -inline -void -glue_join_rows::apply_noalias(Mat& out, const Proxy& A, const Proxy& B) - { - arma_debug_sigprint(); - - const uword A_n_rows = A.get_n_rows(); - const uword A_n_cols = A.get_n_cols(); - - const uword B_n_rows = B.get_n_rows(); - const uword B_n_cols = B.get_n_cols(); - - arma_conform_check - ( - ( (A_n_rows != B_n_rows) && ( (A_n_rows > 0) || (A_n_cols > 0) ) && ( (B_n_rows > 0) || (B_n_cols > 0) ) ), - "join_rows() / join_horiz(): number of rows must be the same" - ); - - out.set_size( (std::max)(A_n_rows, B_n_rows), A_n_cols + B_n_cols ); - - if( out.n_elem > 0 ) - { - if(A.get_n_elem() > 0) - { - out.submat(0, 0, out.n_rows-1, A_n_cols-1) = A.Q; - } - - if(B.get_n_elem() > 0) - { - out.submat(0, A_n_cols, out.n_rows-1, out.n_cols-1) = B.Q; - } - } - } - - - - -template -inline -void -glue_join_rows::apply(Mat& out, const Glue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const Proxy A(X.A); - const Proxy B(X.B); - - if( (A.is_alias(out) == false) && (B.is_alias(out) == false) ) - { - glue_join_rows::apply_noalias(out, A, B); - } - else - { - Mat tmp; - - glue_join_rows::apply_noalias(tmp, A, B); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -glue_join_rows::apply(Mat& out, const Base& A_expr, const Base& B_expr, const Base& C_expr) - { - arma_debug_sigprint(); - - const quasi_unwrap UA(A_expr.get_ref()); - const quasi_unwrap UB(B_expr.get_ref()); - const quasi_unwrap UC(C_expr.get_ref()); - - const Mat& A = UA.M; - const Mat& B = UB.M; - const Mat& C = UC.M; - - const uword out_n_rows = (std::max)((std::max)(A.n_rows, B.n_rows), C.n_rows); - const uword out_n_cols = A.n_cols + B.n_cols + C.n_cols; - - arma_conform_check( ((A.n_rows != out_n_rows) && ((A.n_rows > 0) || (A.n_cols > 0))), "join_rows() / join_horiz(): number of rows must be the same" ); - arma_conform_check( ((B.n_rows != out_n_rows) && ((B.n_rows > 0) || (B.n_cols > 0))), "join_rows() / join_horiz(): number of rows must be the same" ); - arma_conform_check( ((C.n_rows != out_n_rows) && ((C.n_rows > 0) || (C.n_cols > 0))), "join_rows() / join_horiz(): number of rows must be the same" ); - - out.set_size(out_n_rows, out_n_cols); - - if(out.n_elem == 0) { return; } - - uword col_start = 0; - uword col_end_p1 = 0; - - if(A.n_elem > 0) { col_end_p1 += A.n_cols; out.cols(col_start, col_end_p1 - 1) = A; } - - col_start = col_end_p1; - - if(B.n_elem > 0) { col_end_p1 += B.n_cols; out.cols(col_start, col_end_p1 - 1) = B; } - - col_start = col_end_p1; - - if(C.n_elem > 0) { col_end_p1 += C.n_cols; out.cols(col_start, col_end_p1 - 1) = C; } - } - - - -template -inline -void -glue_join_rows::apply(Mat& out, const Base& A_expr, const Base& B_expr, const Base& C_expr, const Base& D_expr) - { - arma_debug_sigprint(); - - const quasi_unwrap UA(A_expr.get_ref()); - const quasi_unwrap UB(B_expr.get_ref()); - const quasi_unwrap UC(C_expr.get_ref()); - const quasi_unwrap UD(D_expr.get_ref()); - - const Mat& A = UA.M; - const Mat& B = UB.M; - const Mat& C = UC.M; - const Mat& D = UD.M; - - const uword out_n_rows = (std::max)(((std::max)((std::max)(A.n_rows, B.n_rows), C.n_rows)), D.n_rows); - const uword out_n_cols = A.n_cols + B.n_cols + C.n_cols + D.n_cols; - - arma_conform_check( ((A.n_rows != out_n_rows) && ((A.n_rows > 0) || (A.n_cols > 0))), "join_rows() / join_horiz(): number of rows must be the same" ); - arma_conform_check( ((B.n_rows != out_n_rows) && ((B.n_rows > 0) || (B.n_cols > 0))), "join_rows() / join_horiz(): number of rows must be the same" ); - arma_conform_check( ((C.n_rows != out_n_rows) && ((C.n_rows > 0) || (C.n_cols > 0))), "join_rows() / join_horiz(): number of rows must be the same" ); - arma_conform_check( ((D.n_rows != out_n_rows) && ((D.n_rows > 0) || (D.n_cols > 0))), "join_rows() / join_horiz(): number of rows must be the same" ); - - out.set_size(out_n_rows, out_n_cols); - - if(out.n_elem == 0) { return; } - - uword col_start = 0; - uword col_end_p1 = 0; - - if(A.n_elem > 0) { col_end_p1 += A.n_cols; out.cols(col_start, col_end_p1 - 1) = A; } - - col_start = col_end_p1; - - if(B.n_elem > 0) { col_end_p1 += B.n_cols; out.cols(col_start, col_end_p1 - 1) = B; } - - col_start = col_end_p1; - - if(C.n_elem > 0) { col_end_p1 += C.n_cols; out.cols(col_start, col_end_p1 - 1) = C; } - - col_start = col_end_p1; - - if(D.n_elem > 0) { col_end_p1 += D.n_cols; out.cols(col_start, col_end_p1 - 1) = D; } - } - - - -template -inline -void -glue_join_slices::apply(Cube& out, const GlueCube& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_cube A_tmp(X.A); - const unwrap_cube B_tmp(X.B); - - const Cube& A = A_tmp.M; - const Cube& B = B_tmp.M; - - if(A.n_elem == 0) { out = B; return; } - if(B.n_elem == 0) { out = A; return; } - - arma_conform_check( ( (A.n_rows != B.n_rows) || (A.n_cols != B.n_cols) ), "join_slices(): size of slices must be the same" ); - - if( (&out != &A) && (&out != &B) ) - { - out.set_size(A.n_rows, A.n_cols, A.n_slices + B.n_slices); - - out.slices(0, A.n_slices-1 ) = A; - out.slices(A.n_slices, out.n_slices-1) = B; - } - else // we have aliasing - { - Cube C(A.n_rows, A.n_cols, A.n_slices + B.n_slices, arma_nozeros_indicator()); - - C.slices(0, A.n_slices-1) = A; - C.slices(A.n_slices, C.n_slices-1) = B; - - out.steal_mem(C); - } - - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_kron_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_kron_bones.hpp deleted file mode 100644 index 84c93476a..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_kron_bones.hpp +++ /dev/null @@ -1,46 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup glue_kron -//! @{ - - - -class glue_kron - { - public: - - template - struct traits - { - static constexpr bool is_row = (T1::is_row && T2::is_row); - static constexpr bool is_col = (T1::is_col && T2::is_col); - static constexpr bool is_xvec = false; - }; - - template inline static void direct_kron(Mat& out, const Mat& A, const Mat& B); - template inline static void direct_kron(Mat< std::complex >& out, const Mat< std::complex >& A, const Mat& B); - template inline static void direct_kron(Mat< std::complex >& out, const Mat& A, const Mat< std::complex >& B); - - template inline static void apply(Mat& out, const Glue& X); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_kron_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_kron_meat.hpp deleted file mode 100644 index 8516e33a3..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_kron_meat.hpp +++ /dev/null @@ -1,147 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_kron -//! @{ - - - -//! \brief -//! both input matrices have the same element type -template -inline -void -glue_kron::direct_kron(Mat& out, const Mat& A, const Mat& B) - { - arma_debug_sigprint(); - - const uword A_rows = A.n_rows; - const uword A_cols = A.n_cols; - const uword B_rows = B.n_rows; - const uword B_cols = B.n_cols; - - out.set_size(A_rows*B_rows, A_cols*B_cols); - - if(out.is_empty()) { return; } - - for(uword j = 0; j < A_cols; j++) - { - for(uword i = 0; i < A_rows; i++) - { - out.submat(i*B_rows, j*B_cols, (i+1)*B_rows-1, (j+1)*B_cols-1) = A.at(i,j) * B; - } - } - } - - - -//! \brief -//! different types of input matrices -//! A -> complex, B -> basic element type -template -inline -void -glue_kron::direct_kron(Mat< std::complex >& out, const Mat< std::complex >& A, const Mat& B) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const uword A_rows = A.n_rows; - const uword A_cols = A.n_cols; - const uword B_rows = B.n_rows; - const uword B_cols = B.n_cols; - - out.set_size(A_rows*B_rows, A_cols*B_cols); - - if(out.is_empty()) { return; } - - Mat tmp_B = conv_to< Mat >::from(B); - - for(uword j = 0; j < A_cols; j++) - { - for(uword i = 0; i < A_rows; i++) - { - out.submat(i*B_rows, j*B_cols, (i+1)*B_rows-1, (j+1)*B_cols-1) = A.at(i,j) * tmp_B; - } - } - } - - - -//! \brief -//! different types of input matrices -//! A -> basic element type, B -> complex -template -inline -void -glue_kron::direct_kron(Mat< std::complex >& out, const Mat& A, const Mat< std::complex >& B) - { - arma_debug_sigprint(); - - const uword A_rows = A.n_rows; - const uword A_cols = A.n_cols; - const uword B_rows = B.n_rows; - const uword B_cols = B.n_cols; - - out.set_size(A_rows*B_rows, A_cols*B_cols); - - if(out.is_empty()) { return; } - - for(uword j = 0; j < A_cols; j++) - { - for(uword i = 0; i < A_rows; i++) - { - out.submat(i*B_rows, j*B_cols, (i+1)*B_rows-1, (j+1)*B_cols-1) = A.at(i,j) * B; - } - } - } - - - -//! \brief -//! apply Kronecker product for two objects with same element type -template -inline -void -glue_kron::apply(Mat& out, const Glue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap UA(X.A); - const quasi_unwrap UB(X.B); - - if(UA.is_alias(out) || UB.is_alias(out)) - { - Mat tmp; - - glue_kron::direct_kron(tmp, UA.M, UB.M); - - out.steal_mem(tmp); - } - else - { - glue_kron::direct_kron(out, UA.M, UB.M); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_max_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_max_bones.hpp deleted file mode 100644 index 149988e90..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_max_bones.hpp +++ /dev/null @@ -1,47 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup glue_max -//! @{ - - - -class glue_max - : public traits_glue_or - { - public: - - // dense matrices - - template inline static void apply(Mat& out, const Glue& X); - - template inline static void apply(Mat& out, const Proxy& PA, const Proxy& PB); - - - // cubes - - template inline static void apply(Cube& out, const GlueCube& X); - - template inline static void apply(Cube& out, const ProxyCube& PA, const ProxyCube& PB); - }; - - - -//! @} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_max_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_max_meat.hpp deleted file mode 100644 index fe8d38858..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_max_meat.hpp +++ /dev/null @@ -1,183 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup glue_max -//! @{ - - - -template -inline -void -glue_max::apply(Mat& out, const Glue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const Proxy PA(X.A); - const Proxy PB(X.B); - - if( (PA.is_alias(out) && PA.has_subview) || (PB.is_alias(out) && PB.has_subview) ) - { - Mat tmp; - - glue_max::apply(tmp, PA, PB); - - out.steal_mem(tmp); - } - else - { - glue_max::apply(out, PA, PB); - } - } - - - -template -inline -void -glue_max::apply(Mat& out, const Proxy& PA, const Proxy& PB) - { - arma_debug_sigprint(); - - const uword n_rows = PA.get_n_rows(); - const uword n_cols = PA.get_n_cols(); - - arma_conform_assert_same_size(n_rows, n_cols, PB.get_n_rows(), PB.get_n_cols(), "element-wise max()"); - - const arma_gt_comparator comparator; - - out.set_size(n_rows, n_cols); - - eT* out_mem = out.memptr(); - - if( (Proxy::use_at == false) && (Proxy::use_at == false) ) - { - typename Proxy::ea_type A = PA.get_ea(); - typename Proxy::ea_type B = PB.get_ea(); - - const uword N = PA.get_n_elem(); - - for(uword i=0; i -inline -void -glue_max::apply(Cube& out, const GlueCube& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const ProxyCube PA(X.A); - const ProxyCube PB(X.B); - - if( (PA.is_alias(out) && PA.has_subview) || (PB.is_alias(out) && PB.has_subview) ) - { - Cube tmp; - - glue_max::apply(tmp, PA, PB); - - out.steal_mem(tmp); - } - else - { - glue_max::apply(out, PA, PB); - } - } - - - -template -inline -void -glue_max::apply(Cube& out, const ProxyCube& PA, const ProxyCube& PB) - { - arma_debug_sigprint(); - - const uword n_rows = PA.get_n_rows(); - const uword n_cols = PA.get_n_cols(); - const uword n_slices = PA.get_n_slices(); - - arma_conform_assert_same_size(n_rows, n_cols, n_slices, PB.get_n_rows(), PB.get_n_cols(), PB.get_n_slices(), "element-wise max()"); - - const arma_gt_comparator comparator; - - out.set_size(n_rows, n_cols, n_slices); - - eT* out_mem = out.memptr(); - - if( (ProxyCube::use_at == false) && (ProxyCube::use_at == false) ) - { - typename ProxyCube::ea_type A = PA.get_ea(); - typename ProxyCube::ea_type B = PB.get_ea(); - - const uword N = PA.get_n_elem(); - - for(uword i=0; i inline static void apply(Mat& out, const Glue& X); - - template inline static void apply(Mat& out, const Proxy& PA, const Proxy& PB); - - - // cubes - - template inline static void apply(Cube& out, const GlueCube& X); - - template inline static void apply(Cube& out, const ProxyCube& PA, const ProxyCube& PB); - }; - - - -//! @} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_min_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_min_meat.hpp deleted file mode 100644 index d6bce26f4..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_min_meat.hpp +++ /dev/null @@ -1,183 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup glue_min -//! @{ - - - -template -inline -void -glue_min::apply(Mat& out, const Glue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const Proxy PA(X.A); - const Proxy PB(X.B); - - if( (PA.is_alias(out) && PA.has_subview) || (PB.is_alias(out) && PB.has_subview) ) - { - Mat tmp; - - glue_min::apply(tmp, PA, PB); - - out.steal_mem(tmp); - } - else - { - glue_min::apply(out, PA, PB); - } - } - - - -template -inline -void -glue_min::apply(Mat& out, const Proxy& PA, const Proxy& PB) - { - arma_debug_sigprint(); - - const uword n_rows = PA.get_n_rows(); - const uword n_cols = PA.get_n_cols(); - - arma_conform_assert_same_size(n_rows, n_cols, PB.get_n_rows(), PB.get_n_cols(), "element-wise min()"); - - const arma_lt_comparator comparator; - - out.set_size(n_rows, n_cols); - - eT* out_mem = out.memptr(); - - if( (Proxy::use_at == false) && (Proxy::use_at == false) ) - { - typename Proxy::ea_type A = PA.get_ea(); - typename Proxy::ea_type B = PB.get_ea(); - - const uword N = PA.get_n_elem(); - - for(uword i=0; i -inline -void -glue_min::apply(Cube& out, const GlueCube& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const ProxyCube PA(X.A); - const ProxyCube PB(X.B); - - if( (PA.is_alias(out) && PA.has_subview) || (PB.is_alias(out) && PB.has_subview) ) - { - Cube tmp; - - glue_min::apply(tmp, PA, PB); - - out.steal_mem(tmp); - } - else - { - glue_min::apply(out, PA, PB); - } - } - - - -template -inline -void -glue_min::apply(Cube& out, const ProxyCube& PA, const ProxyCube& PB) - { - arma_debug_sigprint(); - - const uword n_rows = PA.get_n_rows(); - const uword n_cols = PA.get_n_cols(); - const uword n_slices = PA.get_n_slices(); - - arma_conform_assert_same_size(n_rows, n_cols, n_slices, PB.get_n_rows(), PB.get_n_cols(), PB.get_n_slices(), "element-wise min()"); - - const arma_lt_comparator comparator; - - out.set_size(n_rows, n_cols, n_slices); - - eT* out_mem = out.memptr(); - - if( (ProxyCube::use_at == false) && (ProxyCube::use_at == false) ) - { - typename ProxyCube::ea_type A = PA.get_ea(); - typename ProxyCube::ea_type B = PB.get_ea(); - - const uword N = PA.get_n_elem(); - - for(uword i=0; i - struct traits - { - static constexpr bool is_row = T1::is_row; - static constexpr bool is_col = T2::is_col; - static constexpr bool is_xvec = false; - }; - - template - inline static void apply(Mat::eT>& out, const mtGlue::eT, T1, T2, glue_mixed_times>& X); - }; - - - -class glue_mixed_plus - : public traits_glue_or - { - public: - - template - inline static void apply(Mat::eT>& out, const mtGlue::eT, T1, T2, glue_mixed_plus>& X); - - template - inline static void apply(Cube::eT>& out, const mtGlueCube::eT, T1, T2, glue_mixed_plus>& X); - }; - - - -class glue_mixed_minus - : public traits_glue_or - { - public: - - template - inline static void apply(Mat::eT>& out, const mtGlue::eT, T1, T2, glue_mixed_minus>& X); - - template - inline static void apply(Cube::eT>& out, const mtGlueCube::eT, T1, T2, glue_mixed_minus>& X); - }; - - - -class glue_mixed_div - : public traits_glue_or - { - public: - - template - inline static void apply(Mat::eT>& out, const mtGlue::eT, T1, T2, glue_mixed_div>& X); - - template - inline static void apply(Cube::eT>& out, const mtGlueCube::eT, T1, T2, glue_mixed_div>& X); - }; - - - -class glue_mixed_schur - : public traits_glue_or - { - public: - - template - inline static void apply(Mat::eT>& out, const mtGlue::eT, T1, T2, glue_mixed_schur>& X); - - template - inline static void apply(Cube::eT>& out, const mtGlueCube::eT, T1, T2, glue_mixed_schur>& X); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_mixed_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_mixed_meat.hpp deleted file mode 100644 index d7c28df32..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_mixed_meat.hpp +++ /dev/null @@ -1,560 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_mixed -//! @{ - - - -//! matrix multiplication with different element types -template -inline -void -glue_mixed_times::apply(Mat::eT>& out, const mtGlue::eT, T1, T2, glue_mixed_times>& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type in_eT1; - typedef typename T2::elem_type in_eT2; - - typedef typename eT_promoter::eT out_eT; - - const partial_unwrap tmp1(X.A); - const partial_unwrap tmp2(X.B); - - const typename partial_unwrap::stored_type& A = tmp1.M; - const typename partial_unwrap::stored_type& B = tmp2.M; - - constexpr bool use_alpha = partial_unwrap::do_times || partial_unwrap::do_times; - const out_eT alpha = use_alpha ? (upgrade_val::apply(tmp1.get_val()) * upgrade_val::apply(tmp2.get_val())) : out_eT(0); - - const bool do_trans_A = partial_unwrap::do_trans; - const bool do_trans_B = partial_unwrap::do_trans; - - arma_conform_assert_trans_mul_size(A.n_rows, A.n_cols, B.n_rows, B.n_cols, "matrix multiplication"); - - const uword out_n_rows = (do_trans_A == false) ? A.n_rows : A.n_cols; - const uword out_n_cols = (do_trans_B == false) ? B.n_cols : B.n_rows; - - const bool alias = tmp1.is_alias(out) || tmp2.is_alias(out); - - if(alias == false) - { - out.set_size(out_n_rows, out_n_cols); - - gemm_mixed::apply(out, A, B, alpha); - } - else - { - Mat tmp(out_n_rows, out_n_cols, arma_nozeros_indicator()); - - gemm_mixed::apply(tmp, A, B, alpha); - - out.steal_mem(tmp); - } - } - - - -//! matrix addition with different element types -template -inline -void -glue_mixed_plus::apply(Mat::eT>& out, const mtGlue::eT, T1, T2, glue_mixed_plus>& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - const Proxy A(X.A); - const Proxy B(X.B); - - arma_conform_assert_same_size(A, B, "addition"); - - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - - out.set_size(n_rows, n_cols); - - out_eT* out_mem = out.memptr(); - const uword n_elem = out.n_elem; - - constexpr bool use_at = (Proxy::use_at || Proxy::use_at); - - if(use_at == false) - { - typename Proxy::ea_type AA = A.get_ea(); - typename Proxy::ea_type BB = B.get_ea(); - - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - for(uword i=0; i::apply(AA[i]) + upgrade_val::apply(BB[i]); - } - } - else - { - for(uword i=0; i::apply(AA[i]) + upgrade_val::apply(BB[i]); - } - } - } - else - { - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - (*out_mem) = upgrade_val::apply(A.at(row,col)) + upgrade_val::apply(B.at(row,col)); - out_mem++; - } - } - } - - - -//! matrix subtraction with different element types -template -inline -void -glue_mixed_minus::apply(Mat::eT>& out, const mtGlue::eT, T1, T2, glue_mixed_minus>& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - const Proxy A(X.A); - const Proxy B(X.B); - - arma_conform_assert_same_size(A, B, "subtraction"); - - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - - out.set_size(n_rows, n_cols); - - out_eT* out_mem = out.memptr(); - const uword n_elem = out.n_elem; - - constexpr bool use_at = (Proxy::use_at || Proxy::use_at); - - if(use_at == false) - { - typename Proxy::ea_type AA = A.get_ea(); - typename Proxy::ea_type BB = B.get_ea(); - - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - for(uword i=0; i::apply(AA[i]) - upgrade_val::apply(BB[i]); - } - } - else - { - for(uword i=0; i::apply(AA[i]) - upgrade_val::apply(BB[i]); - } - } - } - else - { - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - (*out_mem) = upgrade_val::apply(A.at(row,col)) - upgrade_val::apply(B.at(row,col)); - out_mem++; - } - } - } - - - -//! element-wise matrix division with different element types -template -inline -void -glue_mixed_div::apply(Mat::eT>& out, const mtGlue::eT, T1, T2, glue_mixed_div>& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - const Proxy A(X.A); - const Proxy B(X.B); - - arma_conform_assert_same_size(A, B, "element-wise division"); - - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - - out.set_size(n_rows, n_cols); - - out_eT* out_mem = out.memptr(); - const uword n_elem = out.n_elem; - - constexpr bool use_at = (Proxy::use_at || Proxy::use_at); - - if(use_at == false) - { - typename Proxy::ea_type AA = A.get_ea(); - typename Proxy::ea_type BB = B.get_ea(); - - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - for(uword i=0; i::apply(AA[i]) / upgrade_val::apply(BB[i]); - } - } - else - { - for(uword i=0; i::apply(AA[i]) / upgrade_val::apply(BB[i]); - } - } - } - else - { - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - (*out_mem) = upgrade_val::apply(A.at(row,col)) / upgrade_val::apply(B.at(row,col)); - out_mem++; - } - } - } - - - -//! element-wise matrix multiplication with different element types -template -inline -void -glue_mixed_schur::apply(Mat::eT>& out, const mtGlue::eT, T1, T2, glue_mixed_schur>& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - const Proxy A(X.A); - const Proxy B(X.B); - - arma_conform_assert_same_size(A, B, "element-wise multiplication"); - - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - - out.set_size(n_rows, n_cols); - - out_eT* out_mem = out.memptr(); - const uword n_elem = out.n_elem; - - constexpr bool use_at = (Proxy::use_at || Proxy::use_at); - - if(use_at == false) - { - typename Proxy::ea_type AA = A.get_ea(); - typename Proxy::ea_type BB = B.get_ea(); - - if(memory::is_aligned(out_mem)) - { - memory::mark_as_aligned(out_mem); - - for(uword i=0; i::apply(AA[i]) * upgrade_val::apply(BB[i]); - } - } - else - { - for(uword i=0; i::apply(AA[i]) * upgrade_val::apply(BB[i]); - } - } - } - else - { - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - (*out_mem) = upgrade_val::apply(A.at(row,col)) * upgrade_val::apply(B.at(row,col)); - out_mem++; - } - } - } - - - -// -// -// - - - -//! cube addition with different element types -template -inline -void -glue_mixed_plus::apply(Cube::eT>& out, const mtGlueCube::eT, T1, T2, glue_mixed_plus>& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - const ProxyCube A(X.A); - const ProxyCube B(X.B); - - arma_conform_assert_same_size(A, B, "addition"); - - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - const uword n_slices = A.get_n_slices(); - - out.set_size(n_rows, n_cols, n_slices); - - out_eT* out_mem = out.memptr(); - const uword n_elem = out.n_elem; - - constexpr bool use_at = (ProxyCube::use_at || ProxyCube::use_at); - - if(use_at == false) - { - typename ProxyCube::ea_type AA = A.get_ea(); - typename ProxyCube::ea_type BB = B.get_ea(); - - for(uword i=0; i::apply(AA[i]) + upgrade_val::apply(BB[i]); - } - } - else - { - for(uword slice = 0; slice < n_slices; ++slice) - for(uword col = 0; col < n_cols; ++col ) - for(uword row = 0; row < n_rows; ++row ) - { - (*out_mem) = upgrade_val::apply(A.at(row,col,slice)) + upgrade_val::apply(B.at(row,col,slice)); - out_mem++; - } - } - } - - - -//! cube subtraction with different element types -template -inline -void -glue_mixed_minus::apply(Cube::eT>& out, const mtGlueCube::eT, T1, T2, glue_mixed_minus>& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - const ProxyCube A(X.A); - const ProxyCube B(X.B); - - arma_conform_assert_same_size(A, B, "subtraction"); - - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - const uword n_slices = A.get_n_slices(); - - out.set_size(n_rows, n_cols, n_slices); - - out_eT* out_mem = out.memptr(); - const uword n_elem = out.n_elem; - - constexpr bool use_at = (ProxyCube::use_at || ProxyCube::use_at); - - if(use_at == false) - { - typename ProxyCube::ea_type AA = A.get_ea(); - typename ProxyCube::ea_type BB = B.get_ea(); - - for(uword i=0; i::apply(AA[i]) - upgrade_val::apply(BB[i]); - } - } - else - { - for(uword slice = 0; slice < n_slices; ++slice) - for(uword col = 0; col < n_cols; ++col ) - for(uword row = 0; row < n_rows; ++row ) - { - (*out_mem) = upgrade_val::apply(A.at(row,col,slice)) - upgrade_val::apply(B.at(row,col,slice)); - out_mem++; - } - } - } - - - -//! element-wise cube division with different element types -template -inline -void -glue_mixed_div::apply(Cube::eT>& out, const mtGlueCube::eT, T1, T2, glue_mixed_div>& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - const ProxyCube A(X.A); - const ProxyCube B(X.B); - - arma_conform_assert_same_size(A, B, "element-wise division"); - - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - const uword n_slices = A.get_n_slices(); - - out.set_size(n_rows, n_cols, n_slices); - - out_eT* out_mem = out.memptr(); - const uword n_elem = out.n_elem; - - constexpr bool use_at = (ProxyCube::use_at || ProxyCube::use_at); - - if(use_at == false) - { - typename ProxyCube::ea_type AA = A.get_ea(); - typename ProxyCube::ea_type BB = B.get_ea(); - - for(uword i=0; i::apply(AA[i]) / upgrade_val::apply(BB[i]); - } - } - else - { - for(uword slice = 0; slice < n_slices; ++slice) - for(uword col = 0; col < n_cols; ++col ) - for(uword row = 0; row < n_rows; ++row ) - { - (*out_mem) = upgrade_val::apply(A.at(row,col,slice)) / upgrade_val::apply(B.at(row,col,slice)); - out_mem++; - } - } - } - - - -//! element-wise cube multiplication with different element types -template -inline -void -glue_mixed_schur::apply(Cube::eT>& out, const mtGlueCube::eT, T1, T2, glue_mixed_schur>& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - const ProxyCube A(X.A); - const ProxyCube B(X.B); - - arma_conform_assert_same_size(A, B, "element-wise multiplication"); - - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - const uword n_slices = A.get_n_slices(); - - out.set_size(n_rows, n_cols, n_slices); - - out_eT* out_mem = out.memptr(); - const uword n_elem = out.n_elem; - - constexpr bool use_at = (ProxyCube::use_at || ProxyCube::use_at); - - if(use_at == false) - { - typename ProxyCube::ea_type AA = A.get_ea(); - typename ProxyCube::ea_type BB = B.get_ea(); - - for(uword i=0; i::apply(AA[i]) * upgrade_val::apply(BB[i]); - } - } - else - { - for(uword slice = 0; slice < n_slices; ++slice) - for(uword col = 0; col < n_cols; ++col ) - for(uword row = 0; row < n_rows; ++row ) - { - (*out_mem) = upgrade_val::apply(A.at(row,col,slice)) * upgrade_val::apply(B.at(row,col,slice)); - out_mem++; - } - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_mvnrnd_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_mvnrnd_bones.hpp deleted file mode 100644 index ab1c437ae..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_mvnrnd_bones.hpp +++ /dev/null @@ -1,58 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_mvnrnd -//! @{ - - -class glue_mvnrnd_vec - { - public: - - template - struct traits - { - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - }; - - template - inline static void apply(Mat& out, const Glue& expr); - }; - - - -class glue_mvnrnd - : public traits_glue_default - { - public: - - template - inline static void apply(Mat& out, const Glue& expr); - - template - inline static bool apply_direct(Mat& out, const Base& M, const Base& C, const uword N); - - template - inline static bool apply_noalias(Mat& out, const Mat& M, const Mat& C, const uword N); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_mvnrnd_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_mvnrnd_meat.hpp deleted file mode 100644 index 4b61820bd..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_mvnrnd_meat.hpp +++ /dev/null @@ -1,175 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_mvnrnd -//! @{ - - -// implementation based on: -// James E. Gentle. -// Generation of Random Numbers. -// Computational Statistics, pp. 305-331, 2009. -// http://dx.doi.org/10.1007/978-0-387-98144-4_7 - - -template -inline -void -glue_mvnrnd_vec::apply(Mat& out, const Glue& expr) - { - arma_debug_sigprint(); - - const bool status = glue_mvnrnd::apply_direct(out, expr.A, expr.B, uword(1)); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("mvnrnd(): given covariance matrix is not symmetric positive semi-definite"); - } - } - - - -template -inline -void -glue_mvnrnd::apply(Mat& out, const Glue& expr) - { - arma_debug_sigprint(); - - const bool status = glue_mvnrnd::apply_direct(out, expr.A, expr.B, expr.aux_uword); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("mvnrnd(): given covariance matrix is not symmetric positive semi-definite"); - } - } - - - -template -inline -bool -glue_mvnrnd::apply_direct(Mat& out, const Base& M, const Base& C, const uword N) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap UM(M.get_ref()); - const quasi_unwrap UC(C.get_ref()); - - arma_conform_check( (UM.M.is_colvec() == false) && (UM.M.is_empty() == false), "mvnrnd(): given mean must be a column vector" ); - arma_conform_check( (UC.M.is_square() == false), "mvnrnd(): given covariance matrix must be square sized" ); - arma_conform_check( (UM.M.n_rows != UC.M.n_rows), "mvnrnd(): number of rows in given mean vector and covariance matrix must match" ); - - if( UM.M.is_empty() || UC.M.is_empty() ) - { - out.set_size(0,N); - return true; - } - - if((arma_config::check_conform) && (auxlib::rudimentary_sym_check(UC.M) == false)) - { - arma_warn(1, "mvnrnd(): given matrix is not symmetric"); - } - - bool status = false; - - if(UM.is_alias(out) || UC.is_alias(out)) - { - Mat tmp; - - status = glue_mvnrnd::apply_noalias(tmp, UM.M, UC.M, N); - - out.steal_mem(tmp); - } - else - { - status = glue_mvnrnd::apply_noalias(out, UM.M, UC.M, N); - } - - return status; - } - - - -template -inline -bool -glue_mvnrnd::apply_noalias(Mat& out, const Mat& M, const Mat& C, const uword N) - { - arma_debug_sigprint(); - - Mat D; - - const bool chol_status = op_chol::apply_direct(D, C, 1); // '1' means "lower triangular" - - if(chol_status == false) - { - // C is not symmetric positive definite, so find approximate square root of C - - Col eigval; // NOTE: eT is constrained to be real (ie. float or double) in fn_mvnrnd.hpp - Mat eigvec; - - const bool eig_status = eig_sym_helper(eigval, eigvec, C, 'd', "mvnrnd()"); - - if(eig_status == false) { return false; } - - eT* eigval_mem = eigval.memptr(); - const uword eigval_n_elem = eigval.n_elem; - - // since we're doing an approximation, tolerate tiny negative eigenvalues - - const eT tol = eT(-100) * Datum::eps * norm(C, "fro"); - - if(arma_isfinite(tol) == false) { return false; } - - for(uword i=0; i DD = eigvec * diagmat(sqrt(eigval)); - - D.steal_mem(DD); - } - - out = D * randn< Mat >(M.n_rows, N); - - if(N == 1) - { - out += M; - } - else - if(N > 1) - { - out.each_col() += M; - } - - return true; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_polyfit_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_polyfit_bones.hpp deleted file mode 100644 index 8e771dc9a..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_polyfit_bones.hpp +++ /dev/null @@ -1,47 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup glue_polyfit -//! @{ - - - -class glue_polyfit - { - public: - - template - struct traits - { - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - }; - - template inline static bool apply_noalias(Mat& out, const Col& X, const Col& Y, const uword N); - - template inline static bool apply_direct(Mat& out, const Base& X_expr, const Base& Y_expr, const uword N); - - template inline static void apply(Mat& out, const Glue& expr); - }; - - - -//! @} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_polyfit_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_polyfit_meat.hpp deleted file mode 100644 index a809685e6..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_polyfit_meat.hpp +++ /dev/null @@ -1,133 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_polyfit -//! @{ - - - -template -inline -bool -glue_polyfit::apply_noalias(Mat& out, const Col& X, const Col& Y, const uword N) - { - arma_debug_sigprint(); - - // create Vandermonde matrix - - Mat V(X.n_elem, N+1, arma_nozeros_indicator()); - - V.tail_cols(1).ones(); - - for(uword i=1; i <= N; ++i) - { - const uword j = N-i; - - Col V_col_j (V.colptr(j ), V.n_rows, false, false); - Col V_col_jp1(V.colptr(j+1), V.n_rows, false, false); - - V_col_j = V_col_jp1 % X; - } - - Mat Q; - Mat R; - - const bool status1 = auxlib::qr_econ(Q, R, V); - - if(status1 == false) { return false; } - - const bool status2 = auxlib::solve_trimat_fast(out, R, (Q.t() * Y), uword(0)); - - if(status2 == false) { return false; } - - return true; - } - - - -template -inline -bool -glue_polyfit::apply_direct(Mat& out, const Base& X_expr, const Base& Y_expr, const uword N) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap UX(X_expr.get_ref()); - const quasi_unwrap UY(Y_expr.get_ref()); - - const Mat& X = UX.M; - const Mat& Y = UY.M; - - arma_conform_check - ( - ( ((X.is_vec() == false) && (X.is_empty() == false)) || ((Y.is_vec() == false) && (Y.is_empty() == false)) ), - "polyfit(): given object must be a vector" - ); - - arma_conform_check( (X.n_elem != Y.n_elem), "polyfit(): given vectors must have the same number of elements" ); - - if(X.n_elem == 0) - { - out.reset(); - return true; - } - - arma_conform_check( (N >= X.n_elem), "polyfit(): N must be less than the number of elements in X" ); - - const Col X_as_colvec( const_cast(X.memptr()), X.n_elem, false, false); - const Col Y_as_colvec( const_cast(Y.memptr()), Y.n_elem, false, false); - - bool status = false; - - if(UX.is_alias(out) || UY.is_alias(out)) - { - Mat tmp; - status = glue_polyfit::apply_noalias(tmp, X_as_colvec, Y_as_colvec, N); - out.steal_mem(tmp); - } - else - { - status = glue_polyfit::apply_noalias(out, X_as_colvec, Y_as_colvec, N); - } - - return status; - } - - - -template -inline -void -glue_polyfit::apply(Mat& out, const Glue& expr) - { - arma_debug_sigprint(); - - const bool status = glue_polyfit::apply_direct(out, expr.A, expr.B, expr.aux_uword); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("polyfit(): failed"); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_polyval_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_polyval_bones.hpp deleted file mode 100644 index f937bd518..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_polyval_bones.hpp +++ /dev/null @@ -1,45 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup glue_polyval -//! @{ - - - -class glue_polyval - { - public: - - template - struct traits - { - static constexpr bool is_row = T2::is_row; - static constexpr bool is_col = T2::is_col; - static constexpr bool is_xvec = T2::is_xvec; - }; - - template inline static void apply_noalias(Mat& out, const Mat& P, const Mat& X); - - template inline static void apply(Mat& out, const Glue& expr); - }; - - - -//! @} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_polyval_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_polyval_meat.hpp deleted file mode 100644 index ed305526e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_polyval_meat.hpp +++ /dev/null @@ -1,83 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_polyval -//! @{ - - - -template -inline -void -glue_polyval::apply_noalias(Mat& out, const Mat& P, const Mat& X) - { - arma_debug_sigprint(); - - out.set_size(X.n_rows, X.n_cols); - - const eT* P_mem = P.memptr(); - const uword P_n_elem = P.n_elem; - - out.fill(P_mem[0]); - - for(uword i=1; i < P_n_elem; ++i) - { - out = out % X + P_mem[i]; - } - } - - - -template -inline -void -glue_polyval::apply(Mat& out, const Glue& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap UP(expr.A); - const quasi_unwrap UX(expr.B); - - const Mat& P = UP.M; - const Mat& X = UX.M; - - arma_conform_check( ((P.is_vec() == false) && (P.is_empty() == false)), "polyval(): argument P must be a vector" ); - - if(P.is_empty() || X.is_empty()) - { - out.zeros(X.n_rows, X.n_cols); - return; - } - - if(UP.is_alias(out) || UX.is_alias(out)) - { - Mat tmp; - glue_polyval::apply_noalias(tmp, P, X); - out.steal_mem(tmp); - } - else - { - glue_polyval::apply_noalias(out, P, X); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_powext_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_powext_bones.hpp deleted file mode 100644 index d5698c5ca..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_powext_bones.hpp +++ /dev/null @@ -1,70 +0,0 @@ - -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup glue_powext -//! @{ - - - -class glue_powext - : public traits_glue_or - { - public: - - template inline static void apply(Mat& out, const Glue& X); - - template inline static void apply(Mat& out, const Mat& A, const Mat& B); - - template inline static Mat apply(const subview_each1& X, const Base& Y); - - // - - template inline static void apply(Cube& out, const GlueCube& X); - - template inline static void apply(Cube& out, const Cube& A, const Cube& B); - - template inline static Cube apply(const subview_cube_each1& X, const Base& Y); - }; - - - -class glue_powext_cx - : public traits_glue_or - { - public: - - template inline static void apply(Mat& out, const mtGlue& X); - - template inline static void apply(Mat< std::complex >& out, const Mat< std::complex >& A, const Mat& B); - - template inline static Mat apply(const subview_each1& X, const Base& Y); - - // - - template inline static void apply(Cube& out, const mtGlueCube& X); - - template inline static void apply(Cube< std::complex >& out, const Cube< std::complex >& A, const Cube& B); - - template inline static Cube< std::complex > apply(const subview_cube_each1< std::complex >& X, const Base& Y); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_powext_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_powext_meat.hpp deleted file mode 100644 index 927ead6c0..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_powext_meat.hpp +++ /dev/null @@ -1,674 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup glue_powext -//! @{ - - -template -inline -void -glue_powext::apply(Mat& out, const Glue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap UA(X.A); - const quasi_unwrap UB(X.B); - - const Mat& A = UA.M; - const Mat& B = UB.M; - - arma_conform_assert_same_size(A, B, "element-wise pow()"); - - const bool UA_bad_alias = UA.is_alias(out) && (UA.has_subview); // allow inplace operation - const bool UB_bad_alias = UB.is_alias(out); - - if(UA_bad_alias || UB_bad_alias) - { - Mat tmp; - - glue_powext::apply(tmp, A, B); - - out.steal_mem(tmp); - } - else - { - glue_powext::apply(out, A, B); - } - } - - - -template -inline -void -glue_powext::apply(Mat& out, const Mat& A, const Mat& B) - { - arma_debug_sigprint(); - - out.set_size(A.n_rows, A.n_cols); - - const uword N = out.n_elem; - - eT* out_mem = out.memptr(); - const eT* A_mem = A.memptr(); - const eT* B_mem = B.memptr(); - - if( arma_config::openmp && mp_gate::eval(N) ) - { - #if defined(ARMA_USE_OPENMP) - { - const int n_threads = mp_thread_limit::get(); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword i=0; i -inline -Mat -glue_powext::apply - ( - const subview_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - typedef typename parent::elem_type eT; - - const parent& A = X.P; - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - Mat out(A_n_rows, A_n_cols, arma_nozeros_indicator()); - - const quasi_unwrap tmp(Y.get_ref()); - const Mat& B = tmp.M; - - X.check_size(B); - - const eT* B_mem = B.memptr(); - - if(mode == 0) // each column - { - if( arma_config::openmp && mp_gate::eval(A.n_elem) ) - { - #if defined(ARMA_USE_OPENMP) - { - const int n_threads = int( (std::min)(uword(mp_thread_limit::get()), A_n_cols) ); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword i=0; i < A_n_cols; ++i) - { - const eT* A_mem = A.colptr(i); - eT* out_mem = out.colptr(i); - - for(uword row=0; row < A_n_rows; ++row) - { - out_mem[row] = eop_aux::pow(A_mem[row], B_mem[row]); - } - } - } - #endif - } - else - { - for(uword i=0; i < A_n_cols; ++i) - { - const eT* A_mem = A.colptr(i); - eT* out_mem = out.colptr(i); - - for(uword row=0; row < A_n_rows; ++row) - { - out_mem[row] = eop_aux::pow(A_mem[row], B_mem[row]); - } - } - } - } - - if(mode == 1) // each row - { - if( arma_config::openmp && mp_gate::eval(A.n_elem) ) - { - #if defined(ARMA_USE_OPENMP) - { - const int n_threads = int( (std::min)(uword(mp_thread_limit::get()), A_n_cols) ); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword i=0; i < A_n_cols; ++i) - { - const eT* A_mem = A.colptr(i); - eT* out_mem = out.colptr(i); - - const eT B_val = B_mem[i]; - - for(uword row=0; row < A_n_rows; ++row) - { - out_mem[row] = eop_aux::pow(A_mem[row], B_val); - } - } - } - #endif - } - else - { - for(uword i=0; i < A_n_cols; ++i) - { - const eT* A_mem = A.colptr(i); - eT* out_mem = out.colptr(i); - - const eT B_val = B_mem[i]; - - for(uword row=0; row < A_n_rows; ++row) - { - out_mem[row] = eop_aux::pow(A_mem[row], B_val); - } - } - } - } - - return out; - } - - - -template -inline -void -glue_powext::apply(Cube& out, const GlueCube& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_cube UA(X.A); - const unwrap_cube UB(X.B); - - const Cube& A = UA.M; - const Cube& B = UB.M; - - arma_conform_assert_same_size(A, B, "element-wise pow()"); - - if(UB.is_alias(out)) - { - Cube tmp; - - glue_powext::apply(tmp, A, B); - - out.steal_mem(tmp); - } - else - { - glue_powext::apply(out, A, B); - } - } - - - -template -inline -void -glue_powext::apply(Cube& out, const Cube& A, const Cube& B) - { - arma_debug_sigprint(); - - out.set_size(A.n_rows, A.n_cols, A.n_slices); - - const uword N = out.n_elem; - - eT* out_mem = out.memptr(); - const eT* A_mem = A.memptr(); - const eT* B_mem = B.memptr(); - - if( arma_config::openmp && mp_gate::eval(N) ) - { - #if defined(ARMA_USE_OPENMP) - { - const int n_threads = mp_thread_limit::get(); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword i=0; i -inline -Cube -glue_powext::apply - ( - const subview_cube_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - const Cube& A = X.P; - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - const uword A_n_slices = A.n_slices; - - Cube out(A_n_rows, A_n_cols, A_n_slices, arma_nozeros_indicator()); - - const quasi_unwrap tmp(Y.get_ref()); - const Mat& B = tmp.M; - - X.check_size(B); - - const eT* B_mem = B.memptr(); - const uword B_n_elem = B.n_elem; - - if( arma_config::openmp && mp_gate::eval(A.n_elem) ) - { - #if defined(ARMA_USE_OPENMP) - { - const int n_threads = int( (std::min)(uword(mp_thread_limit::get()), A_n_slices) ); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword s=0; s < A_n_slices; ++s) - { - const eT* A_slice_mem = A.slice_memptr(s); - eT* out_slice_mem = out.slice_memptr(s); - - for(uword i=0; i < B_n_elem; ++i) - { - out_slice_mem[i] = eop_aux::pow(A_slice_mem[i], B_mem[i]); - } - } - } - #endif - } - else - { - for(uword s=0; s < A_n_slices; ++s) - { - const eT* A_slice_mem = A.slice_memptr(s); - eT* out_slice_mem = out.slice_memptr(s); - - for(uword i=0; i < B_n_elem; ++i) - { - out_slice_mem[i] = eop_aux::pow(A_slice_mem[i], B_mem[i]); - } - } - } - - return out; - } - - - -// - - - -template -inline -void -glue_powext_cx::apply(Mat& out, const mtGlue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const quasi_unwrap UA(X.A); - const quasi_unwrap UB(X.B); - - const Mat& A = UA.M; - const Mat< T>& B = UB.M; - - arma_conform_assert_same_size(A, B, "element-wise pow()"); - - if(UA.is_alias(out) && (UA.has_subview)) - { - Mat tmp; - - glue_powext_cx::apply(tmp, A, B); - - out.steal_mem(tmp); - } - else - { - glue_powext_cx::apply(out, A, B); - } - } - - - -template -inline -void -glue_powext_cx::apply(Mat< std::complex >& out, const Mat< std::complex >& A, const Mat& B) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - out.set_size(A.n_rows, A.n_cols); - - const uword N = out.n_elem; - - eT* out_mem = out.memptr(); - const eT* A_mem = A.memptr(); - const T* B_mem = B.memptr(); - - if( arma_config::openmp && mp_gate::eval(N) ) - { - #if defined(ARMA_USE_OPENMP) - { - const int n_threads = mp_thread_limit::get(); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword i=0; i -inline -Mat -glue_powext_cx::apply - ( - const subview_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - typedef typename parent::elem_type eT; - typedef typename parent::pod_type T; - - const parent& A = X.P; - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - Mat out(A_n_rows, A_n_cols, arma_nozeros_indicator()); - - const quasi_unwrap tmp(Y.get_ref()); - const Mat& B = tmp.M; - - X.check_size(B); - - const T* B_mem = B.memptr(); - - if(mode == 0) // each column - { - if( arma_config::openmp && mp_gate::eval(A.n_elem) ) - { - #if defined(ARMA_USE_OPENMP) - { - const int n_threads = int( (std::min)(uword(mp_thread_limit::get()), A_n_cols) ); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword i=0; i < A_n_cols; ++i) - { - const eT* A_mem = A.colptr(i); - eT* out_mem = out.colptr(i); - - for(uword row=0; row < A_n_rows; ++row) - { - out_mem[row] = std::pow(A_mem[row], B_mem[row]); - } - } - } - #endif - } - else - { - for(uword i=0; i < A_n_cols; ++i) - { - const eT* A_mem = A.colptr(i); - eT* out_mem = out.colptr(i); - - for(uword row=0; row < A_n_rows; ++row) - { - out_mem[row] = std::pow(A_mem[row], B_mem[row]); - } - } - } - } - - if(mode == 1) // each row - { - if( arma_config::openmp && mp_gate::eval(A.n_elem) ) - { - #if defined(ARMA_USE_OPENMP) - { - const int n_threads = int( (std::min)(uword(mp_thread_limit::get()), A_n_cols) ); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword i=0; i < A_n_cols; ++i) - { - const eT* A_mem = A.colptr(i); - eT* out_mem = out.colptr(i); - - const eT B_val = B_mem[i]; - - for(uword row=0; row < A_n_rows; ++row) - { - out_mem[row] = std::pow(A_mem[row], B_val); - } - } - } - #endif - } - else - { - for(uword i=0; i < A_n_cols; ++i) - { - const eT* A_mem = A.colptr(i); - eT* out_mem = out.colptr(i); - - const eT B_val = B_mem[i]; - - for(uword row=0; row < A_n_rows; ++row) - { - out_mem[row] = std::pow(A_mem[row], B_val); - } - } - } - } - - return out; - } - - - -template -inline -void -glue_powext_cx::apply(Cube& out, const mtGlueCube& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - typedef typename get_pod_type::result T; - - const unwrap_cube UA(X.A); - const unwrap_cube UB(X.B); - - const Cube& A = UA.M; - const Cube< T>& B = UB.M; - - arma_conform_assert_same_size(A, B, "element-wise pow()"); - - glue_powext_cx::apply(out, A, B); - } - - - -template -inline -void -glue_powext_cx::apply(Cube< std::complex >& out, const Cube< std::complex >& A, const Cube& B) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - out.set_size(A.n_rows, A.n_cols, A.n_slices); - - const uword N = out.n_elem; - - eT* out_mem = out.memptr(); - const eT* A_mem = A.memptr(); - const T* B_mem = B.memptr(); - - if( arma_config::openmp && mp_gate::eval(N) ) - { - #if defined(ARMA_USE_OPENMP) - { - const int n_threads = mp_thread_limit::get(); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword i=0; i -inline -Cube< std::complex > -glue_powext_cx::apply - ( - const subview_cube_each1< std::complex >& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const Cube& A = X.P; - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - const uword A_n_slices = A.n_slices; - - Cube out(A_n_rows, A_n_cols, A_n_slices, arma_nozeros_indicator()); - - const quasi_unwrap tmp(Y.get_ref()); - const Mat& B = tmp.M; - - X.check_size(B); - - const T* B_mem = B.memptr(); - const uword B_n_elem = B.n_elem; - - if( arma_config::openmp && mp_gate::eval(A.n_elem) ) - { - #if defined(ARMA_USE_OPENMP) - { - const int n_threads = int( (std::min)(uword(mp_thread_limit::get()), A_n_slices) ); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword s=0; s < A_n_slices; ++s) - { - const eT* A_slice_mem = A.slice_memptr(s); - eT* out_slice_mem = out.slice_memptr(s); - - for(uword i=0; i < B_n_elem; ++i) - { - out_slice_mem[i] = std::pow(A_slice_mem[i], B_mem[i]); - } - } - } - #endif - } - else - { - for(uword s=0; s < A_n_slices; ++s) - { - const eT* A_slice_mem = A.slice_memptr(s); - eT* out_slice_mem = out.slice_memptr(s); - - for(uword i=0; i < B_n_elem; ++i) - { - out_slice_mem[i] = std::pow(A_slice_mem[i], B_mem[i]); - } - } - } - - return out; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_quantile_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_quantile_bones.hpp deleted file mode 100644 index cd7fcf120..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_quantile_bones.hpp +++ /dev/null @@ -1,58 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_quantile -//! @{ - - -class glue_quantile - : public traits_glue_default - { - public: - - template - inline static void worker(eTb* out_mem, Col& Y, const Mat& P); - - - template - inline static void apply_noalias(Mat& out, const Mat& X, const Mat& P, const uword dim); - - template - inline static void apply(Mat& out, const mtGlue& expr); - }; - - - -class glue_quantile_default - { - public: - - template - struct traits - { - static constexpr bool is_row = T1::is_row; - static constexpr bool is_col = T1::is_col; - static constexpr bool is_xvec = T1::is_xvec; - }; - - template - inline static void apply(Mat& out, const mtGlue& expr); - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_quantile_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_quantile_meat.hpp deleted file mode 100644 index 726faeb13..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_quantile_meat.hpp +++ /dev/null @@ -1,230 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_quantile -//! @{ - - -template -inline -void -glue_quantile::worker(eTb* out_mem, Col& Y, const Mat& P) - { - arma_debug_sigprint(); - - // NOTE: assuming out_mem is an array with P.n_elem elements - - // TODO: ignore non-finite values ? - - // algorithm based on "Definition 5" in: - // Rob J. Hyndman and Yanan Fan. - // Sample Quantiles in Statistical Packages. - // The American Statistician, Vol. 50, No. 4, pp. 361-365, 1996. - // http://doi.org/10.2307/2684934 - - const eTb* P_mem = P.memptr(); - const uword P_n_elem = P.n_elem; - - const eTb alpha = 0.5; - const eTb N = eTb(Y.n_elem); - const eTb P_min = (eTb(1) - alpha) / N; - const eTb P_max = (N - alpha) / N; - - for(uword i=0; i < P_n_elem; ++i) - { - const eTb P_i = P_mem[i]; - - eTb out_val = eTb(0); - - if(P_i < P_min) - { - out_val = (P_i < eTb(0)) ? eTb(-std::numeric_limits::infinity()) : eTb(Y.min()); - } - else - if(P_i > P_max) - { - out_val = (P_i > eTb(1)) ? eTb( std::numeric_limits::infinity()) : eTb(Y.max()); - } - else - { - const uword k = uword(std::floor(N * P_i + alpha)); - const eTb P_k = (eTb(k) - alpha) / N; - - const eTb w = (P_i - P_k) * N; - - eTa* Y_k_ptr = Y.begin() + uword(k); - std::nth_element( Y.begin(), Y_k_ptr, Y.end() ); - const eTa Y_k_val = (*Y_k_ptr); - - eTa* Y_km1_ptr = Y.begin() + uword(k-1); - // std::nth_element( Y.begin(), Y_km1_ptr, Y.end() ); - std::nth_element( Y.begin(), Y_km1_ptr, Y_k_ptr ); - const eTa Y_km1_val = (*Y_km1_ptr); - - out_val = ((eTb(1) - w) * Y_km1_val) + (w * Y_k_val); - } - - out_mem[i] = out_val; - } - } - - - -template -inline -void -glue_quantile::apply_noalias(Mat& out, const Mat& X, const Mat& P, const uword dim) - { - arma_debug_sigprint(); - - arma_conform_check( ((P.is_vec() == false) && (P.is_empty() == false)), "quantile(): parameter 'P' must be a vector" ); - - if(X.is_empty()) { out.reset(); return; } - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - const uword P_n_elem = P.n_elem; - - if(dim == 0) - { - out.set_size(P_n_elem, X_n_cols); - - if(out.is_empty()) { return; } - - Col Y(X_n_rows, arma_nozeros_indicator()); - - if(X_n_cols == 1) - { - arrayops::copy(Y.memptr(), X.memptr(), X_n_rows); - - glue_quantile::worker(out.memptr(), Y, P); - } - else - { - for(uword col=0; col < X_n_cols; ++col) - { - arrayops::copy(Y.memptr(), X.colptr(col), X_n_rows); - - glue_quantile::worker(out.colptr(col), Y, P); - } - } - } - else - if(dim == 1) - { - out.set_size(X_n_rows, P_n_elem); - - if(out.is_empty()) { return; } - - Col Y(X_n_cols, arma_nozeros_indicator()); - - if(X_n_rows == 1) - { - arrayops::copy(Y.memptr(), X.memptr(), X_n_cols); - - glue_quantile::worker(out.memptr(), Y, P); - } - else - { - Col tmp(P_n_elem, arma_nozeros_indicator()); - - eTb* tmp_mem = tmp.memptr(); - - for(uword row=0; row < X_n_rows; ++row) - { - eTa* Y_mem = Y.memptr(); - - for(uword col=0; col < X_n_cols; ++col) { Y_mem[col] = X.at(row,col); } - - glue_quantile::worker(tmp_mem, Y, P); - - for(uword i=0; i < P_n_elem; ++i) { out.at(row,i) = tmp_mem[i]; } - } - } - } - } - - - -template -inline -void -glue_quantile::apply(Mat& out, const mtGlue& expr) - { - arma_debug_sigprint(); - - typedef typename T2::elem_type eTb; - - const uword dim = expr.aux_uword; - - arma_conform_check( (dim > 1), "quantile(): parameter 'dim' must be 0 or 1" ); - - const quasi_unwrap UA(expr.A); - const quasi_unwrap UB(expr.B); - - arma_conform_check((UA.M.internal_has_nan() || UB.M.internal_has_nan()), "quantile(): detected NaN"); - - if(UA.is_alias(out) || UB.is_alias(out)) - { - Mat tmp; - - glue_quantile::apply_noalias(tmp, UA.M, UB.M, dim); - - out.steal_mem(tmp); - } - else - { - glue_quantile::apply_noalias(out, UA.M, UB.M, dim); - } - } - - - -template -inline -void -glue_quantile_default::apply(Mat& out, const mtGlue& expr) - { - arma_debug_sigprint(); - - typedef typename T2::elem_type eTb; - - const quasi_unwrap UA(expr.A); - const quasi_unwrap UB(expr.B); - - const uword dim = (T1::is_xvec) ? uword(UA.M.is_rowvec() ? 1 : 0) : uword((T1::is_row) ? 1 : 0); - - arma_conform_check((UA.M.internal_has_nan() || UB.M.internal_has_nan()), "quantile(): detected NaN"); - - if(UA.is_alias(out) || UB.is_alias(out)) - { - Mat tmp; - - glue_quantile::apply_noalias(tmp, UA.M, UB.M, dim); - - out.steal_mem(tmp); - } - else - { - glue_quantile::apply_noalias(out, UA.M, UB.M, dim); - } - } - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_relational_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_relational_bones.hpp deleted file mode 100644 index 876ffb7f2..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_relational_bones.hpp +++ /dev/null @@ -1,136 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_relational -//! @{ - - - -class glue_rel_lt - : public traits_glue_or - { - public: - - template - inline static void apply(Mat & out, const mtGlue& X); - - template - inline static void apply(Cube & out, const mtGlueCube& X); - }; - - - -class glue_rel_gt - : public traits_glue_or - { - public: - - template - inline static void apply(Mat & out, const mtGlue& X); - - template - inline static void apply(Cube & out, const mtGlueCube& X); - }; - - - -class glue_rel_lteq - : public traits_glue_or - { - public: - - template - inline static void apply(Mat & out, const mtGlue& X); - - template - inline static void apply(Cube & out, const mtGlueCube& X); - }; - - - -class glue_rel_gteq - : public traits_glue_or - { - public: - - template - inline static void apply(Mat & out, const mtGlue& X); - - template - inline static void apply(Cube & out, const mtGlueCube& X); - }; - - - -class glue_rel_eq - : public traits_glue_or - { - public: - - template - inline static void apply(Mat & out, const mtGlue& X); - - template - inline static void apply(Cube & out, const mtGlueCube& X); - }; - - - -class glue_rel_noteq - : public traits_glue_or - { - public: - - template - inline static void apply(Mat & out, const mtGlue& X); - - template - inline static void apply(Cube & out, const mtGlueCube& X); - }; - - - -class glue_rel_and - : public traits_glue_or - { - public: - - template - inline static void apply(Mat & out, const mtGlue& X); - - template - inline static void apply(Cube & out, const mtGlueCube& X); - }; - - - -class glue_rel_or - : public traits_glue_or - { - public: - - template - inline static void apply(Mat & out, const mtGlue& X); - - template - inline static void apply(Cube & out, const mtGlueCube& X); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_relational_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_relational_meat.hpp deleted file mode 100644 index fcfc46117..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_relational_meat.hpp +++ /dev/null @@ -1,419 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_relational -//! @{ - - - -#undef operator_rel -#undef operator_str - -#undef arma_applier_mat -#undef arma_applier_cube - - -#define arma_applier_mat(operator_rel, operator_str) \ - {\ - const Proxy P1(X.A);\ - const Proxy P2(X.B);\ - \ - arma_conform_assert_same_size(P1, P2, operator_str);\ - \ - const bool bad_alias = (Proxy::has_subview && P1.is_alias(out)) || (Proxy::has_subview && P2.is_alias(out));\ - \ - if(bad_alias == false)\ - {\ - \ - const uword n_rows = P1.get_n_rows();\ - const uword n_cols = P1.get_n_cols();\ - \ - out.set_size(n_rows, n_cols);\ - \ - uword* out_mem = out.memptr();\ - \ - constexpr bool use_at = (Proxy::use_at || Proxy::use_at);\ - \ - if(use_at == false)\ - {\ - typename Proxy::ea_type A = P1.get_ea();\ - typename Proxy::ea_type B = P2.get_ea();\ - \ - const uword n_elem = out.n_elem;\ - \ - for(uword i=0; i::stored_type> tmp1(P1.Q, P1.is_alias(out));\ - const unwrap_check::stored_type> tmp2(P2.Q, P2.is_alias(out));\ - \ - out = (tmp1.M) operator_rel (tmp2.M);\ - }\ - } - - - - -#define arma_applier_cube(operator_rel, operator_str) \ - {\ - const ProxyCube P1(X.A);\ - const ProxyCube P2(X.B);\ - \ - arma_conform_assert_same_size(P1, P2, operator_str);\ - \ - const bool bad_alias = (ProxyCube::has_subview && P1.is_alias(out)) || (ProxyCube::has_subview && P2.is_alias(out));\ - \ - if(bad_alias == false)\ - {\ - \ - const uword n_rows = P1.get_n_rows();\ - const uword n_cols = P1.get_n_cols();\ - const uword n_slices = P1.get_n_slices();\ - \ - out.set_size(n_rows, n_cols, n_slices);\ - \ - uword* out_mem = out.memptr();\ - \ - constexpr bool use_at = (ProxyCube::use_at || ProxyCube::use_at);\ - \ - if(use_at == false)\ - {\ - typename ProxyCube::ea_type A = P1.get_ea();\ - typename ProxyCube::ea_type B = P2.get_ea();\ - \ - const uword n_elem = out.n_elem;\ - \ - for(uword i=0; i::stored_type> tmp1(P1.Q);\ - const unwrap_cube::stored_type> tmp2(P2.Q);\ - \ - out = (tmp1.M) operator_rel (tmp2.M);\ - }\ - } - - - -template -inline -void -glue_rel_lt::apply - ( - Mat & out, - const mtGlue& X - ) - { - arma_debug_sigprint(); - - arma_applier_mat(<, "operator<"); - } - - - -template -inline -void -glue_rel_gt::apply - ( - Mat & out, - const mtGlue& X - ) - { - arma_debug_sigprint(); - - arma_applier_mat(>, "operator>"); - } - - - -template -inline -void -glue_rel_lteq::apply - ( - Mat & out, - const mtGlue& X - ) - { - arma_debug_sigprint(); - - arma_applier_mat(<=, "operator<="); - } - - - -template -inline -void -glue_rel_gteq::apply - ( - Mat & out, - const mtGlue& X - ) - { - arma_debug_sigprint(); - - arma_applier_mat(>=, "operator>="); - } - - - -template -inline -void -glue_rel_eq::apply - ( - Mat & out, - const mtGlue& X - ) - { - arma_debug_sigprint(); - - arma_applier_mat(==, "operator=="); - } - - - -template -inline -void -glue_rel_noteq::apply - ( - Mat & out, - const mtGlue& X - ) - { - arma_debug_sigprint(); - - arma_applier_mat(!=, "operator!="); - } - - - -template -inline -void -glue_rel_and::apply - ( - Mat & out, - const mtGlue& X - ) - { - arma_debug_sigprint(); - - arma_applier_mat(&&, "operator&&"); - } - - - -template -inline -void -glue_rel_or::apply - ( - Mat & out, - const mtGlue& X - ) - { - arma_debug_sigprint(); - - arma_applier_mat(||, "operator||"); - } - - - -// -// -// - - - -template -inline -void -glue_rel_lt::apply - ( - Cube & out, - const mtGlueCube& X - ) - { - arma_debug_sigprint(); - - arma_applier_cube(<, "operator<"); - } - - - -template -inline -void -glue_rel_gt::apply - ( - Cube & out, - const mtGlueCube& X - ) - { - arma_debug_sigprint(); - - arma_applier_cube(>, "operator>"); - } - - - -template -inline -void -glue_rel_lteq::apply - ( - Cube & out, - const mtGlueCube& X - ) - { - arma_debug_sigprint(); - - arma_applier_cube(<=, "operator<="); - } - - - -template -inline -void -glue_rel_gteq::apply - ( - Cube & out, - const mtGlueCube& X - ) - { - arma_debug_sigprint(); - - arma_applier_cube(>=, "operator>="); - } - - - -template -inline -void -glue_rel_eq::apply - ( - Cube & out, - const mtGlueCube& X - ) - { - arma_debug_sigprint(); - - arma_applier_cube(==, "operator=="); - } - - - -template -inline -void -glue_rel_noteq::apply - ( - Cube & out, - const mtGlueCube& X - ) - { - arma_debug_sigprint(); - - arma_applier_cube(!=, "operator!="); - } - - - -template -inline -void -glue_rel_and::apply - ( - Cube & out, - const mtGlueCube& X - ) - { - arma_debug_sigprint(); - - arma_applier_cube(&&, "operator&&"); - } - - - -template -inline -void -glue_rel_or::apply - ( - Cube & out, - const mtGlueCube& X - ) - { - arma_debug_sigprint(); - - arma_applier_cube(||, "operator||"); - } - - - -#undef arma_applier_mat -#undef arma_applier_cube - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_solve_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_solve_bones.hpp deleted file mode 100644 index 20c016591..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_solve_bones.hpp +++ /dev/null @@ -1,175 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup glue_solve -//! @{ - - - -class glue_solve_gen_default - { - public: - - template - struct traits - { - static constexpr bool is_row = false; - static constexpr bool is_col = T2::is_col; - static constexpr bool is_xvec = false; - }; - - template inline static void apply(Mat& out, const Glue& X); - - template inline static bool apply(Mat& out, const Base& A_expr, const Base& B_expr); - }; - - - -class glue_solve_gen_full - { - public: - - template - struct traits - { - static constexpr bool is_row = false; - static constexpr bool is_col = T2::is_col; - static constexpr bool is_xvec = false; - }; - - template inline static void apply(Mat& out, const Glue& X); - - template inline static bool apply(Mat& out, const Base& A_expr, const Base& B_expr, const uword flags); - }; - - - -class glue_solve_tri_default - { - public: - - template - struct traits - { - static constexpr bool is_row = false; - static constexpr bool is_col = T2::is_col; - static constexpr bool is_xvec = false; - }; - - template inline static void apply(Mat& out, const Glue& X); - - template inline static bool apply(Mat& out, const Base& A_expr, const Base& B_expr, const uword flags); - }; - - - -class glue_solve_tri_full - { - public: - - template - struct traits - { - static constexpr bool is_row = false; - static constexpr bool is_col = T2::is_col; - static constexpr bool is_xvec = false; - }; - - template inline static void apply(Mat& out, const Glue& X); - - template inline static bool apply(Mat& out, const Base& A_expr, const Base& B_expr, const uword flags); - }; - - - -namespace solve_opts - { - struct opts - { - const uword flags; - - inline constexpr explicit opts(const uword in_flags); - - inline const opts operator+(const opts& rhs) const; - }; - - inline - constexpr - opts::opts(const uword in_flags) - : flags(in_flags) - {} - - inline - const opts - opts::operator+(const opts& rhs) const - { - const opts result( flags | rhs.flags ); - - return result; - } - - // The values below (eg. 1u << 1) are for internal Armadillo use only. - // The values can change without notice. - - static constexpr uword flag_none = uword(0 ); - static constexpr uword flag_fast = uword(1u << 0); - static constexpr uword flag_equilibrate = uword(1u << 1); - static constexpr uword flag_no_approx = uword(1u << 2); - static constexpr uword flag_triu = uword(1u << 3); - static constexpr uword flag_tril = uword(1u << 4); - static constexpr uword flag_no_band = uword(1u << 5); - static constexpr uword flag_no_sympd = uword(1u << 6); - static constexpr uword flag_allow_ugly = uword(1u << 7); - static constexpr uword flag_likely_sympd = uword(1u << 8); - static constexpr uword flag_refine = uword(1u << 9); - static constexpr uword flag_no_trimat = uword(1u << 10); - static constexpr uword flag_force_approx = uword(1u << 11); - - struct opts_none : public opts { inline constexpr opts_none() : opts(flag_none ) {} }; - struct opts_fast : public opts { inline constexpr opts_fast() : opts(flag_fast ) {} }; - struct opts_equilibrate : public opts { inline constexpr opts_equilibrate() : opts(flag_equilibrate ) {} }; - struct opts_no_approx : public opts { inline constexpr opts_no_approx() : opts(flag_no_approx ) {} }; - struct opts_triu : public opts { inline constexpr opts_triu() : opts(flag_triu ) {} }; - struct opts_tril : public opts { inline constexpr opts_tril() : opts(flag_tril ) {} }; - struct opts_no_band : public opts { inline constexpr opts_no_band() : opts(flag_no_band ) {} }; - struct opts_no_sympd : public opts { inline constexpr opts_no_sympd() : opts(flag_no_sympd ) {} }; - struct opts_allow_ugly : public opts { inline constexpr opts_allow_ugly() : opts(flag_allow_ugly ) {} }; - struct opts_likely_sympd : public opts { inline constexpr opts_likely_sympd() : opts(flag_likely_sympd) {} }; - struct opts_refine : public opts { inline constexpr opts_refine() : opts(flag_refine ) {} }; - struct opts_no_trimat : public opts { inline constexpr opts_no_trimat() : opts(flag_no_trimat ) {} }; - struct opts_force_approx : public opts { inline constexpr opts_force_approx() : opts(flag_force_approx) {} }; - - static constexpr opts_none none; - static constexpr opts_fast fast; - static constexpr opts_equilibrate equilibrate; - static constexpr opts_no_approx no_approx; - static constexpr opts_triu triu; - static constexpr opts_tril tril; - static constexpr opts_no_band no_band; - static constexpr opts_no_sympd no_sympd; - static constexpr opts_allow_ugly allow_ugly; - static constexpr opts_likely_sympd likely_sympd; - static constexpr opts_refine refine; - static constexpr opts_no_trimat no_trimat; - static constexpr opts_force_approx force_approx; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_solve_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_solve_meat.hpp deleted file mode 100644 index f50bcc401..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_solve_meat.hpp +++ /dev/null @@ -1,587 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_solve -//! @{ - - - -// -// glue_solve_gen_default - - -template -inline -void -glue_solve_gen_default::apply(Mat& out, const Glue& X) - { - arma_debug_sigprint(); - - const bool status = glue_solve_gen_default::apply(out, X.A, X.B); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("solve(): solution not found"); - } - } - - - -template -inline -bool -glue_solve_gen_default::apply(Mat& out, const Base& A_expr, const Base& B_expr) - { - arma_debug_sigprint(); - - return glue_solve_gen_full::apply( out, A_expr, B_expr, uword(0)); - } - - - -// -// glue_solve_gen_full - - -template -inline -void -glue_solve_gen_full::apply(Mat& out, const Glue& X) - { - arma_debug_sigprint(); - - const bool status = glue_solve_gen_full::apply( out, X.A, X.B, X.aux_uword ); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("solve(): solution not found"); - } - } - - - -template -inline -bool -glue_solve_gen_full::apply(Mat& actual_out, const Base& A_expr, const Base& B_expr, const uword flags) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - if(has_user_flags == true ) { arma_debug_print("glue_solve_gen_full::apply(): has_user_flags = true" ); } - if(has_user_flags == false) { arma_debug_print("glue_solve_gen_full::apply(): has_user_flags = false"); } - - const bool fast = has_user_flags && bool(flags & solve_opts::flag_fast ); - const bool equilibrate = has_user_flags && bool(flags & solve_opts::flag_equilibrate ); - const bool no_approx = has_user_flags && bool(flags & solve_opts::flag_no_approx ); - const bool no_band = has_user_flags && bool(flags & solve_opts::flag_no_band ); - const bool no_sympd = has_user_flags && bool(flags & solve_opts::flag_no_sympd ); - const bool allow_ugly = has_user_flags && bool(flags & solve_opts::flag_allow_ugly ); - const bool likely_sympd = has_user_flags && bool(flags & solve_opts::flag_likely_sympd); - const bool refine = has_user_flags && bool(flags & solve_opts::flag_refine ); - const bool no_trimat = has_user_flags && bool(flags & solve_opts::flag_no_trimat ); - const bool force_approx = has_user_flags && bool(flags & solve_opts::flag_force_approx); - - if(has_user_flags) - { - arma_debug_print("glue_solve_gen_full::apply(): enabled flags:"); - - if(fast ) { arma_debug_print("fast"); } - if(equilibrate ) { arma_debug_print("equilibrate"); } - if(no_approx ) { arma_debug_print("no_approx"); } - if(no_band ) { arma_debug_print("no_band"); } - if(no_sympd ) { arma_debug_print("no_sympd"); } - if(allow_ugly ) { arma_debug_print("allow_ugly"); } - if(likely_sympd) { arma_debug_print("likely_sympd"); } - if(refine ) { arma_debug_print("refine"); } - if(no_trimat ) { arma_debug_print("no_trimat"); } - if(force_approx) { arma_debug_print("force_approx"); } - - arma_conform_check( (fast && equilibrate ), "solve(): options 'fast' and 'equilibrate' are mutually exclusive" ); - arma_conform_check( (fast && refine ), "solve(): options 'fast' and 'refine' are mutually exclusive" ); - arma_conform_check( (no_sympd && likely_sympd), "solve(): options 'no_sympd' and 'likely_sympd' are mutually exclusive" ); - } - - Mat A = A_expr.get_ref(); - - if(force_approx) - { - arma_debug_print("glue_solve_gen_full::apply(): forced approximate solution"); - - arma_conform_check( no_approx, "solve(): options 'no_approx' and 'force_approx' are mutually exclusive" ); - - if(fast) { arma_warn(2, "solve(): option 'fast' ignored for forced approximate solution" ); } - if(equilibrate) { arma_warn(2, "solve(): option 'equilibrate' ignored for forced approximate solution" ); } - if(refine) { arma_warn(2, "solve(): option 'refine' ignored for forced approximate solution" ); } - if(likely_sympd) { arma_warn(2, "solve(): option 'likely_sympd' ignored for forced approximate solution" ); } - - return auxlib::solve_approx_svd(actual_out, A, B_expr.get_ref()); // A is overwritten - } - - // A_expr and B_expr can be used more than once (sympd optimisation fails or approximate solution required), - // so ensure they are not overwritten in case we have aliasing - - bool is_alias = true; // assume we have aliasing until we can prove otherwise - - if(is_Mat::value && is_Mat::value) - { - const quasi_unwrap UA( A_expr.get_ref() ); - const quasi_unwrap UB( B_expr.get_ref() ); - - is_alias = UA.is_alias(actual_out) || UB.is_alias(actual_out); - } - - Mat tmp; - Mat& out = (is_alias) ? tmp : actual_out; - - T rcond = T(0); - bool status = false; - - if(A.n_rows == A.n_cols) - { - arma_debug_print("glue_solve_gen_full::apply(): detected square system"); - - uword KL = 0; - uword KU = 0; - - const bool is_band = arma_config::optimise_band && ((no_band || auxlib::crippled_lapack(A)) ? false : band_helper::is_band(KL, KU, A, uword(32))); - - const bool is_triu = (no_trimat || refine || equilibrate || likely_sympd || is_band ) ? false : trimat_helper::is_triu(A); - const bool is_tril = (no_trimat || refine || equilibrate || likely_sympd || is_band || is_triu) ? false : trimat_helper::is_tril(A); - - const bool try_sympd = arma_config::optimise_sym && ((no_sympd || auxlib::crippled_lapack(A) || is_band || is_triu || is_tril) ? false : (likely_sympd ? true : sym_helper::guess_sympd(A, uword(16)))); - - if(fast) - { - // fast mode: solvers without refinement and without rcond estimate - - arma_debug_print("glue_solve_gen_full::apply(): fast mode"); - - if(is_band) - { - if( (KL == 1) && (KU == 1) ) - { - arma_debug_print("glue_solve_gen_full::apply(): fast + tridiagonal"); - - status = auxlib::solve_tridiag_fast(out, A, B_expr.get_ref()); - } - else - { - arma_debug_print("glue_solve_gen_full::apply(): fast + band"); - - status = auxlib::solve_band_fast(out, A, KL, KU, B_expr.get_ref()); - } - } - else - if(is_triu || is_tril) - { - if(is_triu) { arma_debug_print("glue_solve_gen_full::apply(): fast + upper triangular matrix"); } - if(is_tril) { arma_debug_print("glue_solve_gen_full::apply(): fast + lower triangular matrix"); } - - const uword layout = (is_triu) ? uword(0) : uword(1); - - status = auxlib::solve_trimat_fast(out, A, B_expr.get_ref(), layout); - } - else - if(try_sympd) - { - arma_debug_print("glue_solve_gen_full::apply(): fast + try_sympd"); - - status = auxlib::solve_sympd_fast(out, A, B_expr.get_ref()); // A is overwritten - - if(status == false) - { - // auxlib::solve_sympd_fast() may have failed because A isn't really sympd - - arma_debug_print("glue_solve_gen_full::apply(): auxlib::solve_sympd_fast() failed; retrying"); - - A = A_expr.get_ref(); - - status = auxlib::solve_square_fast(out, A, B_expr.get_ref()); // A is overwritten - } - } - else - { - arma_debug_print("glue_solve_gen_full::apply(): fast + dense"); - - status = auxlib::solve_square_fast(out, A, B_expr.get_ref()); // A is overwritten - } - } - else - if(refine || equilibrate) - { - // refine mode: solvers with refinement and with rcond estimate - - arma_debug_print("glue_solve_gen_full::apply(): refine mode"); - - if(is_band) - { - arma_debug_print("glue_solve_gen_full::apply(): refine + band"); - - status = auxlib::solve_band_refine(out, rcond, A, KL, KU, B_expr, equilibrate); - } - else - if(try_sympd) - { - arma_debug_print("glue_solve_gen_full::apply(): refine + try_sympd"); - - status = auxlib::solve_sympd_refine(out, rcond, A, B_expr.get_ref(), equilibrate); // A is overwritten - - if( (status == false) && (rcond == T(0)) ) - { - // auxlib::solve_sympd_refine() may have failed because A isn't really sympd; - // in that case rcond is set to zero - - arma_debug_print("glue_solve_gen_full::apply(): auxlib::solve_sympd_refine() failed; retrying"); - - A = A_expr.get_ref(); - - status = auxlib::solve_square_refine(out, rcond, A, B_expr.get_ref(), equilibrate); // A is overwritten - } - } - else - { - arma_debug_print("glue_solve_gen_full::apply(): refine + dense"); - - status = auxlib::solve_square_refine(out, rcond, A, B_expr, equilibrate); // A is overwritten - } - } - else - { - // default mode: solvers without refinement but with rcond estimate - - arma_debug_print("glue_solve_gen_full::apply(): default mode"); - - if(is_band) - { - arma_debug_print("glue_solve_gen_full::apply(): rcond + band"); - - status = auxlib::solve_band_rcond(out, rcond, A, KL, KU, B_expr.get_ref()); - } - else - if(is_triu || is_tril) - { - if(is_triu) { arma_debug_print("glue_solve_gen_full::apply(): rcond + upper triangular matrix"); } - if(is_tril) { arma_debug_print("glue_solve_gen_full::apply(): rcond + lower triangular matrix"); } - - const uword layout = (is_triu) ? uword(0) : uword(1); - - status = auxlib::solve_trimat_rcond(out, rcond, A, B_expr.get_ref(), layout); - } - else - if(try_sympd) - { - bool sympd_state = false; - - status = auxlib::solve_sympd_rcond(out, sympd_state, rcond, A, B_expr.get_ref()); // A is overwritten - - if( (status == false) && (sympd_state == false) ) - { - arma_debug_print("glue_solve_gen_full::apply(): auxlib::solve_sympd_rcond() failed; retrying"); - - A = A_expr.get_ref(); - - status = auxlib::solve_square_rcond(out, rcond, A, B_expr.get_ref()); // A is overwritten - } - } - else - { - status = auxlib::solve_square_rcond(out, rcond, A, B_expr.get_ref()); // A is overwritten - } - } - } - else - { - arma_debug_print("glue_solve_gen_full::apply(): detected non-square system"); - - if(equilibrate) { arma_warn(2, "solve(): option 'equilibrate' ignored for non-square matrix" ); } - if(refine) { arma_warn(2, "solve(): option 'refine' ignored for non-square matrix" ); } - if(likely_sympd) { arma_warn(2, "solve(): option 'likely_sympd' ignored for non-square matrix" ); } - - if(fast) - { - status = auxlib::solve_rect_fast(out, A, B_expr.get_ref()); // A is overwritten - } - else - { - status = auxlib::solve_rect_rcond(out, rcond, A, B_expr.get_ref()); // A is overwritten - } - } - - - if( (status == true) && (fast == false) && (allow_ugly == false) && ((rcond < std::numeric_limits::epsilon()) || arma_isnan(rcond)) ) - { - status = false; - } - - - if( (status == false) && (no_approx == false) ) - { - arma_debug_print("glue_solve_gen_full::apply(): solving rank deficient system"); - - if(rcond == T(0)) - { - arma_warn(2, "solve(): system is singular; attempting approx solution"); - } - else - { - arma_warn(2, "solve(): system is singular (rcond: ", rcond, "); attempting approx solution"); - } - - // TODO: conditionally recreate A: have a separate state flag which indicates whether A was previously overwritten - - A = A_expr.get_ref(); // as A may have been overwritten - - status = auxlib::solve_approx_svd(out, A, B_expr.get_ref()); // A is overwritten - } - - if(is_alias) { actual_out.steal_mem(out); } - - return status; - } - - - -// -// glue_solve_tri_default - - -template -inline -void -glue_solve_tri_default::apply(Mat& out, const Glue& X) - { - arma_debug_sigprint(); - - const bool status = glue_solve_tri_default::apply( out, X.A, X.B, X.aux_uword ); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("solve(): solution not found"); - } - } - - - -template -inline -bool -glue_solve_tri_default::apply(Mat& actual_out, const Base& A_expr, const Base& B_expr, const uword flags) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const bool triu = bool(flags & solve_opts::flag_triu); - const bool tril = bool(flags & solve_opts::flag_tril); - - arma_debug_print("glue_solve_tri_default::apply(): enabled flags:"); - - if(triu) { arma_debug_print("triu"); } - if(tril) { arma_debug_print("tril"); } - - const quasi_unwrap UA(A_expr.get_ref()); - const Mat& A = UA.M; - - arma_conform_check( (A.is_square() == false), "solve(): matrix marked as triangular must be square sized" ); - - const uword layout = (triu) ? uword(0) : uword(1); - - bool is_alias = true; - - if(is_Mat::value) - { - const quasi_unwrap UB(B_expr.get_ref()); - - is_alias = UA.is_alias(actual_out) || UB.is_alias(actual_out); - } - - T rcond = T(0); - bool status = false; - - Mat tmp; - Mat& out = (is_alias) ? tmp : actual_out; - - status = auxlib::solve_trimat_rcond(out, rcond, A, B_expr.get_ref(), layout); // A is not modified - - - if( (status == true) && ( (rcond < std::numeric_limits::epsilon()) || arma_isnan(rcond) ) ) - { - status = false; - } - - - if(status == false) - { - arma_debug_print("glue_solve_tri_default::apply(): solving rank deficient system"); - - if(rcond == T(0)) - { - arma_warn(2, "solve(): system is singular; attempting approx solution"); - } - else - { - arma_warn(2, "solve(): system is singular (rcond: ", rcond, "); attempting approx solution"); - } - - Mat triA = (triu) ? trimatu(A) : trimatl(A); // trimatu() and trimatl() return the same type - - status = auxlib::solve_approx_svd(out, triA, B_expr.get_ref()); // triA is overwritten - } - - - if(is_alias) { actual_out.steal_mem(out); } - - return status; - } - - - -// -// glue_solve_tri_full - - -template -inline -void -glue_solve_tri_full::apply(Mat& out, const Glue& X) - { - arma_debug_sigprint(); - - const bool status = glue_solve_tri_full::apply( out, X.A, X.B, X.aux_uword ); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("solve(): solution not found"); - } - } - - - -template -inline -bool -glue_solve_tri_full::apply(Mat& actual_out, const Base& A_expr, const Base& B_expr, const uword flags) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const bool fast = bool(flags & solve_opts::flag_fast ); - const bool equilibrate = bool(flags & solve_opts::flag_equilibrate ); - const bool no_approx = bool(flags & solve_opts::flag_no_approx ); - const bool triu = bool(flags & solve_opts::flag_triu ); - const bool tril = bool(flags & solve_opts::flag_tril ); - const bool allow_ugly = bool(flags & solve_opts::flag_allow_ugly ); - const bool likely_sympd = bool(flags & solve_opts::flag_likely_sympd); - const bool refine = bool(flags & solve_opts::flag_refine ); - const bool no_trimat = bool(flags & solve_opts::flag_no_trimat ); - const bool force_approx = bool(flags & solve_opts::flag_force_approx); - - arma_debug_print("glue_solve_tri_full::apply(): enabled flags:"); - - if(fast ) { arma_debug_print("fast"); } - if(equilibrate ) { arma_debug_print("equilibrate"); } - if(no_approx ) { arma_debug_print("no_approx"); } - if(triu ) { arma_debug_print("triu"); } - if(tril ) { arma_debug_print("tril"); } - if(allow_ugly ) { arma_debug_print("allow_ugly"); } - if(likely_sympd) { arma_debug_print("likely_sympd"); } - if(refine ) { arma_debug_print("refine"); } - if(no_trimat ) { arma_debug_print("no_trimat"); } - if(force_approx) { arma_debug_print("force_approx"); } - - if(no_trimat || equilibrate || refine || force_approx) - { - const uword mask = ~(solve_opts::flag_triu | solve_opts::flag_tril); - - return glue_solve_gen_full::apply(actual_out, ((triu) ? trimatu(A_expr.get_ref()) : trimatl(A_expr.get_ref())), B_expr, (flags & mask)); - } - - if(likely_sympd) { arma_warn(2, "solve(): option 'likely_sympd' ignored for triangular matrix"); } - - const quasi_unwrap UA(A_expr.get_ref()); - const Mat& A = UA.M; - - arma_conform_check( (A.is_square() == false), "solve(): matrix marked as triangular must be square sized" ); - - const uword layout = (triu) ? uword(0) : uword(1); - - bool is_alias = true; - - if(is_Mat::value) - { - const quasi_unwrap UB(B_expr.get_ref()); - - is_alias = UA.is_alias(actual_out) || UB.is_alias(actual_out); - } - - T rcond = T(0); - bool status = false; - - Mat tmp; - Mat& out = (is_alias) ? tmp : actual_out; - - if(fast) - { - status = auxlib::solve_trimat_fast(out, A, B_expr.get_ref(), layout); // A is not modified - } - else - { - status = auxlib::solve_trimat_rcond(out, rcond, A, B_expr.get_ref(), layout); // A is not modified - } - - - if( (status == true) && (fast == false) && (allow_ugly == false) && ((rcond < std::numeric_limits::epsilon()) || arma_isnan(rcond)) ) - { - status = false; - } - - - if( (status == false) && (no_approx == false) ) - { - arma_debug_print("glue_solve_tri_full::apply(): solving rank deficient system"); - - if(rcond == T(0)) - { - arma_warn(2, "solve(): system is singular; attempting approx solution"); - } - else - { - arma_warn(2, "solve(): system is singular (rcond: ", rcond, "); attempting approx solution"); - } - - Mat triA = (triu) ? trimatu(A) : trimatl(A); // trimatu() and trimatl() return the same type - - status = auxlib::solve_approx_svd(out, triA, B_expr.get_ref()); // triA is overwritten - } - - - if(is_alias) { actual_out.steal_mem(out); } - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_times_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_times_bones.hpp deleted file mode 100644 index 5792e4eca..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_times_bones.hpp +++ /dev/null @@ -1,168 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_times -//! @{ - - - -//! \brief -//! Template metaprogram depth_lhs -//! calculates the number of Glue instances on the left hand side argument of Glue -//! ie. it recursively expands each Tx, until the type of Tx is not "Glue<..,.., glue_type>" (i.e the "glue_type" changes) - -template -struct depth_lhs - { - static constexpr uword num = 0; - }; - -template -struct depth_lhs< glue_type, Glue > - { - static constexpr uword num = 1 + depth_lhs::num; - }; - - - -template -struct glue_times_redirect2_helper - { - template - arma_hot inline static void apply(Mat& out, const Glue& X); - }; - - -template<> -struct glue_times_redirect2_helper - { - template - arma_hot inline static void apply(Mat& out, const Glue& X); - }; - - - -template -struct glue_times_redirect3_helper - { - template - arma_hot inline static void apply(Mat& out, const Glue< Glue,T3,glue_times>& X); - }; - - -template<> -struct glue_times_redirect3_helper - { - template - arma_hot inline static void apply(Mat& out, const Glue< Glue,T3,glue_times>& X); - }; - - - -template -struct glue_times_redirect - { - template - arma_hot inline static void apply(Mat& out, const Glue& X); - }; - - -template<> -struct glue_times_redirect<2> - { - template - arma_hot inline static void apply(Mat& out, const Glue& X); - }; - - -template<> -struct glue_times_redirect<3> - { - template - arma_hot inline static void apply(Mat& out, const Glue< Glue,T3,glue_times>& X); - }; - - -template<> -struct glue_times_redirect<4> - { - template - arma_hot inline static void apply(Mat& out, const Glue< Glue< Glue, T3, glue_times>, T4, glue_times>& X); - }; - - - -//! Class which implements the immediate multiplication of two or more matrices -class glue_times - { - public: - - template - struct traits - { - static constexpr bool is_row = T1::is_row; - static constexpr bool is_col = T2::is_col; - static constexpr bool is_xvec = false; - }; - - template - arma_hot inline static void apply(Mat& out, const Glue& X); - - - template - arma_hot inline static void apply_inplace(Mat& out, const T1& X); - - template - arma_hot inline static void apply_inplace_plus(Mat& out, const Glue& X, const sword sign); - - // - - template - arma_inline static uword mul_storage_cost(const TA& A, const TB& B); - - template - arma_hot inline static void apply(Mat& out, const TA& A, const TB& B, const eT val); - - template - arma_hot inline static void apply(Mat& out, const TA& A, const TB& B, const TC& C, const eT val); - - template - arma_hot inline static void apply(Mat& out, const TA& A, const TB& B, const TC& C, const TD& D, const eT val); - }; - - - -class glue_times_diag - { - public: - - template - struct traits - { - static constexpr bool is_row = T1::is_row; - static constexpr bool is_col = T2::is_col; - static constexpr bool is_xvec = false; - }; - - template - arma_hot inline static void apply(Mat& out, const Glue& X); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_times_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_times_meat.hpp deleted file mode 100644 index 9b4020faa..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_times_meat.hpp +++ /dev/null @@ -1,967 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_times -//! @{ - - - -template -template -inline -void -glue_times_redirect2_helper::apply(Mat& out, const Glue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const partial_unwrap tmp1(X.A); - const partial_unwrap tmp2(X.B); - - const typename partial_unwrap::stored_type& A = tmp1.M; - const typename partial_unwrap::stored_type& B = tmp2.M; - - constexpr bool use_alpha = partial_unwrap::do_times || partial_unwrap::do_times; - const eT alpha = use_alpha ? (tmp1.get_val() * tmp2.get_val()) : eT(0); - - if( (is_cx::no) && (resolves_to_rowvector::value && resolves_to_colvector::value) ) - { - arma_debug_print("glue_times: dot product optimisation"); - - arma_conform_assert_mul_size(A, B, tmp1.do_trans, tmp2.do_trans, "matrix multiplication"); - - const eT val = op_dot::direct_dot(A.n_elem, A.memptr(), B.memptr()); - - out.set_size(1,1); - - out[0] = (use_alpha) ? (val * alpha) : (val); - - return; - } - - const bool alias = tmp1.is_alias(out) || tmp2.is_alias(out); - - if(alias == false) - { - glue_times::apply - < - eT, - partial_unwrap::do_trans, - partial_unwrap::do_trans, - (partial_unwrap::do_times || partial_unwrap::do_times) - > - (out, A, B, alpha); - } - else - { - Mat tmp; - - glue_times::apply - < - eT, - partial_unwrap::do_trans, - partial_unwrap::do_trans, - (partial_unwrap::do_times || partial_unwrap::do_times) - > - (tmp, A, B, alpha); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -glue_times_redirect2_helper::apply(Mat& out, const Glue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(arma_config::optimise_invexpr && (strip_inv::do_inv_gen || strip_inv::do_inv_spd)) - { - // replace inv(A)*B with solve(A,B) - - arma_debug_print("glue_times_redirect<2>::apply(): detected inv(A)*B"); - - const strip_inv A_strip(X.A); - - Mat A = A_strip.M; - - arma_conform_check( (A.is_square() == false), "inv(): given matrix must be square sized" ); - - if( (strip_inv::do_inv_spd) && (arma_config::check_conform) && (auxlib::rudimentary_sym_check(A) == false) ) - { - if(is_cx::no ) { arma_warn(1, "inv_sympd(): given matrix is not symmetric"); } - if(is_cx::yes) { arma_warn(1, "inv_sympd(): given matrix is not hermitian"); } - } - - const unwrap_check B_tmp(X.B, out); - const Mat& B = B_tmp.M; - - arma_conform_assert_mul_size(A, B, "matrix multiplication"); - - const bool status = (strip_inv::do_inv_spd) ? auxlib::solve_sympd_fast(out, A, B) : auxlib::solve_square_fast(out, A, B); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("matrix multiplication: problem with matrix inverse; suggest to use solve() instead"); - } - - return; - } - - if(arma_config::optimise_invexpr && strip_inv::do_inv_spd) - { - // replace A*inv_sympd(B) with trans( solve(trans(B),trans(A)) ) - // transpose of B is avoided as B is explicitly marked as symmetric - - arma_debug_print("glue_times_redirect<2>::apply(): detected A*inv_sympd(B)"); - - const Mat At = trans(X.A); - - const strip_inv B_strip(X.B); - - Mat B = B_strip.M; - - arma_conform_check( (B.is_square() == false), "inv_sympd(): given matrix must be square sized" ); - - if( (arma_config::check_conform) && (auxlib::rudimentary_sym_check(B) == false) ) - { - if(is_cx::no ) { arma_warn(1, "inv_sympd(): given matrix is not symmetric"); } - if(is_cx::yes) { arma_warn(1, "inv_sympd(): given matrix is not hermitian"); } - } - - arma_conform_assert_mul_size(At.n_cols, At.n_rows, B.n_rows, B.n_cols, "matrix multiplication"); - - const bool status = auxlib::solve_sympd_fast(out, B, At); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("matrix multiplication: problem with matrix inverse; suggest to use solve() instead"); - } - - out = trans(out); - - return; - } - - glue_times_redirect2_helper::apply(out, X); - } - - - -template -template -inline -void -glue_times_redirect3_helper::apply(Mat& out, const Glue< Glue, T3, glue_times>& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - // we have exactly 3 objects - // hence we can safely expand X as X.A.A, X.A.B and X.B - - const partial_unwrap tmp1(X.A.A); - const partial_unwrap tmp2(X.A.B); - const partial_unwrap tmp3(X.B ); - - const typename partial_unwrap::stored_type& A = tmp1.M; - const typename partial_unwrap::stored_type& B = tmp2.M; - const typename partial_unwrap::stored_type& C = tmp3.M; - - constexpr bool use_alpha = partial_unwrap::do_times || partial_unwrap::do_times || partial_unwrap::do_times; - const eT alpha = use_alpha ? (tmp1.get_val() * tmp2.get_val() * tmp3.get_val()) : eT(0); - - const bool alias = tmp1.is_alias(out) || tmp2.is_alias(out) || tmp3.is_alias(out); - - if(alias == false) - { - glue_times::apply - < - eT, - partial_unwrap::do_trans, - partial_unwrap::do_trans, - partial_unwrap::do_trans, - (partial_unwrap::do_times || partial_unwrap::do_times || partial_unwrap::do_times) - > - (out, A, B, C, alpha); - } - else - { - Mat tmp; - - glue_times::apply - < - eT, - partial_unwrap::do_trans, - partial_unwrap::do_trans, - partial_unwrap::do_trans, - (partial_unwrap::do_times || partial_unwrap::do_times || partial_unwrap::do_times) - > - (tmp, A, B, C, alpha); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -glue_times_redirect3_helper::apply(Mat& out, const Glue< Glue, T3, glue_times>& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(arma_config::optimise_invexpr && (strip_inv::do_inv_gen || strip_inv::do_inv_spd)) - { - // replace inv(A)*B*C with solve(A,B*C); - - arma_debug_print("glue_times_redirect<3>::apply(): detected inv(A)*B*C"); - - const strip_inv A_strip(X.A.A); - - Mat A = A_strip.M; - - arma_conform_check( (A.is_square() == false), "inv(): given matrix must be square sized" ); - - const partial_unwrap tmp2(X.A.B); - const partial_unwrap tmp3(X.B ); - - const typename partial_unwrap::stored_type& B = tmp2.M; - const typename partial_unwrap::stored_type& C = tmp3.M; - - constexpr bool use_alpha = partial_unwrap::do_times || partial_unwrap::do_times; - const eT alpha = use_alpha ? (tmp2.get_val() * tmp3.get_val()) : eT(0); - - Mat BC; - - glue_times::apply - < - eT, - partial_unwrap::do_trans, - partial_unwrap::do_trans, - (partial_unwrap::do_times || partial_unwrap::do_times) - > - (BC, B, C, alpha); - - arma_conform_assert_mul_size(A, BC, "matrix multiplication"); - - if( (strip_inv::do_inv_spd) && (arma_config::check_conform) && (auxlib::rudimentary_sym_check(A) == false) ) - { - if(is_cx::no ) { arma_warn(1, "inv_sympd(): given matrix is not symmetric"); } - if(is_cx::yes) { arma_warn(1, "inv_sympd(): given matrix is not hermitian"); } - } - - const bool status = (strip_inv::do_inv_spd) ? auxlib::solve_sympd_fast(out, A, BC) : auxlib::solve_square_fast(out, A, BC); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("matrix multiplication: problem with matrix inverse; suggest to use solve() instead"); - } - - return; - } - - - if(arma_config::optimise_invexpr && (strip_inv::do_inv_gen || strip_inv::do_inv_spd)) - { - // replace A*inv(B)*C with A*solve(B,C) - - arma_debug_print("glue_times_redirect<3>::apply(): detected A*inv(B)*C"); - - const strip_inv B_strip(X.A.B); - - Mat B = B_strip.M; - - arma_conform_check( (B.is_square() == false), "inv(): given matrix must be square sized" ); - - const unwrap C_tmp(X.B); - const Mat& C = C_tmp.M; - - arma_conform_assert_mul_size(B, C, "matrix multiplication"); - - if( (strip_inv::do_inv_spd) && (arma_config::check_conform) && (auxlib::rudimentary_sym_check(B) == false) ) - { - if(is_cx::no ) { arma_warn(1, "inv_sympd(): given matrix is not symmetric"); } - if(is_cx::yes) { arma_warn(1, "inv_sympd(): given matrix is not hermitian"); } - } - - Mat solve_result; - - const bool status = (strip_inv::do_inv_spd) ? auxlib::solve_sympd_fast(solve_result, B, C) : auxlib::solve_square_fast(solve_result, B, C); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("matrix multiplication: problem with matrix inverse; suggest to use solve() instead"); - return; - } - - const partial_unwrap_check tmp1(X.A.A, out); - - const typename partial_unwrap_check::stored_type& A = tmp1.M; - - constexpr bool use_alpha = partial_unwrap_check::do_times; - const eT alpha = use_alpha ? tmp1.get_val() : eT(0); - - glue_times::apply - < - eT, - partial_unwrap_check::do_trans, - false, - partial_unwrap_check::do_times - > - (out, A, solve_result, alpha); - - return; - } - - - glue_times_redirect3_helper::apply(out, X); - } - - - -template -template -inline -void -glue_times_redirect::apply(Mat& out, const Glue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const partial_unwrap tmp1(X.A); - const partial_unwrap tmp2(X.B); - - const typename partial_unwrap::stored_type& A = tmp1.M; - const typename partial_unwrap::stored_type& B = tmp2.M; - - constexpr bool use_alpha = partial_unwrap::do_times || partial_unwrap::do_times; - const eT alpha = use_alpha ? (tmp1.get_val() * tmp2.get_val()) : eT(0); - - const bool alias = tmp1.is_alias(out) || tmp2.is_alias(out); - - if(alias == false) - { - glue_times::apply - < - eT, - partial_unwrap::do_trans, - partial_unwrap::do_trans, - (partial_unwrap::do_times || partial_unwrap::do_times) - > - (out, A, B, alpha); - } - else - { - Mat tmp; - - glue_times::apply - < - eT, - partial_unwrap::do_trans, - partial_unwrap::do_trans, - (partial_unwrap::do_times || partial_unwrap::do_times) - > - (tmp, A, B, alpha); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -glue_times_redirect<2>::apply(Mat& out, const Glue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - glue_times_redirect2_helper< is_supported_blas_type::value >::apply(out, X); - } - - - -template -inline -void -glue_times_redirect<3>::apply(Mat& out, const Glue< Glue, T3, glue_times>& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - glue_times_redirect3_helper< is_supported_blas_type::value >::apply(out, X); - } - - - -template -inline -void -glue_times_redirect<4>::apply(Mat& out, const Glue< Glue< Glue, T3, glue_times>, T4, glue_times>& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - // there is exactly 4 objects - // hence we can safely expand X as X.A.A.A, X.A.A.B, X.A.B and X.B - - const partial_unwrap tmp1(X.A.A.A); - const partial_unwrap tmp2(X.A.A.B); - const partial_unwrap tmp3(X.A.B ); - const partial_unwrap tmp4(X.B ); - - const typename partial_unwrap::stored_type& A = tmp1.M; - const typename partial_unwrap::stored_type& B = tmp2.M; - const typename partial_unwrap::stored_type& C = tmp3.M; - const typename partial_unwrap::stored_type& D = tmp4.M; - - constexpr bool use_alpha = partial_unwrap::do_times || partial_unwrap::do_times || partial_unwrap::do_times || partial_unwrap::do_times; - const eT alpha = use_alpha ? (tmp1.get_val() * tmp2.get_val() * tmp3.get_val() * tmp4.get_val()) : eT(0); - - const bool alias = tmp1.is_alias(out) || tmp2.is_alias(out) || tmp3.is_alias(out) || tmp4.is_alias(out); - - if(alias == false) - { - glue_times::apply - < - eT, - partial_unwrap::do_trans, - partial_unwrap::do_trans, - partial_unwrap::do_trans, - partial_unwrap::do_trans, - (partial_unwrap::do_times || partial_unwrap::do_times || partial_unwrap::do_times || partial_unwrap::do_times) - > - (out, A, B, C, D, alpha); - } - else - { - Mat tmp; - - glue_times::apply - < - eT, - partial_unwrap::do_trans, - partial_unwrap::do_trans, - partial_unwrap::do_trans, - partial_unwrap::do_trans, - (partial_unwrap::do_times || partial_unwrap::do_times || partial_unwrap::do_times || partial_unwrap::do_times) - > - (tmp, A, B, C, D, alpha); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -glue_times::apply(Mat& out, const Glue& X) - { - arma_debug_sigprint(); - - constexpr uword N_mat = 1 + depth_lhs< glue_times, Glue >::num; - - arma_debug_print(arma_str::format("N_mat: %u") % N_mat); - - glue_times_redirect::apply(out, X); - } - - - -template -inline -void -glue_times::apply_inplace(Mat& out, const T1& X) - { - arma_debug_sigprint(); - - out = out * X; - } - - - -template -inline -void -glue_times::apply_inplace_plus(Mat& out, const Glue& X, const sword sign) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - if( (is_outer_product::value) || (has_op_inv_any::value) || (has_op_inv_any::value) ) - { - // partial workaround for corner cases - - const Mat tmp(X); - - if(sign > sword(0)) { out += tmp; } else { out -= tmp; } - - return; - } - - const partial_unwrap_check tmp1(X.A, out); - const partial_unwrap_check tmp2(X.B, out); - - typedef typename partial_unwrap_check::stored_type TA; - typedef typename partial_unwrap_check::stored_type TB; - - const TA& A = tmp1.M; - const TB& B = tmp2.M; - - constexpr bool do_trans_A = partial_unwrap_check::do_trans; - constexpr bool do_trans_B = partial_unwrap_check::do_trans; - - const bool use_alpha = partial_unwrap_check::do_times || partial_unwrap_check::do_times || (sign < sword(0)); - - const eT alpha = use_alpha ? ( tmp1.get_val() * tmp2.get_val() * ( (sign > sword(0)) ? eT(1) : eT(-1) ) ) : eT(0); - - arma_conform_assert_mul_size(A, B, do_trans_A, do_trans_B, "matrix multiplication"); - - const uword result_n_rows = (do_trans_A == false) ? (TA::is_row ? 1 : A.n_rows) : (TA::is_col ? 1 : A.n_cols); - const uword result_n_cols = (do_trans_B == false) ? (TB::is_col ? 1 : B.n_cols) : (TB::is_row ? 1 : B.n_rows); - - arma_conform_assert_same_size(out.n_rows, out.n_cols, result_n_rows, result_n_cols, ( (sign > sword(0)) ? "addition" : "subtraction" ) ); - - if(out.n_elem == 0) { return; } - - if( (do_trans_A == false) && (do_trans_B == false) && (use_alpha == false) ) - { - if( ((A.n_rows == 1) || (TA::is_row)) && (is_cx::no) ) { gemv::apply(out.memptr(), B, A.memptr(), alpha, eT(1)); } - else if( (B.n_cols == 1) || (TB::is_col) ) { gemv::apply(out.memptr(), A, B.memptr(), alpha, eT(1)); } - else { gemm::apply(out, A, B, alpha, eT(1)); } - } - else - if( (do_trans_A == false) && (do_trans_B == false) && (use_alpha == true) ) - { - if( ((A.n_rows == 1) || (TA::is_row)) && (is_cx::no) ) { gemv::apply(out.memptr(), B, A.memptr(), alpha, eT(1)); } - else if( (B.n_cols == 1) || (TB::is_col) ) { gemv::apply(out.memptr(), A, B.memptr(), alpha, eT(1)); } - else { gemm::apply(out, A, B, alpha, eT(1)); } - } - else - if( (do_trans_A == true) && (do_trans_B == false) && (use_alpha == false) ) - { - if( ((A.n_cols == 1) || (TA::is_col)) && (is_cx::no) ) { gemv::apply(out.memptr(), B, A.memptr(), alpha, eT(1)); } - else if( (B.n_cols == 1) || (TB::is_col) ) { gemv::apply(out.memptr(), A, B.memptr(), alpha, eT(1)); } - else if( (void_ptr(&A) == void_ptr(&B)) && (is_cx::no) ) { syrk::apply(out, A, alpha, eT(1)); } - else if( (void_ptr(&A) == void_ptr(&B)) && (is_cx::yes) ) { herk::apply(out, A, T(0), T(1)); } - else { gemm::apply(out, A, B, alpha, eT(1)); } - } - else - if( (do_trans_A == true) && (do_trans_B == false) && (use_alpha == true) ) - { - if( ((A.n_cols == 1) || (TA::is_col)) && (is_cx::no) ) { gemv::apply(out.memptr(), B, A.memptr(), alpha, eT(1)); } - else if( (B.n_cols == 1) || (TB::is_col) ) { gemv::apply(out.memptr(), A, B.memptr(), alpha, eT(1)); } - else if( (void_ptr(&A) == void_ptr(&B)) && (is_cx::no) ) { syrk::apply(out, A, alpha, eT(1)); } - else { gemm::apply(out, A, B, alpha, eT(1)); } - } - else - if( (do_trans_A == false) && (do_trans_B == true) && (use_alpha == false) ) - { - if( ((A.n_rows == 1) || (TA::is_row)) && (is_cx::no) ) { gemv::apply(out.memptr(), B, A.memptr(), alpha, eT(1)); } - else if( ((B.n_rows == 1) || (TB::is_row)) && (is_cx::no) ) { gemv::apply(out.memptr(), A, B.memptr(), alpha, eT(1)); } - else if( (void_ptr(&A) == void_ptr(&B)) && (is_cx::no) ) { syrk::apply(out, A, alpha, eT(1)); } - else if( (void_ptr(&A) == void_ptr(&B)) && (is_cx::yes) ) { herk::apply(out, A, T(0), T(1)); } - else { gemm::apply(out, A, B, alpha, eT(1)); } - } - else - if( (do_trans_A == false) && (do_trans_B == true) && (use_alpha == true) ) - { - if( ((A.n_rows == 1) || (TA::is_row)) && (is_cx::no) ) { gemv::apply(out.memptr(), B, A.memptr(), alpha, eT(1)); } - else if( ((B.n_rows == 1) || (TB::is_row)) && (is_cx::no) ) { gemv::apply(out.memptr(), A, B.memptr(), alpha, eT(1)); } - else if( (void_ptr(&A) == void_ptr(&B)) && (is_cx::no) ) { syrk::apply(out, A, alpha, eT(1)); } - else { gemm::apply(out, A, B, alpha, eT(1)); } - } - else - if( (do_trans_A == true) && (do_trans_B == true) && (use_alpha == false) ) - { - if( ((A.n_cols == 1) || (TA::is_col)) && (is_cx::no) ) { gemv::apply(out.memptr(), B, A.memptr(), alpha, eT(1)); } - else if( ((B.n_rows == 1) || (TB::is_row)) && (is_cx::no) ) { gemv::apply(out.memptr(), A, B.memptr(), alpha, eT(1)); } - else { gemm::apply(out, A, B, alpha, eT(1)); } - } - else - if( (do_trans_A == true) && (do_trans_B == true) && (use_alpha == true) ) - { - if( ((A.n_cols == 1) || (TA::is_col)) && (is_cx::no) ) { gemv::apply(out.memptr(), B, A.memptr(), alpha, eT(1)); } - else if( ((B.n_rows == 1) || (TB::is_row)) && (is_cx::no) ) { gemv::apply(out.memptr(), A, B.memptr(), alpha, eT(1)); } - else { gemm::apply(out, A, B, alpha, eT(1)); } - } - } - - - -template -arma_inline -uword -glue_times::mul_storage_cost(const TA& A, const TB& B) - { - const uword final_A_n_rows = (do_trans_A == false) ? ( TA::is_row ? 1 : A.n_rows ) : ( TA::is_col ? 1 : A.n_cols ); - const uword final_B_n_cols = (do_trans_B == false) ? ( TB::is_col ? 1 : B.n_cols ) : ( TB::is_row ? 1 : B.n_rows ); - - return final_A_n_rows * final_B_n_cols; - } - - - -template - < - typename eT, - const bool do_trans_A, - const bool do_trans_B, - const bool use_alpha, - typename TA, - typename TB - > -inline -void -glue_times::apply - ( - Mat& out, - const TA& A, - const TB& B, - const eT alpha - ) - { - arma_debug_sigprint(); - - //arma_conform_assert_mul_size(A, B, do_trans_A, do_trans_B, "matrix multiplication"); - arma_conform_assert_trans_mul_size(A.n_rows, A.n_cols, B.n_rows, B.n_cols, "matrix multiplication"); - - const uword final_n_rows = (do_trans_A == false) ? (TA::is_row ? 1 : A.n_rows) : (TA::is_col ? 1 : A.n_cols); - const uword final_n_cols = (do_trans_B == false) ? (TB::is_col ? 1 : B.n_cols) : (TB::is_row ? 1 : B.n_rows); - - out.set_size(final_n_rows, final_n_cols); - - if( (A.n_elem == 0) || (B.n_elem == 0) ) { out.zeros(); return; } - - if( (do_trans_A == false) && (do_trans_B == false) && (use_alpha == false) ) - { - if( ((A.n_rows == 1) || (TA::is_row)) && (is_cx::no) ) { gemv::apply(out.memptr(), B, A.memptr()); } - else if( (B.n_cols == 1) || (TB::is_col) ) { gemv::apply(out.memptr(), A, B.memptr()); } - else { gemm::apply(out, A, B ); } - } - else - if( (do_trans_A == false) && (do_trans_B == false) && (use_alpha == true) ) - { - if( ((A.n_rows == 1) || (TA::is_row)) && (is_cx::no) ) { gemv::apply(out.memptr(), B, A.memptr(), alpha); } - else if( (B.n_cols == 1) || (TB::is_col) ) { gemv::apply(out.memptr(), A, B.memptr(), alpha); } - else { gemm::apply(out, A, B, alpha); } - } - else - if( (do_trans_A == true) && (do_trans_B == false) && (use_alpha == false) ) - { - if( ((A.n_cols == 1) || (TA::is_col)) && (is_cx::no) ) { gemv::apply(out.memptr(), B, A.memptr()); } - else if( (B.n_cols == 1) || (TB::is_col) ) { gemv::apply(out.memptr(), A, B.memptr()); } - else if( (void_ptr(&A) == void_ptr(&B)) && (is_cx::no) ) { syrk::apply(out, A ); } - else if( (void_ptr(&A) == void_ptr(&B)) && (is_cx::yes) ) { herk::apply(out, A ); } - else { gemm::apply(out, A, B ); } - } - else - if( (do_trans_A == true) && (do_trans_B == false) && (use_alpha == true) ) - { - if( ((A.n_cols == 1) || (TA::is_col)) && (is_cx::no) ) { gemv::apply(out.memptr(), B, A.memptr(), alpha); } - else if( (B.n_cols == 1) || (TB::is_col) ) { gemv::apply(out.memptr(), A, B.memptr(), alpha); } - else if( (void_ptr(&A) == void_ptr(&B)) && (is_cx::no) ) { syrk::apply(out, A, alpha); } - else { gemm::apply(out, A, B, alpha); } - } - else - if( (do_trans_A == false) && (do_trans_B == true) && (use_alpha == false) ) - { - if( ((A.n_rows == 1) || (TA::is_row)) && (is_cx::no) ) { gemv::apply(out.memptr(), B, A.memptr()); } - else if( ((B.n_rows == 1) || (TB::is_row)) && (is_cx::no) ) { gemv::apply(out.memptr(), A, B.memptr()); } - else if( (void_ptr(&A) == void_ptr(&B)) && (is_cx::no) ) { syrk::apply(out, A ); } - else if( (void_ptr(&A) == void_ptr(&B)) && (is_cx::yes) ) { herk::apply(out, A ); } - else { gemm::apply(out, A, B ); } - } - else - if( (do_trans_A == false) && (do_trans_B == true) && (use_alpha == true) ) - { - if( ((A.n_rows == 1) || (TA::is_row)) && (is_cx::no) ) { gemv::apply(out.memptr(), B, A.memptr(), alpha); } - else if( ((B.n_rows == 1) || (TB::is_row)) && (is_cx::no) ) { gemv::apply(out.memptr(), A, B.memptr(), alpha); } - else if( (void_ptr(&A) == void_ptr(&B)) && (is_cx::no) ) { syrk::apply(out, A, alpha); } - else { gemm::apply(out, A, B, alpha); } - } - else - if( (do_trans_A == true) && (do_trans_B == true) && (use_alpha == false) ) - { - if( ((A.n_cols == 1) || (TA::is_col)) && (is_cx::no) ) { gemv::apply(out.memptr(), B, A.memptr()); } - else if( ((B.n_rows == 1) || (TB::is_row)) && (is_cx::no) ) { gemv::apply(out.memptr(), A, B.memptr()); } - else { gemm::apply(out, A, B ); } - } - else - if( (do_trans_A == true) && (do_trans_B == true) && (use_alpha == true) ) - { - if( ((A.n_cols == 1) || (TA::is_col)) && (is_cx::no) ) { gemv::apply(out.memptr(), B, A.memptr(), alpha); } - else if( ((B.n_rows == 1) || (TB::is_row)) && (is_cx::no) ) { gemv::apply(out.memptr(), A, B.memptr(), alpha); } - else { gemm::apply(out, A, B, alpha); } - } - } - - - -template - < - typename eT, - const bool do_trans_A, - const bool do_trans_B, - const bool do_trans_C, - const bool use_alpha, - typename TA, - typename TB, - typename TC - > -inline -void -glue_times::apply - ( - Mat& out, - const TA& A, - const TB& B, - const TC& C, - const eT alpha - ) - { - arma_debug_sigprint(); - - Mat tmp; - - const uword storage_cost_AB = glue_times::mul_storage_cost(A, B); - const uword storage_cost_BC = glue_times::mul_storage_cost(B, C); - - if(storage_cost_AB <= storage_cost_BC) - { - // out = (A*B)*C - - glue_times::apply(tmp, A, B, alpha); - glue_times::apply(out, tmp, C, eT(0)); - } - else - { - // out = A*(B*C) - - glue_times::apply(tmp, B, C, alpha); - glue_times::apply(out, A, tmp, eT(0)); - } - } - - - -template - < - typename eT, - const bool do_trans_A, - const bool do_trans_B, - const bool do_trans_C, - const bool do_trans_D, - const bool use_alpha, - typename TA, - typename TB, - typename TC, - typename TD - > -inline -void -glue_times::apply - ( - Mat& out, - const TA& A, - const TB& B, - const TC& C, - const TD& D, - const eT alpha - ) - { - arma_debug_sigprint(); - - Mat tmp; - - const uword storage_cost_AC = glue_times::mul_storage_cost(A, C); - const uword storage_cost_BD = glue_times::mul_storage_cost(B, D); - - if(storage_cost_AC <= storage_cost_BD) - { - // out = (A*B*C)*D - - glue_times::apply(tmp, A, B, C, alpha); - - glue_times::apply(out, tmp, D, eT(0)); - } - else - { - // out = A*(B*C*D) - - glue_times::apply(tmp, B, C, D, alpha); - - glue_times::apply(out, A, tmp, eT(0)); - } - } - - - -// -// glue_times_diag - - -template -inline -void -glue_times_diag::apply(Mat& actual_out, const Glue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const strip_diagmat S1(X.A); - const strip_diagmat S2(X.B); - - typedef typename strip_diagmat::stored_type T1_stripped; - typedef typename strip_diagmat::stored_type T2_stripped; - - if( (strip_diagmat::do_diagmat == true) && (strip_diagmat::do_diagmat == false) ) - { - arma_debug_print("glue_times_diag::apply(): diagmat(A) * B"); - - const diagmat_proxy A(S1.M); - - const quasi_unwrap UB(X.B); - const Mat& B = UB.M; - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - const uword A_length = (std::min)(A_n_rows, A_n_cols); - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - arma_conform_assert_mul_size(A_n_rows, A_n_cols, B_n_rows, B_n_cols, "matrix multiplication"); - - const bool is_alias = (A.is_alias(actual_out) || UB.is_alias(actual_out)); - - if(is_alias) { arma_debug_print("glue_times_diag::apply(): aliasing detected"); } - - Mat tmp; - Mat& out = (is_alias) ? tmp : actual_out; - - out.zeros(A_n_rows, B_n_cols); - - for(uword col=0; col < B_n_cols; ++col) - { - eT* out_coldata = out.colptr(col); - const eT* B_coldata = B.colptr(col); - - for(uword i=0; i < A_length; ++i) { out_coldata[i] = A[i] * B_coldata[i]; } - } - - if(is_alias) { actual_out.steal_mem(tmp); } - } - else - if( (strip_diagmat::do_diagmat == false) && (strip_diagmat::do_diagmat == true) ) - { - arma_debug_print("glue_times_diag::apply(): A * diagmat(B)"); - - const quasi_unwrap UA(X.A); - const Mat& A = UA.M; - - const diagmat_proxy B(S2.M); - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - const uword B_length = (std::min)(B_n_rows, B_n_cols); - - arma_conform_assert_mul_size(A_n_rows, A_n_cols, B_n_rows, B_n_cols, "matrix multiplication"); - - const bool is_alias = (UA.is_alias(actual_out) || B.is_alias(actual_out)); - - if(is_alias) { arma_debug_print("glue_times_diag::apply(): aliasing detected"); } - - Mat tmp; - Mat& out = (is_alias) ? tmp : actual_out; - - out.zeros(A_n_rows, B_n_cols); - - for(uword col=0; col < B_length; ++col) - { - const eT val = B[col]; - - eT* out_coldata = out.colptr(col); - const eT* A_coldata = A.colptr(col); - - for(uword i=0; i < A_n_rows; ++i) { out_coldata[i] = A_coldata[i] * val; } - } - - if(is_alias) { actual_out.steal_mem(tmp); } - } - else - if( (strip_diagmat::do_diagmat == true) && (strip_diagmat::do_diagmat == true) ) - { - arma_debug_print("glue_times_diag::apply(): diagmat(A) * diagmat(B)"); - - const diagmat_proxy A(S1.M); - const diagmat_proxy B(S2.M); - - arma_conform_assert_mul_size(A.n_rows, A.n_cols, B.n_rows, B.n_cols, "matrix multiplication"); - - const bool is_alias = (A.is_alias(actual_out) || B.is_alias(actual_out)); - - if(is_alias) { arma_debug_print("glue_times_diag::apply(): aliasing detected"); } - - Mat tmp; - Mat& out = (is_alias) ? tmp : actual_out; - - out.zeros(A.n_rows, B.n_cols); - - const uword A_length = (std::min)(A.n_rows, A.n_cols); - const uword B_length = (std::min)(B.n_rows, B.n_cols); - - const uword N = (std::min)(A_length, B_length); - - for(uword i=0; i < N; ++i) { out.at(i,i) = A[i] * B[i]; } - - if(is_alias) { actual_out.steal_mem(tmp); } - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_times_misc_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_times_misc_bones.hpp deleted file mode 100644 index ca01a1ca7..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_times_misc_bones.hpp +++ /dev/null @@ -1,88 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_times_misc -//! @{ - - - -class dense_sparse_helper - { - public: - - template - arma_inline static typename arma_not_cx::result dot(const eT* A_mem, const SpMat& B, const uword col); - - template - arma_inline static typename arma_cx_only::result dot(const eT* A_mem, const SpMat& B, const uword col); - }; - - - -class glue_times_dense_sparse - { - public: - - template - struct traits - { - static constexpr bool is_row = T1::is_row; - static constexpr bool is_col = T2::is_col; - static constexpr bool is_xvec = false; - }; - - template - inline static void apply(Mat& out, const SpToDGlue& expr); - - template - inline static void apply_noalias(Mat& out, const T1& x, const T2& y); - - template - inline static void apply_mixed(Mat< typename promote_type::result >& out, const T1& X, const T2& Y); - }; - - - -class glue_times_sparse_dense - { - public: - - template - struct traits - { - static constexpr bool is_row = T1::is_row; - static constexpr bool is_col = T2::is_col; - static constexpr bool is_xvec = false; - }; - - template - inline static void apply(Mat& out, const SpToDGlue& expr); - - template - inline static void apply_noalias(Mat& out, const T1& x, const T2& y); - - template - inline static void apply_noalias_trans(Mat& out, const T1& x, const T2& y); - - template - inline static void apply_mixed(Mat< typename promote_type::result >& out, const T1& X, const T2& Y); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_times_misc_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_times_misc_meat.hpp deleted file mode 100644 index cca3b3106..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_times_misc_meat.hpp +++ /dev/null @@ -1,646 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_times_misc -//! @{ - - - -template -arma_inline -typename arma_not_cx::result -dense_sparse_helper::dot(const eT* A_mem, const SpMat& B, const uword col) - { - arma_debug_sigprint(); - - uword col_offset = B.col_ptrs[col ]; - const uword next_col_offset = B.col_ptrs[col + 1]; - - const uword* start_ptr = &(B.row_indices[ col_offset]); - const uword* end_ptr = &(B.row_indices[next_col_offset]); - - const eT* B_values = B.values; - - eT acc = eT(0); - - for(const uword* ptr = start_ptr; ptr != end_ptr; ++ptr) - { - const uword index = (*ptr); - - acc += A_mem[index] * B_values[col_offset]; - - ++col_offset; - } - - return acc; - } - - - -template -arma_inline -typename arma_cx_only::result -dense_sparse_helper::dot(const eT* A_mem, const SpMat& B, const uword col) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - uword col_offset = B.col_ptrs[col ]; - const uword next_col_offset = B.col_ptrs[col + 1]; - - const uword* start_ptr = &(B.row_indices[ col_offset]); - const uword* end_ptr = &(B.row_indices[next_col_offset]); - - const eT* B_values = B.values; - - T acc_real = T(0); - T acc_imag = T(0); - - for(const uword* ptr = start_ptr; ptr != end_ptr; ++ptr) - { - const uword index = (*ptr); - - const std::complex& X = A_mem[index]; - const std::complex& Y = B_values[col_offset]; - - const T a = X.real(); - const T b = X.imag(); - - const T c = Y.real(); - const T d = Y.imag(); - - acc_real += (a*c) - (b*d); - acc_imag += (a*d) + (b*c); - - ++col_offset; - } - - return std::complex(acc_real, acc_imag); - } - - - -template -inline -void -glue_times_dense_sparse::apply(Mat& out, const SpToDGlue& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(is_op_diagmat::value) { out = SpMat(expr.A) * expr.B; return; } // SpMat has specialised handling for op_diagmat - - const quasi_unwrap UA(expr.A); - - if(UA.is_alias(out)) - { - Mat tmp; - - glue_times_dense_sparse::apply_noalias(tmp, UA.M, expr.B); - - out.steal_mem(tmp); - } - else - { - glue_times_dense_sparse::apply_noalias(out, UA.M, expr.B); - } - } - - - -template -inline -void -glue_times_dense_sparse::apply_noalias(Mat& out, const T1& x, const T2& y) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap UA(x); - const Mat& A = UA.M; - - const unwrap_spmat UB(y); - const SpMat& B = UB.M; - - arma_conform_assert_mul_size(A.n_rows, A.n_cols, B.n_rows, B.n_cols, "matrix multiplication"); - - out.set_size(A.n_rows, B.n_cols); - - if((A.n_elem == 0) || (B.n_nonzero == 0)) { out.zeros(); return; } - - if((resolves_to_rowvector::value) || (A.n_rows == 1)) - { - arma_debug_print("using row vector specialisation"); - - if( (arma_config::openmp) && (mp_thread_limit::in_parallel() == false) && (B.n_cols >= 2) && mp_gate::eval(B.n_nonzero) ) - { - #if defined(ARMA_USE_OPENMP) - { - arma_debug_print("openmp implementation"); - - eT* out_mem = out.memptr(); - const eT* A_mem = A.memptr(); - - const uword B_n_cols = B.n_cols; - const int n_threads = mp_thread_limit::get(); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword col=0; col < B_n_cols; ++col) - { - out_mem[col] = dense_sparse_helper::dot(A_mem, B, col); - } - } - #endif - } - else - { - arma_debug_print("serial implementation"); - - eT* out_mem = out.memptr(); - const eT* A_mem = A.memptr(); - - const uword B_n_cols = B.n_cols; - - for(uword col=0; col < B_n_cols; ++col) - { - out_mem[col] = dense_sparse_helper::dot(A_mem, B, col); - } - } - } - else - if( (arma_config::openmp) && (mp_thread_limit::in_parallel() == false) && (A.n_rows <= (A.n_cols / uword(100))) ) - { - #if defined(ARMA_USE_OPENMP) - { - arma_debug_print("using parallelised multiplication"); - - const uword B_n_cols = B.n_cols; - const int n_threads = mp_thread_limit::get(); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword i=0; i < B_n_cols; ++i) - { - const uword col_offset_1 = B.col_ptrs[i ]; - const uword col_offset_2 = B.col_ptrs[i+1]; - - const uword col_offset_delta = col_offset_2 - col_offset_1; - - const uvec indices(const_cast(&(B.row_indices[col_offset_1])), col_offset_delta, false, false); - const Col B_col(const_cast< eT*>(&( B.values[col_offset_1])), col_offset_delta, false, false); - - out.col(i) = A.cols(indices) * B_col; - } - } - #endif - } - else - { - arma_debug_print("using standard multiplication"); - - out.zeros(); - - typename SpMat::const_iterator B_it = B.begin(); - - const uword nnz = B.n_nonzero; - const uword out_n_rows = out.n_rows; - - for(uword count = 0; count < nnz; ++count, ++B_it) - { - const eT B_it_val = (*B_it); - const uword B_it_col = B_it.col(); - const uword B_it_row = B_it.row(); - - const eT* A_col = A.colptr(B_it_row); - eT* out_col = out.colptr(B_it_col); - - for(uword row = 0; row < out_n_rows; ++row) - { - out_col[row] += A_col[row] * B_it_val; - } - } - } - } - - - -template -inline -void -glue_times_dense_sparse::apply_mixed(Mat< typename promote_type::result >& out, const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - if( (is_same_type::no) && (is_same_type::yes) ) - { - // upgrade T1 - - const quasi_unwrap UA(X); - const unwrap_spmat UB(Y); - - const Mat& A = UA.M; - const SpMat& B = UB.M; - - const Mat AA = conv_to< Mat >::from(A); - - const SpMat& BB = reinterpret_cast< const SpMat& >(B); - - glue_times_dense_sparse::apply_noalias(out, AA, BB); - } - else - if( (is_same_type::yes) && (is_same_type::no) ) - { - // upgrade T2 - - const quasi_unwrap UA(X); - const unwrap_spmat UB(Y); - - const Mat& A = UA.M; - const SpMat& B = UB.M; - - const Mat& AA = reinterpret_cast< const Mat& >(A); - - SpMat BB(arma_layout_indicator(), B); - - for(uword i=0; i < B.n_nonzero; ++i) { access::rw(BB.values[i]) = out_eT(B.values[i]); } - - glue_times_dense_sparse::apply_noalias(out, AA, BB); - } - else - { - // upgrade T1 and T2 - - const quasi_unwrap UA(X); - const unwrap_spmat UB(Y); - - const Mat& A = UA.M; - const SpMat& B = UB.M; - - const Mat AA = conv_to< Mat >::from(A); - - SpMat BB(arma_layout_indicator(), B); - - for(uword i=0; i < B.n_nonzero; ++i) { access::rw(BB.values[i]) = out_eT(B.values[i]); } - - glue_times_dense_sparse::apply_noalias(out, AA, BB); - } - } - - - -// - - - -template -inline -void -glue_times_sparse_dense::apply(Mat& out, const SpToDGlue& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(is_op_diagmat::value) { out = expr.A * SpMat(expr.B); return; } // SpMat has specialised handling for op_diagmat - - const quasi_unwrap UB(expr.B); - - if((sp_strip_trans::do_htrans && is_cx::no) || (sp_strip_trans::do_strans)) - { - arma_debug_print("detected non-conjugate transpose of A"); - - const sp_strip_trans x_strip(expr.A); - - if(UB.is_alias(out)) - { - Mat tmp; - - glue_times_sparse_dense::apply_noalias_trans(tmp, x_strip.M, UB.M); - - out.steal_mem(tmp); - } - else - { - glue_times_sparse_dense::apply_noalias_trans(out, x_strip.M, UB.M); - } - } - else - { - if(UB.is_alias(out)) - { - Mat tmp; - - glue_times_sparse_dense::apply_noalias(tmp, expr.A, UB.M); - - out.steal_mem(tmp); - } - else - { - glue_times_sparse_dense::apply_noalias(out, expr.A, UB.M); - } - } - } - - - -template -inline -void -glue_times_sparse_dense::apply_noalias(Mat& out, const T1& x, const T2& y) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat UA(x); - const SpMat& A = UA.M; - - const quasi_unwrap UB(y); - const Mat& B = UB.M; - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - arma_conform_assert_mul_size(A_n_rows, A_n_cols, B_n_rows, B_n_cols, "matrix multiplication"); - - if((resolves_to_colvector::value) || (B_n_cols == 1)) - { - arma_debug_print("using column vector specialisation"); - - out.zeros(A_n_rows, 1); - - eT* out_mem = out.memptr(); - const eT* B_mem = B.memptr(); - - typename SpMat::const_iterator A_it = A.begin(); - - const uword nnz = A.n_nonzero; - - for(uword count = 0; count < nnz; ++count, ++A_it) - { - const eT A_it_val = (*A_it); - const uword A_it_row = A_it.row(); - const uword A_it_col = A_it.col(); - - out_mem[A_it_row] += A_it_val * B_mem[A_it_col]; - } - } - else - if(B_n_cols >= (B_n_rows / uword(100))) - { - arma_debug_print("using transpose-based multiplication"); - - const SpMat At = A.st(); - const Mat Bt = B.st(); - - if(A_n_rows == B_n_cols) - { - glue_times_dense_sparse::apply_noalias(out, Bt, At); - - op_strans::apply_mat(out, out); // since 'out' is square-sized, this will do an inplace transpose - } - else - { - Mat tmp; - - glue_times_dense_sparse::apply_noalias(tmp, Bt, At); - - op_strans::apply_mat(out, tmp); - } - } - else - { - arma_debug_print("using standard multiplication"); - - out.zeros(A_n_rows, B_n_cols); - - typename SpMat::const_iterator A_it = A.begin(); - - const uword nnz = A.n_nonzero; - - for(uword count = 0; count < nnz; ++count, ++A_it) - { - const eT A_it_val = (*A_it); - const uword A_it_row = A_it.row(); - const uword A_it_col = A_it.col(); - - for(uword col = 0; col < B_n_cols; ++col) - { - out.at(A_it_row, col) += A_it_val * B.at(A_it_col, col); - } - } - } - } - - - -template -inline -void -glue_times_sparse_dense::apply_noalias_trans(Mat& out, const T1& x, const T2& y) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat UA(x); - const SpMat& A = UA.M; // NOTE: this is the given matrix without the transpose operation applied - - const quasi_unwrap UB(y); - const Mat& B = UB.M; - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - arma_conform_assert_mul_size(A_n_cols, A_n_rows, B_n_rows, B_n_cols, "matrix multiplication"); - - if((resolves_to_colvector::value) || (B_n_cols == 1)) - { - arma_debug_print("using column vector specialisation (avoiding transpose of A)"); - - if( (arma_config::openmp) && (mp_thread_limit::in_parallel() == false) && (A_n_cols >= 2) && mp_gate::eval(A.n_nonzero) ) - { - arma_debug_print("opemp implementation"); - - #if defined(ARMA_USE_OPENMP) - { - out.zeros(A_n_cols, 1); - - eT* out_mem = out.memptr(); - const eT* B_mem = B.memptr(); - - const int n_threads = mp_thread_limit::get(); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword col=0; col < A_n_cols; ++col) - { - out_mem[col] = dense_sparse_helper::dot(B_mem, A, col); - } - } - #endif - } - else - { - arma_debug_print("serial implementation"); - - out.zeros(A_n_cols, 1); - - eT* out_mem = out.memptr(); - const eT* B_mem = B.memptr(); - - for(uword col=0; col < A_n_cols; ++col) - { - out_mem[col] = dense_sparse_helper::dot(B_mem, A, col); - } - } - } - else - if(B_n_cols >= (B_n_rows / uword(100))) - { - arma_debug_print("using transpose-based multiplication (avoiding transpose of A)"); - - const Mat Bt = B.st(); - - if(A_n_cols == B_n_cols) - { - glue_times_dense_sparse::apply_noalias(out, Bt, A); - - op_strans::apply_mat(out, out); // since 'out' is square-sized, this will do an inplace transpose - } - else - { - Mat tmp; - - glue_times_dense_sparse::apply_noalias(tmp, Bt, A); - - op_strans::apply_mat(out, tmp); - } - } - else - { - arma_debug_print("using standard multiplication (avoiding transpose of A)"); - - out.zeros(A_n_cols, B_n_cols); - - typename SpMat::const_iterator A_it = A.begin(); - - const uword nnz = A.n_nonzero; - - for(uword count = 0; count < nnz; ++count, ++A_it) - { - const eT A_it_val = (*A_it); - const uword A_it_row = A_it.row(); - const uword A_it_col = A_it.col(); - - for(uword col = 0; col < B_n_cols; ++col) - { - out.at(A_it_col, col) += A_it_val * B.at(A_it_row, col); - } - } - } - } - - - -template -inline -void -glue_times_sparse_dense::apply_mixed(Mat< typename promote_type::result >& out, const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - if( (is_same_type::no) && (is_same_type::yes) ) - { - // upgrade T1 - - const unwrap_spmat UA(X); - const quasi_unwrap UB(Y); - - const SpMat& A = UA.M; - const Mat& B = UB.M; - - SpMat AA(arma_layout_indicator(), A); - - for(uword i=0; i < A.n_nonzero; ++i) { access::rw(AA.values[i]) = out_eT(A.values[i]); } - - const Mat& BB = reinterpret_cast< const Mat& >(B); - - glue_times_sparse_dense::apply_noalias(out, AA, BB); - } - else - if( (is_same_type::yes) && (is_same_type::no) ) - { - // upgrade T2 - - const unwrap_spmat UA(X); - const quasi_unwrap UB(Y); - - const SpMat& A = UA.M; - const Mat& B = UB.M; - - const SpMat& AA = reinterpret_cast< const SpMat& >(A); - - const Mat BB = conv_to< Mat >::from(B); - - glue_times_sparse_dense::apply_noalias(out, AA, BB); - } - else - { - // upgrade T1 and T2 - - const unwrap_spmat UA(X); - const quasi_unwrap UB(Y); - - const SpMat& A = UA.M; - const Mat& B = UB.M; - - SpMat AA(arma_layout_indicator(), A); - - for(uword i=0; i < A.n_nonzero; ++i) { access::rw(AA.values[i]) = out_eT(A.values[i]); } - - const Mat BB = conv_to< Mat >::from(B); - - glue_times_sparse_dense::apply_noalias(out, AA, BB); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_toeplitz_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_toeplitz_bones.hpp deleted file mode 100644 index 338de1482..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_toeplitz_bones.hpp +++ /dev/null @@ -1,35 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup glue_toeplitz -//! @{ - - - -class glue_toeplitz - : public traits_glue_default - { - public: - - template inline static void apply(Mat& out, const Glue& in); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_toeplitz_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_toeplitz_meat.hpp deleted file mode 100644 index 6b9df9689..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_toeplitz_meat.hpp +++ /dev/null @@ -1,73 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup glue_toeplitz -//! @{ - - - -template -inline -void -glue_toeplitz::apply(Mat& out, const Glue& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_check tmp1(in.A, out); - const unwrap_check tmp2(in.B, out); - - const Mat& A = tmp1.M; - const Mat& B = tmp2.M; - - arma_conform_check - ( - ( ((A.is_vec() == false) && (A.is_empty() == false)) || ((B.is_vec() == false) && (B.is_empty() == false)) ), - "toeplitz(): given object must be a vector" - ); - - const uword A_N = A.n_elem; - const uword B_N = B.n_elem; - - const eT* A_mem = A.memptr(); - const eT* B_mem = B.memptr(); - - out.set_size(A_N, B_N); - - if( out.is_empty() ) { return; } - - for(uword col=0; col < B_N; ++col) - { - eT* col_mem = out.colptr(col); - - uword i = 0; - for(uword row=col; row < A_N; ++row, ++i) { col_mem[row] = A_mem[i]; } - } - - for(uword row=0; row < A_N; ++row) - { - uword i = 1; - for(uword col=(row+1); col < B_N; ++col, ++i) { out.at(row,col) = B_mem[i]; } - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_trapz_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_trapz_bones.hpp deleted file mode 100644 index 8b3019a1f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_trapz_bones.hpp +++ /dev/null @@ -1,56 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup glue_trapz -//! @{ - - - -class glue_trapz - { - public: - - template - struct traits - { - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = true; - }; - - template inline static void apply(Mat& out, const Glue& in); - - template inline static void apply_noalias(Mat& out, const Mat& X, const Mat& Y, const uword dim); - }; - - - -class op_trapz - : public traits_op_xvec - { - public: - - template inline static void apply(Mat& out, const Op& in); - - template inline static void apply_noalias(Mat& out, const Mat& Y, const uword dim); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_trapz_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_trapz_meat.hpp deleted file mode 100644 index de35f0ea7..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/glue_trapz_meat.hpp +++ /dev/null @@ -1,168 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup glue_trapz -//! @{ - - - -template -inline -void -glue_trapz::apply(Mat& out, const Glue& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword dim = in.aux_uword; - - const quasi_unwrap UX(in.A); - const quasi_unwrap UY(in.B); - - if( UX.is_alias(out) || UY.is_alias(out) ) - { - Mat tmp; - - glue_trapz::apply_noalias(tmp, UX.M, UY.M, dim); - - out.steal_mem(tmp); - } - else - { - glue_trapz::apply_noalias(out, UX.M, UY.M, dim); - } - } - - - -template -inline -void -glue_trapz::apply_noalias(Mat& out, const Mat& X, const Mat& Y, const uword dim) - { - arma_debug_sigprint(); - - arma_conform_check( (dim > 1), "trapz(): argument 'dim' must be 0 or 1" ); - - arma_conform_check( ((X.is_vec() == false) && (X.is_empty() == false)), "trapz(): argument 'X' must be a vector" ); - - const uword N = X.n_elem; - - if(dim == 0) - { - arma_conform_check( (N != Y.n_rows), "trapz(): length of X must equal the number of rows in Y when dim=0" ); - } - else - if(dim == 1) - { - arma_conform_check( (N != Y.n_cols), "trapz(): length of X must equal the number of columns in Y when dim=1" ); - } - - if(N <= 1) - { - if(dim == 0) { out.zeros(1, Y.n_cols); } - else if(dim == 1) { out.zeros(Y.n_rows, 1); } - - return; - } - - const Col vec_X( const_cast(X.memptr()), X.n_elem, false, true ); - - const Col diff_X = diff(vec_X); - - if(dim == 0) - { - const Row diff_X_t( const_cast(diff_X.memptr()), diff_X.n_elem, false, true ); - - out = diff_X_t * (0.5 * (Y.rows(0, N-2) + Y.rows(1, N-1))); - } - else - if(dim == 1) - { - out = (0.5 * (Y.cols(0, N-2) + Y.cols(1, N-1))) * diff_X; - } - } - - - -template -inline -void -op_trapz::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword dim = in.aux_uword_a; - - const quasi_unwrap UY(in.m); - - if(UY.is_alias(out)) - { - Mat tmp; - - op_trapz::apply_noalias(tmp, UY.M, dim); - - out.steal_mem(tmp); - } - else - { - op_trapz::apply_noalias(out, UY.M, dim); - } - } - - - -template -inline -void -op_trapz::apply_noalias(Mat& out, const Mat& Y, const uword dim) - { - arma_debug_sigprint(); - - arma_conform_check( (dim > 1), "trapz(): argument 'dim' must be 0 or 1" ); - - uword N = 0; - - if(dim == 0) { N = Y.n_rows; } - else if(dim == 1) { N = Y.n_cols; } - - if(N <= 1) - { - if(dim == 0) { out.zeros(1, Y.n_cols); } - else if(dim == 1) { out.zeros(Y.n_rows, 1); } - - return; - } - - if(dim == 0) - { - out = sum( (0.5 * (Y.rows(0, N-2) + Y.rows(1, N-1))), 0 ); - } - else - if(dim == 1) - { - out = sum( (0.5 * (Y.cols(0, N-2) + Y.cols(1, N-1))), 1 ); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/gmm_diag_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/gmm_diag_bones.hpp deleted file mode 100644 index 386a40d85..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/gmm_diag_bones.hpp +++ /dev/null @@ -1,179 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup gmm_diag -//! @{ - - -namespace gmm_priv -{ - -template -class gmm_diag - { - public: - - arma_aligned const Mat means; - arma_aligned const Mat dcovs; - arma_aligned const Row hefts; - - // - // - - inline ~gmm_diag(); - inline gmm_diag(); - - inline gmm_diag(const gmm_diag& x); - inline gmm_diag& operator=(const gmm_diag& x); - - inline explicit gmm_diag(const gmm_full& x); - inline gmm_diag& operator=(const gmm_full& x); - - inline gmm_diag(const uword in_n_dims, const uword in_n_gaus); - inline void reset(const uword in_n_dims, const uword in_n_gaus); - inline void reset(); - - template - inline void set_params(const Base& in_means, const Base& in_dcovs, const Base& in_hefts); - - template inline void set_means(const Base& in_means); - template inline void set_dcovs(const Base& in_dcovs); - template inline void set_hefts(const Base& in_hefts); - - inline uword n_dims() const; - inline uword n_gaus() const; - - inline bool load(const std::string name); - inline bool save(const std::string name) const; - - inline Col generate() const; - inline Mat generate(const uword N) const; - - template inline eT log_p(const T1& expr, const gmm_empty_arg& junk1 = gmm_empty_arg(), typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == true ))>::result* junk2 = nullptr) const; - template inline eT log_p(const T1& expr, const uword gaus_id, typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == true ))>::result* junk2 = nullptr) const; - - template inline Row log_p(const T1& expr, const gmm_empty_arg& junk1 = gmm_empty_arg(), typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == false))>::result* junk2 = nullptr) const; - template inline Row log_p(const T1& expr, const uword gaus_id, typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == false))>::result* junk2 = nullptr) const; - - template inline eT sum_log_p(const Base& expr) const; - template inline eT sum_log_p(const Base& expr, const uword gaus_id) const; - - template inline eT avg_log_p(const Base& expr) const; - template inline eT avg_log_p(const Base& expr, const uword gaus_id) const; - - template inline uword assign(const T1& expr, const gmm_dist_mode& dist, typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == true ))>::result* junk = nullptr) const; - template inline urowvec assign(const T1& expr, const gmm_dist_mode& dist, typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == false))>::result* junk = nullptr) const; - - template inline urowvec raw_hist(const Base& expr, const gmm_dist_mode& dist_mode) const; - template inline Row norm_hist(const Base& expr, const gmm_dist_mode& dist_mode) const; - - template - inline - bool - learn - ( - const Base& data, - const uword n_gaus, - const gmm_dist_mode& dist_mode, - const gmm_seed_mode& seed_mode, - const uword km_iter, - const uword em_iter, - const eT var_floor, - const bool print_mode - ); - - - template - inline - bool - kmeans_wrapper - ( - Mat& user_means, - const Base& data, - const uword n_gaus, - const gmm_seed_mode& seed_mode, - const uword km_iter, - const bool print_mode - ); - - - // - - protected: - - arma_aligned Mat inv_dcovs; - arma_aligned Row log_det_etc; - arma_aligned Row log_hefts; - arma_aligned Col mah_aux; - - // - - inline void init(const gmm_diag& x); - inline void init(const gmm_full& x); - - inline void init(const uword in_n_dim, const uword in_n_gaus); - - inline void init_constants(); - - inline umat internal_gen_boundaries(const uword N) const; - - inline eT internal_scalar_log_p(const eT* x ) const; - inline eT internal_scalar_log_p(const eT* x, const uword gaus_id) const; - - inline Row internal_vec_log_p(const Mat& X ) const; - inline Row internal_vec_log_p(const Mat& X, const uword gaus_id) const; - - inline eT internal_sum_log_p(const Mat& X ) const; - inline eT internal_sum_log_p(const Mat& X, const uword gaus_id) const; - - inline eT internal_avg_log_p(const Mat& X ) const; - inline eT internal_avg_log_p(const Mat& X, const uword gaus_id) const; - - inline uword internal_scalar_assign(const Mat& X, const gmm_dist_mode& dist_mode) const; - - inline void internal_vec_assign(urowvec& out, const Mat& X, const gmm_dist_mode& dist_mode) const; - - inline void internal_raw_hist(urowvec& hist, const Mat& X, const gmm_dist_mode& dist_mode) const; - - // - - template inline void generate_initial_means(const Mat& X, const gmm_seed_mode& seed); - - template inline void generate_initial_params(const Mat& X, const eT var_floor); - - template inline bool km_iterate(const Mat& X, const uword max_iter, const bool verbose, const char* signature); - - // - - inline bool em_iterate(const Mat& X, const uword max_iter, const eT var_floor, const bool verbose); - - inline void em_update_params(const Mat& X, const umat& boundaries, field< Mat >& t_acc_means, field< Mat >& t_acc_dcovs, field< Col >& t_acc_norm_lhoods, field< Col >& t_gaus_log_lhoods, Col& t_progress_log_lhoods); - - inline void em_generate_acc(const Mat& X, const uword start_index, const uword end_index, Mat& acc_means, Mat& acc_dcovs, Col& acc_norm_lhoods, Col& gaus_log_lhoods, eT& progress_log_lhood) const; - - inline void em_fix_params(const eT var_floor); - }; - -} - - -typedef gmm_priv::gmm_diag gmm_diag; -typedef gmm_priv::gmm_diag fgmm_diag; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/gmm_diag_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/gmm_diag_meat.hpp deleted file mode 100644 index 185f892a3..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/gmm_diag_meat.hpp +++ /dev/null @@ -1,2655 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup gmm_diag -//! @{ - - -namespace gmm_priv -{ - - -template -inline -gmm_diag::~gmm_diag() - { - arma_debug_sigprint_this(this); - - arma_type_check(( (is_same_type::value == false) && (is_same_type::value == false) )); - } - - - -template -inline -gmm_diag::gmm_diag() - { - arma_debug_sigprint_this(this); - } - - - -template -inline -gmm_diag::gmm_diag(const gmm_diag& x) - { - arma_debug_sigprint_this(this); - - init(x); - } - - - -template -inline -gmm_diag& -gmm_diag::operator=(const gmm_diag& x) - { - arma_debug_sigprint(); - - init(x); - - return *this; - } - - - -template -inline -gmm_diag::gmm_diag(const gmm_full& x) - { - arma_debug_sigprint_this(this); - - init(x); - } - - - -template -inline -gmm_diag& -gmm_diag::operator=(const gmm_full& x) - { - arma_debug_sigprint(); - - init(x); - - return *this; - } - - - -template -inline -gmm_diag::gmm_diag(const uword in_n_dims, const uword in_n_gaus) - { - arma_debug_sigprint_this(this); - - init(in_n_dims, in_n_gaus); - } - - - -template -inline -void -gmm_diag::reset() - { - arma_debug_sigprint(); - - init(0, 0); - } - - - -template -inline -void -gmm_diag::reset(const uword in_n_dims, const uword in_n_gaus) - { - arma_debug_sigprint(); - - init(in_n_dims, in_n_gaus); - } - - - -template -template -inline -void -gmm_diag::set_params(const Base& in_means_expr, const Base& in_dcovs_expr, const Base& in_hefts_expr) - { - arma_debug_sigprint(); - - const unwrap tmp1(in_means_expr.get_ref()); - const unwrap tmp2(in_dcovs_expr.get_ref()); - const unwrap tmp3(in_hefts_expr.get_ref()); - - const Mat& in_means = tmp1.M; - const Mat& in_dcovs = tmp2.M; - const Mat& in_hefts = tmp3.M; - - arma_conform_check - ( - (arma::size(in_means) != arma::size(in_dcovs)) || (in_hefts.n_cols != in_means.n_cols) || (in_hefts.n_rows != 1), - "gmm_diag::set_params(): given parameters have inconsistent and/or wrong sizes" - ); - - arma_conform_check( (in_means.internal_has_nonfinite()), "gmm_diag::set_params(): given means have non-finite values" ); - arma_conform_check( (in_dcovs.internal_has_nonfinite()), "gmm_diag::set_params(): given dcovs have non-finite values" ); - arma_conform_check( (in_hefts.internal_has_nonfinite()), "gmm_diag::set_params(): given hefts have non-finite values" ); - - arma_conform_check( (any(vectorise(in_dcovs) <= eT(0))), "gmm_diag::set_params(): given dcovs have negative or zero values" ); - arma_conform_check( (any(vectorise(in_hefts) < eT(0))), "gmm_diag::set_params(): given hefts have negative values" ); - - const eT s = accu(in_hefts); - - arma_conform_check( ((s < (eT(1) - eT(0.001))) || (s > (eT(1) + eT(0.001)))), "gmm_diag::set_params(): sum of given hefts is not 1" ); - - access::rw(means) = in_means; - access::rw(dcovs) = in_dcovs; - access::rw(hefts) = in_hefts; - - init_constants(); - } - - - -template -template -inline -void -gmm_diag::set_means(const Base& in_means_expr) - { - arma_debug_sigprint(); - - const unwrap tmp(in_means_expr.get_ref()); - - const Mat& in_means = tmp.M; - - arma_conform_check( (arma::size(in_means) != arma::size(means)), "gmm_diag::set_means(): given means have incompatible size" ); - arma_conform_check( (in_means.internal_has_nonfinite()), "gmm_diag::set_means(): given means have non-finite values" ); - - access::rw(means) = in_means; - } - - - -template -template -inline -void -gmm_diag::set_dcovs(const Base& in_dcovs_expr) - { - arma_debug_sigprint(); - - const unwrap tmp(in_dcovs_expr.get_ref()); - - const Mat& in_dcovs = tmp.M; - - arma_conform_check( (arma::size(in_dcovs) != arma::size(dcovs)), "gmm_diag::set_dcovs(): given dcovs have incompatible size" ); - arma_conform_check( (in_dcovs.internal_has_nonfinite()), "gmm_diag::set_dcovs(): given dcovs have non-finite values" ); - arma_conform_check( (any(vectorise(in_dcovs) <= eT(0))), "gmm_diag::set_dcovs(): given dcovs have negative or zero values" ); - - access::rw(dcovs) = in_dcovs; - - init_constants(); - } - - - -template -template -inline -void -gmm_diag::set_hefts(const Base& in_hefts_expr) - { - arma_debug_sigprint(); - - const unwrap tmp(in_hefts_expr.get_ref()); - - const Mat& in_hefts = tmp.M; - - arma_conform_check( (arma::size(in_hefts) != arma::size(hefts)), "gmm_diag::set_hefts(): given hefts have incompatible size" ); - arma_conform_check( (in_hefts.internal_has_nonfinite()), "gmm_diag::set_hefts(): given hefts have non-finite values" ); - arma_conform_check( (any(vectorise(in_hefts) < eT(0))), "gmm_diag::set_hefts(): given hefts have negative values" ); - - const eT s = accu(in_hefts); - - arma_conform_check( ((s < (eT(1) - eT(0.001))) || (s > (eT(1) + eT(0.001)))), "gmm_diag::set_hefts(): sum of given hefts is not 1" ); - - // make sure all hefts are positive and non-zero - - const eT* in_hefts_mem = in_hefts.memptr(); - eT* hefts_mem = access::rw(hefts).memptr(); - - for(uword i=0; i < hefts.n_elem; ++i) - { - hefts_mem[i] = (std::max)( in_hefts_mem[i], std::numeric_limits::min() ); - } - - access::rw(hefts) /= accu(hefts); - - log_hefts = log(hefts); - } - - - -template -inline -uword -gmm_diag::n_dims() const - { - return means.n_rows; - } - - - -template -inline -uword -gmm_diag::n_gaus() const - { - return means.n_cols; - } - - - -template -inline -bool -gmm_diag::load(const std::string name) - { - arma_debug_sigprint(); - - Cube Q; - - bool status = Q.load(name, arma_binary); - - if( (status == false) || (Q.n_slices != 2) ) - { - reset(); - arma_warn(3, "gmm_diag::load(): problem with loading or incompatible format"); - return false; - } - - if( (Q.n_rows < 2) || (Q.n_cols < 1) ) - { - reset(); - return true; - } - - access::rw(hefts) = Q.slice(0).row(0); - access::rw(means) = Q.slice(0).submat(1, 0, Q.n_rows-1, Q.n_cols-1); - access::rw(dcovs) = Q.slice(1).submat(1, 0, Q.n_rows-1, Q.n_cols-1); - - init_constants(); - - return true; - } - - - -template -inline -bool -gmm_diag::save(const std::string name) const - { - arma_debug_sigprint(); - - Cube Q(means.n_rows + 1, means.n_cols, 2, arma_nozeros_indicator()); - - if(Q.n_elem > 0) - { - Q.slice(0).row(0) = hefts; - Q.slice(1).row(0).zeros(); // reserved for future use - - Q.slice(0).submat(1, 0, arma::size(means)) = means; - Q.slice(1).submat(1, 0, arma::size(dcovs)) = dcovs; - } - - const bool status = Q.save(name, arma_binary); - - return status; - } - - - -template -inline -Col -gmm_diag::generate() const - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - Col out( ((N_gaus > 0) ? N_dims : uword(0)), fill::randn ); - - if(N_gaus > 0) - { - const double val = randu(); - - double csum = double(0); - uword gaus_id = 0; - - for(uword j=0; j < N_gaus; ++j) - { - csum += hefts[j]; - - if(val <= csum) { gaus_id = j; break; } - } - - out %= sqrt(dcovs.col(gaus_id)); - out += means.col(gaus_id); - } - - return out; - } - - - -template -inline -Mat -gmm_diag::generate(const uword N_vec) const - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - Mat out( ( (N_gaus > 0) ? N_dims : uword(0) ), N_vec, fill::randn ); - - if(N_gaus > 0) - { - const eT* hefts_mem = hefts.memptr(); - - const Mat sqrt_dcovs = sqrt(dcovs); - - for(uword i=0; i < N_vec; ++i) - { - const double val = randu(); - - double csum = double(0); - uword gaus_id = 0; - - for(uword j=0; j < N_gaus; ++j) - { - csum += hefts_mem[j]; - - if(val <= csum) { gaus_id = j; break; } - } - - subview_col out_col = out.col(i); - - out_col %= sqrt_dcovs.col(gaus_id); - out_col += means.col(gaus_id); - } - } - - return out; - } - - - -template -template -inline -eT -gmm_diag::log_p(const T1& expr, const gmm_empty_arg& junk1, typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == true))>::result* junk2) const - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - const quasi_unwrap tmp(expr); - - arma_conform_check( (tmp.M.n_rows != means.n_rows), "gmm_diag::log_p(): incompatible dimensions" ); - - return internal_scalar_log_p( tmp.M.memptr() ); - } - - - -template -template -inline -eT -gmm_diag::log_p(const T1& expr, const uword gaus_id, typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == true))>::result* junk2) const - { - arma_debug_sigprint(); - arma_ignore(junk2); - - const quasi_unwrap tmp(expr); - - arma_conform_check( (tmp.M.n_rows != means.n_rows), "gmm_diag::log_p(): incompatible dimensions" ); - - arma_conform_check( (gaus_id >= means.n_cols), "gmm_diag::log_p(): specified gaussian is out of range" ); - - return internal_scalar_log_p( tmp.M.memptr(), gaus_id ); - } - - - -template -template -inline -Row -gmm_diag::log_p(const T1& expr, const gmm_empty_arg& junk1, typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == false))>::result* junk2) const - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - const quasi_unwrap tmp(expr); - - const Mat& X = tmp.M; - - return internal_vec_log_p(X); - } - - - -template -template -inline -Row -gmm_diag::log_p(const T1& expr, const uword gaus_id, typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == false))>::result* junk2) const - { - arma_debug_sigprint(); - arma_ignore(junk2); - - const quasi_unwrap tmp(expr); - - const Mat& X = tmp.M; - - return internal_vec_log_p(X, gaus_id); - } - - - -template -template -inline -eT -gmm_diag::sum_log_p(const Base& expr) const - { - arma_debug_sigprint(); - - const quasi_unwrap tmp(expr.get_ref()); - - const Mat& X = tmp.M; - - return internal_sum_log_p(X); - } - - - -template -template -inline -eT -gmm_diag::sum_log_p(const Base& expr, const uword gaus_id) const - { - arma_debug_sigprint(); - - const quasi_unwrap tmp(expr.get_ref()); - - const Mat& X = tmp.M; - - return internal_sum_log_p(X, gaus_id); - } - - - -template -template -inline -eT -gmm_diag::avg_log_p(const Base& expr) const - { - arma_debug_sigprint(); - - const quasi_unwrap tmp(expr.get_ref()); - - const Mat& X = tmp.M; - - return internal_avg_log_p(X); - } - - - -template -template -inline -eT -gmm_diag::avg_log_p(const Base& expr, const uword gaus_id) const - { - arma_debug_sigprint(); - - const quasi_unwrap tmp(expr.get_ref()); - - const Mat& X = tmp.M; - - return internal_avg_log_p(X, gaus_id); - } - - - -template -template -inline -uword -gmm_diag::assign(const T1& expr, const gmm_dist_mode& dist, typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == true))>::result* junk) const - { - arma_debug_sigprint(); - arma_ignore(junk); - - const quasi_unwrap tmp(expr); - - const Mat& X = tmp.M; - - return internal_scalar_assign(X, dist); - } - - - -template -template -inline -urowvec -gmm_diag::assign(const T1& expr, const gmm_dist_mode& dist, typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == false))>::result* junk) const - { - arma_debug_sigprint(); - arma_ignore(junk); - - urowvec out; - - const quasi_unwrap tmp(expr); - - const Mat& X = tmp.M; - - internal_vec_assign(out, X, dist); - - return out; - } - - - -template -template -inline -urowvec -gmm_diag::raw_hist(const Base& expr, const gmm_dist_mode& dist_mode) const - { - arma_debug_sigprint(); - - const unwrap tmp(expr.get_ref()); - const Mat& X = tmp.M; - - arma_conform_check( (X.n_rows != means.n_rows), "gmm_diag::raw_hist(): incompatible dimensions" ); - - arma_conform_check( ((dist_mode != eucl_dist) && (dist_mode != prob_dist)), "gmm_diag::raw_hist(): unsupported distance mode" ); - - urowvec hist; - - internal_raw_hist(hist, X, dist_mode); - - return hist; - } - - - -template -template -inline -Row -gmm_diag::norm_hist(const Base& expr, const gmm_dist_mode& dist_mode) const - { - arma_debug_sigprint(); - - const unwrap tmp(expr.get_ref()); - const Mat& X = tmp.M; - - arma_conform_check( (X.n_rows != means.n_rows), "gmm_diag::norm_hist(): incompatible dimensions" ); - - arma_conform_check( ((dist_mode != eucl_dist) && (dist_mode != prob_dist)), "gmm_diag::norm_hist(): unsupported distance mode" ); - - urowvec hist; - - internal_raw_hist(hist, X, dist_mode); - - const uword hist_n_elem = hist.n_elem; - const uword* hist_mem = hist.memptr(); - - eT acc = eT(0); - for(uword i=0; i out(hist_n_elem, arma_nozeros_indicator()); - - eT* out_mem = out.memptr(); - - for(uword i=0; i -template -inline -bool -gmm_diag::learn - ( - const Base& data, - const uword N_gaus, - const gmm_dist_mode& dist_mode, - const gmm_seed_mode& seed_mode, - const uword km_iter, - const uword em_iter, - const eT var_floor, - const bool print_mode - ) - { - arma_debug_sigprint(); - - const bool dist_mode_ok = (dist_mode == eucl_dist) || (dist_mode == maha_dist); - - const bool seed_mode_ok = \ - (seed_mode == keep_existing) - || (seed_mode == static_subset) - || (seed_mode == static_spread) - || (seed_mode == random_subset) - || (seed_mode == random_spread); - - arma_conform_check( (dist_mode_ok == false), "gmm_diag::learn(): dist_mode must be eucl_dist or maha_dist" ); - arma_conform_check( (seed_mode_ok == false), "gmm_diag::learn(): unknown seed_mode" ); - arma_conform_check( (var_floor < eT(0) ), "gmm_diag::learn(): variance floor is negative" ); - - const unwrap tmp_X(data.get_ref()); - const Mat& X = tmp_X.M; - - if(X.is_empty() ) { arma_warn(3, "gmm_diag::learn(): given matrix is empty" ); return false; } - if(X.internal_has_nonfinite()) { arma_warn(3, "gmm_diag::learn(): given matrix has non-finite values"); return false; } - - if(N_gaus == 0) { reset(); return true; } - - if(dist_mode == maha_dist) - { - mah_aux = var(X,1,1); - - const uword mah_aux_n_elem = mah_aux.n_elem; - eT* mah_aux_mem = mah_aux.memptr(); - - for(uword i=0; i < mah_aux_n_elem; ++i) - { - const eT val = mah_aux_mem[i]; - - mah_aux_mem[i] = ((val != eT(0)) && arma_isfinite(val)) ? eT(1) / val : eT(1); - } - } - - - // copy current model, in case of failure by k-means and/or EM - - const gmm_diag orig = (*this); - - - // initial means - - if(seed_mode == keep_existing) - { - if(means.is_empty() ) { arma_warn(3, "gmm_diag::learn(): no existing means" ); return false; } - if(X.n_rows != means.n_rows) { arma_warn(3, "gmm_diag::learn(): dimensionality mismatch"); return false; } - - // TODO: also check for number of vectors? - } - else - { - if(X.n_cols < N_gaus) { arma_warn(3, "gmm_diag::learn(): number of vectors is less than number of gaussians"); return false; } - - reset(X.n_rows, N_gaus); - - if(print_mode) { get_cout_stream() << "gmm_diag::learn(): generating initial means\n"; get_cout_stream().flush(); } - - if(dist_mode == eucl_dist) { generate_initial_means<1>(X, seed_mode); } - else if(dist_mode == maha_dist) { generate_initial_means<2>(X, seed_mode); } - } - - - // k-means - - if(km_iter > 0) - { - const arma_ostream_state stream_state(get_cout_stream()); - - bool status = false; - - if(dist_mode == eucl_dist) { status = km_iterate<1>(X, km_iter, print_mode, "gmm_diag::learn(): k-means"); } - else if(dist_mode == maha_dist) { status = km_iterate<2>(X, km_iter, print_mode, "gmm_diag::learn(): k-means"); } - - stream_state.restore(get_cout_stream()); - - if(status == false) { arma_warn(3, "gmm_diag::learn(): k-means algorithm failed; not enough data, or too many gaussians requested"); init(orig); return false; } - } - - - // initial dcovs - - const eT var_floor_actual = (eT(var_floor) > eT(0)) ? eT(var_floor) : std::numeric_limits::min(); - - if(seed_mode != keep_existing) - { - if(print_mode) { get_cout_stream() << "gmm_diag::learn(): generating initial covariances\n"; get_cout_stream().flush(); } - - if(dist_mode == eucl_dist) { generate_initial_params<1>(X, var_floor_actual); } - else if(dist_mode == maha_dist) { generate_initial_params<2>(X, var_floor_actual); } - } - - - // EM algorithm - - if(em_iter > 0) - { - const arma_ostream_state stream_state(get_cout_stream()); - - const bool status = em_iterate(X, em_iter, var_floor_actual, print_mode); - - stream_state.restore(get_cout_stream()); - - if(status == false) { arma_warn(3, "gmm_diag::learn(): EM algorithm failed"); init(orig); return false; } - } - - mah_aux.reset(); - - init_constants(); - - return true; - } - - - -template -template -inline -bool -gmm_diag::kmeans_wrapper - ( - Mat& user_means, - const Base& data, - const uword N_gaus, - const gmm_seed_mode& seed_mode, - const uword km_iter, - const bool print_mode - ) - { - arma_debug_sigprint(); - - const bool seed_mode_ok = \ - (seed_mode == keep_existing) - || (seed_mode == static_subset) - || (seed_mode == static_spread) - || (seed_mode == random_subset) - || (seed_mode == random_spread); - - arma_conform_check( (seed_mode_ok == false), "kmeans(): unknown seed_mode" ); - - const unwrap tmp_X(data.get_ref()); - const Mat& X = tmp_X.M; - - if(X.is_empty() ) { arma_warn(3, "kmeans(): given matrix is empty" ); return false; } - if(X.internal_has_nonfinite()) { arma_warn(3, "kmeans(): given matrix has non-finite values"); return false; } - - if(N_gaus == 0) { reset(); return true; } - - - // initial means - - if(seed_mode == keep_existing) - { - access::rw(means) = user_means; - - if(means.is_empty() ) { arma_warn(3, "kmeans(): no existing means" ); return false; } - if(X.n_rows != means.n_rows) { arma_warn(3, "kmeans(): dimensionality mismatch"); return false; } - - // TODO: also check for number of vectors? - } - else - { - if(X.n_cols < N_gaus) { arma_warn(3, "kmeans(): number of vectors is less than number of means"); return false; } - - access::rw(means).zeros(X.n_rows, N_gaus); - - if(print_mode) { get_cout_stream() << "kmeans(): generating initial means\n"; } - - generate_initial_means<1>(X, seed_mode); - } - - - // k-means - - if(km_iter > 0) - { - const arma_ostream_state stream_state(get_cout_stream()); - - bool status = false; - - status = km_iterate<1>(X, km_iter, print_mode, "kmeans()"); - - stream_state.restore(get_cout_stream()); - - if(status == false) { arma_warn(3, "kmeans(): clustering failed; not enough data, or too many means requested"); return false; } - } - - return true; - } - - - -// -// -// - - - -template -inline -void -gmm_diag::init(const gmm_diag& x) - { - arma_debug_sigprint(); - - gmm_diag& t = *this; - - if(&t != &x) - { - access::rw(t.means) = x.means; - access::rw(t.dcovs) = x.dcovs; - access::rw(t.hefts) = x.hefts; - - init_constants(); - } - } - - - -template -inline -void -gmm_diag::init(const gmm_full& x) - { - arma_debug_sigprint(); - - access::rw(hefts) = x.hefts; - access::rw(means) = x.means; - - const uword N_dims = x.means.n_rows; - const uword N_gaus = x.means.n_cols; - - access::rw(dcovs).zeros(N_dims,N_gaus); - - for(uword g=0; g < N_gaus; ++g) - { - const Mat& fcov = x.fcovs.slice(g); - - eT* dcov_mem = access::rw(dcovs).colptr(g); - - for(uword d=0; d < N_dims; ++d) - { - dcov_mem[d] = fcov.at(d,d); - } - } - - init_constants(); - } - - - -template -inline -void -gmm_diag::init(const uword in_n_dims, const uword in_n_gaus) - { - arma_debug_sigprint(); - - access::rw(means).zeros(in_n_dims, in_n_gaus); - - access::rw(dcovs).ones(in_n_dims, in_n_gaus); - - access::rw(hefts).set_size(in_n_gaus); - - access::rw(hefts).fill(eT(1) / eT(in_n_gaus)); - - init_constants(); - } - - - -template -inline -void -gmm_diag::init_constants() - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - // - - inv_dcovs.copy_size(dcovs); - - const eT* dcovs_mem = dcovs.memptr(); - eT* inv_dcovs_mem = inv_dcovs.memptr(); - - const uword dcovs_n_elem = dcovs.n_elem; - - for(uword i=0; i < dcovs_n_elem; ++i) - { - inv_dcovs_mem[i] = eT(1) / (std::max)( dcovs_mem[i], std::numeric_limits::min() ); - } - - // - - const eT tmp = (eT(N_dims)/eT(2)) * std::log(Datum::tau); - - log_det_etc.set_size(N_gaus); - - for(uword g=0; g < N_gaus; ++g) - { - const eT* dcovs_colmem = dcovs.colptr(g); - - eT log_det_val = eT(0); - - for(uword d=0; d < N_dims; ++d) - { - log_det_val += std::log( (std::max)( dcovs_colmem[d], std::numeric_limits::min() ) ); - } - - log_det_etc[g] = eT(-1) * ( tmp + eT(0.5) * log_det_val ); - } - - // - - eT* hefts_mem = access::rw(hefts).memptr(); - - for(uword g=0; g < N_gaus; ++g) - { - hefts_mem[g] = (std::max)( hefts_mem[g], std::numeric_limits::min() ); - } - - log_hefts = log(hefts); - } - - - -template -inline -umat -gmm_diag::internal_gen_boundaries(const uword N) const - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_OPENMP) - const uword n_threads_avail = (omp_in_parallel()) ? uword(1) : uword(omp_get_max_threads()); - const uword n_threads = (n_threads_avail > 0) ? ( (n_threads_avail <= N) ? n_threads_avail : 1 ) : 1; - #else - static constexpr uword n_threads = 1; - #endif - - // get_cout_stream() << "gmm_diag::internal_gen_boundaries(): n_threads: " << n_threads << '\n'; - - umat boundaries(2, n_threads, arma_nozeros_indicator()); - - if(N > 0) - { - const uword chunk_size = N / n_threads; - - uword count = 0; - - for(uword t=0; t -inline -eT -gmm_diag::internal_scalar_log_p(const eT* x) const - { - arma_debug_sigprint(); - - const eT* log_hefts_mem = log_hefts.mem; - - const uword N_gaus = means.n_cols; - - if(N_gaus > 0) - { - eT log_sum = internal_scalar_log_p(x, 0) + log_hefts_mem[0]; - - for(uword g=1; g < N_gaus; ++g) - { - const eT tmp = internal_scalar_log_p(x, g) + log_hefts_mem[g]; - - log_sum = log_add_exp(log_sum, tmp); - } - - return log_sum; - } - else - { - return -Datum::inf; - } - } - - - -template -inline -eT -gmm_diag::internal_scalar_log_p(const eT* x, const uword g) const - { - arma_debug_sigprint(); - - const eT* mean = means.colptr(g); - const eT* inv_dcov = inv_dcovs.colptr(g); - - const uword N_dims = means.n_rows; - - eT val_i = eT(0); - eT val_j = eT(0); - - uword i,j; - - for(i=0, j=1; j -inline -Row -gmm_diag::internal_vec_log_p(const Mat& X) const - { - arma_debug_sigprint(); - - arma_conform_check( (X.n_rows != means.n_rows), "gmm_diag::log_p(): incompatible dimensions" ); - - const uword N = X.n_cols; - - Row out(N, arma_nozeros_indicator()); - - if(N > 0) - { - #if defined(ARMA_USE_OPENMP) - { - const umat boundaries = internal_gen_boundaries(N); - - const uword n_threads = boundaries.n_cols; - - #pragma omp parallel for schedule(static) - for(uword t=0; t < n_threads; ++t) - { - const uword start_index = boundaries.at(0,t); - const uword end_index = boundaries.at(1,t); - - eT* out_mem = out.memptr(); - - for(uword i=start_index; i <= end_index; ++i) - { - out_mem[i] = internal_scalar_log_p( X.colptr(i) ); - } - } - } - #else - { - eT* out_mem = out.memptr(); - - for(uword i=0; i < N; ++i) - { - out_mem[i] = internal_scalar_log_p( X.colptr(i) ); - } - } - #endif - } - - return out; - } - - - -template -inline -Row -gmm_diag::internal_vec_log_p(const Mat& X, const uword gaus_id) const - { - arma_debug_sigprint(); - - arma_conform_check( (X.n_rows != means.n_rows), "gmm_diag::log_p(): incompatible dimensions" ); - arma_conform_check( (gaus_id >= means.n_cols), "gmm_diag::log_p(): specified gaussian is out of range" ); - - const uword N = X.n_cols; - - Row out(N, arma_nozeros_indicator()); - - if(N > 0) - { - #if defined(ARMA_USE_OPENMP) - { - const umat boundaries = internal_gen_boundaries(N); - - const uword n_threads = boundaries.n_cols; - - #pragma omp parallel for schedule(static) - for(uword t=0; t < n_threads; ++t) - { - const uword start_index = boundaries.at(0,t); - const uword end_index = boundaries.at(1,t); - - eT* out_mem = out.memptr(); - - for(uword i=start_index; i <= end_index; ++i) - { - out_mem[i] = internal_scalar_log_p( X.colptr(i), gaus_id ); - } - } - } - #else - { - eT* out_mem = out.memptr(); - - for(uword i=0; i < N; ++i) - { - out_mem[i] = internal_scalar_log_p( X.colptr(i), gaus_id ); - } - } - #endif - } - - return out; - } - - - -template -inline -eT -gmm_diag::internal_sum_log_p(const Mat& X) const - { - arma_debug_sigprint(); - - arma_conform_check( (X.n_rows != means.n_rows), "gmm_diag::sum_log_p(): incompatible dimensions" ); - - const uword N = X.n_cols; - - if(N == 0) { return (-Datum::inf); } - - - #if defined(ARMA_USE_OPENMP) - { - const umat boundaries = internal_gen_boundaries(N); - - const uword n_threads = boundaries.n_cols; - - Col t_accs(n_threads, arma_zeros_indicator()); - - #pragma omp parallel for schedule(static) - for(uword t=0; t < n_threads; ++t) - { - const uword start_index = boundaries.at(0,t); - const uword end_index = boundaries.at(1,t); - - eT t_acc = eT(0); - - for(uword i=start_index; i <= end_index; ++i) - { - t_acc += internal_scalar_log_p( X.colptr(i) ); - } - - t_accs[t] = t_acc; - } - - return eT(accu(t_accs)); - } - #else - { - eT acc = eT(0); - - for(uword i=0; i -inline -eT -gmm_diag::internal_sum_log_p(const Mat& X, const uword gaus_id) const - { - arma_debug_sigprint(); - - arma_conform_check( (X.n_rows != means.n_rows), "gmm_diag::sum_log_p(): incompatible dimensions" ); - arma_conform_check( (gaus_id >= means.n_cols), "gmm_diag::sum_log_p(): specified gaussian is out of range" ); - - const uword N = X.n_cols; - - if(N == 0) { return (-Datum::inf); } - - - #if defined(ARMA_USE_OPENMP) - { - const umat boundaries = internal_gen_boundaries(N); - - const uword n_threads = boundaries.n_cols; - - Col t_accs(n_threads, arma_zeros_indicator()); - - #pragma omp parallel for schedule(static) - for(uword t=0; t < n_threads; ++t) - { - const uword start_index = boundaries.at(0,t); - const uword end_index = boundaries.at(1,t); - - eT t_acc = eT(0); - - for(uword i=start_index; i <= end_index; ++i) - { - t_acc += internal_scalar_log_p( X.colptr(i), gaus_id ); - } - - t_accs[t] = t_acc; - } - - return eT(accu(t_accs)); - } - #else - { - eT acc = eT(0); - - for(uword i=0; i -inline -eT -gmm_diag::internal_avg_log_p(const Mat& X) const - { - arma_debug_sigprint(); - - arma_conform_check( (X.n_rows != means.n_rows), "gmm_diag::avg_log_p(): incompatible dimensions" ); - - const uword N = X.n_cols; - - if(N == 0) { return (-Datum::inf); } - - - #if defined(ARMA_USE_OPENMP) - { - const umat boundaries = internal_gen_boundaries(N); - - const uword n_threads = boundaries.n_cols; - - field< running_mean_scalar > t_running_means(n_threads); - - - #pragma omp parallel for schedule(static) - for(uword t=0; t < n_threads; ++t) - { - const uword start_index = boundaries.at(0,t); - const uword end_index = boundaries.at(1,t); - - running_mean_scalar& current_running_mean = t_running_means[t]; - - for(uword i=start_index; i <= end_index; ++i) - { - current_running_mean( internal_scalar_log_p( X.colptr(i) ) ); - } - } - - - eT avg = eT(0); - - for(uword t=0; t < n_threads; ++t) - { - running_mean_scalar& current_running_mean = t_running_means[t]; - - const eT w = eT(current_running_mean.count()) / eT(N); - - avg += w * current_running_mean.mean(); - } - - return avg; - } - #else - { - running_mean_scalar running_mean; - - for(uword i=0; i -inline -eT -gmm_diag::internal_avg_log_p(const Mat& X, const uword gaus_id) const - { - arma_debug_sigprint(); - - arma_conform_check( (X.n_rows != means.n_rows), "gmm_diag::avg_log_p(): incompatible dimensions" ); - arma_conform_check( (gaus_id >= means.n_cols), "gmm_diag::avg_log_p(): specified gaussian is out of range" ); - - const uword N = X.n_cols; - - if(N == 0) { return (-Datum::inf); } - - - #if defined(ARMA_USE_OPENMP) - { - const umat boundaries = internal_gen_boundaries(N); - - const uword n_threads = boundaries.n_cols; - - field< running_mean_scalar > t_running_means(n_threads); - - - #pragma omp parallel for schedule(static) - for(uword t=0; t < n_threads; ++t) - { - const uword start_index = boundaries.at(0,t); - const uword end_index = boundaries.at(1,t); - - running_mean_scalar& current_running_mean = t_running_means[t]; - - for(uword i=start_index; i <= end_index; ++i) - { - current_running_mean( internal_scalar_log_p( X.colptr(i), gaus_id) ); - } - } - - - eT avg = eT(0); - - for(uword t=0; t < n_threads; ++t) - { - running_mean_scalar& current_running_mean = t_running_means[t]; - - const eT w = eT(current_running_mean.count()) / eT(N); - - avg += w * current_running_mean.mean(); - } - - return avg; - } - #else - { - running_mean_scalar running_mean; - - for(uword i=0; i -inline -uword -gmm_diag::internal_scalar_assign(const Mat& X, const gmm_dist_mode& dist_mode) const - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - arma_conform_check( (X.n_rows != N_dims), "gmm_diag::assign(): incompatible dimensions" ); - arma_conform_check( (N_gaus == 0), "gmm_diag::assign(): model has no means" ); - - const eT* X_mem = X.colptr(0); - - if(dist_mode == eucl_dist) - { - eT best_dist = Datum::inf; - uword best_g = 0; - - for(uword g=0; g < N_gaus; ++g) - { - const eT tmp_dist = distance::eval(N_dims, X_mem, means.colptr(g), X_mem); - - if(tmp_dist <= best_dist) { best_dist = tmp_dist; best_g = g; } - } - - return best_g; - } - else - if(dist_mode == prob_dist) - { - const eT* log_hefts_mem = log_hefts.memptr(); - - eT best_p = -Datum::inf; - uword best_g = 0; - - for(uword g=0; g < N_gaus; ++g) - { - const eT tmp_p = internal_scalar_log_p(X_mem, g) + log_hefts_mem[g]; - - if(tmp_p >= best_p) { best_p = tmp_p; best_g = g; } - } - - return best_g; - } - else - { - arma_conform_check(true, "gmm_diag::assign(): unsupported distance mode"); - } - - return uword(0); - } - - - -template -inline -void -gmm_diag::internal_vec_assign(urowvec& out, const Mat& X, const gmm_dist_mode& dist_mode) const - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - arma_conform_check( (X.n_rows != N_dims), "gmm_diag::assign(): incompatible dimensions" ); - - const uword X_n_cols = (N_gaus > 0) ? X.n_cols : 0; - - out.set_size(1,X_n_cols); - - uword* out_mem = out.memptr(); - - if(dist_mode == eucl_dist) - { - #if defined(ARMA_USE_OPENMP) - { - #pragma omp parallel for schedule(static) - for(uword i=0; i::inf; - uword best_g = 0; - - for(uword g=0; g::eval(N_dims, X_colptr, means.colptr(g), X_colptr); - - if(tmp_dist <= best_dist) { best_dist = tmp_dist; best_g = g; } - } - - out_mem[i] = best_g; - } - } - #else - { - for(uword i=0; i::inf; - uword best_g = 0; - - for(uword g=0; g::eval(N_dims, X_colptr, means.colptr(g), X_colptr); - - if(tmp_dist <= best_dist) { best_dist = tmp_dist; best_g = g; } - } - - out_mem[i] = best_g; - } - } - #endif - } - else - if(dist_mode == prob_dist) - { - #if defined(ARMA_USE_OPENMP) - { - const eT* log_hefts_mem = log_hefts.memptr(); - - #pragma omp parallel for schedule(static) - for(uword i=0; i::inf; - uword best_g = 0; - - for(uword g=0; g= best_p) { best_p = tmp_p; best_g = g; } - } - - out_mem[i] = best_g; - } - } - #else - { - const eT* log_hefts_mem = log_hefts.memptr(); - - for(uword i=0; i::inf; - uword best_g = 0; - - for(uword g=0; g= best_p) { best_p = tmp_p; best_g = g; } - } - - out_mem[i] = best_g; - } - } - #endif - } - else - { - arma_conform_check(true, "gmm_diag::assign(): unsupported distance mode"); - } - } - - - - -template -inline -void -gmm_diag::internal_raw_hist(urowvec& hist, const Mat& X, const gmm_dist_mode& dist_mode) const - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - const uword X_n_cols = X.n_cols; - - hist.zeros(N_gaus); - - if(N_gaus == 0) { return; } - - #if defined(ARMA_USE_OPENMP) - { - const umat boundaries = internal_gen_boundaries(X_n_cols); - - const uword n_threads = boundaries.n_cols; - - field thread_hist(n_threads); - - for(uword t=0; t < n_threads; ++t) { thread_hist(t).zeros(N_gaus); } - - - if(dist_mode == eucl_dist) - { - #pragma omp parallel for schedule(static) - for(uword t=0; t < n_threads; ++t) - { - uword* thread_hist_mem = thread_hist(t).memptr(); - - const uword start_index = boundaries.at(0,t); - const uword end_index = boundaries.at(1,t); - - for(uword i=start_index; i <= end_index; ++i) - { - const eT* X_colptr = X.colptr(i); - - eT best_dist = Datum::inf; - uword best_g = 0; - - for(uword g=0; g < N_gaus; ++g) - { - const eT tmp_dist = distance::eval(N_dims, X_colptr, means.colptr(g), X_colptr); - - if(tmp_dist <= best_dist) { best_dist = tmp_dist; best_g = g; } - } - - thread_hist_mem[best_g]++; - } - } - } - else - if(dist_mode == prob_dist) - { - const eT* log_hefts_mem = log_hefts.memptr(); - - #pragma omp parallel for schedule(static) - for(uword t=0; t < n_threads; ++t) - { - uword* thread_hist_mem = thread_hist(t).memptr(); - - const uword start_index = boundaries.at(0,t); - const uword end_index = boundaries.at(1,t); - - for(uword i=start_index; i <= end_index; ++i) - { - const eT* X_colptr = X.colptr(i); - - eT best_p = -Datum::inf; - uword best_g = 0; - - for(uword g=0; g < N_gaus; ++g) - { - const eT tmp_p = internal_scalar_log_p(X_colptr, g) + log_hefts_mem[g]; - - if(tmp_p >= best_p) { best_p = tmp_p; best_g = g; } - } - - thread_hist_mem[best_g]++; - } - } - } - - // reduction - hist = thread_hist(0); - - for(uword t=1; t < n_threads; ++t) - { - hist += thread_hist(t); - } - } - #else - { - uword* hist_mem = hist.memptr(); - - if(dist_mode == eucl_dist) - { - for(uword i=0; i::inf; - uword best_g = 0; - - for(uword g=0; g < N_gaus; ++g) - { - const eT tmp_dist = distance::eval(N_dims, X_colptr, means.colptr(g), X_colptr); - - if(tmp_dist <= best_dist) { best_dist = tmp_dist; best_g = g; } - } - - hist_mem[best_g]++; - } - } - else - if(dist_mode == prob_dist) - { - const eT* log_hefts_mem = log_hefts.memptr(); - - for(uword i=0; i::inf; - uword best_g = 0; - - for(uword g=0; g < N_gaus; ++g) - { - const eT tmp_p = internal_scalar_log_p(X_colptr, g) + log_hefts_mem[g]; - - if(tmp_p >= best_p) { best_p = tmp_p; best_g = g; } - } - - hist_mem[best_g]++; - } - } - } - #endif - } - - - -template -template -inline -void -gmm_diag::generate_initial_means(const Mat& X, const gmm_seed_mode& seed_mode) - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - if( (seed_mode == static_subset) || (seed_mode == random_subset) ) - { - uvec initial_indices; - - if(seed_mode == static_subset) { initial_indices = linspace(0, X.n_cols-1, N_gaus); } - else if(seed_mode == random_subset) { initial_indices = randperm(X.n_cols, N_gaus); } - - // initial_indices.print("initial_indices:"); - - access::rw(means) = X.cols(initial_indices); - } - else - if( (seed_mode == static_spread) || (seed_mode == random_spread) ) - { - // going through all of the samples can be extremely time consuming; - // instead, if there are enough samples, randomly choose samples with probability 0.1 - - const bool use_sampling = ((X.n_cols/uword(100)) > N_gaus); - const uword step = (use_sampling) ? uword(10) : uword(1); - - uword start_index = 0; - - if(seed_mode == static_spread) { start_index = X.n_cols / 2; } - else if(seed_mode == random_spread) { start_index = as_scalar(randi(1, distr_param(0,X.n_cols-1))); } - - access::rw(means).col(0) = X.unsafe_col(start_index); - - const eT* mah_aux_mem = mah_aux.memptr(); - - running_stat rs; - - for(uword g=1; g < N_gaus; ++g) - { - eT max_dist = eT(0); - uword best_i = uword(0); - uword start_i = uword(0); - - if(use_sampling) - { - uword start_i_proposed = uword(0); - - if(seed_mode == static_spread) { start_i_proposed = g % uword(10); } - if(seed_mode == random_spread) { start_i_proposed = as_scalar(randi(1, distr_param(0,9))); } - - if(start_i_proposed < X.n_cols) { start_i = start_i_proposed; } - } - - - for(uword i=start_i; i < X.n_cols; i += step) - { - rs.reset(); - - const eT* X_colptr = X.colptr(i); - - bool ignore_i = false; - - // find the average distance between sample i and the means so far - for(uword h = 0; h < g; ++h) - { - const eT dist = distance::eval(N_dims, X_colptr, means.colptr(h), mah_aux_mem); - - // ignore sample already selected as a mean - if(dist == eT(0)) { ignore_i = true; break; } - else { rs(dist); } - } - - if( (rs.mean() >= max_dist) && (ignore_i == false)) - { - max_dist = eT(rs.mean()); best_i = i; - } - } - - // set the mean to the sample that is the furthest away from the means so far - access::rw(means).col(g) = X.unsafe_col(best_i); - } - } - - // get_cout_stream() << "generate_initial_means():" << '\n'; - // means.print(); - } - - - -template -template -inline -void -gmm_diag::generate_initial_params(const Mat& X, const eT var_floor) - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - const eT* mah_aux_mem = mah_aux.memptr(); - - const uword X_n_cols = X.n_cols; - - if(X_n_cols == 0) { return; } - - // as the covariances are calculated via accumulators, - // the means also need to be calculated via accumulators to ensure numerical consistency - - Mat acc_means(N_dims, N_gaus, arma_zeros_indicator()); - Mat acc_dcovs(N_dims, N_gaus, arma_zeros_indicator()); - - Row acc_hefts(N_gaus, arma_zeros_indicator()); - - uword* acc_hefts_mem = acc_hefts.memptr(); - - #if defined(ARMA_USE_OPENMP) - { - const umat boundaries = internal_gen_boundaries(X_n_cols); - - const uword n_threads = boundaries.n_cols; - - field< Mat > t_acc_means(n_threads); - field< Mat > t_acc_dcovs(n_threads); - field< Row > t_acc_hefts(n_threads); - - for(uword t=0; t < n_threads; ++t) - { - t_acc_means(t).zeros(N_dims, N_gaus); - t_acc_dcovs(t).zeros(N_dims, N_gaus); - t_acc_hefts(t).zeros(N_gaus); - } - - #pragma omp parallel for schedule(static) - for(uword t=0; t < n_threads; ++t) - { - uword* t_acc_hefts_mem = t_acc_hefts(t).memptr(); - - const uword start_index = boundaries.at(0,t); - const uword end_index = boundaries.at(1,t); - - for(uword i=start_index; i <= end_index; ++i) - { - const eT* X_colptr = X.colptr(i); - - eT min_dist = Datum::inf; - uword best_g = 0; - - for(uword g=0; g::eval(N_dims, X_colptr, means.colptr(g), mah_aux_mem); - - if(dist < min_dist) { min_dist = dist; best_g = g; } - } - - eT* t_acc_mean = t_acc_means(t).colptr(best_g); - eT* t_acc_dcov = t_acc_dcovs(t).colptr(best_g); - - for(uword d=0; d::inf; - uword best_g = 0; - - for(uword g=0; g::eval(N_dims, X_colptr, means.colptr(g), mah_aux_mem); - - if(dist < min_dist) { min_dist = dist; best_g = g; } - } - - eT* acc_mean = acc_means.colptr(best_g); - eT* acc_dcov = acc_dcovs.colptr(best_g); - - for(uword d=0; d= 1) ? tmp : eT(0); - dcov[d] = (acc_heft >= 2) ? eT((acc_dcov[d] / eT(acc_heft)) - (tmp*tmp)) : eT(var_floor); - } - - hefts_mem[g] = eT(acc_heft) / eT(X_n_cols); - } - - em_fix_params(var_floor); - } - - - -//! multi-threaded implementation of k-means, inspired by MapReduce -template -template -inline -bool -gmm_diag::km_iterate(const Mat& X, const uword max_iter, const bool verbose, const char* signature) - { - arma_debug_sigprint(); - - if(verbose) - { - get_cout_stream().unsetf(ios::showbase); - get_cout_stream().unsetf(ios::uppercase); - get_cout_stream().unsetf(ios::showpos); - get_cout_stream().unsetf(ios::scientific); - - get_cout_stream().setf(ios::right); - get_cout_stream().setf(ios::fixed); - } - - const uword X_n_cols = X.n_cols; - - if(X_n_cols == 0) { return true; } - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - const eT* mah_aux_mem = mah_aux.memptr(); - - Mat acc_means(N_dims, N_gaus, arma_zeros_indicator()); - Row acc_hefts( N_gaus, arma_zeros_indicator()); - Row last_indx( N_gaus, arma_zeros_indicator()); - - Mat new_means = means; - Mat old_means = means; - - running_mean_scalar rs_delta; - - #if defined(ARMA_USE_OPENMP) - const umat boundaries = internal_gen_boundaries(X_n_cols); - const uword n_threads = boundaries.n_cols; - - field< Mat > t_acc_means(n_threads); - field< Row > t_acc_hefts(n_threads); - field< Row > t_last_indx(n_threads); - #else - const uword n_threads = 1; - #endif - - if(verbose) { get_cout_stream() << signature << ": n_threads: " << n_threads << '\n'; get_cout_stream().flush(); } - - for(uword iter=1; iter <= max_iter; ++iter) - { - #if defined(ARMA_USE_OPENMP) - { - for(uword t=0; t < n_threads; ++t) - { - t_acc_means(t).zeros(N_dims, N_gaus); - t_acc_hefts(t).zeros(N_gaus); - t_last_indx(t).zeros(N_gaus); - } - - #pragma omp parallel for schedule(static) - for(uword t=0; t < n_threads; ++t) - { - Mat& t_acc_means_t = t_acc_means(t); - uword* t_acc_hefts_mem = t_acc_hefts(t).memptr(); - uword* t_last_indx_mem = t_last_indx(t).memptr(); - - const uword start_index = boundaries.at(0,t); - const uword end_index = boundaries.at(1,t); - - for(uword i=start_index; i <= end_index; ++i) - { - const eT* X_colptr = X.colptr(i); - - eT min_dist = Datum::inf; - uword best_g = 0; - - for(uword g=0; g::eval(N_dims, X_colptr, old_means.colptr(g), mah_aux_mem); - - if(dist < min_dist) { min_dist = dist; best_g = g; } - } - - eT* t_acc_mean = t_acc_means_t.colptr(best_g); - - for(uword d=0; d= 1 ) { last_indx(g) = t_last_indx(t)(g); } - } - } - #else - { - acc_hefts.zeros(); - acc_means.zeros(); - last_indx.zeros(); - - uword* acc_hefts_mem = acc_hefts.memptr(); - uword* last_indx_mem = last_indx.memptr(); - - for(uword i=0; i < X_n_cols; ++i) - { - const eT* X_colptr = X.colptr(i); - - eT min_dist = Datum::inf; - uword best_g = 0; - - for(uword g=0; g::eval(N_dims, X_colptr, old_means.colptr(g), mah_aux_mem); - - if(dist < min_dist) { min_dist = dist; best_g = g; } - } - - eT* acc_mean = acc_means.colptr(best_g); - - for(uword d=0; d= 1) ? (acc_mean[d] / eT(acc_heft)) : eT(0); - } - } - - - // heuristics to resurrect dead means - - const uvec dead_gs = find(acc_hefts == uword(0)); - - if(dead_gs.n_elem > 0) - { - if(verbose) { get_cout_stream() << signature << ": recovering from dead means\n"; get_cout_stream().flush(); } - - uword* last_indx_mem = last_indx.memptr(); - - const uvec live_gs = sort( find(acc_hefts >= uword(2)), "descend" ); - - if(live_gs.n_elem == 0) { return false; } - - uword live_gs_count = 0; - - for(uword dead_gs_count = 0; dead_gs_count < dead_gs.n_elem; ++dead_gs_count) - { - const uword dead_g_id = dead_gs(dead_gs_count); - - uword proposed_i = 0; - - if(live_gs_count < live_gs.n_elem) - { - const uword live_g_id = live_gs(live_gs_count); ++live_gs_count; - - if(live_g_id == dead_g_id) { return false; } - - // recover by using a sample from a known good mean - proposed_i = last_indx_mem[live_g_id]; - } - else - { - // recover by using a randomly seleced sample (last resort) - proposed_i = as_scalar(randi(1, distr_param(0,X_n_cols-1))); - } - - if(proposed_i >= X_n_cols) { return false; } - - new_means.col(dead_g_id) = X.col(proposed_i); - } - } - - rs_delta.reset(); - - for(uword g=0; g < N_gaus; ++g) - { - rs_delta( distance::eval(N_dims, old_means.colptr(g), new_means.colptr(g), mah_aux_mem) ); - } - - if(verbose) - { - get_cout_stream() << signature << ": iteration: "; - get_cout_stream().unsetf(ios::scientific); - get_cout_stream().setf(ios::fixed); - get_cout_stream().width(std::streamsize(4)); - get_cout_stream() << iter; - get_cout_stream() << " delta: "; - get_cout_stream().unsetf(ios::fixed); - //get_cout_stream().setf(ios::scientific); - get_cout_stream() << rs_delta.mean() << '\n'; - get_cout_stream().flush(); - } - - arma::swap(old_means, new_means); - - if(rs_delta.mean() <= Datum::eps) { break; } - } - - access::rw(means) = old_means; - - if(means.internal_has_nonfinite()) { return false; } - - return true; - } - - - -//! multi-threaded implementation of Expectation-Maximisation, inspired by MapReduce -template -inline -bool -gmm_diag::em_iterate(const Mat& X, const uword max_iter, const eT var_floor, const bool verbose) - { - arma_debug_sigprint(); - - if(X.n_cols == 0) { return true; } - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - if(verbose) - { - get_cout_stream().unsetf(ios::showbase); - get_cout_stream().unsetf(ios::uppercase); - get_cout_stream().unsetf(ios::showpos); - get_cout_stream().unsetf(ios::scientific); - - get_cout_stream().setf(ios::right); - get_cout_stream().setf(ios::fixed); - } - - const umat boundaries = internal_gen_boundaries(X.n_cols); - - const uword n_threads = boundaries.n_cols; - - field< Mat > t_acc_means(n_threads); - field< Mat > t_acc_dcovs(n_threads); - - field< Col > t_acc_norm_lhoods(n_threads); - field< Col > t_gaus_log_lhoods(n_threads); - - Col t_progress_log_lhood(n_threads, arma_nozeros_indicator()); - - for(uword t=0; t::inf; - - for(uword iter=1; iter <= max_iter; ++iter) - { - init_constants(); - - em_update_params(X, boundaries, t_acc_means, t_acc_dcovs, t_acc_norm_lhoods, t_gaus_log_lhoods, t_progress_log_lhood); - - em_fix_params(var_floor); - - const eT new_avg_log_p = accu(t_progress_log_lhood) / eT(t_progress_log_lhood.n_elem); - - if(verbose) - { - get_cout_stream() << "gmm_diag::learn(): EM: iteration: "; - get_cout_stream().unsetf(ios::scientific); - get_cout_stream().setf(ios::fixed); - get_cout_stream().width(std::streamsize(4)); - get_cout_stream() << iter; - get_cout_stream() << " avg_log_p: "; - get_cout_stream().unsetf(ios::fixed); - //get_cout_stream().setf(ios::scientific); - get_cout_stream() << new_avg_log_p << '\n'; - get_cout_stream().flush(); - } - - if(arma_isfinite(new_avg_log_p) == false) { return false; } - - if(std::abs(old_avg_log_p - new_avg_log_p) <= Datum::eps) { break; } - - - old_avg_log_p = new_avg_log_p; - } - - - if(any(vectorise(dcovs) <= eT(0))) { return false; } - if(means.internal_has_nonfinite()) { return false; } - if(dcovs.internal_has_nonfinite()) { return false; } - if(hefts.internal_has_nonfinite()) { return false; } - - return true; - } - - - - -template -inline -void -gmm_diag::em_update_params - ( - const Mat& X, - const umat& boundaries, - field< Mat >& t_acc_means, - field< Mat >& t_acc_dcovs, - field< Col >& t_acc_norm_lhoods, - field< Col >& t_gaus_log_lhoods, - Col& t_progress_log_lhood - ) - { - arma_debug_sigprint(); - - const uword n_threads = boundaries.n_cols; - - - // em_generate_acc() is the "map" operation, which produces partial accumulators for means, diagonal covariances and hefts - - #if defined(ARMA_USE_OPENMP) - { - #pragma omp parallel for schedule(static) - for(uword t=0; t& acc_means = t_acc_means[t]; - Mat& acc_dcovs = t_acc_dcovs[t]; - Col& acc_norm_lhoods = t_acc_norm_lhoods[t]; - Col& gaus_log_lhoods = t_gaus_log_lhoods[t]; - eT& progress_log_lhood = t_progress_log_lhood[t]; - - em_generate_acc(X, boundaries.at(0,t), boundaries.at(1,t), acc_means, acc_dcovs, acc_norm_lhoods, gaus_log_lhoods, progress_log_lhood); - } - } - #else - { - em_generate_acc(X, boundaries.at(0,0), boundaries.at(1,0), t_acc_means[0], t_acc_dcovs[0], t_acc_norm_lhoods[0], t_gaus_log_lhoods[0], t_progress_log_lhood[0]); - } - #endif - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - Mat& final_acc_means = t_acc_means[0]; - Mat& final_acc_dcovs = t_acc_dcovs[0]; - - Col& final_acc_norm_lhoods = t_acc_norm_lhoods[0]; - - - // the "reduce" operation, which combines the partial accumulators produced by the separate threads - - for(uword t=1; t::min() ); - // - // eT* mean_mem = access::rw(means).colptr(g); - // eT* dcov_mem = access::rw(dcovs).colptr(g); - // - // eT* acc_mean_mem = final_acc_means.colptr(g); - // eT* acc_dcov_mem = final_acc_dcovs.colptr(g); - // - // hefts_mem[g] = acc_norm_lhood / eT(X.n_cols); - // - // for(uword d=0; d < N_dims; ++d) - // { - // const eT tmp = acc_mean_mem[d] / acc_norm_lhood; - // - // mean_mem[d] = tmp; - // dcov_mem[d] = acc_dcov_mem[d] / acc_norm_lhood - tmp*tmp; - // } - // } - - - // conditionally update each component; if only a subset of the hefts was updated, em_fix_params() will sanitise them - for(uword g=0; g < N_gaus; ++g) - { - const eT acc_norm_lhood = (std::max)( final_acc_norm_lhoods[g], std::numeric_limits::min() ); - - if(arma_isfinite(acc_norm_lhood) == false) { continue; } - - eT* acc_mean_mem = final_acc_means.colptr(g); - eT* acc_dcov_mem = final_acc_dcovs.colptr(g); - - bool ok = true; - - for(uword d=0; d < N_dims; ++d) - { - const eT tmp1 = acc_mean_mem[d] / acc_norm_lhood; - const eT tmp2 = acc_dcov_mem[d] / acc_norm_lhood - tmp1*tmp1; - - acc_mean_mem[d] = tmp1; - acc_dcov_mem[d] = tmp2; - - if(arma_isfinite(tmp2) == false) { ok = false; } - } - - - if(ok) - { - hefts_mem[g] = acc_norm_lhood / eT(X.n_cols); - - eT* mean_mem = access::rw(means).colptr(g); - eT* dcov_mem = access::rw(dcovs).colptr(g); - - for(uword d=0; d < N_dims; ++d) - { - mean_mem[d] = acc_mean_mem[d]; - dcov_mem[d] = acc_dcov_mem[d]; - } - } - } - } - - - -template -inline -void -gmm_diag::em_generate_acc - ( - const Mat& X, - const uword start_index, - const uword end_index, - Mat& acc_means, - Mat& acc_dcovs, - Col& acc_norm_lhoods, - Col& gaus_log_lhoods, - eT& progress_log_lhood - ) - const - { - arma_debug_sigprint(); - - progress_log_lhood = eT(0); - - acc_means.zeros(); - acc_dcovs.zeros(); - - acc_norm_lhoods.zeros(); - gaus_log_lhoods.zeros(); - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - const eT* log_hefts_mem = log_hefts.memptr(); - eT* gaus_log_lhoods_mem = gaus_log_lhoods.memptr(); - - - for(uword i=start_index; i <= end_index; i++) - { - const eT* x = X.colptr(i); - - for(uword g=0; g < N_gaus; ++g) - { - gaus_log_lhoods_mem[g] = internal_scalar_log_p(x, g) + log_hefts_mem[g]; - } - - eT log_lhood_sum = gaus_log_lhoods_mem[0]; - - for(uword g=1; g < N_gaus; ++g) - { - log_lhood_sum = log_add_exp(log_lhood_sum, gaus_log_lhoods_mem[g]); - } - - progress_log_lhood += log_lhood_sum; - - for(uword g=0; g < N_gaus; ++g) - { - const eT norm_lhood = std::exp(gaus_log_lhoods_mem[g] - log_lhood_sum); - - acc_norm_lhoods[g] += norm_lhood; - - eT* acc_mean_mem = acc_means.colptr(g); - eT* acc_dcov_mem = acc_dcovs.colptr(g); - - for(uword d=0; d < N_dims; ++d) - { - const eT x_d = x[d]; - const eT y_d = x_d * norm_lhood; - - acc_mean_mem[d] += y_d; - acc_dcov_mem[d] += y_d * x_d; // equivalent to x_d * x_d * norm_lhood - } - } - } - - progress_log_lhood /= eT((end_index - start_index) + 1); - } - - - -template -inline -void -gmm_diag::em_fix_params(const eT var_floor) - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - const eT var_ceiling = std::numeric_limits::max(); - - const uword dcovs_n_elem = dcovs.n_elem; - eT* dcovs_mem = access::rw(dcovs).memptr(); - - for(uword i=0; i < dcovs_n_elem; ++i) - { - eT& var_val = dcovs_mem[i]; - - if(var_val < var_floor ) { var_val = var_floor; } - else if(var_val > var_ceiling) { var_val = var_ceiling; } - else if(arma_isnan(var_val) ) { var_val = eT(1); } - } - - - eT* hefts_mem = access::rw(hefts).memptr(); - - for(uword g1=0; g1 < N_gaus; ++g1) - { - if(hefts_mem[g1] > eT(0)) - { - const eT* means_colptr_g1 = means.colptr(g1); - - for(uword g2=(g1+1); g2 < N_gaus; ++g2) - { - if( (hefts_mem[g2] > eT(0)) && (std::abs(hefts_mem[g1] - hefts_mem[g2]) <= std::numeric_limits::epsilon()) ) - { - const eT dist = distance::eval(N_dims, means_colptr_g1, means.colptr(g2), means_colptr_g1); - - if(dist == eT(0)) { hefts_mem[g2] = eT(0); } - } - } - } - } - - const eT heft_floor = std::numeric_limits::min(); - const eT heft_initial = eT(1) / eT(N_gaus); - - for(uword i=0; i < N_gaus; ++i) - { - eT& heft_val = hefts_mem[i]; - - if(heft_val < heft_floor) { heft_val = heft_floor; } - else if(heft_val > eT(1) ) { heft_val = eT(1); } - else if(arma_isnan(heft_val) ) { heft_val = heft_initial; } - } - - const eT heft_sum = accu(hefts); - - if((heft_sum < (eT(1) - Datum::eps)) || (heft_sum > (eT(1) + Datum::eps))) { access::rw(hefts) /= heft_sum; } - } - - -} // namespace gmm_priv - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/gmm_full_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/gmm_full_bones.hpp deleted file mode 100644 index a842a62f0..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/gmm_full_bones.hpp +++ /dev/null @@ -1,167 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup gmm_full -//! @{ - - -namespace gmm_priv -{ - -template -class gmm_full - { - public: - - arma_aligned const Mat means; - arma_aligned const Cube fcovs; - arma_aligned const Row hefts; - - // - // - - inline ~gmm_full(); - inline gmm_full(); - - inline gmm_full(const gmm_full& x); - inline gmm_full& operator=(const gmm_full& x); - - inline explicit gmm_full(const gmm_diag& x); - inline gmm_full& operator=(const gmm_diag& x); - - inline gmm_full(const uword in_n_dims, const uword in_n_gaus); - inline void reset(const uword in_n_dims, const uword in_n_gaus); - inline void reset(); - - template - inline void set_params(const Base& in_means, const BaseCube& in_fcovs, const Base& in_hefts); - - template inline void set_means(const Base & in_means); - template inline void set_fcovs(const BaseCube& in_fcovs); - template inline void set_hefts(const Base & in_hefts); - - inline uword n_dims() const; - inline uword n_gaus() const; - - inline bool load(const std::string name); - inline bool save(const std::string name) const; - - inline Col generate() const; - inline Mat generate(const uword N) const; - - template inline eT log_p(const T1& expr, const gmm_empty_arg& junk1 = gmm_empty_arg(), typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == true ))>::result* junk2 = nullptr) const; - template inline eT log_p(const T1& expr, const uword gaus_id, typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == true ))>::result* junk2 = nullptr) const; - - template inline Row log_p(const T1& expr, const gmm_empty_arg& junk1 = gmm_empty_arg(), typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == false))>::result* junk2 = nullptr) const; - template inline Row log_p(const T1& expr, const uword gaus_id, typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == false))>::result* junk2 = nullptr) const; - - template inline eT sum_log_p(const Base& expr) const; - template inline eT sum_log_p(const Base& expr, const uword gaus_id) const; - - template inline eT avg_log_p(const Base& expr) const; - template inline eT avg_log_p(const Base& expr, const uword gaus_id) const; - - template inline uword assign(const T1& expr, const gmm_dist_mode& dist, typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == true ))>::result* junk = nullptr) const; - template inline urowvec assign(const T1& expr, const gmm_dist_mode& dist, typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == false))>::result* junk = nullptr) const; - - template inline urowvec raw_hist(const Base& expr, const gmm_dist_mode& dist_mode) const; - template inline Row norm_hist(const Base& expr, const gmm_dist_mode& dist_mode) const; - - template - inline - bool - learn - ( - const Base& data, - const uword n_gaus, - const gmm_dist_mode& dist_mode, - const gmm_seed_mode& seed_mode, - const uword km_iter, - const uword em_iter, - const eT var_floor, - const bool print_mode - ); - - - // - - protected: - - - arma_aligned Cube inv_fcovs; - arma_aligned Row log_det_etc; - arma_aligned Row log_hefts; - arma_aligned Col mah_aux; - arma_aligned Cube chol_fcovs; - - // - - inline void init(const gmm_full& x); - inline void init(const gmm_diag& x); - - inline void init(const uword in_n_dim, const uword in_n_gaus); - - inline void init_constants(const bool calc_chol = true); - - inline umat internal_gen_boundaries(const uword N) const; - - inline eT internal_scalar_log_p(const eT* x ) const; - inline eT internal_scalar_log_p(const eT* x, const uword gaus_id) const; - - inline Row internal_vec_log_p(const Mat& X ) const; - inline Row internal_vec_log_p(const Mat& X, const uword gaus_id) const; - - inline eT internal_sum_log_p(const Mat& X ) const; - inline eT internal_sum_log_p(const Mat& X, const uword gaus_id) const; - - inline eT internal_avg_log_p(const Mat& X ) const; - inline eT internal_avg_log_p(const Mat& X, const uword gaus_id) const; - - inline uword internal_scalar_assign(const Mat& X, const gmm_dist_mode& dist_mode) const; - - inline void internal_vec_assign(urowvec& out, const Mat& X, const gmm_dist_mode& dist_mode) const; - - inline void internal_raw_hist(urowvec& hist, const Mat& X, const gmm_dist_mode& dist_mode) const; - - // - - template inline void generate_initial_means(const Mat& X, const gmm_seed_mode& seed); - - template inline void generate_initial_params(const Mat& X, const eT var_floor); - - template inline bool km_iterate(const Mat& X, const uword max_iter, const bool verbose); - - // - - inline bool em_iterate(const Mat& X, const uword max_iter, const eT var_floor, const bool verbose); - - inline void em_update_params(const Mat& X, const umat& boundaries, field< Mat >& t_acc_means, field< Cube >& t_acc_fcovs, field< Col >& t_acc_norm_lhoods, field< Col >& t_gaus_log_lhoods, Col& t_progress_log_lhoods, const eT var_floor); - - inline void em_generate_acc(const Mat& X, const uword start_index, const uword end_index, Mat& acc_means, Cube& acc_fcovs, Col& acc_norm_lhoods, Col& gaus_log_lhoods, eT& progress_log_lhood) const; - - inline void em_fix_params(const eT var_floor); - }; - -} - - -typedef gmm_priv::gmm_full gmm_full; -typedef gmm_priv::gmm_full fgmm_full; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/gmm_full_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/gmm_full_meat.hpp deleted file mode 100644 index 6e9d1f7d1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/gmm_full_meat.hpp +++ /dev/null @@ -1,2739 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup gmm_full -//! @{ - - -namespace gmm_priv -{ - - -template -inline -gmm_full::~gmm_full() - { - arma_debug_sigprint_this(this); - - arma_type_check(( (is_same_type::value == false) && (is_same_type::value == false) )); - } - - - -template -inline -gmm_full::gmm_full() - { - arma_debug_sigprint_this(this); - } - - - -template -inline -gmm_full::gmm_full(const gmm_full& x) - { - arma_debug_sigprint_this(this); - - init(x); - } - - - -template -inline -gmm_full& -gmm_full::operator=(const gmm_full& x) - { - arma_debug_sigprint(); - - init(x); - - return *this; - } - - - -template -inline -gmm_full::gmm_full(const gmm_diag& x) - { - arma_debug_sigprint_this(this); - - init(x); - } - - - -template -inline -gmm_full& -gmm_full::operator=(const gmm_diag& x) - { - arma_debug_sigprint(); - - init(x); - - return *this; - } - - - -template -inline -gmm_full::gmm_full(const uword in_n_dims, const uword in_n_gaus) - { - arma_debug_sigprint_this(this); - - init(in_n_dims, in_n_gaus); - } - - - -template -inline -void -gmm_full::reset() - { - arma_debug_sigprint(); - - init(0, 0); - } - - - -template -inline -void -gmm_full::reset(const uword in_n_dims, const uword in_n_gaus) - { - arma_debug_sigprint(); - - init(in_n_dims, in_n_gaus); - } - - - -template -template -inline -void -gmm_full::set_params(const Base& in_means_expr, const BaseCube& in_fcovs_expr, const Base& in_hefts_expr) - { - arma_debug_sigprint(); - - const unwrap tmp1(in_means_expr.get_ref()); - const unwrap_cube tmp2(in_fcovs_expr.get_ref()); - const unwrap tmp3(in_hefts_expr.get_ref()); - - const Mat & in_means = tmp1.M; - const Cube& in_fcovs = tmp2.M; - const Mat & in_hefts = tmp3.M; - - arma_conform_check - ( - (in_means.n_cols != in_fcovs.n_slices) || (in_means.n_rows != in_fcovs.n_rows) || (in_fcovs.n_rows != in_fcovs.n_cols) || (in_hefts.n_cols != in_means.n_cols) || (in_hefts.n_rows != 1), - "gmm_full::set_params(): given parameters have inconsistent and/or wrong sizes" - ); - - arma_conform_check( (in_means.internal_has_nonfinite()), "gmm_full::set_params(): given means have non-finite values" ); - arma_conform_check( (in_fcovs.internal_has_nonfinite()), "gmm_full::set_params(): given fcovs have non-finite values" ); - arma_conform_check( (in_hefts.internal_has_nonfinite()), "gmm_full::set_params(): given hefts have non-finite values" ); - - for(uword g=0; g < in_fcovs.n_slices; ++g) - { - arma_conform_check( (any(diagvec(in_fcovs.slice(g)) <= eT(0))), "gmm_full::set_params(): given fcovs have negative or zero values on diagonals" ); - } - - arma_conform_check( (any(vectorise(in_hefts) < eT(0))), "gmm_full::set_params(): given hefts have negative values" ); - - const eT s = accu(in_hefts); - - arma_conform_check( ((s < (eT(1) - eT(0.001))) || (s > (eT(1) + eT(0.001)))), "gmm_full::set_params(): sum of given hefts is not 1" ); - - access::rw(means) = in_means; - access::rw(fcovs) = in_fcovs; - access::rw(hefts) = in_hefts; - - init_constants(); - } - - - -template -template -inline -void -gmm_full::set_means(const Base& in_means_expr) - { - arma_debug_sigprint(); - - const unwrap tmp(in_means_expr.get_ref()); - - const Mat& in_means = tmp.M; - - arma_conform_check( (arma::size(in_means) != arma::size(means)), "gmm_full::set_means(): given means have incompatible size" ); - arma_conform_check( (in_means.internal_has_nonfinite()), "gmm_full::set_means(): given means have non-finite values" ); - - access::rw(means) = in_means; - } - - - -template -template -inline -void -gmm_full::set_fcovs(const BaseCube& in_fcovs_expr) - { - arma_debug_sigprint(); - - const unwrap_cube tmp(in_fcovs_expr.get_ref()); - - const Cube& in_fcovs = tmp.M; - - arma_conform_check( (arma::size(in_fcovs) != arma::size(fcovs)), "gmm_full::set_fcovs(): given fcovs have incompatible size" ); - arma_conform_check( (in_fcovs.internal_has_nonfinite()), "gmm_full::set_fcovs(): given fcovs have non-finite values" ); - - for(uword i=0; i < in_fcovs.n_slices; ++i) - { - arma_conform_check( (any(diagvec(in_fcovs.slice(i)) <= eT(0))), "gmm_full::set_fcovs(): given fcovs have negative or zero values on diagonals" ); - } - - access::rw(fcovs) = in_fcovs; - - init_constants(); - } - - - -template -template -inline -void -gmm_full::set_hefts(const Base& in_hefts_expr) - { - arma_debug_sigprint(); - - const unwrap tmp(in_hefts_expr.get_ref()); - - const Mat& in_hefts = tmp.M; - - arma_conform_check( (arma::size(in_hefts) != arma::size(hefts)), "gmm_full::set_hefts(): given hefts have incompatible size" ); - arma_conform_check( (in_hefts.internal_has_nonfinite()), "gmm_full::set_hefts(): given hefts have non-finite values" ); - arma_conform_check( (any(vectorise(in_hefts) < eT(0))), "gmm_full::set_hefts(): given hefts have negative values" ); - - const eT s = accu(in_hefts); - - arma_conform_check( ((s < (eT(1) - eT(0.001))) || (s > (eT(1) + eT(0.001)))), "gmm_full::set_hefts(): sum of given hefts is not 1" ); - - // make sure all hefts are positive and non-zero - - const eT* in_hefts_mem = in_hefts.memptr(); - eT* hefts_mem = access::rw(hefts).memptr(); - - for(uword i=0; i < hefts.n_elem; ++i) - { - hefts_mem[i] = (std::max)( in_hefts_mem[i], std::numeric_limits::min() ); - } - - access::rw(hefts) /= accu(hefts); - - log_hefts = log(hefts); - } - - - -template -inline -uword -gmm_full::n_dims() const - { - return means.n_rows; - } - - - -template -inline -uword -gmm_full::n_gaus() const - { - return means.n_cols; - } - - - -template -inline -bool -gmm_full::load(const std::string name) - { - arma_debug_sigprint(); - - field< Mat > storage; - - bool status = storage.load(name, arma_binary); - - if( (status == false) || (storage.n_elem < 2) ) - { - reset(); - arma_warn(3, "gmm_full::load(): problem with loading or incompatible format"); - return false; - } - - uword count = 0; - - const Mat& storage_means = storage(count); ++count; - const Mat& storage_hefts = storage(count); ++count; - - const uword N_dims = storage_means.n_rows; - const uword N_gaus = storage_means.n_cols; - - if( (storage.n_elem != (N_gaus + 2)) || (storage_hefts.n_rows != 1) || (storage_hefts.n_cols != N_gaus) ) - { - reset(); - arma_warn(3, "gmm_full::load(): incompatible format"); - return false; - } - - reset(N_dims, N_gaus); - - access::rw(means) = storage_means; - access::rw(hefts) = storage_hefts; - - for(uword g=0; g < N_gaus; ++g) - { - const Mat& storage_fcov = storage(count); ++count; - - if( (storage_fcov.n_rows != N_dims) || (storage_fcov.n_cols != N_dims) ) - { - reset(); - arma_warn(3, "gmm_full::load(): incompatible format"); - return false; - } - - access::rw(fcovs).slice(g) = storage_fcov; - } - - init_constants(); - - return true; - } - - - -template -inline -bool -gmm_full::save(const std::string name) const - { - arma_debug_sigprint(); - - const uword N_gaus = means.n_cols; - - field< Mat > storage(2 + N_gaus); - - uword count = 0; - - storage(count) = means; ++count; - storage(count) = hefts; ++count; - - for(uword g=0; g < N_gaus; ++g) - { - storage(count) = fcovs.slice(g); ++count; - } - - const bool status = storage.save(name, arma_binary); - - return status; - } - - - -template -inline -Col -gmm_full::generate() const - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - Col out( (N_gaus > 0) ? N_dims : uword(0), arma_nozeros_indicator() ); - Col tmp( (N_gaus > 0) ? N_dims : uword(0), fill::randn ); - - if(N_gaus > 0) - { - const double val = randu(); - - double csum = double(0); - uword gaus_id = 0; - - for(uword j=0; j < N_gaus; ++j) - { - csum += hefts[j]; - - if(val <= csum) { gaus_id = j; break; } - } - - out = chol_fcovs.slice(gaus_id) * tmp; - out += means.col(gaus_id); - } - - return out; - } - - - -template -inline -Mat -gmm_full::generate(const uword N_vec) const - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - Mat out( ( (N_gaus > 0) ? N_dims : uword(0) ), N_vec, arma_nozeros_indicator() ); - Mat tmp( ( (N_gaus > 0) ? N_dims : uword(0) ), N_vec, fill::randn ); - - if(N_gaus > 0) - { - const eT* hefts_mem = hefts.memptr(); - - for(uword i=0; i < N_vec; ++i) - { - const double val = randu(); - - double csum = double(0); - uword gaus_id = 0; - - for(uword j=0; j < N_gaus; ++j) - { - csum += hefts_mem[j]; - - if(val <= csum) { gaus_id = j; break; } - } - - Col out_vec(out.colptr(i), N_dims, false, true); - Col tmp_vec(tmp.colptr(i), N_dims, false, true); - - out_vec = chol_fcovs.slice(gaus_id) * tmp_vec; - out_vec += means.col(gaus_id); - } - } - - return out; - } - - - -template -template -inline -eT -gmm_full::log_p(const T1& expr, const gmm_empty_arg& junk1, typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == true))>::result* junk2) const - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - const uword N_dims = means.n_rows; - - const quasi_unwrap U(expr); - - arma_conform_check( (U.M.n_rows != N_dims), "gmm_full::log_p(): incompatible dimensions" ); - - return internal_scalar_log_p( U.M.memptr() ); - } - - - -template -template -inline -eT -gmm_full::log_p(const T1& expr, const uword gaus_id, typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == true))>::result* junk2) const - { - arma_debug_sigprint(); - arma_ignore(junk2); - - const uword N_dims = means.n_rows; - - const quasi_unwrap U(expr); - - arma_conform_check( (U.M.n_rows != N_dims), "gmm_full::log_p(): incompatible dimensions" ); - arma_conform_check( (gaus_id >= means.n_cols), "gmm_full::log_p(): specified gaussian is out of range" ); - - return internal_scalar_log_p( U.M.memptr(), gaus_id ); - } - - - -template -template -inline -Row -gmm_full::log_p(const T1& expr, const gmm_empty_arg& junk1, typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == false))>::result* junk2) const - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - const quasi_unwrap tmp(expr); - - const Mat& X = tmp.M; - - return internal_vec_log_p(X); - } - - - -template -template -inline -Row -gmm_full::log_p(const T1& expr, const uword gaus_id, typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == false))>::result* junk2) const - { - arma_debug_sigprint(); - arma_ignore(junk2); - - const quasi_unwrap tmp(expr); - - const Mat& X = tmp.M; - - return internal_vec_log_p(X, gaus_id); - } - - - -template -template -inline -eT -gmm_full::sum_log_p(const Base& expr) const - { - arma_debug_sigprint(); - - const quasi_unwrap tmp(expr.get_ref()); - - const Mat& X = tmp.M; - - return internal_sum_log_p(X); - } - - - -template -template -inline -eT -gmm_full::sum_log_p(const Base& expr, const uword gaus_id) const - { - arma_debug_sigprint(); - - const quasi_unwrap tmp(expr.get_ref()); - - const Mat& X = tmp.M; - - return internal_sum_log_p(X, gaus_id); - } - - - -template -template -inline -eT -gmm_full::avg_log_p(const Base& expr) const - { - arma_debug_sigprint(); - - const quasi_unwrap tmp(expr.get_ref()); - - const Mat& X = tmp.M; - - return internal_avg_log_p(X); - } - - - -template -template -inline -eT -gmm_full::avg_log_p(const Base& expr, const uword gaus_id) const - { - arma_debug_sigprint(); - - const quasi_unwrap tmp(expr.get_ref()); - - const Mat& X = tmp.M; - - return internal_avg_log_p(X, gaus_id); - } - - - -template -template -inline -uword -gmm_full::assign(const T1& expr, const gmm_dist_mode& dist, typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == true))>::result* junk) const - { - arma_debug_sigprint(); - arma_ignore(junk); - - const quasi_unwrap tmp(expr); - - const Mat& X = tmp.M; - - return internal_scalar_assign(X, dist); - } - - - -template -template -inline -urowvec -gmm_full::assign(const T1& expr, const gmm_dist_mode& dist, typename enable_if<((is_arma_type::value) && (resolves_to_colvector::value == false))>::result* junk) const - { - arma_debug_sigprint(); - arma_ignore(junk); - - urowvec out; - - const quasi_unwrap tmp(expr); - - const Mat& X = tmp.M; - - internal_vec_assign(out, X, dist); - - return out; - } - - - -template -template -inline -urowvec -gmm_full::raw_hist(const Base& expr, const gmm_dist_mode& dist_mode) const - { - arma_debug_sigprint(); - - const unwrap tmp(expr.get_ref()); - const Mat& X = tmp.M; - - arma_conform_check( (X.n_rows != means.n_rows), "gmm_full::raw_hist(): incompatible dimensions" ); - - arma_conform_check( ((dist_mode != eucl_dist) && (dist_mode != prob_dist)), "gmm_full::raw_hist(): unsupported distance mode" ); - - urowvec hist; - - internal_raw_hist(hist, X, dist_mode); - - return hist; - } - - - -template -template -inline -Row -gmm_full::norm_hist(const Base& expr, const gmm_dist_mode& dist_mode) const - { - arma_debug_sigprint(); - - const unwrap tmp(expr.get_ref()); - const Mat& X = tmp.M; - - arma_conform_check( (X.n_rows != means.n_rows), "gmm_full::norm_hist(): incompatible dimensions" ); - - arma_conform_check( ((dist_mode != eucl_dist) && (dist_mode != prob_dist)), "gmm_full::norm_hist(): unsupported distance mode" ); - - urowvec hist; - - internal_raw_hist(hist, X, dist_mode); - - const uword hist_n_elem = hist.n_elem; - const uword* hist_mem = hist.memptr(); - - eT acc = eT(0); - for(uword i=0; i out(hist_n_elem, arma_nozeros_indicator()); - - eT* out_mem = out.memptr(); - - for(uword i=0; i -template -inline -bool -gmm_full::learn - ( - const Base& data, - const uword N_gaus, - const gmm_dist_mode& dist_mode, - const gmm_seed_mode& seed_mode, - const uword km_iter, - const uword em_iter, - const eT var_floor, - const bool print_mode - ) - { - arma_debug_sigprint(); - - const bool dist_mode_ok = (dist_mode == eucl_dist) || (dist_mode == maha_dist); - - const bool seed_mode_ok = \ - (seed_mode == keep_existing) - || (seed_mode == static_subset) - || (seed_mode == static_spread) - || (seed_mode == random_subset) - || (seed_mode == random_spread); - - arma_conform_check( (dist_mode_ok == false), "gmm_full::learn(): dist_mode must be eucl_dist or maha_dist" ); - arma_conform_check( (seed_mode_ok == false), "gmm_full::learn(): unknown seed_mode" ); - arma_conform_check( (var_floor < eT(0) ), "gmm_full::learn(): variance floor is negative" ); - - const unwrap tmp_X(data.get_ref()); - const Mat& X = tmp_X.M; - - if(X.is_empty() ) { arma_warn(3, "gmm_full::learn(): given matrix is empty" ); return false; } - if(X.internal_has_nonfinite()) { arma_warn(3, "gmm_full::learn(): given matrix has non-finite values"); return false; } - - if(N_gaus == 0) { reset(); return true; } - - if(dist_mode == maha_dist) - { - mah_aux = var(X,1,1); - - const uword mah_aux_n_elem = mah_aux.n_elem; - eT* mah_aux_mem = mah_aux.memptr(); - - for(uword i=0; i < mah_aux_n_elem; ++i) - { - const eT val = mah_aux_mem[i]; - - mah_aux_mem[i] = ((val != eT(0)) && arma_isfinite(val)) ? eT(1) / val : eT(1); - } - } - - - // copy current model, in case of failure by k-means and/or EM - - const gmm_full orig = (*this); - - - // initial means - - if(seed_mode == keep_existing) - { - if(means.is_empty() ) { arma_warn(3, "gmm_full::learn(): no existing means" ); return false; } - if(X.n_rows != means.n_rows) { arma_warn(3, "gmm_full::learn(): dimensionality mismatch"); return false; } - - // TODO: also check for number of vectors? - } - else - { - if(X.n_cols < N_gaus) { arma_warn(3, "gmm_full::learn(): number of vectors is less than number of gaussians"); return false; } - - reset(X.n_rows, N_gaus); - - if(print_mode) { get_cout_stream() << "gmm_full::learn(): generating initial means\n"; get_cout_stream().flush(); } - - if(dist_mode == eucl_dist) { generate_initial_means<1>(X, seed_mode); } - else if(dist_mode == maha_dist) { generate_initial_means<2>(X, seed_mode); } - } - - - // k-means - - if(km_iter > 0) - { - const arma_ostream_state stream_state(get_cout_stream()); - - bool status = false; - - if(dist_mode == eucl_dist) { status = km_iterate<1>(X, km_iter, print_mode); } - else if(dist_mode == maha_dist) { status = km_iterate<2>(X, km_iter, print_mode); } - - stream_state.restore(get_cout_stream()); - - if(status == false) { arma_warn(3, "gmm_full::learn(): k-means algorithm failed; not enough data, or too many gaussians requested"); init(orig); return false; } - } - - - // initial fcovs - - const eT var_floor_actual = (eT(var_floor) > eT(0)) ? eT(var_floor) : std::numeric_limits::min(); - - if(seed_mode != keep_existing) - { - if(print_mode) { get_cout_stream() << "gmm_full::learn(): generating initial covariances\n"; get_cout_stream().flush(); } - - if(dist_mode == eucl_dist) { generate_initial_params<1>(X, var_floor_actual); } - else if(dist_mode == maha_dist) { generate_initial_params<2>(X, var_floor_actual); } - } - - - // EM algorithm - - if(em_iter > 0) - { - const arma_ostream_state stream_state(get_cout_stream()); - - const bool status = em_iterate(X, em_iter, var_floor_actual, print_mode); - - stream_state.restore(get_cout_stream()); - - if(status == false) { arma_warn(3, "gmm_full::learn(): EM algorithm failed"); init(orig); return false; } - } - - mah_aux.reset(); - - init_constants(); - - return true; - } - - - -// -// -// - - - -template -inline -void -gmm_full::init(const gmm_full& x) - { - arma_debug_sigprint(); - - gmm_full& t = *this; - - if(&t != &x) - { - access::rw(t.means) = x.means; - access::rw(t.fcovs) = x.fcovs; - access::rw(t.hefts) = x.hefts; - - init_constants(); - } - } - - - -template -inline -void -gmm_full::init(const gmm_diag& x) - { - arma_debug_sigprint(); - - access::rw(hefts) = x.hefts; - access::rw(means) = x.means; - - const uword N_dims = x.means.n_rows; - const uword N_gaus = x.means.n_cols; - - access::rw(fcovs).zeros(N_dims,N_dims,N_gaus); - - for(uword g=0; g < N_gaus; ++g) - { - Mat& fcov = access::rw(fcovs).slice(g); - - const eT* dcov_mem = x.dcovs.colptr(g); - - for(uword d=0; d < N_dims; ++d) - { - fcov.at(d,d) = dcov_mem[d]; - } - } - - init_constants(); - } - - - -template -inline -void -gmm_full::init(const uword in_n_dims, const uword in_n_gaus) - { - arma_debug_sigprint(); - - access::rw(means).zeros(in_n_dims, in_n_gaus); - - access::rw(fcovs).zeros(in_n_dims, in_n_dims, in_n_gaus); - - for(uword g=0; g < in_n_gaus; ++g) - { - access::rw(fcovs).slice(g).diag().ones(); - } - - access::rw(hefts).set_size(in_n_gaus); - access::rw(hefts).fill(eT(1) / eT(in_n_gaus)); - - init_constants(); - } - - - -template -inline -void -gmm_full::init_constants(const bool calc_chol) - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - const eT tmp = (eT(N_dims)/eT(2)) * std::log(Datum::tau); - - // - - inv_fcovs.copy_size(fcovs); - log_det_etc.set_size(N_gaus); - - Mat tmp_inv; - - for(uword g=0; g < N_gaus; ++g) - { - const Mat& fcov = fcovs.slice(g); - Mat& inv_fcov = inv_fcovs.slice(g); - - //const bool inv_ok = auxlib::inv(tmp_inv, fcov); - const bool inv_ok = auxlib::inv_sympd(tmp_inv, fcov); - - eT log_det_val = eT(0); - eT log_det_sign = eT(0); - - const bool log_det_status = log_det(log_det_val, log_det_sign, fcov); - - const bool log_det_ok = ( log_det_status && (arma_isfinite(log_det_val)) && (log_det_sign > eT(0)) ); - - if(inv_ok && log_det_ok) - { - inv_fcov = tmp_inv; - } - else - { - // last resort: treat the covariance matrix as diagonal - - inv_fcov.zeros(); - - log_det_val = eT(0); - - for(uword d=0; d < N_dims; ++d) - { - const eT sanitised_val = (std::max)( eT(fcov.at(d,d)), eT(std::numeric_limits::min()) ); - - inv_fcov.at(d,d) = eT(1) / sanitised_val; - - log_det_val += std::log(sanitised_val); - } - } - - log_det_etc[g] = eT(-1) * ( tmp + eT(0.5) * log_det_val ); - } - - // - - eT* hefts_mem = access::rw(hefts).memptr(); - - for(uword g=0; g < N_gaus; ++g) - { - hefts_mem[g] = (std::max)( hefts_mem[g], std::numeric_limits::min() ); - } - - log_hefts = log(hefts); - - - if(calc_chol) - { - chol_fcovs.copy_size(fcovs); - - Mat tmp_chol; - - for(uword g=0; g < N_gaus; ++g) - { - const Mat& fcov = fcovs.slice(g); - Mat& chol_fcov = chol_fcovs.slice(g); - - const uword chol_layout = 1; // indicates "lower" - - const bool chol_ok = op_chol::apply_direct(tmp_chol, fcov, chol_layout); - - if(chol_ok) - { - chol_fcov = tmp_chol; - } - else - { - // last resort: treat the covariance matrix as diagonal - - chol_fcov.zeros(); - - for(uword d=0; d < N_dims; ++d) - { - const eT sanitised_val = (std::max)( eT(fcov.at(d,d)), eT(std::numeric_limits::min()) ); - - chol_fcov.at(d,d) = std::sqrt(sanitised_val); - } - } - } - } - } - - - -template -inline -umat -gmm_full::internal_gen_boundaries(const uword N) const - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_OPENMP) - const uword n_threads_avail = uword(omp_get_max_threads()); - const uword n_threads = (n_threads_avail > 0) ? ( (n_threads_avail <= N) ? n_threads_avail : 1 ) : 1; - #else - static constexpr uword n_threads = 1; - #endif - - // get_cout_stream() << "gmm_full::internal_gen_boundaries(): n_threads: " << n_threads << '\n'; - - umat boundaries(2, n_threads, arma_nozeros_indicator()); - - if(N > 0) - { - const uword chunk_size = N / n_threads; - - uword count = 0; - - for(uword t=0; t -inline -eT -gmm_full::internal_scalar_log_p(const eT* x) const - { - arma_debug_sigprint(); - - const eT* log_hefts_mem = log_hefts.mem; - - const uword N_gaus = means.n_cols; - - if(N_gaus > 0) - { - eT log_sum = internal_scalar_log_p(x, 0) + log_hefts_mem[0]; - - for(uword g=1; g < N_gaus; ++g) - { - const eT log_val = internal_scalar_log_p(x, g) + log_hefts_mem[g]; - - log_sum = log_add_exp(log_sum, log_val); - } - - return log_sum; - } - else - { - return -Datum::inf; - } - } - - - -template -inline -eT -gmm_full::internal_scalar_log_p(const eT* x, const uword g) const - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const eT* mean_mem = means.colptr(g); - - eT outer_acc = eT(0); - - const eT* inv_fcov_coldata = inv_fcovs.slice(g).memptr(); - - for(uword i=0; i < N_dims; ++i) - { - eT inner_acc = eT(0); - - for(uword j=0; j < N_dims; ++j) - { - inner_acc += (x[j] - mean_mem[j]) * inv_fcov_coldata[j]; - } - - inv_fcov_coldata += N_dims; - - outer_acc += inner_acc * (x[i] - mean_mem[i]); - } - - return eT(-0.5)*outer_acc + log_det_etc.mem[g]; - } - - - -template -inline -Row -gmm_full::internal_vec_log_p(const Mat& X) const - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_samples = X.n_cols; - - arma_conform_check( (X.n_rows != N_dims), "gmm_full::log_p(): incompatible dimensions" ); - - Row out(N_samples, arma_nozeros_indicator()); - - if(N_samples > 0) - { - #if defined(ARMA_USE_OPENMP) - { - const umat boundaries = internal_gen_boundaries(N_samples); - - const uword n_threads = boundaries.n_cols; - - #pragma omp parallel for schedule(static) - for(uword t=0; t < n_threads; ++t) - { - const uword start_index = boundaries.at(0,t); - const uword end_index = boundaries.at(1,t); - - eT* out_mem = out.memptr(); - - for(uword i=start_index; i <= end_index; ++i) - { - out_mem[i] = internal_scalar_log_p( X.colptr(i) ); - } - } - } - #else - { - eT* out_mem = out.memptr(); - - for(uword i=0; i < N_samples; ++i) - { - out_mem[i] = internal_scalar_log_p( X.colptr(i) ); - } - } - #endif - } - - return out; - } - - - -template -inline -Row -gmm_full::internal_vec_log_p(const Mat& X, const uword gaus_id) const - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_samples = X.n_cols; - - arma_conform_check( (X.n_rows != N_dims), "gmm_full::log_p(): incompatible dimensions" ); - arma_conform_check( (gaus_id >= means.n_cols), "gmm_full::log_p(): specified gaussian is out of range" ); - - Row out(N_samples, arma_nozeros_indicator()); - - if(N_samples > 0) - { - #if defined(ARMA_USE_OPENMP) - { - const umat boundaries = internal_gen_boundaries(N_samples); - - const uword n_threads = boundaries.n_cols; - - #pragma omp parallel for schedule(static) - for(uword t=0; t < n_threads; ++t) - { - const uword start_index = boundaries.at(0,t); - const uword end_index = boundaries.at(1,t); - - eT* out_mem = out.memptr(); - - for(uword i=start_index; i <= end_index; ++i) - { - out_mem[i] = internal_scalar_log_p( X.colptr(i), gaus_id ); - } - } - } - #else - { - eT* out_mem = out.memptr(); - - for(uword i=0; i < N_samples; ++i) - { - out_mem[i] = internal_scalar_log_p( X.colptr(i), gaus_id ); - } - } - #endif - } - - return out; - } - - - -template -inline -eT -gmm_full::internal_sum_log_p(const Mat& X) const - { - arma_debug_sigprint(); - - arma_conform_check( (X.n_rows != means.n_rows), "gmm_full::sum_log_p(): incompatible dimensions" ); - - const uword N = X.n_cols; - - if(N == 0) { return (-Datum::inf); } - - - #if defined(ARMA_USE_OPENMP) - { - const umat boundaries = internal_gen_boundaries(N); - - const uword n_threads = boundaries.n_cols; - - Col t_accs(n_threads, arma_zeros_indicator()); - - #pragma omp parallel for schedule(static) - for(uword t=0; t < n_threads; ++t) - { - const uword start_index = boundaries.at(0,t); - const uword end_index = boundaries.at(1,t); - - eT t_acc = eT(0); - - for(uword i=start_index; i <= end_index; ++i) - { - t_acc += internal_scalar_log_p( X.colptr(i) ); - } - - t_accs[t] = t_acc; - } - - return eT(accu(t_accs)); - } - #else - { - eT acc = eT(0); - - for(uword i=0; i -inline -eT -gmm_full::internal_sum_log_p(const Mat& X, const uword gaus_id) const - { - arma_debug_sigprint(); - - arma_conform_check( (X.n_rows != means.n_rows), "gmm_full::sum_log_p(): incompatible dimensions" ); - arma_conform_check( (gaus_id >= means.n_cols), "gmm_full::sum_log_p(): specified gaussian is out of range" ); - - const uword N = X.n_cols; - - if(N == 0) { return (-Datum::inf); } - - - #if defined(ARMA_USE_OPENMP) - { - const umat boundaries = internal_gen_boundaries(N); - - const uword n_threads = boundaries.n_cols; - - Col t_accs(n_threads, arma_zeros_indicator()); - - #pragma omp parallel for schedule(static) - for(uword t=0; t < n_threads; ++t) - { - const uword start_index = boundaries.at(0,t); - const uword end_index = boundaries.at(1,t); - - eT t_acc = eT(0); - - for(uword i=start_index; i <= end_index; ++i) - { - t_acc += internal_scalar_log_p( X.colptr(i), gaus_id ); - } - - t_accs[t] = t_acc; - } - - return eT(accu(t_accs)); - } - #else - { - eT acc = eT(0); - - for(uword i=0; i -inline -eT -gmm_full::internal_avg_log_p(const Mat& X) const - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_samples = X.n_cols; - - arma_conform_check( (X.n_rows != N_dims), "gmm_full::avg_log_p(): incompatible dimensions" ); - - if(N_samples == 0) { return (-Datum::inf); } - - - #if defined(ARMA_USE_OPENMP) - { - const umat boundaries = internal_gen_boundaries(N_samples); - - const uword n_threads = boundaries.n_cols; - - field< running_mean_scalar > t_running_means(n_threads); - - - #pragma omp parallel for schedule(static) - for(uword t=0; t < n_threads; ++t) - { - const uword start_index = boundaries.at(0,t); - const uword end_index = boundaries.at(1,t); - - running_mean_scalar& current_running_mean = t_running_means[t]; - - for(uword i=start_index; i <= end_index; ++i) - { - current_running_mean( internal_scalar_log_p( X.colptr(i) ) ); - } - } - - - eT avg = eT(0); - - for(uword t=0; t < n_threads; ++t) - { - running_mean_scalar& current_running_mean = t_running_means[t]; - - const eT w = eT(current_running_mean.count()) / eT(N_samples); - - avg += w * current_running_mean.mean(); - } - - return avg; - } - #else - { - running_mean_scalar running_mean; - - for(uword i=0; i < N_samples; ++i) - { - running_mean( internal_scalar_log_p( X.colptr(i) ) ); - } - - return running_mean.mean(); - } - #endif - } - - - -template -inline -eT -gmm_full::internal_avg_log_p(const Mat& X, const uword gaus_id) const - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_samples = X.n_cols; - - arma_conform_check( (X.n_rows != N_dims), "gmm_full::avg_log_p(): incompatible dimensions" ); - arma_conform_check( (gaus_id >= means.n_cols), "gmm_full::avg_log_p(): specified gaussian is out of range" ); - - if(N_samples == 0) { return (-Datum::inf); } - - - #if defined(ARMA_USE_OPENMP) - { - const umat boundaries = internal_gen_boundaries(N_samples); - - const uword n_threads = boundaries.n_cols; - - field< running_mean_scalar > t_running_means(n_threads); - - - #pragma omp parallel for schedule(static) - for(uword t=0; t < n_threads; ++t) - { - const uword start_index = boundaries.at(0,t); - const uword end_index = boundaries.at(1,t); - - running_mean_scalar& current_running_mean = t_running_means[t]; - - for(uword i=start_index; i <= end_index; ++i) - { - current_running_mean( internal_scalar_log_p( X.colptr(i), gaus_id) ); - } - } - - - eT avg = eT(0); - - for(uword t=0; t < n_threads; ++t) - { - running_mean_scalar& current_running_mean = t_running_means[t]; - - const eT w = eT(current_running_mean.count()) / eT(N_samples); - - avg += w * current_running_mean.mean(); - } - - return avg; - } - #else - { - running_mean_scalar running_mean; - - for(uword i=0; i -inline -uword -gmm_full::internal_scalar_assign(const Mat& X, const gmm_dist_mode& dist_mode) const - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - arma_conform_check( (X.n_rows != N_dims), "gmm_full::assign(): incompatible dimensions" ); - arma_conform_check( (N_gaus == 0), "gmm_full::assign(): model has no means" ); - - const eT* X_mem = X.colptr(0); - - if(dist_mode == eucl_dist) - { - eT best_dist = Datum::inf; - uword best_g = 0; - - for(uword g=0; g < N_gaus; ++g) - { - const eT tmp_dist = distance::eval(N_dims, X_mem, means.colptr(g), X_mem); - - if(tmp_dist <= best_dist) - { - best_dist = tmp_dist; - best_g = g; - } - } - - return best_g; - } - else - if(dist_mode == prob_dist) - { - const eT* log_hefts_mem = log_hefts.memptr(); - - eT best_p = -Datum::inf; - uword best_g = 0; - - for(uword g=0; g < N_gaus; ++g) - { - const eT tmp_p = internal_scalar_log_p(X_mem, g) + log_hefts_mem[g]; - - if(tmp_p >= best_p) - { - best_p = tmp_p; - best_g = g; - } - } - - return best_g; - } - else - { - arma_conform_check(true, "gmm_full::assign(): unsupported distance mode"); - } - - return uword(0); - } - - - -template -inline -void -gmm_full::internal_vec_assign(urowvec& out, const Mat& X, const gmm_dist_mode& dist_mode) const - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - arma_conform_check( (X.n_rows != N_dims), "gmm_full::assign(): incompatible dimensions" ); - - const uword X_n_cols = (N_gaus > 0) ? X.n_cols : 0; - - out.set_size(1,X_n_cols); - - uword* out_mem = out.memptr(); - - if(dist_mode == eucl_dist) - { - #if defined(ARMA_USE_OPENMP) - { - #pragma omp parallel for schedule(static) - for(uword i=0; i::inf; - uword best_g = 0; - - for(uword g=0; g::eval(N_dims, X_colptr, means.colptr(g), X_colptr); - - if(tmp_dist <= best_dist) { best_dist = tmp_dist; best_g = g; } - } - - out_mem[i] = best_g; - } - } - #else - { - for(uword i=0; i::inf; - uword best_g = 0; - - for(uword g=0; g::eval(N_dims, X_colptr, means.colptr(g), X_colptr); - - if(tmp_dist <= best_dist) { best_dist = tmp_dist; best_g = g; } - } - - out_mem[i] = best_g; - } - } - #endif - } - else - if(dist_mode == prob_dist) - { - #if defined(ARMA_USE_OPENMP) - { - const umat boundaries = internal_gen_boundaries(X_n_cols); - - const uword n_threads = boundaries.n_cols; - - const eT* log_hefts_mem = log_hefts.memptr(); - - #pragma omp parallel for schedule(static) - for(uword t=0; t < n_threads; ++t) - { - const uword start_index = boundaries.at(0,t); - const uword end_index = boundaries.at(1,t); - - for(uword i=start_index; i <= end_index; ++i) - { - const eT* X_colptr = X.colptr(i); - - eT best_p = -Datum::inf; - uword best_g = 0; - - for(uword g=0; g= best_p) { best_p = tmp_p; best_g = g; } - } - - out_mem[i] = best_g; - } - } - } - #else - { - const eT* log_hefts_mem = log_hefts.memptr(); - - for(uword i=0; i::inf; - uword best_g = 0; - - for(uword g=0; g= best_p) { best_p = tmp_p; best_g = g; } - } - - out_mem[i] = best_g; - } - } - #endif - } - else - { - arma_conform_check(true, "gmm_full::assign(): unsupported distance mode"); - } - } - - - - -template -inline -void -gmm_full::internal_raw_hist(urowvec& hist, const Mat& X, const gmm_dist_mode& dist_mode) const - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - const uword X_n_cols = X.n_cols; - - hist.zeros(N_gaus); - - if(N_gaus == 0) { return; } - - #if defined(ARMA_USE_OPENMP) - { - const umat boundaries = internal_gen_boundaries(X_n_cols); - - const uword n_threads = boundaries.n_cols; - - field thread_hist(n_threads); - - for(uword t=0; t < n_threads; ++t) { thread_hist(t).zeros(N_gaus); } - - - if(dist_mode == eucl_dist) - { - #pragma omp parallel for schedule(static) - for(uword t=0; t < n_threads; ++t) - { - uword* thread_hist_mem = thread_hist(t).memptr(); - - const uword start_index = boundaries.at(0,t); - const uword end_index = boundaries.at(1,t); - - for(uword i=start_index; i <= end_index; ++i) - { - const eT* X_colptr = X.colptr(i); - - eT best_dist = Datum::inf; - uword best_g = 0; - - for(uword g=0; g < N_gaus; ++g) - { - const eT tmp_dist = distance::eval(N_dims, X_colptr, means.colptr(g), X_colptr); - - if(tmp_dist <= best_dist) { best_dist = tmp_dist; best_g = g; } - } - - thread_hist_mem[best_g]++; - } - } - } - else - if(dist_mode == prob_dist) - { - const eT* log_hefts_mem = log_hefts.memptr(); - - #pragma omp parallel for schedule(static) - for(uword t=0; t < n_threads; ++t) - { - uword* thread_hist_mem = thread_hist(t).memptr(); - - const uword start_index = boundaries.at(0,t); - const uword end_index = boundaries.at(1,t); - - for(uword i=start_index; i <= end_index; ++i) - { - const eT* X_colptr = X.colptr(i); - - eT best_p = -Datum::inf; - uword best_g = 0; - - for(uword g=0; g < N_gaus; ++g) - { - const eT tmp_p = internal_scalar_log_p(X_colptr, g) + log_hefts_mem[g]; - - if(tmp_p >= best_p) { best_p = tmp_p; best_g = g; } - } - - thread_hist_mem[best_g]++; - } - } - } - - // reduction - for(uword t=0; t < n_threads; ++t) - { - hist += thread_hist(t); - } - } - #else - { - uword* hist_mem = hist.memptr(); - - if(dist_mode == eucl_dist) - { - for(uword i=0; i::inf; - uword best_g = 0; - - for(uword g=0; g < N_gaus; ++g) - { - const eT tmp_dist = distance::eval(N_dims, X_colptr, means.colptr(g), X_colptr); - - if(tmp_dist <= best_dist) { best_dist = tmp_dist; best_g = g; } - } - - hist_mem[best_g]++; - } - } - else - if(dist_mode == prob_dist) - { - const eT* log_hefts_mem = log_hefts.memptr(); - - for(uword i=0; i::inf; - uword best_g = 0; - - for(uword g=0; g < N_gaus; ++g) - { - const eT tmp_p = internal_scalar_log_p(X_colptr, g) + log_hefts_mem[g]; - - if(tmp_p >= best_p) { best_p = tmp_p; best_g = g; } - } - - hist_mem[best_g]++; - } - } - } - #endif - } - - - -template -template -inline -void -gmm_full::generate_initial_means(const Mat& X, const gmm_seed_mode& seed_mode) - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - if( (seed_mode == static_subset) || (seed_mode == random_subset) ) - { - uvec initial_indices; - - if(seed_mode == static_subset) { initial_indices = linspace(0, X.n_cols-1, N_gaus); } - else if(seed_mode == random_subset) { initial_indices = randperm(X.n_cols, N_gaus); } - - // initial_indices.print("initial_indices:"); - - access::rw(means) = X.cols(initial_indices); - } - else - if( (seed_mode == static_spread) || (seed_mode == random_spread) ) - { - // going through all of the samples can be extremely time consuming; - // instead, if there are enough samples, randomly choose samples with probability 0.1 - - const bool use_sampling = ((X.n_cols/uword(100)) > N_gaus); - const uword step = (use_sampling) ? uword(10) : uword(1); - - uword start_index = 0; - - if(seed_mode == static_spread) { start_index = X.n_cols / 2; } - else if(seed_mode == random_spread) { start_index = as_scalar(randi(1, distr_param(0,X.n_cols-1))); } - - access::rw(means).col(0) = X.unsafe_col(start_index); - - const eT* mah_aux_mem = mah_aux.memptr(); - - running_stat rs; - - for(uword g=1; g < N_gaus; ++g) - { - eT max_dist = eT(0); - uword best_i = uword(0); - uword start_i = uword(0); - - if(use_sampling) - { - uword start_i_proposed = uword(0); - - if(seed_mode == static_spread) { start_i_proposed = g % uword(10); } - if(seed_mode == random_spread) { start_i_proposed = as_scalar(randi(1, distr_param(0,9))); } - - if(start_i_proposed < X.n_cols) { start_i = start_i_proposed; } - } - - - for(uword i=start_i; i < X.n_cols; i += step) - { - rs.reset(); - - const eT* X_colptr = X.colptr(i); - - bool ignore_i = false; - - // find the average distance between sample i and the means so far - for(uword h = 0; h < g; ++h) - { - const eT dist = distance::eval(N_dims, X_colptr, means.colptr(h), mah_aux_mem); - - // ignore sample already selected as a mean - if(dist == eT(0)) { ignore_i = true; break; } - else { rs(dist); } - } - - if( (rs.mean() >= max_dist) && (ignore_i == false)) - { - max_dist = eT(rs.mean()); best_i = i; - } - } - - // set the mean to the sample that is the furthest away from the means so far - access::rw(means).col(g) = X.unsafe_col(best_i); - } - } - - // get_cout_stream() << "generate_initial_means():" << '\n'; - // means.print(); - } - - - -template -template -inline -void -gmm_full::generate_initial_params(const Mat& X, const eT var_floor) - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - const eT* mah_aux_mem = mah_aux.memptr(); - - const uword X_n_cols = X.n_cols; - - if(X_n_cols == 0) { return; } - - // as the covariances are calculated via accumulators, - // the means also need to be calculated via accumulators to ensure numerical consistency - - Mat acc_means(N_dims, N_gaus); - Mat acc_dcovs(N_dims, N_gaus); - - Row acc_hefts(N_gaus, arma_zeros_indicator()); - - uword* acc_hefts_mem = acc_hefts.memptr(); - - #if defined(ARMA_USE_OPENMP) - { - const umat boundaries = internal_gen_boundaries(X_n_cols); - - const uword n_threads = boundaries.n_cols; - - field< Mat > t_acc_means(n_threads); - field< Mat > t_acc_dcovs(n_threads); - field< Row > t_acc_hefts(n_threads); - - for(uword t=0; t < n_threads; ++t) - { - t_acc_means(t).zeros(N_dims, N_gaus); - t_acc_dcovs(t).zeros(N_dims, N_gaus); - t_acc_hefts(t).zeros(N_gaus); - } - - #pragma omp parallel for schedule(static) - for(uword t=0; t < n_threads; ++t) - { - uword* t_acc_hefts_mem = t_acc_hefts(t).memptr(); - - const uword start_index = boundaries.at(0,t); - const uword end_index = boundaries.at(1,t); - - for(uword i=start_index; i <= end_index; ++i) - { - const eT* X_colptr = X.colptr(i); - - eT min_dist = Datum::inf; - uword best_g = 0; - - for(uword g=0; g::eval(N_dims, X_colptr, means.colptr(g), mah_aux_mem); - - if(dist < min_dist) { min_dist = dist; best_g = g; } - } - - eT* t_acc_mean = t_acc_means(t).colptr(best_g); - eT* t_acc_dcov = t_acc_dcovs(t).colptr(best_g); - - for(uword d=0; d::inf; - uword best_g = 0; - - for(uword g=0; g::eval(N_dims, X_colptr, means.colptr(g), mah_aux_mem); - - if(dist < min_dist) { min_dist = dist; best_g = g; } - } - - eT* acc_mean = acc_means.colptr(best_g); - eT* acc_dcov = acc_dcovs.colptr(best_g); - - for(uword d=0; d& fcov = access::rw(fcovs).slice(g); - fcov.zeros(); - - for(uword d=0; d= 1) ? tmp : eT(0); - fcov.at(d,d) = (acc_heft >= 2) ? eT((acc_dcov[d] / eT(acc_heft)) - (tmp*tmp)) : eT(var_floor); - } - - hefts_mem[g] = eT(acc_heft) / eT(X_n_cols); - } - - em_fix_params(var_floor); - } - - - -//! multi-threaded implementation of k-means, inspired by MapReduce -template -template -inline -bool -gmm_full::km_iterate(const Mat& X, const uword max_iter, const bool verbose) - { - arma_debug_sigprint(); - - if(verbose) - { - get_cout_stream().unsetf(ios::showbase); - get_cout_stream().unsetf(ios::uppercase); - get_cout_stream().unsetf(ios::showpos); - get_cout_stream().unsetf(ios::scientific); - - get_cout_stream().setf(ios::right); - get_cout_stream().setf(ios::fixed); - } - - const uword X_n_cols = X.n_cols; - - if(X_n_cols == 0) { return true; } - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - const eT* mah_aux_mem = mah_aux.memptr(); - - Mat acc_means(N_dims, N_gaus, arma_zeros_indicator()); - Row acc_hefts( N_gaus, arma_zeros_indicator()); - Row last_indx( N_gaus, arma_zeros_indicator()); - - Mat new_means = means; - Mat old_means = means; - - running_mean_scalar rs_delta; - - #if defined(ARMA_USE_OPENMP) - const umat boundaries = internal_gen_boundaries(X_n_cols); - const uword n_threads = boundaries.n_cols; - - field< Mat > t_acc_means(n_threads); - field< Row > t_acc_hefts(n_threads); - field< Row > t_last_indx(n_threads); - #else - const uword n_threads = 1; - #endif - - if(verbose) { get_cout_stream() << "gmm_full::learn(): k-means: n_threads: " << n_threads << '\n'; get_cout_stream().flush(); } - - for(uword iter=1; iter <= max_iter; ++iter) - { - #if defined(ARMA_USE_OPENMP) - { - for(uword t=0; t < n_threads; ++t) - { - t_acc_means(t).zeros(N_dims, N_gaus); - t_acc_hefts(t).zeros(N_gaus); - t_last_indx(t).zeros(N_gaus); - } - - #pragma omp parallel for schedule(static) - for(uword t=0; t < n_threads; ++t) - { - Mat& t_acc_means_t = t_acc_means(t); - uword* t_acc_hefts_mem = t_acc_hefts(t).memptr(); - uword* t_last_indx_mem = t_last_indx(t).memptr(); - - const uword start_index = boundaries.at(0,t); - const uword end_index = boundaries.at(1,t); - - for(uword i=start_index; i <= end_index; ++i) - { - const eT* X_colptr = X.colptr(i); - - eT min_dist = Datum::inf; - uword best_g = 0; - - for(uword g=0; g::eval(N_dims, X_colptr, old_means.colptr(g), mah_aux_mem); - - if(dist < min_dist) { min_dist = dist; best_g = g; } - } - - eT* t_acc_mean = t_acc_means_t.colptr(best_g); - - for(uword d=0; d= 1 ) { last_indx(g) = t_last_indx(t)(g); } - } - } - #else - { - acc_hefts.zeros(); - acc_means.zeros(); - last_indx.zeros(); - - uword* acc_hefts_mem = acc_hefts.memptr(); - uword* last_indx_mem = last_indx.memptr(); - - for(uword i=0; i < X_n_cols; ++i) - { - const eT* X_colptr = X.colptr(i); - - eT min_dist = Datum::inf; - uword best_g = 0; - - for(uword g=0; g::eval(N_dims, X_colptr, old_means.colptr(g), mah_aux_mem); - - if(dist < min_dist) { min_dist = dist; best_g = g; } - } - - eT* acc_mean = acc_means.colptr(best_g); - - for(uword d=0; d= 1) ? (acc_mean[d] / eT(acc_heft)) : eT(0); - } - } - - - // heuristics to resurrect dead means - - const uvec dead_gs = find(acc_hefts == uword(0)); - - if(dead_gs.n_elem > 0) - { - if(verbose) { get_cout_stream() << "gmm_full::learn(): k-means: recovering from dead means\n"; get_cout_stream().flush(); } - - uword* last_indx_mem = last_indx.memptr(); - - const uvec live_gs = sort( find(acc_hefts >= uword(2)), "descend" ); - - if(live_gs.n_elem == 0) { return false; } - - uword live_gs_count = 0; - - for(uword dead_gs_count = 0; dead_gs_count < dead_gs.n_elem; ++dead_gs_count) - { - const uword dead_g_id = dead_gs(dead_gs_count); - - uword proposed_i = 0; - - if(live_gs_count < live_gs.n_elem) - { - const uword live_g_id = live_gs(live_gs_count); ++live_gs_count; - - if(live_g_id == dead_g_id) { return false; } - - // recover by using a sample from a known good mean - proposed_i = last_indx_mem[live_g_id]; - } - else - { - // recover by using a randomly seleced sample (last resort) - proposed_i = as_scalar(randi(1, distr_param(0,X_n_cols-1))); - } - - if(proposed_i >= X_n_cols) { return false; } - - new_means.col(dead_g_id) = X.col(proposed_i); - } - } - - rs_delta.reset(); - - for(uword g=0; g < N_gaus; ++g) - { - rs_delta( distance::eval(N_dims, old_means.colptr(g), new_means.colptr(g), mah_aux_mem) ); - } - - if(verbose) - { - get_cout_stream() << "gmm_full::learn(): k-means: iteration: "; - get_cout_stream().unsetf(ios::scientific); - get_cout_stream().setf(ios::fixed); - get_cout_stream().width(std::streamsize(4)); - get_cout_stream() << iter; - get_cout_stream() << " delta: "; - get_cout_stream().unsetf(ios::fixed); - //get_cout_stream().setf(ios::scientific); - get_cout_stream() << rs_delta.mean() << '\n'; - get_cout_stream().flush(); - } - - arma::swap(old_means, new_means); - - if(rs_delta.mean() <= Datum::eps) { break; } - } - - access::rw(means) = old_means; - - if(means.internal_has_nonfinite()) { return false; } - - return true; - } - - - -//! multi-threaded implementation of Expectation-Maximisation, inspired by MapReduce -template -inline -bool -gmm_full::em_iterate(const Mat& X, const uword max_iter, const eT var_floor, const bool verbose) - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - if(verbose) - { - get_cout_stream().unsetf(ios::showbase); - get_cout_stream().unsetf(ios::uppercase); - get_cout_stream().unsetf(ios::showpos); - get_cout_stream().unsetf(ios::scientific); - - get_cout_stream().setf(ios::right); - get_cout_stream().setf(ios::fixed); - } - - const umat boundaries = internal_gen_boundaries(X.n_cols); - - const uword n_threads = boundaries.n_cols; - - field< Mat > t_acc_means(n_threads); - field< Cube > t_acc_fcovs(n_threads); - - field< Col > t_acc_norm_lhoods(n_threads); - field< Col > t_gaus_log_lhoods(n_threads); - - Col t_progress_log_lhood(n_threads, arma_nozeros_indicator()); - - for(uword t=0; t::inf; - - const bool calc_chol = false; - - for(uword iter=1; iter <= max_iter; ++iter) - { - init_constants(calc_chol); - - em_update_params(X, boundaries, t_acc_means, t_acc_fcovs, t_acc_norm_lhoods, t_gaus_log_lhoods, t_progress_log_lhood, var_floor); - - em_fix_params(var_floor); - - const eT new_avg_log_p = accu(t_progress_log_lhood) / eT(t_progress_log_lhood.n_elem); - - if(verbose) - { - get_cout_stream() << "gmm_full::learn(): EM: iteration: "; - get_cout_stream().unsetf(ios::scientific); - get_cout_stream().setf(ios::fixed); - get_cout_stream().width(std::streamsize(4)); - get_cout_stream() << iter; - get_cout_stream() << " avg_log_p: "; - get_cout_stream().unsetf(ios::fixed); - //get_cout_stream().setf(ios::scientific); - get_cout_stream() << new_avg_log_p << '\n'; - get_cout_stream().flush(); - } - - if(arma_isfinite(new_avg_log_p) == false) { return false; } - - if(std::abs(old_avg_log_p - new_avg_log_p) <= Datum::eps) { break; } - - - old_avg_log_p = new_avg_log_p; - } - - - for(uword g=0; g < N_gaus; ++g) - { - const Mat& fcov = fcovs.slice(g); - - if(any(vectorise(fcov.diag()) <= eT(0))) { return false; } - } - - if(means.internal_has_nonfinite()) { return false; } - if(fcovs.internal_has_nonfinite()) { return false; } - if(hefts.internal_has_nonfinite()) { return false; } - - return true; - } - - - - -template -inline -void -gmm_full::em_update_params - ( - const Mat& X, - const umat& boundaries, - field< Mat >& t_acc_means, - field< Cube >& t_acc_fcovs, - field< Col >& t_acc_norm_lhoods, - field< Col >& t_gaus_log_lhoods, - Col& t_progress_log_lhood, - const eT var_floor - ) - { - arma_debug_sigprint(); - - const uword n_threads = boundaries.n_cols; - - - // em_generate_acc() is the "map" operation, which produces partial accumulators for means, diagonal covariances and hefts - - #if defined(ARMA_USE_OPENMP) - { - #pragma omp parallel for schedule(static) - for(uword t=0; t& acc_means = t_acc_means[t]; - Cube& acc_fcovs = t_acc_fcovs[t]; - Col& acc_norm_lhoods = t_acc_norm_lhoods[t]; - Col& gaus_log_lhoods = t_gaus_log_lhoods[t]; - eT& progress_log_lhood = t_progress_log_lhood[t]; - - em_generate_acc(X, boundaries.at(0,t), boundaries.at(1,t), acc_means, acc_fcovs, acc_norm_lhoods, gaus_log_lhoods, progress_log_lhood); - } - } - #else - { - em_generate_acc(X, boundaries.at(0,0), boundaries.at(1,0), t_acc_means[0], t_acc_fcovs[0], t_acc_norm_lhoods[0], t_gaus_log_lhoods[0], t_progress_log_lhood[0]); - } - #endif - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - Mat& final_acc_means = t_acc_means[0]; - Cube& final_acc_fcovs = t_acc_fcovs[0]; - - Col& final_acc_norm_lhoods = t_acc_norm_lhoods[0]; - - - // the "reduce" operation, which combines the partial accumulators produced by the separate threads - - for(uword t=1; t mean_outer(N_dims, N_dims, arma_nozeros_indicator()); - - - //// update each component without sanity checking - //for(uword g=0; g < N_gaus; ++g) - // { - // const eT acc_norm_lhood = (std::max)( final_acc_norm_lhoods[g], std::numeric_limits::min() ); - // - // hefts_mem[g] = acc_norm_lhood / eT(X.n_cols); - // - // eT* mean_mem = access::rw(means).colptr(g); - // eT* acc_mean_mem = final_acc_means.colptr(g); - // - // for(uword d=0; d < N_dims; ++d) - // { - // mean_mem[d] = acc_mean_mem[d] / acc_norm_lhood; - // } - // - // const Col mean(mean_mem, N_dims, false, true); - // - // mean_outer = mean * mean.t(); - // - // Mat& fcov = access::rw(fcovs).slice(g); - // Mat& acc_fcov = final_acc_fcovs.slice(g); - // - // fcov = acc_fcov / acc_norm_lhood - mean_outer; - // } - - - // conditionally update each component; if only a subset of the hefts was updated, em_fix_params() will sanitise them - for(uword g=0; g < N_gaus; ++g) - { - const eT acc_norm_lhood = (std::max)( final_acc_norm_lhoods[g], std::numeric_limits::min() ); - - if(arma_isfinite(acc_norm_lhood) == false) { continue; } - - eT* acc_mean_mem = final_acc_means.colptr(g); - - for(uword d=0; d < N_dims; ++d) - { - acc_mean_mem[d] /= acc_norm_lhood; - } - - const Col new_mean(acc_mean_mem, N_dims, false, true); - - mean_outer = new_mean * new_mean.t(); - - Mat& acc_fcov = final_acc_fcovs.slice(g); - - acc_fcov /= acc_norm_lhood; - acc_fcov -= mean_outer; - - for(uword d=0; d < N_dims; ++d) - { - eT& val = acc_fcov.at(d,d); - - if(val < var_floor) { val = var_floor; } - } - - if(acc_fcov.internal_has_nonfinite()) { continue; } - - eT log_det_val = eT(0); - eT log_det_sign = eT(0); - - const bool log_det_status = log_det(log_det_val, log_det_sign, acc_fcov); - - const bool log_det_ok = ( log_det_status && (arma_isfinite(log_det_val)) && (log_det_sign > eT(0)) ); - - const bool inv_ok = (log_det_ok) ? bool(auxlib::inv_sympd(mean_outer, acc_fcov)) : bool(false); // mean_outer is used as a junk matrix - - if(log_det_ok && inv_ok) - { - hefts_mem[g] = acc_norm_lhood / eT(X.n_cols); - - eT* mean_mem = access::rw(means).colptr(g); - - for(uword d=0; d < N_dims; ++d) - { - mean_mem[d] = acc_mean_mem[d]; - } - - Mat& fcov = access::rw(fcovs).slice(g); - - fcov = acc_fcov; - } - } - } - - - -template -inline -void -gmm_full::em_generate_acc - ( - const Mat& X, - const uword start_index, - const uword end_index, - Mat& acc_means, - Cube& acc_fcovs, - Col& acc_norm_lhoods, - Col& gaus_log_lhoods, - eT& progress_log_lhood - ) - const - { - arma_debug_sigprint(); - - progress_log_lhood = eT(0); - - acc_means.zeros(); - acc_fcovs.zeros(); - - acc_norm_lhoods.zeros(); - gaus_log_lhoods.zeros(); - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - const eT* log_hefts_mem = log_hefts.memptr(); - eT* gaus_log_lhoods_mem = gaus_log_lhoods.memptr(); - - - for(uword i=start_index; i <= end_index; i++) - { - const eT* x = X.colptr(i); - - for(uword g=0; g < N_gaus; ++g) - { - gaus_log_lhoods_mem[g] = internal_scalar_log_p(x, g) + log_hefts_mem[g]; - } - - eT log_lhood_sum = gaus_log_lhoods_mem[0]; - - for(uword g=1; g < N_gaus; ++g) - { - log_lhood_sum = log_add_exp(log_lhood_sum, gaus_log_lhoods_mem[g]); - } - - progress_log_lhood += log_lhood_sum; - - for(uword g=0; g < N_gaus; ++g) - { - const eT norm_lhood = std::exp(gaus_log_lhoods_mem[g] - log_lhood_sum); - - acc_norm_lhoods[g] += norm_lhood; - - eT* acc_mean_mem = acc_means.colptr(g); - - for(uword d=0; d < N_dims; ++d) - { - acc_mean_mem[d] += x[d] * norm_lhood; - } - - Mat& acc_fcov = access::rw(acc_fcovs).slice(g); - - // specialised version of acc_fcov += norm_lhood * (xx * xx.t()); - - for(uword d=0; d < N_dims; ++d) - { - const uword dp1 = d+1; - - const eT xd = x[d]; - - eT* acc_fcov_col_d = acc_fcov.colptr(d) + d; - eT* acc_fcov_row_d = &(acc_fcov.at(d,dp1)); - - (*acc_fcov_col_d) += norm_lhood * (xd * xd); acc_fcov_col_d++; - - for(uword e=dp1; e < N_dims; ++e) - { - const eT val = norm_lhood * (xd * x[e]); - - (*acc_fcov_col_d) += val; acc_fcov_col_d++; - (*acc_fcov_row_d) += val; acc_fcov_row_d += N_dims; - } - } - } - } - - progress_log_lhood /= eT((end_index - start_index) + 1); - } - - - -template -inline -void -gmm_full::em_fix_params(const eT var_floor) - { - arma_debug_sigprint(); - - const uword N_dims = means.n_rows; - const uword N_gaus = means.n_cols; - - const eT var_ceiling = std::numeric_limits::max(); - - for(uword g=0; g < N_gaus; ++g) - { - Mat& fcov = access::rw(fcovs).slice(g); - - for(uword d=0; d < N_dims; ++d) - { - eT& var_val = fcov.at(d,d); - - if(var_val < var_floor ) { var_val = var_floor; } - else if(var_val > var_ceiling) { var_val = var_ceiling; } - else if(arma_isnan(var_val) ) { var_val = eT(1); } - } - } - - - eT* hefts_mem = access::rw(hefts).memptr(); - - for(uword g1=0; g1 < N_gaus; ++g1) - { - if(hefts_mem[g1] > eT(0)) - { - const eT* means_colptr_g1 = means.colptr(g1); - - for(uword g2=(g1+1); g2 < N_gaus; ++g2) - { - if( (hefts_mem[g2] > eT(0)) && (std::abs(hefts_mem[g1] - hefts_mem[g2]) <= std::numeric_limits::epsilon()) ) - { - const eT dist = distance::eval(N_dims, means_colptr_g1, means.colptr(g2), means_colptr_g1); - - if(dist == eT(0)) { hefts_mem[g2] = eT(0); } - } - } - } - } - - const eT heft_floor = std::numeric_limits::min(); - const eT heft_initial = eT(1) / eT(N_gaus); - - for(uword i=0; i < N_gaus; ++i) - { - eT& heft_val = hefts_mem[i]; - - if(heft_val < heft_floor) { heft_val = heft_floor; } - else if(heft_val > eT(1) ) { heft_val = eT(1); } - else if(arma_isnan(heft_val) ) { heft_val = heft_initial; } - } - - const eT heft_sum = accu(hefts); - - if((heft_sum < (eT(1) - Datum::eps)) || (heft_sum > (eT(1) + Datum::eps))) { access::rw(hefts) /= heft_sum; } - } - - - -} // namespace gmm_priv - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/gmm_misc_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/gmm_misc_bones.hpp deleted file mode 100644 index 44507d418..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/gmm_misc_bones.hpp +++ /dev/null @@ -1,119 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup gmm_misc -//! @{ - - -struct gmm_dist_mode { const uword id; inline constexpr explicit gmm_dist_mode(const uword in_id) : id(in_id) {} }; - -inline bool operator==(const gmm_dist_mode& a, const gmm_dist_mode& b) { return (a.id == b.id); } -inline bool operator!=(const gmm_dist_mode& a, const gmm_dist_mode& b) { return (a.id != b.id); } - -struct gmm_dist_eucl : public gmm_dist_mode { inline constexpr gmm_dist_eucl() : gmm_dist_mode(1) {} }; -struct gmm_dist_maha : public gmm_dist_mode { inline constexpr gmm_dist_maha() : gmm_dist_mode(2) {} }; -struct gmm_dist_prob : public gmm_dist_mode { inline constexpr gmm_dist_prob() : gmm_dist_mode(3) {} }; - -static constexpr gmm_dist_eucl eucl_dist; -static constexpr gmm_dist_maha maha_dist; -static constexpr gmm_dist_prob prob_dist; - - - -struct gmm_seed_mode { const uword id; inline constexpr explicit gmm_seed_mode(const uword in_id) : id(in_id) {} }; - -inline bool operator==(const gmm_seed_mode& a, const gmm_seed_mode& b) { return (a.id == b.id); } -inline bool operator!=(const gmm_seed_mode& a, const gmm_seed_mode& b) { return (a.id != b.id); } - -struct gmm_seed_keep_existing : public gmm_seed_mode { inline constexpr gmm_seed_keep_existing() : gmm_seed_mode(1) {} }; -struct gmm_seed_static_subset : public gmm_seed_mode { inline constexpr gmm_seed_static_subset() : gmm_seed_mode(2) {} }; -struct gmm_seed_static_spread : public gmm_seed_mode { inline constexpr gmm_seed_static_spread() : gmm_seed_mode(3) {} }; -struct gmm_seed_random_subset : public gmm_seed_mode { inline constexpr gmm_seed_random_subset() : gmm_seed_mode(4) {} }; -struct gmm_seed_random_spread : public gmm_seed_mode { inline constexpr gmm_seed_random_spread() : gmm_seed_mode(5) {} }; - -static constexpr gmm_seed_keep_existing keep_existing; -static constexpr gmm_seed_static_subset static_subset; -static constexpr gmm_seed_static_spread static_spread; -static constexpr gmm_seed_random_subset random_subset; -static constexpr gmm_seed_random_spread random_spread; - - -namespace gmm_priv -{ - - -template class gmm_diag; -template class gmm_full; - - -struct gmm_empty_arg {}; - - -// running_mean_scalar - -template -class running_mean_scalar - { - public: - - inline running_mean_scalar(); - inline running_mean_scalar(const running_mean_scalar& in_rms); - - inline const running_mean_scalar& operator=(const running_mean_scalar& in_rms); - - arma_hot inline void operator() (const eT X); - - inline void reset(); - - inline uword count() const; - inline eT mean() const; - - - private: - - arma_aligned uword counter; - arma_aligned eT r_mean; - }; - - - -// distance - -template -struct distance {}; - - -template -struct distance - { - arma_inline static eT eval(const uword N, const eT* A, const eT* B, const eT*); - }; - - - -template -struct distance - { - arma_inline static eT eval(const uword N, const eT* A, const eT* B, const eT* C); - }; - - -} - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/gmm_misc_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/gmm_misc_meat.hpp deleted file mode 100644 index d512eb191..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/gmm_misc_meat.hpp +++ /dev/null @@ -1,193 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup gmm_misc -//! @{ - - -namespace gmm_priv -{ - - -template -inline -running_mean_scalar::running_mean_scalar() - : counter(uword(0)) - , r_mean ( eT(0)) - { - arma_debug_sigprint_this(this); - } - - - -template -inline -running_mean_scalar::running_mean_scalar(const running_mean_scalar& in) - : counter(in.counter) - , r_mean (in.r_mean ) - { - arma_debug_sigprint_this(this); - } - - - -template -inline -const running_mean_scalar& -running_mean_scalar::operator=(const running_mean_scalar& in) - { - arma_debug_sigprint(); - - counter = in.counter; - r_mean = in.r_mean; - - return *this; - } - - - -template -inline -void -running_mean_scalar::operator() (const eT X) - { - arma_debug_sigprint(); - - counter++; - - if(counter > 1) - { - const eT old_r_mean = r_mean; - - r_mean = old_r_mean + (X - old_r_mean)/counter; - } - else - { - r_mean = X; - } - } - - - -template -inline -void -running_mean_scalar::reset() - { - arma_debug_sigprint(); - - counter = 0; - r_mean = eT(0); - } - - - -template -inline -uword -running_mean_scalar::count() const - { - return counter; - } - - - -template -inline -eT -running_mean_scalar::mean() const - { - return r_mean; - } - - - -// -// -// - - - -template -arma_inline -eT -distance::eval(const uword N, const eT* A, const eT* B, const eT*) - { - eT acc1 = eT(0); - eT acc2 = eT(0); - - uword i,j; - for(i=0, j=1; j -arma_inline -eT -distance::eval(const uword N, const eT* A, const eT* B, const eT* C) - { - eT acc1 = eT(0); - eT acc2 = eT(0); - - uword i,j; - for(i=0, j=1; j -inline -hid_t -get_hdf5_type() - { - return -1; // Return invalid. - } - - - -//! Specializations for each valid element type -//! (taken from all the possible typedefs of {u8, s8, ..., u64, s64} and the other native types. -//! We can't use the actual u8/s8 typedefs because their relations to the H5T_... types are unclear. -template<> -inline -hid_t -get_hdf5_type< unsigned char >() - { - return H5Tcopy(H5T_NATIVE_UCHAR); - } - -template<> -inline -hid_t -get_hdf5_type< char >() - { - return H5Tcopy(H5T_NATIVE_CHAR); - } - -template<> -inline -hid_t -get_hdf5_type< short >() - { - return H5Tcopy(H5T_NATIVE_SHORT); - } - -template<> -inline -hid_t -get_hdf5_type< unsigned short >() - { - return H5Tcopy(H5T_NATIVE_USHORT); - } - -template<> -inline -hid_t -get_hdf5_type< int >() - { - return H5Tcopy(H5T_NATIVE_INT); - } - -template<> -inline -hid_t -get_hdf5_type< unsigned int >() - { - return H5Tcopy(H5T_NATIVE_UINT); - } - -template<> -inline -hid_t -get_hdf5_type< long >() - { - return H5Tcopy(H5T_NATIVE_LONG); - } - -template<> -inline -hid_t -get_hdf5_type< unsigned long >() - { - return H5Tcopy(H5T_NATIVE_ULONG); - } - -template<> -inline -hid_t -get_hdf5_type< long long >() - { - return H5Tcopy(H5T_NATIVE_LLONG); - } - -template<> -inline -hid_t -get_hdf5_type< unsigned long long >() - { - return H5Tcopy(H5T_NATIVE_ULLONG); - } - -template<> -inline -hid_t -get_hdf5_type< float >() - { - return H5Tcopy(H5T_NATIVE_FLOAT); - } - -template<> -inline -hid_t -get_hdf5_type< double >() - { - return H5Tcopy(H5T_NATIVE_DOUBLE); - } - - - -//! Utility hid_t since HOFFSET() won't work with std::complex. -template -struct hdf5_complex_t - { - eT real; - eT imag; - }; - - - -template<> -inline -hid_t -get_hdf5_type< std::complex >() - { - hid_t type = H5Tcreate(H5T_COMPOUND, sizeof(hdf5_complex_t)); - - H5Tinsert(type, "real", HOFFSET(hdf5_complex_t, real), H5T_NATIVE_FLOAT); - H5Tinsert(type, "imag", HOFFSET(hdf5_complex_t, imag), H5T_NATIVE_FLOAT); - - return type; - } - - - -template<> -inline -hid_t -get_hdf5_type< std::complex >() - { - hid_t type = H5Tcreate(H5T_COMPOUND, sizeof(hdf5_complex_t)); - - H5Tinsert(type, "real", HOFFSET(hdf5_complex_t, real), H5T_NATIVE_DOUBLE); - H5Tinsert(type, "imag", HOFFSET(hdf5_complex_t, imag), H5T_NATIVE_DOUBLE); - - return type; - } - - - -// Compare datatype against all supported types. -inline -bool -is_supported_arma_hdf5_type(hid_t datatype) - { - hid_t search_type; - - bool is_equal; - - - // start with most likely used types: double, complex, float, complex - - search_type = get_hdf5_type(); - is_equal = ( H5Tequal(datatype, search_type) > 0 ); - H5Tclose(search_type); - if(is_equal) { return true; } - - search_type = get_hdf5_type< std::complex >(); - is_equal = ( H5Tequal(datatype, search_type) > 0 ); - H5Tclose(search_type); - if(is_equal) { return true; } - - search_type = get_hdf5_type(); - is_equal = ( H5Tequal(datatype, search_type) > 0 ); - H5Tclose(search_type); - if(is_equal) { return true; } - - search_type = get_hdf5_type< std::complex >(); - is_equal = ( H5Tequal(datatype, search_type) > 0 ); - H5Tclose(search_type); - if(is_equal) { return true; } - - - // remaining supported types: u8, s8, u16, s16, u32, s32, u64, s64, ulng_t, slng_t - - search_type = get_hdf5_type(); - is_equal = ( H5Tequal(datatype, search_type) > 0 ); - H5Tclose(search_type); - if(is_equal) { return true; } - - search_type = get_hdf5_type(); - is_equal = ( H5Tequal(datatype, search_type) > 0 ); - H5Tclose(search_type); - if(is_equal) { return true; } - - search_type = get_hdf5_type(); - is_equal = ( H5Tequal(datatype, search_type) > 0 ); - H5Tclose(search_type); - if(is_equal) { return true; } - - search_type = get_hdf5_type(); - is_equal = ( H5Tequal(datatype, search_type) > 0 ); - H5Tclose(search_type); - if(is_equal) { return true; } - - search_type = get_hdf5_type(); - is_equal = ( H5Tequal(datatype, search_type) > 0 ); - H5Tclose(search_type); - if(is_equal) { return true; } - - search_type = get_hdf5_type(); - is_equal = ( H5Tequal(datatype, search_type) > 0 ); - H5Tclose(search_type); - if(is_equal) { return true; } - - search_type = get_hdf5_type(); - is_equal = ( H5Tequal(datatype, search_type) > 0 ); - H5Tclose(search_type); - if(is_equal) { return true; } - - search_type = get_hdf5_type(); - is_equal = ( H5Tequal(datatype, search_type) > 0 ); - H5Tclose(search_type); - if(is_equal) { return true; } - - search_type = get_hdf5_type(); - is_equal = ( H5Tequal(datatype, search_type) > 0 ); - H5Tclose(search_type); - if(is_equal) { return true; } - - search_type = get_hdf5_type(); - is_equal = ( H5Tequal(datatype, search_type) > 0 ); - H5Tclose(search_type); - if(is_equal) { return true; } - - return false; - } - - - -//! Auxiliary functions and structs for search_hdf5_file. -struct hdf5_search_info - { - const std::vector& names; - int num_dims; - bool exact; - hid_t best_match; - size_t best_match_position; // Position of best match in names vector. - }; - - - -inline -herr_t -hdf5_search_callback - ( - hid_t loc_id, - const char* name, - const H5O_info_t* info, - void* operator_data // hdf5_search_info - ) - { - hdf5_search_info* search_info = (hdf5_search_info*) operator_data; - - // We are looking for datasets. - if(info->type == H5O_TYPE_DATASET) - { - // Check type of dataset to see if we could even load it. - hid_t dataset = H5Dopen(loc_id, name, H5P_DEFAULT); - hid_t datatype = H5Dget_type(dataset); - - const bool is_supported = is_supported_arma_hdf5_type(datatype); - - H5Tclose(datatype); - H5Dclose(dataset); - - if(is_supported == false) - { - // Forget about it and move on. - return 0; - } - - // Now we have to check against our set of names. - // Only check names which could be better. - for(size_t string_pos = 0; string_pos < search_info->best_match_position; ++string_pos) - { - // name is the full path (/path/to/dataset); names[string_pos] may be - // "dataset", "/to/dataset", or "/path/to/dataset". - // So if we count the number of forward slashes in names[string_pos], - // and then simply take the last substring of name containing that number of slashes, - // we can do the comparison. - - // Count the number of forward slashes in names[string_pos]. - uword name_count = 0; - for(uword i = 0; i < search_info->names[string_pos].length(); ++i) - { - if((search_info->names[string_pos])[i] == '/') { ++name_count; } - } - - // Count the number of forward slashes in the full name. - uword count = 0; - const std::string str = std::string(name); - for(uword i = 0; i < str.length(); ++i) - { - if(str[i] == '/') { ++count; } - } - - // Is the full string the same? - if(str == search_info->names[string_pos]) - { - // We found it exactly. - hid_t match_candidate = H5Dopen(loc_id, name, H5P_DEFAULT); - - if(match_candidate < 0) - { - return -1; - } - - // Ensure that the dataset is valid and of the correct dimensionality. - hid_t filespace = H5Dget_space(match_candidate); - int num_dims = H5Sget_simple_extent_ndims(filespace); - - if(num_dims <= search_info->num_dims) - { - // Valid dataset -- we'll keep it. - // If we already have an existing match we have to close it. - if(search_info->best_match != -1) - { - H5Dclose(search_info->best_match); - } - - search_info->best_match_position = string_pos; - search_info->best_match = match_candidate; - } - - H5Sclose(filespace); - // There is no possibility of anything better, so terminate the search. - return 1; - } - - // If we are asking for more slashes than we have, this can't be a match. - // Skip to below, where we decide whether or not to keep it anyway based - // on the exactness condition of the search. - if(count <= name_count) - { - size_t start_pos = (count == 0) ? 0 : std::string::npos; - while(count > 0) - { - // Move pointer to previous slash. - start_pos = str.rfind('/', start_pos); - - // Break if we've run out of slashes. - if(start_pos == std::string::npos) { break; } - - --count; - } - - // Now take the substring (this may end up being the full string). - const std::string substring = str.substr(start_pos); - - // Are they the same? - if(substring == search_info->names[string_pos]) - { - // We have found the object; it must be better than our existing match. - hid_t match_candidate = H5Dopen(loc_id, name, H5P_DEFAULT); - - - // arma_check(match_candidate < 0, "Mat::load(): cannot open an HDF5 dataset"); - if(match_candidate < 0) - { - return -1; - } - - - // Ensure that the dataset is valid and of the correct dimensionality. - hid_t filespace = H5Dget_space(match_candidate); - int num_dims = H5Sget_simple_extent_ndims(filespace); - - if(num_dims <= search_info->num_dims) - { - // Valid dataset -- we'll keep it. - // If we already have an existing match we have to close it. - if(search_info->best_match != -1) - { - H5Dclose(search_info->best_match); - } - - search_info->best_match_position = string_pos; - search_info->best_match = match_candidate; - } - - H5Sclose(filespace); - } - } - - - // If they are not the same, but we have not found anything and we don't need an exact match, take this. - if((search_info->exact == false) && (search_info->best_match == -1)) - { - hid_t match_candidate = H5Dopen(loc_id, name, H5P_DEFAULT); - - // arma_check(match_candidate < 0, "Mat::load(): cannot open an HDF5 dataset"); - if(match_candidate < 0) - { - return -1; - } - - hid_t filespace = H5Dget_space(match_candidate); - int num_dims = H5Sget_simple_extent_ndims(filespace); - - if(num_dims <= search_info->num_dims) - { - // Valid dataset -- we'll keep it. - search_info->best_match = H5Dopen(loc_id, name, H5P_DEFAULT); - } - - H5Sclose(filespace); - } - } - } - - return 0; - } - - - -//! Search an HDF5 file for the given dataset names. -//! If 'exact' is true, failure to find a dataset in the list of names means that -1 is returned. -//! If 'exact' is false and no datasets are found, -1 is returned. -//! The number of dimensions is used to help prune down invalid datasets; -//! 2 dimensions is a matrix, 1 dimension is a vector, and 3 dimensions is a cube. -//! If the number of dimensions in a dataset is less than or equal to num_dims, -//! it will be considered -- for instance, a one-dimensional HDF5 vector can be loaded as a single-column matrix. -inline -hid_t -search_hdf5_file - ( - const std::vector& names, - hid_t hdf5_file, - int num_dims = 2, - bool exact = false - ) - { - hdf5_search_info search_info = { names, num_dims, exact, -1, names.size() }; - - // We'll use the H5Ovisit to track potential entries. - herr_t status = H5Ovisit(hdf5_file, H5_INDEX_NAME, H5_ITER_NATIVE, hdf5_search_callback, void_ptr(&search_info)); - - // Return the best match; it will be -1 if there was a problem. - return (status < 0) ? -1 : search_info.best_match; - } - - - -//! Load an HDF5 matrix into an array of type specified by datatype, -//! then convert that into the desired array 'dest'. -//! This should only be called when eT is not the datatype. -template -inline -hid_t -load_and_convert_hdf5 - ( - eT *dest, - hid_t dataset, - hid_t datatype, - uword n_elem - ) - { - - // We can't use nice template specializations here - // as the determination of the type of 'datatype' must be done at runtime. - // So we end up with this ugliness... - hid_t search_type; - - bool is_equal; - - - // u8 - search_type = get_hdf5_type(); - is_equal = (H5Tequal(datatype, search_type) > 0); - H5Tclose(search_type); - - if(is_equal) - { - Col v(n_elem, arma_nozeros_indicator()); - hid_t status = H5Dread(dataset, datatype, H5S_ALL, H5S_ALL, H5P_DEFAULT, void_ptr(v.memptr())); - arrayops::convert(dest, v.memptr(), n_elem); - - return status; - } - - - // s8 - search_type = get_hdf5_type(); - is_equal = (H5Tequal(datatype, search_type) > 0); - H5Tclose(search_type); - - if(is_equal) - { - Col v(n_elem, arma_nozeros_indicator()); - hid_t status = H5Dread(dataset, datatype, H5S_ALL, H5S_ALL, H5P_DEFAULT, void_ptr(v.memptr())); - arrayops::convert(dest, v.memptr(), n_elem); - - return status; - } - - - // u16 - search_type = get_hdf5_type(); - is_equal = (H5Tequal(datatype, search_type) > 0); - H5Tclose(search_type); - - if(is_equal) - { - Col v(n_elem, arma_nozeros_indicator()); - hid_t status = H5Dread(dataset, datatype, H5S_ALL, H5S_ALL, H5P_DEFAULT, void_ptr(v.memptr())); - arrayops::convert(dest, v.memptr(), n_elem); - - return status; - } - - - // s16 - search_type = get_hdf5_type(); - is_equal = (H5Tequal(datatype, search_type) > 0); - H5Tclose(search_type); - - if(is_equal) - { - Col v(n_elem, arma_nozeros_indicator()); - hid_t status = H5Dread(dataset, datatype, H5S_ALL, H5S_ALL, H5P_DEFAULT, void_ptr(v.memptr())); - arrayops::convert(dest, v.memptr(), n_elem); - - return status; - } - - - // u32 - search_type = get_hdf5_type(); - is_equal = (H5Tequal(datatype, search_type) > 0); - H5Tclose(search_type); - - if(is_equal) - { - Col v(n_elem, arma_nozeros_indicator()); - hid_t status = H5Dread(dataset, datatype, H5S_ALL, H5S_ALL, H5P_DEFAULT, void_ptr(v.memptr())); - arrayops::convert(dest, v.memptr(), n_elem); - - return status; - } - - - // s32 - search_type = get_hdf5_type(); - is_equal = (H5Tequal(datatype, search_type) > 0); - H5Tclose(search_type); - - if(is_equal) - { - Col v(n_elem, arma_nozeros_indicator()); - hid_t status = H5Dread(dataset, datatype, H5S_ALL, H5S_ALL, H5P_DEFAULT, void_ptr(v.memptr())); - arrayops::convert(dest, v.memptr(), n_elem); - - return status; - } - - - // u64 - search_type = get_hdf5_type(); - is_equal = (H5Tequal(datatype, search_type) > 0); - H5Tclose(search_type); - - if(is_equal) - { - Col v(n_elem, arma_nozeros_indicator()); - hid_t status = H5Dread(dataset, datatype, H5S_ALL, H5S_ALL, H5P_DEFAULT, void_ptr(v.memptr())); - arrayops::convert(dest, v.memptr(), n_elem); - - return status; - } - - - // s64 - search_type = get_hdf5_type(); - is_equal = (H5Tequal(datatype, search_type) > 0); - H5Tclose(search_type); - - if(is_equal) - { - Col v(n_elem, arma_nozeros_indicator()); - hid_t status = H5Dread(dataset, datatype, H5S_ALL, H5S_ALL, H5P_DEFAULT, void_ptr(v.memptr())); - arrayops::convert(dest, v.memptr(), n_elem); - - return status; - } - - - // ulng_t - search_type = get_hdf5_type(); - is_equal = (H5Tequal(datatype, search_type) > 0); - H5Tclose(search_type); - - if(is_equal) - { - Col v(n_elem, arma_nozeros_indicator()); - hid_t status = H5Dread(dataset, datatype, H5S_ALL, H5S_ALL, H5P_DEFAULT, void_ptr(v.memptr())); - arrayops::convert(dest, v.memptr(), n_elem); - - return status; - } - - - // slng_t - search_type = get_hdf5_type(); - is_equal = (H5Tequal(datatype, search_type) > 0); - H5Tclose(search_type); - - if(is_equal) - { - Col v(n_elem, arma_nozeros_indicator()); - hid_t status = H5Dread(dataset, datatype, H5S_ALL, H5S_ALL, H5P_DEFAULT, void_ptr(v.memptr())); - arrayops::convert(dest, v.memptr(), n_elem); - - return status; - } - - - // float - search_type = get_hdf5_type(); - is_equal = (H5Tequal(datatype, search_type) > 0); - H5Tclose(search_type); - - if(is_equal) - { - Col v(n_elem, arma_nozeros_indicator()); - hid_t status = H5Dread(dataset, datatype, H5S_ALL, H5S_ALL, H5P_DEFAULT, void_ptr(v.memptr())); - arrayops::convert(dest, v.memptr(), n_elem); - - return status; - } - - - // double - search_type = get_hdf5_type(); - is_equal = (H5Tequal(datatype, search_type) > 0); - H5Tclose(search_type); - - if(is_equal) - { - Col v(n_elem, arma_nozeros_indicator()); - hid_t status = H5Dread(dataset, datatype, H5S_ALL, H5S_ALL, H5P_DEFAULT, void_ptr(v.memptr())); - arrayops::convert(dest, v.memptr(), n_elem); - - return status; - } - - - // complex float - search_type = get_hdf5_type< std::complex >(); - is_equal = (H5Tequal(datatype, search_type) > 0); - H5Tclose(search_type); - - if(is_equal) - { - if(is_cx::no) - { - return -1; // can't read complex data into non-complex matrix/cube - } - - Col< std::complex > v(n_elem, arma_nozeros_indicator()); - hid_t status = H5Dread(dataset, datatype, H5S_ALL, H5S_ALL, H5P_DEFAULT, void_ptr(v.memptr())); - arrayops::convert_cx(dest, v.memptr(), n_elem); - - return status; - } - - - // complex double - search_type = get_hdf5_type< std::complex >(); - is_equal = (H5Tequal(datatype, search_type) > 0); - H5Tclose(search_type); - - if(is_equal) - { - if(is_cx::no) - { - return -1; // can't read complex data into non-complex matrix/cube - } - - Col< std::complex > v(n_elem, arma_nozeros_indicator()); - hid_t status = H5Dread(dataset, datatype, H5S_ALL, H5S_ALL, H5P_DEFAULT, void_ptr(v.memptr())); - arrayops::convert_cx(dest, v.memptr(), n_elem); - - return status; - } - - - return -1; // Failure. - } - - - -struct hdf5_suspend_printing_errors - { - #if (ARMA_WARN_LEVEL >= 3) - - inline - hdf5_suspend_printing_errors() {} - - #else - - herr_t (*old_client_func)(hid_t, void*); - void* old_client_data; - - inline - hdf5_suspend_printing_errors() - { - // Save old error handler. - H5Eget_auto(H5E_DEFAULT, &old_client_func, &old_client_data); - - // Disable annoying HDF5 error messages. - H5Eset_auto(H5E_DEFAULT, NULL, NULL); - } - - inline - ~hdf5_suspend_printing_errors() - { - H5Eset_auto(H5E_DEFAULT, old_client_func, old_client_data); - } - - #endif - }; - - - -} // namespace hdf5_misc -#endif // #if defined(ARMA_USE_HDF5) - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/hdf5_name.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/hdf5_name.hpp deleted file mode 100644 index 8dd38ccf7..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/hdf5_name.hpp +++ /dev/null @@ -1,93 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup diskio -//! @{ - - -namespace hdf5_opts - { - typedef unsigned int flag_type; - - struct opts - { - const flag_type flags; - - inline constexpr explicit opts(const flag_type in_flags); - - inline const opts operator+(const opts& rhs) const; - }; - - inline - constexpr - opts::opts(const flag_type in_flags) - : flags(in_flags) - {} - - inline - const opts - opts::operator+(const opts& rhs) const - { - const opts result( flags | rhs.flags ); - - return result; - } - - // The values below (eg. 1u << 0) are for internal Armadillo use only. - // The values can change without notice. - - static constexpr flag_type flag_none = flag_type(0 ); - static constexpr flag_type flag_trans = flag_type(1u << 0); - static constexpr flag_type flag_append = flag_type(1u << 1); - static constexpr flag_type flag_replace = flag_type(1u << 2); - - struct opts_none : public opts { inline constexpr opts_none() : opts(flag_none ) {} }; - struct opts_trans : public opts { inline constexpr opts_trans() : opts(flag_trans ) {} }; - struct opts_append : public opts { inline constexpr opts_append() : opts(flag_append ) {} }; - struct opts_replace : public opts { inline constexpr opts_replace() : opts(flag_replace) {} }; - - static constexpr opts_none none; - static constexpr opts_trans trans; - static constexpr opts_append append; - static constexpr opts_replace replace; - } - - -struct hdf5_name - { - const std::string filename; - const std::string dsname; - const hdf5_opts::opts opts; - - inline - hdf5_name(const std::string& in_filename) - : filename(in_filename ) - , dsname (std::string() ) - , opts (hdf5_opts::none) - {} - - inline - hdf5_name(const std::string& in_filename, const std::string& in_dsname, const hdf5_opts::opts& in_opts = hdf5_opts::none) - : filename(in_filename) - , dsname (in_dsname ) - , opts (in_opts ) - {} - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/include_hdf5.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/include_hdf5.hpp deleted file mode 100644 index a639f78a1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/include_hdf5.hpp +++ /dev/null @@ -1,45 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -#if defined(ARMA_USE_HDF5) - - #undef H5_USE_110_API - #define H5_USE_110_API - - #if defined(__has_include) - #if __has_include() - #include - #else - #undef ARMA_USE_HDF5 - #pragma message ("WARNING: use of HDF5 disabled; hdf5.h header not found") - #endif - #else - #include - #endif - - #if defined(H5_USE_16_API) || defined(H5_USE_16_API_DEFAULT) - #pragma message ("WARNING: use of HDF5 disabled; incompatible configuration: H5_USE_16_API or H5_USE_16_API_DEFAULT") - #undef ARMA_USE_HDF5 - #endif - - // // TODO - // #if defined(H5_USE_18_API) || defined(H5_USE_18_API_DEFAULT) - // #pragma message ("WARNING: detected possibly incompatible configuration of HDF5: H5_USE_18_API or H5_USE_18_API_DEFAULT") - // #endif - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/include_superlu.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/include_superlu.hpp deleted file mode 100644 index 43fa0a732..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/include_superlu.hpp +++ /dev/null @@ -1,393 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 AND BSD-3-Clause -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// -// ------------------------------------------------------------------------ -// -// This file includes portions of SuperLU 5.2 software, -// licensed under the following conditions. -// -// Copyright (c) 2003, The Regents of the University of California, through -// Lawrence Berkeley National Laboratory (subject to receipt of any required -// approvals from U.S. Dept. of Energy) -// -// All rights reserved. -// -// Redistribution and use in source and binary forms, with or without -// modification, are permitted provided that the following conditions are met: -// -// (1) Redistributions of source code must retain the above copyright notice, -// this list of conditions and the following disclaimer. -// (2) Redistributions in binary form must reproduce the above copyright notice, -// this list of conditions and the following disclaimer in the documentation -// and/or other materials provided with the distribution. -// (3) Neither the name of Lawrence Berkeley National Laboratory, U.S. Dept. of -// Energy nor the names of its contributors may be used to endorse or promote -// products derived from this software without specific prior written permission. -// -// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, -// THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -// PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR -// CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, -// EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -// PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; -// OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -// WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE -// OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, -// EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -// -// ------------------------------------------------------------------------ - - -#if defined(ARMA_USE_SUPERLU) - -#undef ARMA_SLU_HEADERS_FOUND - -// Since we need to suport float, double, cx_float and cx_double, -// as well as preserve the sanity of the user, -// we cannot simply include all the SuperLU headers due to their messy state -// (duplicate definitions, pollution of global namespace, bizarro defines). -// As such we are forced to include only a subset of the headers -// and manually specify a few SuperLU structures and function prototypes. -// -// CAVEAT: -// This code requires SuperLU version 5.2, -// and assumes that newer 5.x versions will have no API changes. - -namespace arma -{ -namespace superlu - { - // slu_*defs.h has int typedefed to int_t. - // I'll just write it as int for simplicity, where I can, but supermatrix.h needs int_t. - typedef int int_t; - } -} - -#if defined(ARMA_USE_SUPERLU_HEADERS) || defined(ARMA_SUPERLU_INCLUDE_DIR) - -namespace arma -{ -namespace superlu - { - // Include supermatrix.h. This gives us SuperMatrix. - // Put it in the slu namespace. - // For versions of SuperLU I am familiar with, supermatrix.h does not include any other files. - // Therefore, putting it in the superlu namespace is reasonably safe. - // This same reasoning is true for superlu_enum_consts.h. - - #undef ARMA_SLU_HEADER_A - #undef ARMA_SLU_HEADER_B - - #if defined(ARMA_SUPERLU_INCLUDE_DIR) - #undef ARMA_SLU_STR1 - #undef ARMA_SLU_STR2 - - #define ARMA_SLU_STR1(x) x - #define ARMA_SLU_STR2(x) ARMA_SLU_STR1(x) - - #define ARMA_SLU_HEADER_A ARMA_SLU_STR2(ARMA_SUPERLU_INCLUDE_DIR)ARMA_SLU_STR2(supermatrix.h) - #define ARMA_SLU_HEADER_B ARMA_SLU_STR2(ARMA_SUPERLU_INCLUDE_DIR)ARMA_SLU_STR2(superlu_enum_consts.h) - #else - #define ARMA_SLU_HEADER_A supermatrix.h - #define ARMA_SLU_HEADER_B superlu_enum_consts.h - #endif - - #if defined(__has_include) - #if __has_include(ARMA_INCFILE_WRAP(ARMA_SLU_HEADER_A)) && __has_include(ARMA_INCFILE_WRAP(ARMA_SLU_HEADER_B)) - #include ARMA_INCFILE_WRAP(ARMA_SLU_HEADER_A) - #include ARMA_INCFILE_WRAP(ARMA_SLU_HEADER_B) - #define ARMA_SLU_HEADERS_FOUND - #endif - #else - #include ARMA_INCFILE_WRAP(ARMA_SLU_HEADER_A) - #include ARMA_INCFILE_WRAP(ARMA_SLU_HEADER_B) - #define ARMA_SLU_HEADERS_FOUND - #endif - - #undef ARMA_SLU_STR1 - #undef ARMA_SLU_STR2 - - #undef ARMA_SLU_HEADER_A - #undef ARMA_SLU_HEADER_B - - #if defined(ARMA_SLU_HEADERS_FOUND) - - typedef struct - { - int* panel_histo; - double* utime; - float* ops; - int TinyPivots; - int RefineSteps; - int expansions; - } SuperLUStat_t; - - typedef struct - { - fact_t Fact; - yes_no_t Equil; - colperm_t ColPerm; - trans_t Trans; - IterRefine_t IterRefine; - double DiagPivotThresh; - yes_no_t SymmetricMode; - yes_no_t PivotGrowth; - yes_no_t ConditionNumber; - rowperm_t RowPerm; - int ILU_DropRule; - double ILU_DropTol; - double ILU_FillFactor; - norm_t ILU_Norm; - double ILU_FillTol; - milu_t ILU_MILU; - double ILU_MILU_Dim; - yes_no_t ParSymbFact; - yes_no_t ReplaceTinyPivot; - yes_no_t SolveInitialized; - yes_no_t RefineInitialized; - yes_no_t PrintStat; - int nnzL, nnzU; - int num_lookaheads; - yes_no_t lookahead_etree; - yes_no_t SymPattern; - } superlu_options_t; - - typedef struct - { - float for_lu; - float total_needed; - } mem_usage_t; - - typedef struct e_node - { - int size; - void* mem; - } ExpHeader; - - typedef struct - { - int size; - int used; - int top1; - int top2; - void* array; - } LU_stack_t; - - typedef struct - { - int* xsup; - int* supno; - int* lsub; - int* xlsub; - void* lusup; - int* xlusup; - void* ucol; - int* usub; - int* xusub; - int nzlmax; - int nzumax; - int nzlumax; - int n; - LU_space_t MemModel; - int num_expansions; - ExpHeader* expanders; - LU_stack_t stack; - } GlobalLU_t; - - #endif - } -} - - -#endif - -#if defined(ARMA_USE_SUPERLU_HEADERS) && !defined(ARMA_SLU_HEADERS_FOUND) - #undef ARMA_USE_SUPERLU - #pragma message ("WARNING: use of SuperLU disabled; required headers not found") -#endif - -#endif - - - -#if defined(ARMA_USE_SUPERLU) && !defined(ARMA_SLU_HEADERS_FOUND) - -// Not using any SuperLU headers, so define all required enums and structs. - -#if defined(ARMA_SUPERLU_INCLUDE_DIR) - #pragma message ("WARNING: SuperLU headers not found; using built-in definitions") -#endif - -namespace arma -{ -namespace superlu - { - typedef enum - { - SLU_NC, - SLU_NCP, - SLU_NR, - SLU_SC, - SLU_SCP, - SLU_SR, - SLU_DN, - SLU_NR_loc - } Stype_t; - - typedef enum - { - SLU_S, - SLU_D, - SLU_C, - SLU_Z - } Dtype_t; - - typedef enum - { - SLU_GE, - SLU_TRLU, - SLU_TRUU, - SLU_TRL, - SLU_TRU, - SLU_SYL, - SLU_SYU, - SLU_HEL, - SLU_HEU - } Mtype_t; - - typedef struct - { - Stype_t Stype; - Dtype_t Dtype; - Mtype_t Mtype; - int_t nrow; - int_t ncol; - void* Store; - } SuperMatrix; - - typedef struct - { - int* panel_histo; - double* utime; - float* ops; - int TinyPivots; - int RefineSteps; - int expansions; - } SuperLUStat_t; - - typedef enum {NO, YES} yes_no_t; - typedef enum {DOFACT, SamePattern, SamePattern_SameRowPerm, FACTORED} fact_t; - typedef enum {NOROWPERM, LargeDiag, MY_PERMR} rowperm_t; - typedef enum {NATURAL, MMD_ATA, MMD_AT_PLUS_A, COLAMD, - METIS_AT_PLUS_A, PARMETIS, ZOLTAN, MY_PERMC} colperm_t; - typedef enum {NOTRANS, TRANS, CONJ} trans_t; - typedef enum {NOREFINE, SLU_SINGLE=1, SLU_DOUBLE, SLU_EXTRA} IterRefine_t; - typedef enum {SYSTEM, USER} LU_space_t; - typedef enum {ONE_NORM, TWO_NORM, INF_NORM} norm_t; - typedef enum {SILU, SMILU_1, SMILU_2, SMILU_3} milu_t; - - typedef struct - { - fact_t Fact; - yes_no_t Equil; - colperm_t ColPerm; - trans_t Trans; - IterRefine_t IterRefine; - double DiagPivotThresh; - yes_no_t SymmetricMode; - yes_no_t PivotGrowth; - yes_no_t ConditionNumber; - rowperm_t RowPerm; - int ILU_DropRule; - double ILU_DropTol; - double ILU_FillFactor; - norm_t ILU_Norm; - double ILU_FillTol; - milu_t ILU_MILU; - double ILU_MILU_Dim; - yes_no_t ParSymbFact; - yes_no_t ReplaceTinyPivot; - yes_no_t SolveInitialized; - yes_no_t RefineInitialized; - yes_no_t PrintStat; - int nnzL, nnzU; - int num_lookaheads; - yes_no_t lookahead_etree; - yes_no_t SymPattern; - } superlu_options_t; - - typedef struct - { - float for_lu; - float total_needed; - } mem_usage_t; - - typedef struct - { - int_t nnz; - void* nzval; - int_t* rowind; - int_t* colptr; - } NCformat; - - typedef struct - { - int_t lda; - void* nzval; - } DNformat; - - typedef struct e_node - { - int size; - void* mem; - } ExpHeader; - - typedef struct - { - int size; - int used; - int top1; - int top2; - void* array; - } LU_stack_t; - - typedef struct - { - int* xsup; - int* supno; - int* lsub; - int* xlsub; - void* lusup; - int* xlusup; - void* ucol; - int* usub; - int* xusub; - int nzlmax; - int nzumax; - int nzlumax; - int n; - LU_space_t MemModel; - int num_expansions; - ExpHeader* expanders; - LU_stack_t stack; - } GlobalLU_t; - } -} - -#undef ARMA_SLU_HEADERS_FOUND - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/injector_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/injector_bones.hpp deleted file mode 100644 index 80e2a1732..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/injector_bones.hpp +++ /dev/null @@ -1,84 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup injector -//! @{ - - - -template -class mat_injector - { - public: - - typedef typename T1::elem_type elem_type; - - arma_cold inline void insert(const elem_type val) const; - arma_cold inline void end_of_row() const; - arma_cold inline ~mat_injector(); - - - private: - - inline mat_injector(T1& in_X, const elem_type val); - inline mat_injector(T1& in_X, const injector_end_of_row<>&); - - T1& parent; - - mutable std::vector values; - mutable std::vector rowend; - - friend class Mat; - friend class Row; - friend class Col; - }; - - - -// - - - -template -class field_injector - { - public: - - typedef typename T1::object_type object_type; - - arma_cold inline void insert(const object_type& val) const; - arma_cold inline void end_of_row() const; - arma_cold inline ~field_injector(); - - - private: - - inline field_injector(T1& in_X, const object_type& val); - inline field_injector(T1& in_X, const injector_end_of_row<>&); - - T1& parent; - - mutable std::vector values; - mutable std::vector rowend; - - friend class field; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/injector_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/injector_meat.hpp deleted file mode 100644 index 0c07d7278..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/injector_meat.hpp +++ /dev/null @@ -1,379 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup injector -//! @{ - - - -template -inline -mat_injector::mat_injector(T1& in_parent, const typename mat_injector::elem_type val) - : parent(in_parent) - { - arma_debug_sigprint(); - - values.reserve(16); - rowend.reserve(16); - - insert(val); - } - - - -template -inline -mat_injector::mat_injector(T1& in_parent, const injector_end_of_row<>&) - : parent(in_parent) - { - arma_debug_sigprint(); - - values.reserve(16); - rowend.reserve(16); - - end_of_row(); - } - - - -template -inline -mat_injector::~mat_injector() - { - arma_debug_sigprint(); - - const uword N = values.size(); - - if(N == 0) { return; } - - uword n_rows = 1; - uword n_cols = 0; - - for(uword i=0; i::value) - { - arma_conform_check( (n_rows > 1), "matrix initialisation: incompatible dimensions" ); - - parent.zeros(1,n_cols); - - uword col = 0; - - for(uword i=0; i::value) - { - const bool is_vec = ((n_cols == 1) || (n_rows == 1)); - - arma_conform_check( (is_vec == false), "matrix initialisation: incompatible dimensions" ); - - if(n_cols == 1) - { - parent.zeros(n_rows,1); - - uword row = 0; - - for(uword i=0; i 0) && rowend[i-1]) { ++row; } - } - else - { - parent.at(row) = values[i]; - ++row; - } - } - } - else - if(n_rows == 1) - { - parent.zeros(n_cols,1); - - uword row = 0; - - for(uword i=0; i -inline -void -mat_injector::insert(const typename mat_injector::elem_type val) const - { - arma_debug_sigprint(); - - values.push_back(val ); - rowend.push_back(char(0)); - } - - - - -template -inline -void -mat_injector::end_of_row() const - { - arma_debug_sigprint(); - - typedef typename mat_injector::elem_type eT; - - values.push_back( eT(0)); - rowend.push_back(char(1)); - } - - - -template -inline -const mat_injector& -operator<<(const mat_injector& ref, const typename mat_injector::elem_type val) - { - arma_debug_sigprint(); - - ref.insert(val); - - return ref; - } - - - -template -inline -const mat_injector& -operator<<(const mat_injector& ref, const injector_end_of_row<>&) - { - arma_debug_sigprint(); - - ref.end_of_row(); - - return ref; - } - - - -// -// -// - - - -template -inline -field_injector::field_injector(T1& in_parent, const typename field_injector::object_type& val) - : parent(in_parent) - { - arma_debug_sigprint(); - - insert(val); - } - - - -template -inline -field_injector::field_injector(T1& in_parent, const injector_end_of_row<>&) - : parent(in_parent) - { - arma_debug_sigprint(); - - end_of_row(); - } - - - -template -inline -field_injector::~field_injector() - { - arma_debug_sigprint(); - - const uword N = values.size(); - - if(N == 0) { return; } - - uword n_rows = 1; - uword n_cols = 0; - - for(uword i=0; i -inline -void -field_injector::insert(const typename field_injector::object_type& val) const - { - arma_debug_sigprint(); - - values.push_back(val ); - rowend.push_back(char(0)); - } - - - - -template -inline -void -field_injector::end_of_row() const - { - arma_debug_sigprint(); - - typedef typename field_injector::object_type oT; - - values.push_back(oT() ); - rowend.push_back(char(1)); - } - - - -template -inline -const field_injector& -operator<<(const field_injector& ref, const typename field_injector::object_type& val) - { - arma_debug_sigprint(); - - ref.insert(val); - - return ref; - } - - - -template -inline -const field_injector& -operator<<(const field_injector& ref, const injector_end_of_row<>&) - { - arma_debug_sigprint(); - - ref.end_of_row(); - - return ref; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/memory.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/memory.hpp deleted file mode 100644 index 34547e613..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/memory.hpp +++ /dev/null @@ -1,210 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup memory -//! @{ - - -class memory - { - public: - - template arma_malloc inline static eT* acquire(const uword n_elem); - - template arma_inline static void release(eT* mem); - - template arma_inline static bool is_aligned(const eT* mem); - template arma_inline static void mark_as_aligned( eT*& mem); - template arma_inline static void mark_as_aligned(const eT*& mem); - }; - - - -template -arma_malloc -inline -eT* -memory::acquire(const uword n_elem) - { - if(n_elem == 0) { return nullptr; } - - arma_conform_check - ( - ( size_t(n_elem) > (std::numeric_limits::max() / sizeof(eT)) ), - "arma::memory::acquire(): requested size is too large" - ); - - eT* out_memptr; - - #if defined(ARMA_ALIEN_MEM_ALLOC_FUNCTION) - { - out_memptr = (eT *) ARMA_ALIEN_MEM_ALLOC_FUNCTION(sizeof(eT)*n_elem); - } - #elif defined(ARMA_USE_TBB_ALLOC) - { - out_memptr = (eT *) scalable_malloc(sizeof(eT)*n_elem); - } - #elif defined(ARMA_USE_MKL_ALLOC) - { - out_memptr = (eT *) mkl_malloc( sizeof(eT)*n_elem, 32 ); - } - #elif defined(ARMA_HAVE_POSIX_MEMALIGN) - { - eT* memptr = nullptr; - - const size_t n_bytes = sizeof(eT)*size_t(n_elem); - const size_t alignment = (n_bytes >= size_t(1024)) ? size_t(32) : size_t(16); - - // TODO: investigate apparent memory leak when using alignment >= 64 (as shown on Fedora 28, glibc 2.27) - int status = posix_memalign((void **)&memptr, ( (alignment >= sizeof(void*)) ? alignment : sizeof(void*) ), n_bytes); - - out_memptr = (status == 0) ? memptr : nullptr; - } - #elif defined(_MSC_VER) - { - // Windoze is too primitive to handle C++17 std::aligned_alloc() - - //out_memptr = (eT *) malloc(sizeof(eT)*n_elem); - //out_memptr = (eT *) _aligned_malloc( sizeof(eT)*n_elem, 16 ); // lives in malloc.h - - const size_t n_bytes = sizeof(eT)*size_t(n_elem); - const size_t alignment = (n_bytes >= size_t(1024)) ? size_t(32) : size_t(16); - - out_memptr = (eT *) _aligned_malloc( n_bytes, alignment ); - } - #else - { - //return ( new(std::nothrow) eT[n_elem] ); - out_memptr = (eT *) malloc(sizeof(eT)*n_elem); - } - #endif - - // TODO: for mingw, use __mingw_aligned_malloc - - arma_check_bad_alloc( (out_memptr == nullptr), "arma::memory::acquire(): out of memory" ); - - return out_memptr; - } - - - -template -arma_inline -void -memory::release(eT* mem) - { - if(mem == nullptr) { return; } - - #if defined(ARMA_ALIEN_MEM_FREE_FUNCTION) - { - ARMA_ALIEN_MEM_FREE_FUNCTION( (void *)(mem) ); - } - #elif defined(ARMA_USE_TBB_ALLOC) - { - scalable_free( (void *)(mem) ); - } - #elif defined(ARMA_USE_MKL_ALLOC) - { - mkl_free( (void *)(mem) ); - } - #elif defined(ARMA_HAVE_POSIX_MEMALIGN) - { - free( (void *)(mem) ); - } - #elif defined(_MSC_VER) - { - //free( (void *)(mem) ); - _aligned_free( (void *)(mem) ); - } - #else - { - //delete [] mem; - free( (void *)(mem) ); - } - #endif - - // TODO: for mingw, use __mingw_aligned_free - } - - - -template -arma_inline -bool -memory::is_aligned(const eT* mem) - { - #if (defined(ARMA_HAVE_GCC_ASSUME_ALIGNED) || defined(__cpp_lib_assume_aligned)) && !defined(ARMA_DONT_CHECK_ALIGNMENT) - { - return (sizeof(std::size_t) >= sizeof(eT*)) ? ((std::size_t(mem) & 0x0F) == 0) : false; - } - #else - { - arma_ignore(mem); - - return false; - } - #endif - } - - - -template -arma_inline -void -memory::mark_as_aligned(eT*& mem) - { - #if defined(ARMA_HAVE_GCC_ASSUME_ALIGNED) - { - mem = (eT*)__builtin_assume_aligned(mem, 16); - } - #elif defined(__cpp_lib_assume_aligned) - { - mem = (eT*)std::assume_aligned<16>(mem); - } - #else - { - arma_ignore(mem); - } - #endif - } - - - -template -arma_inline -void -memory::mark_as_aligned(const eT*& mem) - { - #if defined(ARMA_HAVE_GCC_ASSUME_ALIGNED) - { - mem = (const eT*)__builtin_assume_aligned(mem, 16); - } - #elif defined(__cpp_lib_assume_aligned) - { - mem = (const eT*)std::assume_aligned<16>(mem); - } - #else - { - arma_ignore(mem); - } - #endif - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mp_misc.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mp_misc.hpp deleted file mode 100644 index b323ffeb2..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mp_misc.hpp +++ /dev/null @@ -1,91 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup mp_misc -//! @{ - - - - -template -struct mp_gate - { - arma_inline - static - bool - eval(const uword n_elem) - { - #if defined(ARMA_USE_OPENMP) - { - const bool length_ok = (is_cx::yes || use_smaller_thresh) ? (n_elem >= (arma_config::mp_threshold/uword(2))) : (n_elem >= arma_config::mp_threshold); - - if(length_ok) - { - if(omp_in_parallel()) { return false; } - } - - return length_ok; - } - #else - { - arma_ignore(n_elem); - - return false; - } - #endif - } - }; - - - -struct mp_thread_limit - { - arma_inline - static - int - get() - { - #if defined(ARMA_USE_OPENMP) - int n_threads = (std::min)(int(arma_config::mp_threads), int((std::max)(int(1), int(omp_get_max_threads())))); - #else - int n_threads = int(1); - #endif - - return n_threads; - } - - arma_inline - static - bool - in_parallel() - { - #if defined(ARMA_USE_OPENMP) - { - return bool(omp_in_parallel()); - } - #else - { - return false; - } - #endif - } - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtGlueCube_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtGlueCube_bones.hpp deleted file mode 100644 index 846d80503..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtGlueCube_bones.hpp +++ /dev/null @@ -1,43 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup mtGlueCube -//! @{ - - - -template -class mtGlueCube : public BaseCube< out_eT, mtGlueCube > - { - public: - - typedef out_eT elem_type; - typedef typename get_pod_type::result pod_type; - - arma_inline mtGlueCube(const T1& in_A, const T2& in_B); - arma_inline mtGlueCube(const T1& in_A, const T2& in_B, const uword in_aux_uword); - arma_inline ~mtGlueCube(); - - arma_aligned const T1& A; //!< first operand; must be derived from BaseCube - arma_aligned const T2& B; //!< second operand; must be derived from BaseCube - arma_aligned uword aux_uword; //!< storage of auxiliary data, uword format - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtGlueCube_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtGlueCube_meat.hpp deleted file mode 100644 index c5e91e12a..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtGlueCube_meat.hpp +++ /dev/null @@ -1,56 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup mtGlueCube -//! @{ - - - -template -inline -mtGlueCube::mtGlueCube(const T1& in_A, const T2& in_B) - : A(in_A) - , B(in_B) - { - arma_debug_sigprint(); - } - - - -template -inline -mtGlueCube::mtGlueCube(const T1& in_A, const T2& in_B, const uword in_aux_uword) - : A(in_A) - , B(in_B) - , aux_uword(in_aux_uword) - { - arma_debug_sigprint(); - } - - - -template -inline -mtGlueCube::~mtGlueCube() - { - arma_debug_sigprint(); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtGlue_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtGlue_bones.hpp deleted file mode 100644 index 5937d89f7..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtGlue_bones.hpp +++ /dev/null @@ -1,47 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup mtGlue -//! @{ - - - -template -class mtGlue : public Base< out_eT, mtGlue > - { - public: - - typedef out_eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_row = glue_type::template traits::is_row; - static constexpr bool is_col = glue_type::template traits::is_col; - static constexpr bool is_xvec = glue_type::template traits::is_xvec; - - arma_inline mtGlue(const T1& in_A, const T2& in_B); - arma_inline mtGlue(const T1& in_A, const T2& in_B, const uword in_aux_uword); - arma_inline ~mtGlue(); - - arma_aligned const T1& A; //!< first operand; must be derived from Base - arma_aligned const T2& B; //!< second operand; must be derived from Base - arma_aligned uword aux_uword; //!< storage of auxiliary data, uword format - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtGlue_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtGlue_meat.hpp deleted file mode 100644 index 85cc9a219..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtGlue_meat.hpp +++ /dev/null @@ -1,56 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup mtGlue -//! @{ - - - -template -inline -mtGlue::mtGlue(const T1& in_A, const T2& in_B) - : A(in_A) - , B(in_B) - { - arma_debug_sigprint(); - } - - - -template -inline -mtGlue::mtGlue(const T1& in_A, const T2& in_B, const uword in_aux_uword) - : A(in_A) - , B(in_B) - , aux_uword(in_aux_uword) - { - arma_debug_sigprint(); - } - - - -template -inline -mtGlue::~mtGlue() - { - arma_debug_sigprint(); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtOpCube_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtOpCube_bones.hpp deleted file mode 100644 index ea9addfd3..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtOpCube_bones.hpp +++ /dev/null @@ -1,60 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup mtOpCube -//! @{ - - - -struct mtOpCube_dual_aux_indicator {}; - - -template -class mtOpCube : public BaseCube< out_eT, mtOpCube > - { - public: - - typedef out_eT elem_type; - typedef typename get_pod_type::result pod_type; - - typedef typename T1::elem_type in_eT; - - inline explicit mtOpCube(const T1& in_m); - inline mtOpCube(const T1& in_m, const in_eT in_aux); - inline mtOpCube(const T1& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b, const uword in_aux_uword_c); - inline mtOpCube(const T1& in_m, const in_eT in_aux, const uword in_aux_uword_a, const uword in_aux_uword_b, const uword in_aux_uword_c); - - inline mtOpCube(const char junk, const T1& in_m, const out_eT in_aux); - - inline mtOpCube(const mtOpCube_dual_aux_indicator&, const T1& in_m, const in_eT in_aux_a, const out_eT in_aux_b); - - inline ~mtOpCube(); - - - arma_aligned const T1& m; //!< the operand; must be derived from BaseCube - arma_aligned in_eT aux; //!< auxiliary data, using the element type as used by T1 - arma_aligned out_eT aux_out_eT; //!< auxiliary data, using the element type as specified by the out_eT template parameter - arma_aligned uword aux_uword_a; //!< auxiliary data, uword format - arma_aligned uword aux_uword_b; //!< auxiliary data, uword format - arma_aligned uword aux_uword_c; //!< auxiliary data, uword format - - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtOpCube_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtOpCube_meat.hpp deleted file mode 100644 index 611cd9e94..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtOpCube_meat.hpp +++ /dev/null @@ -1,105 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup mtOpCube -//! @{ - - - -template -inline -mtOpCube::mtOpCube(const T1& in_m) - : m(in_m) - { - arma_debug_sigprint(); - } - - - -template -inline -mtOpCube::mtOpCube(const T1& in_m, const typename T1::elem_type in_aux) - : m(in_m) - , aux(in_aux) - { - arma_debug_sigprint(); - } - - - -template -inline -mtOpCube::mtOpCube(const T1& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b, const uword in_aux_uword_c) - : m(in_m) - , aux_uword_a(in_aux_uword_a) - , aux_uword_b(in_aux_uword_b) - , aux_uword_c(in_aux_uword_c) - { - arma_debug_sigprint(); - } - - - -template -inline -mtOpCube::mtOpCube(const T1& in_m, const typename T1::elem_type in_aux, const uword in_aux_uword_a, const uword in_aux_uword_b, const uword in_aux_uword_c) - : m(in_m) - , aux(in_aux) - , aux_uword_a(in_aux_uword_a) - , aux_uword_b(in_aux_uword_b) - , aux_uword_c(in_aux_uword_c) - { - arma_debug_sigprint(); - } - - - -template -inline -mtOpCube::mtOpCube(const char junk, const T1& in_m, const out_eT in_aux) - : m(in_m) - , aux_out_eT(in_aux) - { - arma_debug_sigprint(); - arma_ignore(junk); - } - - - -template -inline -mtOpCube::mtOpCube(const mtOpCube_dual_aux_indicator&, const T1& in_m, const typename T1::elem_type in_aux_a, const out_eT in_aux_b) - : m (in_m ) - , aux (in_aux_a) - , aux_out_eT(in_aux_b) - { - arma_debug_sigprint(); - } - - - -template -inline -mtOpCube::~mtOpCube() - { - arma_debug_sigprint(); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtOp_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtOp_bones.hpp deleted file mode 100644 index ff0e4c38f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtOp_bones.hpp +++ /dev/null @@ -1,62 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup mtOp -//! @{ - - -struct mtOp_dual_aux_indicator {}; - - -template -class mtOp : public Base< out_eT, mtOp > - { - public: - - typedef out_eT elem_type; - typedef typename get_pod_type::result pod_type; - - typedef typename T1::elem_type in_eT; - - static constexpr bool is_row = op_type::template traits::is_row; - static constexpr bool is_col = op_type::template traits::is_col; - static constexpr bool is_xvec = op_type::template traits::is_xvec; - - inline explicit mtOp(const T1& in_m); - inline mtOp(const T1& in_m, const in_eT in_aux); - inline mtOp(const T1& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b); - inline mtOp(const T1& in_m, const in_eT in_aux, const uword in_aux_uword_a, const uword in_aux_uword_b); - - inline mtOp(const char junk, const T1& in_m, const out_eT in_aux); - - inline mtOp(const mtOp_dual_aux_indicator&, const T1& in_m, const in_eT in_aux_a, const out_eT in_aux_b); - - inline ~mtOp(); - - - arma_aligned const T1& m; //!< the operand; must be derived from Base - arma_aligned in_eT aux; //!< auxiliary data, using the element type as used by T1 - arma_aligned out_eT aux_out_eT; //!< auxiliary data, using the element type as specified by the out_eT template parameter - arma_aligned uword aux_uword_a; //!< auxiliary data, uword format - arma_aligned uword aux_uword_b; //!< auxiliary data, uword format - - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtOp_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtOp_meat.hpp deleted file mode 100644 index 623660c4d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtOp_meat.hpp +++ /dev/null @@ -1,104 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup mtOp -//! @{ - - - -template -inline -mtOp::mtOp(const T1& in_m) - : m(in_m) - { - arma_debug_sigprint(); - } - - - -template -inline -mtOp::mtOp(const T1& in_m, const typename T1::elem_type in_aux) - : m(in_m) - , aux(in_aux) - { - arma_debug_sigprint(); - } - - - -template -inline -mtOp::mtOp(const T1& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b) - : m(in_m) - , aux_uword_a(in_aux_uword_a) - , aux_uword_b(in_aux_uword_b) - { - arma_debug_sigprint(); - } - - - -template -inline -mtOp::mtOp(const T1& in_m, const typename T1::elem_type in_aux, const uword in_aux_uword_a, const uword in_aux_uword_b) - : m(in_m) - , aux(in_aux) - , aux_uword_a(in_aux_uword_a) - , aux_uword_b(in_aux_uword_b) - { - arma_debug_sigprint(); - } - - - -template -inline -mtOp::mtOp(const char junk, const T1& in_m, const out_eT in_aux) - : m(in_m) - , aux_out_eT(in_aux) - { - arma_ignore(junk); - - arma_debug_sigprint(); - } - - - -template -inline -mtOp::mtOp(const mtOp_dual_aux_indicator&, const T1& in_m, const typename T1::elem_type in_aux_a, const out_eT in_aux_b) - : m (in_m ) - , aux (in_aux_a) - , aux_out_eT(in_aux_b) - { - arma_debug_sigprint(); - } - - - -template -inline -mtOp::~mtOp() - { - arma_debug_sigprint(); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtSpGlue_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtSpGlue_bones.hpp deleted file mode 100644 index 3690914ef..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtSpGlue_bones.hpp +++ /dev/null @@ -1,48 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup mtSpGlue -//! @{ - - - -template -class mtSpGlue : public SpBase< out_eT, mtSpGlue > - { - public: - - typedef out_eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_row = spglue_type::template traits::is_row; - static constexpr bool is_col = spglue_type::template traits::is_col; - static constexpr bool is_xvec = spglue_type::template traits::is_xvec; - - inline mtSpGlue(const T1& in_A, const T2& in_B); - inline ~mtSpGlue(); - - template - arma_inline bool is_alias(const SpMat& X) const; - - const T1& A; //!< first operand; must be derived from SpBase - const T2& B; //!< second operand; must be derived from SpBase - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtSpGlue_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtSpGlue_meat.hpp deleted file mode 100644 index ee1bf3cd2..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtSpGlue_meat.hpp +++ /dev/null @@ -1,55 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup mtSpGlue -//! @{ - - - -template -inline -mtSpGlue::mtSpGlue(const T1& in_A, const T2& in_B) - : A(in_A) - , B(in_B) - { - arma_debug_sigprint(); - } - - - -template -inline -mtSpGlue::~mtSpGlue() - { - arma_debug_sigprint(); - } - - - -template -template -arma_inline -bool -mtSpGlue::is_alias(const SpMat& X) const - { - return (A.is_alias(X) || B.is_alias(X)); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtSpOp_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtSpOp_bones.hpp deleted file mode 100644 index 78facfaa7..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtSpOp_bones.hpp +++ /dev/null @@ -1,56 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup mtSpOp -//! @{ - - - -template -class mtSpOp : public SpBase< out_eT, mtSpOp > - { - public: - - typedef out_eT elem_type; - typedef typename get_pod_type::result pod_type; - - typedef typename T1::elem_type in_eT; - - static constexpr bool is_row = spop_type::template traits::is_row; - static constexpr bool is_col = spop_type::template traits::is_col; - static constexpr bool is_xvec = spop_type::template traits::is_xvec; - - inline explicit mtSpOp(const T1& in_m); - inline mtSpOp(const T1& in_m, const in_eT in_aux); - inline mtSpOp(const T1& in_m, const uword aux_uword_a, const uword aux_uword_b); - inline mtSpOp(const char junk, const T1& in_m, const out_eT in_aux); - inline ~mtSpOp(); - - template - arma_inline bool is_alias(const SpMat& X) const; - - arma_aligned const T1& m; //!< the operand; must be derived from SpBase - arma_aligned in_eT aux; //!< auxiliary data, using the element type as used by T1 - arma_aligned out_eT aux_out_eT; //!< auxiliary data, using the element type as specified by the out_eT template parameter - arma_aligned uword aux_uword_a; - arma_aligned uword aux_uword_b; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtSpOp_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtSpOp_meat.hpp deleted file mode 100644 index 59d2f3eb4..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtSpOp_meat.hpp +++ /dev/null @@ -1,90 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup mtSpOp -//! @{ - - - -template -inline -mtSpOp::mtSpOp(const T1& in_m) - : m(in_m) - { - arma_debug_sigprint(); - } - - - -template -inline -mtSpOp::mtSpOp(const T1& in_m, const typename T1::elem_type in_aux) - : m(in_m) - , aux(in_aux) - { - arma_debug_sigprint(); - } - - - -template -inline -mtSpOp::mtSpOp(const T1& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b) - : m(in_m) - , aux_uword_a(in_aux_uword_a) - , aux_uword_b(in_aux_uword_b) - { - arma_debug_sigprint(); - } - - - -template -inline -mtSpOp::mtSpOp(const char junk, const T1& in_m, const out_eT in_aux) - : m(in_m) - , aux_out_eT(in_aux) - { - arma_ignore(junk); - - arma_debug_sigprint(); - } - - - -template -inline -mtSpOp::~mtSpOp() - { - arma_debug_sigprint(); - } - - - -template -template -arma_inline -bool -mtSpOp::is_alias(const SpMat& X) const - { - return (void_ptr(&X) == void_ptr(&m)); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtSpReduceOp_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtSpReduceOp_bones.hpp deleted file mode 100644 index 51be0a3ff..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtSpReduceOp_bones.hpp +++ /dev/null @@ -1,62 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup mtSpReduceOp -//! @{ - - -// NOTE: mtSpReduceOp is dedicated for reduction operations on sparse matrices, -// NOTE: including sum(), min(), max(), mean(), var(), stddev(), -// NOTE where the entire sparse matrix is reduced to a vector. -// NOTE: -// NOTE: Even though it would make more sense for mtSpReduceOp to be derived from Base -// NOTE: (as it's more efficient to store the resulting vectors in dense format), -// NOTE: mtSpReduceOp is derived from SpBase so the default user-accessible output is in sparse storage format. -// NOTE. This is to mimic the behaviour of Octave and to keep compatibility with existing user code. -// NOTE: -// NOTE: However, for simplicity and efficiency, each mtSpReduceOp op_type::apply() function -// NOTE: must output to a dense matrix, ie. apply(Mat, ...). -// NOTE: The SpMat class handles mtSpReduceOp by converting the dense output to a sparse representation. -// NOTE: The Mat class has an explicit constructor to efficiently handle mtSpReduceOp. - -template -class mtSpReduceOp : public SpBase< out_eT, mtSpReduceOp > - { - public: - - typedef out_eT elem_type; - typedef typename get_pod_type::result pod_type; - - typedef typename T1::elem_type in_eT; - - static constexpr bool is_row = op_type::template traits::is_row; - static constexpr bool is_col = op_type::template traits::is_col; - static constexpr bool is_xvec = op_type::template traits::is_xvec; - - inline explicit mtSpReduceOp(const T1& in_m); - inline mtSpReduceOp(const T1& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b); - inline ~mtSpReduceOp(); - - arma_aligned const T1& m; //!< the operand; must be derived from SpBase - arma_aligned uword aux_uword_a; //!< auxiliary data, uword format - arma_aligned uword aux_uword_b; //!< auxiliary data, uword format - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtSpReduceOp_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtSpReduceOp_meat.hpp deleted file mode 100644 index e7a63c75a..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mtSpReduceOp_meat.hpp +++ /dev/null @@ -1,55 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup mtSpReduceOp -//! @{ - - - -template -inline -mtSpReduceOp::mtSpReduceOp(const T1& in_m) - : m(in_m) - { - arma_debug_sigprint(); - } - - - -template -inline -mtSpReduceOp::mtSpReduceOp(const T1& in_m, const uword in_aux_uword_a, const uword in_aux_uword_b) - : m(in_m) - , aux_uword_a(in_aux_uword_a) - , aux_uword_b(in_aux_uword_b) - { - arma_debug_sigprint(); - } - - - -template -inline -mtSpReduceOp::~mtSpReduceOp() - { - arma_debug_sigprint(); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mul_gemm.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mul_gemm.hpp deleted file mode 100644 index 41cc833ff..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mul_gemm.hpp +++ /dev/null @@ -1,435 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup gemm -//! @{ - - - -//! for tiny square matrices, size <= 4x4 -template -class gemm_emul_tinysq - { - public: - - - template - arma_cold - inline - static - void - apply - ( - Mat& C, - const TA& A, - const TB& B, - const eT alpha = eT(1), - const eT beta = eT(0) - ) - { - arma_debug_sigprint(); - - switch(A.n_rows) - { - case 4: gemv_emul_tinysq::apply( C.colptr(3), A, B.colptr(3), alpha, beta ); - // fallthrough - case 3: gemv_emul_tinysq::apply( C.colptr(2), A, B.colptr(2), alpha, beta ); - // fallthrough - case 2: gemv_emul_tinysq::apply( C.colptr(1), A, B.colptr(1), alpha, beta ); - // fallthrough - case 1: gemv_emul_tinysq::apply( C.colptr(0), A, B.colptr(0), alpha, beta ); - // fallthrough - default: ; - } - } - - }; - - - -//! emulation of gemm(), for non-complex matrices only, as it assumes only simple transposes (ie. doesn't do hermitian transposes) -template -class gemm_emul_large - { - public: - - template - arma_hot - inline - static - void - apply - ( - Mat& C, - const TA& A, - const TB& B, - const eT alpha = eT(1), - const eT beta = eT(0) - ) - { - arma_debug_sigprint(); - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - if( (do_trans_A == false) && (do_trans_B == false) ) - { - arma_aligned podarray tmp(A_n_cols); - - eT* A_rowdata = tmp.memptr(); - - for(uword row_A=0; row_A < A_n_rows; ++row_A) - { - tmp.copy_row(A, row_A); - - for(uword col_B=0; col_B < B_n_cols; ++col_B) - { - const eT acc = op_dot::direct_dot_arma(B_n_rows, A_rowdata, B.colptr(col_B)); - - if( (use_alpha == false) && (use_beta == false) ) { C.at(row_A,col_B) = acc; } - else if( (use_alpha == true ) && (use_beta == false) ) { C.at(row_A,col_B) = alpha*acc; } - else if( (use_alpha == false) && (use_beta == true ) ) { C.at(row_A,col_B) = acc + beta*C.at(row_A,col_B); } - else if( (use_alpha == true ) && (use_beta == true ) ) { C.at(row_A,col_B) = alpha*acc + beta*C.at(row_A,col_B); } - } - } - } - else - if( (do_trans_A == true) && (do_trans_B == false) ) - { - for(uword col_A=0; col_A < A_n_cols; ++col_A) - { - // col_A is interpreted as row_A when storing the results in matrix C - - const eT* A_coldata = A.colptr(col_A); - - for(uword col_B=0; col_B < B_n_cols; ++col_B) - { - const eT acc = op_dot::direct_dot_arma(B_n_rows, A_coldata, B.colptr(col_B)); - - if( (use_alpha == false) && (use_beta == false) ) { C.at(col_A,col_B) = acc; } - else if( (use_alpha == true ) && (use_beta == false) ) { C.at(col_A,col_B) = alpha*acc; } - else if( (use_alpha == false) && (use_beta == true ) ) { C.at(col_A,col_B) = acc + beta*C.at(col_A,col_B); } - else if( (use_alpha == true ) && (use_beta == true ) ) { C.at(col_A,col_B) = alpha*acc + beta*C.at(col_A,col_B); } - } - } - } - else - if( (do_trans_A == false) && (do_trans_B == true) ) - { - Mat BB; - op_strans::apply_mat_noalias(BB, B); - - gemm_emul_large::apply(C, A, BB, alpha, beta); - } - else - if( (do_trans_A == true) && (do_trans_B == true) ) - { - // mat B_tmp = trans(B); - // dgemm_arma::apply(C, A, B_tmp, alpha, beta); - - - // By using the trans(A)*trans(B) = trans(B*A) equivalency, - // transpose operations are not needed - - arma_aligned podarray tmp(B.n_cols); - eT* B_rowdata = tmp.memptr(); - - for(uword row_B=0; row_B < B_n_rows; ++row_B) - { - tmp.copy_row(B, row_B); - - for(uword col_A=0; col_A < A_n_cols; ++col_A) - { - const eT acc = op_dot::direct_dot_arma(A_n_rows, B_rowdata, A.colptr(col_A)); - - if( (use_alpha == false) && (use_beta == false) ) { C.at(col_A,row_B) = acc; } - else if( (use_alpha == true ) && (use_beta == false) ) { C.at(col_A,row_B) = alpha*acc; } - else if( (use_alpha == false) && (use_beta == true ) ) { C.at(col_A,row_B) = acc + beta*C.at(col_A,row_B); } - else if( (use_alpha == true ) && (use_beta == true ) ) { C.at(col_A,row_B) = alpha*acc + beta*C.at(col_A,row_B); } - } - } - } - } - - }; - - - -template -class gemm_emul - { - public: - - - template - arma_hot - inline - static - void - apply - ( - Mat& C, - const TA& A, - const TB& B, - const eT alpha = eT(1), - const eT beta = eT(0), - const typename arma_not_cx::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - gemm_emul_large::apply(C, A, B, alpha, beta); - } - - - - template - arma_hot - inline - static - void - apply - ( - Mat& C, - const Mat& A, - const Mat& B, - const eT alpha = eT(1), - const eT beta = eT(0), - const typename arma_cx_only::result* junk = nullptr - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - // "better than nothing" handling of hermitian transposes for complex number matrices - - Mat tmp_A; - Mat tmp_B; - - if(do_trans_A) { op_htrans::apply_mat_noalias(tmp_A, A); } - if(do_trans_B) { op_htrans::apply_mat_noalias(tmp_B, B); } - - const Mat& AA = (do_trans_A == false) ? A : tmp_A; - const Mat& BB = (do_trans_B == false) ? B : tmp_B; - - gemm_emul_large::apply(C, AA, BB, alpha, beta); - } - - }; - - - -//! \brief -//! Wrapper for BLAS dgemm function, using template arguments to control the arguments passed to dgemm. -//! Matrix 'C' is assumed to have been set to the correct size (ie. taking into account transposes) - -template -class gemm - { - public: - - template - inline - static - void - apply_blas_type( Mat& C, const TA& A, const TB& B, const eT alpha = eT(1), const eT beta = eT(0) ) - { - arma_debug_sigprint(); - - if( (A.n_rows <= 4) && (A.n_rows == A.n_cols) && (A.n_rows == B.n_rows) && (B.n_rows == B.n_cols) && (is_cx::no) ) - { - if(do_trans_B == false) - { - gemm_emul_tinysq::apply(C, A, B, alpha, beta); - } - else - { - Mat BB(B.n_rows, B.n_rows, arma_nozeros_indicator()); - - op_strans::apply_mat_noalias_tinysq(BB, B); - - gemm_emul_tinysq::apply(C, A, BB, alpha, beta); - } - } - else - { - #if defined(ARMA_USE_ATLAS) - { - arma_debug_print("atlas::cblas_gemm()"); - - arma_conform_assert_atlas_size(A,B); - - atlas::cblas_gemm - ( - atlas_CblasColMajor, - (do_trans_A) ? ( is_cx::yes ? atlas_CblasConjTrans : atlas_CblasTrans ) : atlas_CblasNoTrans, - (do_trans_B) ? ( is_cx::yes ? atlas_CblasConjTrans : atlas_CblasTrans ) : atlas_CblasNoTrans, - C.n_rows, - C.n_cols, - (do_trans_A) ? A.n_rows : A.n_cols, - (use_alpha) ? alpha : eT(1), - A.mem, - (do_trans_A) ? A.n_rows : C.n_rows, - B.mem, - (do_trans_B) ? C.n_cols : ( (do_trans_A) ? A.n_rows : A.n_cols ), - (use_beta) ? beta : eT(0), - C.memptr(), - C.n_rows - ); - } - #elif defined(ARMA_USE_BLAS) - { - arma_debug_print("blas::gemm()"); - - arma_conform_assert_blas_size(A,B); - - const char trans_A = (do_trans_A) ? ( is_cx::yes ? 'C' : 'T' ) : 'N'; - const char trans_B = (do_trans_B) ? ( is_cx::yes ? 'C' : 'T' ) : 'N'; - - const blas_int m = blas_int(C.n_rows); - const blas_int n = blas_int(C.n_cols); - const blas_int k = (do_trans_A) ? blas_int(A.n_rows) : blas_int(A.n_cols); - - const eT local_alpha = (use_alpha) ? alpha : eT(1); - - const blas_int lda = (do_trans_A) ? k : m; - const blas_int ldb = (do_trans_B) ? n : k; - - const eT local_beta = (use_beta) ? beta : eT(0); - - arma_debug_print( arma_str::format("blas::gemm(): trans_A: %c") % trans_A ); - arma_debug_print( arma_str::format("blas::gemm(): trans_B: %c") % trans_B ); - - blas::gemm - ( - &trans_A, - &trans_B, - &m, - &n, - &k, - &local_alpha, - A.mem, - &lda, - B.mem, - &ldb, - &local_beta, - C.memptr(), - &m - ); - } - #else - { - gemm_emul::apply(C,A,B,alpha,beta); - } - #endif - } - } - - - - //! immediate multiplication of matrices A and B, storing the result in C - template - inline - static - void - apply( Mat& C, const TA& A, const TB& B, const eT alpha = eT(1), const eT beta = eT(0) ) - { - gemm_emul::apply(C,A,B,alpha,beta); - } - - - - template - arma_inline - static - void - apply - ( - Mat& C, - const TA& A, - const TB& B, - const float alpha = float(1), - const float beta = float(0) - ) - { - gemm::apply_blas_type(C,A,B,alpha,beta); - } - - - - template - arma_inline - static - void - apply - ( - Mat& C, - const TA& A, - const TB& B, - const double alpha = double(1), - const double beta = double(0) - ) - { - gemm::apply_blas_type(C,A,B,alpha,beta); - } - - - - template - arma_inline - static - void - apply - ( - Mat< std::complex >& C, - const TA& A, - const TB& B, - const std::complex alpha = std::complex(1), - const std::complex beta = std::complex(0) - ) - { - gemm::apply_blas_type(C,A,B,alpha,beta); - } - - - - template - arma_inline - static - void - apply - ( - Mat< std::complex >& C, - const TA& A, - const TB& B, - const std::complex alpha = std::complex(1), - const std::complex beta = std::complex(0) - ) - { - gemm::apply_blas_type(C,A,B,alpha,beta); - } - - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mul_gemm_mixed.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mul_gemm_mixed.hpp deleted file mode 100644 index 158a91919..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mul_gemm_mixed.hpp +++ /dev/null @@ -1,291 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup gemm_mixed -//! @{ - - - -//! \brief -//! Matrix multplication where the matrices have differing element types. -//! Uses caching for speedup. -//! Matrix 'C' is assumed to have been set to the correct size (ie. taking into account transposes) - -template -class gemm_mixed_large - { - public: - - template - arma_hot - inline - static - void - apply - ( - Mat& C, - const Mat& A, - const Mat& B, - const out_eT alpha = out_eT(1), - const out_eT beta = out_eT(0) - ) - { - arma_debug_sigprint(); - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - if( (do_trans_A == false) && (do_trans_B == false) ) - { - podarray tmp(A_n_cols); - in_eT1* A_rowdata = tmp.memptr(); - - #if defined(ARMA_USE_OPENMP) - const bool use_mp = (B_n_cols >= 2) && (B.n_elem >= 8192) && (mp_thread_limit::in_parallel() == false); - #else - const bool use_mp = false; - #endif - - if(use_mp) - { - #if defined(ARMA_USE_OPENMP) - { - const int n_threads = int( (std::min)( uword(mp_thread_limit::get()), uword(B_n_cols) ) ); - - for(uword row_A=0; row_A < A_n_rows; ++row_A) - { - tmp.copy_row(A, row_A); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword col_B=0; col_B < B_n_cols; ++col_B) - { - const in_eT2* B_coldata = B.colptr(col_B); - - out_eT acc = out_eT(0); - for(uword i=0; i < B_n_rows; ++i) - { - acc += upgrade_val::apply(A_rowdata[i]) * upgrade_val::apply(B_coldata[i]); - } - - if( (use_alpha == false) && (use_beta == false) ) { C.at(row_A,col_B) = acc; } - else if( (use_alpha == true ) && (use_beta == false) ) { C.at(row_A,col_B) = alpha*acc; } - else if( (use_alpha == false) && (use_beta == true ) ) { C.at(row_A,col_B) = acc + beta*C.at(row_A,col_B); } - else if( (use_alpha == true ) && (use_beta == true ) ) { C.at(row_A,col_B) = alpha*acc + beta*C.at(row_A,col_B); } - } - } - } - #endif - } - else - { - for(uword row_A=0; row_A < A_n_rows; ++row_A) - { - tmp.copy_row(A, row_A); - - for(uword col_B=0; col_B < B_n_cols; ++col_B) - { - const in_eT2* B_coldata = B.colptr(col_B); - - out_eT acc = out_eT(0); - for(uword i=0; i < B_n_rows; ++i) - { - acc += upgrade_val::apply(A_rowdata[i]) * upgrade_val::apply(B_coldata[i]); - } - - if( (use_alpha == false) && (use_beta == false) ) { C.at(row_A,col_B) = acc; } - else if( (use_alpha == true ) && (use_beta == false) ) { C.at(row_A,col_B) = alpha*acc; } - else if( (use_alpha == false) && (use_beta == true ) ) { C.at(row_A,col_B) = acc + beta*C.at(row_A,col_B); } - else if( (use_alpha == true ) && (use_beta == true ) ) { C.at(row_A,col_B) = alpha*acc + beta*C.at(row_A,col_B); } - } - } - } - } - else - if( (do_trans_A == true) && (do_trans_B == false) ) - { - #if defined(ARMA_USE_OPENMP) - const bool use_mp = (B_n_cols >= 2) && (B.n_elem >= 8192) && (mp_thread_limit::in_parallel() == false); - #else - const bool use_mp = false; - #endif - - if(use_mp) - { - #if defined(ARMA_USE_OPENMP) - { - const int n_threads = int( (std::min)( uword(mp_thread_limit::get()), uword(B_n_cols) ) ); - - for(uword col_A=0; col_A < A_n_cols; ++col_A) - { - // col_A is interpreted as row_A when storing the results in matrix C - - const in_eT1* A_coldata = A.colptr(col_A); - - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword col_B=0; col_B < B_n_cols; ++col_B) - { - const in_eT2* B_coldata = B.colptr(col_B); - - out_eT acc = out_eT(0); - for(uword i=0; i < B_n_rows; ++i) - { - acc += upgrade_val::apply(A_coldata[i]) * upgrade_val::apply(B_coldata[i]); - } - - if( (use_alpha == false) && (use_beta == false) ) { C.at(col_A,col_B) = acc; } - else if( (use_alpha == true ) && (use_beta == false) ) { C.at(col_A,col_B) = alpha*acc; } - else if( (use_alpha == false) && (use_beta == true ) ) { C.at(col_A,col_B) = acc + beta*C.at(col_A,col_B); } - else if( (use_alpha == true ) && (use_beta == true ) ) { C.at(col_A,col_B) = alpha*acc + beta*C.at(col_A,col_B); } - } - } - } - #endif - } - else - { - for(uword col_A=0; col_A < A_n_cols; ++col_A) - { - // col_A is interpreted as row_A when storing the results in matrix C - - const in_eT1* A_coldata = A.colptr(col_A); - - for(uword col_B=0; col_B < B_n_cols; ++col_B) - { - const in_eT2* B_coldata = B.colptr(col_B); - - out_eT acc = out_eT(0); - for(uword i=0; i < B_n_rows; ++i) - { - acc += upgrade_val::apply(A_coldata[i]) * upgrade_val::apply(B_coldata[i]); - } - - if( (use_alpha == false) && (use_beta == false) ) { C.at(col_A,col_B) = acc; } - else if( (use_alpha == true ) && (use_beta == false) ) { C.at(col_A,col_B) = alpha*acc; } - else if( (use_alpha == false) && (use_beta == true ) ) { C.at(col_A,col_B) = acc + beta*C.at(col_A,col_B); } - else if( (use_alpha == true ) && (use_beta == true ) ) { C.at(col_A,col_B) = alpha*acc + beta*C.at(col_A,col_B); } - } - } - } - } - else - if( (do_trans_A == false) && (do_trans_B == true) ) - { - Mat B_tmp; - - op_strans::apply_mat_noalias(B_tmp, B); - - gemm_mixed_large::apply(C, A, B_tmp, alpha, beta); - } - else - if( (do_trans_A == true) && (do_trans_B == true) ) - { - // mat B_tmp = trans(B); - // dgemm_arma::apply(C, A, B_tmp, alpha, beta); - - - // By using the trans(A)*trans(B) = trans(B*A) equivalency, - // transpose operations are not needed - - podarray tmp(B_n_cols); - in_eT2* B_rowdata = tmp.memptr(); - - for(uword row_B=0; row_B < B_n_rows; ++row_B) - { - tmp.copy_row(B, row_B); - - for(uword col_A=0; col_A < A_n_cols; ++col_A) - { - const in_eT1* A_coldata = A.colptr(col_A); - - out_eT acc = out_eT(0); - for(uword i=0; i < A_n_rows; ++i) - { - acc += upgrade_val::apply(B_rowdata[i]) * upgrade_val::apply(A_coldata[i]); - } - - if( (use_alpha == false) && (use_beta == false) ) { C.at(col_A,row_B) = acc; } - else if( (use_alpha == true ) && (use_beta == false) ) { C.at(col_A,row_B) = alpha*acc; } - else if( (use_alpha == false) && (use_beta == true ) ) { C.at(col_A,row_B) = acc + beta*C.at(col_A,row_B); } - else if( (use_alpha == true ) && (use_beta == true ) ) { C.at(col_A,row_B) = alpha*acc + beta*C.at(col_A,row_B); } - } - } - - } - } - - }; - - - -//! \brief -//! Matrix multplication where the matrices have differing element types. - -template -class gemm_mixed - { - public: - - //! immediate multiplication of matrices A and B, storing the result in C - template - inline - static - void - apply - ( - Mat& C, - const Mat& A, - const Mat& B, - const out_eT alpha = out_eT(1), - const out_eT beta = out_eT(0) - ) - { - arma_debug_sigprint(); - - if((is_cx::yes && do_trans_A) || (is_cx::yes && do_trans_B)) - { - // better-than-nothing handling of hermitian transpose - - Mat tmp_A; - Mat tmp_B; - - const bool predo_trans_A = ( (do_trans_A == true) && (is_cx::yes) ); - const bool predo_trans_B = ( (do_trans_B == true) && (is_cx::yes) ); - - if(predo_trans_A) { op_htrans::apply_mat_noalias(tmp_A, A); } - if(predo_trans_B) { op_htrans::apply_mat_noalias(tmp_B, B); } - - const Mat& AA = (predo_trans_A == false) ? A : tmp_A; - const Mat& BB = (predo_trans_B == false) ? B : tmp_B; - - gemm_mixed_large<((predo_trans_A) ? false : do_trans_A), ((predo_trans_B) ? false : do_trans_B), use_alpha, use_beta>::apply(C, AA, BB, alpha, beta); - } - else - { - gemm_mixed_large::apply(C, A, B, alpha, beta); - } - } - - - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mul_gemv.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mul_gemv.hpp deleted file mode 100644 index 8c4a0c87e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mul_gemv.hpp +++ /dev/null @@ -1,495 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup gemv -//! @{ - - - -//! for tiny square matrices, size <= 4x4 -template -class gemv_emul_tinysq - { - public: - - - template - struct pos - { - static constexpr uword n2 = (do_trans_A == false) ? (row + col*2) : (col + row*2); - static constexpr uword n3 = (do_trans_A == false) ? (row + col*3) : (col + row*3); - static constexpr uword n4 = (do_trans_A == false) ? (row + col*4) : (col + row*4); - }; - - - - template - arma_inline - static - void - assign(eT* y, const eT acc, const eT alpha, const eT beta) - { - if(use_beta == false) - { - y[i] = (use_alpha == false) ? acc : alpha*acc; - } - else - { - const eT tmp = y[i]; - - y[i] = beta*tmp + ( (use_alpha == false) ? acc : alpha*acc ); - } - } - - - - template - arma_cold - inline - static - void - apply( eT* y, const TA& A, const eT* x, const eT alpha = eT(1), const eT beta = eT(0) ) - { - arma_debug_sigprint(); - - const eT* Am = A.memptr(); - - switch(A.n_rows) - { - case 1: - { - const eT acc = Am[0] * x[0]; - - assign(y, acc, alpha, beta); - } - break; - - - case 2: - { - const eT x0 = x[0]; - const eT x1 = x[1]; - - const eT acc0 = Am[pos<0,0>::n2]*x0 + Am[pos<0,1>::n2]*x1; - const eT acc1 = Am[pos<1,0>::n2]*x0 + Am[pos<1,1>::n2]*x1; - - assign(y, acc0, alpha, beta); - assign(y, acc1, alpha, beta); - } - break; - - - case 3: - { - const eT x0 = x[0]; - const eT x1 = x[1]; - const eT x2 = x[2]; - - const eT acc0 = Am[pos<0,0>::n3]*x0 + Am[pos<0,1>::n3]*x1 + Am[pos<0,2>::n3]*x2; - const eT acc1 = Am[pos<1,0>::n3]*x0 + Am[pos<1,1>::n3]*x1 + Am[pos<1,2>::n3]*x2; - const eT acc2 = Am[pos<2,0>::n3]*x0 + Am[pos<2,1>::n3]*x1 + Am[pos<2,2>::n3]*x2; - - assign(y, acc0, alpha, beta); - assign(y, acc1, alpha, beta); - assign(y, acc2, alpha, beta); - } - break; - - - case 4: - { - const eT x0 = x[0]; - const eT x1 = x[1]; - const eT x2 = x[2]; - const eT x3 = x[3]; - - const eT acc0 = Am[pos<0,0>::n4]*x0 + Am[pos<0,1>::n4]*x1 + Am[pos<0,2>::n4]*x2 + Am[pos<0,3>::n4]*x3; - const eT acc1 = Am[pos<1,0>::n4]*x0 + Am[pos<1,1>::n4]*x1 + Am[pos<1,2>::n4]*x2 + Am[pos<1,3>::n4]*x3; - const eT acc2 = Am[pos<2,0>::n4]*x0 + Am[pos<2,1>::n4]*x1 + Am[pos<2,2>::n4]*x2 + Am[pos<2,3>::n4]*x3; - const eT acc3 = Am[pos<3,0>::n4]*x0 + Am[pos<3,1>::n4]*x1 + Am[pos<3,2>::n4]*x2 + Am[pos<3,3>::n4]*x3; - - assign(y, acc0, alpha, beta); - assign(y, acc1, alpha, beta); - assign(y, acc2, alpha, beta); - assign(y, acc3, alpha, beta); - } - break; - - - default: - ; - } - } - - }; - - - -class gemv_emul_helper - { - public: - - template - arma_hot - inline - static - typename arma_not_cx::result - dot_row_col( const TA& A, const eT* x, const uword row, const uword N ) - { - eT acc1 = eT(0); - eT acc2 = eT(0); - - uword i,j; - for(i=0, j=1; j < N; i+=2, j+=2) - { - const eT xi = x[i]; - const eT xj = x[j]; - - acc1 += A.at(row,i) * xi; - acc2 += A.at(row,j) * xj; - } - - if(i < N) - { - acc1 += A.at(row,i) * x[i]; - } - - return (acc1 + acc2); - } - - - - template - arma_hot - inline - static - typename arma_cx_only::result - dot_row_col( const TA& A, const eT* x, const uword row, const uword N ) - { - typedef typename get_pod_type::result T; - - T val_real = T(0); - T val_imag = T(0); - - for(uword i=0; i& Ai = A.at(row,i); - const std::complex& xi = x[i]; - - const T a = Ai.real(); - const T b = Ai.imag(); - - const T c = xi.real(); - const T d = xi.imag(); - - val_real += (a*c) - (b*d); - val_imag += (a*d) + (b*c); - } - - return std::complex(val_real, val_imag); - } - - }; - - - -//! \brief -//! Partial emulation of BLAS gemv(). -//! 'y' is assumed to have been set to the correct size (ie. taking into account the transpose) - -template -class gemv_emul - { - public: - - template - arma_hot - inline - static - void - apply( eT* y, const TA& A, const eT* x, const eT alpha = eT(1), const eT beta = eT(0) ) - { - arma_debug_sigprint(); - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - if(do_trans_A == false) - { - if(A_n_rows == 1) - { - const eT acc = op_dot::direct_dot_arma(A_n_cols, A.memptr(), x); - - if( (use_alpha == false) && (use_beta == false) ) { y[0] = acc; } - else if( (use_alpha == true ) && (use_beta == false) ) { y[0] = alpha*acc; } - else if( (use_alpha == false) && (use_beta == true ) ) { y[0] = acc + beta*y[0]; } - else if( (use_alpha == true ) && (use_beta == true ) ) { y[0] = alpha*acc + beta*y[0]; } - } - else - for(uword row=0; row < A_n_rows; ++row) - { - const eT acc = gemv_emul_helper::dot_row_col(A, x, row, A_n_cols); - - if( (use_alpha == false) && (use_beta == false) ) { y[row] = acc; } - else if( (use_alpha == true ) && (use_beta == false) ) { y[row] = alpha*acc; } - else if( (use_alpha == false) && (use_beta == true ) ) { y[row] = acc + beta*y[row]; } - else if( (use_alpha == true ) && (use_beta == true ) ) { y[row] = alpha*acc + beta*y[row]; } - } - } - else - if(do_trans_A == true) - { - if(is_cx::no) - { - for(uword col=0; col < A_n_cols; ++col) - { - // col is interpreted as row when storing the results in 'y' - - - // const eT* A_coldata = A.colptr(col); - // - // eT acc = eT(0); - // for(uword row=0; row < A_n_rows; ++row) - // { - // acc += A_coldata[row] * x[row]; - // } - - const eT acc = op_dot::direct_dot_arma(A_n_rows, A.colptr(col), x); - - if( (use_alpha == false) && (use_beta == false) ) { y[col] = acc; } - else if( (use_alpha == true ) && (use_beta == false) ) { y[col] = alpha*acc; } - else if( (use_alpha == false) && (use_beta == true ) ) { y[col] = acc + beta*y[col]; } - else if( (use_alpha == true ) && (use_beta == true ) ) { y[col] = alpha*acc + beta*y[col]; } - } - } - else - { - Mat AA; - - op_htrans::apply_mat_noalias(AA, A); - - gemv_emul::apply(y, AA, x, alpha, beta); - } - } - } - - }; - - - -//! \brief -//! Wrapper for BLAS gemv function, using template arguments to control the arguments passed to gemv. -//! 'y' is assumed to have been set to the correct size (ie. taking into account the transpose) - -template -class gemv - { - public: - - template - inline - static - void - apply_blas_type( eT* y, const TA& A, const eT* x, const eT alpha = eT(1), const eT beta = eT(0) ) - { - arma_debug_sigprint(); - - if( (A.n_rows <= 4) && (A.n_rows == A.n_cols) && (is_cx::no) ) - { - gemv_emul_tinysq::apply(y, A, x, alpha, beta); - } - else - { - #if defined(ARMA_USE_ATLAS) - { - arma_conform_assert_atlas_size(A); - - if(is_cx::no) - { - // use gemm() instead of gemv() to work around a speed issue in Atlas 3.8.4 - - arma_debug_print("atlas::cblas_gemm()"); - - atlas::cblas_gemm - ( - atlas_CblasColMajor, - (do_trans_A) ? ( is_cx::yes ? atlas_CblasConjTrans : atlas_CblasTrans ) : atlas_CblasNoTrans, - atlas_CblasNoTrans, - (do_trans_A) ? A.n_cols : A.n_rows, - 1, - (do_trans_A) ? A.n_rows : A.n_cols, - (use_alpha) ? alpha : eT(1), - A.mem, - A.n_rows, - x, - (do_trans_A) ? A.n_rows : A.n_cols, - (use_beta) ? beta : eT(0), - y, - (do_trans_A) ? A.n_cols : A.n_rows - ); - } - else - { - arma_debug_print("atlas::cblas_gemv()"); - - atlas::cblas_gemv - ( - atlas_CblasColMajor, - (do_trans_A) ? ( is_cx::yes ? atlas_CblasConjTrans : atlas_CblasTrans ) : atlas_CblasNoTrans, - A.n_rows, - A.n_cols, - (use_alpha) ? alpha : eT(1), - A.mem, - A.n_rows, - x, - 1, - (use_beta) ? beta : eT(0), - y, - 1 - ); - } - } - #elif defined(ARMA_USE_BLAS) - { - arma_debug_print("blas::gemv()"); - - arma_conform_assert_blas_size(A); - - const char trans_A = (do_trans_A) ? ( is_cx::yes ? 'C' : 'T' ) : 'N'; - const blas_int m = blas_int(A.n_rows); - const blas_int n = blas_int(A.n_cols); - const eT local_alpha = (use_alpha) ? alpha : eT(1); - //const blas_int lda = A.n_rows; - const blas_int inc = blas_int(1); - const eT local_beta = (use_beta) ? beta : eT(0); - - arma_debug_print( arma_str::format("blas::gemv(): trans_A: %c") % trans_A ); - - blas::gemv - ( - &trans_A, - &m, - &n, - &local_alpha, - A.mem, - &m, // lda - x, - &inc, - &local_beta, - y, - &inc - ); - } - #else - { - gemv_emul::apply(y,A,x,alpha,beta); - } - #endif - } - - } - - - - template - arma_inline - static - void - apply( eT* y, const TA& A, const eT* x, const eT alpha = eT(1), const eT beta = eT(0) ) - { - gemv_emul::apply(y,A,x,alpha,beta); - } - - - - template - arma_inline - static - void - apply - ( - float* y, - const TA& A, - const float* x, - const float alpha = float(1), - const float beta = float(0) - ) - { - gemv::apply_blas_type(y,A,x,alpha,beta); - } - - - - template - arma_inline - static - void - apply - ( - double* y, - const TA& A, - const double* x, - const double alpha = double(1), - const double beta = double(0) - ) - { - gemv::apply_blas_type(y,A,x,alpha,beta); - } - - - - template - arma_inline - static - void - apply - ( - std::complex* y, - const TA& A, - const std::complex* x, - const std::complex alpha = std::complex(1), - const std::complex beta = std::complex(0) - ) - { - gemv::apply_blas_type(y,A,x,alpha,beta); - } - - - - template - arma_inline - static - void - apply - ( - std::complex* y, - const TA& A, - const std::complex* x, - const std::complex alpha = std::complex(1), - const std::complex beta = std::complex(0) - ) - { - gemv::apply_blas_type(y,A,x,alpha,beta); - } - - - - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mul_herk.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mul_herk.hpp deleted file mode 100644 index 442f734d7..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mul_herk.hpp +++ /dev/null @@ -1,492 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup herk -//! @{ - - - -class herk_helper - { - public: - - template - inline - static - void - inplace_conj_copy_upper_tri_to_lower_tri(Mat& C) - { - // under the assumption that C is a square matrix - - const uword N = C.n_rows; - - for(uword k=0; k < N; ++k) - { - eT* colmem = C.colptr(k); - - for(uword i=(k+1); i < N; ++i) - { - colmem[i] = std::conj( C.at(k,i) ); - } - } - } - - - template - arma_hot - inline - static - eT - dot_conj_row(const uword n_elem, const eT* const A, const Mat& B, const uword row) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - T val_real = T(0); - T val_imag = T(0); - - for(uword i=0; i& X = A[i]; - const std::complex& Y = B.at(row,i); - - const T a = X.real(); - const T b = X.imag(); - - const T c = Y.real(); - const T d = Y.imag(); - - val_real += (a*c) + (b*d); - val_imag += (b*c) - (a*d); - } - - return std::complex(val_real, val_imag); - } - - }; - - - -template -class herk_vec - { - public: - - template - arma_hot - inline - static - void - apply - ( - Mat< std::complex >& C, - const TA& A, - const T alpha = T(1), - const T beta = T(0) - ) - { - arma_debug_sigprint(); - - typedef std::complex eT; - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - // for beta != 0, C is assumed to be hermitian - - // do_trans_A == false -> C = alpha * A * A^H + beta*C - // do_trans_A == true -> C = alpha * A^H * A + beta*C - - const eT* A_mem = A.memptr(); - - if(do_trans_A == false) - { - if(A_n_rows == 1) - { - const eT acc = op_cdot::direct_cdot(A_n_cols, A_mem, A_mem); - - if( (use_alpha == false) && (use_beta == false) ) { C[0] = acc; } - else if( (use_alpha == true ) && (use_beta == false) ) { C[0] = alpha*acc; } - else if( (use_alpha == false) && (use_beta == true ) ) { C[0] = acc + beta*C[0]; } - else if( (use_alpha == true ) && (use_beta == true ) ) { C[0] = alpha*acc + beta*C[0]; } - } - else - for(uword row_A=0; row_A < A_n_rows; ++row_A) - { - const eT& A_rowdata = A_mem[row_A]; - - for(uword k=row_A; k < A_n_rows; ++k) - { - const eT acc = A_rowdata * std::conj( A_mem[k] ); - - if( (use_alpha == false) && (use_beta == false) ) - { - C.at(row_A, k) = acc; - if(row_A != k) { C.at(k, row_A) = std::conj(acc); } - } - else - if( (use_alpha == true) && (use_beta == false) ) - { - const eT val = alpha*acc; - - C.at(row_A, k) = val; - if(row_A != k) { C.at(k, row_A) = std::conj(val); } - } - else - if( (use_alpha == false) && (use_beta == true) ) - { - C.at(row_A, k) = acc + beta*C.at(row_A, k); - if(row_A != k) { C.at(k, row_A) = std::conj(acc) + beta*C.at(k, row_A); } - } - else - if( (use_alpha == true) && (use_beta == true) ) - { - const eT val = alpha*acc; - - C.at(row_A, k) = val + beta*C.at(row_A, k); - if(row_A != k) { C.at(k, row_A) = std::conj(val) + beta*C.at(k, row_A); } - } - } - } - } - else - if(do_trans_A == true) - { - if(A_n_cols == 1) - { - const eT acc = op_cdot::direct_cdot(A_n_rows, A_mem, A_mem); - - if( (use_alpha == false) && (use_beta == false) ) { C[0] = acc; } - else if( (use_alpha == true ) && (use_beta == false) ) { C[0] = alpha*acc; } - else if( (use_alpha == false) && (use_beta == true ) ) { C[0] = acc + beta*C[0]; } - else if( (use_alpha == true ) && (use_beta == true ) ) { C[0] = alpha*acc + beta*C[0]; } - } - else - for(uword col_A=0; col_A < A_n_cols; ++col_A) - { - // col_A is interpreted as row_A when storing the results in matrix C - - const eT A_coldata = std::conj( A_mem[col_A] ); - - for(uword k=col_A; k < A_n_cols ; ++k) - { - const eT acc = A_coldata * A_mem[k]; - - if( (use_alpha == false) && (use_beta == false) ) - { - C.at(col_A, k) = acc; - if(col_A != k) { C.at(k, col_A) = std::conj(acc); } - } - else - if( (use_alpha == true ) && (use_beta == false) ) - { - const eT val = alpha*acc; - - C.at(col_A, k) = val; - if(col_A != k) { C.at(k, col_A) = std::conj(val); } - } - else - if( (use_alpha == false) && (use_beta == true ) ) - { - C.at(col_A, k) = acc + beta*C.at(col_A, k); - if(col_A != k) { C.at(k, col_A) = std::conj(acc) + beta*C.at(k, col_A); } - } - else - if( (use_alpha == true ) && (use_beta == true ) ) - { - const eT val = alpha*acc; - - C.at(col_A, k) = val + beta*C.at(col_A, k); - if(col_A != k) { C.at(k, col_A) = std::conj(val) + beta*C.at(k, col_A); } - } - } - } - } - } - - }; - - - -template -class herk_emul - { - public: - - template - arma_hot - inline - static - void - apply - ( - Mat< std::complex >& C, - const TA& A, - const T alpha = T(1), - const T beta = T(0) - ) - { - arma_debug_sigprint(); - - typedef std::complex eT; - - // do_trans_A == false -> C = alpha * A * A^H + beta*C - // do_trans_A == true -> C = alpha * A^H * A + beta*C - - if(do_trans_A == false) - { - Mat AA; - - op_htrans::apply_mat_noalias(AA, A); - - herk_emul::apply(C, AA, alpha, beta); - } - else - if(do_trans_A == true) - { - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - for(uword col_A=0; col_A < A_n_cols; ++col_A) - { - // col_A is interpreted as row_A when storing the results in matrix C - - const eT* A_coldata = A.colptr(col_A); - - for(uword k=col_A; k < A_n_cols ; ++k) - { - const eT acc = op_cdot::direct_cdot(A_n_rows, A_coldata, A.colptr(k)); - - if( (use_alpha == false) && (use_beta == false) ) - { - C.at(col_A, k) = acc; - if(col_A != k) { C.at(k, col_A) = std::conj(acc); } - } - else - if( (use_alpha == true) && (use_beta == false) ) - { - const eT val = alpha*acc; - - C.at(col_A, k) = val; - if(col_A != k) { C.at(k, col_A) = std::conj(val); } - } - else - if( (use_alpha == false) && (use_beta == true) ) - { - C.at(col_A, k) = acc + beta*C.at(col_A, k); - if(col_A != k) { C.at(k, col_A) = std::conj(acc) + beta*C.at(k, col_A); } - } - else - if( (use_alpha == true) && (use_beta == true) ) - { - const eT val = alpha*acc; - - C.at(col_A, k) = val + beta*C.at(col_A, k); - if(col_A != k) { C.at(k, col_A) = std::conj(val) + beta*C.at(k, col_A); } - } - } - } - } - } - - }; - - - -template -class herk - { - public: - - template - inline - static - void - apply_blas_type( Mat>& C, const TA& A, const T alpha = T(1), const T beta = T(0) ) - { - arma_debug_sigprint(); - - const uword threshold = 16; - - if(A.is_vec()) - { - // work around poor handling of vectors by herk() in standard BLAS - - herk_vec::apply(C,A,alpha,beta); - - return; - } - - - if( (A.n_elem <= threshold) ) - { - herk_emul::apply(C,A,alpha,beta); - } - else - { - #if defined(ARMA_USE_ATLAS) - { - if(use_beta == true) - { - typedef typename std::complex eT; - - // use a temporary matrix, as we can't assume that matrix C is already symmetric - Mat D(C.n_rows, C.n_cols, arma_nozeros_indicator()); - - herk::apply_blas_type(D,A,alpha); - - // NOTE: assuming beta=1; this is okay for now, as currently glue_times only uses beta=1 - arrayops::inplace_plus(C.memptr(), D.memptr(), C.n_elem); - - return; - } - - atlas::cblas_herk - ( - atlas_CblasColMajor, - atlas_CblasUpper, - (do_trans_A) ? atlas_CblasConjTrans : atlas_CblasNoTrans, - C.n_cols, - (do_trans_A) ? A.n_rows : A.n_cols, - (use_alpha) ? alpha : T(1), - A.mem, - (do_trans_A) ? A.n_rows : C.n_cols, - (use_beta) ? beta : T(0), - C.memptr(), - C.n_cols - ); - - herk_helper::inplace_conj_copy_upper_tri_to_lower_tri(C); - } - #elif defined(ARMA_USE_BLAS) - { - if(use_beta == true) - { - typedef typename std::complex eT; - - // use a temporary matrix, as we can't assume that matrix C is already symmetric - Mat D(C.n_rows, C.n_cols, arma_nozeros_indicator()); - - herk::apply_blas_type(D,A,alpha); - - // NOTE: assuming beta=1; this is okay for now, as currently glue_times only uses beta=1 - arrayops::inplace_plus(C.memptr(), D.memptr(), C.n_elem); - - return; - } - - arma_debug_print("blas::herk()"); - - const char uplo = 'U'; - - const char trans_A = (do_trans_A) ? 'C' : 'N'; - - const blas_int n = blas_int(C.n_cols); - const blas_int k = (do_trans_A) ? blas_int(A.n_rows) : blas_int(A.n_cols); - - const T local_alpha = (use_alpha) ? alpha : T(1); - const T local_beta = (use_beta) ? beta : T(0); - - const blas_int lda = (do_trans_A) ? k : n; - - arma_debug_print( arma_str::format("blas::herk(): trans_A: %c") % trans_A ); - - blas::herk - ( - &uplo, - &trans_A, - &n, - &k, - &local_alpha, - A.mem, - &lda, - &local_beta, - C.memptr(), - &n // &ldc - ); - - herk_helper::inplace_conj_copy_upper_tri_to_lower_tri(C); - } - #else - { - herk_emul::apply(C,A,alpha,beta); - } - #endif - } - - } - - - - template - inline - static - void - apply( Mat& C, const TA& A, const eT alpha = eT(1), const eT beta = eT(0), const typename arma_not_cx::result* junk = nullptr ) - { - arma_ignore(C); - arma_ignore(A); - arma_ignore(alpha); - arma_ignore(beta); - arma_ignore(junk); - - // herk() cannot be used by non-complex matrices - - return; - } - - - - template - arma_inline - static - void - apply - ( - Mat< std::complex >& C, - const TA& A, - const float alpha = float(1), - const float beta = float(0) - ) - { - herk::apply_blas_type(C,A,alpha,beta); - } - - - - template - arma_inline - static - void - apply - ( - Mat< std::complex >& C, - const TA& A, - const double alpha = double(1), - const double beta = double(0) - ) - { - herk::apply_blas_type(C,A,alpha,beta); - } - - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mul_syrk.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mul_syrk.hpp deleted file mode 100644 index 4c7de9373..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/mul_syrk.hpp +++ /dev/null @@ -1,501 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup syrk -//! @{ - - - -class syrk_helper - { - public: - - template - inline - static - void - inplace_copy_upper_tri_to_lower_tri(Mat& C) - { - // under the assumption that C is a square matrix - - const uword N = C.n_rows; - - for(uword k=0; k < N; ++k) - { - eT* colmem = C.colptr(k); - - uword i, j; - for(i=(k+1), j=(k+2); j < N; i+=2, j+=2) - { - const eT tmp_i = C.at(k,i); - const eT tmp_j = C.at(k,j); - - colmem[i] = tmp_i; - colmem[j] = tmp_j; - } - - if(i < N) - { - colmem[i] = C.at(k,i); - } - } - } - }; - - - -//! partial emulation of BLAS function syrk(), specialised for A being a vector -template -class syrk_vec - { - public: - - template - arma_hot - inline - static - void - apply - ( - Mat& C, - const TA& A, - const eT alpha = eT(1), - const eT beta = eT(0) - ) - { - arma_debug_sigprint(); - - const uword A_n1 = (do_trans_A == false) ? A.n_rows : A.n_cols; - const uword A_n2 = (do_trans_A == false) ? A.n_cols : A.n_rows; - - const eT* A_mem = A.memptr(); - - if(A_n1 == 1) - { - const eT acc1 = op_dot::direct_dot(A_n2, A_mem, A_mem); - - if( (use_alpha == false) && (use_beta == false) ) { C[0] = acc1; } - else if( (use_alpha == true ) && (use_beta == false) ) { C[0] = alpha*acc1; } - else if( (use_alpha == false) && (use_beta == true ) ) { C[0] = acc1 + beta*C[0]; } - else if( (use_alpha == true ) && (use_beta == true ) ) { C[0] = alpha*acc1 + beta*C[0]; } - } - else - for(uword k=0; k < A_n1; ++k) - { - const eT A_k = A_mem[k]; - - uword i,j; - for(i=(k), j=(k+1); j < A_n1; i+=2, j+=2) - { - const eT acc1 = A_k * A_mem[i]; - const eT acc2 = A_k * A_mem[j]; - - if( (use_alpha == false) && (use_beta == false) ) - { - C.at(k, i) = acc1; - C.at(k, j) = acc2; - - C.at(i, k) = acc1; - C.at(j, k) = acc2; - } - else - if( (use_alpha == true ) && (use_beta == false) ) - { - const eT val1 = alpha*acc1; - const eT val2 = alpha*acc2; - - C.at(k, i) = val1; - C.at(k, j) = val2; - - C.at(i, k) = val1; - C.at(j, k) = val2; - } - else - if( (use_alpha == false) && (use_beta == true) ) - { - C.at(k, i) = acc1 + beta*C.at(k, i); - C.at(k, j) = acc2 + beta*C.at(k, j); - - if(i != k) { C.at(i, k) = acc1 + beta*C.at(i, k); } - C.at(j, k) = acc2 + beta*C.at(j, k); - } - else - if( (use_alpha == true ) && (use_beta == true) ) - { - const eT val1 = alpha*acc1; - const eT val2 = alpha*acc2; - - C.at(k, i) = val1 + beta*C.at(k, i); - C.at(k, j) = val2 + beta*C.at(k, j); - - if(i != k) { C.at(i, k) = val1 + beta*C.at(i, k); } - C.at(j, k) = val2 + beta*C.at(j, k); - } - } - - if(i < A_n1) - { - const eT acc1 = A_k * A_mem[i]; - - if( (use_alpha == false) && (use_beta == false) ) - { - C.at(k, i) = acc1; - C.at(i, k) = acc1; - } - else - if( (use_alpha == true) && (use_beta == false) ) - { - const eT val1 = alpha*acc1; - - C.at(k, i) = val1; - C.at(i, k) = val1; - } - else - if( (use_alpha == false) && (use_beta == true) ) - { - C.at(k, i) = acc1 + beta*C.at(k, i); - if(i != k) { C.at(i, k) = acc1 + beta*C.at(i, k); } - } - else - if( (use_alpha == true) && (use_beta == true) ) - { - const eT val1 = alpha*acc1; - - C.at(k, i) = val1 + beta*C.at(k, i); - if(i != k) { C.at(i, k) = val1 + beta*C.at(i, k); } - } - } - } - } - - }; - - - -//! partial emulation of BLAS function syrk() -template -class syrk_emul - { - public: - - template - arma_hot - inline - static - void - apply - ( - Mat& C, - const TA& A, - const eT alpha = eT(1), - const eT beta = eT(0) - ) - { - arma_debug_sigprint(); - - // do_trans_A == false -> C = alpha * A * A^T + beta*C - // do_trans_A == true -> C = alpha * A^T * A + beta*C - - if(do_trans_A == false) - { - Mat AA; - - op_strans::apply_mat_noalias(AA, A); - - syrk_emul::apply(C, AA, alpha, beta); - } - else - if(do_trans_A == true) - { - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - for(uword col_A=0; col_A < A_n_cols; ++col_A) - { - // col_A is interpreted as row_A when storing the results in matrix C - - const eT* A_coldata = A.colptr(col_A); - - for(uword k=col_A; k < A_n_cols; ++k) - { - const eT acc = op_dot::direct_dot_arma(A_n_rows, A_coldata, A.colptr(k)); - - if( (use_alpha == false) && (use_beta == false) ) - { - C.at(col_A, k) = acc; - C.at(k, col_A) = acc; - } - else - if( (use_alpha == true ) && (use_beta == false) ) - { - const eT val = alpha*acc; - - C.at(col_A, k) = val; - C.at(k, col_A) = val; - } - else - if( (use_alpha == false) && (use_beta == true ) ) - { - C.at(col_A, k) = acc + beta*C.at(col_A, k); - if(col_A != k) { C.at(k, col_A) = acc + beta*C.at(k, col_A); } - } - else - if( (use_alpha == true ) && (use_beta == true ) ) - { - const eT val = alpha*acc; - - C.at(col_A, k) = val + beta*C.at(col_A, k); - if(col_A != k) { C.at(k, col_A) = val + beta*C.at(k, col_A); } - } - } - } - } - } - - }; - - - -template -class syrk - { - public: - - template - inline - static - void - apply_blas_type( Mat& C, const TA& A, const eT alpha = eT(1), const eT beta = eT(0) ) - { - arma_debug_sigprint(); - - if(A.is_vec()) - { - // work around poor handling of vectors by syrk() in standard BLAS - - syrk_vec::apply(C,A,alpha,beta); - - return; - } - - const uword threshold = (is_cx::yes ? 16u : 48u); - - if( A.n_elem <= threshold ) - { - syrk_emul::apply(C,A,alpha,beta); - } - else - { - #if defined(ARMA_USE_ATLAS) - { - if(use_beta == true) - { - // use a temporary matrix, as we can't assume that matrix C is already symmetric - Mat D(C.n_rows, C.n_cols, arma_nozeros_indicator()); - - syrk::apply_blas_type(D,A,alpha); - - // NOTE: assuming beta=1; this is okay for now, as currently glue_times only uses beta=1 - arrayops::inplace_plus(C.memptr(), D.memptr(), C.n_elem); - - return; - } - - atlas::cblas_syrk - ( - atlas_CblasColMajor, - atlas_CblasUpper, - (do_trans_A) ? atlas_CblasTrans : atlas_CblasNoTrans, - C.n_cols, - (do_trans_A) ? A.n_rows : A.n_cols, - (use_alpha) ? alpha : eT(1), - A.mem, - (do_trans_A) ? A.n_rows : C.n_cols, - (use_beta) ? beta : eT(0), - C.memptr(), - C.n_cols - ); - - syrk_helper::inplace_copy_upper_tri_to_lower_tri(C); - } - #elif defined(ARMA_USE_BLAS) - { - if(use_beta == true) - { - // use a temporary matrix, as we can't assume that matrix C is already symmetric - Mat D(C.n_rows, C.n_cols, arma_nozeros_indicator()); - - syrk::apply_blas_type(D,A,alpha); - - // NOTE: assuming beta=1; this is okay for now, as currently glue_times only uses beta=1 - arrayops::inplace_plus(C.memptr(), D.memptr(), C.n_elem); - - return; - } - - arma_debug_print("blas::syrk()"); - - const char uplo = 'U'; - - const char trans_A = (do_trans_A) ? 'T' : 'N'; - - const blas_int n = blas_int(C.n_cols); - const blas_int k = (do_trans_A) ? blas_int(A.n_rows) : blas_int(A.n_cols); - - const eT local_alpha = (use_alpha) ? alpha : eT(1); - const eT local_beta = (use_beta) ? beta : eT(0); - - const blas_int lda = (do_trans_A) ? k : n; - - arma_debug_print( arma_str::format("blas::syrk(): trans_A: %c") % trans_A ); - - blas::syrk - ( - &uplo, - &trans_A, - &n, - &k, - &local_alpha, - A.mem, - &lda, - &local_beta, - C.memptr(), - &n // &ldc - ); - - syrk_helper::inplace_copy_upper_tri_to_lower_tri(C); - } - #else - { - syrk_emul::apply(C,A,alpha,beta); - } - #endif - } - } - - - - template - inline - static - void - apply( Mat& C, const TA& A, const eT alpha = eT(1), const eT beta = eT(0) ) - { - if(is_cx::no) - { - if(A.is_vec()) - { - syrk_vec::apply(C,A,alpha,beta); - } - else - { - syrk_emul::apply(C,A,alpha,beta); - } - } - else - { - // handling of complex matrix by syrk_emul() is not yet implemented - return; - } - } - - - - template - arma_inline - static - void - apply - ( - Mat& C, - const TA& A, - const float alpha = float(1), - const float beta = float(0) - ) - { - syrk::apply_blas_type(C,A,alpha,beta); - } - - - - template - arma_inline - static - void - apply - ( - Mat& C, - const TA& A, - const double alpha = double(1), - const double beta = double(0) - ) - { - syrk::apply_blas_type(C,A,alpha,beta); - } - - - - template - arma_inline - static - void - apply - ( - Mat< std::complex >& C, - const TA& A, - const std::complex alpha = std::complex(1), - const std::complex beta = std::complex(0) - ) - { - arma_ignore(C); - arma_ignore(A); - arma_ignore(alpha); - arma_ignore(beta); - - // handling of complex matrix by syrk() is not yet implemented - return; - } - - - - template - arma_inline - static - void - apply - ( - Mat< std::complex >& C, - const TA& A, - const std::complex alpha = std::complex(1), - const std::complex beta = std::complex(0) - ) - { - arma_ignore(C); - arma_ignore(A); - arma_ignore(alpha); - arma_ignore(beta); - - // handling of complex matrix by syrk() is not yet implemented - return; - } - - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_DenseGenMatProd_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_DenseGenMatProd_bones.hpp deleted file mode 100644 index 90c3b5ad9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_DenseGenMatProd_bones.hpp +++ /dev/null @@ -1,43 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -//! Define matrix operations on existing matrix objects -template -class DenseGenMatProd - { - private: - - const Mat& op_mat; - - - public: - - const uword n_rows; // number of rows of the underlying matrix - const uword n_cols; // number of columns of the underlying matrix - - inline DenseGenMatProd(const Mat& mat_obj); - - inline void perform_op(eT* x_in, eT* y_out) const; - }; - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_DenseGenMatProd_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_DenseGenMatProd_meat.hpp deleted file mode 100644 index c80b1d2c1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_DenseGenMatProd_meat.hpp +++ /dev/null @@ -1,51 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -template -inline -DenseGenMatProd::DenseGenMatProd(const Mat& mat_obj) - : op_mat(mat_obj) - , n_rows(mat_obj.n_rows) - , n_cols(mat_obj.n_cols) - { - arma_debug_sigprint(); - } - - - -// Perform the matrix-vector multiplication operation \f$y=Ax\f$. -// y_out = A * x_in -template -inline -void -DenseGenMatProd::perform_op(eT* x_in, eT* y_out) const - { - arma_debug_sigprint(); - - const Col x(x_in , n_cols, false, true); - Col y(y_out, n_rows, false, true); - - y = op_mat * x; - } - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_DoubleShiftQR_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_DoubleShiftQR_bones.hpp deleted file mode 100644 index 1599568d2..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_DoubleShiftQR_bones.hpp +++ /dev/null @@ -1,76 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -template -class DoubleShiftQR - { - private: - - uword n; // Dimension of the matrix - Mat mat_H; // A copy of the matrix to be factorised - eT shift_s; // Shift constant - eT shift_t; // Shift constant - Mat ref_u; // Householder reflectors - Col ref_nr; // How many rows does each reflector affects - // 3 - A general reflector - // 2 - A Givens rotation - // 1 - An identity transformation - const eT prec; // Approximately zero - const eT eps_rel; - const eT eps_abs; - bool computed; // Whether matrix has been factorised - - inline void compute_reflector(const eT& x1, const eT& x2, const eT& x3, uword ind); - arma_inline void compute_reflector(const eT* x, uword ind); - - // Update the block X = H(il:iu, il:iu) - inline void update_block(uword il, uword iu); - - // P = I - 2 * u * u' = P' - // PX = X - 2 * u * (u'X) - inline void apply_PX(Mat& X, uword oi, uword oj, uword nrow, uword ncol, uword u_ind); - - // x is a pointer to a vector - // Px = x - 2 * dot(x, u) * u - inline void apply_PX(eT* x, uword u_ind); - - // XP = X - 2 * (X * u) * u' - inline void apply_XP(Mat& X, uword oi, uword oj, uword nrow, uword ncol, uword u_ind); - - - public: - - inline DoubleShiftQR(uword size); - - inline DoubleShiftQR(const Mat& mat_obj, eT s, eT t); - - inline void compute(const Mat& mat_obj, eT s, eT t); - - inline Mat matrix_QtHQ(); - - inline void apply_QtY(Col& y); - - inline void apply_YQ(Mat& Y); - }; - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_DoubleShiftQR_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_DoubleShiftQR_meat.hpp deleted file mode 100644 index ca29693f9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_DoubleShiftQR_meat.hpp +++ /dev/null @@ -1,399 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -template -inline -void -DoubleShiftQR::compute_reflector(const eT& x1, const eT& x2, const eT& x3, uword ind) - { - arma_debug_sigprint(); - - // In general case the reflector affects 3 rows - ref_nr(ind) = 3; - eT x2x3 = eT(0); - // If x3 is zero, decrease nr by 1 - if(std::abs(x3) < prec) - { - // If x2 is also zero, nr will be 1, and we can exit this function - if(std::abs(x2) < prec) - { - ref_nr(ind) = 1; - return; - } - else - { - ref_nr(ind) = 2; - } - x2x3 = std::abs(x2); - } - else - { - x2x3 = arma_hypot(x2, x3); - } - - // x1' = x1 - rho * ||x|| - // rho = -sign(x1), if x1 == 0, we choose rho = 1 - eT x1_new = x1 - ((x1 <= 0) - (x1 > 0)) * arma_hypot(x1, x2x3); - eT x_norm = arma_hypot(x1_new, x2x3); - // Double check the norm of new x - if(x_norm < prec) - { - ref_nr(ind) = 1; - return; - } - ref_u(0, ind) = x1_new / x_norm; - ref_u(1, ind) = x2 / x_norm; - ref_u(2, ind) = x3 / x_norm; - } - - -template -arma_inline -void -DoubleShiftQR::compute_reflector(const eT* x, uword ind) - { - arma_debug_sigprint(); - - compute_reflector(x[0], x[1], x[2], ind); - } - - - -template -inline -void -DoubleShiftQR::update_block(uword il, uword iu) - { - arma_debug_sigprint(); - - // Block size - uword bsize = iu - il + 1; - - // If block size == 1, there is no need to apply reflectors - if(bsize == 1) - { - ref_nr(il) = 1; - return; - } - - // For block size == 2, do a Givens rotation on M = X * X - s * X + t * I - if(bsize == 2) - { - // m00 = x00 * (x00 - s) + x01 * x10 + t - eT m00 = mat_H(il, il) * (mat_H(il, il) - shift_s) + - mat_H(il, il + 1) * mat_H(il + 1, il) + - shift_t; - // m10 = x10 * (x00 + x11 - s) - eT m10 = mat_H(il + 1, il) * (mat_H(il, il) + mat_H(il + 1, il + 1) - shift_s); - // This causes nr=2 - compute_reflector(m00, m10, 0, il); - // Apply the reflector to X - apply_PX(mat_H, il, il, 2, n - il, il); - apply_XP(mat_H, 0, il, il + 2, 2, il); - - ref_nr(il + 1) = 1; - return; - } - - // For block size >=3, use the regular strategy - eT m00 = mat_H(il, il) * (mat_H(il, il) - shift_s) + - mat_H(il, il + 1) * mat_H(il + 1, il) + - shift_t; - eT m10 = mat_H(il + 1, il) * (mat_H(il, il) + mat_H(il + 1, il + 1) - shift_s); - // m20 = x21 * x10 - eT m20 = mat_H(il + 2, il + 1) * mat_H(il + 1, il); - compute_reflector(m00, m10, m20, il); - - // Apply the first reflector - apply_PX(mat_H, il, il, 3, n - il, il); - apply_XP(mat_H, 0, il, il + (std::min)(bsize, uword(4)), 3, il); - - // Calculate the following reflectors - // If entering this loop, block size is at least 4. - for(uword i = 1; i < bsize - 2; i++) - { - compute_reflector(mat_H.colptr(il + i - 1) + il + i, il + i); - // Apply the reflector to X - apply_PX(mat_H, il + i, il + i - 1, 3, n + 1 - il - i, il + i); - apply_XP(mat_H, 0, il + i, il + (std::min)(bsize, uword(i + 4)), 3, il + i); - } - - // The last reflector - // This causes nr=2 - compute_reflector(mat_H(iu - 1, iu - 2), mat_H(iu, iu - 2), 0, iu - 1); - // Apply the reflector to X - apply_PX(mat_H, iu - 1, iu - 2, 2, n + 2 - iu, iu - 1); - apply_XP(mat_H, 0, iu - 1, il + bsize, 2, iu - 1); - - ref_nr(iu) = 1; - } - - - -template -inline -void -DoubleShiftQR::apply_PX(Mat& X, uword oi, uword oj, uword nrow, uword ncol, uword u_ind) - { - arma_debug_sigprint(); - - if(ref_nr(u_ind) == 1) { return; } - - // Householder reflectors at index u_ind - Col u(ref_u.colptr(u_ind), 3, false); - - const uword stride = X.n_rows; - const eT u0_2 = 2 * u(0); - const eT u1_2 = 2 * u(1); - - eT* xptr = &X(oi, oj); - if(ref_nr(u_ind) == 2 || nrow == 2) - { - for(uword i = 0; i < ncol; i++, xptr += stride) - { - eT tmp = u0_2 * xptr[0] + u1_2 * xptr[1]; - xptr[0] -= tmp * u(0); - xptr[1] -= tmp * u(1); - } - } - else - { - const eT u2_2 = 2 * u(2); - for(uword i = 0; i < ncol; i++, xptr += stride) - { - eT tmp = u0_2 * xptr[0] + u1_2 * xptr[1] + u2_2 * xptr[2]; - xptr[0] -= tmp * u(0); - xptr[1] -= tmp * u(1); - xptr[2] -= tmp * u(2); - } - } - } - - - -template -inline -void -DoubleShiftQR::apply_PX(eT* x, uword u_ind) - { - arma_debug_sigprint(); - - if(ref_nr(u_ind) == 1) { return; } - - eT u0 = ref_u(0, u_ind), - u1 = ref_u(1, u_ind), - u2 = ref_u(2, u_ind); - - // When the reflector only contains two elements, u2 has been set to zero - bool nr_is_2 = (ref_nr(u_ind) == 2); - eT dot2 = x[0] * u0 + x[1] * u1 + (nr_is_2 ? 0 : (x[2] * u2)); - dot2 *= 2; - x[0] -= dot2 * u0; - x[1] -= dot2 * u1; - if(!nr_is_2) { x[2] -= dot2 * u2; } - } - - - -template -inline -void -DoubleShiftQR::apply_XP(Mat& X, uword oi, uword oj, uword nrow, uword ncol, uword u_ind) - { - arma_debug_sigprint(); - - if(ref_nr(u_ind) == 1) { return; } - - // Householder reflectors at index u_ind - Col u(ref_u.colptr(u_ind), 3, false); - uword stride = X.n_rows; - const eT u0_2 = 2 * u(0); - const eT u1_2 = 2 * u(1); - eT* X0 = &X(oi, oj); - eT* X1 = X0 + stride; // X0 => X(oi, oj), X1 => X(oi, oj + 1) - - if(ref_nr(u_ind) == 2 || ncol == 2) - { - // tmp = 2 * u0 * X0 + 2 * u1 * X1 - // X0 => X0 - u0 * tmp - // X1 => X1 - u1 * tmp - for(uword i = 0; i < nrow; i++) - { - eT tmp = u0_2 * X0[i] + u1_2 * X1[i]; - X0[i] -= tmp * u(0); - X1[i] -= tmp * u(1); - } - } - else - { - eT* X2 = X1 + stride; // X2 => X(oi, oj + 2) - const eT u2_2 = 2 * u(2); - for(uword i = 0; i < nrow; i++) - { - eT tmp = u0_2 * X0[i] + u1_2 * X1[i] + u2_2 * X2[i]; - X0[i] -= tmp * u(0); - X1[i] -= tmp * u(1); - X2[i] -= tmp * u(2); - } - } - } - - - -template -inline -DoubleShiftQR::DoubleShiftQR(uword size) - : n(size) - , prec(std::numeric_limits::epsilon()) - , eps_rel(prec) - , eps_abs(prec) - , computed(false) - { - arma_debug_sigprint(); - } - - - -template -inline -DoubleShiftQR::DoubleShiftQR(const Mat& mat_obj, eT s, eT t) - : n(mat_obj.n_rows) - , mat_H(n, n) - , shift_s(s) - , shift_t(t) - , ref_u(3, n) - , ref_nr(n) - , prec(std::numeric_limits::epsilon()) - , eps_rel(prec) - , eps_abs(prec) - , computed(false) - { - arma_debug_sigprint(); - - compute(mat_obj, s, t); - } - - - -template -void -DoubleShiftQR::compute(const Mat& mat_obj, eT s, eT t) - { - arma_debug_sigprint(); - - arma_conform_check( (mat_obj.is_square() == false), "newarp::DoubleShiftQR::compute(): matrix must be square" ); - - n = mat_obj.n_rows; - mat_H.set_size(n, n); - shift_s = s; - shift_t = t; - ref_u.set_size(3, n); - ref_nr.set_size(n); - - // Make a copy of mat_obj - mat_H = mat_obj; - - // Obtain the indices of zero elements in the subdiagonal, - // so that H can be divided into several blocks - std::vector zero_ind; - zero_ind.reserve(n - 1); - zero_ind.push_back(0); - eT* Hii = mat_H.memptr(); - for(uword i = 0; i < n - 2; i++, Hii += (n + 1)) - { - // Hii[1] => mat_H(i + 1, i) - const eT h = std::abs(Hii[1]); - if(h <= eps_abs || h <= eps_rel * (std::abs(Hii[0]) + std::abs(Hii[n + 1]))) - { - Hii[1] = 0; - zero_ind.push_back(i + 1); - } - // Make sure mat_H is upper Hessenberg - // Zero the elements below mat_H(i + 1, i) - std::fill(Hii + 2, Hii + n - i, eT(0)); - } - zero_ind.push_back(n); - - for(std::vector::size_type i = 0; i < zero_ind.size() - 1; i++) - { - uword start = zero_ind[i]; - uword end = zero_ind[i + 1] - 1; - // Compute refelctors from each block X - update_block(start, end); - } - - computed = true; - } - - - -template -Mat -DoubleShiftQR::matrix_QtHQ() - { - arma_debug_sigprint(); - - arma_conform_check( (computed == false), "newarp::DoubleShiftQR::matrix_QtHQ(): need to call compute() first" ); - - return mat_H; - } - - - -template -inline -void -DoubleShiftQR::apply_QtY(Col& y) - { - arma_debug_sigprint(); - - arma_conform_check( (computed == false), "newarp::DoubleShiftQR::apply_QtY(): need to call compute() first" ); - - eT* y_ptr = y.memptr(); - for(uword i = 0; i < n - 1; i++, y_ptr++) - { - apply_PX(y_ptr, i); - } - } - - - -template -inline -void -DoubleShiftQR::apply_YQ(Mat& Y) - { - arma_debug_sigprint(); - - arma_conform_check( (computed == false), "newarp::DoubleShiftQR::apply_YQ(): need to call compute() first" ); - - uword nrow = Y.n_rows; - for(uword i = 0; i < n - 2; i++) - { - apply_XP(Y, 0, i, nrow, 3, i); - } - - apply_XP(Y, 0, n - 2, nrow, 2, n - 2); - } - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_EigsSelect.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_EigsSelect.hpp deleted file mode 100644 index d518c64bb..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_EigsSelect.hpp +++ /dev/null @@ -1,52 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -//! The enumeration of selection rules of desired eigenvalues. -struct EigsSelect - { - enum SELECT_EIGENVALUE - { - LARGEST_MAGN = 0, //!< Select eigenvalues with largest magnitude. - //!< Magnitude means the absolute value for real numbers and norm for complex numbers. - //!< Applies to both symmetric and general eigen solvers. - - LARGEST_REAL, //!< Select eigenvalues with largest real part. Only for general eigen solvers. - - LARGEST_IMAG, //!< Select eigenvalues with largest imaginary part (in magnitude). Only for general eigen solvers. - - LARGEST_ALGE, //!< Select eigenvalues with largest algebraic value, considering any negative sign. Only for symmetric eigen solvers. - - SMALLEST_MAGN, //!< Select eigenvalues with smallest magnitude. Applies to both symmetric and general eigen solvers. - - SMALLEST_REAL, //!< Select eigenvalues with smallest real part. Only for general eigen solvers. - - SMALLEST_IMAG, //!< Select eigenvalues with smallest imaginary part (in magnitude). Only for general eigen solvers. - - SMALLEST_ALGE, //!< Select eigenvalues with smallest algebraic value. Only for symmetric eigen solvers. - - BOTH_ENDS //!< Select eigenvalues half from each end of the spectrum. - //!< When `nev` is odd, compute more from the high end. Only for symmetric eigen solvers. - }; - }; - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_GenEigsSolver_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_GenEigsSolver_bones.hpp deleted file mode 100644 index eabaf063d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_GenEigsSolver_bones.hpp +++ /dev/null @@ -1,109 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -//! This class implements the eigen solver for general real matrices. -template -class GenEigsSolver - { - protected: - - const OpType& op; // object to conduct matrix operation, eg. matrix-vector product - const uword nev; // number of eigenvalues requested - Col< std::complex > ritz_val; // ritz values - - // Sort the first nev Ritz pairs in decreasing magnitude order - // This is used to return the final results - virtual void sort_ritzpair(); - - - private: - - const uword dim_n; // dimension of matrix A - const uword ncv; // number of ritz values - uword nmatop; // number of matrix operations called - uword niter; // number of restarting iterations - Mat fac_V; // V matrix in the Arnoldi factorisation - Mat fac_H; // H matrix in the Arnoldi factorisation - Col fac_f; // residual in the Arnoldi factorisation - Mat< std::complex > ritz_vec; // ritz vectors - Col< std::complex > ritz_est; // last row of ritz_vec - std::vector ritz_conv; // indicator of the convergence of ritz values - const eT eps; // the machine precision - // eg. ~= 1e-16 for double type - const eT approx0; // a number that is approximately zero - // approx0 = eps^(2/3) - // used to test the orthogonality of vectors, - // and in convergence test, tol*approx0 is - // the absolute tolerance - - std::mt19937_64 local_rng; // local random number generator - - inline void fill_rand(eT* dest, const uword N, const uword seed_val); - - // Arnoldi factorisation starting from step-k - inline void factorise_from(uword from_k, uword to_m, const Col& fk); - - // Implicitly restarted Arnoldi factorisation - inline void restart(uword k); - - // Calculate the number of converged Ritz values - inline uword num_converged(eT tol); - - // Return the adjusted nev for restarting - inline uword nev_adjusted(uword nconv); - - // Retrieve and sort ritz values and ritz vectors - inline void retrieve_ritzpair(); - - - public: - - //! Constructor to create a solver object. - inline GenEigsSolver(const OpType& op_, uword nev_, uword ncv_); - - //! Providing the initial residual vector for the algorithm. - inline void init(eT* init_resid); - - //! Providing a random initial residual vector. - inline void init(); - - //! Conducting the major computation procedure. - inline uword compute(uword maxit = 1000, eT tol = 1e-10); - - //! Returning the number of iterations used in the computation. - inline int num_iterations() { return niter; } - - //! Returning the number of matrix operations used in the computation. - inline int num_operations() { return nmatop; } - - //! Returning the converged eigenvalues. - inline Col< std::complex > eigenvalues(); - - //! Returning the eigenvectors associated with the converged eigenvalues. - inline Mat< std::complex > eigenvectors(uword nvec); - - //! Returning all converged eigenvectors. - inline Mat< std::complex > eigenvectors() { return eigenvectors(nev); } - }; - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_GenEigsSolver_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_GenEigsSolver_meat.hpp deleted file mode 100644 index 7965415f9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_GenEigsSolver_meat.hpp +++ /dev/null @@ -1,492 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -template -inline -void -GenEigsSolver::fill_rand(eT* dest, const uword N, const uword seed_val) - { - arma_debug_sigprint(); - - typedef typename std::mt19937_64::result_type seed_type; - - local_rng.seed( seed_type(seed_val) ); - - std::uniform_real_distribution dist(-1.0, +1.0); - - for(uword i=0; i < N; ++i) { dest[i] = eT(dist(local_rng)); } - } - - - -template -inline -void -GenEigsSolver::factorise_from(uword from_k, uword to_m, const Col& fk) - { - arma_debug_sigprint(); - - if(to_m <= from_k) { return; } - - fac_f = fk; - - Col w(dim_n, arma_zeros_indicator()); - eT beta = norm(fac_f); - // Keep the upperleft k x k submatrix of H and set other elements to 0 - fac_H.tail_cols(ncv - from_k).zeros(); - fac_H.submat(span(from_k, ncv - 1), span(0, from_k - 1)).zeros(); - for(uword i = from_k; i <= to_m - 1; i++) - { - bool restart = false; - // If beta = 0, then the next V is not full rank - // We need to generate a new residual vector that is orthogonal - // to the current V, which we call a restart - if(beta < eps) - { - // // Generate new random vector for fac_f - // blas_int idist = 2; - // blas_int iseed[4] = {1, 3, 5, 7}; - // iseed[0] = (i + 100) % 4095; - // blas_int n = dim_n; - // lapack::larnv(&idist, &iseed[0], &n, fac_f.memptr()); - - // Generate new random vector for fac_f - fill_rand(fac_f.memptr(), dim_n, i+1); - - // f <- f - V * V' * f, so that f is orthogonal to V - Mat Vs(fac_V.memptr(), dim_n, i, false); // First i columns - Col Vf = Vs.t() * fac_f; - fac_f -= Vs * Vf; - // beta <- ||f|| - beta = norm(fac_f); - - restart = true; - } - - // v <- f / ||f|| - fac_V.col(i) = fac_f / beta; // The (i+1)-th column - - // Note that H[i+1, i] equals to the unrestarted beta - if(restart) { fac_H(i, i - 1) = 0.0; } else { fac_H(i, i - 1) = beta; } - - // w <- A * v, v = fac_V.col(i) - op.perform_op(fac_V.colptr(i), w.memptr()); - nmatop++; - - // First i+1 columns of V - Mat Vs(fac_V.memptr(), dim_n, i + 1, false); - // h = fac_H(0:i, i) - Col h(fac_H.colptr(i), i + 1, false); - // h <- V' * w - h = Vs.t() * w; - - // f <- w - V * h - fac_f = w - Vs * h; - beta = norm(fac_f); - - if(beta > 0.717 * norm(h)) { continue; } - - // f/||f|| is going to be the next column of V, so we need to test - // whether V' * (f/||f||) ~= 0 - Col Vf = Vs.t() * fac_f; - // If not, iteratively correct the residual - uword count = 0; - while(count < 5 && abs(Vf).max() > approx0 * beta) - { - // f <- f - V * Vf - fac_f -= Vs * Vf; - // h <- h + Vf - h += Vf; - // beta <- ||f|| - beta = norm(fac_f); - - Vf = Vs.t() * fac_f; - count++; - } - } - } - - - -template -inline -void -GenEigsSolver::restart(uword k) - { - arma_debug_sigprint(); - - if(k >= ncv) { return; } - - DoubleShiftQR decomp_ds(ncv); - UpperHessenbergQR decomp; - - Mat Q(ncv, ncv, fill::eye); - - for(uword i = k; i < ncv; i++) - { - if(cx_attrib::is_complex(ritz_val(i), eT(0)) && (i < (ncv - 1)) && cx_attrib::is_conj(ritz_val(i), ritz_val(i + 1), eT(0))) - { - // H - mu * I = Q1 * R1 - // H <- R1 * Q1 + mu * I = Q1' * H * Q1 - // H - conj(mu) * I = Q2 * R2 - // H <- R2 * Q2 + conj(mu) * I = Q2' * H * Q2 - // - // (H - mu * I) * (H - conj(mu) * I) = Q1 * Q2 * R2 * R1 = Q * R - eT s = 2 * ritz_val(i).real(); - eT t = std::norm(ritz_val(i)); - decomp_ds.compute(fac_H, s, t); - - // Q -> Q * Qi - decomp_ds.apply_YQ(Q); - // H -> Q'HQ - fac_H = decomp_ds.matrix_QtHQ(); - - i++; - } - else - { - // QR decomposition of H - mu * I, mu is real - fac_H.diag() -= ritz_val(i).real(); - decomp.compute(fac_H); - - // Q -> Q * Qi - decomp.apply_YQ(Q); - // H -> Q'HQ = RQ + mu * I - fac_H = decomp.matrix_RQ(); - fac_H.diag() += ritz_val(i).real(); - } - } - - // V -> VQ - // Q has some elements being zero - // The first (ncv - k + i) elements of the i-th column of Q are non-zero - Mat Vs(dim_n, k + 1, arma_nozeros_indicator()); - uword nnz; - for(uword i = 0; i < k; i++) - { - nnz = ncv - k + i + 1; - Mat V(fac_V.memptr(), dim_n, nnz, false); - Col q(Q.colptr(i), nnz, false); - Col v(Vs.colptr(i), dim_n, false); - v = V * q; - } - - Vs.col(k) = fac_V * Q.col(k); - fac_V.head_cols(k + 1) = Vs; - - Col fk = fac_f * Q(ncv - 1, k - 1) + fac_V.col(k) * fac_H(k, k - 1); - factorise_from(k, ncv, fk); - retrieve_ritzpair(); - } - - - -template -inline -uword -GenEigsSolver::num_converged(eT tol) - { - arma_debug_sigprint(); - - // thresh = tol * max(prec, abs(theta)), theta for ritz value - const eT f_norm = arma::norm(fac_f); - for(uword i = 0; i < nev; i++) - { - eT thresh = tol * (std::max)(approx0, std::abs(ritz_val(i))); - eT resid = std::abs(ritz_est(i)) * f_norm; - ritz_conv[i] = (resid < thresh); - } - - return std::count(ritz_conv.begin(), ritz_conv.end(), true); - } - - - -template -inline -uword -GenEigsSolver::nev_adjusted(uword nconv) - { - arma_debug_sigprint(); - - uword nev_new = nev; - - for(uword i = nev; i < ncv; i++) - { - if(std::abs(ritz_est(i)) < eps) { nev_new++; } - } - // Adjust nev_new again, according to dnaup2.f line 660~674 in ARPACK - nev_new += (std::min)(nconv, (ncv - nev_new) / 2); - if(nev_new == 1 && ncv >= 6) - { - nev_new = ncv / 2; - } - else - if(nev_new == 1 && ncv > 3) - { - nev_new = 2; - } - - if(nev_new > ncv - 2) { nev_new = ncv - 2; } - - // Increase nev by one if ritz_val[nev - 1] and - // ritz_val[nev] are conjugate pairs - if(cx_attrib::is_complex(ritz_val(nev_new - 1), eps) && cx_attrib::is_conj(ritz_val(nev_new - 1), ritz_val(nev_new), eps)) - { - nev_new++; - } - - return nev_new; - } - - - -template -inline -void -GenEigsSolver::retrieve_ritzpair() - { - arma_debug_sigprint(); - - UpperHessenbergEigen decomp(fac_H); - - Col< std::complex > evals = decomp.eigenvalues(); - Mat< std::complex > evecs = decomp.eigenvectors(); - - SortEigenvalue< std::complex, SelectionRule > sorting(evals.memptr(), evals.n_elem); - std::vector ind = sorting.index(); - - // Copy the ritz values and vectors to ritz_val and ritz_vec, respectively - for(uword i = 0; i < ncv; i++) - { - ritz_val(i) = evals(ind[i]); - ritz_est(i) = evecs(ncv - 1, ind[i]); - } - for(uword i = 0; i < nev; i++) - { - ritz_vec.col(i) = evecs.col(ind[i]); - } - } - - - -template -inline -void -GenEigsSolver::sort_ritzpair() - { - arma_debug_sigprint(); - - // SortEigenvalue< std::complex, EigsSelect::LARGEST_MAGN > sorting(ritz_val.memptr(), nev); - - // sort Ritz values according to SelectionRule, to be consistent with ARPACK - SortEigenvalue< std::complex, SelectionRule > sorting(ritz_val.memptr(), nev); - - std::vector ind = sorting.index(); - - Col< std::complex > new_ritz_val(ncv, arma_zeros_indicator() ); - Mat< std::complex > new_ritz_vec(ncv, nev, arma_nozeros_indicator()); - std::vector new_ritz_conv(nev); - - for(uword i = 0; i < nev; i++) - { - new_ritz_val(i) = ritz_val(ind[i]); - new_ritz_vec.col(i) = ritz_vec.col(ind[i]); - new_ritz_conv[i] = ritz_conv[ind[i]]; - } - - ritz_val.swap(new_ritz_val); - ritz_vec.swap(new_ritz_vec); - ritz_conv.swap(new_ritz_conv); - } - - - -template -inline -GenEigsSolver::GenEigsSolver(const OpType& op_, uword nev_, uword ncv_) - : op(op_) - , nev(nev_) - , dim_n(op.n_rows) - , ncv(ncv_ > dim_n ? dim_n : ncv_) - , nmatop(0) - , niter(0) - , eps(std::numeric_limits::epsilon()) - , approx0(std::pow(eps, eT(2.0) / 3)) - { - arma_debug_sigprint(); - - arma_conform_check( (nev_ < 1 || nev_ > dim_n - 2), "newarp::GenEigsSolver: nev must satisfy 1 <= nev <= n - 2, n is the size of matrix" ); - arma_conform_check( (ncv_ < nev_ + 2 || ncv_ > dim_n), "newarp::GenEigsSolver: ncv must satisfy nev + 2 <= ncv <= n, n is the size of matrix" ); - } - - - -template -inline -void -GenEigsSolver::init(eT* init_resid) - { - arma_debug_sigprint(); - - // Reset all matrices/vectors to zero - fac_V.zeros(dim_n, ncv); - fac_H.zeros(ncv, ncv); - fac_f.zeros(dim_n); - ritz_val.zeros(ncv); - ritz_vec.zeros(ncv, nev); - ritz_est.zeros(ncv); - ritz_conv.assign(nev, false); - - nmatop = 0; - niter = 0; - - Col r(init_resid, dim_n, false); - // The first column of fac_V - Col v(fac_V.colptr(0), dim_n, false); - eT rnorm = norm(r); - arma_check( (rnorm < eps), "newarp::GenEigsSolver::init(): initial residual vector cannot be zero" ); - v = r / rnorm; - - Col w(dim_n, arma_zeros_indicator()); - op.perform_op(v.memptr(), w.memptr()); - nmatop++; - - fac_H(0, 0) = dot(v, w); - fac_f = w - v * fac_H(0, 0); - } - - - -template -inline -void -GenEigsSolver::init() - { - arma_debug_sigprint(); - - // podarray init_resid(dim_n); - // blas_int idist = 2; // Uniform(-1, 1) - // blas_int iseed[4] = {1, 3, 5, 7}; // Fixed random seed - // blas_int n = dim_n; - // lapack::larnv(&idist, &iseed[0], &n, init_resid.memptr()); - // init(init_resid.memptr()); - - podarray init_resid(dim_n); - - fill_rand(init_resid.memptr(), dim_n, 0); - - init(init_resid.memptr()); - } - - - -template -inline -uword -GenEigsSolver::compute(uword maxit, eT tol) - { - arma_debug_sigprint(); - - // The m-step Arnoldi factorisation - factorise_from(1, ncv, fac_f); - retrieve_ritzpair(); - // Restarting - uword i, nconv = 0, nev_adj; - for(i = 0; i < maxit; i++) - { - nconv = num_converged(tol); - if(nconv >= nev) { break; } - - nev_adj = nev_adjusted(nconv); - restart(nev_adj); - } - // Sorting results - sort_ritzpair(); - - niter = i + 1; - - return (std::min)(nev, nconv); - } - - - -template -inline -Col< std::complex > -GenEigsSolver::eigenvalues() - { - arma_debug_sigprint(); - - uword nconv = std::count(ritz_conv.begin(), ritz_conv.end(), true); - Col< std::complex > res(nconv, arma_zeros_indicator()); - - if(nconv > 0) - { - uword j = 0; - for(uword i = 0; i < nev; i++) - { - if(ritz_conv[i]) - { - res(j) = ritz_val(i); - j++; - } - } - } - - return res; - } - - - -template -inline -Mat< std::complex > -GenEigsSolver::eigenvectors(uword nvec) - { - arma_debug_sigprint(); - - uword nconv = std::count(ritz_conv.begin(), ritz_conv.end(), true); - nvec = (std::min)(nvec, nconv); - Mat< std::complex > res(dim_n, nvec); - - if(nvec > 0) - { - Mat< std::complex > ritz_vec_conv(ncv, nvec, arma_zeros_indicator()); - uword j = 0; - for(uword i = 0; (i < nev) && (j < nvec); i++) - { - if(ritz_conv[i]) - { - ritz_vec_conv.col(j) = ritz_vec.col(i); - j++; - } - } - - res = fac_V * ritz_vec_conv; - } - - return res; - } - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SortEigenvalue.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SortEigenvalue.hpp deleted file mode 100644 index 4df115efc..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SortEigenvalue.hpp +++ /dev/null @@ -1,203 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -// When comparing eigenvalues, we first calculate the "target" to sort. -// For example, if we want to choose the eigenvalues with largest magnitude, the target will be -std::abs(x). -// The minus sign is due to the fact that std::sort() sorts in ascending order. - - -// default target: throw an exception -template -struct SortingTarget - { - arma_inline static typename get_pod_type::result get(const eT& val) - { - arma_ignore(val); - arma_stop_logic_error("newarp::SortingTarget: incompatible selection rule"); - - typedef typename get_pod_type::result out_T; - return out_T(0); - } - }; - - -// specialisation for LARGEST_MAGN: this covers [float, double, complex] x [LARGEST_MAGN] -template -struct SortingTarget - { - arma_inline static typename get_pod_type::result get(const eT& val) - { - return -std::abs(val); - } - }; - - -// specialisation for LARGEST_REAL: this covers [complex] x [LARGEST_REAL] -template -struct SortingTarget, EigsSelect::LARGEST_REAL> - { - arma_inline static T get(const std::complex& val) - { - return -val.real(); - } - }; - - -// specialisation for LARGEST_IMAG: this covers [complex] x [LARGEST_IMAG] -template -struct SortingTarget, EigsSelect::LARGEST_IMAG> - { - arma_inline static T get(const std::complex& val) - { - return -std::abs(val.imag()); - } - }; - - -// specialisation for LARGEST_ALGE: this covers [float, double] x [LARGEST_ALGE] -template -struct SortingTarget - { - arma_inline static eT get(const eT& val) - { - return -val; - } - }; - - -// Here BOTH_ENDS is the same as LARGEST_ALGE, but we need some additional steps, -// which are done in SymEigsSolver => retrieve_ritzpair(). -// There we move the smallest values to the proper locations. -template -struct SortingTarget - { - arma_inline static eT get(const eT& val) - { - return -val; - } - }; - - -// specialisation for SMALLEST_MAGN: this covers [float, double, complex] x [SMALLEST_MAGN] -template -struct SortingTarget - { - arma_inline static typename get_pod_type::result get(const eT& val) - { - return std::abs(val); - } - }; - - -// specialisation for SMALLEST_REAL: this covers [complex] x [SMALLEST_REAL] -template -struct SortingTarget, EigsSelect::SMALLEST_REAL> - { - arma_inline static T get(const std::complex& val) - { - return val.real(); - } - }; - - -// specialisation for SMALLEST_IMAG: this covers [complex] x [SMALLEST_IMAG] -template -struct SortingTarget, EigsSelect::SMALLEST_IMAG> - { - arma_inline static T get(const std::complex& val) - { - return std::abs(val.imag()); - } - }; - - -// specialisation for SMALLEST_ALGE: this covers [float, double] x [SMALLEST_ALGE] -template -struct SortingTarget - { - arma_inline static eT get(const eT& val) - { - return val; - } - }; - - -// Sort eigenvalues and return the order index -template -struct PairComparator - { - arma_inline bool operator() (const PairType& v1, const PairType& v2) - { - return v1.first < v2.first; - } - }; - - -template -class SortEigenvalue - { - private: - - typedef typename get_pod_type::result TargetType; // type of the sorting target, will be a floating number type, eg. double - typedef std::pair PairType; // type of the sorting pair, including the sorting target and the index - - std::vector pair_sort; - - - public: - - inline - SortEigenvalue(const eT* start, const uword size) - : pair_sort(size) - { - arma_debug_sigprint(); - - for(uword i = 0; i < size; i++) - { - pair_sort[i].first = SortingTarget::get(start[i]); - pair_sort[i].second = i; - } - - PairComparator comp; - - std::sort(pair_sort.begin(), pair_sort.end(), comp); - } - - - inline - std::vector - index() - { - arma_debug_sigprint(); - - const uword len = pair_sort.size(); - - std::vector ind(len); - - for(uword i = 0; i < len; i++) { ind[i] = pair_sort[i].second; } - - return ind; - } - }; - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SparseGenMatProd_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SparseGenMatProd_bones.hpp deleted file mode 100644 index 2028aee2e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SparseGenMatProd_bones.hpp +++ /dev/null @@ -1,44 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -//! Define matrix operations on existing matrix objects -template -class SparseGenMatProd - { - private: - - const SpMat& op_mat; - SpMat op_mat_st; - - - public: - - const uword n_rows; // number of rows of the underlying matrix - const uword n_cols; // number of columns of the underlying matrix - - inline SparseGenMatProd(const SpMat& mat_obj); - - inline void perform_op(eT* x_in, eT* y_out) const; - }; - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SparseGenMatProd_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SparseGenMatProd_meat.hpp deleted file mode 100644 index f9c66f833..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SparseGenMatProd_meat.hpp +++ /dev/null @@ -1,63 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -template -inline -SparseGenMatProd::SparseGenMatProd(const SpMat& mat_obj) - : op_mat(mat_obj) - , n_rows(mat_obj.n_rows) - , n_cols(mat_obj.n_cols) - { - arma_debug_sigprint(); - - op_mat_st = op_mat.st(); // pre-calculate transpose - } - - - -// Perform the matrix-vector multiplication operation \f$y=Ax\f$. -// y_out = A * x_in -template -inline -void -SparseGenMatProd::perform_op(eT* x_in, eT* y_out) const - { - arma_debug_sigprint(); - - // // OLD METHOD - // - // const Col x(x_in , n_cols, false, true); - // Col y(y_out, n_rows, false, true); - // - // y = op_mat * x; - - - // NEW METHOD - - const Row x(x_in , n_cols, false, true); - Row y(y_out, n_rows, false, true); - - y = x * op_mat_st; - } - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SparseGenRealShiftSolve_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SparseGenRealShiftSolve_bones.hpp deleted file mode 100644 index a47575ddf..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SparseGenRealShiftSolve_bones.hpp +++ /dev/null @@ -1,51 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -//! Define matrix operations on existing matrix objects -template -class SparseGenRealShiftSolve - { - private: - - #if defined(ARMA_USE_SUPERLU) - // The following objects are read-only in perform_op() - mutable superlu_supermatrix_wrangler l; - mutable superlu_supermatrix_wrangler u; - mutable superlu_array_wrangler perm_c; - mutable superlu_array_wrangler perm_r; - #endif - - - public: - - bool valid = false; - - const uword n_rows; // number of rows of the underlying matrix - const uword n_cols; // number of columns of the underlying matrix - - inline SparseGenRealShiftSolve(const SpMat& mat_obj, const eT shift); - - inline void perform_op(eT* x_in, eT* y_out) const; - }; - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SparseGenRealShiftSolve_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SparseGenRealShiftSolve_meat.hpp deleted file mode 100644 index 9213d2be9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SparseGenRealShiftSolve_meat.hpp +++ /dev/null @@ -1,138 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -template -inline -SparseGenRealShiftSolve::SparseGenRealShiftSolve(const SpMat& mat_obj, const eT shift) - #if defined(ARMA_USE_SUPERLU) - : perm_c(mat_obj.n_cols + 1) - , perm_r(mat_obj.n_rows + 1) - , n_rows(mat_obj.n_rows) - , n_cols(mat_obj.n_cols) - #else - : n_rows(0) - , n_cols(0) - #endif - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_SUPERLU) - { - // Derived from sp_auxlib::run_aupd_shiftinvert() - superlu_opts superlu_opts_default; - superlu::superlu_options_t options; - sp_auxlib::set_superlu_opts(options, superlu_opts_default); - - superlu::GlobalLU_t Glu; - arrayops::fill_zeros(reinterpret_cast(&Glu), sizeof(superlu::GlobalLU_t)); - - superlu_supermatrix_wrangler x; - superlu_supermatrix_wrangler xC; - superlu_array_wrangler etree(mat_obj.n_cols+1); - - // Copy A-shift*I to x - const bool status_x = sp_auxlib::copy_to_supermatrix_with_shift(x.get_ref(), mat_obj, shift); - - if(status_x == false) { arma_stop_runtime_error("newarp::SparseGenRealShiftSolve::SparseGenRealShiftSolve(): could not construct SuperLU matrix"); return; } - - int panel_size = superlu::sp_ispec_environ(1); - int relax = superlu::sp_ispec_environ(2); - int slu_info = 0; // Return code - int lwork = 0; // lwork = 0: allocate space internally by system malloc - - superlu_stat_wrangler stat; - - arma_debug_print("superlu::gstrf()"); - superlu::get_permutation_c(options.ColPerm, x.get_ptr(), perm_c.get_ptr()); - superlu::sp_preorder_mat(&options, x.get_ptr(), perm_c.get_ptr(), etree.get_ptr(), xC.get_ptr()); - superlu::gstrf(&options, xC.get_ptr(), relax, panel_size, etree.get_ptr(), NULL, lwork, perm_c.get_ptr(), perm_r.get_ptr(), l.get_ptr(), u.get_ptr(), &Glu, stat.get_ptr(), &slu_info); - - if(slu_info != 0) - { - arma_warn(2, "matrix is singular to working precision"); - return; - } - - eT x_norm_val = sp_auxlib::norm1(x.get_ptr()); - eT x_rcond = sp_auxlib::lu_rcond(l.get_ptr(), u.get_ptr(), x_norm_val); - - if( (x_rcond < std::numeric_limits::epsilon()) || arma_isnan(x_rcond) ) - { - if(x_rcond == eT(0)) { arma_warn(2, "matrix is singular to working precision"); } - else { arma_warn(2, "matrix is singular to working precision (rcond: ", x_rcond, ")"); } - return; - } - - valid = true; - } - #else - { - arma_ignore(mat_obj); - arma_ignore(shift); - } - #endif - } - - - -// Perform the shift-solve operation \f$y=(A-\sigma I)^{-1}x\f$. -// y_out = inv(A - sigma * I) * x_in -template -inline -void -SparseGenRealShiftSolve::perform_op(eT* x_in, eT* y_out) const - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_SUPERLU) - { - const Col x(x_in , n_cols, false, true); - Col y(y_out, n_rows, false, true); - - // Derived from sp_auxlib::run_aupd_shiftinvert() - y = x; - superlu_supermatrix_wrangler out_slu; - - const bool status_out_slu = sp_auxlib::wrap_to_supermatrix(out_slu.get_ref(), y); - - if(status_out_slu == false) { arma_stop_runtime_error("newarp::SparseGenRealShiftSolve::perform_op(): could not construct SuperLU matrix"); return; } - - superlu_stat_wrangler stat; - int info = 0; - - arma_debug_print("superlu::gstrs()"); - superlu::gstrs(superlu::NOTRANS, l.get_ptr(), u.get_ptr(), perm_c.get_ptr(), perm_r.get_ptr(), out_slu.get_ptr(), stat.get_ptr(), &info); - - if(info != 0) { arma_stop_runtime_error("newarp::SparseGenRealShiftSolve::perform_op(): could not solve linear equation"); return; } - - // No need to modify memory further since it was all done in-place. - } - #else - { - arma_ignore(x_in); - arma_ignore(y_out); - } - #endif - } - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SymEigsShiftSolver_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SymEigsShiftSolver_bones.hpp deleted file mode 100644 index bf3231f60..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SymEigsShiftSolver_bones.hpp +++ /dev/null @@ -1,43 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -//! This class implements the eigen solver for real symmetric matrices in the shift-and-invert mode. -template -class SymEigsShiftSolver : public SymEigsSolver - { - private: - - const eT sigma; - - // Sort the first nev Ritz pairs in ascending algebraic order - // This is used to return the final results - void sort_ritzpair(); - - - public: - - //! Constructor to create a solver object. - inline SymEigsShiftSolver(const OpType& op_, uword nev_, uword ncv_, const eT sigma_); - }; - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SymEigsShiftSolver_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SymEigsShiftSolver_meat.hpp deleted file mode 100644 index a2a6309da..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SymEigsShiftSolver_meat.hpp +++ /dev/null @@ -1,50 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -template -inline -void -SymEigsShiftSolver::sort_ritzpair() - { - arma_debug_sigprint(); - - // First transform back the Ritz values, and then sort - for(uword i = 0; i < this->nev; i++) - { - this->ritz_val(i) = eT(1.0) / this->ritz_val(i) + sigma; - } - SymEigsSolver::sort_ritzpair(); - } - - - -template -inline -SymEigsShiftSolver::SymEigsShiftSolver(const OpType& op_, uword nev_, uword ncv_, const eT sigma_) - : SymEigsSolver::SymEigsSolver(op_, nev_, ncv_) - , sigma(sigma_) - { - arma_debug_sigprint(); - } - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SymEigsSolver_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SymEigsSolver_bones.hpp deleted file mode 100644 index 612f92a64..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SymEigsSolver_bones.hpp +++ /dev/null @@ -1,107 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -//! This class implements the eigen solver for real symmetric matrices. -template -class SymEigsSolver - { - protected: - - const OpType& op; // object to conduct matrix operation, eg. matrix-vector product - const uword nev; // number of eigenvalues requested - Col ritz_val; // ritz values - - // Sort the first nev Ritz pairs in ascending algebraic order - // This is used to return the final results - virtual void sort_ritzpair(); - - - private: - - const uword dim_n; // dimension of matrix A - const uword ncv; // number of ritz values - uword nmatop; // number of matrix operations called - uword niter; // number of restarting iterations - Mat fac_V; // V matrix in the Arnoldi factorisation - Mat fac_H; // H matrix in the Arnoldi factorisation - Col fac_f; // residual in the Arnoldi factorisation - Mat ritz_vec; // ritz vectors - Col ritz_est; // last row of ritz_vec - std::vector ritz_conv; // indicator of the convergence of ritz values - const eT eps; // the machine precision - // eg. ~= 1e-16 for double type - const eT eps23; // eps^(2/3), used in convergence test - // tol*eps23 is the absolute tolerance - const eT near0; // a very small value, but 1/near0 does not overflow - - std::mt19937_64 local_rng; // local random number generator - - inline void fill_rand(eT* dest, const uword N, const uword seed_val); - - // Arnoldi factorisation starting from step-k - inline void factorise_from(uword from_k, uword to_m, const Col& fk); - - // Implicitly restarted Arnoldi factorisation - inline void restart(uword k); - - // Calculate the number of converged Ritz values - inline uword num_converged(eT tol); - - // Return the adjusted nev for restarting - inline uword nev_adjusted(uword nconv); - - // Retrieve and sort ritz values and ritz vectors - inline void retrieve_ritzpair(); - - - public: - - //! Constructor to create a solver object. - inline SymEigsSolver(const OpType& op_, uword nev_, uword ncv_); - - //! Providing the initial residual vector for the algorithm. - inline void init(eT* init_resid); - - //! Providing a random initial residual vector. - inline void init(); - - //! Conducting the major computation procedure. - inline uword compute(uword maxit = 1000, eT tol = 1e-10); - - //! Returning the number of iterations used in the computation. - inline uword num_iterations() { return niter; } - - //! Returning the number of matrix operations used in the computation. - inline uword num_operations() { return nmatop; } - - //! Returning the converged eigenvalues. - inline Col eigenvalues(); - - //! Returning the eigenvectors associated with the converged eigenvalues. - inline Mat eigenvectors(uword nvec); - - //! Returning all converged eigenvectors. - inline Mat eigenvectors() { return eigenvectors(nev); } - }; - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SymEigsSolver_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SymEigsSolver_meat.hpp deleted file mode 100644 index 595b314bd..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_SymEigsSolver_meat.hpp +++ /dev/null @@ -1,508 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -template -inline -void -SymEigsSolver::fill_rand(eT* dest, const uword N, const uword seed_val) - { - arma_debug_sigprint(); - - typedef typename std::mt19937_64::result_type seed_type; - - local_rng.seed( seed_type(seed_val) ); - - std::uniform_real_distribution dist(-1.0, +1.0); - - for(uword i=0; i < N; ++i) { dest[i] = eT(dist(local_rng)); } - } - - - -template -inline -void -SymEigsSolver::factorise_from(uword from_k, uword to_m, const Col& fk) - { - arma_debug_sigprint(); - - if(to_m <= from_k) { return; } - - fac_f = fk; - - Col w(dim_n, arma_zeros_indicator()); - // Norm of f - eT beta = norm(fac_f); - // Used to test beta~=0 - const eT beta_thresh = eps * eop_aux::sqrt(dim_n); - // Keep the upperleft k x k submatrix of H and set other elements to 0 - fac_H.tail_cols(ncv - from_k).zeros(); - fac_H.submat(span(from_k, ncv - 1), span(0, from_k - 1)).zeros(); - for(uword i = from_k; i <= to_m - 1; i++) - { - bool restart = false; - // If beta = 0, then the next V is not full rank - // We need to generate a new residual vector that is orthogonal - // to the current V, which we call a restart - if(beta < near0) - { - // // Generate new random vector for fac_f - // blas_int idist = 2; - // blas_int iseed[4] = {1, 3, 5, 7}; - // iseed[0] = (i + 100) % 4095; - // blas_int n = dim_n; - // lapack::larnv(&idist, &iseed[0], &n, fac_f.memptr()); - - // Generate new random vector for fac_f - fill_rand(fac_f.memptr(), dim_n, i+1); - - // f <- f - V * V' * f, so that f is orthogonal to V - Mat Vs(fac_V.memptr(), dim_n, i, false); // First i columns - Col Vf = Vs.t() * fac_f; - fac_f -= Vs * Vf; - // beta <- ||f|| - beta = norm(fac_f); - - restart = true; - } - - // v <- f / ||f|| - Col v(fac_V.colptr(i), dim_n, false); // The (i+1)-th column - v = fac_f / beta; - - // Note that H[i+1, i] equals to the unrestarted beta - fac_H(i, i - 1) = restart ? eT(0) : beta; - - // w <- A * v, v = fac_V.col(i) - op.perform_op(v.memptr(), w.memptr()); - nmatop++; - - fac_H(i - 1, i) = fac_H(i, i - 1); // Due to symmetry - eT Hii = dot(v, w); - fac_H(i, i) = Hii; - - // f <- w - V * V' * w = w - H[i+1, i] * V{i} - H[i+1, i+1] * V{i+1} - // If restarting, we know that H[i+1, i] = 0 - if(restart) - { - fac_f = w - Hii * v; - } - else - { - fac_f = w - fac_H(i, i - 1) * fac_V.col(i - 1) - Hii * v; - } - - beta = norm(fac_f); - - // f/||f|| is going to be the next column of V, so we need to test - // whether V' * (f/||f||) ~= 0 - Mat Vs(fac_V.memptr(), dim_n, i + 1, false); // First i+1 columns - Col Vf = Vs.t() * fac_f; - eT ortho_err = abs(Vf).max(); - // If not, iteratively correct the residual - uword count = 0; - while(count < 5 && ortho_err > eps * beta) - { - // There is an edge case: when beta=||f|| is close to zero, f mostly consists - // of rounding errors, so the test [ortho_err < eps * beta] is very - // likely to fail. In particular, if beta=0, then the test is ensured to fail. - // Hence when this happens, we force f to be zero, and then restart in the - // next iteration. - if(beta < beta_thresh) - { - fac_f.zeros(); - beta = eT(0); - break; - } - - // f <- f - V * Vf - fac_f -= Vs * Vf; - // h <- h + Vf - fac_H(i - 1, i) += Vf[i - 1]; - fac_H(i, i - 1) = fac_H(i - 1, i); - fac_H(i, i) += Vf[i]; - // beta <- ||f|| - beta = norm(fac_f); - - Vf = Vs.t() * fac_f; - ortho_err = abs(Vf).max(); - count++; - } - } - } - - - -template -inline -void -SymEigsSolver::restart(uword k) - { - arma_debug_sigprint(); - - if(k >= ncv) { return; } - - TridiagQR decomp; - Mat Q(ncv, ncv, fill::eye); - - for(uword i = k; i < ncv; i++) - { - // QR decomposition of H-mu*I, mu is the shift - fac_H.diag() -= ritz_val(i); - decomp.compute(fac_H); - - // Q -> Q * Qi - decomp.apply_YQ(Q); - - // H -> Q'HQ - // Since QR = H - mu * I, we have H = QR + mu * I - // and therefore Q'HQ = RQ + mu * I - fac_H = decomp.matrix_RQ(); - fac_H.diag() += ritz_val(i); - } - - // V -> VQ, only need to update the first k+1 columns - // Q has some elements being zero - // The first (ncv - k + i) elements of the i-th column of Q are non-zero - Mat Vs(dim_n, k + 1, arma_nozeros_indicator()); - uword nnz; - for(uword i = 0; i < k; i++) - { - nnz = ncv - k + i + 1; - Mat V(fac_V.memptr(), dim_n, nnz, false); - Col q(Q.colptr(i), nnz, false); - // OLD CODE: - // Vs.col(i) = V * q; - // NEW CODE: - Col v(Vs.colptr(i), dim_n, false, true); - v = V * q; - } - - Vs.col(k) = fac_V * Q.col(k); - fac_V.head_cols(k + 1) = Vs; - - Col fk = fac_f * Q(ncv - 1, k - 1) + fac_V.col(k) * fac_H(k, k - 1); - factorise_from(k, ncv, fk); - retrieve_ritzpair(); - } - - - -template -inline -uword -SymEigsSolver::num_converged(eT tol) - { - arma_debug_sigprint(); - - // thresh = tol * max(approx0, abs(theta)), theta for ritz value - const eT f_norm = norm(fac_f); - for(uword i = 0; i < nev; i++) - { - eT thresh = tol * (std::max)(eps23, std::abs(ritz_val(i))); - eT resid = std::abs(ritz_est(i)) * f_norm; - ritz_conv[i] = (resid < thresh); - } - - return std::count(ritz_conv.begin(), ritz_conv.end(), true); - } - - - -template -inline -uword -SymEigsSolver::nev_adjusted(uword nconv) - { - arma_debug_sigprint(); - - uword nev_new = nev; - for(uword i = nev; i < ncv; i++) - { - if(std::abs(ritz_est(i)) < near0) { nev_new++; } - } - - // Adjust nev_new, according to dsaup2.f line 677~684 in ARPACK - nev_new += (std::min)(nconv, (ncv - nev_new) / 2); - - if(nev_new >= ncv) { nev_new = ncv - 1; } - - if(nev_new == 1) - { - if(ncv >= 6) { nev_new = ncv / 2; } - else if(ncv > 2) { nev_new = 2; } - } - - return nev_new; - } - - - -template -inline -void -SymEigsSolver::retrieve_ritzpair() - { - arma_debug_sigprint(); - - TridiagEigen decomp(fac_H); - Col evals = decomp.eigenvalues(); - Mat evecs = decomp.eigenvectors(); - - SortEigenvalue sorting(evals.memptr(), evals.n_elem); - std::vector ind = sorting.index(); - - // For BOTH_ENDS, the eigenvalues are sorted according - // to the LARGEST_ALGE rule, so we need to move those smallest - // values to the left - // The order would be - // Largest => Smallest => 2nd largest => 2nd smallest => ... - // We keep this order since the first k values will always be - // the wanted collection, no matter k is nev_updated (used in restart()) - // or is nev (used in sort_ritzpair()) - if(SelectionRule == EigsSelect::BOTH_ENDS) - { - std::vector ind_copy(ind); - for(uword i = 0; i < ncv; i++) - { - // If i is even, pick values from the left (large values) - // If i is odd, pick values from the right (small values) - - ind[i] = (i % 2 == 0) ? ind_copy[i / 2] : ind_copy[ncv - 1 - i / 2]; - } - } - - // Copy the ritz values and vectors to ritz_val and ritz_vec, respectively - for(uword i = 0; i < ncv; i++) - { - ritz_val(i) = evals(ind[i]); - ritz_est(i) = evecs(ncv - 1, ind[i]); - } - for(uword i = 0; i < nev; i++) - { - ritz_vec.col(i) = evecs.col(ind[i]); - } - } - - - -template -inline -void -SymEigsSolver::sort_ritzpair() - { - arma_debug_sigprint(); - - // SortEigenvalue sorting(ritz_val.memptr(), nev); - - // Sort Ritz values in ascending algebraic, to be consistent with ARPACK - SortEigenvalue sorting(ritz_val.memptr(), nev); - - std::vector ind = sorting.index(); - - Col new_ritz_val(ncv, arma_zeros_indicator() ); - Mat new_ritz_vec(ncv, nev, arma_nozeros_indicator()); - std::vector new_ritz_conv(nev); - - for(uword i = 0; i < nev; i++) - { - new_ritz_val(i) = ritz_val(ind[i]); - new_ritz_vec.col(i) = ritz_vec.col(ind[i]); - new_ritz_conv[i] = ritz_conv[ind[i]]; - } - - ritz_val.swap(new_ritz_val); - ritz_vec.swap(new_ritz_vec); - ritz_conv.swap(new_ritz_conv); - } - - - -template -inline -SymEigsSolver::SymEigsSolver(const OpType& op_, uword nev_, uword ncv_) - : op(op_) - , nev(nev_) - , dim_n(op.n_rows) - , ncv(ncv_ > dim_n ? dim_n : ncv_) - , nmatop(0) - , niter(0) - , eps(std::numeric_limits::epsilon()) - , eps23(std::pow(eps, eT(2.0) / 3)) - , near0(std::numeric_limits::min() * eT(10)) - { - arma_debug_sigprint(); - - arma_conform_check( (nev_ < 1 || nev_ > dim_n - 1), "newarp::SymEigsSolver: nev must satisfy 1 <= nev <= n - 1, n is the size of matrix" ); - arma_conform_check( (ncv_ <= nev_ || ncv_ > dim_n), "newarp::SymEigsSolver: ncv must satisfy nev < ncv <= n, n is the size of matrix" ); - } - - - -template -inline -void -SymEigsSolver::init(eT* init_resid) - { - arma_debug_sigprint(); - - // Reset all matrices/vectors to zero - fac_V.zeros(dim_n, ncv); - fac_H.zeros(ncv, ncv); - fac_f.zeros(dim_n); - ritz_val.zeros(ncv); - ritz_vec.zeros(ncv, nev); - ritz_est.zeros(ncv); - ritz_conv.assign(nev, false); - - nmatop = 0; - niter = 0; - - Col r(init_resid, dim_n, false); - // The first column of fac_V - Col v(fac_V.colptr(0), dim_n, false); - eT rnorm = norm(r); - arma_check( (rnorm < near0), "newarp::SymEigsSolver::init(): initial residual vector cannot be zero" ); - v = r / rnorm; - - Col w(dim_n, arma_zeros_indicator()); - op.perform_op(v.memptr(), w.memptr()); - nmatop++; - - fac_H(0, 0) = dot(v, w); - fac_f = w - v * fac_H(0, 0); - - // In some cases f is zero in exact arithmetics, but due to rounding errors - // it may contain tiny fluctuations. When this happens, we force f to be zero - if(abs(fac_f).max() < eps) { fac_f.zeros(); } - } - - - -template -inline -void -SymEigsSolver::init() - { - arma_debug_sigprint(); - - // podarray init_resid(dim_n); - // blas_int idist = 2; // Uniform(-1, 1) - // blas_int iseed[4] = {1, 3, 5, 7}; // Fixed random seed - // blas_int n = dim_n; - // lapack::larnv(&idist, &iseed[0], &n, init_resid.memptr()); - // init(init_resid.memptr()); - - podarray init_resid(dim_n); - - fill_rand(init_resid.memptr(), dim_n, 0); - - init(init_resid.memptr()); - } - - - -template -inline -uword -SymEigsSolver::compute(uword maxit, eT tol) - { - arma_debug_sigprint(); - - // The m-step Arnoldi factorisation - factorise_from(1, ncv, fac_f); - retrieve_ritzpair(); - // Restarting - uword i, nconv = 0, nev_adj; - for(i = 0; i < maxit; i++) - { - nconv = num_converged(tol); - if(nconv >= nev) { break; } - - nev_adj = nev_adjusted(nconv); - restart(nev_adj); - } - // Sorting results - sort_ritzpair(); - - niter = i + 1; - - return (std::min)(nev, nconv); - } - - - -template -inline -Col -SymEigsSolver::eigenvalues() - { - arma_debug_sigprint(); - - uword nconv = std::count(ritz_conv.begin(), ritz_conv.end(), true); - Col res(nconv, arma_zeros_indicator()); - - if(nconv > 0) - { - uword j = 0; - - for(uword i=0; i < nev; i++) - { - if(ritz_conv[i]) { res(j) = ritz_val(i); j++; } - } - } - - return res; - } - - - -template -inline -Mat -SymEigsSolver::eigenvectors(uword nvec) - { - arma_debug_sigprint(); - - uword nconv = std::count(ritz_conv.begin(), ritz_conv.end(), true); - nvec = (std::min)(nvec, nconv); - Mat res(dim_n, nvec); - - if(nvec > 0) - { - Mat ritz_vec_conv(ncv, nvec, arma_zeros_indicator()); - - uword j = 0; - - for(uword i=0; i < nev && j < nvec; i++) - { - if(ritz_conv[i]) { ritz_vec_conv.col(j) = ritz_vec.col(i); j++; } - } - - res = fac_V * ritz_vec_conv; - } - - return res; - } - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_TridiagEigen_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_TridiagEigen_bones.hpp deleted file mode 100644 index 9664a3c5e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_TridiagEigen_bones.hpp +++ /dev/null @@ -1,58 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -//! Calculate the eigenvalues and eigenvectors of a symmetric tridiagonal matrix. -//! This class is a wrapper of the Lapack functions `_steqr`. -template -class TridiagEigen - { - private: - - blas_int n; - Col main_diag; // Main diagonal elements of the matrix - Col sub_diag; // Sub-diagonal elements of the matrix - Mat evecs; // To store eigenvectors - bool computed; - - - public: - - //! Default constructor. Computation can - //! be performed later by calling the compute() method. - inline TridiagEigen(); - - //! Constructor to create an object that calculates the eigenvalues - //! and eigenvectors of a symmetric tridiagonal matrix `mat_obj`. - inline TridiagEigen(const Mat& mat_obj); - - //! Compute the eigenvalue decomposition of a symmetric tridiagonal matrix. - inline void compute(const Mat& mat_obj); - - //! Retrieve the eigenvalues. - inline Col eigenvalues(); - - //! Retrieve the eigenvectors. - inline Mat eigenvectors(); - }; - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_TridiagEigen_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_TridiagEigen_meat.hpp deleted file mode 100644 index 65de5090e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_TridiagEigen_meat.hpp +++ /dev/null @@ -1,132 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -template -inline -TridiagEigen::TridiagEigen() - : n(0) - , computed(false) - { - arma_debug_sigprint(); - } - - - -template -inline -TridiagEigen::TridiagEigen(const Mat& mat_obj) - : n(mat_obj.n_rows) - , computed(false) - { - arma_debug_sigprint(); - - compute(mat_obj); - } - - - -template -inline -void -TridiagEigen::compute(const Mat& mat_obj) - { - arma_debug_sigprint(); - - arma_conform_check( (mat_obj.is_square() == false), "newarp::TridiagEigen::compute(): matrix must be square" ); - - n = blas_int(mat_obj.n_rows); - - main_diag = mat_obj.diag(); - sub_diag = mat_obj.diag(-1); - - evecs.set_size(n, n); - - char compz = 'I'; - blas_int lwork_min = 1 + 4*n + n*n; - blas_int liwork_min = 3 + 5*n; - blas_int info = blas_int(0); - - blas_int lwork_proposed = 0; - blas_int liwork_proposed = 0; - - if(n >= 32) - { - eT work_query[2] = {}; - blas_int lwork_query = blas_int(-1); - - blas_int iwork_query[2] = {}; - blas_int liwork_query = blas_int(-1); - - arma_debug_print("lapack::stedc()"); - lapack::stedc(&compz, &n, main_diag.memptr(), sub_diag.memptr(), evecs.memptr(), &n, &work_query[0], &lwork_query, &iwork_query[0], &liwork_query, &info); - - if(info != 0) { arma_stop_runtime_error("lapack::stedc(): couldn't get size of work arrays"); return; } - - lwork_proposed = static_cast( work_query[0] ); - liwork_proposed = iwork_query[0]; - } - - blas_int lwork = (std::max)( lwork_min, lwork_proposed); - blas_int liwork = (std::max)(liwork_min, liwork_proposed); - - podarray work( static_cast( lwork) ); - podarray iwork( static_cast(liwork) ); - - arma_debug_print("lapack::stedc()"); - lapack::stedc(&compz, &n, main_diag.memptr(), sub_diag.memptr(), evecs.memptr(), &n, work.memptr(), &lwork, iwork.memptr(), &liwork, &info); - - if(info != 0) { arma_stop_runtime_error("lapack::stedc(): failed to compute all eigenvalues"); return; } - - computed = true; - } - - - -template -inline -Col -TridiagEigen::eigenvalues() - { - arma_debug_sigprint(); - - arma_conform_check( (computed == false), "newarp::TridiagEigen::eigenvalues(): need to call compute() first" ); - - // After calling compute(), main_diag will contain the eigenvalues. - return main_diag; - } - - - -template -inline -Mat -TridiagEigen::eigenvectors() - { - arma_debug_sigprint(); - - arma_conform_check( (computed == false), "newarp::TridiagEigen::eigenvectors(): need to call compute() first" ); - - return evecs; - } - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_UpperHessenbergEigen_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_UpperHessenbergEigen_bones.hpp deleted file mode 100644 index 668adbe56..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_UpperHessenbergEigen_bones.hpp +++ /dev/null @@ -1,59 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -//! Calculate the eigenvalues and eigenvectors of an upper Hessenberg matrix. -//! This class is uses lapack::lahqr() and lapack::trevc() -template -class UpperHessenbergEigen - { - private: - - uword n_rows; - Mat mat_Z; // In the first stage, H = ZTZ', Z is an orthogonal matrix - // In the second stage, Z will be overwritten by the eigenvectors of H - Mat mat_T; // H = ZTZ', T is a Schur form matrix - Col< std::complex > evals; // eigenvalues of H - bool computed; - - - public: - - //! Default constructor. Computation can - //! be performed later by calling the compute() method. - inline UpperHessenbergEigen(); - - //! Constructor to create an object that calculates the eigenvalues - //! and eigenvectors of an upper Hessenberg matrix `mat_obj`. - inline UpperHessenbergEigen(const Mat& mat_obj); - - //! Compute the eigenvalue decomposition of an upper Hessenberg matrix. - inline void compute(const Mat& mat_obj); - - //! Retrieve the eigenvalues. - inline Col< std::complex > eigenvalues(); - - //! Retrieve the eigenvectors. - inline Mat< std::complex > eigenvectors(); - }; - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_UpperHessenbergEigen_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_UpperHessenbergEigen_meat.hpp deleted file mode 100644 index 11c2b5989..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_UpperHessenbergEigen_meat.hpp +++ /dev/null @@ -1,168 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -template -inline -UpperHessenbergEigen::UpperHessenbergEigen() - : n_rows(0) - , computed(false) - { - arma_debug_sigprint(); - } - - - -template -inline -UpperHessenbergEigen::UpperHessenbergEigen(const Mat& mat_obj) - : n_rows(mat_obj.n_rows) - , computed(false) - { - arma_debug_sigprint(); - - compute(mat_obj); - } - - - -template -inline -void -UpperHessenbergEigen::compute(const Mat& mat_obj) - { - arma_debug_sigprint(); - - arma_conform_check( (mat_obj.is_square() == false), "newarp::UpperHessenbergEigen::compute(): matrix must be square" ); - - n_rows = mat_obj.n_rows; - - mat_Z.set_size(n_rows, n_rows); - mat_T.set_size(n_rows, n_rows); - evals.set_size(n_rows); - - mat_Z.eye(); - mat_T = mat_obj; - - blas_int want_T = blas_int(1); - blas_int want_Z = blas_int(1); - - blas_int n = blas_int(n_rows); - blas_int ilo = blas_int(1); - blas_int ihi = blas_int(n_rows); - blas_int iloz = blas_int(1); - blas_int ihiz = blas_int(n_rows); - - blas_int info = blas_int(0); - - podarray wr(n_rows); - podarray wi(n_rows); - - arma_debug_print("lapack::lahqr()"); - lapack::lahqr(&want_T, &want_Z, &n, &ilo, &ihi, mat_T.memptr(), &n, wr.memptr(), wi.memptr(), &iloz, &ihiz, mat_Z.memptr(), &n, &info); - - if(info != 0) { arma_stop_runtime_error("lapack::lahqr(): failed to compute all eigenvalues"); return; } - - for(uword i=0; i < n_rows; i++) { evals(i) = std::complex(wr[i], wi[i]); } - - char side = 'R'; - char howmny = 'B'; - blas_int m = blas_int(0); - - podarray work(3*n); - - arma_debug_print("lapack::trevc()"); - lapack::trevc(&side, &howmny, (blas_int*) NULL, &n, mat_T.memptr(), &n, (eT*) NULL, &n, mat_Z.memptr(), &n, &n, &m, work.memptr(), &info); - - if(info != 0) { arma_stop_runtime_error("lapack::trevc(): illegal value"); return; } - - computed = true; - } - - - -template -inline -Col< std::complex > -UpperHessenbergEigen::eigenvalues() - { - arma_debug_sigprint(); - - arma_conform_check( (computed == false), "newarp::UpperHessenbergEigen::eigenvalues(): need to call compute() first" ); - - return evals; - } - - - -template -inline -Mat< std::complex > -UpperHessenbergEigen::eigenvectors() - { - arma_debug_sigprint(); - - arma_conform_check( (computed == false), "newarp::UpperHessenbergEigen::eigenvectors(): need to call compute() first" ); - - // Lapack will set the imaginary parts of real eigenvalues to be exact zero - Mat< std::complex > evecs(n_rows, n_rows, arma_zeros_indicator()); - - std::complex* col_ptr = evecs.memptr(); - - for(uword i=0; i < n_rows; i++) - { - if(cx_attrib::is_real(evals(i), eT(0))) - { - // for real eigenvector, normalise and copy - const eT z_norm = norm(mat_Z.col(i)); - - for(uword j=0; j < n_rows; j++) - { - col_ptr[j] = std::complex(mat_Z(j, i) / z_norm, eT(0)); - } - - col_ptr += n_rows; - } - else - { - // complex eigenvectors are stored in consecutive columns - const eT r2 = dot(mat_Z.col(i ), mat_Z.col(i )); - const eT i2 = dot(mat_Z.col(i+1), mat_Z.col(i+1)); - - const eT z_norm = std::sqrt(r2 + i2); - const eT* z_ptr = mat_Z.colptr(i); - - for(uword j=0; j < n_rows; j++) - { - col_ptr[j ] = std::complex(z_ptr[j] / z_norm, z_ptr[j + n_rows] / z_norm); - col_ptr[j + n_rows] = std::conj(col_ptr[j]); - } - - i++; - col_ptr += 2 * n_rows; - } - } - - return evecs; - } - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_UpperHessenbergQR_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_UpperHessenbergQR_bones.hpp deleted file mode 100644 index 4d07f8c08..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_UpperHessenbergQR_bones.hpp +++ /dev/null @@ -1,86 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -//! Perform the QR decomposition of an upper Hessenberg matrix. -template -class UpperHessenbergQR - { - protected: - - uword n; - Mat mat_T; - // Gi = [ cos[i] sin[i]] - // [-sin[i] cos[i]] - // Q = G1 * G2 * ... * G_{n-1} - Col rot_cos; - Col rot_sin; - bool computed; - - - public: - - //! Default constructor. Computation can - //! be performed later by calling the compute() method. - inline UpperHessenbergQR(); - - //! Constructor to create an object that performs and stores the - //! QR decomposition of an upper Hessenberg matrix `mat_obj`. - inline UpperHessenbergQR(const Mat& mat_obj); - - //! Conduct the QR factorisation of an upper Hessenberg matrix. - virtual void compute(const Mat& mat_obj); - - //! Return the \f$RQ\f$ matrix, the multiplication of \f$R\f$ and \f$Q\f$, - //! which is an upper Hessenberg matrix. - virtual Mat matrix_RQ(); - - //! Apply the \f$Q\f$ matrix to another matrix \f$Y\f$. - inline void apply_YQ(Mat& Y); - }; - - - -//! Perform the QR decomposition of a tridiagonal matrix, a special -//! case of upper Hessenberg matrices. -template -class TridiagQR : public UpperHessenbergQR - { - public: - - //! Default constructor. Computation can - //! be performed later by calling the compute() method. - inline TridiagQR(); - - //! Constructor to create an object that performs and stores the - //! QR decomposition of a tridiagonal matrix `mat_obj`. - inline TridiagQR(const Mat& mat_obj); - - //! Conduct the QR factorisation of a tridiagonal matrix. - inline void compute(const Mat& mat_obj); - - //! Return the \f$RQ\f$ matrix, the multiplication of \f$R\f$ and \f$Q\f$, - //! which is a tridiagonal matrix. - inline Mat matrix_RQ(); - }; - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_UpperHessenbergQR_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_UpperHessenbergQR_meat.hpp deleted file mode 100644 index e62ffc3bc..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_UpperHessenbergQR_meat.hpp +++ /dev/null @@ -1,310 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -template -inline -UpperHessenbergQR::UpperHessenbergQR() - : n(0) - , computed(false) - { - arma_debug_sigprint(); - } - - - -template -inline -UpperHessenbergQR::UpperHessenbergQR(const Mat& mat_obj) - : n(mat_obj.n_rows) - , mat_T(n, n) - , rot_cos(n - 1) - , rot_sin(n - 1) - , computed(false) - { - arma_debug_sigprint(); - - compute(mat_obj); - } - - - -template -void -UpperHessenbergQR::compute(const Mat& mat_obj) - { - arma_debug_sigprint(); - - n = mat_obj.n_rows; - mat_T.set_size(n, n); - rot_cos.set_size(n - 1); - rot_sin.set_size(n - 1); - - // Make a copy of mat_obj - mat_T = mat_obj; - - eT xi, xj, r, c, s, eps = std::numeric_limits::epsilon(); - eT *ptr; - for(uword i = 0; i < n - 1; i++) - { - // Make sure mat_T is upper Hessenberg - // Zero the elements below mat_T(i + 1, i) - if(i < n - 2) { mat_T(span(i + 2, n - 1), i).zeros(); } - - xi = mat_T(i, i); // mat_T(i, i) - xj = mat_T(i + 1, i); // mat_T(i + 1, i) - r = arma_hypot(xi, xj); - if(r <= eps) - { - r = 0; - rot_cos(i) = c = 1; - rot_sin(i) = s = 0; - } - else - { - rot_cos(i) = c = xi / r; - rot_sin(i) = s = -xj / r; - } - - // For a complete QR decomposition, - // we first obtain the rotation matrix - // G = [ cos sin] - // [-sin cos] - // and then do T[i:(i + 1), i:(n - 1)] = G' * T[i:(i + 1), i:(n - 1)] - - // mat_T.submat(i, i, i + 1, n - 1) = Gt * mat_T.submat(i, i, i + 1, n - 1); - mat_T(i, i) = r; // mat_T(i, i) => r - mat_T(i + 1, i) = 0; // mat_T(i + 1, i) => 0 - ptr = &mat_T(i, i + 1); // mat_T(i, k), k = i+1, i+2, ..., n-1 - for(uword j = i + 1; j < n; j++, ptr += n) - { - eT tmp = ptr[0]; - ptr[0] = c * tmp - s * ptr[1]; - ptr[1] = s * tmp + c * ptr[1]; - } - } - - computed = true; - } - - - -template -Mat -UpperHessenbergQR::matrix_RQ() - { - arma_debug_sigprint(); - - arma_conform_check( (computed == false), "newarp::UpperHessenbergQR::matrix_RQ(): need to call compute() first" ); - - // Make a copy of the R matrix - Mat RQ = trimatu(mat_T); - - for(uword i = 0; i < n - 1; i++) - { - // RQ[, i:(i + 1)] = RQ[, i:(i + 1)] * Gi - // Gi = [ cos[i] sin[i]] - // [-sin[i] cos[i]] - const eT c = rot_cos(i); - const eT s = rot_sin(i); - eT *Yi, *Yi1; - Yi = RQ.colptr(i); - Yi1 = RQ.colptr(i + 1); - for(uword j = 0; j < i + 2; j++) - { - eT tmp = Yi[j]; - Yi[j] = c * tmp - s * Yi1[j]; - Yi1[j] = s * tmp + c * Yi1[j]; - } - - /* Yi = RQ(span(0, i + 1), i); - RQ(span(0, i + 1), i) = (*c) * Yi - (*s) * RQ(span(0, i + 1), i + 1); - RQ(span(0, i + 1), i + 1) = (*s) * Yi + (*c) * RQ(span(0, i + 1), i + 1); */ - } - - return RQ; - } - - - -template -inline -void -UpperHessenbergQR::apply_YQ(Mat& Y) - { - arma_debug_sigprint(); - - arma_conform_check( (computed == false), "newarp::UpperHessenbergQR::apply_YQ(): need to call compute() first" ); - - eT *Y_col_i, *Y_col_i1; - uword nrow = Y.n_rows; - for(uword i = 0; i < n - 1; i++) - { - const eT c = rot_cos(i); - const eT s = rot_sin(i); - Y_col_i = Y.colptr(i); - Y_col_i1 = Y.colptr(i + 1); - for(uword j = 0; j < nrow; j++) - { - eT tmp = Y_col_i[j]; - Y_col_i[j] = c * tmp - s * Y_col_i1[j]; - Y_col_i1[j] = s * tmp + c * Y_col_i1[j]; - } - } - } - - - -template -inline -TridiagQR::TridiagQR() - : UpperHessenbergQR() - { - arma_debug_sigprint(); - } - - - -template -inline -TridiagQR::TridiagQR(const Mat& mat_obj) - : UpperHessenbergQR() - { - arma_debug_sigprint(); - - this->compute(mat_obj); - } - - - -template -inline -void -TridiagQR::compute(const Mat& mat_obj) - { - arma_debug_sigprint(); - - this->n = mat_obj.n_rows; - this->mat_T.set_size(this->n, this->n); - this->rot_cos.set_size(this->n - 1); - this->rot_sin.set_size(this->n - 1); - - this->mat_T.zeros(); - this->mat_T.diag() = mat_obj.diag(); - this->mat_T.diag(1) = mat_obj.diag(-1); - this->mat_T.diag(-1) = mat_obj.diag(-1); - - eT xi, xj, r, c, s, tmp, eps = std::numeric_limits::epsilon(); - eT *ptr; // A number of pointers to avoid repeated address calculation - for(uword i = 0; i < this->n - 1; i++) - { - xi = this->mat_T(i, i); // mat_T(i, i) - xj = this->mat_T(i + 1, i); // mat_T(i + 1, i) - r = arma_hypot(xi, xj); - if(r <= eps) - { - r = 0; - this->rot_cos(i) = c = 1; - this->rot_sin(i) = s = 0; - } - else - { - this->rot_cos(i) = c = xi / r; - this->rot_sin(i) = s = -xj / r; - } - - // For a complete QR decomposition, - // we first obtain the rotation matrix - // G = [ cos sin] - // [-sin cos] - // and then do T[i:(i + 1), i:(i + 2)] = G' * T[i:(i + 1), i:(i + 2)] - - // Update T[i, i] and T[i + 1, i] - // The updated value of T[i, i] is known to be r - // The updated value of T[i + 1, i] is known to be 0 - this->mat_T(i, i) = r; - this->mat_T(i + 1, i) = 0; - // Update T[i, i + 1] and T[i + 1, i + 1] - // ptr[0] == T[i, i + 1] - // ptr[1] == T[i + 1, i + 1] - ptr = &(this->mat_T(i, i + 1)); - tmp = *ptr; - ptr[0] = c * tmp - s * ptr[1]; - ptr[1] = s * tmp + c * ptr[1]; - - if(i < this->n - 2) - { - // Update T[i, i + 2] and T[i + 1, i + 2] - // ptr[0] == T[i, i + 2] == 0 - // ptr[1] == T[i + 1, i + 2] - ptr = &(this->mat_T(i, i + 2)); - ptr[0] = -s * ptr[1]; - ptr[1] *= c; - } - } - - this->computed = true; - } - - - -template -Mat -TridiagQR::matrix_RQ() - { - arma_debug_sigprint(); - - arma_conform_check( (this->computed == false), "newarp::TridiagQR::matrix_RQ(): need to call compute() first" ); - - // Make a copy of the R matrix - Mat RQ(this->n, this->n, arma_zeros_indicator()); - RQ.diag() = this->mat_T.diag(); - RQ.diag(1) = this->mat_T.diag(1); - - // [m11 m12] will point to RQ[i:(i+1), i:(i+1)] - // [m21 m22] - eT *m11 = RQ.memptr(), *m12, *m21, *m22, tmp; - for(uword i = 0; i < this->n - 1; i++) - { - const eT c = this->rot_cos(i); - const eT s = this->rot_sin(i); - m21 = m11 + 1; - m12 = m11 + this->n; - m22 = m12 + 1; - tmp = *m21; - - // Update diagonal and the below-subdiagonal - *m11 = c * (*m11) - s * (*m12); - *m21 = c * tmp - s * (*m22); - *m22 = s * tmp + c * (*m22); - - // Move m11 to RQ[i+1, i+1] - m11 = m22; - } - - // Copy the below-subdiagonal to above-subdiagonal - RQ.diag(1) = RQ.diag(-1); - - return RQ; - } - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_cx_attrib.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_cx_attrib.hpp deleted file mode 100644 index e654dc475..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/newarp_cx_attrib.hpp +++ /dev/null @@ -1,37 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -namespace newarp -{ - - -//! Tiny functions to check attributes of complex numbers -struct cx_attrib - { - template - arma_inline static bool is_real (const std::complex& v, const T eps) { return (std::abs(v.imag()) <= eps); } - - template - arma_inline static bool is_complex(const std::complex& v, const T eps) { return (std::abs(v.imag()) > eps); } - - template - arma_inline static bool is_conj(const std::complex& v1, const std::complex& v2, const T eps) { return (std::abs(v1 - std::conj(v2)) <= eps); } - }; - - -} // namespace newarp diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_all_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_all_bones.hpp deleted file mode 100644 index b8faf9a2d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_all_bones.hpp +++ /dev/null @@ -1,81 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_all -//! @{ - - - -class op_all - : public traits_op_xvec - { - public: - - - template - static inline bool - all_vec_helper(const Base& X); - - - template - static inline bool - all_vec_helper(const subview& X); - - - template - static inline bool - all_vec_helper(const Op& X); - - - template - static inline bool - all_vec_helper - ( - const mtOp& X, - const typename arma_op_rel_only::result* junk1 = nullptr, - const typename arma_not_cx::result* junk2 = nullptr - ); - - - template - static inline bool - all_vec_helper - ( - const mtGlue& X, - const typename arma_glue_rel_only::result* junk1 = nullptr, - const typename arma_not_cx::result* junk2 = nullptr, - const typename arma_not_cx::result* junk3 = nullptr - ); - - - template - static inline bool all_vec(T1& X); - - - template - static inline void apply_helper(Mat& out, const Proxy& P, const uword dim); - - - template - static inline void apply(Mat& out, const mtOp& X); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_all_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_all_meat.hpp deleted file mode 100644 index 185d4eeca..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_all_meat.hpp +++ /dev/null @@ -1,406 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_all -//! @{ - - - -template -inline -bool -op_all::all_vec_helper(const Base& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const Proxy P(X.get_ref()); - - const uword n_elem = P.get_n_elem(); - - uword count = 0; - - if(Proxy::use_at == false) - { - typename Proxy::ea_type Pea = P.get_ea(); - - for(uword i=0; i -inline -bool -op_all::all_vec_helper(const subview& X) - { - arma_debug_sigprint(); - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - uword count = 0; - - if(X_n_rows == 1) - { - for(uword col=0; col < X_n_cols; ++col) - { - count += (X.at(0,col) != eT(0)) ? uword(1) : uword(0); - } - } - else - { - for(uword col=0; col < X_n_cols; ++col) - { - const eT* X_colmem = X.colptr(col); - - for(uword row=0; row < X_n_rows; ++row) - { - count += (X_colmem[row] != eT(0)) ? uword(1) : uword(0); - } - } - } - - return (X.n_elem == count); - } - - - -template -inline -bool -op_all::all_vec_helper(const Op& X) - { - arma_debug_sigprint(); - - return op_all::all_vec_helper(X.m); - } - - - -template -inline -bool -op_all::all_vec_helper - ( - const mtOp& X, - const typename arma_op_rel_only::result* junk1, - const typename arma_not_cx::result* junk2 - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - typedef typename T1::elem_type eT; - - const eT val = X.aux; - - const Proxy P(X.m); - - const uword n_elem = P.get_n_elem(); - - uword count = 0; - - if(Proxy::use_at == false) - { - typename Proxy::ea_type Pea = P.get_ea(); - - for(uword i=0; i < n_elem; ++i) - { - const eT tmp = Pea[i]; - - if(is_same_type::yes) { count += (val < tmp) ? uword(1) : uword(0); } - else if(is_same_type::yes) { count += (tmp < val) ? uword(1) : uword(0); } - else if(is_same_type::yes) { count += (val > tmp) ? uword(1) : uword(0); } - else if(is_same_type::yes) { count += (tmp > val) ? uword(1) : uword(0); } - else if(is_same_type::yes) { count += (val <= tmp) ? uword(1) : uword(0); } - else if(is_same_type::yes) { count += (tmp <= val) ? uword(1) : uword(0); } - else if(is_same_type::yes) { count += (val >= tmp) ? uword(1) : uword(0); } - else if(is_same_type::yes) { count += (tmp >= val) ? uword(1) : uword(0); } - else if(is_same_type::yes) { count += (tmp == val) ? uword(1) : uword(0); } - else if(is_same_type::yes) { count += (tmp != val) ? uword(1) : uword(0); } - } - } - else - { - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - const eT tmp = P.at(row,col); - - if(is_same_type::yes) { if(val < tmp) { ++count; } } - else if(is_same_type::yes) { if(tmp < val) { ++count; } } - else if(is_same_type::yes) { if(val > tmp) { ++count; } } - else if(is_same_type::yes) { if(tmp > val) { ++count; } } - else if(is_same_type::yes) { if(val <= tmp) { ++count; } } - else if(is_same_type::yes) { if(tmp <= val) { ++count; } } - else if(is_same_type::yes) { if(val >= tmp) { ++count; } } - else if(is_same_type::yes) { if(tmp >= val) { ++count; } } - else if(is_same_type::yes) { if(tmp == val) { ++count; } } - else if(is_same_type::yes) { if(tmp != val) { ++count; } } - } - } - - return (n_elem == count); - } - - - -template -inline -bool -op_all::all_vec_helper - ( - const mtGlue& X, - const typename arma_glue_rel_only::result* junk1, - const typename arma_not_cx::result* junk2, - const typename arma_not_cx::result* junk3 - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - arma_ignore(junk3); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename Proxy::ea_type ea_type1; - typedef typename Proxy::ea_type ea_type2; - - const Proxy A(X.A); - const Proxy B(X.B); - - arma_conform_assert_same_size(A, B, "relational operator"); - - const uword n_elem = A.get_n_elem(); - - uword count = 0; - - constexpr bool use_at = (Proxy::use_at || Proxy::use_at); - - if(use_at == false) - { - ea_type1 PA = A.get_ea(); - ea_type2 PB = B.get_ea(); - - for(uword i=0; i::yes) { count += (tmp1 < tmp2) ? uword(1) : uword(0); } - else if(is_same_type::yes) { count += (tmp1 > tmp2) ? uword(1) : uword(0); } - else if(is_same_type::yes) { count += (tmp1 <= tmp2) ? uword(1) : uword(0); } - else if(is_same_type::yes) { count += (tmp1 >= tmp2) ? uword(1) : uword(0); } - else if(is_same_type::yes) { count += (tmp1 == tmp2) ? uword(1) : uword(0); } - else if(is_same_type::yes) { count += (tmp1 != tmp2) ? uword(1) : uword(0); } - else if(is_same_type::yes) { count += (tmp1 && tmp2) ? uword(1) : uword(0); } - else if(is_same_type::yes) { count += (tmp1 || tmp2) ? uword(1) : uword(0); } - } - } - else - { - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - const eT1 tmp1 = A.at(row,col); - const eT2 tmp2 = B.at(row,col); - - if(is_same_type::yes) { if(tmp1 < tmp2) { ++count; } } - else if(is_same_type::yes) { if(tmp1 > tmp2) { ++count; } } - else if(is_same_type::yes) { if(tmp1 <= tmp2) { ++count; } } - else if(is_same_type::yes) { if(tmp1 >= tmp2) { ++count; } } - else if(is_same_type::yes) { if(tmp1 == tmp2) { ++count; } } - else if(is_same_type::yes) { if(tmp1 != tmp2) { ++count; } } - else if(is_same_type::yes) { if(tmp1 && tmp2) { ++count; } } - else if(is_same_type::yes) { if(tmp1 || tmp2) { ++count; } } - } - } - - return (n_elem == count); - } - - - -template -inline -bool -op_all::all_vec(T1& X) - { - arma_debug_sigprint(); - - return op_all::all_vec_helper(X); - } - - - -template -inline -void -op_all::apply_helper(Mat& out, const Proxy& P, const uword dim) - { - arma_debug_sigprint(); - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - typedef typename Proxy::elem_type eT; - - if(dim == 0) // traverse rows (ie. process each column) - { - out.zeros(1, n_cols); - - if(out.n_elem == 0) { return; } - - uword* out_mem = out.memptr(); - - if(is_Mat::stored_type>::value) - { - const unwrap::stored_type> U(P.Q); - - for(uword col=0; col < n_cols; ++col) - { - const eT* colmem = U.M.colptr(col); - - uword count = 0; - - for(uword row=0; row < n_rows; ++row) - { - count += (colmem[row] != eT(0)) ? uword(1) : uword(0); - } - - out_mem[col] = (n_rows == count) ? uword(1) : uword(0); - } - } - else - { - for(uword col=0; col < n_cols; ++col) - { - uword count = 0; - - for(uword row=0; row < n_rows; ++row) - { - if(P.at(row,col) != eT(0)) { ++count; } - } - - out_mem[col] = (n_rows == count) ? uword(1) : uword(0); - } - } - } - else - { - out.zeros(n_rows, 1); - - uword* out_mem = out.memptr(); - - // internal dual use of 'out': keep the counts for each row - - if(is_Mat::stored_type>::value) - { - const unwrap::stored_type> U(P.Q); - - for(uword col=0; col < n_cols; ++col) - { - const eT* colmem = U.M.colptr(col); - - for(uword row=0; row < n_rows; ++row) - { - out_mem[row] += (colmem[row] != eT(0)) ? uword(1) : uword(0); - } - } - } - else - { - for(uword col=0; col < n_cols; ++col) - { - for(uword row=0; row < n_rows; ++row) - { - if(P.at(row,col) != eT(0)) { ++out_mem[row]; } - } - } - } - - - // see what the counts tell us - - for(uword row=0; row < n_rows; ++row) - { - out_mem[row] = (n_cols == out_mem[row]) ? uword(1) : uword(0); - } - - } - } - - - -template -inline -void -op_all::apply(Mat& out, const mtOp& X) - { - arma_debug_sigprint(); - - const uword dim = X.aux_uword_a; - - const Proxy P(X.m); - - if(P.is_alias(out) == false) - { - op_all::apply_helper(out, P, dim); - } - else - { - Mat out2; - - op_all::apply_helper(out2, P, dim); - - out.steal_mem(out2); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_any_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_any_bones.hpp deleted file mode 100644 index ffb197bdc..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_any_bones.hpp +++ /dev/null @@ -1,81 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_any -//! @{ - - - -class op_any - : public traits_op_xvec - { - public: - - - template - static inline bool - any_vec_helper(const Base& X); - - - template - static inline bool - any_vec_helper(const subview& X); - - - template - static inline bool - any_vec_helper(const Op& X); - - - template - static inline bool - any_vec_helper - ( - const mtOp& X, - const typename arma_op_rel_only::result* junk1 = nullptr, - const typename arma_not_cx::result* junk2 = nullptr - ); - - - template - static inline bool - any_vec_helper - ( - const mtGlue& X, - const typename arma_glue_rel_only::result* junk1 = nullptr, - const typename arma_not_cx::result* junk2 = nullptr, - const typename arma_not_cx::result* junk3 = nullptr - ); - - - template - static inline bool any_vec(T1& X); - - - template - static inline void apply_helper(Mat& out, const Proxy& P, const uword dim); - - - template - static inline void apply(Mat& out, const mtOp& X); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_any_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_any_meat.hpp deleted file mode 100644 index 3d5ff8aa0..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_any_meat.hpp +++ /dev/null @@ -1,377 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_any -//! @{ - - - -template -inline -bool -op_any::any_vec_helper(const Base& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const Proxy P(X.get_ref()); - - const uword n_elem = P.get_n_elem(); - - if(Proxy::use_at == false) - { - typename Proxy::ea_type Pea = P.get_ea(); - - for(uword i=0; i -inline -bool -op_any::any_vec_helper(const subview& X) - { - arma_debug_sigprint(); - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(X_n_rows == 1) - { - for(uword col=0; col < X_n_cols; ++col) - { - if(X.at(0,col) != eT(0)) { return true; } - } - } - else - { - for(uword col=0; col < X_n_cols; ++col) - { - const eT* X_colmem = X.colptr(col); - - for(uword row=0; row < X_n_rows; ++row) - { - if(X_colmem[row] != eT(0)) { return true; } - } - } - } - - return false; - } - - - -template -inline -bool -op_any::any_vec_helper(const Op& X) - { - arma_debug_sigprint(); - - return op_any::any_vec_helper(X.m); - } - - - -template -inline -bool -op_any::any_vec_helper - ( - const mtOp& X, - const typename arma_op_rel_only::result* junk1, - const typename arma_not_cx::result* junk2 - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - typedef typename T1::elem_type eT; - - const eT val = X.aux; - - const Proxy P(X.m); - - - if(Proxy::use_at == false) - { - typename Proxy::ea_type Pea = P.get_ea(); - - const uword n_elem = P.get_n_elem(); - - for(uword i=0; i < n_elem; ++i) - { - const eT tmp = Pea[i]; - - if(is_same_type::yes) { if(val < tmp) { return true; } } - else if(is_same_type::yes) { if(tmp < val) { return true; } } - else if(is_same_type::yes) { if(val > tmp) { return true; } } - else if(is_same_type::yes) { if(tmp > val) { return true; } } - else if(is_same_type::yes) { if(val <= tmp) { return true; } } - else if(is_same_type::yes) { if(tmp <= val) { return true; } } - else if(is_same_type::yes) { if(val >= tmp) { return true; } } - else if(is_same_type::yes) { if(tmp >= val) { return true; } } - else if(is_same_type::yes) { if(tmp == val) { return true; } } - else if(is_same_type::yes) { if(tmp != val) { return true; } } - } - } - else - { - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - const eT tmp = P.at(row,col); - - if(is_same_type::yes) { if(val < tmp) { return true; } } - else if(is_same_type::yes) { if(tmp < val) { return true; } } - else if(is_same_type::yes) { if(val > tmp) { return true; } } - else if(is_same_type::yes) { if(tmp > val) { return true; } } - else if(is_same_type::yes) { if(val <= tmp) { return true; } } - else if(is_same_type::yes) { if(tmp <= val) { return true; } } - else if(is_same_type::yes) { if(val >= tmp) { return true; } } - else if(is_same_type::yes) { if(tmp >= val) { return true; } } - else if(is_same_type::yes) { if(tmp == val) { return true; } } - else if(is_same_type::yes) { if(tmp != val) { return true; } } - } - } - - return false; - } - - - -template -inline -bool -op_any::any_vec_helper - ( - const mtGlue& X, - const typename arma_glue_rel_only::result* junk1, - const typename arma_not_cx::result* junk2, - const typename arma_not_cx::result* junk3 - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - arma_ignore(junk3); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename Proxy::ea_type ea_type1; - typedef typename Proxy::ea_type ea_type2; - - const Proxy A(X.A); - const Proxy B(X.B); - - arma_conform_assert_same_size(A, B, "relational operator"); - - constexpr bool use_at = (Proxy::use_at || Proxy::use_at); - - if(use_at == false) - { - ea_type1 PA = A.get_ea(); - ea_type2 PB = B.get_ea(); - - const uword n_elem = A.get_n_elem(); - - for(uword i=0; i::yes) { if(tmp1 < tmp2) { return true; } } - else if(is_same_type::yes) { if(tmp1 > tmp2) { return true; } } - else if(is_same_type::yes) { if(tmp1 <= tmp2) { return true; } } - else if(is_same_type::yes) { if(tmp1 >= tmp2) { return true; } } - else if(is_same_type::yes) { if(tmp1 == tmp2) { return true; } } - else if(is_same_type::yes) { if(tmp1 != tmp2) { return true; } } - else if(is_same_type::yes) { if(tmp1 && tmp2) { return true; } } - else if(is_same_type::yes) { if(tmp1 || tmp2) { return true; } } - } - } - else - { - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - const eT1 tmp1 = A.at(row,col); - const eT2 tmp2 = B.at(row,col); - - if(is_same_type::yes) { if(tmp1 < tmp2) { return true; } } - else if(is_same_type::yes) { if(tmp1 > tmp2) { return true; } } - else if(is_same_type::yes) { if(tmp1 <= tmp2) { return true; } } - else if(is_same_type::yes) { if(tmp1 >= tmp2) { return true; } } - else if(is_same_type::yes) { if(tmp1 == tmp2) { return true; } } - else if(is_same_type::yes) { if(tmp1 != tmp2) { return true; } } - else if(is_same_type::yes) { if(tmp1 && tmp2) { return true; } } - else if(is_same_type::yes) { if(tmp1 || tmp2) { return true; } } - } - } - - return false; - } - - - -template -inline -bool -op_any::any_vec(T1& X) - { - arma_debug_sigprint(); - - return op_any::any_vec_helper(X); - } - - - -template -inline -void -op_any::apply_helper(Mat& out, const Proxy& P, const uword dim) - { - arma_debug_sigprint(); - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - typedef typename Proxy::elem_type eT; - - if(dim == 0) // traverse rows (ie. process each column) - { - out.zeros(1, n_cols); - - uword* out_mem = out.memptr(); - - if(is_Mat::stored_type>::value) - { - const unwrap::stored_type> U(P.Q); - - for(uword col=0; col < n_cols; ++col) - { - const eT* colmem = U.M.colptr(col); - - for(uword row=0; row < n_rows; ++row) - { - if(colmem[row] != eT(0)) { out_mem[col] = uword(1); break; } - } - } - } - else - { - for(uword col=0; col < n_cols; ++col) - { - for(uword row=0; row < n_rows; ++row) - { - if(P.at(row,col) != eT(0)) { out_mem[col] = uword(1); break; } - } - } - } - } - else - { - out.zeros(n_rows, 1); - - uword* out_mem = out.memptr(); - - if(is_Mat::stored_type>::value) - { - const unwrap::stored_type> U(P.Q); - - for(uword col=0; col < n_cols; ++col) - { - const eT* colmem = U.M.colptr(col); - - for(uword row=0; row < n_rows; ++row) - { - if(colmem[row] != eT(0)) { out_mem[row] = uword(1); } - } - } - } - else - { - for(uword col=0; col < n_cols; ++col) - { - for(uword row=0; row < n_rows; ++row) - { - if(P.at(row,col) != eT(0)) { out_mem[row] = uword(1); } - } - } - } - } - } - - - -template -inline -void -op_any::apply(Mat& out, const mtOp& X) - { - arma_debug_sigprint(); - - const uword dim = X.aux_uword_a; - - const Proxy P(X.m); - - if(P.is_alias(out) == false) - { - op_any::apply_helper(out, P, dim); - } - else - { - Mat out2; - - op_any::apply_helper(out2, P, dim); - - out.steal_mem(out2); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_chi2rnd_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_chi2rnd_bones.hpp deleted file mode 100644 index 540bdfbdd..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_chi2rnd_bones.hpp +++ /dev/null @@ -1,54 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_chi2rnd -//! @{ - - -class op_chi2rnd - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const Op& in); - - template - inline static void apply_noalias(Mat& out, const Proxy& P); - - template - inline static void fill_constant_df(Mat& out, const eT df); - }; - - - -template -class op_chi2rnd_varying_df - { - public: - - arma_aligned std::mt19937_64 motor; - - inline ~op_chi2rnd_varying_df(); - inline op_chi2rnd_varying_df(); - - inline eT operator()(const eT df); - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_chi2rnd_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_chi2rnd_meat.hpp deleted file mode 100644 index 939258320..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_chi2rnd_meat.hpp +++ /dev/null @@ -1,176 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_chi2rnd -//! @{ - - - -template -inline -void -op_chi2rnd::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const Proxy P(in.m); - - if(P.is_alias(out) == false) - { - op_chi2rnd::apply_noalias(out, P); - } - else - { - Mat tmp; - - op_chi2rnd::apply_noalias(tmp, P); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -op_chi2rnd::apply_noalias(Mat& out, const Proxy& P) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - op_chi2rnd_varying_df generator; - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - out.set_size(n_rows, n_cols); - - eT* out_mem = out.memptr(); - - if(Proxy::use_at == false) - { - const uword N = P.get_n_elem(); - - typename Proxy::ea_type Pea = P.get_ea(); - - for(uword i=0; i -inline -void -op_chi2rnd::fill_constant_df(Mat& out, const eT df) - { - arma_debug_sigprint(); - - if(df > eT(0)) - { - typedef std::mt19937_64 motor_type; - typedef std::mt19937_64::result_type seed_type; - typedef std::chi_squared_distribution distr_type; - - motor_type motor; motor.seed( seed_type(arma_rng::randi()) ); - distr_type distr(df); - - const uword N = out.n_elem; - - eT* out_mem = out.memptr(); - - for(uword i=0; i::nan ); - } - } - - - -// - - - -template -inline -op_chi2rnd_varying_df::~op_chi2rnd_varying_df() - { - arma_debug_sigprint(); - } - - - -template -inline -op_chi2rnd_varying_df::op_chi2rnd_varying_df() - { - arma_debug_sigprint(); - - typedef std::mt19937_64::result_type seed_type; - - motor.seed( seed_type(arma_rng::randi()) ); - } - - - -template -inline -eT -op_chi2rnd_varying_df::operator()(const eT df) - { - arma_debug_sigprint(); - - // as C++11 doesn't seem to provide a way to explicitly set the parameter - // of an existing chi_squared_distribution object, - // we need to create a new object each time - - if(df > eT(0)) - { - std::chi_squared_distribution distr(df); - - return eT( distr(motor) ); - } - else - { - return Datum::nan; - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_chol_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_chol_bones.hpp deleted file mode 100644 index e3b3a9c08..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_chol_bones.hpp +++ /dev/null @@ -1,38 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_chol -//! @{ - - - -class op_chol - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& X); - - template - inline static bool apply_direct(Mat& out, const Base& A_expr, const uword layout); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_chol_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_chol_meat.hpp deleted file mode 100644 index d79f989f0..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_chol_meat.hpp +++ /dev/null @@ -1,74 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_chol -//! @{ - - - -template -inline -void -op_chol::apply(Mat& out, const Op& X) - { - arma_debug_sigprint(); - - const bool status = op_chol::apply_direct(out, X.m, X.aux_uword_a); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("chol(): decomposition failed"); - } - } - - - -template -inline -bool -op_chol::apply_direct(Mat& out, const Base& A_expr, const uword layout) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - out = A_expr.get_ref(); - - arma_conform_check( (out.is_square() == false), "chol(): given matrix must be square sized", [&](){ out.soft_reset(); } ); - - if(out.is_empty()) { return true; } - - if((arma_config::check_conform) && (auxlib::rudimentary_sym_check(out) == false)) - { - if(is_cx::no ) { arma_warn(1, "chol(): given matrix is not symmetric"); } - if(is_cx::yes) { arma_warn(1, "chol(): given matrix is not hermitian"); } - } - - uword KD = 0; - - const bool is_band = arma_config::optimise_band && ((auxlib::crippled_lapack(out)) ? false : ((layout == 0) ? band_helper::is_band_upper(KD, out, uword(32)) : band_helper::is_band_lower(KD, out, uword(32)))); - - const bool status = (is_band) ? auxlib::chol_band(out, KD, layout) : auxlib::chol(out, layout); - - return status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_clamp_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_clamp_bones.hpp deleted file mode 100644 index 89e53424b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_clamp_bones.hpp +++ /dev/null @@ -1,74 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_clamp -//! @{ - - - -class op_clamp - : public traits_op_passthru - { - public: - - // matrices - - template inline static void apply(Mat& out, const mtOp& in); - - template inline static void apply_direct(Mat& out, const Mat& X, const eT min_val, const eT max_val); - - template inline static void apply_proxy_noalias(Mat& out, const Proxy& P, const typename T1::elem_type min_val, const typename T1::elem_type max_val); - - // cubes - - template inline static void apply(Cube& out, const mtOpCube& in); - - template inline static void apply_direct(Cube& out, const Cube& X, const eT min_val, const eT max_val); - - template inline static void apply_proxy_noalias(Cube& out, const ProxyCube& P, const typename T1::elem_type min_val, const typename T1::elem_type max_val); - }; - - - -class op_clamp_cx - : public traits_op_passthru - { - public: - - // matrices - - template inline static void apply(Mat& out, const mtOp& in); - - template inline static void apply_direct(Mat& out, const Mat& X, const eT min_val, const eT max_val); - - template inline static void apply_proxy_noalias(Mat& out, const Proxy& P, const typename T1::elem_type min_val, const typename T1::elem_type max_val); - - - // cubes - - template inline static void apply(Cube& out, const mtOpCube& in); - - template inline static void apply_direct(Cube& out, const Cube& X, const eT min_val, const eT max_val); - - template inline static void apply_proxy_noalias(Cube& out, const ProxyCube& P, const typename T1::elem_type min_val, const typename T1::elem_type max_val); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_clamp_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_clamp_meat.hpp deleted file mode 100644 index d479e4eb1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_clamp_meat.hpp +++ /dev/null @@ -1,577 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_clamp -//! @{ - - - -template -inline -void -op_clamp::apply(Mat& out, const mtOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const eT min_val = in.aux; - const eT max_val = in.aux_out_eT; - - arma_conform_check( (min_val > max_val), "clamp(): min_val must be less than max_val" ); - - if(is_Mat::value) - { - const unwrap U(in.m); - - op_clamp::apply_direct(out, U.M, min_val, max_val); - } - else - { - const Proxy P(in.m); - - if(P.is_alias(out)) - { - Mat tmp; - - op_clamp::apply_proxy_noalias(tmp, P, min_val, max_val); - - out.steal_mem(tmp); - } - else - { - op_clamp::apply_proxy_noalias(out, P, min_val, max_val); - } - } - } - - - -template -inline -void -op_clamp::apply_direct(Mat& out, const Mat& X, const eT min_val, const eT max_val) - { - arma_debug_sigprint(); - - if(&out != &X) - { - out.set_size(X.n_rows, X.n_cols); - - const uword N = out.n_elem; - - const eT* X_mem = X.memptr(); - eT* out_mem = out.memptr(); - - for(uword i=0; i max_val) ? max_val : val); - } - } - else - { - arma_debug_print("op_clamp::apply_direct(): inplace operation"); - - arrayops::clamp(out.memptr(), out.n_elem, min_val, max_val); - } - } - - - -template -inline -void -op_clamp::apply_proxy_noalias(Mat& out, const Proxy& P, const typename T1::elem_type min_val, const typename T1::elem_type max_val) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - out.set_size(n_rows, n_cols); - - eT* out_mem = out.memptr(); - - if(Proxy::use_at == false) - { - const uword N = P.get_n_elem(); - - typename Proxy::ea_type A = P.get_ea(); - - for(uword i=0; i max_val) ? max_val : val); - } - } - else - { - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - const eT val = P.at(row,col); - - (*out_mem) = (val < min_val) ? min_val : ((val > max_val) ? max_val : val); - - out_mem++; - } - } - } - - - -// - - - -template -inline -void -op_clamp::apply(Cube& out, const mtOpCube& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const eT min_val = in.aux; - const eT max_val = in.aux_out_eT; - - arma_conform_check( (min_val > max_val), "clamp(): min_val must be less than max_val" ); - - if(is_Cube::value) - { - const unwrap_cube U(in.m); - - op_clamp::apply_direct(out, U.M, min_val, max_val); - } - else - { - const ProxyCube P(in.m); - - if(P.is_alias(out)) - { - Cube tmp; - - op_clamp::apply_proxy_noalias(tmp, P, min_val, max_val); - - out.steal_mem(tmp); - } - else - { - op_clamp::apply_proxy_noalias(out, P, min_val, max_val); - } - } - } - - - -template -inline -void -op_clamp::apply_direct(Cube& out, const Cube& X, const eT min_val, const eT max_val) - { - arma_debug_sigprint(); - - if(&out != &X) - { - out.set_size(X.n_rows, X.n_cols, X.n_slices); - - const uword N = out.n_elem; - - const eT* X_mem = X.memptr(); - eT* out_mem = out.memptr(); - - for(uword i=0; i max_val) ? max_val : val); - } - } - else - { - arma_debug_print("op_clamp::apply_direct(): inplace operation"); - - arrayops::clamp(out.memptr(), out.n_elem, min_val, max_val); - } - } - - - -template -inline -void -op_clamp::apply_proxy_noalias(Cube& out, const ProxyCube& P, const typename T1::elem_type min_val, const typename T1::elem_type max_val) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - const uword n_slices = P.get_n_slices(); - - out.set_size(n_rows, n_cols, n_slices); - - eT* out_mem = out.memptr(); - - if(ProxyCube::use_at == false) - { - const uword N = P.get_n_elem(); - - typename ProxyCube::ea_type A = P.get_ea(); - - for(uword i=0; i max_val) ? max_val : val); - } - } - else - { - for(uword s=0; s < n_slices; ++s) - for(uword c=0; c < n_cols; ++c) - for(uword r=0; r < n_rows; ++r) - { - const eT val = P.at(r,c,s); - - (*out_mem) = (val < min_val) ? min_val : ((val > max_val) ? max_val : val); - - out_mem++; - } - } - } - - - -// - - - -template -inline -void -op_clamp_cx::apply(Mat& out, const mtOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(is_Mat::value) - { - const unwrap U(in.m); - - op_clamp_cx::apply_direct(out, U.M, in.aux, in.aux_out_eT); - } - else - { - const Proxy P(in.m); - - if(P.is_alias(out)) - { - Mat tmp; - - op_clamp_cx::apply_proxy_noalias(tmp, P, in.aux, in.aux_out_eT); - - out.steal_mem(tmp); - } - else - { - op_clamp_cx::apply_proxy_noalias(out, P, in.aux, in.aux_out_eT); - } - } - } - - - -template -inline -void -op_clamp_cx::apply_direct(Mat& out, const Mat& X, const eT min_val, const eT max_val) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const T min_val_real = std::real(min_val); - const T min_val_imag = std::imag(min_val); - - const T max_val_real = std::real(max_val); - const T max_val_imag = std::imag(max_val); - - arma_conform_check( (min_val_real > max_val_real), "clamp(): real(min_val) must be less than real(max_val)" ); - arma_conform_check( (min_val_imag > max_val_imag), "clamp(): imag(min_val) must be less than imag(max_val)" ); - - if(&out != &X) - { - out.set_size(X.n_rows, X.n_cols); - - const uword N = out.n_elem; - - const eT* X_mem = X.memptr(); - eT* out_mem = out.memptr(); - - for(uword i=0; i max_val_real) ? max_val_real : val_real); - val_imag = (val_imag < min_val_imag) ? min_val_imag : ((val_imag > max_val_imag) ? max_val_imag : val_imag); - - out_mem[i] = std::complex(val_real,val_imag); - } - } - else - { - arma_debug_print("op_clamp_cx::apply_direct(): inplace operation"); - - arrayops::clamp(out.memptr(), out.n_elem, min_val, max_val); - } - } - - - -template -inline -void -op_clamp_cx::apply_proxy_noalias(Mat& out, const Proxy& P, const typename T1::elem_type min_val, const typename T1::elem_type max_val) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const T min_val_real = std::real(min_val); - const T min_val_imag = std::imag(min_val); - - const T max_val_real = std::real(max_val); - const T max_val_imag = std::imag(max_val); - - arma_conform_check( (min_val_real > max_val_real), "clamp(): real(min_val) must be less than real(max_val)" ); - arma_conform_check( (min_val_imag > max_val_imag), "clamp(): imag(min_val) must be less than imag(max_val)" ); - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - out.set_size(n_rows, n_cols); - - eT* out_mem = out.memptr(); - - if(Proxy::use_at == false) - { - const uword N = P.get_n_elem(); - - typename Proxy::ea_type A = P.get_ea(); - - for(uword i=0; i max_val_real) ? max_val_real : val_real); - val_imag = (val_imag < min_val_imag) ? min_val_imag : ((val_imag > max_val_imag) ? max_val_imag : val_imag); - - out_mem[i] = std::complex(val_real,val_imag); - } - } - else - { - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - const eT val = P.at(row,col); - - T val_real = std::real(val); - T val_imag = std::imag(val); - - val_real = (val_real < min_val_real) ? min_val_real : ((val_real > max_val_real) ? max_val_real : val_real); - val_imag = (val_imag < min_val_imag) ? min_val_imag : ((val_imag > max_val_imag) ? max_val_imag : val_imag); - - (*out_mem) = std::complex(val_real,val_imag); out_mem++; - } - } - } - - - -// - - - -template -inline -void -op_clamp_cx::apply(Cube& out, const mtOpCube& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(is_Cube::value) - { - const unwrap_cube U(in.m); - - op_clamp_cx::apply_direct(out, U.M, in.aux, in.aux_out_eT); - } - else - { - const ProxyCube P(in.m); - - if(P.is_alias(out)) - { - Cube tmp; - - op_clamp_cx::apply_proxy_noalias(tmp, P, in.aux, in.aux_out_eT); - - out.steal_mem(tmp); - } - else - { - op_clamp_cx::apply_proxy_noalias(out, P, in.aux, in.aux_out_eT); - } - } - } - - - -template -inline -void -op_clamp_cx::apply_direct(Cube& out, const Cube& X, const eT min_val, const eT max_val) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const T min_val_real = std::real(min_val); - const T min_val_imag = std::imag(min_val); - - const T max_val_real = std::real(max_val); - const T max_val_imag = std::imag(max_val); - - arma_conform_check( (min_val_real > max_val_real), "clamp(): real(min_val) must be less than real(max_val)" ); - arma_conform_check( (min_val_imag > max_val_imag), "clamp(): imag(min_val) must be less than imag(max_val)" ); - - if(&out != &X) - { - out.set_size(X.n_rows, X.n_cols, X.n_slices); - - const uword N = out.n_elem; - - const eT* X_mem = X.memptr(); - eT* out_mem = out.memptr(); - - for(uword i=0; i max_val_real) ? max_val_real : val_real); - val_imag = (val_imag < min_val_imag) ? min_val_imag : ((val_imag > max_val_imag) ? max_val_imag : val_imag); - - out_mem[i] = std::complex(val_real,val_imag); - } - } - else - { - arma_debug_print("op_clamp_cx::apply_direct(): inplace operation"); - - arrayops::clamp(out.memptr(), out.n_elem, min_val, max_val); - } - } - - - -template -inline -void -op_clamp_cx::apply_proxy_noalias(Cube& out, const ProxyCube& P, const typename T1::elem_type min_val, const typename T1::elem_type max_val) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const T min_val_real = std::real(min_val); - const T min_val_imag = std::imag(min_val); - - const T max_val_real = std::real(max_val); - const T max_val_imag = std::imag(max_val); - - arma_conform_check( (min_val_real > max_val_real), "clamp(): real(min_val) must be less than real(max_val)" ); - arma_conform_check( (min_val_imag > max_val_imag), "clamp(): imag(min_val) must be less than imag(max_val)" ); - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - const uword n_slices = P.get_n_slices(); - - out.set_size(n_rows, n_cols, n_slices); - - eT* out_mem = out.memptr(); - - if(ProxyCube::use_at == false) - { - const uword N = P.get_n_elem(); - - typename ProxyCube::ea_type A = P.get_ea(); - - for(uword i=0; i max_val_real) ? max_val_real : val_real); - val_imag = (val_imag < min_val_imag) ? min_val_imag : ((val_imag > max_val_imag) ? max_val_imag : val_imag); - - out_mem[i] = std::complex(val_real,val_imag); - } - } - else - { - for(uword s=0; s < n_slices; ++s) - for(uword c=0; c < n_cols; ++c) - for(uword r=0; r < n_rows; ++r) - { - const eT val = P.at(r,c,s); - - T val_real = std::real(val); - T val_imag = std::imag(val); - - val_real = (val_real < min_val_real) ? min_val_real : ((val_real > max_val_real) ? max_val_real : val_real); - val_imag = (val_imag < min_val_imag) ? min_val_imag : ((val_imag > max_val_imag) ? max_val_imag : val_imag); - - (*out_mem) = std::complex(val_real,val_imag); out_mem++; - } - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_col_as_mat_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_col_as_mat_bones.hpp deleted file mode 100644 index 6e653ea44..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_col_as_mat_bones.hpp +++ /dev/null @@ -1,33 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_col_as_mat -//! @{ - - -class op_col_as_mat - : public traits_op_default - { - public: - - template inline static void apply(Mat& out, const CubeToMatOp& expr); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_col_as_mat_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_col_as_mat_meat.hpp deleted file mode 100644 index 403191ed3..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_col_as_mat_meat.hpp +++ /dev/null @@ -1,53 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_col_as_mat -//! @{ - - - -template -inline -void -op_col_as_mat::apply(Mat& out, const CubeToMatOp& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_cube U(expr.m); - const Cube& A = U.M; - - const uword in_col = expr.aux_uword; - - arma_conform_check_bounds( (in_col >= A.n_cols), "Cube::col_as_mat(): index out of bounds" ); - - const uword A_n_rows = A.n_rows; - const uword A_n_slices = A.n_slices; - - out.set_size(A_n_rows, A_n_slices); - - for(uword s=0; s < A_n_slices; ++s) - { - arrayops::copy(out.colptr(s), A.slice_colptr(s, in_col), A_n_rows); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cond_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cond_bones.hpp deleted file mode 100644 index b76489870..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cond_bones.hpp +++ /dev/null @@ -1,36 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_cond -//! @{ - - -class op_cond - : public traits_op_default - { - public: - - template static inline typename T1::pod_type apply(const Base& X); - - template static inline typename get_pod_type::result apply_diag(const Mat& A); - template static inline typename get_pod_type::result apply_sym ( Mat& A); - template static inline typename get_pod_type::result apply_gen ( Mat& A); - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cond_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cond_meat.hpp deleted file mode 100644 index f0ac58298..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cond_meat.hpp +++ /dev/null @@ -1,174 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_cond -//! @{ - - - -template -inline -typename T1::pod_type -op_cond::apply(const Base& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - Mat A(X.get_ref()); - - if(A.n_elem == 0) { return T(0); } - - if(is_op_diagmat::value || A.is_diagmat()) - { - arma_debug_print("op_cond::apply(): detected diagonal matrix"); - - return op_cond::apply_diag(A); - } - - bool is_approx_sym = false; - bool is_approx_sympd = false; - - sym_helper::analyse_matrix(is_approx_sym, is_approx_sympd, A); - - const bool do_sym = (is_cx::no) ? (is_approx_sym) : (is_approx_sym && is_approx_sympd); - - if(do_sym) - { - arma_debug_print("op_cond: symmetric/hermitian optimisation"); - - return op_cond::apply_sym(A); - } - - return op_cond::apply_gen(A); - } - - - -template -inline -typename get_pod_type::result -op_cond::apply_diag(const Mat& A) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const uword N = (std::min)(A.n_rows, A.n_cols); - - T abs_min = Datum::inf; - T abs_max = T(0); - - for(uword i=0; i < N; ++i) - { - const T abs_val = std::abs(A.at(i,i)); - - if(arma_isnan(abs_val)) - { - arma_warn(3, "cond(): failed"); - - return Datum::nan; - } - - abs_min = (abs_val < abs_min) ? abs_val : abs_min; - abs_max = (abs_val > abs_max) ? abs_val : abs_max; - } - - if((abs_min == T(0)) || (abs_max == T(0))) { return Datum::inf; } - - return T(abs_max / abs_min); - } - - - -template -inline -typename get_pod_type::result -op_cond::apply_sym(Mat& A) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - Col eigval; - - const bool status = auxlib::eig_sym(eigval, A); - - if(status == false) - { - arma_warn(3, "cond(): failed"); - - return Datum::nan; - } - - if(eigval.n_elem == 0) { return T(0); } - - const T* eigval_mem = eigval.memptr(); - - T abs_min = std::abs(eigval_mem[0]); - T abs_max = abs_min; - - for(uword i=1; i < eigval.n_elem; ++i) - { - const T abs_val = std::abs(eigval_mem[i]); - - abs_min = (abs_val < abs_min) ? abs_val : abs_min; - abs_max = (abs_val > abs_max) ? abs_val : abs_max; - } - - if((abs_min == T(0)) || (abs_max == T(0))) { return Datum::inf; } - - return T(abs_max / abs_min); - } - - - -template -inline -typename get_pod_type::result -op_cond::apply_gen(Mat& A) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - Col S; - - const bool status = auxlib::svd_dc(S, A); - - if(status == false) - { - arma_warn(3, "cond(): failed"); - - return Datum::nan; - } - - if(S.n_elem == 0) { return T(0); } - - const T S_max = S[0]; - const T S_min = S[S.n_elem-1]; - - if((S_max == T(0)) || (S_min == T(0))) { return Datum::inf; } - - return T(S_max / S_min); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cor_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cor_bones.hpp deleted file mode 100644 index 7a506c3a5..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cor_bones.hpp +++ /dev/null @@ -1,36 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_cor -//! @{ - - - -class op_cor - : public traits_op_default - { - public: - - template inline static void apply(Mat& out, const Op< T1, op_cor>& in); - template inline static void apply(Mat& out, const Op< Op, op_cor>& in); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cor_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cor_meat.hpp deleted file mode 100644 index e9b9cdbe1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cor_meat.hpp +++ /dev/null @@ -1,126 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_cor -//! @{ - - - -template -inline -void -op_cor::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword norm_type = in.aux_uword_a; - - const unwrap U(in.m); - const Mat& A = U.M; - - if(A.n_elem == 0) - { - out.reset(); - return; - } - - if(A.n_elem == 1) - { - out.set_size(1,1); - out[0] = eT(1); - return; - } - - const Mat& AA = (A.n_rows == 1) - ? Mat(const_cast(A.memptr()), A.n_cols, A.n_rows, false, false) - : Mat(const_cast(A.memptr()), A.n_rows, A.n_cols, false, false); - - const uword N = AA.n_rows; - const eT norm_val = (norm_type == 0) ? ( (N > 1) ? eT(N-1) : eT(1) ) : eT(N); - - const Mat tmp = AA.each_row() - mean(AA,0); - - out = tmp.t() * tmp; - out /= norm_val; - - const Col s = sqrt(out.diag()); - - out /= (s * s.t()); // TODO: check for zeros in s? - } - - - -template -inline -void -op_cor::apply(Mat& out, const Op< Op, op_cor>& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword norm_type = in.aux_uword_a; - - if(is_cx::yes) - { - const Mat tmp = in.m; // force the evaluation of Op - - out = cor(tmp, norm_type); - } - else - { - const unwrap U(in.m.m); - const Mat& A = U.M; - - if(A.n_elem == 0) - { - out.reset(); - return; - } - - if(A.n_elem == 1) - { - out.set_size(1,1); - out[0] = eT(1); - return; - } - - const Mat& AA = (A.n_cols == 1) - ? Mat(const_cast(A.memptr()), A.n_cols, A.n_rows, false, false) - : Mat(const_cast(A.memptr()), A.n_rows, A.n_cols, false, false); - - const uword N = AA.n_cols; - const eT norm_val = (norm_type == 0) ? ( (N > 1) ? eT(N-1) : eT(1) ) : eT(N); - - const Mat tmp = AA.each_col() - mean(AA,1); - - out = tmp * tmp.t(); - out /= norm_val; - - const Col s = sqrt(out.diag()); - - out /= (s * s.t()); // TODO: check for zeros in s? - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cov_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cov_bones.hpp deleted file mode 100644 index 5de43ba81..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cov_bones.hpp +++ /dev/null @@ -1,36 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_cov -//! @{ - - - -class op_cov - : public traits_op_default - { - public: - - template inline static void apply(Mat& out, const Op< T1, op_cov>& in); - template inline static void apply(Mat& out, const Op< Op, op_cov>& in); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cov_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cov_meat.hpp deleted file mode 100644 index 08afb822e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cov_meat.hpp +++ /dev/null @@ -1,104 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_cov -//! @{ - - - -template -inline -void -op_cov::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword norm_type = in.aux_uword_a; - - const unwrap U(in.m); - const Mat& A = U.M; - - if(A.n_elem == 0) - { - out.reset(); - return; - } - - const Mat& AA = (A.n_rows == 1) - ? Mat(const_cast(A.memptr()), A.n_cols, A.n_rows, false, false) - : Mat(const_cast(A.memptr()), A.n_rows, A.n_cols, false, false); - - const uword N = AA.n_rows; - const eT norm_val = (norm_type == 0) ? ( (N > 1) ? eT(N-1) : eT(1) ) : eT(N); - - const Mat tmp = AA.each_row() - mean(AA,0); - - out = tmp.t() * tmp; - out /= norm_val; - } - - - -template -inline -void -op_cov::apply(Mat& out, const Op< Op, op_cov>& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword norm_type = in.aux_uword_a; - - if(is_cx::yes) - { - const Mat tmp = in.m; // force the evaluation of Op - - out = cov(tmp, norm_type); - } - else - { - const unwrap U(in.m.m); - const Mat& A = U.M; - - if(A.n_elem == 0) - { - out.reset(); - return; - } - - const Mat& AA = (A.n_cols == 1) - ? Mat(const_cast(A.memptr()), A.n_cols, A.n_rows, false, false) - : Mat(const_cast(A.memptr()), A.n_rows, A.n_cols, false, false); - - const uword N = AA.n_cols; - const eT norm_val = (norm_type == 0) ? ( (N > 1) ? eT(N-1) : eT(1) ) : eT(N); - - const Mat tmp = AA.each_col() - mean(AA,1); - - out = tmp * tmp.t(); - out /= norm_val; - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cumprod_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cumprod_bones.hpp deleted file mode 100644 index ce3b686fa..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cumprod_bones.hpp +++ /dev/null @@ -1,49 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_cumprod -//! @{ - - - -class op_cumprod - : public traits_op_default - { - public: - - template - inline static void apply_noalias(Mat& out, const Mat& X, const uword dim); - - template - inline static void apply(Mat& out, const Op& in); - }; - - - -class op_cumprod_vec - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const Op& in); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cumprod_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cumprod_meat.hpp deleted file mode 100644 index fa49b243c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cumprod_meat.hpp +++ /dev/null @@ -1,174 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_cumprod -//! @{ - - - -template -inline -void -op_cumprod::apply_noalias(Mat& out, const Mat& X, const uword dim) - { - arma_debug_sigprint(); - - uword n_rows = X.n_rows; - uword n_cols = X.n_cols; - - out.set_size(n_rows,n_cols); - - if(out.n_elem == 0) { return; } - - if(dim == 0) - { - if(n_cols == 1) - { - const eT* X_mem = X.memptr(); - eT* out_mem = out.memptr(); - - eT acc = eT(1); - - for(uword row=0; row < n_rows; ++row) - { - acc *= X_mem[row]; - - out_mem[row] = acc; - } - } - else - { - for(uword col=0; col < n_cols; ++col) - { - const eT* X_colmem = X.colptr(col); - eT* out_colmem = out.colptr(col); - - eT acc = eT(1); - - for(uword row=0; row < n_rows; ++row) - { - acc *= X_colmem[row]; - - out_colmem[row] = acc; - } - } - } - } - else - if(dim == 1) - { - if(n_rows == 1) - { - const eT* X_mem = X.memptr(); - eT* out_mem = out.memptr(); - - eT acc = eT(1); - - for(uword col=0; col < n_cols; ++col) - { - acc *= X_mem[col]; - - out_mem[col] = acc; - } - } - else - { - if(n_cols > 0) - { - arrayops::copy( out.colptr(0), X.colptr(0), n_rows ); - - for(uword col=1; col < n_cols; ++col) - { - const eT* out_colmem_prev = out.colptr(col-1); - eT* out_colmem = out.colptr(col ); - const eT* X_colmem = X.colptr(col ); - - for(uword row=0; row < n_rows; ++row) - { - out_colmem[row] = out_colmem_prev[row] * X_colmem[row]; - } - } - } - } - } - } - - - -template -inline -void -op_cumprod::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword dim = in.aux_uword_a; - - arma_conform_check( (dim > 1), "cumprod(): parameter 'dim' must be 0 or 1" ); - - const quasi_unwrap U(in.m); - - if(U.is_alias(out)) - { - Mat tmp; - - op_cumprod::apply_noalias(tmp, U.M, dim); - - out.steal_mem(tmp); - } - else - { - op_cumprod::apply_noalias(out, U.M, dim); - } - } - - - -template -inline -void -op_cumprod_vec::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap U(in.m); - - const uword dim = (T1::is_xvec) ? uword(U.M.is_rowvec() ? 1 : 0) : uword((T1::is_row) ? 1 : 0); - - if(U.is_alias(out)) - { - Mat tmp; - - op_cumprod::apply_noalias(tmp, U.M, dim); - - out.steal_mem(tmp); - } - else - { - op_cumprod::apply_noalias(out, U.M, dim); - } - } - - - -//! @} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cumsum_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cumsum_bones.hpp deleted file mode 100644 index 007d3f360..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cumsum_bones.hpp +++ /dev/null @@ -1,49 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_cumsum -//! @{ - - - -class op_cumsum - : public traits_op_default - { - public: - - template - inline static void apply_noalias(Mat& out, const Mat& X, const uword dim); - - template - inline static void apply(Mat& out, const Op& in); - }; - - - -class op_cumsum_vec - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const Op& in); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cumsum_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cumsum_meat.hpp deleted file mode 100644 index 8552ae183..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cumsum_meat.hpp +++ /dev/null @@ -1,174 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_cumsum -//! @{ - - - -template -inline -void -op_cumsum::apply_noalias(Mat& out, const Mat& X, const uword dim) - { - arma_debug_sigprint(); - - uword n_rows = X.n_rows; - uword n_cols = X.n_cols; - - out.set_size(n_rows,n_cols); - - if(out.n_elem == 0) { return; } - - if(dim == 0) - { - if(n_cols == 1) - { - const eT* X_mem = X.memptr(); - eT* out_mem = out.memptr(); - - eT acc = eT(0); - - for(uword row=0; row < n_rows; ++row) - { - acc += X_mem[row]; - - out_mem[row] = acc; - } - } - else - { - for(uword col=0; col < n_cols; ++col) - { - const eT* X_colmem = X.colptr(col); - eT* out_colmem = out.colptr(col); - - eT acc = eT(0); - - for(uword row=0; row < n_rows; ++row) - { - acc += X_colmem[row]; - - out_colmem[row] = acc; - } - } - } - } - else - if(dim == 1) - { - if(n_rows == 1) - { - const eT* X_mem = X.memptr(); - eT* out_mem = out.memptr(); - - eT acc = eT(0); - - for(uword col=0; col < n_cols; ++col) - { - acc += X_mem[col]; - - out_mem[col] = acc; - } - } - else - { - if(n_cols > 0) - { - arrayops::copy( out.colptr(0), X.colptr(0), n_rows ); - - for(uword col=1; col < n_cols; ++col) - { - const eT* out_colmem_prev = out.colptr(col-1); - eT* out_colmem = out.colptr(col ); - const eT* X_colmem = X.colptr(col ); - - for(uword row=0; row < n_rows; ++row) - { - out_colmem[row] = out_colmem_prev[row] + X_colmem[row]; - } - } - } - } - } - } - - - -template -inline -void -op_cumsum::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword dim = in.aux_uword_a; - - arma_conform_check( (dim > 1), "cumsum(): parameter 'dim' must be 0 or 1" ); - - const quasi_unwrap U(in.m); - - if(U.is_alias(out)) - { - Mat tmp; - - op_cumsum::apply_noalias(tmp, U.M, dim); - - out.steal_mem(tmp); - } - else - { - op_cumsum::apply_noalias(out, U.M, dim); - } - } - - - -template -inline -void -op_cumsum_vec::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap U(in.m); - - const uword dim = (T1::is_xvec) ? uword(U.M.is_rowvec() ? 1 : 0) : uword((T1::is_row) ? 1 : 0); - - if(U.is_alias(out)) - { - Mat tmp; - - op_cumsum::apply_noalias(tmp, U.M, dim); - - out.steal_mem(tmp); - } - else - { - op_cumsum::apply_noalias(out, U.M, dim); - } - } - - - -//! @} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cx_scalar_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cx_scalar_bones.hpp deleted file mode 100644 index c1c28477f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cx_scalar_bones.hpp +++ /dev/null @@ -1,168 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_cx_scalar -//! @{ - - - -class op_cx_scalar_times - : public traits_op_passthru - { - public: - - template - inline static void - apply - ( - Mat< typename std::complex >& out, - const mtOp, T1, op_cx_scalar_times>& X - ); - - template - inline static void - apply - ( - Cube< typename std::complex >& out, - const mtOpCube, T1, op_cx_scalar_times>& X - ); - }; - - - -class op_cx_scalar_plus - : public traits_op_passthru - { - public: - - template - inline static void - apply - ( - Mat< typename std::complex >& out, - const mtOp, T1, op_cx_scalar_plus>& X - ); - - template - inline static void - apply - ( - Cube< typename std::complex >& out, - const mtOpCube, T1, op_cx_scalar_plus>& X - ); - }; - - - -class op_cx_scalar_minus_pre - : public traits_op_passthru - { - public: - - template - inline static void - apply - ( - Mat< typename std::complex >& out, - const mtOp, T1, op_cx_scalar_minus_pre>& X - ); - - template - inline static void - apply - ( - Cube< typename std::complex >& out, - const mtOpCube, T1, op_cx_scalar_minus_pre>& X - ); - }; - - - -class op_cx_scalar_minus_post - : public traits_op_passthru - { - public: - - template - inline static void - apply - ( - Mat< typename std::complex >& out, - const mtOp, T1, op_cx_scalar_minus_post>& X - ); - - template - inline static void - apply - ( - Cube< typename std::complex >& out, - const mtOpCube, T1, op_cx_scalar_minus_post>& X - ); - }; - - - -class op_cx_scalar_div_pre - : public traits_op_passthru - { - public: - - template - inline static void - apply - ( - Mat< typename std::complex >& out, - const mtOp, T1, op_cx_scalar_div_pre>& X - ); - - template - inline static void - apply - ( - Cube< typename std::complex >& out, - const mtOpCube, T1, op_cx_scalar_div_pre>& X - ); - }; - - - -class op_cx_scalar_div_post - : public traits_op_passthru - { - public: - - template - inline static void - apply - ( - Mat< typename std::complex >& out, - const mtOp, T1, op_cx_scalar_div_post>& X - ); - - template - inline static void - apply - ( - Cube< typename std::complex >& out, - const mtOpCube, T1, op_cx_scalar_div_post>& X - ); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cx_scalar_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cx_scalar_meat.hpp deleted file mode 100644 index 5b56cc1d9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_cx_scalar_meat.hpp +++ /dev/null @@ -1,564 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_cx_scalar -//! @{ - - - -template -inline -void -op_cx_scalar_times::apply - ( - Mat< typename std::complex >& out, - const mtOp, T1, op_cx_scalar_times>& X - ) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const Proxy A(X.m); - - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - - out.set_size(n_rows, n_cols); - - const eT k = X.aux_out_eT; - eT* out_mem = out.memptr(); - - if(Proxy::use_at == false) - { - const uword n_elem = A.get_n_elem(); - - for(uword i=0; i -inline -void -op_cx_scalar_plus::apply - ( - Mat< typename std::complex >& out, - const mtOp, T1, op_cx_scalar_plus>& X - ) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const Proxy A(X.m); - - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - - out.set_size(n_rows, n_cols); - - const eT k = X.aux_out_eT; - eT* out_mem = out.memptr(); - - if(Proxy::use_at == false) - { - const uword n_elem = A.get_n_elem(); - - for(uword i=0; i -inline -void -op_cx_scalar_minus_pre::apply - ( - Mat< typename std::complex >& out, - const mtOp, T1, op_cx_scalar_minus_pre>& X - ) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const Proxy A(X.m); - - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - - out.set_size(n_rows, n_cols); - - const eT k = X.aux_out_eT; - eT* out_mem = out.memptr(); - - if(Proxy::use_at == false) - { - const uword n_elem = A.get_n_elem(); - - for(uword i=0; i -inline -void -op_cx_scalar_minus_post::apply - ( - Mat< typename std::complex >& out, - const mtOp, T1, op_cx_scalar_minus_post>& X - ) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const Proxy A(X.m); - - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - - out.set_size(n_rows, n_cols); - - const eT k = X.aux_out_eT; - eT* out_mem = out.memptr(); - - if(Proxy::use_at == false) - { - const uword n_elem = A.get_n_elem(); - - for(uword i=0; i -inline -void -op_cx_scalar_div_pre::apply - ( - Mat< typename std::complex >& out, - const mtOp, T1, op_cx_scalar_div_pre>& X - ) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const Proxy A(X.m); - - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - - out.set_size(n_rows, n_cols); - - const eT k = X.aux_out_eT; - eT* out_mem = out.memptr(); - - if(Proxy::use_at == false) - { - const uword n_elem = A.get_n_elem(); - - for(uword i=0; i -inline -void -op_cx_scalar_div_post::apply - ( - Mat< typename std::complex >& out, - const mtOp, T1, op_cx_scalar_div_post>& X - ) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const Proxy A(X.m); - - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - - out.set_size(n_rows, n_cols); - - const eT k = X.aux_out_eT; - eT* out_mem = out.memptr(); - - if(Proxy::use_at == false) - { - const uword n_elem = A.get_n_elem(); - - for(uword i=0; i -inline -void -op_cx_scalar_times::apply - ( - Cube< typename std::complex >& out, - const mtOpCube, T1, op_cx_scalar_times>& X - ) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const ProxyCube A(X.m); - - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - const uword n_slices = A.get_n_slices(); - - out.set_size(n_rows, n_cols, n_slices); - - const eT k = X.aux_out_eT; - const uword n_elem = out.n_elem; - eT* out_mem = out.memptr(); - - if(ProxyCube::use_at == false) - { - for(uword i=0; i -inline -void -op_cx_scalar_plus::apply - ( - Cube< typename std::complex >& out, - const mtOpCube, T1, op_cx_scalar_plus>& X - ) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const ProxyCube A(X.m); - - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - const uword n_slices = A.get_n_slices(); - - out.set_size(n_rows, n_cols, n_slices); - - const eT k = X.aux_out_eT; - const uword n_elem = out.n_elem; - eT* out_mem = out.memptr(); - - if(ProxyCube::use_at == false) - { - for(uword i=0; i -inline -void -op_cx_scalar_minus_pre::apply - ( - Cube< typename std::complex >& out, - const mtOpCube, T1, op_cx_scalar_minus_pre>& X - ) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const ProxyCube A(X.m); - - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - const uword n_slices = A.get_n_slices(); - - out.set_size(n_rows, n_cols, n_slices); - - const eT k = X.aux_out_eT; - const uword n_elem = out.n_elem; - eT* out_mem = out.memptr(); - - if(ProxyCube::use_at == false) - { - for(uword i=0; i -inline -void -op_cx_scalar_minus_post::apply - ( - Cube< typename std::complex >& out, - const mtOpCube, T1, op_cx_scalar_minus_post>& X - ) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const ProxyCube A(X.m); - - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - const uword n_slices = A.get_n_slices(); - - out.set_size(n_rows, n_cols, n_slices); - - const eT k = X.aux_out_eT; - const uword n_elem = out.n_elem; - eT* out_mem = out.memptr(); - - if(ProxyCube::use_at == false) - { - for(uword i=0; i -inline -void -op_cx_scalar_div_pre::apply - ( - Cube< typename std::complex >& out, - const mtOpCube, T1, op_cx_scalar_div_pre>& X - ) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const ProxyCube A(X.m); - - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - const uword n_slices = A.get_n_slices(); - - out.set_size(n_rows, n_cols, n_slices); - - const eT k = X.aux_out_eT; - const uword n_elem = out.n_elem; - eT* out_mem = out.memptr(); - - if(ProxyCube::use_at == false) - { - for(uword i=0; i -inline -void -op_cx_scalar_div_post::apply - ( - Cube< typename std::complex >& out, - const mtOpCube, T1, op_cx_scalar_div_post>& X - ) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - const ProxyCube A(X.m); - - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - const uword n_slices = A.get_n_slices(); - - out.set_size(n_rows, n_cols, n_slices); - - const eT k = X.aux_out_eT; - const uword n_elem = out.n_elem; - eT* out_mem = out.memptr(); - - if(ProxyCube::use_at == false) - { - for(uword i=0; i - struct pos - { - static constexpr uword n2 = row + col*2; - static constexpr uword n3 = row + col*3; - }; - - template - inline static bool apply_direct(typename T1::elem_type& out_val, const Base& expr); - - template - inline static typename T1::elem_type apply_diagmat(const Base& expr); - - template - inline static typename T1::elem_type apply_trimat(const Base& expr); - - template - arma_cold inline static eT apply_tiny_2x2(const Mat& X); - - template - arma_cold inline static eT apply_tiny_3x3(const Mat& X); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_det_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_det_meat.hpp deleted file mode 100644 index a69cd59ab..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_det_meat.hpp +++ /dev/null @@ -1,178 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_det -//! @{ - - - -template -inline -bool -op_det::apply_direct(typename T1::elem_type& out_val, const Base& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - if(strip_diagmat::do_diagmat) - { - const strip_diagmat strip(expr.get_ref()); - - out_val = op_det::apply_diagmat(strip.M); - - return true; - } - - if(strip_trimat::do_trimat) - { - const strip_trimat strip(expr.get_ref()); - - out_val = op_det::apply_trimat(strip.M); - - return true; - } - - Mat A(expr.get_ref()); - - arma_conform_check( (A.is_square() == false), "det(): given matrix must be square sized" ); - - const uword N = A.n_rows; - - if(N == 0) { out_val = eT(1); return true; } - if(N == 1) { out_val = A[0]; return true; } - - if((is_cx::no) && (N <= 3)) - { - constexpr T det_min = std::numeric_limits::epsilon(); - constexpr T det_max = T(1) / std::numeric_limits::epsilon(); - - eT det_val = eT(0); - - if(N == 2) { det_val = op_det::apply_tiny_2x2(A); } - if(N == 3) { det_val = op_det::apply_tiny_3x3(A); } - - const T abs_det_val = std::abs(det_val); - - if((abs_det_val > det_min) && (abs_det_val < det_max)) { out_val = det_val; return true; } - - // fallthrough if det_val is suspect - } - - if(A.is_diagmat()) { out_val = op_det::apply_diagmat(A); return true; } - - const bool is_triu = trimat_helper::is_triu(A); - const bool is_tril = is_triu ? false : trimat_helper::is_tril(A); - - if(is_triu || is_tril) { out_val = op_det::apply_trimat(A); return true; } - - return auxlib::det(out_val, A); - } - - - -template -inline -typename T1::elem_type -op_det::apply_diagmat(const Base& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const diagmat_proxy A(expr.get_ref()); - - arma_conform_check( (A.n_rows != A.n_cols), "det(): given matrix must be square sized" ); - - const uword N = (std::min)(A.n_rows, A.n_cols); - - eT val = eT(1); - - for(uword i=0; i -inline -typename T1::elem_type -op_det::apply_trimat(const Base& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const Proxy P(expr.get_ref()); - - const uword N = P.get_n_rows(); - - arma_conform_check( (N != P.get_n_cols()), "det(): given matrix must be square sized" ); - - eT val = eT(1); - - for(uword i=0; i -inline -eT -op_det::apply_tiny_2x2(const Mat& X) - { - arma_debug_sigprint(); - - const eT* Xm = X.memptr(); - - return ( Xm[pos<0,0>::n2]*Xm[pos<1,1>::n2] - Xm[pos<0,1>::n2]*Xm[pos<1,0>::n2] ); - } - - - -template -inline -eT -op_det::apply_tiny_3x3(const Mat& X) - { - arma_debug_sigprint(); - - const eT* Xm = X.memptr(); - - // const double tmp1 = X.at(0,0) * X.at(1,1) * X.at(2,2); - // const double tmp2 = X.at(0,1) * X.at(1,2) * X.at(2,0); - // const double tmp3 = X.at(0,2) * X.at(1,0) * X.at(2,1); - // const double tmp4 = X.at(2,0) * X.at(1,1) * X.at(0,2); - // const double tmp5 = X.at(2,1) * X.at(1,2) * X.at(0,0); - // const double tmp6 = X.at(2,2) * X.at(1,0) * X.at(0,1); - // return (tmp1+tmp2+tmp3) - (tmp4+tmp5+tmp6); - - const eT val1 = Xm[pos<0,0>::n3]*(Xm[pos<2,2>::n3]*Xm[pos<1,1>::n3] - Xm[pos<2,1>::n3]*Xm[pos<1,2>::n3]); - const eT val2 = Xm[pos<1,0>::n3]*(Xm[pos<2,2>::n3]*Xm[pos<0,1>::n3] - Xm[pos<2,1>::n3]*Xm[pos<0,2>::n3]); - const eT val3 = Xm[pos<2,0>::n3]*(Xm[pos<1,2>::n3]*Xm[pos<0,1>::n3] - Xm[pos<1,1>::n3]*Xm[pos<0,2>::n3]); - - return ( val1 - val2 + val3 ); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_diagmat_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_diagmat_bones.hpp deleted file mode 100644 index 50f7dc7b9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_diagmat_bones.hpp +++ /dev/null @@ -1,61 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_diagmat -//! @{ - - - -class op_diagmat - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& X); - - template - inline static void apply(Mat& out, const Proxy& P); - - template - inline static void apply(Mat& out, const Op< Glue, op_diagmat>& X); - - template - inline static void apply_times(Mat& out, const T1& X, const T2& Y, const typename arma_not_cx::result* junk = nullptr); - - template - inline static void apply_times(Mat& out, const T1& X, const T2& Y, const typename arma_cx_only::result* junk = nullptr); - }; - - - -class op_diagmat2 - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& X); - - template - inline static void apply(Mat& out, const Proxy& P, const uword row_offset, const uword col_offset); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_diagmat_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_diagmat_meat.hpp deleted file mode 100644 index 93f865eae..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_diagmat_meat.hpp +++ /dev/null @@ -1,767 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_diagmat -//! @{ - - - -template -inline -void -op_diagmat::apply(Mat& out, const Op& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(is_Mat::value) - { - // allow detection of in-place operation - - const unwrap U(X.m); - const Mat& A = U.M; - - if(&out != &A) // no aliasing - { - const Proxy< Mat > P(A); - - op_diagmat::apply(out, P); - } - else // we have aliasing - { - const uword n_rows = out.n_rows; - const uword n_cols = out.n_cols; - - if((n_rows == 1) || (n_cols == 1)) // create diagonal matrix from vector - { - const eT* out_mem = out.memptr(); - const uword N = out.n_elem; - - Mat tmp(N,N, arma_zeros_indicator()); - - for(uword i=0; i P(X.m); - - if(P.is_alias(out)) - { - Mat tmp; - - op_diagmat::apply(tmp, P); - - out.steal_mem(tmp); - } - else - { - op_diagmat::apply(out, P); - } - } - } - - - -template -inline -void -op_diagmat::apply(Mat& out, const Proxy& P) - { - arma_debug_sigprint(); - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) { out.reset(); return; } - - const bool P_is_vec = (T1::is_row) || (T1::is_col) || (n_rows == 1) || (n_cols == 1); - - if(P_is_vec) - { - out.zeros(n_elem, n_elem); - - if(Proxy::use_at == false) - { - typename Proxy::ea_type Pea = P.get_ea(); - - for(uword i=0; i < n_elem; ++i) { out.at(i,i) = Pea[i]; } - } - else - { - if(n_rows == 1) - { - for(uword i=0; i < n_elem; ++i) { out.at(i,i) = P.at(0,i); } - } - else - { - for(uword i=0; i < n_elem; ++i) { out.at(i,i) = P.at(i,0); } - } - } - } - else // P represents a matrix - { - out.zeros(n_rows, n_cols); - - const uword N = (std::min)(n_rows, n_cols); - - for(uword i=0; i -inline -void -op_diagmat::apply(Mat& out, const Op< Glue, op_diagmat>& X) - { - arma_debug_sigprint(); - - op_diagmat::apply_times(out, X.m.A, X.m.B); - } - - - -template -inline -void -op_diagmat::apply_times(Mat& actual_out, const T1& X, const T2& Y, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - - const partial_unwrap UA(X); - const partial_unwrap UB(Y); - - const typename partial_unwrap::stored_type& A = UA.M; - const typename partial_unwrap::stored_type& B = UB.M; - - arma_conform_assert_trans_mul_size< partial_unwrap::do_trans, partial_unwrap::do_trans >(A.n_rows, A.n_cols, B.n_rows, B.n_cols, "matrix multiplication"); - - constexpr bool use_alpha = partial_unwrap::do_times || partial_unwrap::do_times; - const eT alpha = use_alpha ? (UA.get_val() * UB.get_val()) : eT(0); - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - // check if the multiplication results in a vector - - if( (partial_unwrap::do_trans == false) && (partial_unwrap::do_trans == false) ) - { - if((A_n_rows == 1) || (B_n_cols == 1)) - { - arma_debug_print("trans_A = false; trans_B = false; vector result"); - - const Mat C = A*B; - const eT* C_mem = C.memptr(); - const uword N = C.n_elem; - - actual_out.zeros(N,N); - - for(uword i=0; i::do_trans == true ) && (partial_unwrap::do_trans == false) ) - { - if((A_n_cols == 1) || (B_n_cols == 1)) - { - arma_debug_print("trans_A = true; trans_B = false; vector result"); - - const Mat C = trans(A)*B; - const eT* C_mem = C.memptr(); - const uword N = C.n_elem; - - actual_out.zeros(N,N); - - for(uword i=0; i::do_trans == false) && (partial_unwrap::do_trans == true ) ) - { - if((A_n_rows == 1) || (B_n_rows == 1)) - { - arma_debug_print("trans_A = false; trans_B = true; vector result"); - - const Mat C = A*trans(B); - const eT* C_mem = C.memptr(); - const uword N = C.n_elem; - - actual_out.zeros(N,N); - - for(uword i=0; i::do_trans == true ) && (partial_unwrap::do_trans == true ) ) - { - if((A_n_cols == 1) || (B_n_rows == 1)) - { - arma_debug_print("trans_A = true; trans_B = true; vector result"); - - const Mat C = trans(A)*trans(B); - const eT* C_mem = C.memptr(); - const uword N = C.n_elem; - - actual_out.zeros(N,N); - - for(uword i=0; i tmp; - Mat& out = (is_alias) ? tmp : actual_out; - - if( (partial_unwrap::do_trans == false) && (partial_unwrap::do_trans == false) ) - { - arma_debug_print("trans_A = false; trans_B = false; matrix result"); - - out.zeros(A_n_rows, B_n_cols); - - const uword N = (std::min)(A_n_rows, B_n_cols); - - for(uword k=0; k < N; ++k) - { - eT acc1 = eT(0); - eT acc2 = eT(0); - - const eT* B_colptr = B.colptr(k); - - // condition: A_n_cols = B_n_rows - - uword j; - - for(j=1; j < A_n_cols; j+=2) - { - const uword i = (j-1); - - const eT tmp_i = B_colptr[i]; - const eT tmp_j = B_colptr[j]; - - acc1 += A.at(k, i) * tmp_i; - acc2 += A.at(k, j) * tmp_j; - } - - const uword i = (j-1); - - if(i < A_n_cols) - { - acc1 += A.at(k, i) * B_colptr[i]; - } - - const eT acc = acc1 + acc2; - - out.at(k,k) = (use_alpha) ? eT(alpha * acc) : eT(acc); - } - } - else - if( (partial_unwrap::do_trans == true ) && (partial_unwrap::do_trans == false) ) - { - arma_debug_print("trans_A = true; trans_B = false; matrix result"); - - out.zeros(A_n_cols, B_n_cols); - - const uword N = (std::min)(A_n_cols, B_n_cols); - - for(uword k=0; k < N; ++k) - { - const eT* A_colptr = A.colptr(k); - const eT* B_colptr = B.colptr(k); - - // condition: A_n_rows = B_n_rows - - const eT acc = op_dot::direct_dot(A_n_rows, A_colptr, B_colptr); - - out.at(k,k) = (use_alpha) ? eT(alpha * acc) : eT(acc); - } - } - else - if( (partial_unwrap::do_trans == false) && (partial_unwrap::do_trans == true ) ) - { - arma_debug_print("trans_A = false; trans_B = true; matrix result"); - - out.zeros(A_n_rows, B_n_rows); - - const uword N = (std::min)(A_n_rows, B_n_rows); - - for(uword k=0; k < N; ++k) - { - eT acc = eT(0); - - // condition: A_n_cols = B_n_cols - - for(uword i=0; i < A_n_cols; ++i) - { - acc += A.at(k,i) * B.at(k,i); - } - - out.at(k,k) = (use_alpha) ? eT(alpha * acc) : eT(acc); - } - } - else - if( (partial_unwrap::do_trans == true ) && (partial_unwrap::do_trans == true ) ) - { - arma_debug_print("trans_A = true; trans_B = true; matrix result"); - - out.zeros(A_n_cols, B_n_rows); - - const uword N = (std::min)(A_n_cols, B_n_rows); - - for(uword k=0; k < N; ++k) - { - eT acc = eT(0); - - const eT* A_colptr = A.colptr(k); - - // condition: A_n_rows = B_n_cols - - for(uword i=0; i < A_n_rows; ++i) - { - acc += A_colptr[i] * B.at(k,i); - } - - out.at(k,k) = (use_alpha) ? eT(alpha * acc) : eT(acc); - } - } - - if(is_alias) { actual_out.steal_mem(tmp); } - } - - - -template -inline -void -op_diagmat::apply_times(Mat& actual_out, const T1& X, const T2& Y, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::pod_type T; - typedef typename T1::elem_type eT; - - const partial_unwrap UA(X); - const partial_unwrap UB(Y); - - const typename partial_unwrap::stored_type& A = UA.M; - const typename partial_unwrap::stored_type& B = UB.M; - - arma_conform_assert_trans_mul_size< partial_unwrap::do_trans, partial_unwrap::do_trans >(A.n_rows, A.n_cols, B.n_rows, B.n_cols, "matrix multiplication"); - - constexpr bool use_alpha = partial_unwrap::do_times || partial_unwrap::do_times; - const eT alpha = use_alpha ? (UA.get_val() * UB.get_val()) : eT(0); - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - // check if the multiplication results in a vector - - if( (partial_unwrap::do_trans == false) && (partial_unwrap::do_trans == false) ) - { - if((A_n_rows == 1) || (B_n_cols == 1)) - { - arma_debug_print("trans_A = false; trans_B = false; vector result"); - - const Mat C = A*B; - const eT* C_mem = C.memptr(); - const uword N = C.n_elem; - - actual_out.zeros(N,N); - - for(uword i=0; i::do_trans == true ) && (partial_unwrap::do_trans == false) ) - { - if((A_n_cols == 1) || (B_n_cols == 1)) - { - arma_debug_print("trans_A = true; trans_B = false; vector result"); - - const Mat C = trans(A)*B; - const eT* C_mem = C.memptr(); - const uword N = C.n_elem; - - actual_out.zeros(N,N); - - for(uword i=0; i::do_trans == false) && (partial_unwrap::do_trans == true ) ) - { - if((A_n_rows == 1) || (B_n_rows == 1)) - { - arma_debug_print("trans_A = false; trans_B = true; vector result"); - - const Mat C = A*trans(B); - const eT* C_mem = C.memptr(); - const uword N = C.n_elem; - - actual_out.zeros(N,N); - - for(uword i=0; i::do_trans == true ) && (partial_unwrap::do_trans == true ) ) - { - if((A_n_cols == 1) || (B_n_rows == 1)) - { - arma_debug_print("trans_A = true; trans_B = true; vector result"); - - const Mat C = trans(A)*trans(B); - const eT* C_mem = C.memptr(); - const uword N = C.n_elem; - - actual_out.zeros(N,N); - - for(uword i=0; i tmp; - Mat& out = (is_alias) ? tmp : actual_out; - - if( (partial_unwrap::do_trans == false) && (partial_unwrap::do_trans == false) ) - { - arma_debug_print("trans_A = false; trans_B = false; matrix result"); - - out.zeros(A_n_rows, B_n_cols); - - const uword N = (std::min)(A_n_rows, B_n_cols); - - for(uword k=0; k < N; ++k) - { - T acc_real = T(0); - T acc_imag = T(0); - - const eT* B_colptr = B.colptr(k); - - // condition: A_n_cols = B_n_rows - - for(uword i=0; i < A_n_cols; ++i) - { - // acc += A.at(k, i) * B_colptr[i]; - - const std::complex& xx = A.at(k, i); - const std::complex& yy = B_colptr[i]; - - const T a = xx.real(); - const T b = xx.imag(); - - const T c = yy.real(); - const T d = yy.imag(); - - acc_real += (a*c) - (b*d); - acc_imag += (a*d) + (b*c); - } - - const eT acc = std::complex(acc_real, acc_imag); - - out.at(k,k) = (use_alpha) ? eT(alpha * acc) : eT(acc); - } - } - else - if( (partial_unwrap::do_trans == true) && (partial_unwrap::do_trans == false) ) - { - arma_debug_print("trans_A = true; trans_B = false; matrix result"); - - out.zeros(A_n_cols, B_n_cols); - - const uword N = (std::min)(A_n_cols, B_n_cols); - - for(uword k=0; k < N; ++k) - { - T acc_real = T(0); - T acc_imag = T(0); - - const eT* A_colptr = A.colptr(k); - const eT* B_colptr = B.colptr(k); - - // condition: A_n_rows = B_n_rows - - for(uword i=0; i < A_n_rows; ++i) - { - // acc += std::conj(A_colptr[i]) * B_colptr[i]; - - const std::complex& xx = A_colptr[i]; - const std::complex& yy = B_colptr[i]; - - const T a = xx.real(); - const T b = xx.imag(); - - const T c = yy.real(); - const T d = yy.imag(); - - // take into account the complex conjugate of xx - - acc_real += (a*c) + (b*d); - acc_imag += (a*d) - (b*c); - } - - const eT acc = std::complex(acc_real, acc_imag); - - out.at(k,k) = (use_alpha) ? eT(alpha * acc) : eT(acc); - } - } - else - if( (partial_unwrap::do_trans == false) && (partial_unwrap::do_trans == true) ) - { - arma_debug_print("trans_A = false; trans_B = true; matrix result"); - - out.zeros(A_n_rows, B_n_rows); - - const uword N = (std::min)(A_n_rows, B_n_rows); - - for(uword k=0; k < N; ++k) - { - T acc_real = T(0); - T acc_imag = T(0); - - // condition: A_n_cols = B_n_cols - - for(uword i=0; i < A_n_cols; ++i) - { - // acc += A.at(k,i) * std::conj(B.at(k,i)); - - const std::complex& xx = A.at(k, i); - const std::complex& yy = B.at(k, i); - - const T a = xx.real(); - const T b = xx.imag(); - - const T c = yy.real(); - const T d = -yy.imag(); // take the conjugate - - acc_real += (a*c) - (b*d); - acc_imag += (a*d) + (b*c); - } - - const eT acc = std::complex(acc_real, acc_imag); - - out.at(k,k) = (use_alpha) ? eT(alpha * acc) : eT(acc); - } - } - else - if( (partial_unwrap::do_trans == true) && (partial_unwrap::do_trans == true) ) - { - arma_debug_print("trans_A = true; trans_B = true; matrix result"); - - out.zeros(A_n_cols, B_n_rows); - - const uword N = (std::min)(A_n_cols, B_n_rows); - - for(uword k=0; k < N; ++k) - { - T acc_real = T(0); - T acc_imag = T(0); - - const eT* A_colptr = A.colptr(k); - - // condition: A_n_rows = B_n_cols - - for(uword i=0; i < A_n_rows; ++i) - { - // acc += std::conj(A_colptr[i]) * std::conj(B.at(k,i)); - - const std::complex& xx = A_colptr[i]; - const std::complex& yy = B.at(k, i); - - const T a = xx.real(); - const T b = -xx.imag(); // take the conjugate - - const T c = yy.real(); - const T d = -yy.imag(); // take the conjugate - - acc_real += (a*c) - (b*d); - acc_imag += (a*d) + (b*c); - } - - const eT acc = std::complex(acc_real, acc_imag); - - out.at(k,k) = (use_alpha) ? eT(alpha * acc) : eT(acc); - } - } - - if(is_alias) { actual_out.steal_mem(tmp); } - } - - - -// -// -// - - - -template -inline -void -op_diagmat2::apply(Mat& out, const Op& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword row_offset = X.aux_uword_a; - const uword col_offset = X.aux_uword_b; - - const Proxy P(X.m); - - if(P.is_alias(out)) - { - Mat tmp; - - op_diagmat2::apply(tmp, P, row_offset, col_offset); - - out.steal_mem(tmp); - } - else - { - op_diagmat2::apply(out, P, row_offset, col_offset); - } - } - - - -template -inline -void -op_diagmat2::apply(Mat& out, const Proxy& P, const uword row_offset, const uword col_offset) - { - arma_debug_sigprint(); - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) { out.reset(); return; } - - const bool P_is_vec = (T1::is_row) || (T1::is_col) || (n_rows == 1) || (n_cols == 1); - - if(P_is_vec) - { - const uword n_pad = (std::max)(row_offset, col_offset); - - out.zeros(n_elem + n_pad, n_elem + n_pad); - - if(Proxy::use_at == false) - { - typename Proxy::ea_type Pea = P.get_ea(); - - for(uword i=0; i < n_elem; ++i) { out.at(row_offset + i, col_offset + i) = Pea[i]; } - } - else - { - if(n_rows == 1) - { - for(uword i=0; i < n_elem; ++i) { out.at(row_offset + i, col_offset + i) = P.at(0,i); } - } - else - { - for(uword i=0; i < n_elem; ++i) { out.at(row_offset + i, col_offset + i) = P.at(i,0); } - } - } - } - else // P represents a matrix - { - arma_conform_check_bounds - ( - ((row_offset > 0) && (row_offset >= n_rows)) || ((col_offset > 0) && (col_offset >= n_cols)), - "diagmat(): requested diagonal out of bounds" - ); - - out.zeros(n_rows, n_cols); - - const uword N = (std::min)(n_rows - row_offset, n_cols - col_offset); - - for(uword i=0; i - inline static void apply(Mat& out, const Op& X); - - template - inline static void apply_proxy(Mat& out, const Proxy& P); - - template - inline static void apply(Mat& out, const Op< Glue, op_diagvec>& X, const typename arma_not_cx::result* junk = nullptr); - - template - inline static void apply(Mat& out, const Op< Glue, op_diagvec>& X, const typename arma_cx_only::result* junk = nullptr); - }; - - - -class op_diagvec2 - : public traits_op_col - { - public: - - template - inline static void apply(Mat& out, const Op& X); - - template - inline static void apply_proxy(Mat& out, const Proxy& P, const uword row_offset, const uword col_offset); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_diagvec_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_diagvec_meat.hpp deleted file mode 100644 index 5312e55a0..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_diagvec_meat.hpp +++ /dev/null @@ -1,536 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_diagvec -//! @{ - - - -template -inline -void -op_diagvec::apply(Mat& out, const Op& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const Proxy P(X.m); - - if(P.is_alias(out) == false) - { - op_diagvec::apply_proxy(out, P); - } - else - { - Mat tmp; - - op_diagvec::apply_proxy(tmp, P); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -op_diagvec::apply_proxy(Mat& out, const Proxy& P) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - const uword len = (std::min)(n_rows, n_cols); - - out.set_size(len, 1); - - eT* out_mem = out.memptr(); - - uword i,j; - for(i=0, j=1; j < len; i+=2, j+=2) - { - const eT tmp_i = P.at(i, i); - const eT tmp_j = P.at(j, j); - - out_mem[i] = tmp_i; - out_mem[j] = tmp_j; - } - - if(i < len) - { - out_mem[i] = P.at(i, i); - } - } - - - -template -inline -void -op_diagvec::apply(Mat& actual_out, const Op< Glue, op_diagvec>& X, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - - const partial_unwrap UA(X.m.A); - const partial_unwrap UB(X.m.B); - - const typename partial_unwrap::stored_type& A = UA.M; - const typename partial_unwrap::stored_type& B = UB.M; - - arma_conform_assert_trans_mul_size< partial_unwrap::do_trans, partial_unwrap::do_trans >(A.n_rows, A.n_cols, B.n_rows, B.n_cols, "matrix multiplication"); - - if( (A.n_elem == 0) || (B.n_elem == 0) ) { actual_out.reset(); return; } - - constexpr bool use_alpha = partial_unwrap::do_times || partial_unwrap::do_times; - const eT alpha = use_alpha ? (UA.get_val() * UB.get_val()) : eT(0); - - const bool is_alias = (UA.is_alias(actual_out) || UB.is_alias(actual_out)); - - Mat tmp; - Mat& out = (is_alias) ? tmp : actual_out; - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - if( (partial_unwrap::do_trans == false) && (partial_unwrap::do_trans == false) ) - { - arma_debug_print("trans_A = false; trans_B = false;"); - - const uword N = (std::min)(A_n_rows, B_n_cols); - - out.set_size(N,1); - - eT* out_mem = out.memptr(); - - for(uword k=0; k < N; ++k) - { - eT acc1 = eT(0); - eT acc2 = eT(0); - - const eT* B_colptr = B.colptr(k); - - // condition: A_n_cols = B_n_rows - - uword j; - - for(j=1; j < A_n_cols; j+=2) - { - const uword i = (j-1); - - const eT tmp_i = B_colptr[i]; - const eT tmp_j = B_colptr[j]; - - acc1 += A.at(k, i) * tmp_i; - acc2 += A.at(k, j) * tmp_j; - } - - const uword i = (j-1); - - if(i < A_n_cols) - { - acc1 += A.at(k, i) * B_colptr[i]; - } - - const eT acc = acc1 + acc2; - - out_mem[k] = (use_alpha) ? eT(alpha * acc) : eT(acc); - } - } - else - if( (partial_unwrap::do_trans == true ) && (partial_unwrap::do_trans == false) ) - { - arma_debug_print("trans_A = true; trans_B = false;"); - - const uword N = (std::min)(A_n_cols, B_n_cols); - - out.set_size(N,1); - - eT* out_mem = out.memptr(); - - for(uword k=0; k < N; ++k) - { - const eT* A_colptr = A.colptr(k); - const eT* B_colptr = B.colptr(k); - - // condition: A_n_rows = B_n_rows - - const eT acc = op_dot::direct_dot(A_n_rows, A_colptr, B_colptr); - - out_mem[k] = (use_alpha) ? eT(alpha * acc) : eT(acc); - } - } - else - if( (partial_unwrap::do_trans == false) && (partial_unwrap::do_trans == true ) ) - { - arma_debug_print("trans_A = false; trans_B = true;"); - - const uword N = (std::min)(A_n_rows, B_n_rows); - - out.set_size(N,1); - - eT* out_mem = out.memptr(); - - for(uword k=0; k < N; ++k) - { - eT acc = eT(0); - - // condition: A_n_cols = B_n_cols - - for(uword i=0; i < A_n_cols; ++i) - { - acc += A.at(k,i) * B.at(k,i); - } - - out_mem[k] = (use_alpha) ? eT(alpha * acc) : eT(acc); - } - } - else - if( (partial_unwrap::do_trans == true ) && (partial_unwrap::do_trans == true ) ) - { - arma_debug_print("trans_A = true; trans_B = true;"); - - const uword N = (std::min)(A_n_cols, B_n_rows); - - out.set_size(N,1); - - eT* out_mem = out.memptr(); - - for(uword k=0; k < N; ++k) - { - eT acc = eT(0); - - const eT* A_colptr = A.colptr(k); - - // condition: A_n_rows = B_n_cols - - for(uword i=0; i < A_n_rows; ++i) - { - acc += A_colptr[i] * B.at(k,i); - } - - out_mem[k] = (use_alpha) ? eT(alpha * acc) : eT(acc); - } - } - - if(is_alias) { actual_out.steal_mem(tmp); } - } - - - -template -inline -void -op_diagvec::apply(Mat& actual_out, const Op< Glue, op_diagvec>& X, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::pod_type T; - typedef typename T1::elem_type eT; - - const partial_unwrap UA(X.m.A); - const partial_unwrap UB(X.m.B); - - const typename partial_unwrap::stored_type& A = UA.M; - const typename partial_unwrap::stored_type& B = UB.M; - - arma_conform_assert_trans_mul_size< partial_unwrap::do_trans, partial_unwrap::do_trans >(A.n_rows, A.n_cols, B.n_rows, B.n_cols, "matrix multiplication"); - - if( (A.n_elem == 0) || (B.n_elem == 0) ) { actual_out.reset(); return; } - - constexpr bool use_alpha = partial_unwrap::do_times || partial_unwrap::do_times; - const eT alpha = use_alpha ? (UA.get_val() * UB.get_val()) : eT(0); - - const bool is_alias = (UA.is_alias(actual_out) || UB.is_alias(actual_out)); - - Mat tmp; - Mat& out = (is_alias) ? tmp : actual_out; - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - if( (partial_unwrap::do_trans == false) && (partial_unwrap::do_trans == false) ) - { - arma_debug_print("trans_A = false; trans_B = false;"); - - const uword N = (std::min)(A_n_rows, B_n_cols); - - out.set_size(N,1); - - eT* out_mem = out.memptr(); - - for(uword k=0; k < N; ++k) - { - T acc_real = T(0); - T acc_imag = T(0); - - const eT* B_colptr = B.colptr(k); - - // condition: A_n_cols = B_n_rows - - for(uword i=0; i < A_n_cols; ++i) - { - // acc += A.at(k, i) * B_colptr[i]; - - const std::complex& xx = A.at(k, i); - const std::complex& yy = B_colptr[i]; - - const T a = xx.real(); - const T b = xx.imag(); - - const T c = yy.real(); - const T d = yy.imag(); - - acc_real += (a*c) - (b*d); - acc_imag += (a*d) + (b*c); - } - - const eT acc = std::complex(acc_real, acc_imag); - - out_mem[k] = (use_alpha) ? eT(alpha * acc) : eT(acc); - } - } - else - if( (partial_unwrap::do_trans == true) && (partial_unwrap::do_trans == false) ) - { - arma_debug_print("trans_A = true; trans_B = false;"); - - const uword N = (std::min)(A_n_cols, B_n_cols); - - out.set_size(N,1); - - eT* out_mem = out.memptr(); - - for(uword k=0; k < N; ++k) - { - T acc_real = T(0); - T acc_imag = T(0); - - const eT* A_colptr = A.colptr(k); - const eT* B_colptr = B.colptr(k); - - // condition: A_n_rows = B_n_rows - - for(uword i=0; i < A_n_rows; ++i) - { - // acc += std::conj(A_colptr[i]) * B_colptr[i]; - - const std::complex& xx = A_colptr[i]; - const std::complex& yy = B_colptr[i]; - - const T a = xx.real(); - const T b = xx.imag(); - - const T c = yy.real(); - const T d = yy.imag(); - - // take into account the complex conjugate of xx - - acc_real += (a*c) + (b*d); - acc_imag += (a*d) - (b*c); - } - - const eT acc = std::complex(acc_real, acc_imag); - - out_mem[k] = (use_alpha) ? eT(alpha * acc) : eT(acc); - } - } - else - if( (partial_unwrap::do_trans == false) && (partial_unwrap::do_trans == true) ) - { - arma_debug_print("trans_A = false; trans_B = true;"); - - const uword N = (std::min)(A_n_rows, B_n_rows); - - out.set_size(N,1); - - eT* out_mem = out.memptr(); - - for(uword k=0; k < N; ++k) - { - T acc_real = T(0); - T acc_imag = T(0); - - // condition: A_n_cols = B_n_cols - - for(uword i=0; i < A_n_cols; ++i) - { - // acc += A.at(k,i) * std::conj(B.at(k,i)); - - const std::complex& xx = A.at(k, i); - const std::complex& yy = B.at(k, i); - - const T a = xx.real(); - const T b = xx.imag(); - - const T c = yy.real(); - const T d = -yy.imag(); // take the conjugate - - acc_real += (a*c) - (b*d); - acc_imag += (a*d) + (b*c); - } - - const eT acc = std::complex(acc_real, acc_imag); - - out_mem[k] = (use_alpha) ? eT(alpha * acc) : eT(acc); - } - } - else - if( (partial_unwrap::do_trans == true) && (partial_unwrap::do_trans == true) ) - { - arma_debug_print("trans_A = true; trans_B = true;"); - - const uword N = (std::min)(A_n_cols, B_n_rows); - - out.set_size(N,1); - - eT* out_mem = out.memptr(); - - for(uword k=0; k < N; ++k) - { - T acc_real = T(0); - T acc_imag = T(0); - - const eT* A_colptr = A.colptr(k); - - // condition: A_n_rows = B_n_cols - - for(uword i=0; i < A_n_rows; ++i) - { - // acc += std::conj(A_colptr[i]) * std::conj(B.at(k,i)); - - const std::complex& xx = A_colptr[i]; - const std::complex& yy = B.at(k, i); - - const T a = xx.real(); - const T b = -xx.imag(); // take the conjugate - - const T c = yy.real(); - const T d = -yy.imag(); // take the conjugate - - acc_real += (a*c) - (b*d); - acc_imag += (a*d) + (b*c); - } - - const eT acc = std::complex(acc_real, acc_imag); - - out_mem[k] = (use_alpha) ? eT(alpha * acc) : eT(acc); - } - } - - if(is_alias) { actual_out.steal_mem(tmp); } - } - - - -// -// -// - - - -template -inline -void -op_diagvec2::apply(Mat& out, const Op& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword a = X.aux_uword_a; - const uword b = X.aux_uword_b; - - const uword row_offset = (b > 0) ? a : 0; - const uword col_offset = (b == 0) ? a : 0; - - const Proxy P(X.m); - - if(P.is_alias(out) == false) - { - op_diagvec2::apply_proxy(out, P, row_offset, col_offset); - } - else - { - Mat tmp; - - op_diagvec2::apply_proxy(tmp, P, row_offset, col_offset); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -op_diagvec2::apply_proxy(Mat& out, const Proxy& P, const uword row_offset, const uword col_offset) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - arma_conform_check_bounds - ( - ((row_offset > 0) && (row_offset >= n_rows)) || ((col_offset > 0) && (col_offset >= n_cols)), - "diagvec(): requested diagonal is out of bounds" - ); - - const uword len = (std::min)(n_rows - row_offset, n_cols - col_offset); - - out.set_size(len, 1); - - eT* out_mem = out.memptr(); - - uword i,j; - for(i=0, j=1; j < len; i+=2, j+=2) - { - const eT tmp_i = P.at( i + row_offset, i + col_offset ); - const eT tmp_j = P.at( j + row_offset, j + col_offset ); - - out_mem[i] = tmp_i; - out_mem[j] = tmp_j; - } - - if(i < len) - { - out_mem[i] = P.at( i + row_offset, i + col_offset ); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_diff_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_diff_bones.hpp deleted file mode 100644 index a6844abc2..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_diff_bones.hpp +++ /dev/null @@ -1,49 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_diff -//! @{ - - - -class op_diff - : public traits_op_default - { - public: - - template - inline static void apply_noalias(Mat& out, const Mat& X, const uword k, const uword dim); - - template - inline static void apply(Mat& out, const Op& in); - }; - - - -class op_diff_vec - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const Op& in); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_diff_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_diff_meat.hpp deleted file mode 100644 index 8baff88b3..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_diff_meat.hpp +++ /dev/null @@ -1,224 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_diff -//! @{ - - -template -inline -void -op_diff::apply_noalias(Mat& out, const Mat& X, const uword k, const uword dim) - { - arma_debug_sigprint(); - - uword n_rows = X.n_rows; - uword n_cols = X.n_cols; - - if(dim == 0) - { - if(n_rows <= k) { out.set_size(0,n_cols); return; } - - --n_rows; - - out.set_size(n_rows,n_cols); - - for(uword col=0; col < n_cols; ++col) - { - eT* out_colmem = out.colptr(col); - const eT* X_colmem = X.colptr(col); - - for(uword row=0; row < n_rows; ++row) - { - const eT val0 = X_colmem[row ]; - const eT val1 = X_colmem[row+1]; - - out_colmem[row] = val1 - val0; - } - } - - if(k >= 2) - { - for(uword iter=2; iter <= k; ++iter) - { - --n_rows; - - for(uword col=0; col < n_cols; ++col) - { - eT* colmem = out.colptr(col); - - for(uword row=0; row < n_rows; ++row) - { - const eT val0 = colmem[row ]; - const eT val1 = colmem[row+1]; - - colmem[row] = val1 - val0; - } - } - } - - out = out( span(0,n_rows-1), span::all ); - } - } - else - if(dim == 1) - { - if(n_cols <= k) { out.set_size(n_rows,0); return; } - - --n_cols; - - out.set_size(n_rows,n_cols); - - if(n_rows == 1) - { - const eT* X_mem = X.memptr(); - eT* out_mem = out.memptr(); - - for(uword col=0; col < n_cols; ++col) - { - const eT val0 = X_mem[col ]; - const eT val1 = X_mem[col+1]; - - out_mem[col] = val1 - val0; - } - } - else - { - for(uword col=0; col < n_cols; ++col) - { - eT* out_col_mem = out.colptr(col); - - const eT* X_col0_mem = X.colptr(col ); - const eT* X_col1_mem = X.colptr(col+1); - - for(uword row=0; row < n_rows; ++row) - { - out_col_mem[row] = X_col1_mem[row] - X_col0_mem[row]; - } - } - } - - if(k >= 2) - { - for(uword iter=2; iter <= k; ++iter) - { - --n_cols; - - if(n_rows == 1) - { - eT* out_mem = out.memptr(); - - for(uword col=0; col < n_cols; ++col) - { - const eT val0 = out_mem[col ]; - const eT val1 = out_mem[col+1]; - - out_mem[col] = val1 - val0; - } - } - else - { - for(uword col=0; col < n_cols; ++col) - { - eT* col0_mem = out.colptr(col ); - const eT* col1_mem = out.colptr(col+1); - - for(uword row=0; row < n_rows; ++row) - { - col0_mem[row] = col1_mem[row] - col0_mem[row]; - } - } - } - } - - out = out( span::all, span(0,n_cols-1) ); - } - } - } - - - -template -inline -void -op_diff::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword k = in.aux_uword_a; - const uword dim = in.aux_uword_b; - - arma_conform_check( (dim > 1), "diff(): parameter 'dim' must be 0 or 1" ); - - if(k == 0) { out = in.m; return; } - - const quasi_unwrap U(in.m); - - if(U.is_alias(out)) - { - Mat tmp; - - op_diff::apply_noalias(tmp, U.M, k, dim); - - out.steal_mem(tmp); - } - else - { - op_diff::apply_noalias(out, U.M, k, dim); - } - } - - - -template -inline -void -op_diff_vec::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword k = in.aux_uword_a; - - if(k == 0) { out = in.m; return; } - - const quasi_unwrap U(in.m); - - const uword dim = (T1::is_xvec) ? uword(U.M.is_rowvec() ? 1 : 0) : uword((T1::is_row) ? 1 : 0); - - if(U.is_alias(out)) - { - Mat tmp; - - op_diff::apply_noalias(tmp, U.M, k, dim); - - out.steal_mem(tmp); - } - else - { - op_diff::apply_noalias(out, U.M, k, dim); - } - } - - - -//! @} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_dot_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_dot_bones.hpp deleted file mode 100644 index d4b0674be..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_dot_bones.hpp +++ /dev/null @@ -1,121 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_dot -//! @{ - -//! \brief -//! dot product operation - -class op_dot - : public traits_op_default - { - public: - - template - arma_inline static - typename arma_not_cx::result - direct_dot_arma(const uword n_elem, const eT* const A, const eT* const B); - - template - arma_hot inline static - typename arma_cx_only::result - direct_dot_arma(const uword n_elem, const eT* const A, const eT* const B); - - template - arma_hot inline static typename arma_real_only::result - direct_dot(const uword n_elem, const eT* const A, const eT* const B); - - template - arma_hot inline static typename arma_cx_only::result - direct_dot(const uword n_elem, const eT* const A, const eT* const B); - - template - arma_hot inline static typename arma_integral_only::result - direct_dot(const uword n_elem, const eT* const A, const eT* const B); - - - template - arma_hot inline static eT direct_dot(const uword n_elem, const eT* const A, const eT* const B, const eT* C); - - template - arma_hot inline static typename T1::elem_type apply(const T1& X, const T2& Y); - - template - arma_hot inline static typename arma_not_cx::result apply_proxy_linear(const Proxy& PA, const Proxy& PB); - - template - arma_hot inline static typename arma_cx_only::result apply_proxy_linear(const Proxy& PA, const Proxy& PB); - }; - - - -//! \brief -//! normalised dot product operation - -class op_norm_dot - : public traits_op_default - { - public: - - template - arma_hot inline static typename T1::elem_type apply(const T1& X, const T2& Y); - }; - - - -//! \brief -//! complex conjugate dot product operation - -class op_cdot - : public traits_op_default - { - public: - - template - arma_hot inline static eT direct_cdot_arma(const uword n_elem, const eT* const A, const eT* const B); - - template - arma_hot inline static eT direct_cdot(const uword n_elem, const eT* const A, const eT* const B); - - template - arma_hot inline static typename T1::elem_type apply (const T1& X, const T2& Y); - - template - arma_hot inline static typename T1::elem_type apply_unwrap(const T1& X, const T2& Y); - - template - arma_hot inline static typename T1::elem_type apply_proxy (const T1& X, const T2& Y); - }; - - - -class op_dot_mixed - : public traits_op_default - { - public: - - template - arma_hot inline static - typename promote_type::result - apply(const T1& A, const T2& B); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_dot_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_dot_meat.hpp deleted file mode 100644 index e4ed53e8e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_dot_meat.hpp +++ /dev/null @@ -1,630 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_dot -//! @{ - - - -//! for two arrays, generic version for non-complex values -template -arma_inline -typename arma_not_cx::result -op_dot::direct_dot_arma(const uword n_elem, const eT* const A, const eT* const B) - { - arma_debug_sigprint(); - - #if defined(__FAST_MATH__) - { - eT val = eT(0); - - for(uword i=0; i -inline -typename arma_cx_only::result -op_dot::direct_dot_arma(const uword n_elem, const eT* const A, const eT* const B) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - T val_real = T(0); - T val_imag = T(0); - - for(uword i=0; i& X = A[i]; - const std::complex& Y = B[i]; - - const T a = X.real(); - const T b = X.imag(); - - const T c = Y.real(); - const T d = Y.imag(); - - val_real += (a*c) - (b*d); - val_imag += (a*d) + (b*c); - } - - return std::complex(val_real, val_imag); - } - - - -//! for two arrays, float and double version -template -inline -typename arma_real_only::result -op_dot::direct_dot(const uword n_elem, const eT* const A, const eT* const B) - { - arma_debug_sigprint(); - - if( n_elem <= 32u ) - { - return op_dot::direct_dot_arma(n_elem, A, B); - } - else - { - #if defined(ARMA_USE_ATLAS) - { - arma_debug_print("atlas::cblas_dot()"); - - return atlas::cblas_dot(n_elem, A, B); - } - #elif defined(ARMA_USE_BLAS) - { - arma_debug_print("blas::dot()"); - - return blas::dot(n_elem, A, B); - } - #else - { - return op_dot::direct_dot_arma(n_elem, A, B); - } - #endif - } - } - - - -//! for two arrays, complex version -template -inline -typename arma_cx_only::result -op_dot::direct_dot(const uword n_elem, const eT* const A, const eT* const B) - { - if( n_elem <= 16u ) - { - return op_dot::direct_dot_arma(n_elem, A, B); - } - else - { - #if defined(ARMA_USE_ATLAS) - { - arma_debug_print("atlas::cblas_cx_dot()"); - - return atlas::cblas_cx_dot(n_elem, A, B); - } - #elif defined(ARMA_USE_BLAS) - { - arma_debug_print("blas::dot()"); - - return blas::dot(n_elem, A, B); - } - #else - { - return op_dot::direct_dot_arma(n_elem, A, B); - } - #endif - } - } - - - -//! for two arrays, integral version -template -inline -typename arma_integral_only::result -op_dot::direct_dot(const uword n_elem, const eT* const A, const eT* const B) - { - return op_dot::direct_dot_arma(n_elem, A, B); - } - - - - -//! for three arrays -template -inline -eT -op_dot::direct_dot(const uword n_elem, const eT* const A, const eT* const B, const eT* C) - { - arma_debug_sigprint(); - - eT val = eT(0); - - for(uword i=0; i -inline -typename T1::elem_type -op_dot::apply(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(is_subview_row::value && is_subview_row::value) - { - const subview_row& A = reinterpret_cast< const subview_row& >(X); - const subview_row& B = reinterpret_cast< const subview_row& >(Y); - - if( (A.m.n_rows == 1) && (B.m.n_rows == 1) ) - { - arma_debug_print("op_dot::apply(): subview_row optimisation"); - - arma_conform_check( (A.n_elem != B.n_elem), "dot(): objects must have the same number of elements" ); - - const eT* A_mem = A.m.memptr(); - const eT* B_mem = B.m.memptr(); - - return op_dot::direct_dot(A.n_elem, &A_mem[A.aux_col1], &B_mem[B.aux_col1]); - } - } - - if(is_subview::value || is_subview::value) - { - arma_debug_print("op_dot::apply(): subview optimisation"); - - const sv_keep_unwrap& UA(X); - const sv_keep_unwrap& UB(Y); - - typedef typename sv_keep_unwrap::stored_type UA_M_type; - typedef typename sv_keep_unwrap::stored_type UB_M_type; - - const UA_M_type& A = UA.M; - const UB_M_type& B = UB.M; - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - if( (A_n_rows == B.n_rows) && (A_n_cols == B.n_cols) ) - { - eT acc = eT(0); - - for(uword c=0; c < A_n_cols; ++c) { acc += op_dot::direct_dot(A_n_rows, A.colptr(c), B.colptr(c)); } - - return acc; - } - else - { - const quasi_unwrap UUA(A); - const quasi_unwrap UUB(B); - - arma_conform_check( (UUA.M.n_elem != UUB.M.n_elem), "dot(): objects must have the same number of elements" ); - - return op_dot::direct_dot(UUA.M.n_elem, UUA.M.memptr(), UUB.M.memptr()); - } - } - - // if possible, bypass transposes of non-complex vectors - - if( (is_cx::no) && (resolves_to_vector::value) && (resolves_to_vector::value) && (partial_unwrap::is_fast) && (partial_unwrap::is_fast) ) - { - arma_debug_print("op_dot::apply(): vector optimisation"); - - const partial_unwrap UA(X); - const partial_unwrap UB(Y); - - const typename partial_unwrap::stored_type& A = UA.M; - const typename partial_unwrap::stored_type& B = UB.M; - - arma_conform_check( (A.n_elem != B.n_elem), "dot(): objects must have the same number of elements" ); - - const eT val = op_dot::direct_dot(A.n_elem, A.memptr(), B.memptr()); - - return (UA.do_times || UB.do_times) ? (val * UA.get_val() * UB.get_val()) : val; - } - - constexpr bool proxy_is_mat = (is_Mat::stored_type>::value && is_Mat::stored_type>::value); - - constexpr bool use_at = (Proxy::use_at) || (Proxy::use_at); - - constexpr bool have_direct_mem = (quasi_unwrap::has_orig_mem) && (quasi_unwrap::has_orig_mem); - - if(proxy_is_mat || use_at || have_direct_mem) - { - arma_debug_print("op_dot::apply(): direct_mem optimisation"); - - const quasi_unwrap A(X); - const quasi_unwrap B(Y); - - arma_conform_check( (A.M.n_elem != B.M.n_elem), "dot(): objects must have the same number of elements" ); - - return op_dot::direct_dot(A.M.n_elem, A.M.memptr(), B.M.memptr()); - } - - const Proxy PA(X); - const Proxy PB(Y); - - arma_conform_check( (PA.get_n_elem() != PB.get_n_elem()), "dot(): objects must have the same number of elements" ); - - return op_dot::apply_proxy_linear(PA,PB); - } - - - -template -inline -typename arma_not_cx::result -op_dot::apply_proxy_linear(const Proxy& PA, const Proxy& PB) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename Proxy::ea_type ea_type1; - typedef typename Proxy::ea_type ea_type2; - - const uword N = PA.get_n_elem(); - - ea_type1 A = PA.get_ea(); - ea_type2 B = PB.get_ea(); - - eT val1 = eT(0); - eT val2 = eT(0); - - uword i,j; - - for(i=0, j=1; j -inline -typename arma_cx_only::result -op_dot::apply_proxy_linear(const Proxy& PA, const Proxy& PB) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - typedef typename Proxy::ea_type ea_type1; - typedef typename Proxy::ea_type ea_type2; - - const uword N = PA.get_n_elem(); - - ea_type1 A = PA.get_ea(); - ea_type2 B = PB.get_ea(); - - T val_real = T(0); - T val_imag = T(0); - - for(uword i=0; i xx = A[i]; - const std::complex yy = B[i]; - - const T a = xx.real(); - const T b = xx.imag(); - - const T c = yy.real(); - const T d = yy.imag(); - - val_real += (a*c) - (b*d); - val_imag += (a*d) + (b*c); - } - - return std::complex(val_real, val_imag); - } - - - -// -// op_norm_dot - - - -template -inline -typename T1::elem_type -op_norm_dot::apply(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const quasi_unwrap tmp1(X); - const quasi_unwrap tmp2(Y); - - const Col A( const_cast(tmp1.M.memptr()), tmp1.M.n_elem, false ); - const Col B( const_cast(tmp2.M.memptr()), tmp2.M.n_elem, false ); - - arma_conform_check( (A.n_elem != B.n_elem), "norm_dot(): objects must have the same number of elements" ); - - const T denom = norm(A,2) * norm(B,2); - - return (denom != T(0)) ? ( op_dot::apply(A,B) / denom ) : eT(0); - } - - - -// -// op_cdot - - - -template -inline -eT -op_cdot::direct_cdot_arma(const uword n_elem, const eT* const A, const eT* const B) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - T val_real = T(0); - T val_imag = T(0); - - for(uword i=0; i& X = A[i]; - const std::complex& Y = B[i]; - - const T a = X.real(); - const T b = X.imag(); - - const T c = Y.real(); - const T d = Y.imag(); - - val_real += (a*c) + (b*d); - val_imag += (a*d) - (b*c); - } - - return std::complex(val_real, val_imag); - } - - - -template -inline -eT -op_cdot::direct_cdot(const uword n_elem, const eT* const A, const eT* const B) - { - arma_debug_sigprint(); - - if( n_elem <= 32u ) - { - return op_cdot::direct_cdot_arma(n_elem, A, B); - } - else - { - #if defined(ARMA_USE_BLAS) - { - arma_debug_print("blas::gemv()"); - - // using gemv() workaround due to compatibility issues with cdotc() and zdotc() - - const char trans = 'C'; - - const blas_int m = blas_int(n_elem); - const blas_int n = 1; - //const blas_int lda = (n_elem > 0) ? blas_int(n_elem) : blas_int(1); - const blas_int inc = 1; - - const eT alpha = eT(1); - const eT beta = eT(0); - - eT result[2]; // paranoia: using two elements instead of one - - //blas::gemv(&trans, &m, &n, &alpha, A, &lda, B, &inc, &beta, &result[0], &inc); - blas::gemv(&trans, &m, &n, &alpha, A, &m, B, &inc, &beta, &result[0], &inc); - - return result[0]; - } - #else - { - return op_cdot::direct_cdot_arma(n_elem, A, B); - } - #endif - } - } - - - -template -inline -typename T1::elem_type -op_cdot::apply(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - if(is_Mat::value && is_Mat::value) - { - return op_cdot::apply_unwrap(X,Y); - } - else - { - return op_cdot::apply_proxy(X,Y); - } - } - - - -template -inline -typename T1::elem_type -op_cdot::apply_unwrap(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap tmp1(X); - const unwrap tmp2(Y); - - const Mat& A = tmp1.M; - const Mat& B = tmp2.M; - - arma_conform_check( (A.n_elem != B.n_elem), "cdot(): objects must have the same number of elements" ); - - return op_cdot::direct_cdot( A.n_elem, A.mem, B.mem ); - } - - - -template -inline -typename T1::elem_type -op_cdot::apply_proxy(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - typedef typename Proxy::ea_type ea_type1; - typedef typename Proxy::ea_type ea_type2; - - constexpr bool use_at = (Proxy::use_at) || (Proxy::use_at); - - if(use_at == false) - { - const Proxy PA(X); - const Proxy PB(Y); - - const uword N = PA.get_n_elem(); - - arma_conform_check( (N != PB.get_n_elem()), "cdot(): objects must have the same number of elements" ); - - ea_type1 A = PA.get_ea(); - ea_type2 B = PB.get_ea(); - - T val_real = T(0); - T val_imag = T(0); - - for(uword i=0; i AA = A[i]; - const std::complex BB = B[i]; - - const T a = AA.real(); - const T b = AA.imag(); - - const T c = BB.real(); - const T d = BB.imag(); - - val_real += (a*c) + (b*d); - val_imag += (a*d) - (b*c); - } - - return std::complex(val_real, val_imag); - } - else - { - return op_cdot::apply_unwrap( X, Y ); - } - } - - - -template -inline -typename promote_type::result -op_dot_mixed::apply(const T1& A, const T2& B) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type in_eT1; - typedef typename T2::elem_type in_eT2; - - typedef typename promote_type::result out_eT; - - const Proxy PA(A); - const Proxy PB(B); - - const uword N = PA.get_n_elem(); - - arma_conform_check( (N != PB.get_n_elem()), "dot(): objects must have the same number of elements" ); - - out_eT acc = out_eT(0); - - for(uword i=0; i < N; ++i) - { - acc += upgrade_val::apply(PA[i]) * upgrade_val::apply(PB[i]); - } - - return acc; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_dotext_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_dotext_bones.hpp deleted file mode 100644 index dc3b7b81f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_dotext_bones.hpp +++ /dev/null @@ -1,50 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_dotext -//! @{ - - - -class op_dotext - : public traits_op_default - { - public: - - - template - inline static eT direct_rowvec_mat_colvec (const eT* A_mem, const Mat& B, const eT* C_mem); - - template - inline static eT direct_rowvec_transmat_colvec (const eT* A_mem, const Mat& B, const eT* C_mem); - - template - inline static eT direct_rowvec_diagmat_colvec (const eT* A_mem, const Mat& B, const eT* C_mem); - - template - inline static eT direct_rowvec_invdiagmat_colvec(const eT* A_mem, const Mat& B, const eT* C_mem); - - template - inline static eT direct_rowvec_invdiagvec_colvec(const eT* A_mem, const Mat& B, const eT* C_mem); - - }; - - - -//! @} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_dotext_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_dotext_meat.hpp deleted file mode 100644 index a5c462039..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_dotext_meat.hpp +++ /dev/null @@ -1,214 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_dotext -//! @{ - - - -template -inline -eT -op_dotext::direct_rowvec_mat_colvec - ( - const eT* A_mem, - const Mat& B, - const eT* C_mem - ) - { - arma_debug_sigprint(); - - const uword cost_AB = B.n_cols; - const uword cost_BC = B.n_rows; - - if(cost_AB <= cost_BC) - { - podarray tmp(B.n_cols); - - for(uword col=0; col tmp(B.n_rows); - - for(uword row=0; row -inline -eT -op_dotext::direct_rowvec_transmat_colvec - ( - const eT* A_mem, - const Mat& B, - const eT* C_mem - ) - { - arma_debug_sigprint(); - - const uword cost_AB = B.n_rows; - const uword cost_BC = B.n_cols; - - if(cost_AB <= cost_BC) - { - podarray tmp(B.n_rows); - - for(uword row=0; row tmp(B.n_cols); - - for(uword col=0; col -inline -eT -op_dotext::direct_rowvec_diagmat_colvec - ( - const eT* A_mem, - const Mat& B, - const eT* C_mem - ) - { - arma_debug_sigprint(); - - eT val = eT(0); - - for(uword i=0; i -inline -eT -op_dotext::direct_rowvec_invdiagmat_colvec - ( - const eT* A_mem, - const Mat& B, - const eT* C_mem - ) - { - arma_debug_sigprint(); - - eT val = eT(0); - - for(uword i=0; i -inline -eT -op_dotext::direct_rowvec_invdiagvec_colvec - ( - const eT* A_mem, - const Mat& B, - const eT* C_mem - ) - { - arma_debug_sigprint(); - - const eT* B_mem = B.mem; - - eT val = eT(0); - - for(uword i=0; i - inline static void apply(Mat& out, const Op& expr); - - template - inline static bool apply_direct(Mat& out, const Base& X); - }; - - - -class op_expmat_sym - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& in); - - template - inline static bool apply_direct(Mat& out, const Base& expr); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_expmat_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_expmat_meat.hpp deleted file mode 100644 index 7dd076b86..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_expmat_meat.hpp +++ /dev/null @@ -1,256 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_expmat -//! @{ - - -//! implementation based on: -//! Cleve Moler, Charles Van Loan. -//! Nineteen Dubious Ways to Compute the Exponential of a Matrix, Twenty-Five Years Later. -//! SIAM Review, Vol. 45, No. 1, 2003, pp. 3-49. -//! http://dx.doi.org/10.1137/S00361445024180 - - -template -inline -void -op_expmat::apply(Mat& out, const Op& expr) - { - arma_debug_sigprint(); - - const bool status = op_expmat::apply_direct(out, expr.m); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("expmat(): given matrix appears ill-conditioned"); - } - } - - - -template -inline -bool -op_expmat::apply_direct(Mat& out, const Base& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - if(is_op_diagmat::value) - { - out = expr.get_ref(); // force the evaluation of diagmat() - - arma_conform_check( (out.is_square() == false), "expmat(): given matrix must be square sized", [&](){ out.soft_reset(); } ); - - const uword N = (std::min)(out.n_rows, out.n_cols); - - for(uword i=0; i A = expr.get_ref(); - - arma_conform_check( (A.is_square() == false), "expmat(): given matrix must be square sized" ); - - if(A.is_diagmat()) - { - arma_debug_print("op_expmat: detected diagonal matrix"); - - const uword N = (std::min)(A.n_rows, A.n_cols); - - out.zeros(N,N); - - for(uword i=0; i::no) ? (is_approx_sym) : (is_approx_sym && is_approx_sympd)); - } - - if(do_sym) - { - arma_debug_print("op_expmat: symmetric/hermitian optimisation"); - - Col< T> eigval; - Mat eigvec; - - const bool eig_status = eig_sym_helper(eigval, eigvec, A, 'd', "expmat()"); - - if(eig_status == false) { return false; } - - eigval = exp(eigval); - - out = eigvec * diagmat(eigval) * eigvec.t(); - - return true; - } - - const T norm_val = arma::norm(A, "inf"); - - if(arma_isfinite(norm_val) == false) { return false; } - - const double log2_val = (norm_val > T(0)) ? double(eop_aux::log2(norm_val)) : double(0); - - int exponent = int(0); std::frexp(log2_val, &exponent); - - const uword s = uword( (std::max)(int(0), exponent + int(1)) ); - - A /= eT(eop_aux::pow(double(2), double(s))); - - T c = T(0.5); - - Mat E(A.n_rows, A.n_rows, fill::eye); E += c * A; - Mat D(A.n_rows, A.n_rows, fill::eye); D -= c * A; - - Mat X = A; - - bool positive = true; - - const uword N = 6; - - for(uword i = 2; i <= N; ++i) - { - c = c * T(N - i + 1) / T(i * (2*N - i + 1)); - - X = A * X; - - E += c * X; - - if(positive) { D += c * X; } else { D -= c * X; } - - positive = (positive) ? false : true; - } - - if( (D.internal_has_nonfinite()) || (E.internal_has_nonfinite()) ) { return false; } - - const bool status = solve(out, D, E, solve_opts::no_approx); - - if(status == false) { return false; } - - for(uword i=0; i < s; ++i) { out = out * out; } - - return true; - } - - - -template -inline -void -op_expmat_sym::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - const bool status = op_expmat_sym::apply_direct(out, in.m); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("expmat_sym(): transformation failed"); - } - } - - - -template -inline -bool -op_expmat_sym::apply_direct(Mat& out, const Base& expr) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const unwrap U(expr.get_ref()); - const Mat& X = U.M; - - arma_conform_check( (X.is_square() == false), "expmat_sym(): given matrix must be square sized" ); - - if((arma_config::check_conform) && (arma_config::warn_level > 0) && (is_cx::yes) && (sym_helper::check_diag_imag(X) == false)) - { - arma_warn(1, "inv_sympd(): imaginary components on diagonal are non-zero"); - } - - if(is_op_diagmat::value || X.is_diagmat()) - { - arma_debug_print("op_expmat_sym: detected diagonal matrix"); - - out = X; - - eT* colmem = out.memptr(); - - const uword N = X.n_rows; - - for(uword i=0; i eigval; - Mat eigvec; - - const bool status = eig_sym_helper(eigval, eigvec, X, 'd', "expmat_sym()"); - - if(status == false) { return false; } - - eigval = exp(eigval); - - out = eigvec * diagmat(eigval) * eigvec.t(); - - return true; - } - #else - { - arma_ignore(out); - arma_ignore(expr); - arma_stop_logic_error("expmat_sym(): use of LAPACK must be enabled"); - return false; - } - #endif - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_fft_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_fft_bones.hpp deleted file mode 100644 index b0dcbfdf1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_fft_bones.hpp +++ /dev/null @@ -1,61 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_fft -//! @{ - - - -class op_fft_real - : public traits_op_passthru - { - public: - - template - inline static void apply( Mat< std::complex >& out, const mtOp,T1,op_fft_real>& in ); - }; - - - -class op_fft_cx - : public traits_op_passthru - { - public: - - template - inline static void apply( Mat& out, const Op& in ); - - template - inline static void apply_noalias(Mat& out, const Mat& X, const uword a, const uword b); - }; - - - -class op_ifft_cx - : public traits_op_passthru - { - public: - - template - inline static void apply( Mat& out, const Op& in ); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_fft_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_fft_meat.hpp deleted file mode 100644 index daf7aff46..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_fft_meat.hpp +++ /dev/null @@ -1,325 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_fft -//! @{ - - -#if defined(ARMA_USE_FFTW3) - -template -class fft_engine_wrapper - { - public: - - static constexpr uword threshold = 512; - - fft_engine_kissfft* worker_kissfft = nullptr; - fft_engine_fftw3 * worker_fftw3 = nullptr; - - inline - ~fft_engine_wrapper() - { - arma_debug_sigprint(); - - if(worker_kissfft != nullptr) { delete worker_kissfft; } - if(worker_fftw3 != nullptr) { delete worker_fftw3; } - } - - inline - fft_engine_wrapper(const uword N_samples, const uword N_exec) - { - arma_debug_sigprint(); - - const bool use_fftw3 = N_samples >= (threshold / N_exec); - - worker_kissfft = (use_fftw3 == false) ? new fft_engine_kissfft(N_samples) : nullptr; - worker_fftw3 = (use_fftw3 == true ) ? new fft_engine_fftw3 (N_samples) : nullptr; - } - - inline - void - run(cx_type* Y, const cx_type* X) - { - arma_debug_sigprint(); - - if(worker_kissfft != nullptr) { (*worker_kissfft).run(Y,X); } - else if(worker_fftw3 != nullptr) { (*worker_fftw3).run(Y,X); } - } - }; - -#endif - - -// -// op_fft_real - - -template -inline -void -op_fft_real::apply( Mat< std::complex >& out, const mtOp,T1,op_fft_real>& in ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type in_eT; - typedef typename std::complex out_eT; - - // no need to worry about aliasing, as we're going from a real object to complex complex, which by definition cannot alias - - const quasi_unwrap U(in.m); - const Mat& X = U.M; - - const uword n_rows = X.n_rows; - const uword n_cols = X.n_cols; - const uword n_elem = X.n_elem; - - const bool is_vec = ( (n_rows == 1) || (n_cols == 1) ); - - const uword N_orig = (is_vec) ? n_elem : n_rows; - const uword N_user = (in.aux_uword_b == 0) ? in.aux_uword_a : N_orig; - - #if defined(ARMA_USE_FFTW3) - const uword N_exec = (is_vec) ? uword(1) : n_cols; - fft_engine_wrapper worker(N_user, N_exec); - #else - fft_engine_kissfft worker(N_user); - #endif - - if(is_vec) - { - (n_cols == 1) ? out.set_size(N_user, 1) : out.set_size(1, N_user); - - if( (out.n_elem == 0) || (N_orig == 0) ) { out.zeros(); return; } - - if( (N_user == 1) && (N_orig >= 1) ) { out[0] = out_eT( X[0] ); return; } - - podarray data(N_user, arma_zeros_indicator()); - - out_eT* data_mem = data.memptr(); - const in_eT* X_mem = X.memptr(); - - const uword N = (std::min)(N_user, N_orig); - - for(uword i=0; i < N; ++i) { data_mem[i].real(X_mem[i]); } - - worker.run( out.memptr(), data_mem ); - } - else - { - // process each column seperately - - out.set_size(N_user, n_cols); - - if( (out.n_elem == 0) || (N_orig == 0) ) { out.zeros(); return; } - - if( (N_user == 1) && (N_orig >= 1) ) - { - for(uword col=0; col < n_cols; ++col) { out.at(0,col).real( X.at(0,col) ); } - - return; - } - - podarray data(N_user, arma_zeros_indicator()); - - out_eT* data_mem = data.memptr(); - - const uword N = (std::min)(N_user, N_orig); - - for(uword col=0; col < n_cols; ++col) - { - for(uword i=0; i < N; ++i) { data_mem[i].real( X.at(i, col) ); } - - worker.run( out.colptr(col), data_mem ); - } - } - } - - - -// -// op_fft_cx - - -template -inline -void -op_fft_cx::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap U(in.m); - - if(U.is_alias(out)) - { - Mat tmp; - - op_fft_cx::apply_noalias(tmp, U.M, in.aux_uword_a, in.aux_uword_b); - - out.steal_mem(tmp); - } - else - { - op_fft_cx::apply_noalias(out, U.M, in.aux_uword_a, in.aux_uword_b); - } - } - - - -template -inline -void -op_fft_cx::apply_noalias(Mat& out, const Mat& X, const uword a, const uword b) - { - arma_debug_sigprint(); - - const uword n_rows = X.n_rows; - const uword n_cols = X.n_cols; - const uword n_elem = X.n_elem; - - const bool is_vec = ( (n_rows == 1) || (n_cols == 1) ); - - const uword N_orig = (is_vec) ? n_elem : n_rows; - const uword N_user = (b == 0) ? a : N_orig; - - #if defined(ARMA_USE_FFTW3) - const uword N_exec = (is_vec) ? uword(1) : n_cols; - fft_engine_wrapper worker(N_user, N_exec); - #else - fft_engine_kissfft worker(N_user); - #endif - - if(is_vec) - { - (n_cols == 1) ? out.set_size(N_user, 1) : out.set_size(1, N_user); - - if( (out.n_elem == 0) || (N_orig == 0) ) { out.zeros(); return; } - - if( (N_user == 1) && (N_orig >= 1) ) { out[0] = X[0]; return; } - - if(N_user > N_orig) - { - podarray data(N_user); - - eT* data_mem = data.memptr(); - - arrayops::fill_zeros( &data_mem[N_orig], (N_user - N_orig) ); - - arrayops::copy(data_mem, X.memptr(), (std::min)(N_user, N_orig)); - - worker.run( out.memptr(), data_mem ); - } - else - { - worker.run( out.memptr(), X.memptr() ); - } - } - else - { - // process each column seperately - - out.set_size(N_user, n_cols); - - if( (out.n_elem == 0) || (N_orig == 0) ) { out.zeros(); return; } - - if( (N_user == 1) && (N_orig >= 1) ) - { - for(uword col=0; col < n_cols; ++col) { out.at(0,col) = X.at(0,col); } - - return; - } - - if(N_user > N_orig) - { - podarray data(N_user); - - eT* data_mem = data.memptr(); - - arrayops::fill_zeros( &data_mem[N_orig], (N_user - N_orig) ); - - const uword N = (std::min)(N_user, N_orig); - - for(uword col=0; col < n_cols; ++col) - { - arrayops::copy(data_mem, X.colptr(col), N); - - worker.run( out.colptr(col), data_mem ); - } - } - else - { - for(uword col=0; col < n_cols; ++col) - { - worker.run( out.colptr(col), X.colptr(col) ); - } - } - } - - - // correct the scaling for the inverse transform - if(inverse) - { - typedef typename get_pod_type::result T; - - const T k = T(1) / T(N_user); - - eT* out_mem = out.memptr(); - - const uword out_n_elem = out.n_elem; - - for(uword i=0; i < out_n_elem; ++i) { out_mem[i] *= k; } - } - } - - - -// -// op_ifft_cx - - -template -inline -void -op_ifft_cx::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap U(in.m); - - if(U.is_alias(out)) - { - Mat tmp; - - op_fft_cx::apply_noalias(tmp, U.M, in.aux_uword_a, in.aux_uword_b); - - out.steal_mem(tmp); - } - else - { - op_fft_cx::apply_noalias(out, U.M, in.aux_uword_a, in.aux_uword_b); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_find_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_find_bones.hpp deleted file mode 100644 index 6e7c9cc55..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_find_bones.hpp +++ /dev/null @@ -1,130 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_find -//! @{ - - - -class op_find - : public traits_op_col - { - public: - - template - inline static uword - helper - ( - Mat& indices, - const Base& X - ); - - template - inline static uword - helper - ( - Mat& indices, - const mtOp& X, - const typename arma_op_rel_only::result* junk1 = nullptr, - const typename arma_not_cx::result* junk2 = nullptr - ); - - template - inline static uword - helper - ( - Mat& indices, - const mtOp& X, - const typename arma_op_rel_only::result* junk1 = nullptr, - const typename arma_cx_only::result* junk2 = nullptr - ); - - template - inline static uword - helper - ( - Mat& indices, - const mtGlue& X, - const typename arma_glue_rel_only::result* junk1 = nullptr, - const typename arma_not_cx::result* junk2 = nullptr, - const typename arma_not_cx::result* junk3 = nullptr - ); - - template - inline static uword - helper - ( - Mat& indices, - const mtGlue& X, - const typename arma_glue_rel_only::result* junk1 = nullptr, - const typename arma_cx_only::result* junk2 = nullptr, - const typename arma_cx_only::result* junk3 = nullptr - ); - - template - inline static void apply(Mat& out, const mtOp& X); - }; - - - -class op_find_simple - : public traits_op_col - { - public: - - template - inline static void apply(Mat& out, const mtOp& X); - }; - - - -class op_find_finite - : public traits_op_col - { - public: - - template - inline static void apply(Mat& out, const mtOp& X); - }; - - - -class op_find_nonfinite - : public traits_op_col - { - public: - - template - inline static void apply(Mat& out, const mtOp& X); - }; - - - -class op_find_nan - : public traits_op_col - { - public: - - template - inline static void apply(Mat& out, const mtOp& X); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_find_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_find_meat.hpp deleted file mode 100644 index 6654add28..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_find_meat.hpp +++ /dev/null @@ -1,660 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_find -//! @{ - - - -template -inline -uword -op_find::helper - ( - Mat& indices, - const Base& X - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const Proxy A(X.get_ref()); - - const uword n_elem = A.get_n_elem(); - - indices.set_size(n_elem, 1); - - uword* indices_mem = indices.memptr(); - uword n_nz = 0; - - if(Proxy::use_at == false) - { - typename Proxy::ea_type PA = A.get_ea(); - - for(uword i=0; i -inline -uword -op_find::helper - ( - Mat& indices, - const mtOp& X, - const typename arma_op_rel_only::result* junk1, - const typename arma_not_cx::result* junk2 - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - typedef typename T1::elem_type eT; - - const eT val = X.aux; - - if((is_same_type::yes || is_same_type::yes) && arma_config::check_conform && arma_isnan(val)) - { - arma_warn(1, "find(): NaN is not equal to anything; suggest to use find_nonfinite() instead"); - } - - const Proxy A(X.m); - - const uword n_elem = A.get_n_elem(); - - indices.set_size(n_elem, 1); - - uword* indices_mem = indices.memptr(); - uword n_nz = 0; - - if(Proxy::use_at == false) - { - typename Proxy::ea_type PA = A.get_ea(); - - uword i,j; - for(i=0, j=1; j < n_elem; i+=2, j+=2) - { - const eT tpi = PA[i]; - const eT tpj = PA[j]; - - bool not_zero_i; - bool not_zero_j; - - if(is_same_type::yes) { not_zero_i = (val < tpi); } - else if(is_same_type::yes) { not_zero_i = (tpi < val); } - else if(is_same_type::yes) { not_zero_i = (val > tpi); } - else if(is_same_type::yes) { not_zero_i = (tpi > val); } - else if(is_same_type::yes) { not_zero_i = (val <= tpi); } - else if(is_same_type::yes) { not_zero_i = (tpi <= val); } - else if(is_same_type::yes) { not_zero_i = (val >= tpi); } - else if(is_same_type::yes) { not_zero_i = (tpi >= val); } - else if(is_same_type::yes) { not_zero_i = (tpi == val); } - else if(is_same_type::yes) { not_zero_i = (tpi != val); } - else { not_zero_i = false; } - - if(is_same_type::yes) { not_zero_j = (val < tpj); } - else if(is_same_type::yes) { not_zero_j = (tpj < val); } - else if(is_same_type::yes) { not_zero_j = (val > tpj); } - else if(is_same_type::yes) { not_zero_j = (tpj > val); } - else if(is_same_type::yes) { not_zero_j = (val <= tpj); } - else if(is_same_type::yes) { not_zero_j = (tpj <= val); } - else if(is_same_type::yes) { not_zero_j = (val >= tpj); } - else if(is_same_type::yes) { not_zero_j = (tpj >= val); } - else if(is_same_type::yes) { not_zero_j = (tpj == val); } - else if(is_same_type::yes) { not_zero_j = (tpj != val); } - else { not_zero_j = false; } - - if(not_zero_i) { indices_mem[n_nz] = i; ++n_nz; } - if(not_zero_j) { indices_mem[n_nz] = j; ++n_nz; } - } - - if(i < n_elem) - { - bool not_zero; - - const eT tmp = PA[i]; - - if(is_same_type::yes) { not_zero = (val < tmp); } - else if(is_same_type::yes) { not_zero = (tmp < val); } - else if(is_same_type::yes) { not_zero = (val > tmp); } - else if(is_same_type::yes) { not_zero = (tmp > val); } - else if(is_same_type::yes) { not_zero = (val <= tmp); } - else if(is_same_type::yes) { not_zero = (tmp <= val); } - else if(is_same_type::yes) { not_zero = (val >= tmp); } - else if(is_same_type::yes) { not_zero = (tmp >= val); } - else if(is_same_type::yes) { not_zero = (tmp == val); } - else if(is_same_type::yes) { not_zero = (tmp != val); } - else { not_zero = false; } - - if(not_zero) { indices_mem[n_nz] = i; ++n_nz; } - } - } - else - { - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - - uword i = 0; - - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - const eT tmp = A.at(row,col); - - bool not_zero; - - if(is_same_type::yes) { not_zero = (val < tmp); } - else if(is_same_type::yes) { not_zero = (tmp < val); } - else if(is_same_type::yes) { not_zero = (val > tmp); } - else if(is_same_type::yes) { not_zero = (tmp > val); } - else if(is_same_type::yes) { not_zero = (val <= tmp); } - else if(is_same_type::yes) { not_zero = (tmp <= val); } - else if(is_same_type::yes) { not_zero = (val >= tmp); } - else if(is_same_type::yes) { not_zero = (tmp >= val); } - else if(is_same_type::yes) { not_zero = (tmp == val); } - else if(is_same_type::yes) { not_zero = (tmp != val); } - else { not_zero = false; } - - if(not_zero) { indices_mem[n_nz] = i; ++n_nz; } - - ++i; - } - } - - return n_nz; - } - - - -template -inline -uword -op_find::helper - ( - Mat& indices, - const mtOp& X, - const typename arma_op_rel_only::result* junk1, - const typename arma_cx_only::result* junk2 - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - typedef typename T1::elem_type eT; - typedef typename Proxy::ea_type ea_type; - - const eT val = X.aux; - - if((is_same_type::yes || is_same_type::yes) && arma_config::check_conform && arma_isnan(val)) - { - arma_warn(1, "find(): NaN is not equal to anything; suggest to use find_nonfinite() instead"); - } - - const Proxy A(X.m); - - const uword n_elem = A.get_n_elem(); - - indices.set_size(n_elem, 1); - - uword* indices_mem = indices.memptr(); - uword n_nz = 0; - - - if(Proxy::use_at == false) - { - ea_type PA = A.get_ea(); - - for(uword i=0; i::yes) { not_zero = (tmp == val); } - else if(is_same_type::yes) { not_zero = (tmp != val); } - else { not_zero = false; } - - if(not_zero) { indices_mem[n_nz] = i; ++n_nz; } - } - } - else - { - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - - uword i = 0; - - for(uword col=0; col::yes) { not_zero = (tmp == val); } - else if(is_same_type::yes) { not_zero = (tmp != val); } - else { not_zero = false; } - - if(not_zero) { indices_mem[n_nz] = i; ++n_nz; } - - i++; - } - } - - return n_nz; - } - - - -template -inline -uword -op_find::helper - ( - Mat& indices, - const mtGlue& X, - const typename arma_glue_rel_only::result* junk1, - const typename arma_not_cx::result* junk2, - const typename arma_not_cx::result* junk3 - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - arma_ignore(junk3); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename Proxy::ea_type ea_type1; - typedef typename Proxy::ea_type ea_type2; - - const Proxy A(X.A); - const Proxy B(X.B); - - arma_conform_assert_same_size(A, B, "relational operator"); - - const uword n_elem = A.get_n_elem(); - - indices.set_size(n_elem, 1); - - uword* indices_mem = indices.memptr(); - uword n_nz = 0; - - if((Proxy::use_at == false) && (Proxy::use_at == false)) - { - ea_type1 PA = A.get_ea(); - ea_type2 PB = B.get_ea(); - - for(uword i=0; i::yes) { not_zero = (tmp1 < tmp2); } - else if(is_same_type::yes) { not_zero = (tmp1 > tmp2); } - else if(is_same_type::yes) { not_zero = (tmp1 <= tmp2); } - else if(is_same_type::yes) { not_zero = (tmp1 >= tmp2); } - else if(is_same_type::yes) { not_zero = (tmp1 == tmp2); } - else if(is_same_type::yes) { not_zero = (tmp1 != tmp2); } - else if(is_same_type::yes) { not_zero = (tmp1 && tmp2); } - else if(is_same_type::yes) { not_zero = (tmp1 || tmp2); } - else { not_zero = false; } - - if(not_zero) { indices_mem[n_nz] = i; ++n_nz; } - } - } - else - { - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - - uword i = 0; - - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - const eT1 tmp1 = A.at(row,col); - const eT2 tmp2 = B.at(row,col); - - bool not_zero; - - if(is_same_type::yes) { not_zero = (tmp1 < tmp2); } - else if(is_same_type::yes) { not_zero = (tmp1 > tmp2); } - else if(is_same_type::yes) { not_zero = (tmp1 <= tmp2); } - else if(is_same_type::yes) { not_zero = (tmp1 >= tmp2); } - else if(is_same_type::yes) { not_zero = (tmp1 == tmp2); } - else if(is_same_type::yes) { not_zero = (tmp1 != tmp2); } - else if(is_same_type::yes) { not_zero = (tmp1 && tmp2); } - else if(is_same_type::yes) { not_zero = (tmp1 || tmp2); } - else { not_zero = false; } - - if(not_zero) { indices_mem[n_nz] = i; ++n_nz; } - - i++; - } - } - - return n_nz; - } - - - -template -inline -uword -op_find::helper - ( - Mat& indices, - const mtGlue& X, - const typename arma_glue_rel_only::result* junk1, - const typename arma_cx_only::result* junk2, - const typename arma_cx_only::result* junk3 - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - arma_ignore(junk3); - - typedef typename Proxy::ea_type ea_type1; - typedef typename Proxy::ea_type ea_type2; - - const Proxy A(X.A); - const Proxy B(X.B); - - arma_conform_assert_same_size(A, B, "relational operator"); - - const uword n_elem = A.get_n_elem(); - - indices.set_size(n_elem, 1); - - uword* indices_mem = indices.memptr(); - uword n_nz = 0; - - if((Proxy::use_at == false) && (Proxy::use_at == false)) - { - ea_type1 PA = A.get_ea(); - ea_type2 PB = B.get_ea(); - - for(uword i=0; i::yes) { not_zero = (PA[i] == PB[i]); } - else if(is_same_type::yes) { not_zero = (PA[i] != PB[i]); } - else { not_zero = false; } - - if(not_zero) { indices_mem[n_nz] = i; ++n_nz; } - } - } - else - { - const uword n_rows = A.get_n_rows(); - const uword n_cols = A.get_n_cols(); - - uword i = 0; - - for(uword col=0; col::yes) { not_zero = (A.at(row,col) == B.at(row,col)); } - else if(is_same_type::yes) { not_zero = (A.at(row,col) != B.at(row,col)); } - else { not_zero = false; } - - if(not_zero) { indices_mem[n_nz] = i; ++n_nz; } - - i++; - } - } - - return n_nz; - } - - - -template -inline -void -op_find::apply(Mat& out, const mtOp& X) - { - arma_debug_sigprint(); - - const uword k = X.aux_uword_a; - const uword type = X.aux_uword_b; - - Mat indices; - const uword n_nz = op_find::helper(indices, X.m); - - if(n_nz > 0) - { - if(type == 0) // "first" - { - out = (k > 0 && k <= n_nz) ? indices.rows(0, k-1 ) : indices.rows(0, n_nz-1); - } - else // "last" - { - out = (k > 0 && k <= n_nz) ? indices.rows(n_nz-k, n_nz-1) : indices.rows(0, n_nz-1); - } - } - else - { - out.set_size(0,1); // empty column vector - } - } - - - -// - - - -template -inline -void -op_find_simple::apply(Mat& out, const mtOp& X) - { - arma_debug_sigprint(); - - Mat indices; - const uword n_nz = op_find::helper(indices, X.m); - - out.steal_mem_col(indices, n_nz); - } - - - -// - - - -template -inline -void -op_find_finite::apply(Mat& out, const mtOp& X) - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "find_finite(): detection of non-finite values is not reliable in fast math mode"); } - - const Proxy P(X.m); - - const uword n_elem = P.get_n_elem(); - - Mat indices(n_elem, 1, arma_nozeros_indicator()); - - uword* indices_mem = indices.memptr(); - uword count = 0; - - if(Proxy::use_at == false) - { - const typename Proxy::ea_type Pea = P.get_ea(); - - for(uword i=0; i -inline -void -op_find_nonfinite::apply(Mat& out, const mtOp& X) - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "find_nonfinite(): detection of non-finite values is not reliable in fast math mode"); } - - const Proxy P(X.m); - - const uword n_elem = P.get_n_elem(); - - Mat indices(n_elem, 1, arma_nozeros_indicator()); - - uword* indices_mem = indices.memptr(); - uword count = 0; - - if(Proxy::use_at == false) - { - const typename Proxy::ea_type Pea = P.get_ea(); - - for(uword i=0; i -inline -void -op_find_nan::apply(Mat& out, const mtOp& X) - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "find_nan(): detection of non-finite values is not reliable in fast math mode"); } - - const Proxy P(X.m); - - const uword n_elem = P.get_n_elem(); - - Mat indices(n_elem, 1, arma_nozeros_indicator()); - - uword* indices_mem = indices.memptr(); - uword count = 0; - - if(Proxy::use_at == false) - { - const typename Proxy::ea_type Pea = P.get_ea(); - - for(uword i=0; i - static inline bool apply_helper(Mat& out, const Proxy& P, const bool ascending_indices); - - template - static inline void apply(Mat& out, const mtOp& in); - }; - - - -template -struct arma_find_unique_packet - { - eT val; - uword index; - }; - - - -template -struct arma_find_unique_comparator - { - arma_inline - bool - operator() (const arma_find_unique_packet& A, const arma_find_unique_packet& B) const - { - return (A.val < B.val); - } - }; - - - -template -struct arma_find_unique_comparator< std::complex > - { - arma_inline - bool - operator() (const arma_find_unique_packet< std::complex >& A, const arma_find_unique_packet< std::complex >& B) const - { - const T A_real = A.val.real(); - const T B_real = B.val.real(); - - return ( (A_real < B_real) ? true : ((A_real == B_real) ? (A.val.imag() < B.val.imag()) : false) ); - } - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_find_unique_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_find_unique_meat.hpp deleted file mode 100644 index 63084c972..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_find_unique_meat.hpp +++ /dev/null @@ -1,130 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_find_unique -//! @{ - - - -template -inline -bool -op_find_unique::apply_helper(Mat& out, const Proxy& P, const bool ascending_indices) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) { out.set_size(0,1); return true; } - if(n_elem == 1) { out.set_size(1,1); out[0] = 0; return true; } - - uvec indices(n_elem, arma_nozeros_indicator()); - - std::vector< arma_find_unique_packet > packet_vec(n_elem); - - if(Proxy::use_at == false) - { - typename Proxy::ea_type Pea = P.get_ea(); - - for(uword i=0; i comparator; - - std::sort( packet_vec.begin(), packet_vec.end(), comparator ); - - uword* indices_mem = indices.memptr(); - - indices_mem[0] = packet_vec[0].index; - - uword count = 1; - - for(uword i=1; i < n_elem; ++i) - { - const eT diff = packet_vec[i-1].val - packet_vec[i].val; - - if(diff != eT(0)) - { - indices_mem[count] = packet_vec[i].index; - ++count; - } - } - - out.steal_mem_col(indices,count); - - if(ascending_indices) { std::sort(out.begin(), out.end()); } - - return true; - } - - - -template -inline -void -op_find_unique::apply(Mat& out, const mtOp& in) - { - arma_debug_sigprint(); - - const Proxy P(in.m); - - const bool ascending_indices = (in.aux_uword_a == uword(1)); - - const bool all_non_nan = op_find_unique::apply_helper(out, P, ascending_indices); - - if(all_non_nan == false) - { - arma_conform_check( true, "find_unique(): detected NaN" ); - - out.reset(); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_flip_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_flip_bones.hpp deleted file mode 100644 index c81eca15c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_flip_bones.hpp +++ /dev/null @@ -1,59 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_flip -//! @{ - - - -class op_flipud - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const Op& in); - - template - inline static void apply_direct(Mat& out, const Mat& X); - - template - inline static void apply_proxy_noalias(Mat& out, const Proxy& P); - }; - - - - -class op_fliplr - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const Op& in); - - template - inline static void apply_direct(Mat& out, const Mat& X); - - template - inline static void apply_proxy_noalias(Mat& out, const Proxy& P); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_flip_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_flip_meat.hpp deleted file mode 100644 index 253a1fd7a..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_flip_meat.hpp +++ /dev/null @@ -1,341 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_flip -//! @{ - - - -template -inline -void -op_flipud::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(is_Mat::value) - { - // allow detection of in-place operation - - const unwrap U(in.m); - - op_flipud::apply_direct(out, U.M); - } - else - { - const Proxy P(in.m); - - if(P.is_alias(out)) - { - Mat tmp; - - op_flipud::apply_proxy_noalias(tmp, P); - - out.steal_mem(tmp); - } - else - { - op_flipud::apply_proxy_noalias(out, P); - } - } - } - - - -template -inline -void -op_flipud::apply_direct(Mat& out, const Mat& X) - { - arma_debug_sigprint(); - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - const uword X_n_rows_m1 = X_n_rows - 1; - - if(&out != &X) - { - out.set_size(X_n_rows, X_n_cols); - - if(X_n_cols == 1) - { - const eT* X_mem = X.memptr(); - eT* out_mem = out.memptr(); - - for(uword row=0; row < X_n_rows; ++row) - { - out_mem[X_n_rows_m1 - row] = X_mem[row]; - } - } - else - { - for(uword col=0; col < X_n_cols; ++col) - { - const eT* X_colmem = X.colptr(col); - eT* out_colmem = out.colptr(col); - - for(uword row=0; row < X_n_rows; ++row) - { - out_colmem[X_n_rows_m1 - row] = X_colmem[row]; - } - } - } - } - else // in-place operation - { - const uword N = X_n_rows / 2; - - if(X_n_cols == 1) - { - eT* out_mem = out.memptr(); - - for(uword row=0; row < N; ++row) - { - std::swap(out_mem[X_n_rows_m1 - row], out_mem[row]); - } - } - else - { - for(uword col=0; col < X_n_cols; ++col) - { - eT* out_colmem = out.colptr(col); - - for(uword row=0; row < N; ++row) - { - std::swap(out_colmem[X_n_rows_m1 - row], out_colmem[row]); - } - } - } - } - } - - - -template -inline -void -op_flipud::apply_proxy_noalias(Mat& out, const Proxy& P) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - typedef typename Proxy::stored_type P_stored_type; - - if(is_Mat::value) - { - const unwrap U(P.Q); - - op_flipud::apply_direct(out, U.M); - - return; - } - - const uword P_n_rows = P.get_n_rows(); - const uword P_n_cols = P.get_n_cols(); - - const uword P_n_rows_m1 = P_n_rows - 1; - - out.set_size(P_n_rows, P_n_cols); - - if( ((T1::is_col) || (P_n_cols == 1)) && (Proxy::use_at == false) ) - { - eT* out_mem = out.memptr(); - - const typename Proxy::ea_type P_ea = P.get_ea(); - - for(uword row=0; row < P_n_rows; ++row) - { - out_mem[P_n_rows_m1 - row] = P_ea[row]; - } - } - else - { - for(uword col=0; col < P_n_cols; ++col) - { - eT* out_colmem = out.colptr(col); - - for(uword row=0; row < P_n_rows; ++row) - { - out_colmem[P_n_rows_m1 - row] = P.at(row, col); - } - } - } - } - - - -// - - - -template -inline -void -op_fliplr::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(is_Mat::value) - { - // allow detection of in-place operation - - const unwrap U(in.m); - - op_fliplr::apply_direct(out, U.M); - } - else - { - const Proxy P(in.m); - - if(P.is_alias(out)) - { - Mat tmp; - - op_fliplr::apply_proxy_noalias(tmp, P); - - out.steal_mem(tmp); - } - else - { - op_fliplr::apply_proxy_noalias(out, P); - } - } - } - - - -template -inline -void -op_fliplr::apply_direct(Mat& out, const Mat& X) - { - arma_debug_sigprint(); - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - const uword X_n_cols_m1 = X_n_cols - 1; - - if(&out != &X) - { - out.set_size(X_n_rows, X_n_cols); - - if(X_n_rows == 1) - { - const eT* X_mem = X.memptr(); - eT* out_mem = out.memptr(); - - for(uword col=0; col < X_n_cols; ++col) - { - out_mem[X_n_cols_m1 - col] = X_mem[col]; - } - } - else - { - for(uword col=0; col < X_n_cols; ++col) - { - out.col(X_n_cols_m1 - col) = X.col(col); - } - } - } - else // in-place operation - { - const uword N = X_n_cols / 2; - - if(X_n_rows == 1) - { - eT* out_mem = out.memptr(); - - for(uword col=0; col < N; ++col) - { - std::swap(out_mem[X_n_cols_m1 - col], out_mem[col]); - } - } - else - { - for(uword col=0; col < N; ++col) - { - out.swap_cols(X_n_cols_m1 - col, col); - } - } - } - } - - - -template -inline -void -op_fliplr::apply_proxy_noalias(Mat& out, const Proxy& P) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - typedef typename Proxy::stored_type P_stored_type; - - if(is_Mat::value) - { - const unwrap U(P.Q); - - op_fliplr::apply_direct(out, U.M); - - return; - } - - const uword P_n_rows = P.get_n_rows(); - const uword P_n_cols = P.get_n_cols(); - - const uword P_n_cols_m1 = P_n_cols - 1; - - out.set_size(P_n_rows, P_n_cols); - - if( ((T1::is_row) || (P_n_rows == 1)) && (Proxy::use_at == false) ) - { - eT* out_mem = out.memptr(); - - const typename Proxy::ea_type P_ea = P.get_ea(); - - for(uword col=0; col < P_n_cols; ++col) - { - out_mem[P_n_cols_m1 - col] = P_ea[col]; - } - } - else - { - for(uword col=0; col < P_n_cols; ++col) - { - eT* out_colmem = out.colptr(P_n_cols_m1 - col); - - for(uword row=0; row < P_n_rows; ++row) - { - out_colmem[row] = P.at(row,col); - } - } - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_hist_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_hist_bones.hpp deleted file mode 100644 index c014ba269..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_hist_bones.hpp +++ /dev/null @@ -1,39 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_hist -//! @{ - - - -class op_hist - : public traits_op_passthru - { - public: - - template - inline static void apply_noalias(Mat& out, const Mat& A, const uword n_bins, const uword dim); - - template - inline static void apply(Mat& out, const mtOp& X); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_hist_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_hist_meat.hpp deleted file mode 100644 index 27cffa83c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_hist_meat.hpp +++ /dev/null @@ -1,125 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_hist -//! @{ - - - -template -inline -void -op_hist::apply_noalias(Mat& out, const Mat& A, const uword n_bins, const uword dim) - { - arma_debug_sigprint(); - - arma_conform_check( ((A.is_vec() == false) && (A.is_empty() == false)), "hist(): only vectors are supported when automatically determining bin centers" ); - - if(n_bins == 0) { out.reset(); return; } - - uword A_n_elem = A.n_elem; - const eT* A_mem = A.memptr(); - - eT min_val = priv::most_pos(); - eT max_val = priv::most_neg(); - - uword i,j; - for(i=0, j=1; j < A_n_elem; i+=2, j+=2) - { - const eT val_i = A_mem[i]; - const eT val_j = A_mem[j]; - - if(min_val > val_i) { min_val = val_i; } - if(min_val > val_j) { min_val = val_j; } - - if(max_val < val_i) { max_val = val_i; } - if(max_val < val_j) { max_val = val_j; } - } - - if(i < A_n_elem) - { - const eT val_i = A_mem[i]; - - if(min_val > val_i) { min_val = val_i; } - if(max_val < val_i) { max_val = val_i; } - } - - if(min_val == max_val) - { - min_val -= (n_bins/2); - max_val += (n_bins/2); - } - - if(arma_isfinite(min_val) == false) { min_val = priv::most_neg(); } - if(arma_isfinite(max_val) == false) { max_val = priv::most_pos(); } - - Col c(n_bins, arma_nozeros_indicator()); - eT* c_mem = c.memptr(); - - for(uword ii=0; ii < n_bins; ++ii) - { - c_mem[ii] = (0.5 + ii) / double(n_bins); - } - - c = ((max_val - min_val) * c) + min_val; - - glue_hist::apply_noalias(out, A, c, dim); - } - - - -template -inline -void -op_hist::apply(Mat& out, const mtOp& X) - { - arma_debug_sigprint(); - - const uword n_bins = X.aux_uword_a; - - const quasi_unwrap U(X.m); - - const uword dim = (T1::is_xvec) ? uword(U.M.is_rowvec() ? 1 : 0) : uword((T1::is_row) ? 1 : 0); - - if(is_non_integral::value) - { - if(U.is_alias(out)) - { - Mat tmp; - - op_hist::apply_noalias(tmp, U.M, n_bins, dim); - - out.steal_mem(tmp); - } - else - { - op_hist::apply_noalias(out, U.M, n_bins, dim); - } - } - else - { - Mat converted = conv_to< Mat >::from(U.M); - - op_hist::apply_noalias(out, converted, n_bins, dim); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_htrans_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_htrans_bones.hpp deleted file mode 100644 index c10f624f0..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_htrans_bones.hpp +++ /dev/null @@ -1,107 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_htrans -//! @{ - - -//! 'hermitian transpose' operation - -class op_htrans - { - public: - - template - struct traits - { - static constexpr bool is_row = T1::is_col; // deliberately swapped - static constexpr bool is_col = T1::is_row; - static constexpr bool is_xvec = T1::is_xvec; - }; - - template - arma_hot inline static void apply_mat_noalias(Mat& out, const Mat& A, const typename arma_not_cx::result* junk = nullptr); - - template - arma_hot inline static void apply_mat_noalias(Mat& out, const Mat& A, const typename arma_cx_only::result* junk = nullptr); - - // - - template - arma_hot inline static void block_worker(std::complex* Y, const std::complex* X, const uword X_n_rows, const uword Y_n_rows, const uword n_rows, const uword n_cols); - - template - arma_hot inline static void apply_mat_noalias_large(Mat< std::complex >& out, const Mat< std::complex >& A); - - // - - template - arma_hot inline static void apply_mat_inplace(Mat& out, const typename arma_not_cx::result* junk = nullptr); - - template - arma_hot inline static void apply_mat_inplace(Mat& out, const typename arma_cx_only::result* junk = nullptr); - - // - - template - inline static void apply_mat(Mat& out, const Mat& A, const typename arma_not_cx::result* junk = nullptr); - - template - inline static void apply_mat(Mat& out, const Mat& A, const typename arma_cx_only::result* junk = nullptr); - - // - - template - inline static void apply_proxy(Mat& out, const Proxy& P); - - // - - template - inline static void apply_direct(Mat& out, const T1& X); - - template - inline static void apply(Mat& out, const Op& in, const typename arma_not_cx::result* junk = nullptr); - - template - inline static void apply(Mat& out, const Op& in, const typename arma_cx_only::result* junk = nullptr); - }; - - - -class op_htrans2 - { - public: - - template - struct traits - { - static constexpr bool is_row = T1::is_col; // deliberately swapped - static constexpr bool is_col = T1::is_row; - static constexpr bool is_xvec = T1::is_xvec; - }; - - template - inline static void apply(Mat& out, const Op& in, const typename arma_not_cx::result* junk = nullptr); - - template - inline static void apply(Mat& out, const Op& in, const typename arma_cx_only::result* junk = nullptr); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_htrans_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_htrans_meat.hpp deleted file mode 100644 index 0968a50bb..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_htrans_meat.hpp +++ /dev/null @@ -1,419 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_htrans -//! @{ - - - -template -inline -void -op_htrans::apply_mat_noalias(Mat& out, const Mat& A, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - op_strans::apply_mat_noalias(out, A); - } - - - -template -inline -void -op_htrans::apply_mat_noalias(Mat& out, const Mat& A, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - out.set_size(A_n_cols, A_n_rows); - - if( (A_n_cols == 1) || (A_n_rows == 1) ) - { - const uword n_elem = A.n_elem; - - const eT* A_mem = A.memptr(); - eT* out_mem = out.memptr(); - - for(uword i=0; i < n_elem; ++i) - { - out_mem[i] = std::conj(A_mem[i]); - } - } - else - if( (A_n_rows >= 512) && (A_n_cols >= 512) ) - { - op_htrans::apply_mat_noalias_large(out, A); - } - else - { - eT* outptr = out.memptr(); - - for(uword k=0; k < A_n_rows; ++k) - { - const eT* Aptr = &(A.at(k,0)); - - for(uword j=0; j < A_n_cols; ++j) - { - (*outptr) = std::conj(*Aptr); - - Aptr += A_n_rows; - outptr++; - } - } - } - } - - - -template -inline -void -op_htrans::block_worker(std::complex* Y, const std::complex* X, const uword X_n_rows, const uword Y_n_rows, const uword n_rows, const uword n_cols) - { - for(uword row = 0; row < n_rows; ++row) - { - const uword Y_offset = row * Y_n_rows; - - for(uword col = 0; col < n_cols; ++col) - { - const uword X_offset = col * X_n_rows; - - Y[col + Y_offset] = std::conj(X[row + X_offset]); - } - } - } - - - -template -inline -void -op_htrans::apply_mat_noalias_large(Mat< std::complex >& out, const Mat< std::complex >& A) - { - arma_debug_sigprint(); - - const uword n_rows = A.n_rows; - const uword n_cols = A.n_cols; - - const uword block_size = 64; - - const uword n_rows_base = block_size * (n_rows / block_size); - const uword n_cols_base = block_size * (n_cols / block_size); - - const uword n_rows_extra = n_rows - n_rows_base; - const uword n_cols_extra = n_cols - n_cols_base; - - const std::complex* X = A.memptr(); - std::complex* Y = out.memptr(); - - for(uword row = 0; row < n_rows_base; row += block_size) - { - const uword Y_offset = row * n_cols; - - for(uword col = 0; col < n_cols_base; col += block_size) - { - const uword X_offset = col * n_rows; - - op_htrans::block_worker(&Y[col + Y_offset], &X[row + X_offset], n_rows, n_cols, block_size, block_size); - } - - const uword X_offset = n_cols_base * n_rows; - - op_htrans::block_worker(&Y[n_cols_base + Y_offset], &X[row + X_offset], n_rows, n_cols, block_size, n_cols_extra); - } - - if(n_rows_extra == 0) { return; } - - const uword Y_offset = n_rows_base * n_cols; - - for(uword col = 0; col < n_cols_base; col += block_size) - { - const uword X_offset = col * n_rows; - - op_htrans::block_worker(&Y[col + Y_offset], &X[n_rows_base + X_offset], n_rows, n_cols, n_rows_extra, block_size); - } - - const uword X_offset = n_cols_base * n_rows; - - op_htrans::block_worker(&Y[n_cols_base + Y_offset], &X[n_rows_base + X_offset], n_rows, n_cols, n_rows_extra, n_cols_extra); - } - - - -template -inline -void -op_htrans::apply_mat_inplace(Mat& out, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - op_strans::apply_mat_inplace(out); - } - - - -template -inline -void -op_htrans::apply_mat_inplace(Mat& out, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const uword n_rows = out.n_rows; - const uword n_cols = out.n_cols; - - if(n_rows == n_cols) - { - arma_debug_print("doing in-place hermitian transpose of a square matrix"); - - for(uword col=0; col < n_cols; ++col) - { - eT* coldata = out.colptr(col); - - out.at(col,col) = std::conj( out.at(col,col) ); - - for(uword row=(col+1); row < n_rows; ++row) - { - const eT val1 = std::conj(coldata[row]); - const eT val2 = std::conj(out.at(col,row)); - - out.at(col,row) = val1; - coldata[row] = val2; - } - } - } - else - { - Mat tmp; - - op_htrans::apply_mat_noalias(tmp, out); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -op_htrans::apply_mat(Mat& out, const Mat& A, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - op_strans::apply_mat(out, A); - } - - - -template -inline -void -op_htrans::apply_mat(Mat& out, const Mat& A, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - if(&out != &A) - { - op_htrans::apply_mat_noalias(out, A); - } - else - { - op_htrans::apply_mat_inplace(out); - } - } - - - -template -inline -void -op_htrans::apply_proxy(Mat& out, const Proxy& P) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - if( (resolves_to_vector::yes) && (Proxy::use_at == false) ) - { - out.set_size(n_cols, n_rows); - - eT* out_mem = out.memptr(); - - const uword n_elem = P.get_n_elem(); - - typename Proxy::ea_type Pea = P.get_ea(); - - for(uword i=0; i < n_elem; ++i) - { - out_mem[i] = std::conj(Pea[i]); - } - } - else - { - out.set_size(n_cols, n_rows); - - eT* outptr = out.memptr(); - - for(uword k=0; k < n_rows; ++k) - { - for(uword j=0; j < n_cols; ++j) - { - (*outptr) = std::conj(P.at(k,j)); - - outptr++; - } - } - } - } - - - -template -inline -void -op_htrans::apply_direct(Mat& out, const T1& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - // allow detection of in-place transpose - if(is_Mat::value || (arma_config::openmp && Proxy::use_mp)) - { - const unwrap U(X); - - op_htrans::apply_mat(out, U.M); - } - else - { - const Proxy P(X); - - const bool is_alias = P.is_alias(out); - - if(is_Mat::stored_type>::value) - { - const quasi_unwrap::stored_type> U(P.Q); - - if(is_alias) - { - Mat tmp; - - op_htrans::apply_mat_noalias(tmp, U.M); - - out.steal_mem(tmp); - } - else - { - op_htrans::apply_mat_noalias(out, U.M); - } - } - else - { - if(is_alias) - { - Mat tmp; - - op_htrans::apply_proxy(tmp, P); - - out.steal_mem(tmp); - } - else - { - op_htrans::apply_proxy(out, P); - } - } - } - } - - - -template -inline -void -op_htrans::apply(Mat& out, const Op& in, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - op_strans::apply_direct(out, in.m); - } - - - -template -inline -void -op_htrans::apply(Mat& out, const Op& in, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - op_htrans::apply_direct(out, in.m); - } - - - -// -// op_htrans2 - - - -template -inline -void -op_htrans2::apply(Mat& out, const Op& in, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - op_strans::apply_direct(out, in.m); - - arrayops::inplace_mul(out.memptr(), in.aux, out.n_elem); - } - - - -template -inline -void -op_htrans2::apply(Mat& out, const Op& in, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - op_htrans::apply_direct(out, in.m); - - arrayops::inplace_mul(out.memptr(), in.aux, out.n_elem); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_index_max_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_index_max_bones.hpp deleted file mode 100644 index d226f22d2..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_index_max_bones.hpp +++ /dev/null @@ -1,57 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_index_max -//! @{ - - -class op_index_max - : public traits_op_xvec - { - public: - - // dense matrices - - template - inline static void apply(Mat& out, const mtOp& in); - - template - inline static void apply_noalias(Mat& out, const Mat& X, const uword dim); - - - // cubes - - template - inline static void apply(Cube& out, const mtOpCube& in); - - template - inline static void apply_noalias(Cube& out, const Cube& X, const uword dim, const typename arma_not_cx::result* junk = nullptr); - - template - inline static void apply_noalias(Cube& out, const Cube& X, const uword dim, const typename arma_cx_only::result* junk = nullptr); - - - // sparse matrices - - template - inline static void apply(Mat& out, const SpBase& expr, const uword dim); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_index_max_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_index_max_meat.hpp deleted file mode 100644 index 6aed272be..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_index_max_meat.hpp +++ /dev/null @@ -1,433 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_index_max -//! @{ - - - -template -inline -void -op_index_max::apply(Mat& out, const mtOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword dim = in.aux_uword_a; - arma_conform_check( (dim > 1), "index_max(): parameter 'dim' must be 0 or 1" ); - - const quasi_unwrap U(in.m); - const Mat& X = U.M; - - if(U.is_alias(out) == false) - { - op_index_max::apply_noalias(out, X, dim); - } - else - { - Mat tmp; - - op_index_max::apply_noalias(tmp, X, dim); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -op_index_max::apply_noalias(Mat& out, const Mat& X, const uword dim) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(dim == 0) - { - arma_debug_print("op_index_max::apply(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols); - - if(X_n_rows == 0) { return; } - - uword* out_mem = out.memptr(); - - for(uword col=0; col < X_n_cols; ++col) - { - op_max::direct_max( X.colptr(col), X_n_rows, out_mem[col] ); - } - } - else - if(dim == 1) - { - arma_debug_print("op_index_max::apply(): dim = 1"); - - out.zeros(X_n_rows, (X_n_cols > 0) ? 1 : 0); - - if(X_n_cols == 0) { return; } - - uword* out_mem = out.memptr(); - - Col tmp(X_n_rows, arma_nozeros_indicator()); - - T* tmp_mem = tmp.memptr(); - - if(is_cx::yes) - { - const eT* col_mem = X.colptr(0); - - for(uword row=0; row < X_n_rows; ++row) - { - tmp_mem[row] = eop_aux::arma_abs(col_mem[row]); - } - } - else - { - arrayops::copy(tmp_mem, (T*)(X.colptr(0)), X_n_rows); - } - - for(uword col=1; col < X_n_cols; ++col) - { - const eT* col_mem = X.colptr(col); - - for(uword row=0; row < X_n_rows; ++row) - { - T& max_val = tmp_mem[row]; - T col_val = (is_cx::yes) ? T(eop_aux::arma_abs(col_mem[row])) : T(access::tmp_real(col_mem[row])); - - if(max_val < col_val) - { - max_val = col_val; - - out_mem[row] = col; - } - } - } - } - } - - - -template -inline -void -op_index_max::apply(Cube& out, const mtOpCube& in) - { - arma_debug_sigprint(); - - const uword dim = in.aux_uword_a; - arma_conform_check( (dim > 2), "index_max(): parameter 'dim' must be 0 or 1 or 2" ); - - const unwrap_cube U(in.m); - - if(U.is_alias(out) == false) - { - op_index_max::apply_noalias(out, U.M, dim); - } - else - { - Cube tmp; - - op_index_max::apply_noalias(tmp, U.M, dim); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -op_index_max::apply_noalias(Cube& out, const Cube& X, const uword dim, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - const uword X_n_slices = X.n_slices; - - if(dim == 0) - { - arma_debug_print("op_index_max::apply(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols, X_n_slices); - - if(out.is_empty() || X.is_empty()) { return; } - - for(uword slice=0; slice < X_n_slices; ++slice) - { - uword* out_mem = out.slice_memptr(slice); - - for(uword col=0; col < X_n_cols; ++col) - { - op_max::direct_max( X.slice_colptr(slice,col), X_n_rows, out_mem[col] ); - } - } - } - else - if(dim == 1) - { - arma_debug_print("op_index_max::apply(): dim = 1"); - - out.zeros(X_n_rows, (X_n_cols > 0) ? 1 : 0, X_n_slices); - - if(out.is_empty() || X.is_empty()) { return; } - - Col tmp(X_n_rows, arma_nozeros_indicator()); - - eT* tmp_mem = tmp.memptr(); - - for(uword slice=0; slice < X_n_slices; ++slice) - { - uword* out_mem = out.slice_memptr(slice); - - arrayops::copy(tmp_mem, X.slice_colptr(slice,0), X_n_rows); - - for(uword col=1; col < X_n_cols; ++col) - { - const eT* col_mem = X.slice_colptr(slice,col); - - for(uword row=0; row < X_n_rows; ++row) - { - const eT val = col_mem[row]; - - if(val > tmp_mem[row]) - { - tmp_mem[row] = val; - out_mem[row] = col; - } - } - } - } - } - else - if(dim == 2) - { - arma_debug_print("op_index_max::apply(): dim = 2"); - - out.zeros(X_n_rows, X_n_cols, (X_n_slices > 0) ? 1 : 0); - - if(out.is_empty() || X.is_empty()) { return; } - - Mat tmp(X.slice_memptr(0), X_n_rows, X_n_cols); // copy slice 0 - - eT* tmp_mem = tmp.memptr(); - uword* out_mem = out.memptr(); - - const uword N = X.n_elem_slice; - - for(uword slice=1; slice < X_n_slices; ++slice) - { - const eT* X_slice_mem = X.slice_memptr(slice); - - for(uword i=0; i < N; ++i) - { - const eT val = X_slice_mem[i]; - - if(val > tmp_mem[i]) - { - tmp_mem[i] = val; - out_mem[i] = slice; - } - } - } - } - } - - - -template -inline -void -op_index_max::apply_noalias(Cube& out, const Cube& X, const uword dim, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename get_pod_type::result T; - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - const uword X_n_slices = X.n_slices; - - if(dim == 0) - { - arma_debug_print("op_index_max::apply(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols, X_n_slices); - - if(out.is_empty() || X.is_empty()) { return; } - - for(uword slice=0; slice < X_n_slices; ++slice) - { - uword* out_mem = out.slice_memptr(slice); - - for(uword col=0; col < X_n_cols; ++col) - { - op_max::direct_max( X.slice_colptr(slice,col), X_n_rows, out_mem[col] ); - } - } - } - else - if(dim == 1) - { - arma_debug_print("op_index_max::apply(): dim = 1"); - - out.zeros(X_n_rows, (X_n_cols > 0) ? 1 : 0, X_n_slices); - - if(out.is_empty() || X.is_empty()) { return; } - - Col tmp(X_n_rows, arma_nozeros_indicator()); - - T* tmp_mem = tmp.memptr(); - - for(uword slice=0; slice < X_n_slices; ++slice) - { - uword* out_mem = out.slice_memptr(slice); - - const eT* col0_mem = X.slice_colptr(slice,0); - - for(uword row=0; row < X_n_rows; ++row) - { - tmp_mem[row] = std::abs( col0_mem[row] ); - } - - for(uword col=1; col < X_n_cols; ++col) - { - const eT* col_mem = X.slice_colptr(slice,col); - - for(uword row=0; row < X_n_rows; ++row) - { - const T val = std::abs( col_mem[row] ); - - if(val > tmp_mem[row]) - { - tmp_mem[row] = val; - out_mem[row] = col; - } - } - } - } - } - else - if(dim == 2) - { - arma_debug_print("op_index_max::apply(): dim = 2"); - - out.zeros(X_n_rows, X_n_cols, (X_n_slices > 0) ? 1 : 0); - - if(out.is_empty() || X.is_empty()) { return; } - - uword* out_mem = out.memptr(); - - Mat tmp(X_n_rows, X_n_cols, arma_nozeros_indicator()); - - T* tmp_mem = tmp.memptr(); - const eT* X_slice0_mem = X.slice_memptr(0); - - const uword N = X.n_elem_slice; - - for(uword i=0; i tmp_mem[i]) - { - tmp_mem[i] = val; - out_mem[i] = slice; - } - } - } - } - } - - - -template -inline -void -op_index_max::apply(Mat& out, const SpBase& expr, const uword dim) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - arma_conform_check( (dim > 1), "index_max(): parameter 'dim' must be 0 or 1" ); - - const unwrap_spmat U(expr.get_ref()); - const SpMat& X = U.M; - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(dim == 0) - { - arma_debug_print("op_index_max::apply(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols); - - if(X_n_rows == 0) { return; } - - uword* out_mem = out.memptr(); - - for(uword col=0; col < X_n_cols; ++col) - { - out_mem[col] = X.col(col).index_max(); - } - } - else - if(dim == 1) - { - arma_debug_print("op_index_max::apply(): dim = 1"); - - out.set_size(X_n_rows, (X_n_cols > 0) ? 1 : 0); - - if(X_n_cols == 0) { return; } - - uword* out_mem = out.memptr(); - - const SpMat Xt = X.st(); - - for(uword row=0; row < X_n_rows; ++row) - { - out_mem[row] = Xt.col(row).index_max(); - } - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_index_min_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_index_min_bones.hpp deleted file mode 100644 index 050b8c0ff..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_index_min_bones.hpp +++ /dev/null @@ -1,57 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_index_min -//! @{ - - -class op_index_min - : public traits_op_xvec - { - public: - - // dense matrices - - template - inline static void apply(Mat& out, const mtOp& in); - - template - inline static void apply_noalias(Mat& out, const Mat& X, const uword dim); - - - // cubes - - template - inline static void apply(Cube& out, const mtOpCube& in); - - template - inline static void apply_noalias(Cube& out, const Cube& X, const uword dim, const typename arma_not_cx::result* junk = nullptr); - - template - inline static void apply_noalias(Cube& out, const Cube& X, const uword dim, const typename arma_cx_only::result* junk = nullptr); - - - // sparse matrices - - template - inline static void apply(Mat& out, const SpBase& expr, const uword dim); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_index_min_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_index_min_meat.hpp deleted file mode 100644 index c0ca9269d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_index_min_meat.hpp +++ /dev/null @@ -1,433 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_index_min -//! @{ - - - -template -inline -void -op_index_min::apply(Mat& out, const mtOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword dim = in.aux_uword_a; - arma_conform_check( (dim > 1), "index_min(): parameter 'dim' must be 0 or 1" ); - - const quasi_unwrap U(in.m); - const Mat& X = U.M; - - if(U.is_alias(out) == false) - { - op_index_min::apply_noalias(out, X, dim); - } - else - { - Mat tmp; - - op_index_min::apply_noalias(tmp, X, dim); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -op_index_min::apply_noalias(Mat& out, const Mat& X, const uword dim) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(dim == 0) - { - arma_debug_print("op_index_min::apply(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols); - - if(X_n_rows == 0) { return; } - - uword* out_mem = out.memptr(); - - for(uword col=0; col < X_n_cols; ++col) - { - op_min::direct_min( X.colptr(col), X_n_rows, out_mem[col] ); - } - } - else - if(dim == 1) - { - arma_debug_print("op_index_min::apply(): dim = 1"); - - out.zeros(X_n_rows, (X_n_cols > 0) ? 1 : 0); - - if(X_n_cols == 0) { return; } - - uword* out_mem = out.memptr(); - - Col tmp(X_n_rows, arma_nozeros_indicator()); - - T* tmp_mem = tmp.memptr(); - - if(is_cx::yes) - { - const eT* col_mem = X.colptr(0); - - for(uword row=0; row < X_n_rows; ++row) - { - tmp_mem[row] = eop_aux::arma_abs(col_mem[row]); - } - } - else - { - arrayops::copy(tmp_mem, (T*)(X.colptr(0)), X_n_rows); - } - - for(uword col=1; col < X_n_cols; ++col) - { - const eT* col_mem = X.colptr(col); - - for(uword row=0; row < X_n_rows; ++row) - { - T& min_val = tmp_mem[row]; - T col_val = (is_cx::yes) ? T(eop_aux::arma_abs(col_mem[row])) : T(access::tmp_real(col_mem[row])); - - if(min_val > col_val) - { - min_val = col_val; - - out_mem[row] = col; - } - } - } - } - } - - - -template -inline -void -op_index_min::apply(Cube& out, const mtOpCube& in) - { - arma_debug_sigprint(); - - const uword dim = in.aux_uword_a; - arma_conform_check( (dim > 2), "index_min(): parameter 'dim' must be 0 or 1 or 2" ); - - const unwrap_cube U(in.m); - - if(U.is_alias(out) == false) - { - op_index_min::apply_noalias(out, U.M, dim); - } - else - { - Cube tmp; - - op_index_min::apply_noalias(tmp, U.M, dim); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -op_index_min::apply_noalias(Cube& out, const Cube& X, const uword dim, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - const uword X_n_slices = X.n_slices; - - if(dim == 0) - { - arma_debug_print("op_index_min::apply(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols, X_n_slices); - - if(out.is_empty() || X.is_empty()) { return; } - - for(uword slice=0; slice < X_n_slices; ++slice) - { - uword* out_mem = out.slice_memptr(slice); - - for(uword col=0; col < X_n_cols; ++col) - { - op_min::direct_min( X.slice_colptr(slice,col), X_n_rows, out_mem[col] ); - } - } - } - else - if(dim == 1) - { - arma_debug_print("op_index_min::apply(): dim = 1"); - - out.zeros(X_n_rows, (X_n_cols > 0) ? 1 : 0, X_n_slices); - - if(out.is_empty() || X.is_empty()) { return; } - - Col tmp(X_n_rows, arma_nozeros_indicator()); - - eT* tmp_mem = tmp.memptr(); - - for(uword slice=0; slice < X_n_slices; ++slice) - { - uword* out_mem = out.slice_memptr(slice); - - arrayops::copy(tmp_mem, X.slice_colptr(slice,0), X_n_rows); - - for(uword col=1; col < X_n_cols; ++col) - { - const eT* col_mem = X.slice_colptr(slice,col); - - for(uword row=0; row < X_n_rows; ++row) - { - const eT val = col_mem[row]; - - if(val < tmp_mem[row]) - { - tmp_mem[row] = val; - out_mem[row] = col; - } - } - } - } - } - else - if(dim == 2) - { - arma_debug_print("op_index_min::apply(): dim = 2"); - - out.zeros(X_n_rows, X_n_cols, (X_n_slices > 0) ? 1 : 0); - - if(out.is_empty() || X.is_empty()) { return; } - - Mat tmp(X.slice_memptr(0), X_n_rows, X_n_cols); // copy slice 0 - - eT* tmp_mem = tmp.memptr(); - uword* out_mem = out.memptr(); - - const uword N = X.n_elem_slice; - - for(uword slice=1; slice < X_n_slices; ++slice) - { - const eT* X_slice_mem = X.slice_memptr(slice); - - for(uword i=0; i < N; ++i) - { - const eT val = X_slice_mem[i]; - - if(val < tmp_mem[i]) - { - tmp_mem[i] = val; - out_mem[i] = slice; - } - } - } - } - } - - - -template -inline -void -op_index_min::apply_noalias(Cube& out, const Cube& X, const uword dim, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename get_pod_type::result T; - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - const uword X_n_slices = X.n_slices; - - if(dim == 0) - { - arma_debug_print("op_index_min::apply(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols, X_n_slices); - - if(out.is_empty() || X.is_empty()) { return; } - - for(uword slice=0; slice < X_n_slices; ++slice) - { - uword* out_mem = out.slice_memptr(slice); - - for(uword col=0; col < X_n_cols; ++col) - { - op_min::direct_min( X.slice_colptr(slice,col), X_n_rows, out_mem[col] ); - } - } - } - else - if(dim == 1) - { - arma_debug_print("op_index_min::apply(): dim = 1"); - - out.zeros(X_n_rows, (X_n_cols > 0) ? 1 : 0, X_n_slices); - - if(out.is_empty() || X.is_empty()) { return; } - - Col tmp(X_n_rows, arma_nozeros_indicator()); - - T* tmp_mem = tmp.memptr(); - - for(uword slice=0; slice < X_n_slices; ++slice) - { - uword* out_mem = out.slice_memptr(slice); - - const eT* col0_mem = X.slice_colptr(slice,0); - - for(uword row=0; row < X_n_rows; ++row) - { - tmp_mem[row] = std::abs( col0_mem[row] ); - } - - for(uword col=1; col < X_n_cols; ++col) - { - const eT* col_mem = X.slice_colptr(slice,col); - - for(uword row=0; row < X_n_rows; ++row) - { - const T val = std::abs( col_mem[row] ); - - if(val < tmp_mem[row]) - { - tmp_mem[row] = val; - out_mem[row] = col; - } - } - } - } - } - else - if(dim == 2) - { - arma_debug_print("op_index_min::apply(): dim = 2"); - - out.zeros(X_n_rows, X_n_cols, (X_n_slices > 0) ? 1 : 0); - - if(out.is_empty() || X.is_empty()) { return; } - - uword* out_mem = out.memptr(); - - Mat tmp(X_n_rows, X_n_cols, arma_nozeros_indicator()); - - T* tmp_mem = tmp.memptr(); - const eT* X_slice0_mem = X.slice_memptr(0); - - const uword N = X.n_elem_slice; - - for(uword i=0; i -inline -void -op_index_min::apply(Mat& out, const SpBase& expr, const uword dim) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - arma_conform_check( (dim > 1), "index_min(): parameter 'dim' must be 0 or 1" ); - - const unwrap_spmat U(expr.get_ref()); - const SpMat& X = U.M; - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(dim == 0) - { - arma_debug_print("op_index_min::apply(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols); - - if(X_n_rows == 0) { return; } - - uword* out_mem = out.memptr(); - - for(uword col=0; col < X_n_cols; ++col) - { - out_mem[col] = X.col(col).index_min(); - } - } - else - if(dim == 1) - { - arma_debug_print("op_index_min::apply(): dim = 1"); - - out.set_size(X_n_rows, (X_n_cols > 0) ? 1 : 0); - - if(X_n_cols == 0) { return; } - - uword* out_mem = out.memptr(); - - const SpMat Xt = X.st(); - - for(uword row=0; row < X_n_rows; ++row) - { - out_mem[row] = Xt.col(row).index_min(); - } - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_inv_gen_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_inv_gen_bones.hpp deleted file mode 100644 index fe952ed1b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_inv_gen_bones.hpp +++ /dev/null @@ -1,143 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_inv_gen -//! @{ - - - -class op_inv_gen_default - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& in); - - template - inline static bool apply_direct(Mat& out, const Base& expr, const char* caller_sig); - }; - - - -class op_inv_gen_full - : public traits_op_default - { - public: - - template - struct pos - { - static constexpr uword n2 = row + col*2; - static constexpr uword n3 = row + col*3; - }; - - template - inline static void apply(Mat& out, const Op& in); - - template - inline static bool apply_direct(Mat& out, const Base& expr, const char* caller_sig, const uword flags); - - template - arma_cold inline static bool apply_tiny_2x2(Mat& X); - - template - arma_cold inline static bool apply_tiny_3x3(Mat& X); - }; - - - -template -struct op_inv_gen_state - { - uword size = uword(0); - T rcond = T(0); - bool is_diag = false; - bool is_sym = false; - }; - - - -class op_inv_gen_rcond - : public traits_op_default - { - public: - - template - inline static bool apply_direct(Mat& out_inv, op_inv_gen_state& out_state, const Base& expr); - }; - - - -namespace inv_opts - { - struct opts - { - const uword flags; - - inline constexpr explicit opts(const uword in_flags); - - inline const opts operator+(const opts& rhs) const; - }; - - inline - constexpr - opts::opts(const uword in_flags) - : flags(in_flags) - {} - - inline - const opts - opts::operator+(const opts& rhs) const - { - const opts result( flags | rhs.flags ); - - return result; - } - - // The values below (eg. 1u << 1) are for internal Armadillo use only. - // The values can change without notice. - - static constexpr uword flag_none = uword(0 ); - static constexpr uword flag_fast = uword(1u << 0); - static constexpr uword flag_tiny = uword(1u << 0); // deprecated - static constexpr uword flag_allow_approx = uword(1u << 1); - static constexpr uword flag_likely_sympd = uword(1u << 2); // deprecated - static constexpr uword flag_no_sympd = uword(1u << 3); // deprecated - static constexpr uword flag_no_ugly = uword(1u << 4); - - struct opts_none : public opts { inline constexpr opts_none() : opts(flag_none ) {} }; - struct opts_fast : public opts { inline constexpr opts_fast() : opts(flag_fast ) {} }; - struct opts_tiny : public opts { inline constexpr opts_tiny() : opts(flag_tiny ) {} }; - struct opts_allow_approx : public opts { inline constexpr opts_allow_approx() : opts(flag_allow_approx) {} }; - struct opts_likely_sympd : public opts { inline constexpr opts_likely_sympd() : opts(flag_likely_sympd) {} }; - struct opts_no_sympd : public opts { inline constexpr opts_no_sympd() : opts(flag_no_sympd ) {} }; - struct opts_no_ugly : public opts { inline constexpr opts_no_ugly() : opts(flag_no_ugly ) {} }; - - static constexpr opts_none none; - static constexpr opts_fast fast; - static constexpr opts_tiny tiny; - static constexpr opts_allow_approx allow_approx; - static constexpr opts_likely_sympd likely_sympd; - static constexpr opts_no_sympd no_sympd; - static constexpr opts_no_ugly no_ugly; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_inv_gen_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_inv_gen_meat.hpp deleted file mode 100644 index c08ed33e1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_inv_gen_meat.hpp +++ /dev/null @@ -1,428 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_inv_gen -//! @{ - - - -template -inline -void -op_inv_gen_default::apply(Mat& out, const Op& X) - { - arma_debug_sigprint(); - - const bool status = op_inv_gen_default::apply_direct(out, X.m, "inv()"); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("inv(): matrix is singular"); - } - } - - - -template -inline -bool -op_inv_gen_default::apply_direct(Mat& out, const Base& expr, const char* caller_sig) - { - arma_debug_sigprint(); - - return op_inv_gen_full::apply_direct(out, expr, caller_sig, uword(0)); - } - - - -// - - - -template -inline -void -op_inv_gen_full::apply(Mat& out, const Op& X) - { - arma_debug_sigprint(); - - const uword flags = X.aux_uword_a; - - const bool status = op_inv_gen_full::apply_direct(out, X.m, "inv()", flags); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("inv(): matrix is singular"); - } - } - - - -template -inline -bool -op_inv_gen_full::apply_direct(Mat& out, const Base& expr, const char* caller_sig, const uword flags) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - if(has_user_flags == true ) { arma_debug_print("op_inv_gen_full: has_user_flags = true"); } - if(has_user_flags == false) { arma_debug_print("op_inv_gen_full: has_user_flags = false"); } - - const bool fast = has_user_flags && bool(flags & inv_opts::flag_fast ); - const bool allow_approx = has_user_flags && bool(flags & inv_opts::flag_allow_approx); - const bool no_ugly = has_user_flags && bool(flags & inv_opts::flag_no_ugly ); - - if(has_user_flags) - { - arma_debug_print("op_inv_gen_full: enabled flags:"); - - if(fast ) { arma_debug_print("fast"); } - if(allow_approx) { arma_debug_print("allow_approx"); } - if(no_ugly ) { arma_debug_print("no_ugly"); } - - arma_conform_check( (fast && allow_approx), "inv(): options 'fast' and 'allow_approx' are mutually exclusive" ); - arma_conform_check( (fast && no_ugly ), "inv(): options 'fast' and 'no_ugly' are mutually exclusive" ); - arma_conform_check( (no_ugly && allow_approx), "inv(): options 'no_ugly' and 'allow_approx' are mutually exclusive" ); - } - - if(no_ugly) - { - op_inv_gen_state inv_state; - - const bool status = op_inv_gen_rcond::apply_direct(out, inv_state, expr); - - // workaround for bug in gcc 4.8 - const uword local_size = inv_state.size; - const T local_rcond = inv_state.rcond; - - if((status == false) || (local_rcond < ((std::max)(local_size, uword(1)) * std::numeric_limits::epsilon())) || arma_isnan(local_rcond)) { return false; } - - return true; - } - - if(allow_approx) - { - op_inv_gen_state inv_state; - - Mat tmp; - - const bool status = op_inv_gen_rcond::apply_direct(tmp, inv_state, expr); - - // workaround for bug in gcc 4.8 - const uword local_size = inv_state.size; - const T local_rcond = inv_state.rcond; - - if((status == false) || (local_rcond < ((std::max)(local_size, uword(1)) * std::numeric_limits::epsilon())) || arma_isnan(local_rcond)) - { - Mat A = expr.get_ref(); - - if(inv_state.is_diag) { return op_pinv::apply_diag(out, A, T(0) ); } - if(inv_state.is_sym ) { return op_pinv::apply_sym (out, A, T(0), uword(0)); } - - return op_pinv::apply_gen(out, A, T(0), uword(0)); - } - - out.steal_mem(tmp); - - return true; - } - - out = expr.get_ref(); - - arma_conform_check( (out.is_square() == false), caller_sig, ": given matrix must be square sized", [&](){ out.soft_reset(); } ); - - const uword N = out.n_rows; - - if(N == 0) { return true; } - - if(is_cx::no) - { - if(N == 1) - { - const eT a = out[0]; - - out[0] = eT(1) / a; - - return (a != eT(0)); - } - else - if(N == 2) - { - const bool status = op_inv_gen_full::apply_tiny_2x2(out); - - if(status) { return true; } - } - else - if(N == 3) - { - const bool status = op_inv_gen_full::apply_tiny_3x3(out); - - if(status) { return true; } - } - - // fallthrough if optimisation failed - } - - if(is_op_diagmat::value || out.is_diagmat()) - { - arma_debug_print("op_inv_gen_full: detected diagonal matrix"); - - eT* colmem = out.memptr(); - - for(uword i=0; i strip(expr.get_ref()); - - const bool is_triu_expr = strip.do_triu; - const bool is_tril_expr = strip.do_tril; - - const bool is_triu_mat = (is_triu_expr || is_tril_expr) ? false : ( trimat_helper::is_triu(out)); - const bool is_tril_mat = (is_triu_expr || is_tril_expr) ? false : ((is_triu_mat) ? false : trimat_helper::is_tril(out)); - - if(is_triu_expr || is_tril_expr || is_triu_mat || is_tril_mat) - { - return auxlib::inv_tr(out, ((is_triu_expr || is_triu_mat) ? uword(0) : uword(1))); - } - - const bool try_sympd = arma_config::optimise_sym && sym_helper::guess_sympd(out); - - if(try_sympd) - { - arma_debug_print("op_inv_gen_full: attempting sympd optimisation"); - - Mat tmp = out; - - bool sympd_state = false; - - const bool status = auxlib::inv_sympd(tmp, sympd_state); - - if(status) { out.steal_mem(tmp); return true; } - - if((status == false) && (sympd_state == true)) { return false; } - - arma_debug_print("op_inv_gen_full: sympd optimisation failed"); - - // fallthrough if optimisation failed - } - - return auxlib::inv(out); - } - - - -template -inline -bool -op_inv_gen_full::apply_tiny_2x2(Mat& X) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - // NOTE: assuming matrix X is square sized - - constexpr T det_min = std::numeric_limits::epsilon(); - constexpr T det_max = T(1) / std::numeric_limits::epsilon(); - - eT* Xm = X.memptr(); - - const eT a = Xm[pos<0,0>::n2]; - const eT b = Xm[pos<0,1>::n2]; - const eT c = Xm[pos<1,0>::n2]; - const eT d = Xm[pos<1,1>::n2]; - - const eT det_val = (a*d - b*c); - const T abs_det_val = std::abs(det_val); - - if((abs_det_val < det_min) || (abs_det_val > det_max) || arma_isnan(det_val)) { return false; } - - Xm[pos<0,0>::n2] = d / det_val; - Xm[pos<0,1>::n2] = -b / det_val; - Xm[pos<1,0>::n2] = -c / det_val; - Xm[pos<1,1>::n2] = a / det_val; - - return true; - } - - - -template -inline -bool -op_inv_gen_full::apply_tiny_3x3(Mat& X) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - // NOTE: assuming matrix X is square sized - - constexpr T det_min = std::numeric_limits::epsilon(); - constexpr T det_max = T(1) / std::numeric_limits::epsilon(); - - Mat Y(3, 3, arma_nozeros_indicator()); - - eT* Xm = X.memptr(); - eT* Ym = Y.memptr(); - - const eT det_val = op_det::apply_tiny_3x3(X); - const T abs_det_val = std::abs(det_val); - - if((abs_det_val < det_min) || (abs_det_val > det_max) || arma_isnan(det_val)) { return false; } - - Ym[pos<0,0>::n3] = (Xm[pos<2,2>::n3]*Xm[pos<1,1>::n3] - Xm[pos<2,1>::n3]*Xm[pos<1,2>::n3]) / det_val; - Ym[pos<1,0>::n3] = -(Xm[pos<2,2>::n3]*Xm[pos<1,0>::n3] - Xm[pos<2,0>::n3]*Xm[pos<1,2>::n3]) / det_val; - Ym[pos<2,0>::n3] = (Xm[pos<2,1>::n3]*Xm[pos<1,0>::n3] - Xm[pos<2,0>::n3]*Xm[pos<1,1>::n3]) / det_val; - - Ym[pos<0,1>::n3] = -(Xm[pos<2,2>::n3]*Xm[pos<0,1>::n3] - Xm[pos<2,1>::n3]*Xm[pos<0,2>::n3]) / det_val; - Ym[pos<1,1>::n3] = (Xm[pos<2,2>::n3]*Xm[pos<0,0>::n3] - Xm[pos<2,0>::n3]*Xm[pos<0,2>::n3]) / det_val; - Ym[pos<2,1>::n3] = -(Xm[pos<2,1>::n3]*Xm[pos<0,0>::n3] - Xm[pos<2,0>::n3]*Xm[pos<0,1>::n3]) / det_val; - - Ym[pos<0,2>::n3] = (Xm[pos<1,2>::n3]*Xm[pos<0,1>::n3] - Xm[pos<1,1>::n3]*Xm[pos<0,2>::n3]) / det_val; - Ym[pos<1,2>::n3] = -(Xm[pos<1,2>::n3]*Xm[pos<0,0>::n3] - Xm[pos<1,0>::n3]*Xm[pos<0,2>::n3]) / det_val; - Ym[pos<2,2>::n3] = (Xm[pos<1,1>::n3]*Xm[pos<0,0>::n3] - Xm[pos<1,0>::n3]*Xm[pos<0,1>::n3]) / det_val; - - const eT check_val = Xm[pos<0,0>::n3]*Ym[pos<0,0>::n3] + Xm[pos<0,1>::n3]*Ym[pos<1,0>::n3] + Xm[pos<0,2>::n3]*Ym[pos<2,0>::n3]; - - const T max_diff = (is_float::value) ? T(1e-4) : T(1e-10); // empirically determined; may need tuning - - if(std::abs(T(1) - check_val) >= max_diff) { return false; } - - arrayops::copy(Xm, Ym, uword(3*3)); - - return true; - } - - - -template -inline -bool -op_inv_gen_rcond::apply_direct(Mat& out, op_inv_gen_state& out_state, const Base& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - out = expr.get_ref(); - out_state.size = out.n_rows; - out_state.rcond = T(0); - - arma_conform_check( (out.is_square() == false), "inv(): given matrix must be square sized", [&](){ out.soft_reset(); } ); - - if(is_op_diagmat::value || out.is_diagmat()) - { - arma_debug_print("op_inv_gen_rcond: detected diagonal matrix"); - - out_state.is_diag = true; - - eT* colmem = out.memptr(); - - T max_abs_src_val = T(0); - T max_abs_inv_val = T(0); - - const uword N = out.n_rows; - - for(uword i=0; i max_abs_src_val) ? abs_src_val : max_abs_src_val; - max_abs_inv_val = (abs_inv_val > max_abs_inv_val) ? abs_inv_val : max_abs_inv_val; - - colmem += N; - } - - out_state.rcond = T(1) / (max_abs_src_val * max_abs_inv_val); - - return true; - } - - const strip_trimat strip(expr.get_ref()); - - const bool is_triu_expr = strip.do_triu; - const bool is_tril_expr = strip.do_tril; - - const bool is_triu_mat = (is_triu_expr || is_tril_expr) ? false : ( trimat_helper::is_triu(out)); - const bool is_tril_mat = (is_triu_expr || is_tril_expr) ? false : ((is_triu_mat) ? false : trimat_helper::is_tril(out)); - - if(is_triu_expr || is_tril_expr || is_triu_mat || is_tril_mat) - { - return auxlib::inv_tr_rcond(out, out_state.rcond, ((is_triu_expr || is_triu_mat) ? uword(0) : uword(1))); - } - - const bool try_sympd = arma_config::optimise_sym && ((auxlib::crippled_lapack(out)) ? false : sym_helper::guess_sympd(out)); - - if(try_sympd) - { - arma_debug_print("op_inv_gen_rcond: attempting sympd optimisation"); - - out_state.is_sym = true; - - Mat tmp = out; - - bool sympd_state = false; - - const bool status = auxlib::inv_sympd_rcond(tmp, sympd_state, out_state.rcond); - - if(status) { out.steal_mem(tmp); return true; } - - if((status == false) && (sympd_state == true)) { return false; } - - arma_debug_print("op_inv_gen_rcond: sympd optimisation failed"); - - // fallthrough if optimisation failed - } - - return auxlib::inv_rcond(out, out_state.rcond); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_inv_spd_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_inv_spd_bones.hpp deleted file mode 100644 index 85a501321..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_inv_spd_bones.hpp +++ /dev/null @@ -1,76 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_inv_spd -//! @{ - - - -class op_inv_spd_default - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& in); - - template - inline static bool apply_direct(Mat& out, const Base& expr); - }; - - - -class op_inv_spd_full - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& in); - - template - inline static bool apply_direct(Mat& out, const Base& expr, const uword flags); - - template - arma_cold inline static bool apply_tiny_2x2(Mat& X); - }; - - - -template -struct op_inv_spd_state - { - uword size = uword(0); - T rcond = T(0); - bool is_diag = false; - }; - - - -class op_inv_spd_rcond - : public traits_op_default - { - public: - - template - inline static bool apply_direct(Mat& out_inv, op_inv_spd_state& out_state, const Base& expr); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_inv_spd_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_inv_spd_meat.hpp deleted file mode 100644 index 13994e38a..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_inv_spd_meat.hpp +++ /dev/null @@ -1,365 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_inv_spd -//! @{ - - - -template -inline -void -op_inv_spd_default::apply(Mat& out, const Op& X) - { - arma_debug_sigprint(); - - const bool status = op_inv_spd_default::apply_direct(out, X.m); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("inv_sympd(): matrix is singular or not positive definite"); - } - } - - - -template -inline -bool -op_inv_spd_default::apply_direct(Mat& out, const Base& expr) - { - arma_debug_sigprint(); - - return op_inv_spd_full::apply_direct(out, expr, uword(0)); - } - - - -// - - - -template -inline -void -op_inv_spd_full::apply(Mat& out, const Op& X) - { - arma_debug_sigprint(); - - const uword flags = X.aux_uword_a; - - const bool status = op_inv_spd_full::apply_direct(out, X.m, flags); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("inv_sympd(): matrix is singular or not positive definite"); - } - } - - - -template -inline -bool -op_inv_spd_full::apply_direct(Mat& out, const Base& expr, const uword flags) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - if(has_user_flags == true ) { arma_debug_print("op_inv_spd_full: has_user_flags = true"); } - if(has_user_flags == false) { arma_debug_print("op_inv_spd_full: has_user_flags = false"); } - - const bool fast = has_user_flags && bool(flags & inv_opts::flag_fast ); - const bool allow_approx = has_user_flags && bool(flags & inv_opts::flag_allow_approx); - const bool no_ugly = has_user_flags && bool(flags & inv_opts::flag_no_ugly ); - - if(has_user_flags) - { - arma_debug_print("op_inv_spd_full: enabled flags:"); - - if(fast ) { arma_debug_print("fast"); } - if(allow_approx) { arma_debug_print("allow_approx"); } - if(no_ugly ) { arma_debug_print("no_ugly"); } - - arma_conform_check( (fast && allow_approx), "inv_sympd(): options 'fast' and 'allow_approx' are mutually exclusive" ); - arma_conform_check( (fast && no_ugly ), "inv_sympd(): options 'fast' and 'no_ugly' are mutually exclusive" ); - arma_conform_check( (no_ugly && allow_approx), "inv_sympd(): options 'no_ugly' and 'allow_approx' are mutually exclusive" ); - } - - if(no_ugly) - { - op_inv_spd_state inv_state; - - const bool status = op_inv_spd_rcond::apply_direct(out, inv_state, expr); - - // workaround for bug in gcc 4.8 - const uword local_size = inv_state.size; - const T local_rcond = inv_state.rcond; - - if((status == false) || (local_rcond < ((std::max)(local_size, uword(1)) * std::numeric_limits::epsilon())) || arma_isnan(local_rcond)) { return false; } - - return true; - } - - if(allow_approx) - { - op_inv_spd_state inv_state; - - Mat tmp; - - const bool status = op_inv_spd_rcond::apply_direct(tmp, inv_state, expr); - - // workaround for bug in gcc 4.8 - const uword local_size = inv_state.size; - const T local_rcond = inv_state.rcond; - - if((status == false) || (local_rcond < ((std::max)(local_size, uword(1)) * std::numeric_limits::epsilon())) || arma_isnan(local_rcond)) - { - const Mat A = expr.get_ref(); - - if(inv_state.is_diag) { return op_pinv::apply_diag(out, A, T(0)); } - - return op_pinv::apply_sym(out, A, T(0), uword(0)); - } - - out.steal_mem(tmp); - - return true; - } - - out = expr.get_ref(); - - arma_conform_check( (out.is_square() == false), "inv_sympd(): given matrix must be square sized", [&](){ out.soft_reset(); } ); - - if((arma_config::check_conform) && (arma_config::warn_level > 0)) - { - if(auxlib::rudimentary_sym_check(out) == false) - { - if(is_cx::no ) { arma_warn(1, "inv_sympd(): given matrix is not symmetric"); } - if(is_cx::yes) { arma_warn(1, "inv_sympd(): given matrix is not hermitian"); } - } - else - if((is_cx::yes) && (sym_helper::check_diag_imag(out) == false)) - { - arma_warn(1, "inv_sympd(): imaginary components on diagonal are non-zero"); - } - } - - const uword N = out.n_rows; - - if(N == 0) { return true; } - - if(is_cx::no) - { - if(N == 1) - { - const T a = access::tmp_real(out[0]); - - out[0] = eT(T(1) / a); - - return (a > T(0)); - } - else - if(N == 2) - { - const bool status = op_inv_spd_full::apply_tiny_2x2(out); - - if(status) { return true; } - } - - // fallthrough if optimisation failed - } - - if(is_op_diagmat::value || out.is_diagmat()) - { - arma_debug_print("op_inv_spd_full: detected diagonal matrix"); - - eT* colmem = out.memptr(); - - for(uword i=0; i -inline -bool -op_inv_spd_full::apply_tiny_2x2(Mat& X) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - // NOTE: assuming matrix X is square sized - // NOTE: assuming matrix X is symmetric - // NOTE: assuming matrix X is real - - constexpr T det_min = std::numeric_limits::epsilon(); - constexpr T det_max = T(1) / std::numeric_limits::epsilon(); - - eT* Xm = X.memptr(); - - T a = access::tmp_real(Xm[0]); - T c = access::tmp_real(Xm[1]); - T d = access::tmp_real(Xm[3]); - - const T det_val = (a*d - c*c); - - // positive definite iff all leading principal minors are positive - // a = first leading principal minor (top-left 1x1 submatrix) - // det_val = second leading principal minor (top-left 2x2 submatrix) - - if(a <= T(0)) { return false; } - - // NOTE: since det_min is positive, this also checks whether det_val is positive - if((det_val < det_min) || (det_val > det_max) || arma_isnan(det_val)) { return false; } - - d /= det_val; - c /= det_val; - a /= det_val; - - Xm[0] = d; - Xm[1] = -c; - Xm[2] = -c; - Xm[3] = a; - - return true; - } - - - -// - - - -template -inline -bool -op_inv_spd_rcond::apply_direct(Mat& out, op_inv_spd_state& out_state, const Base& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - out = expr.get_ref(); - out_state.size = out.n_rows; - out_state.rcond = T(0); - - arma_conform_check( (out.is_square() == false), "inv_sympd(): given matrix must be square sized", [&](){ out.soft_reset(); } ); - - if((arma_config::check_conform) && (arma_config::warn_level > 0)) - { - if(auxlib::rudimentary_sym_check(out) == false) - { - if(is_cx::no ) { arma_warn(1, "inv_sympd(): given matrix is not symmetric"); } - if(is_cx::yes) { arma_warn(1, "inv_sympd(): given matrix is not hermitian"); } - } - else - if((is_cx::yes) && (sym_helper::check_diag_imag(out) == false)) - { - arma_warn(1, "inv_sympd(): imaginary components on diagonal are non-zero"); - } - } - - if(is_op_diagmat::value || out.is_diagmat()) - { - arma_debug_print("op_inv_spd_rcond: detected diagonal matrix"); - - out_state.is_diag = true; - - eT* colmem = out.memptr(); - - T max_abs_src_val = T(0); - T max_abs_inv_val = T(0); - - const uword N = out.n_rows; - - for(uword i=0; i max_abs_src_val) ? abs_src_val : max_abs_src_val; - max_abs_inv_val = (abs_inv_val > max_abs_inv_val) ? abs_inv_val : max_abs_inv_val; - - colmem += N; - } - - out_state.rcond = T(1) / (max_abs_src_val * max_abs_inv_val); - - return true; - } - - if(auxlib::crippled_lapack(out)) - { - arma_debug_print("op_inv_spd_rcond: workaround for crippled lapack"); - - Mat tmp = out; - - bool sympd_state = false; - - auxlib::inv_sympd(out, sympd_state); - - if(sympd_state == false) { out.soft_reset(); out_state.rcond = T(0); return false; } - - out_state.rcond = auxlib::rcond(tmp); - - if(out_state.rcond == T(0)) { out.soft_reset(); return false; } - - return true; - } - - bool is_sympd_junk = false; - - return auxlib::inv_sympd_rcond(out, is_sympd_junk, out_state.rcond); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_log_det_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_log_det_bones.hpp deleted file mode 100644 index e2f3daf0d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_log_det_bones.hpp +++ /dev/null @@ -1,52 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_log_det -//! @{ - - - -class op_log_det - : public traits_op_default - { - public: - - template - inline static bool apply_direct(typename T1::elem_type& out_val, typename T1::pod_type& out_sign, const Base& expr); - - template - inline static bool apply_diagmat(typename T1::elem_type& out_val, typename T1::pod_type& out_sign, const Base& expr); - - template - inline static bool apply_trimat(typename T1::elem_type& out_val, typename T1::pod_type& out_sign, const Base& expr); - }; - - - -class op_log_det_sympd - : public traits_op_default - { - public: - - template - inline static bool apply_direct(typename T1::pod_type& out_val, const Base& expr); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_log_det_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_log_det_meat.hpp deleted file mode 100644 index 5601597d6..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_log_det_meat.hpp +++ /dev/null @@ -1,239 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_log_det -//! @{ - - - -template -inline -bool -op_log_det::apply_direct(typename T1::elem_type& out_val, typename T1::pod_type& out_sign, const Base& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - // typedef typename T1::pod_type T; - - if(strip_diagmat::do_diagmat) - { - const strip_diagmat strip(expr.get_ref()); - - return op_log_det::apply_diagmat(out_val, out_sign, strip.M); - } - - if(strip_trimat::do_trimat) - { - const strip_trimat strip(expr.get_ref()); - - return op_log_det::apply_trimat(out_val, out_sign, strip.M); - } - - Mat A(expr.get_ref()); - - arma_conform_check( (A.is_square() == false), "log_det(): given matrix must be square sized" ); - - if(A.is_diagmat()) { return op_log_det::apply_diagmat(out_val, out_sign, A); } - - const bool is_triu = trimat_helper::is_triu(A); - const bool is_tril = is_triu ? false : trimat_helper::is_tril(A); - - if(is_triu || is_tril) { return op_log_det::apply_trimat(out_val, out_sign, A); } - - // const bool try_sympd = arma_config::optimise_sym && sym_helper::guess_sympd(A); - // - // if(try_sympd) - // { - // arma_debug_print("op_log_det: attempting sympd optimisation"); - // - // T out_val_real = T(0); - // - // const bool status = auxlib::log_det_sympd(out_val_real, A); - // - // if(status) - // { - // out_val = eT(out_val_real); - // out_sign = T(1); - // - // return true; - // } - // - // arma_debug_print("op_log_det: sympd optimisation failed"); - // - // // restore A as it's destroyed by auxlib::log_det_sympd() - // A = expr.get_ref(); - // - // // fallthrough to the next return statement - // } - - return auxlib::log_det(out_val, out_sign, A); - } - - - -template -inline -bool -op_log_det::apply_diagmat(typename T1::elem_type& out_val, typename T1::pod_type& out_sign, const Base& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const diagmat_proxy A(expr.get_ref()); - - arma_conform_check( (A.n_rows != A.n_cols), "log_det(): given matrix must be square sized" ); - - const uword N = (std::min)(A.n_rows, A.n_cols); - - if(N == 0) - { - out_val = eT(0); - out_sign = T(1); - - return true; - } - - eT x = A[0]; - - T sign = (is_cx::no) ? ( (access::tmp_real(x) < T(0)) ? T(-1) : T(1) ) : T(1); - eT val = (is_cx::no) ? std::log( (access::tmp_real(x) < T(0)) ? x*T(-1) : x ) : std::log(x); - - for(uword i=1; i::no) ? ( (access::tmp_real(x) < T(0)) ? T(-1) : T(1) ) : T(1); - val += (is_cx::no) ? std::log( (access::tmp_real(x) < T(0)) ? x*T(-1) : x ) : std::log(x); - } - - out_val = val; - out_sign = sign; - - return (arma_isnan(out_val) == false); - } - - - -template -inline -bool -op_log_det::apply_trimat(typename T1::elem_type& out_val, typename T1::pod_type& out_sign, const Base& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const Proxy P(expr.get_ref()); - - const uword N = P.get_n_rows(); - - arma_conform_check( (N != P.get_n_cols()), "log_det(): given matrix must be square sized" ); - - if(N == 0) - { - out_val = eT(0); - out_sign = T(1); - - return true; - } - - eT x = P.at(0,0); - - T sign = (is_cx::no) ? ( (access::tmp_real(x) < T(0)) ? T(-1) : T(1) ) : T(1); - eT val = (is_cx::no) ? std::log( (access::tmp_real(x) < T(0)) ? x*T(-1) : x ) : std::log(x); - - for(uword i=1; i::no) ? ( (access::tmp_real(x) < T(0)) ? T(-1) : T(1) ) : T(1); - val += (is_cx::no) ? std::log( (access::tmp_real(x) < T(0)) ? x*T(-1) : x ) : std::log(x); - } - - out_val = val; - out_sign = sign; - - return (arma_isnan(out_val) == false); - } - - - -// - - - -template -inline -bool -op_log_det_sympd::apply_direct(typename T1::pod_type& out_val, const Base& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - Mat A(expr.get_ref()); - - arma_conform_check( (A.is_square() == false), "log_det_sympd(): given matrix must be square sized" ); - - if((arma_config::check_conform) && (arma_config::warn_level > 0) && (is_cx::yes) && (sym_helper::check_diag_imag(A) == false)) - { - arma_warn(1, "log_det_sympd(): imaginary components on diagonal are non-zero"); - } - - if(is_op_diagmat::value || A.is_diagmat()) - { - arma_debug_print("op_log_det_sympd: detected diagonal matrix"); - - eT* colmem = A.memptr(); - - out_val = T(0); - - const uword N = A.n_rows; - - for(uword i=0; i::no ) { arma_warn(1, "log_det_sympd(): given matrix is not symmetric"); } - if(is_cx::yes) { arma_warn(1, "log_det_sympd(): given matrix is not hermitian"); } - } - - return auxlib::log_det_sympd(out_val, A); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_logmat_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_logmat_bones.hpp deleted file mode 100644 index 77e967d73..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_logmat_bones.hpp +++ /dev/null @@ -1,82 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_logmat -//! @{ - - - -class op_logmat - : public traits_op_default - { - public: - - template - inline static void apply(Mat< std::complex >& out, const mtOp,T1,op_logmat>& in); - - template - inline static bool apply_direct(Mat< std::complex >& out, const Op& expr, const uword); - - template - inline static bool apply_direct(Mat< std::complex >& out, const Base& expr, const uword n_iters); - }; - - - -class op_logmat_cx - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& in); - - template - inline static bool apply_direct(Mat& out, const Op& expr, const uword); - - template - inline static bool apply_direct_noalias(Mat& out, const diagmat_proxy& P); - - template - inline static bool apply_direct(Mat& out, const Base& expr, const uword n_iters); - - template - inline static bool apply_common(Mat< std::complex >& out, Mat< std::complex >& S, const uword n_iters); - - - template - inline static bool helper(Mat& S, const uword m); - }; - - - -class op_logmat_sympd - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& in); - - template - inline static bool apply_direct(Mat& out, const Base& expr); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_logmat_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_logmat_meat.hpp deleted file mode 100644 index 671366021..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_logmat_meat.hpp +++ /dev/null @@ -1,572 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_logmat -//! @{ - - -// Partly based on algorithm 11.9 (inverse scaling and squaring algorithm with Schur decomposition) in: -// Nicholas J. Higham. -// Functions of Matrices: Theory and Computation. -// SIAM, 2008. -// ISBN 978-0-89871-646-7 - - -template -inline -void -op_logmat::apply(Mat< std::complex >& out, const mtOp,T1,op_logmat>& in) - { - arma_debug_sigprint(); - - const bool status = op_logmat::apply_direct(out, in.m, in.aux_uword_a); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("logmat(): transformation failed"); - } - } - - - -template -inline -bool -op_logmat::apply_direct(Mat< std::complex >& out, const Op& expr, const uword) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type T; - - const diagmat_proxy P(expr.m); - - arma_conform_check( (P.n_rows != P.n_cols), "logmat(): given matrix must be square sized" ); - - const uword N = P.n_rows; - - out.zeros(N,N); // aliasing can't happen as op_logmat is defined as cx_mat = op(mat) - - for(uword i=0; i= T(0)) - { - out.at(i,i) = std::log(val); - } - else - { - out.at(i,i) = std::log( std::complex(val) ); - } - } - - return true; - } - - - -template -inline -bool -op_logmat::apply_direct(Mat< std::complex >& out, const Base& expr, const uword n_iters) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type in_T; - typedef typename std::complex out_T; - - const quasi_unwrap expr_unwrap(expr.get_ref()); - const Mat& A = expr_unwrap.M; - - arma_conform_check( (A.is_square() == false), "logmat(): given matrix must be square sized" ); - - if(A.n_elem == 0) - { - out.reset(); - return true; - } - else - if(A.n_elem == 1) - { - out.set_size(1,1); - out[0] = std::log( std::complex( A[0] ) ); - return true; - } - - if(A.is_diagmat()) - { - arma_debug_print("op_logmat: detected diagonal matrix"); - - const uword N = A.n_rows; - - out.zeros(N,N); // aliasing can't happen as op_logmat is defined as cx_mat = op(mat) - - for(uword i=0; i= in_T(0)) - { - out.at(i,i) = std::log(val); - } - else - { - out.at(i,i) = std::log( out_T(val) ); - } - } - - return true; - } - - const bool try_sympd = arma_config::optimise_sym && sym_helper::guess_sympd(A); - - if(try_sympd) - { - arma_debug_print("op_logmat: attempting sympd optimisation"); - - // if matrix A is sympd, all its eigenvalues are positive - - Col eigval; - Mat eigvec; - - const bool eig_status = eig_sym_helper(eigval, eigvec, A, 'd', "logmat()"); - - if(eig_status) - { - // ensure each eigenvalue is > 0 - - const uword N = eigval.n_elem; - const in_T* eigval_mem = eigval.memptr(); - - bool all_pos = true; - - for(uword i=0; i >::from( eigvec * diagmat(eigval) * eigvec.t() ); - - return true; - } - } - - arma_debug_print("op_logmat: sympd optimisation failed"); - - // fallthrough if eigen decomposition failed or an eigenvalue is <= 0 - } - - - Mat S(A.n_rows, A.n_cols, arma_nozeros_indicator()); - - const in_T* Amem = A.memptr(); - out_T* Smem = S.memptr(); - - const uword n_elem = A.n_elem; - - for(uword i=0; i( Amem[i] ); - } - - return op_logmat_cx::apply_common(out, S, n_iters); - } - - - -template -inline -void -op_logmat_cx::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - const bool status = op_logmat_cx::apply_direct(out, in.m, in.aux_uword_a); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("logmat(): transformation failed"); - } - } - - - -template -inline -bool -op_logmat_cx::apply_direct(Mat& out, const Op& expr, const uword) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const diagmat_proxy P(expr.m); - - bool status = false; - - if(P.is_alias(out)) - { - Mat tmp; - - status = op_logmat_cx::apply_direct_noalias(tmp, P); - - out.steal_mem(tmp); - } - else - { - status = op_logmat_cx::apply_direct_noalias(out, P); - } - - return status; - } - - - -template -inline -bool -op_logmat_cx::apply_direct_noalias(Mat& out, const diagmat_proxy& P) - { - arma_debug_sigprint(); - - arma_conform_check( (P.n_rows != P.n_cols), "logmat(): given matrix must be square sized" ); - - const uword N = P.n_rows; - - out.zeros(N,N); - - for(uword i=0; i -inline -bool -op_logmat_cx::apply_direct(Mat& out, const Base& expr, const uword n_iters) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - typedef typename T1::elem_type eT; - - Mat S = expr.get_ref(); - - arma_conform_check( (S.n_rows != S.n_cols), "logmat(): given matrix must be square sized" ); - - if(S.n_elem == 0) - { - out.reset(); - return true; - } - else - if(S.n_elem == 1) - { - out.set_size(1,1); - out[0] = std::log(S[0]); - return true; - } - - if(S.is_diagmat()) - { - arma_debug_print("op_logmat_cx: detected diagonal matrix"); - - const uword N = S.n_rows; - - out.zeros(N,N); // aliasing can't happen as S is generated - - for(uword i=0; i eigval; - Mat eigvec; - - const bool eig_status = eig_sym_helper(eigval, eigvec, S, 'd', "logmat()"); - - if(eig_status) - { - // ensure each eigenvalue is > 0 - - const uword N = eigval.n_elem; - const T* eigval_mem = eigval.memptr(); - - bool all_pos = true; - - for(uword i=0; i -inline -bool -op_logmat_cx::apply_common(Mat< std::complex >& out, Mat< std::complex >& S, const uword n_iters) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - Mat U; - - const bool schur_ok = auxlib::schur(U,S); - - if(schur_ok == false) { arma_debug_print("logmat(): schur decomposition failed"); return false; } - - // NOTE: theta[0] and theta[1] not really used - double theta[] = { 1.10e-5, 1.82e-3, 1.6206284795015624e-2, 5.3873532631381171e-2, 1.1352802267628681e-1, 1.8662860613541288e-1, 2.642960831111435e-1 }; - - const uword N = S.n_rows; - - uword p = 0; - uword m = 6; - - uword iter = 0; - - while(iter < n_iters) - { - const T tau = norm( (S - eye< Mat >(N,N)), 1 ); - - if(tau <= theta[6]) - { - p++; - - uword j1 = 0; - uword j2 = 0; - - for(uword i=2; i<=6; ++i) { if( tau <= theta[i]) { j1 = i; break; } } - for(uword i=2; i<=6; ++i) { if((tau/2.0) <= theta[i]) { j2 = i; break; } } - - // sanity check, for development purposes only - arma_conform_check( (j2 > j1), "internal error: op_logmat::apply_direct(): j2 > j1" ); - - if( ((j1 - j2) <= 1) || (p == 2) ) { m = j1; break; } - } - - const bool sqrtmat_ok = op_sqrtmat_cx::apply_direct(S,S); - - if(sqrtmat_ok == false) { arma_debug_print("logmat(): sqrtmat() failed"); return false; } - - iter++; - } - - if(iter >= n_iters) { arma_warn(2, "logmat(): reached max iterations without full convergence"); } - - S.diag() -= eT(1); - - if(m >= 1) - { - const bool helper_ok = op_logmat_cx::helper(S,m); - - if(helper_ok == false) { return false; } - } - - out = U * S * U.t(); - - out *= eT(eop_aux::pow(double(2), double(iter))); - - return true; - } - - - -template -inline -bool -op_logmat_cx::helper(Mat& A, const uword m) - { - arma_debug_sigprint(); - - if(A.internal_has_nonfinite()) { return false; } - - const vec indices = regspace(1,m-1); - - mat tmp(m, m, arma_zeros_indicator()); - - tmp.diag(-1) = indices / sqrt(square(2.0*indices) - 1.0); - tmp.diag(+1) = indices / sqrt(square(2.0*indices) - 1.0); - - vec eigval; - mat eigvec; - - const bool eig_ok = eig_sym_helper(eigval, eigvec, tmp, 'd', "logmat()"); - - if(eig_ok == false) { arma_debug_print("logmat(): eig_sym() failed"); return false; } - - const vec nodes = (eigval + 1.0) / 2.0; - const vec weights = square(eigvec.row(0).t()); - - const uword N = A.n_rows; - - Mat B(N, N, arma_zeros_indicator()); - - Mat X; - - for(uword i=0; i < m; ++i) - { - // B += weights(i) * solve( (nodes(i)*A + eye< Mat >(N,N)), A ); - - //const bool solve_ok = solve( X, (nodes(i)*A + eye< Mat >(N,N)), A, solve_opts::fast ); - const bool solve_ok = solve( X, trimatu(nodes(i)*A + eye< Mat >(N,N)), A, solve_opts::no_approx ); - - if(solve_ok == false) { arma_debug_print("logmat(): solve() failed"); return false; } - - B += weights(i) * X; - } - - A = B; - - return true; - } - - - -template -inline -void -op_logmat_sympd::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - const bool status = op_logmat_sympd::apply_direct(out, in.m); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("logmat_sympd(): transformation failed"); - } - } - - - -template -inline -bool -op_logmat_sympd::apply_direct(Mat& out, const Base& expr) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::pod_type T; - typedef typename T1::elem_type eT; - - const unwrap U(expr.get_ref()); - const Mat& X = U.M; - - arma_conform_check( (X.is_square() == false), "logmat_sympd(): given matrix must be square sized" ); - - if((arma_config::check_conform) && (arma_config::warn_level > 0) && (is_cx::yes) && (sym_helper::check_diag_imag(X) == false)) - { - arma_warn(1, "logmat_sympd(): imaginary components on diagonal are non-zero"); - } - - if(is_op_diagmat::value || X.is_diagmat()) - { - arma_debug_print("op_logmat_sympd: detected diagonal matrix"); - - out = X; - - eT* colmem = out.memptr(); - - const uword N = X.n_rows; - - for(uword i=0; i eigval; - Mat eigvec; - - const bool status = eig_sym_helper(eigval, eigvec, X, 'd', "logmat_sympd()"); - - if(status == false) { return false; } - - const uword N = eigval.n_elem; - const T* eigval_mem = eigval.memptr(); - - bool all_pos = true; - - for(uword i=0; i - inline static void apply(Mat& out, const Op& in); - - template - inline static void apply_noalias(Mat& out, const Mat& X, const uword dim, const typename arma_not_cx::result* junk = nullptr); - - template - inline static void apply_noalias(Mat& out, const Mat& X, const uword dim, const typename arma_cx_only::result* junk = nullptr); - - - // - // cubes - - template - inline static void apply(Cube& out, const OpCube& in); - - template - inline static void apply_noalias(Cube& out, const Cube& X, const uword dim, const typename arma_not_cx::result* junk = nullptr); - - template - inline static void apply_noalias(Cube& out, const Cube& X, const uword dim, const typename arma_cx_only::result* junk = nullptr); - - - // - // for non-complex numbers - - template - inline static eT direct_max(const eT* const X, const uword N); - - template - inline static eT direct_max(const eT* const X, const uword N, uword& index_of_max_val); - - template - inline static eT direct_max(const Mat& X, const uword row); - - template - inline static eT max(const subview& X); - - template - inline static typename arma_not_cx::result max(const Base& X); - - template - inline static typename arma_not_cx::result max(const BaseCube& X); - - template - inline static typename arma_not_cx::result max_with_index(const Proxy& P, uword& index_of_max_val); - - template - inline static typename arma_not_cx::result max_with_index(const ProxyCube& P, uword& index_of_max_val); - - - // - // for complex numbers - - template - inline static std::complex direct_max(const std::complex* const X, const uword n_elem); - - template - inline static std::complex direct_max(const std::complex* const X, const uword n_elem, uword& index_of_max_val); - - template - inline static std::complex direct_max(const Mat< std::complex >& X, const uword row); - - template - inline static std::complex max(const subview< std::complex >& X); - - template - inline static typename arma_cx_only::result max(const Base& X); - - template - inline static typename arma_cx_only::result max(const BaseCube& X); - - template - inline static typename arma_cx_only::result max_with_index(const Proxy& P, uword& index_of_max_val); - - template - inline static typename arma_cx_only::result max_with_index(const ProxyCube& P, uword& index_of_max_val); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_max_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_max_meat.hpp deleted file mode 100644 index 5e2b39a4d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_max_meat.hpp +++ /dev/null @@ -1,1325 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_max -//! @{ - - - -template -inline -void -op_max::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword dim = in.aux_uword_a; - arma_conform_check( (dim > 1), "max(): parameter 'dim' must be 0 or 1" ); - - const quasi_unwrap U(in.m); - const Mat& X = U.M; - - if(U.is_alias(out) == false) - { - op_max::apply_noalias(out, X, dim); - } - else - { - Mat tmp; - - op_max::apply_noalias(tmp, X, dim); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -op_max::apply_noalias(Mat& out, const Mat& X, const uword dim, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(dim == 0) - { - arma_debug_print("op_max::apply(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols); - - if(X_n_rows == 0) { return; } - - eT* out_mem = out.memptr(); - - for(uword col=0; col 0) ? 1 : 0); - - if(X_n_cols == 0) { return; } - - eT* out_mem = out.memptr(); - - arrayops::copy(out_mem, X.colptr(0), X_n_rows); - - for(uword col=1; col out_mem[row]) { out_mem[row] = col_val; } - } - } - } - } - - - -template -inline -void -op_max::apply_noalias(Mat& out, const Mat& X, const uword dim, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(dim == 0) - { - arma_debug_print("op_max::apply(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols); - - if(X_n_rows == 0) { return; } - - eT* out_mem = out.memptr(); - - for(uword col=0; col 0) ? 1 : 0); - - if(X_n_cols == 0) { return; } - - eT* out_mem = out.memptr(); - - for(uword row=0; row -inline -void -op_max::apply(Cube& out, const OpCube& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword dim = in.aux_uword_a; - arma_conform_check( (dim > 2), "max(): parameter 'dim' must be 0 or 1 or 2" ); - - const unwrap_cube U(in.m); - - if(U.is_alias(out) == false) - { - op_max::apply_noalias(out, U.M, dim); - } - else - { - Cube tmp; - - op_max::apply_noalias(tmp, U.M, dim); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -op_max::apply_noalias(Cube& out, const Cube& X, const uword dim, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - const uword X_n_slices = X.n_slices; - - if(dim == 0) - { - arma_debug_print("op_max::apply(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols, X_n_slices); - - if(X_n_rows == 0) { return; } - - for(uword slice=0; slice < X_n_slices; ++slice) - { - eT* out_mem = out.slice_memptr(slice); - - for(uword col=0; col < X_n_cols; ++col) - { - out_mem[col] = op_max::direct_max( X.slice_colptr(slice,col), X_n_rows ); - } - } - } - else - if(dim == 1) - { - arma_debug_print("op_max::apply(): dim = 1"); - - out.set_size(X_n_rows, (X_n_cols > 0) ? 1 : 0, X_n_slices); - - if(X_n_cols == 0) { return; } - - for(uword slice=0; slice < X_n_slices; ++slice) - { - eT* out_mem = out.slice_memptr(slice); - - arrayops::copy(out_mem, X.slice_colptr(slice,0), X_n_rows); - - for(uword col=1; col < X_n_cols; ++col) - { - const eT* col_mem = X.slice_colptr(slice,col); - - for(uword row=0; row < X_n_rows; ++row) - { - const eT col_val = col_mem[row]; - - if(col_val > out_mem[row]) { out_mem[row] = col_val; } - } - } - } - } - else - if(dim == 2) - { - arma_debug_print("op_max::apply(): dim = 2"); - - out.set_size(X_n_rows, X_n_cols, (X_n_slices > 0) ? 1 : 0); - - if(X_n_slices == 0) { return; } - - const uword N = X.n_elem_slice; - - eT* out_mem = out.slice_memptr(0); - - arrayops::copy(out_mem, X.slice_memptr(0), N); - - for(uword slice=1; slice < X_n_slices; ++slice) - { - const eT* X_mem = X.slice_memptr(slice); - - for(uword i=0; i < N; ++i) - { - const eT val = X_mem[i]; - - if(val > out_mem[i]) { out_mem[i] = val; } - } - } - } - } - - - -template -inline -void -op_max::apply_noalias(Cube& out, const Cube& X, const uword dim, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - const uword X_n_slices = X.n_slices; - - if(dim == 0) - { - arma_debug_print("op_max::apply(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols, X_n_slices); - - if(X_n_rows == 0) { return; } - - for(uword slice=0; slice < X_n_slices; ++slice) - { - eT* out_mem = out.slice_memptr(slice); - - for(uword col=0; col < X_n_cols; ++col) - { - out_mem[col] = op_max::direct_max( X.slice_colptr(slice,col), X_n_rows ); - } - } - } - else - if(dim == 1) - { - arma_debug_print("op_max::apply(): dim = 1"); - - out.set_size(X_n_rows, (X_n_cols > 0) ? 1 : 0, X_n_slices); - - if(X_n_cols == 0) { return; } - - for(uword slice=0; slice < X_n_slices; ++slice) - { - eT* out_mem = out.slice_memptr(slice); - - const Mat tmp('j', X.slice_memptr(slice), X_n_rows, X_n_cols); - - for(uword row=0; row < X_n_rows; ++row) - { - out_mem[row] = op_max::direct_max(tmp, row); - } - } - } - else - if(dim == 2) - { - arma_debug_print("op_max::apply(): dim = 2"); - - out.set_size(X_n_rows, X_n_cols, (X_n_slices > 0) ? 1 : 0); - - if(X_n_slices == 0) { return; } - - const uword N = X.n_elem_slice; - - eT* out_mem = out.slice_memptr(0); - - arrayops::copy(out_mem, X.slice_memptr(0), N); - - for(uword slice=1; slice < X_n_slices; ++slice) - { - const eT* X_mem = X.slice_memptr(slice); - - for(uword i=0; i < N; ++i) - { - const eT& val = X_mem[i]; - - if(std::abs(val) > std::abs(out_mem[i])) { out_mem[i] = val; } - } - } - } - } - - - -template -inline -eT -op_max::direct_max(const eT* const X, const uword n_elem) - { - arma_debug_sigprint(); - - eT max_val_i = priv::most_neg(); - eT max_val_j = priv::most_neg(); - - uword i,j; - for(i=0, j=1; j max_val_i) { max_val_i = X_i; } - if(X_j > max_val_j) { max_val_j = X_j; } - } - - if(i < n_elem) - { - const eT X_i = X[i]; - - if(X_i > max_val_i) { max_val_i = X_i; } - } - - return (max_val_i > max_val_j) ? max_val_i : max_val_j; - } - - - -template -inline -eT -op_max::direct_max(const eT* const X, const uword n_elem, uword& index_of_max_val) - { - arma_debug_sigprint(); - - eT max_val_i = priv::most_neg(); - eT max_val_j = priv::most_neg(); - - uword best_index_i = 0; - uword best_index_j = 0; - - uword i,j; - for(i=0, j=1; j max_val_i) { max_val_i = X_i; best_index_i = i; } - if(X_j > max_val_j) { max_val_j = X_j; best_index_j = j; } - } - - if(i < n_elem) - { - const eT X_i = X[i]; - - if(X_i > max_val_i) { max_val_i = X_i; best_index_i = i; } - } - - index_of_max_val = (max_val_i > max_val_j) ? best_index_i : best_index_j; - - return (max_val_i > max_val_j) ? max_val_i : max_val_j; - } - - - -template -inline -eT -op_max::direct_max(const Mat& X, const uword row) - { - arma_debug_sigprint(); - - const uword X_n_cols = X.n_cols; - - eT max_val_i = priv::most_neg(); - eT max_val_j = priv::most_neg(); - - uword i,j; - for(i=0, j=1; j < X_n_cols; i+=2, j+=2) - { - const eT tmp_i = X.at(row,i); - const eT tmp_j = X.at(row,j); - - if(tmp_i > max_val_i) { max_val_i = tmp_i; } - if(tmp_j > max_val_j) { max_val_j = tmp_j; } - } - - if(i < X_n_cols) - { - const eT tmp_i = X.at(row,i); - - if(tmp_i > max_val_i) { max_val_i = tmp_i; } - } - - return (max_val_i > max_val_j) ? max_val_i : max_val_j; - } - - - -template -inline -eT -op_max::max(const subview& X) - { - arma_debug_sigprint(); - - if(X.n_elem == 0) - { - arma_conform_check(true, "max(): object has no elements"); - - return Datum::nan; - } - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(X_n_rows == 1) - { - eT max_val_i = priv::most_neg(); - eT max_val_j = priv::most_neg(); - - const Mat& A = X.m; - - const uword start_row = X.aux_row1; - const uword start_col = X.aux_col1; - - const uword end_col_p1 = start_col + X_n_cols; - - uword i,j; - for(i=start_col, j=start_col+1; j < end_col_p1; i+=2, j+=2) - { - const eT tmp_i = A.at(start_row, i); - const eT tmp_j = A.at(start_row, j); - - if(tmp_i > max_val_i) { max_val_i = tmp_i; } - if(tmp_j > max_val_j) { max_val_j = tmp_j; } - } - - if(i < end_col_p1) - { - const eT tmp_i = A.at(start_row, i); - - if(tmp_i > max_val_i) { max_val_i = tmp_i; } - } - - return (max_val_i > max_val_j) ? max_val_i : max_val_j; - } - - eT max_val = priv::most_neg(); - - for(uword col=0; col < X_n_cols; ++col) - { - max_val = (std::max)(max_val, op_max::direct_max(X.colptr(col), X_n_rows)); - } - - return max_val; - } - - - -template -inline -typename arma_not_cx::result -op_max::max(const Base& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const Proxy P(X.get_ref()); - - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) - { - arma_conform_check(true, "max(): object has no elements"); - - return Datum::nan; - } - - eT max_val_i = priv::most_neg(); - eT max_val_j = priv::most_neg(); - - if(Proxy::use_at == false) - { - typedef typename Proxy::ea_type ea_type; - - ea_type A = P.get_ea(); - - uword i,j; - - for(i=0, j=1; j max_val_i) { max_val_i = tmp_i; } - if(tmp_j > max_val_j) { max_val_j = tmp_j; } - } - - if(i < n_elem) - { - const eT tmp_i = A[i]; - - if(tmp_i > max_val_i) { max_val_i = tmp_i; } - } - } - else - { - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - if(n_rows == 1) - { - uword i,j; - for(i=0, j=1; j < n_cols; i+=2, j+=2) - { - const eT tmp_i = P.at(0,i); - const eT tmp_j = P.at(0,j); - - if(tmp_i > max_val_i) { max_val_i = tmp_i; } - if(tmp_j > max_val_j) { max_val_j = tmp_j; } - } - - if(i < n_cols) - { - const eT tmp_i = P.at(0,i); - - if(tmp_i > max_val_i) { max_val_i = tmp_i; } - } - } - else - { - for(uword col=0; col < n_cols; ++col) - { - uword i,j; - for(i=0, j=1; j < n_rows; i+=2, j+=2) - { - const eT tmp_i = P.at(i,col); - const eT tmp_j = P.at(j,col); - - if(tmp_i > max_val_i) { max_val_i = tmp_i; } - if(tmp_j > max_val_j) { max_val_j = tmp_j; } - } - - if(i < n_rows) - { - const eT tmp_i = P.at(i,col); - - if(tmp_i > max_val_i) { max_val_i = tmp_i; } - } - } - } - } - - return (max_val_i > max_val_j) ? max_val_i : max_val_j; - } - - - -template -inline -typename arma_not_cx::result -op_max::max(const BaseCube& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const ProxyCube P(X.get_ref()); - - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) - { - arma_conform_check(true, "max(): object has no elements"); - - return Datum::nan; - } - - eT max_val = priv::most_neg(); - - if(ProxyCube::use_at == false) - { - eT max_val_i = priv::most_neg(); - eT max_val_j = priv::most_neg(); - - typedef typename ProxyCube::ea_type ea_type; - - ea_type A = P.get_ea(); - - uword i,j; - - for(i=0, j=1; j max_val_i) { max_val_i = tmp_i; } - if(tmp_j > max_val_j) { max_val_j = tmp_j; } - } - - if(i < n_elem) - { - const eT tmp_i = A[i]; - - if(tmp_i > max_val_i) { max_val_i = tmp_i; } - } - - max_val = (max_val_i > max_val_j) ? max_val_i : max_val_j; - } - else - { - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - const uword n_slices = P.get_n_slices(); - - for(uword slice=0; slice < n_slices; ++slice) - for(uword col=0; col < n_cols; ++col ) - for(uword row=0; row < n_rows; ++row ) - { - const eT tmp = P.at(row,col,slice); - - if(tmp > max_val) { max_val = tmp; } - } - } - - return max_val; - } - - - -template -inline -typename arma_not_cx::result -op_max::max_with_index(const Proxy& P, uword& index_of_max_val) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) - { - arma_conform_check(true, "max(): object has no elements"); - - return Datum::nan; - } - - eT best_val = priv::most_neg(); - uword best_index = 0; - - if(Proxy::use_at == false) - { - typedef typename Proxy::ea_type ea_type; - - ea_type A = P.get_ea(); - - for(uword i=0; i best_val) { best_val = tmp; best_index = i; } - } - } - else - { - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - if(n_rows == 1) - { - for(uword i=0; i < n_cols; ++i) - { - const eT tmp = P.at(0,i); - - if(tmp > best_val) { best_val = tmp; best_index = i; } - } - } - else - if(n_cols == 1) - { - for(uword i=0; i < n_rows; ++i) - { - const eT tmp = P.at(i,0); - - if(tmp > best_val) { best_val = tmp; best_index = i; } - } - } - else - { - uword count = 0; - - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - const eT tmp = P.at(row,col); - - if(tmp > best_val) { best_val = tmp; best_index = count; } - - ++count; - } - } - } - - index_of_max_val = best_index; - - return best_val; - } - - - -template -inline -typename arma_not_cx::result -op_max::max_with_index(const ProxyCube& P, uword& index_of_max_val) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) - { - arma_conform_check(true, "max(): object has no elements"); - - return Datum::nan; - } - - eT best_val = priv::most_neg(); - uword best_index = 0; - - if(ProxyCube::use_at == false) - { - typedef typename ProxyCube::ea_type ea_type; - - ea_type A = P.get_ea(); - - for(uword i=0; i < n_elem; ++i) - { - const eT tmp = A[i]; - - if(tmp > best_val) { best_val = tmp; best_index = i; } - } - } - else - { - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - const uword n_slices = P.get_n_slices(); - - uword count = 0; - - for(uword slice=0; slice < n_slices; ++slice) - for(uword col=0; col < n_cols; ++col ) - for(uword row=0; row < n_rows; ++row ) - { - const eT tmp = P.at(row,col,slice); - - if(tmp > best_val) { best_val = tmp; best_index = count; } - - ++count; - } - } - - index_of_max_val = best_index; - - return best_val; - } - - - -template -inline -std::complex -op_max::direct_max(const std::complex* const X, const uword n_elem) - { - arma_debug_sigprint(); - - uword index = 0; - T max_val = priv::most_neg(); - - for(uword i=0; i max_val) - { - max_val = tmp_val; - index = i; - } - } - - return X[index]; - } - - - -template -inline -std::complex -op_max::direct_max(const std::complex* const X, const uword n_elem, uword& index_of_max_val) - { - arma_debug_sigprint(); - - uword index = 0; - T max_val = priv::most_neg(); - - for(uword i=0; i max_val) - { - max_val = tmp_val; - index = i; - } - } - - index_of_max_val = index; - - return X[index]; - } - - - -template -inline -std::complex -op_max::direct_max(const Mat< std::complex >& X, const uword row) - { - arma_debug_sigprint(); - - const uword X_n_cols = X.n_cols; - - uword index = 0; - T max_val = priv::most_neg(); - - for(uword col=0; col max_val) - { - max_val = tmp_val; - index = col; - } - } - - return X.at(row,index); - } - - - -template -inline -std::complex -op_max::max(const subview< std::complex >& X) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - if(X.n_elem == 0) - { - arma_conform_check(true, "max(): object has no elements"); - - return Datum::nan; - } - - const Mat& A = X.m; - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - const uword start_row = X.aux_row1; - const uword start_col = X.aux_col1; - - const uword end_row_p1 = start_row + X_n_rows; - const uword end_col_p1 = start_col + X_n_cols; - - T max_val = priv::most_neg(); - - uword best_row = 0; - uword best_col = 0; - - if(X_n_rows == 1) - { - best_col = 0; - - for(uword col=start_col; col < end_col_p1; ++col) - { - const T tmp_val = std::abs( A.at(start_row, col) ); - - if(tmp_val > max_val) - { - max_val = tmp_val; - best_col = col; - } - } - - best_row = start_row; - } - else - { - for(uword col=start_col; col < end_col_p1; ++col) - for(uword row=start_row; row < end_row_p1; ++row) - { - const T tmp_val = std::abs( A.at(row, col) ); - - if(tmp_val > max_val) - { - max_val = tmp_val; - best_row = row; - best_col = col; - } - } - } - - return A.at(best_row, best_col); - } - - - -template -inline -typename arma_cx_only::result -op_max::max(const Base& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - const Proxy P(X.get_ref()); - - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) - { - arma_conform_check(true, "max(): object has no elements"); - - return Datum::nan; - } - - T max_val = priv::most_neg(); - - if(Proxy::use_at == false) - { - typedef typename Proxy::ea_type ea_type; - - ea_type A = P.get_ea(); - - uword index = 0; - - for(uword i=0; i max_val) - { - max_val = tmp; - index = i; - } - } - - return( A[index] ); - } - else - { - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - uword best_row = 0; - uword best_col = 0; - - if(n_rows == 1) - { - for(uword col=0; col < n_cols; ++col) - { - const T tmp = std::abs(P.at(0,col)); - - if(tmp > max_val) - { - max_val = tmp; - best_col = col; - } - } - } - else - { - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - const T tmp = std::abs(P.at(row,col)); - - if(tmp > max_val) - { - max_val = tmp; - - best_row = row; - best_col = col; - } - } - } - - return P.at(best_row, best_col); - } - } - - - -template -inline -typename arma_cx_only::result -op_max::max(const BaseCube& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - const ProxyCube P(X.get_ref()); - - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) - { - arma_conform_check(true, "max(): object has no elements"); - - return Datum::nan; - } - - T max_val = priv::most_neg(); - - if(ProxyCube::use_at == false) - { - typedef typename ProxyCube::ea_type ea_type; - - ea_type A = P.get_ea(); - - uword index = 0; - - for(uword i=0; i max_val) - { - max_val = tmp; - index = i; - } - } - - return( A[index] ); - } - else - { - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - const uword n_slices = P.get_n_slices(); - - eT max_val_orig = eT(0); - - for(uword slice=0; slice < n_slices; ++slice) - for(uword col=0; col < n_cols; ++col ) - for(uword row=0; row < n_rows; ++row ) - { - const eT tmp_orig = P.at(row,col,slice); - const T tmp = std::abs(tmp_orig); - - if(tmp > max_val) - { - max_val = tmp; - max_val_orig = tmp_orig; - } - } - - return max_val_orig; - } - } - - - -template -inline -typename arma_cx_only::result -op_max::max_with_index(const Proxy& P, uword& index_of_max_val) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) - { - arma_conform_check(true, "max(): object has no elements"); - - return Datum::nan; - } - - T best_val = priv::most_neg(); - - if(Proxy::use_at == false) - { - typedef typename Proxy::ea_type ea_type; - - ea_type A = P.get_ea(); - - uword best_index = 0; - - for(uword i=0; i best_val) { best_val = tmp; best_index = i; } - } - - index_of_max_val = best_index; - - return( A[best_index] ); - } - else - { - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - uword best_row = 0; - uword best_col = 0; - uword best_index = 0; - - if(n_rows == 1) - { - for(uword col=0; col < n_cols; ++col) - { - const T tmp = std::abs(P.at(0,col)); - - if(tmp > best_val) { best_val = tmp; best_col = col; } - } - - best_index = best_col; - } - else - if(n_cols == 1) - { - for(uword row=0; row < n_rows; ++row) - { - const T tmp = std::abs(P.at(row,0)); - - if(tmp > best_val) { best_val = tmp; best_row = row; } - } - - best_index = best_row; - } - else - { - uword count = 0; - - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - const T tmp = std::abs(P.at(row,col)); - - if(tmp > best_val) - { - best_val = tmp; - - best_row = row; - best_col = col; - - best_index = count; - } - - ++count; - } - } - - index_of_max_val = best_index; - - return P.at(best_row, best_col); - } - } - - - -template -inline -typename arma_cx_only::result -op_max::max_with_index(const ProxyCube& P, uword& index_of_max_val) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) - { - arma_conform_check(true, "max(): object has no elements"); - - return Datum::nan; - } - - T best_val = priv::most_neg(); - - if(ProxyCube::use_at == false) - { - typedef typename ProxyCube::ea_type ea_type; - - ea_type A = P.get_ea(); - - uword best_index = 0; - - for(uword i=0; i < n_elem; ++i) - { - const T tmp = std::abs(A[i]); - - if(tmp > best_val) { best_val = tmp; best_index = i; } - } - - index_of_max_val = best_index; - - return( A[best_index] ); - } - else - { - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - const uword n_slices = P.get_n_slices(); - - eT best_val_orig = eT(0); - uword best_index = 0; - uword count = 0; - - for(uword slice=0; slice < n_slices; ++slice) - for(uword col=0; col < n_cols; ++col ) - for(uword row=0; row < n_rows; ++row ) - { - const eT tmp_orig = P.at(row,col,slice); - const T tmp = std::abs(tmp_orig); - - if(tmp > best_val) - { - best_val = tmp; - best_val_orig = tmp_orig; - best_index = count; - } - - ++count; - } - - index_of_max_val = best_index; - - return best_val_orig; - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_mean_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_mean_bones.hpp deleted file mode 100644 index 20a86ae20..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_mean_bones.hpp +++ /dev/null @@ -1,115 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_mean -//! @{ - - -//! Class for finding mean values of a matrix -class op_mean - : public traits_op_xvec - { - public: - - // dense matrices - - template - inline static void apply(Mat& out, const Op& in); - - template - inline static void apply_noalias(Mat& out, const Proxy& P, const uword dim); - - template - inline static void apply_noalias_unwrap(Mat& out, const Proxy& P, const uword dim); - - template - inline static void apply_noalias_proxy(Mat& out, const Proxy& P, const uword dim); - - - // cubes - - template - inline static void apply(Cube& out, const OpCube& in); - - template - inline static void apply_noalias(Cube& out, const ProxyCube& P, const uword dim); - - template - inline static void apply_noalias_unwrap(Cube& out, const ProxyCube& P, const uword dim); - - template - inline static void apply_noalias_proxy(Cube& out, const ProxyCube& P, const uword dim); - - - // - - template - inline static eT direct_mean(const eT* const X, const uword N); - - template - inline static eT direct_mean_robust(const eT* const X, const uword N); - - - // - - template - inline static eT direct_mean(const Mat& X, const uword row); - - template - inline static eT direct_mean_robust(const Mat& X, const uword row); - - - // - - template - inline static eT mean_all(const subview& X); - - template - inline static eT mean_all_robust(const subview& X); - - - // - - template - inline static eT mean_all(const diagview& X); - - template - inline static eT mean_all_robust(const diagview& X); - - - // - - template - inline static typename T1::elem_type mean_all(const Op& X); - - template - inline static typename T1::elem_type mean_all(const Base& X); - - - // - - template - arma_inline static eT robust_mean(const eT A, const eT B); - - template - arma_inline static std::complex robust_mean(const std::complex& A, const std::complex& B); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_mean_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_mean_meat.hpp deleted file mode 100644 index 3f06b2634..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_mean_meat.hpp +++ /dev/null @@ -1,713 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_mean -//! @{ - - - -template -inline -void -op_mean::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword dim = in.aux_uword_a; - arma_conform_check( (dim > 1), "mean(): parameter 'dim' must be 0 or 1" ); - - const Proxy P(in.m); - - if(P.is_alias(out) == false) - { - op_mean::apply_noalias(out, P, dim); - } - else - { - Mat tmp; - - op_mean::apply_noalias(tmp, P, dim); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -op_mean::apply_noalias(Mat& out, const Proxy& P, const uword dim) - { - arma_debug_sigprint(); - - if(is_Mat::stored_type>::value) - { - op_mean::apply_noalias_unwrap(out, P, dim); - } - else - { - op_mean::apply_noalias_proxy(out, P, dim); - } - } - - - -template -inline -void -op_mean::apply_noalias_unwrap(Mat& out, const Proxy& P, const uword dim) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - typedef typename Proxy::stored_type P_stored_type; - - const unwrap tmp(P.Q); - - const typename unwrap::stored_type& X = tmp.M; - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(dim == 0) - { - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols); - - if(X_n_rows == 0) { return; } - - eT* out_mem = out.memptr(); - - for(uword col=0; col < X_n_cols; ++col) - { - out_mem[col] = op_mean::direct_mean( X.colptr(col), X_n_rows ); - } - } - else - if(dim == 1) - { - out.zeros(X_n_rows, (X_n_cols > 0) ? 1 : 0); - - if(X_n_cols == 0) { return; } - - eT* out_mem = out.memptr(); - - for(uword col=0; col < X_n_cols; ++col) - { - const eT* col_mem = X.colptr(col); - - for(uword row=0; row < X_n_rows; ++row) - { - out_mem[row] += col_mem[row]; - } - } - - out /= T(X_n_cols); - - for(uword row=0; row < X_n_rows; ++row) - { - if(arma_isfinite(out_mem[row]) == false) - { - out_mem[row] = op_mean::direct_mean_robust( X, row ); - } - } - } - } - - - -template -inline -void -op_mean::apply_noalias_proxy(Mat& out, const Proxy& P, const uword dim) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - const uword P_n_rows = P.get_n_rows(); - const uword P_n_cols = P.get_n_cols(); - - if(dim == 0) - { - out.set_size((P_n_rows > 0) ? 1 : 0, P_n_cols); - - if(P_n_rows == 0) { return; } - - eT* out_mem = out.memptr(); - - for(uword col=0; col < P_n_cols; ++col) - { - eT val1 = eT(0); - eT val2 = eT(0); - - uword i,j; - for(i=0, j=1; j < P_n_rows; i+=2, j+=2) - { - val1 += P.at(i,col); - val2 += P.at(j,col); - } - - if(i < P_n_rows) - { - val1 += P.at(i,col); - } - - out_mem[col] = (val1 + val2) / T(P_n_rows); - } - } - else - if(dim == 1) - { - out.zeros(P_n_rows, (P_n_cols > 0) ? 1 : 0); - - if(P_n_cols == 0) { return; } - - eT* out_mem = out.memptr(); - - for(uword col=0; col < P_n_cols; ++col) - for(uword row=0; row < P_n_rows; ++row) - { - out_mem[row] += P.at(row,col); - } - - out /= T(P_n_cols); - } - - if(out.internal_has_nonfinite()) - { - // TODO: replace with dedicated handling to avoid unwrapping - op_mean::apply_noalias_unwrap(out, P, dim); - } - } - - - -// -// cubes - - - -template -inline -void -op_mean::apply(Cube& out, const OpCube& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword dim = in.aux_uword_a; - arma_conform_check( (dim > 2), "mean(): parameter 'dim' must be 0 or 1 or 2" ); - - const ProxyCube P(in.m); - - if(P.is_alias(out) == false) - { - op_mean::apply_noalias(out, P, dim); - } - else - { - Cube tmp; - - op_mean::apply_noalias(tmp, P, dim); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -op_mean::apply_noalias(Cube& out, const ProxyCube& P, const uword dim) - { - arma_debug_sigprint(); - - if(is_Cube::stored_type>::value) - { - op_mean::apply_noalias_unwrap(out, P, dim); - } - else - { - op_mean::apply_noalias_proxy(out, P, dim); - } - } - - - -template -inline -void -op_mean::apply_noalias_unwrap(Cube& out, const ProxyCube& P, const uword dim) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - typedef typename ProxyCube::stored_type P_stored_type; - - const unwrap_cube U(P.Q); - - const Cube& X = U.M; - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - const uword X_n_slices = X.n_slices; - - if(dim == 0) - { - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols, X_n_slices); - - if(X_n_rows == 0) { return; } - - for(uword slice=0; slice < X_n_slices; ++slice) - { - eT* out_mem = out.slice_memptr(slice); - - for(uword col=0; col < X_n_cols; ++col) - { - out_mem[col] = op_mean::direct_mean( X.slice_colptr(slice,col), X_n_rows ); - } - } - } - else - if(dim == 1) - { - out.zeros(X_n_rows, (X_n_cols > 0) ? 1 : 0, X_n_slices); - - if(X_n_cols == 0) { return; } - - for(uword slice=0; slice < X_n_slices; ++slice) - { - eT* out_mem = out.slice_memptr(slice); - - for(uword col=0; col < X_n_cols; ++col) - { - const eT* col_mem = X.slice_colptr(slice,col); - - for(uword row=0; row < X_n_rows; ++row) - { - out_mem[row] += col_mem[row]; - } - } - - const Mat tmp('j', X.slice_memptr(slice), X_n_rows, X_n_cols); - - for(uword row=0; row < X_n_rows; ++row) - { - out_mem[row] /= T(X_n_cols); - - if(arma_isfinite(out_mem[row]) == false) - { - out_mem[row] = op_mean::direct_mean_robust( tmp, row ); - } - } - } - } - else - if(dim == 2) - { - out.zeros(X_n_rows, X_n_cols, (X_n_slices > 0) ? 1 : 0); - - if(X_n_slices == 0) { return; } - - eT* out_mem = out.memptr(); - - for(uword slice=0; slice < X_n_slices; ++slice) - { - arrayops::inplace_plus(out_mem, X.slice_memptr(slice), X.n_elem_slice ); - } - - out /= T(X_n_slices); - - podarray tmp(X_n_slices); - - for(uword col=0; col < X_n_cols; ++col) - for(uword row=0; row < X_n_rows; ++row) - { - if(arma_isfinite(out.at(row,col,0)) == false) - { - for(uword slice=0; slice < X_n_slices; ++slice) - { - tmp[slice] = X.at(row,col,slice); - } - - out.at(row,col,0) = op_mean::direct_mean_robust(tmp.memptr(), X_n_slices); - } - } - } - } - - - -template -inline -void -op_mean::apply_noalias_proxy(Cube& out, const ProxyCube& P, const uword dim) - { - arma_debug_sigprint(); - - op_mean::apply_noalias_unwrap(out, P, dim); - - // TODO: implement specialised handling - } - - - - -// - - - -template -inline -eT -op_mean::direct_mean(const eT* const X, const uword n_elem) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const eT result = arrayops::accumulate(X, n_elem) / T(n_elem); - - return arma_isfinite(result) ? result : op_mean::direct_mean_robust(X, n_elem); - } - - - -template -inline -eT -op_mean::direct_mean_robust(const eT* const X, const uword n_elem) - { - arma_debug_sigprint(); - - // use an adapted form of the mean finding algorithm from the running_stat class - - typedef typename get_pod_type::result T; - - uword i,j; - - eT r_mean = eT(0); - - for(i=0, j=1; j -inline -eT -op_mean::direct_mean(const Mat& X, const uword row) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const uword X_n_cols = X.n_cols; - - eT val = eT(0); - - uword i,j; - for(i=0, j=1; j < X_n_cols; i+=2, j+=2) - { - val += X.at(row,i); - val += X.at(row,j); - } - - if(i < X_n_cols) - { - val += X.at(row,i); - } - - const eT result = val / T(X_n_cols); - - return arma_isfinite(result) ? result : op_mean::direct_mean_robust(X, row); - } - - - -template -inline -eT -op_mean::direct_mean_robust(const Mat& X, const uword row) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const uword X_n_cols = X.n_cols; - - eT r_mean = eT(0); - - for(uword col=0; col < X_n_cols; ++col) - { - r_mean = r_mean + (X.at(row,col) - r_mean)/T(col+1); - } - - return r_mean; - } - - - -template -inline -eT -op_mean::mean_all(const subview& X) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - const uword X_n_elem = X.n_elem; - - if(X_n_elem == 0) - { - arma_conform_check(true, "mean(): object has no elements"); - - return Datum::nan; - } - - eT val = eT(0); - - if(X_n_rows == 1) - { - const Mat& A = X.m; - - const uword start_row = X.aux_row1; - const uword start_col = X.aux_col1; - - const uword end_col_p1 = start_col + X_n_cols; - - uword i,j; - for(i=start_col, j=start_col+1; j < end_col_p1; i+=2, j+=2) - { - val += A.at(start_row, i); - val += A.at(start_row, j); - } - - if(i < end_col_p1) - { - val += A.at(start_row, i); - } - } - else - { - for(uword col=0; col < X_n_cols; ++col) - { - val += arrayops::accumulate(X.colptr(col), X_n_rows); - } - } - - const eT result = val / T(X_n_elem); - - return arma_isfinite(result) ? result : op_mean::mean_all_robust(X); - } - - - -template -inline -eT -op_mean::mean_all_robust(const subview& X) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - const uword start_row = X.aux_row1; - const uword start_col = X.aux_col1; - - const uword end_row_p1 = start_row + X_n_rows; - const uword end_col_p1 = start_col + X_n_cols; - - const Mat& A = X.m; - - - eT r_mean = eT(0); - - if(X_n_rows == 1) - { - uword i=0; - - for(uword col = start_col; col < end_col_p1; ++col, ++i) - { - r_mean = r_mean + (A.at(start_row,col) - r_mean)/T(i+1); - } - } - else - { - uword i=0; - - for(uword col = start_col; col < end_col_p1; ++col) - for(uword row = start_row; row < end_row_p1; ++row, ++i) - { - r_mean = r_mean + (A.at(row,col) - r_mean)/T(i+1); - } - } - - return r_mean; - } - - - -template -inline -eT -op_mean::mean_all(const diagview& X) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const uword X_n_elem = X.n_elem; - - if(X_n_elem == 0) - { - arma_conform_check(true, "mean(): object has no elements"); - - return Datum::nan; - } - - eT val = eT(0); - - for(uword i=0; i -inline -eT -op_mean::mean_all_robust(const diagview& X) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const uword X_n_elem = X.n_elem; - - eT r_mean = eT(0); - - for(uword i=0; i -inline -typename T1::elem_type -op_mean::mean_all(const Op& X) - { - arma_debug_sigprint(); - - return op_mean::mean_all(X.m); - } - - - -template -inline -typename T1::elem_type -op_mean::mean_all(const Base& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap tmp(X.get_ref()); - const Mat& A = tmp.M; - - const uword A_n_elem = A.n_elem; - - if(A_n_elem == 0) - { - arma_conform_check(true, "mean(): object has no elements"); - - return Datum::nan; - } - - return op_mean::direct_mean(A.memptr(), A_n_elem); - } - - - -template -arma_inline -eT -op_mean::robust_mean(const eT A, const eT B) - { - return A + (B - A)/eT(2); - } - - - -template -arma_inline -std::complex -op_mean::robust_mean(const std::complex& A, const std::complex& B) - { - return A + (B - A)/T(2); - } - - - -//! @} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_median_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_median_bones.hpp deleted file mode 100644 index 8212d148f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_median_bones.hpp +++ /dev/null @@ -1,77 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_median -//! @{ - - -template -struct arma_cx_median_packet - { - T val; - uword index; - }; - - - -template -arma_inline -bool -operator< (const arma_cx_median_packet& A, const arma_cx_median_packet& B) - { - return (A.val < B.val); - } - - - -class op_median - : public traits_op_xvec - { - public: - - template - inline static void apply(Mat& out, const Op& expr); - - template - inline static void apply_noalias(Mat& out, const Mat& X, const uword dim, const typename arma_not_cx::result* junk = nullptr); - - template - inline static void apply_noalias(Mat& out, const Mat& X, const uword dim, const typename arma_cx_only::result* junk = nullptr); - - // - // - - template - inline static typename T1::elem_type median_vec(const T1& X, const typename arma_not_cx::result* junk = nullptr); - - template - inline static typename T1::elem_type median_vec(const T1& X, const typename arma_cx_only::result* junk = nullptr); - - // - // - - template - inline static eT direct_median(std::vector& X); - - template - inline static void direct_cx_median_index(uword& out_index1, uword& out_index2, std::vector< arma_cx_median_packet >& X); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_median_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_median_meat.hpp deleted file mode 100644 index a2efd84d9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_median_meat.hpp +++ /dev/null @@ -1,338 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_median -//! @{ - - - -template -inline -void -op_median::apply(Mat& out, const Op& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap U(expr.m); - - const uword dim = expr.aux_uword_a; - - arma_conform_check( U.M.internal_has_nan(), "median(): detected NaN" ); - arma_conform_check( (dim > 1), "median(): parameter 'dim' must be 0 or 1" ); - - if(U.is_alias(out)) - { - Mat tmp; - - op_median::apply_noalias(out, U.M, dim); - - out.steal_mem(tmp); - } - else - { - op_median::apply_noalias(out, U.M, dim); - } - } - - - -template -inline -void -op_median::apply_noalias(Mat& out, const Mat& X, const uword dim, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(dim == 0) // in each column - { - arma_debug_print("op_median::apply(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols); - - if(X_n_rows > 0) - { - std::vector tmp_vec(X_n_rows); - - for(uword col=0; col < X_n_cols; ++col) - { - arrayops::copy( &(tmp_vec[0]), X.colptr(col), X_n_rows ); - - out[col] = op_median::direct_median(tmp_vec); - } - } - } - else - if(dim == 1) // in each row - { - arma_debug_print("op_median::apply(): dim = 1"); - - out.set_size(X_n_rows, (X_n_cols > 0) ? 1 : 0); - - if(X_n_cols > 0) - { - std::vector tmp_vec(X_n_cols); - - for(uword row=0; row < X_n_rows; ++row) - { - for(uword col=0; col < X_n_cols; ++col) { tmp_vec[col] = X.at(row,col); } - - out[row] = op_median::direct_median(tmp_vec); - } - } - } - } - - - -template -inline -void -op_median::apply_noalias(Mat& out, const Mat& X, const uword dim, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename get_pod_type::result T; - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(dim == 0) // in each column - { - arma_debug_print("op_median::apply(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols); - - if(X_n_rows > 0) - { - std::vector< arma_cx_median_packet > tmp_vec(X_n_rows); - - for(uword col=0; col 0) ? 1 : 0); - - if(X_n_cols > 0) - { - std::vector< arma_cx_median_packet > tmp_vec(X_n_cols); - - for(uword row=0; row -inline -typename T1::elem_type -op_median::median_vec - ( - const T1& X, - const typename arma_not_cx::result* junk - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - - const quasi_unwrap U(X); - - const uword n_elem = U.M.n_elem; - - if(n_elem == 0) - { - arma_conform_check(true, "median(): object has no elements"); - - return Datum::nan; - } - - arma_conform_check( U.M.internal_has_nan(), "median(): detected NaN" ); - - std::vector tmp_vec(n_elem); - - arrayops::copy( &(tmp_vec[0]), U.M.memptr(), n_elem ); - - return op_median::direct_median(tmp_vec); - } - - - -template -inline -typename T1::elem_type -op_median::median_vec - ( - const T1& X, - const typename arma_cx_only::result* junk - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const quasi_unwrap U(X); - - const uword n_elem = U.M.n_elem; - - if(n_elem == 0) - { - arma_conform_check(true, "median(): object has no elements"); - - return Datum::nan; - } - - arma_conform_check( U.M.internal_has_nan(), "median(): detected NaN" ); - - std::vector< arma_cx_median_packet > tmp_vec(n_elem); - - const eT* A = U.M.memptr(); - - for(uword i=0; i -inline -eT -op_median::direct_median(std::vector& X) - { - arma_debug_sigprint(); - - const uword n_elem = uword(X.size()); - const uword half = n_elem/2; - - typename std::vector::iterator first = X.begin(); - typename std::vector::iterator nth = first + half; - typename std::vector::iterator pastlast = X.end(); - - std::nth_element(first, nth, pastlast); - - if((n_elem % 2) == 0) // even number of elements - { - typename std::vector::iterator start = X.begin(); - typename std::vector::iterator pastend = start + half; - - const eT val1 = (*nth); - const eT val2 = (*(std::max_element(start, pastend))); - - return op_mean::robust_mean(val1, val2); - } - else // odd number of elements - { - return (*nth); - } - } - - - -template -inline -void -op_median::direct_cx_median_index - ( - uword& out_index1, - uword& out_index2, - std::vector< arma_cx_median_packet >& X - ) - { - arma_debug_sigprint(); - - typedef arma_cx_median_packet eT; - - const uword n_elem = uword(X.size()); - const uword half = n_elem/2; - - typename std::vector::iterator first = X.begin(); - typename std::vector::iterator nth = first + half; - typename std::vector::iterator pastlast = X.end(); - - std::nth_element(first, nth, pastlast); - - out_index1 = (*nth).index; - - if((n_elem % 2) == 0) // even number of elements - { - typename std::vector::iterator start = X.begin(); - typename std::vector::iterator pastend = start + half; - - out_index2 = (*(std::max_element(start, pastend))).index; - } - else // odd number of elements - { - out_index2 = out_index1; - } - } - - - -//! @} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_min_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_min_bones.hpp deleted file mode 100644 index e9f5a621a..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_min_bones.hpp +++ /dev/null @@ -1,112 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_min -//! @{ - - -class op_min - : public traits_op_xvec - { - public: - - // - // dense matrices - - template - inline static void apply(Mat& out, const Op& in); - - template - inline static void apply_noalias(Mat& out, const Mat& X, const uword dim, const typename arma_not_cx::result* junk = nullptr); - - template - inline static void apply_noalias(Mat& out, const Mat& X, const uword dim, const typename arma_cx_only::result* junk = nullptr); - - - // - // cubes - - template - inline static void apply(Cube& out, const OpCube& in); - - template - inline static void apply_noalias(Cube& out, const Cube& X, const uword dim, const typename arma_not_cx::result* junk = nullptr); - - template - inline static void apply_noalias(Cube& out, const Cube& X, const uword dim, const typename arma_cx_only::result* junk = nullptr); - - - // - // for non-complex numbers - - template - inline static eT direct_min(const eT* const X, const uword N); - - template - inline static eT direct_min(const eT* const X, const uword N, uword& index_of_min_val); - - template - inline static eT direct_min(const Mat& X, const uword row); - - template - inline static eT min(const subview& X); - - template - inline static typename arma_not_cx::result min(const Base& X); - - template - inline static typename arma_not_cx::result min(const BaseCube& X); - - template - inline static typename arma_not_cx::result min_with_index(const Proxy& P, uword& index_of_min_val); - - template - inline static typename arma_not_cx::result min_with_index(const ProxyCube& P, uword& index_of_min_val); - - - // - // for complex numbers - - template - inline static std::complex direct_min(const std::complex* const X, const uword n_elem); - - template - inline static std::complex direct_min(const std::complex* const X, const uword n_elem, uword& index_of_min_val); - - template - inline static std::complex direct_min(const Mat< std::complex >& X, const uword row); - - template - inline static std::complex min(const subview< std::complex >& X); - - template - inline static typename arma_cx_only::result min(const Base& X); - - template - inline static typename arma_cx_only::result min(const BaseCube& X); - - template - inline static typename arma_cx_only::result min_with_index(const Proxy& P, uword& index_of_min_val); - - template - inline static typename arma_cx_only::result min_with_index(const ProxyCube& P, uword& index_of_min_val); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_min_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_min_meat.hpp deleted file mode 100644 index 8fa6e74f9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_min_meat.hpp +++ /dev/null @@ -1,1325 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_min -//! @{ - - - -template -inline -void -op_min::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword dim = in.aux_uword_a; - arma_conform_check( (dim > 1), "min(): parameter 'dim' must be 0 or 1" ); - - const quasi_unwrap U(in.m); - const Mat& X = U.M; - - if(U.is_alias(out) == false) - { - op_min::apply_noalias(out, X, dim); - } - else - { - Mat tmp; - - op_min::apply_noalias(tmp, X, dim); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -op_min::apply_noalias(Mat& out, const Mat& X, const uword dim, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(dim == 0) - { - arma_debug_print("op_min::apply(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols); - - if(X_n_rows == 0) { return; } - - eT* out_mem = out.memptr(); - - for(uword col=0; col 0) ? 1 : 0); - - if(X_n_cols == 0) { return; } - - eT* out_mem = out.memptr(); - - arrayops::copy(out_mem, X.colptr(0), X_n_rows); - - for(uword col=1; col -inline -void -op_min::apply_noalias(Mat& out, const Mat& X, const uword dim, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(dim == 0) - { - arma_debug_print("op_min::apply(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols); - - if(X_n_rows == 0) { return; } - - eT* out_mem = out.memptr(); - - for(uword col=0; col 0) ? 1 : 0); - - if(X_n_cols == 0) { return; } - - eT* out_mem = out.memptr(); - - for(uword row=0; row -inline -void -op_min::apply(Cube& out, const OpCube& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword dim = in.aux_uword_a; - arma_conform_check( (dim > 2), "min(): parameter 'dim' must be 0 or 1 or 2" ); - - const unwrap_cube U(in.m); - - if(U.is_alias(out) == false) - { - op_min::apply_noalias(out, U.M, dim); - } - else - { - Cube tmp; - - op_min::apply_noalias(tmp, U.M, dim); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -op_min::apply_noalias(Cube& out, const Cube& X, const uword dim, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - const uword X_n_slices = X.n_slices; - - if(dim == 0) - { - arma_debug_print("op_min::apply(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols, X_n_slices); - - if(X_n_rows == 0) { return; } - - for(uword slice=0; slice < X_n_slices; ++slice) - { - eT* out_mem = out.slice_memptr(slice); - - for(uword col=0; col < X_n_cols; ++col) - { - out_mem[col] = op_min::direct_min( X.slice_colptr(slice,col), X_n_rows ); - } - } - } - else - if(dim == 1) - { - arma_debug_print("op_min::apply(): dim = 1"); - - out.set_size(X_n_rows, (X_n_cols > 0) ? 1 : 0, X_n_slices); - - if(X_n_cols == 0) { return; } - - for(uword slice=0; slice < X_n_slices; ++slice) - { - eT* out_mem = out.slice_memptr(slice); - - arrayops::copy(out_mem, X.slice_colptr(slice,0), X_n_rows); - - for(uword col=1; col < X_n_cols; ++col) - { - const eT* col_mem = X.slice_colptr(slice,col); - - for(uword row=0; row < X_n_rows; ++row) - { - const eT col_val = col_mem[row]; - - if(col_val < out_mem[row]) { out_mem[row] = col_val; } - } - } - } - } - else - if(dim == 2) - { - arma_debug_print("op_min::apply(): dim = 2"); - - out.set_size(X_n_rows, X_n_cols, (X_n_slices > 0) ? 1 : 0); - - if(X_n_slices == 0) { return; } - - const uword N = X.n_elem_slice; - - eT* out_mem = out.slice_memptr(0); - - arrayops::copy(out_mem, X.slice_memptr(0), N); - - for(uword slice=1; slice < X_n_slices; ++slice) - { - const eT* X_mem = X.slice_memptr(slice); - - for(uword i=0; i < N; ++i) - { - const eT val = X_mem[i]; - - if(val < out_mem[i]) { out_mem[i] = val; } - } - } - } - } - - - -template -inline -void -op_min::apply_noalias(Cube& out, const Cube& X, const uword dim, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - const uword X_n_slices = X.n_slices; - - if(dim == 0) - { - arma_debug_print("op_min::apply(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols, X_n_slices); - - if(X_n_rows == 0) { return; } - - for(uword slice=0; slice < X_n_slices; ++slice) - { - eT* out_mem = out.slice_memptr(slice); - - for(uword col=0; col < X_n_cols; ++col) - { - out_mem[col] = op_min::direct_min( X.slice_colptr(slice,col), X_n_rows ); - } - } - } - else - if(dim == 1) - { - arma_debug_print("op_min::apply(): dim = 1"); - - out.set_size(X_n_rows, (X_n_cols > 0) ? 1 : 0, X_n_slices); - - if(X_n_cols == 0) { return; } - - for(uword slice=0; slice < X_n_slices; ++slice) - { - eT* out_mem = out.slice_memptr(slice); - - const Mat tmp('j', X.slice_memptr(slice), X_n_rows, X_n_cols); - - for(uword row=0; row < X_n_rows; ++row) - { - out_mem[row] = op_min::direct_min(tmp, row); - } - } - } - else - if(dim == 2) - { - arma_debug_print("op_min::apply(): dim = 2"); - - out.set_size(X_n_rows, X_n_cols, (X_n_slices > 0) ? 1 : 0); - - if(X_n_slices == 0) { return; } - - const uword N = X.n_elem_slice; - - eT* out_mem = out.slice_memptr(0); - - arrayops::copy(out_mem, X.slice_memptr(0), N); - - for(uword slice=1; slice < X_n_slices; ++slice) - { - const eT* X_mem = X.slice_memptr(slice); - - for(uword i=0; i < N; ++i) - { - const eT& val = X_mem[i]; - - if(std::abs(val) < std::abs(out_mem[i])) { out_mem[i] = val; } - } - } - } - } - - - -template -inline -eT -op_min::direct_min(const eT* const X, const uword n_elem) - { - arma_debug_sigprint(); - - eT min_val_i = priv::most_pos(); - eT min_val_j = priv::most_pos(); - - uword i,j; - for(i=0, j=1; j -inline -eT -op_min::direct_min(const eT* const X, const uword n_elem, uword& index_of_min_val) - { - arma_debug_sigprint(); - - eT min_val_i = priv::most_pos(); - eT min_val_j = priv::most_pos(); - - uword best_index_i = 0; - uword best_index_j = 0; - - uword i,j; - for(i=0, j=1; j -inline -eT -op_min::direct_min(const Mat& X, const uword row) - { - arma_debug_sigprint(); - - const uword X_n_cols = X.n_cols; - - eT min_val_i = priv::most_pos(); - eT min_val_j = priv::most_pos(); - - uword i,j; - for(i=0, j=1; j < X_n_cols; i+=2, j+=2) - { - const eT tmp_i = X.at(row,i); - const eT tmp_j = X.at(row,j); - - if(tmp_i < min_val_i) { min_val_i = tmp_i; } - if(tmp_j < min_val_j) { min_val_j = tmp_j; } - } - - if(i < X_n_cols) - { - const eT tmp_i = X.at(row,i); - - if(tmp_i < min_val_i) { min_val_i = tmp_i; } - } - - return (min_val_i < min_val_j) ? min_val_i : min_val_j; - } - - - -template -inline -eT -op_min::min(const subview& X) - { - arma_debug_sigprint(); - - if(X.n_elem == 0) - { - arma_conform_check(true, "min(): object has no elements"); - - return Datum::nan; - } - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(X_n_rows == 1) - { - eT min_val_i = priv::most_pos(); - eT min_val_j = priv::most_pos(); - - const Mat& A = X.m; - - const uword start_row = X.aux_row1; - const uword start_col = X.aux_col1; - - const uword end_col_p1 = start_col + X_n_cols; - - uword i,j; - for(i=start_col, j=start_col+1; j < end_col_p1; i+=2, j+=2) - { - const eT tmp_i = A.at(start_row, i); - const eT tmp_j = A.at(start_row, j); - - if(tmp_i < min_val_i) { min_val_i = tmp_i; } - if(tmp_j < min_val_j) { min_val_j = tmp_j; } - } - - if(i < end_col_p1) - { - const eT tmp_i = A.at(start_row, i); - - if(tmp_i < min_val_i) { min_val_i = tmp_i; } - } - - return (min_val_i < min_val_j) ? min_val_i : min_val_j; - } - - eT min_val = priv::most_pos(); - - for(uword col=0; col < X_n_cols; ++col) - { - min_val = (std::min)(min_val, op_min::direct_min(X.colptr(col), X_n_rows)); - } - - return min_val; - } - - - -template -inline -typename arma_not_cx::result -op_min::min(const Base& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const Proxy P(X.get_ref()); - - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) - { - arma_conform_check(true, "min(): object has no elements"); - - return Datum::nan; - } - - eT min_val_i = priv::most_pos(); - eT min_val_j = priv::most_pos(); - - if(Proxy::use_at == false) - { - typedef typename Proxy::ea_type ea_type; - - ea_type A = P.get_ea(); - - uword i,j; - - for(i=0, j=1; j -inline -typename arma_not_cx::result -op_min::min(const BaseCube& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const ProxyCube P(X.get_ref()); - - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) - { - arma_conform_check(true, "min(): object has no elements"); - - return Datum::nan; - } - - eT min_val = priv::most_pos(); - - if(ProxyCube::use_at == false) - { - eT min_val_i = priv::most_pos(); - eT min_val_j = priv::most_pos(); - - typedef typename ProxyCube::ea_type ea_type; - - ea_type A = P.get_ea(); - - uword i,j; - - for(i=0, j=1; j -inline -typename arma_not_cx::result -op_min::min_with_index(const Proxy& P, uword& index_of_min_val) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) - { - arma_conform_check(true, "min(): object has no elements"); - - return Datum::nan; - } - - eT best_val = priv::most_pos(); - uword best_index = 0; - - if(Proxy::use_at == false) - { - typedef typename Proxy::ea_type ea_type; - - ea_type A = P.get_ea(); - - for(uword i=0; i -inline -typename arma_not_cx::result -op_min::min_with_index(const ProxyCube& P, uword& index_of_min_val) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) - { - arma_conform_check(true, "min(): object has no elements"); - - return Datum::nan; - } - - eT best_val = priv::most_pos(); - uword best_index = 0; - - if(ProxyCube::use_at == false) - { - typedef typename ProxyCube::ea_type ea_type; - - ea_type A = P.get_ea(); - - for(uword i=0; i < n_elem; ++i) - { - const eT tmp = A[i]; - - if(tmp < best_val) { best_val = tmp; best_index = i; } - } - } - else - { - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - const uword n_slices = P.get_n_slices(); - - uword count = 0; - - for(uword slice=0; slice < n_slices; ++slice) - for(uword col=0; col < n_cols; ++col ) - for(uword row=0; row < n_rows; ++row ) - { - const eT tmp = P.at(row,col,slice); - - if(tmp < best_val) { best_val = tmp; best_index = count; } - - ++count; - } - } - - index_of_min_val = best_index; - - return best_val; - } - - - -template -inline -std::complex -op_min::direct_min(const std::complex* const X, const uword n_elem) - { - arma_debug_sigprint(); - - uword index = 0; - T min_val = priv::most_pos(); - - for(uword i=0; i -inline -std::complex -op_min::direct_min(const std::complex* const X, const uword n_elem, uword& index_of_min_val) - { - arma_debug_sigprint(); - - uword index = 0; - T min_val = priv::most_pos(); - - for(uword i=0; i -inline -std::complex -op_min::direct_min(const Mat< std::complex >& X, const uword row) - { - arma_debug_sigprint(); - - const uword X_n_cols = X.n_cols; - - uword index = 0; - T min_val = priv::most_pos(); - - for(uword col=0; col -inline -std::complex -op_min::min(const subview< std::complex >& X) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - if(X.n_elem == 0) - { - arma_conform_check(true, "min(): object has no elements"); - - return Datum::nan; - } - - const Mat& A = X.m; - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - const uword start_row = X.aux_row1; - const uword start_col = X.aux_col1; - - const uword end_row_p1 = start_row + X_n_rows; - const uword end_col_p1 = start_col + X_n_cols; - - T min_val = priv::most_pos(); - - uword best_row = 0; - uword best_col = 0; - - if(X_n_rows == 1) - { - best_col = 0; - - for(uword col=start_col; col < end_col_p1; ++col) - { - const T tmp_val = std::abs( A.at(start_row, col) ); - - if(tmp_val < min_val) - { - min_val = tmp_val; - best_col = col; - } - } - - best_row = start_row; - } - else - { - for(uword col=start_col; col < end_col_p1; ++col) - for(uword row=start_row; row < end_row_p1; ++row) - { - const T tmp_val = std::abs( A.at(row, col) ); - - if(tmp_val < min_val) - { - min_val = tmp_val; - best_row = row; - best_col = col; - } - } - } - - return A.at(best_row, best_col); - } - - - -template -inline -typename arma_cx_only::result -op_min::min(const Base& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - const Proxy P(X.get_ref()); - - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) - { - arma_conform_check(true, "min(): object has no elements"); - - return Datum::nan; - } - - T min_val = priv::most_pos(); - - if(Proxy::use_at == false) - { - typedef typename Proxy::ea_type ea_type; - - ea_type A = P.get_ea(); - - uword index = 0; - - for(uword i=0; i -inline -typename arma_cx_only::result -op_min::min(const BaseCube& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - const ProxyCube P(X.get_ref()); - - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) - { - arma_conform_check(true, "min(): object has no elements"); - - return Datum::nan; - } - - T min_val = priv::most_pos(); - - if(ProxyCube::use_at == false) - { - typedef typename ProxyCube::ea_type ea_type; - - ea_type A = P.get_ea(); - - uword index = 0; - - for(uword i=0; i -inline -typename arma_cx_only::result -op_min::min_with_index(const Proxy& P, uword& index_of_min_val) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) - { - arma_conform_check(true, "min(): object has no elements"); - - return Datum::nan; - } - - T best_val = priv::most_pos(); - - if(Proxy::use_at == false) - { - typedef typename Proxy::ea_type ea_type; - - ea_type A = P.get_ea(); - - uword best_index = 0; - - for(uword i=0; i -inline -typename arma_cx_only::result -op_min::min_with_index(const ProxyCube& P, uword& index_of_min_val) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) - { - arma_conform_check(true, "min(): object has no elements"); - - return Datum::nan; - } - - T best_val = priv::most_pos(); - - if(ProxyCube::use_at == false) - { - typedef typename ProxyCube::ea_type ea_type; - - ea_type A = P.get_ea(); - - uword best_index = 0; - - for(uword i=0; i < n_elem; ++i) - { - const T tmp = std::abs(A[i]); - - if(tmp < best_val) { best_val = tmp; best_index = i; } - } - - index_of_min_val = best_index; - - return( A[best_index] ); - } - else - { - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - const uword n_slices = P.get_n_slices(); - - eT best_val_orig = eT(0); - uword best_index = 0; - uword count = 0; - - for(uword slice=0; slice < n_slices; ++slice) - for(uword col=0; col < n_cols; ++col ) - for(uword row=0; row < n_rows; ++row ) - { - const eT tmp_orig = P.at(row,col,slice); - const T tmp = std::abs(tmp_orig); - - if(tmp < best_val) - { - best_val = tmp; - best_val_orig = tmp_orig; - best_index = count; - } - - ++count; - } - - index_of_min_val = best_index; - - return best_val_orig; - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_misc_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_misc_bones.hpp deleted file mode 100644 index 5fd157143..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_misc_bones.hpp +++ /dev/null @@ -1,80 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_misc -//! @{ - - - -class op_real - : public traits_op_passthru - { - public: - - template - inline static void apply( Mat& out, const mtOp& X); - - template - inline static void apply( Cube& out, const mtOpCube& X); - }; - - - -class op_imag - : public traits_op_passthru - { - public: - - template - inline static void apply( Mat& out, const mtOp& X); - - template - inline static void apply( Cube& out, const mtOpCube& X); - }; - - - -class op_abs - : public traits_op_passthru - { - public: - - template - inline static void apply( Mat& out, const mtOp& X); - - template - inline static void apply( Cube& out, const mtOpCube& X); - }; - - - -class op_arg - : public traits_op_passthru - { - public: - - template - inline static void apply( Mat& out, const mtOp& X); - - template - inline static void apply( Cube& out, const mtOpCube& X); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_misc_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_misc_meat.hpp deleted file mode 100644 index 0f6a7b963..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_misc_meat.hpp +++ /dev/null @@ -1,404 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_misc -//! @{ - - - -template -inline -void -op_real::apply( Mat& out, const mtOp& X ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - const Proxy P(X.m); - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - out.set_size(n_rows, n_cols); - - T* out_mem = out.memptr(); - - if(Proxy::use_at == false) - { - typedef typename Proxy::ea_type ea_type; - - const uword n_elem = P.get_n_elem(); - ea_type A = P.get_ea(); - - for(uword i=0; i < n_elem; ++i) - { - out_mem[i] = std::real( A[i] ); - } - } - else - { - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - *out_mem = std::real( P.at(row,col) ); - out_mem++; - } - } - } - - - -template -inline -void -op_real::apply( Cube& out, const mtOpCube& X ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - const ProxyCube P(X.m); - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - const uword n_slices = P.get_n_slices(); - - out.set_size(n_rows, n_cols, n_slices); - - T* out_mem = out.memptr(); - - if(ProxyCube::use_at == false) - { - typedef typename ProxyCube::ea_type ea_type; - - const uword n_elem = P.get_n_elem(); - ea_type A = P.get_ea(); - - for(uword i=0; i < n_elem; ++i) - { - out_mem[i] = std::real( A[i] ); - } - } - else - { - for(uword slice=0; slice < n_slices; ++slice) - for(uword col=0; col < n_cols; ++col ) - for(uword row=0; row < n_rows; ++row ) - { - *out_mem = std::real( P.at(row,col,slice) ); - out_mem++; - } - } - } - - - -template -inline -void -op_imag::apply( Mat& out, const mtOp& X ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - const Proxy P(X.m); - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - out.set_size(n_rows, n_cols); - - T* out_mem = out.memptr(); - - if(Proxy::use_at == false) - { - typedef typename Proxy::ea_type ea_type; - - const uword n_elem = P.get_n_elem(); - ea_type A = P.get_ea(); - - for(uword i=0; i < n_elem; ++i) - { - out_mem[i] = std::imag( A[i] ); - } - } - else - { - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - *out_mem = std::imag( P.at(row,col) ); - out_mem++; - } - } - } - - - -template -inline -void -op_imag::apply( Cube& out, const mtOpCube& X ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - const ProxyCube P(X.m); - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - const uword n_slices = P.get_n_slices(); - - out.set_size(n_rows, n_cols, n_slices); - - T* out_mem = out.memptr(); - - if(ProxyCube::use_at == false) - { - typedef typename ProxyCube::ea_type ea_type; - - const uword n_elem = P.get_n_elem(); - ea_type A = P.get_ea(); - - for(uword i=0; i < n_elem; ++i) - { - out_mem[i] = std::imag( A[i] ); - } - } - else - { - for(uword slice=0; slice < n_slices; ++slice) - for(uword col=0; col < n_cols; ++col ) - for(uword row=0; row < n_rows; ++row ) - { - *out_mem = std::imag( P.at(row,col,slice) ); - out_mem++; - } - } - } - - - -template -inline -void -op_abs::apply( Mat& out, const mtOp& X ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - const Proxy P(X.m); - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - out.set_size(n_rows, n_cols); - - T* out_mem = out.memptr(); - - if(Proxy::use_at == false) - { - typedef typename Proxy::ea_type ea_type; - - const uword n_elem = P.get_n_elem(); - ea_type A = P.get_ea(); - - #if defined(ARMA_USE_OPENMP) - { - const int n_threads = mp_thread_limit::get(); - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword i=0; i < n_elem; ++i) - { - out_mem[i] = std::abs( A[i] ); - } - } - #else - { - for(uword i=0; i < n_elem; ++i) - { - out_mem[i] = std::abs( A[i] ); - } - } - #endif - } - else - { - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - *out_mem = std::abs( P.at(row,col) ); - out_mem++; - } - } - } - - - -template -inline -void -op_abs::apply( Cube& out, const mtOpCube& X ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - const ProxyCube P(X.m); - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - const uword n_slices = P.get_n_slices(); - - out.set_size(n_rows, n_cols, n_slices); - - T* out_mem = out.memptr(); - - if(ProxyCube::use_at == false) - { - typedef typename ProxyCube::ea_type ea_type; - - const uword n_elem = P.get_n_elem(); - ea_type A = P.get_ea(); - - #if defined(ARMA_USE_OPENMP) - { - const int n_threads = mp_thread_limit::get(); - #pragma omp parallel for schedule(static) num_threads(n_threads) - for(uword i=0; i < n_elem; ++i) - { - out_mem[i] = std::abs( A[i] ); - } - } - #else - { - for(uword i=0; i < n_elem; ++i) - { - out_mem[i] = std::abs( A[i] ); - } - } - #endif - } - else - { - for(uword slice=0; slice < n_slices; ++slice) - for(uword col=0; col < n_cols; ++col ) - for(uword row=0; row < n_rows; ++row ) - { - *out_mem = std::abs( P.at(row,col,slice) ); - out_mem++; - } - } - } - - - -template -inline -void -op_arg::apply( Mat& out, const mtOp& X ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const Proxy P(X.m); - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - out.set_size(n_rows, n_cols); - - T* out_mem = out.memptr(); - - if(Proxy::use_at == false) - { - typedef typename Proxy::ea_type ea_type; - - const uword n_elem = P.get_n_elem(); - ea_type A = P.get_ea(); - - for(uword i=0; i < n_elem; ++i) - { - out_mem[i] = arma_arg::eval( A[i] ); - } - } - else - { - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - *out_mem = arma_arg::eval( P.at(row,col) ); - out_mem++; - } - } - } - - - -template -inline -void -op_arg::apply( Cube& out, const mtOpCube& X ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const ProxyCube P(X.m); - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - const uword n_slices = P.get_n_slices(); - - out.set_size(n_rows, n_cols, n_slices); - - T* out_mem = out.memptr(); - - if(ProxyCube::use_at == false) - { - typedef typename ProxyCube::ea_type ea_type; - - const uword n_elem = P.get_n_elem(); - ea_type A = P.get_ea(); - - for(uword i=0; i < n_elem; ++i) - { - out_mem[i] = arma_arg::eval( A[i] ); - } - } - else - { - for(uword slice=0; slice < n_slices; ++slice) - for(uword col=0; col < n_cols; ++col ) - for(uword row=0; row < n_rows; ++row ) - { - *out_mem = arma_arg::eval( P.at(row,col,slice) ); - out_mem++; - } - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_nonzeros_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_nonzeros_bones.hpp deleted file mode 100644 index be62b3f48..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_nonzeros_bones.hpp +++ /dev/null @@ -1,41 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_nonzeros -//! @{ - - - -class op_nonzeros - : public traits_op_col - { - public: - - // for dense matrices - - template - static inline void apply_noalias(Mat& out, const Proxy& P); - - template - static inline void apply(Mat& out, const Op& X); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_nonzeros_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_nonzeros_meat.hpp deleted file mode 100644 index cdc0b932b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_nonzeros_meat.hpp +++ /dev/null @@ -1,101 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_nonzeros -//! @{ - - - -template -inline -void -op_nonzeros::apply_noalias(Mat& out, const Proxy& P) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword N_max = P.get_n_elem(); - - Mat tmp(N_max, 1, arma_nozeros_indicator()); - - eT* tmp_mem = tmp.memptr(); - - uword N_nz = 0; - - if(Proxy::use_at == false) - { - typename Proxy::ea_type Pea = P.get_ea(); - - for(uword i=0; i -inline -void -op_nonzeros::apply(Mat& out, const Op& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const Proxy P(X.m); - - if(P.get_n_elem() == 0) { out.set_size(0,1); return; } - - if(P.is_alias(out)) - { - Mat out2; - - op_nonzeros::apply_noalias(out2, P); - - out.steal_mem(out2); - } - else - { - op_nonzeros::apply_noalias(out, P); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_norm2est_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_norm2est_bones.hpp deleted file mode 100644 index 7ac004bf5..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_norm2est_bones.hpp +++ /dev/null @@ -1,60 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_norm2est -//! @{ - - - -template -struct norm2est_randu_filler - { - std::mt19937_64 local_engine; - std::uniform_real_distribution local_u_distr; - - inline norm2est_randu_filler(); - - inline void fill(eT* mem, const uword N); - }; - - -template -struct norm2est_randu_filler< std::complex > - { - std::mt19937_64 local_engine; - std::uniform_real_distribution local_u_distr; - - inline norm2est_randu_filler(); - - inline void fill(std::complex* mem, const uword N); - }; - - - -class op_norm2est - : public traits_op_default - { - public: - - template inline static typename T1::pod_type norm2est(const Base& X, const typename T1::pod_type tolerance, const uword max_iter); - template inline static typename T1::pod_type norm2est(const SpBase& X, const typename T1::pod_type tolerance, const uword max_iter); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_norm2est_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_norm2est_meat.hpp deleted file mode 100644 index bf7d4497c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_norm2est_meat.hpp +++ /dev/null @@ -1,248 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_norm2est -//! @{ - - - -template -inline -norm2est_randu_filler::norm2est_randu_filler() - { - arma_debug_sigprint(); - - typedef typename std::mt19937_64::result_type local_seed_type; - - local_engine.seed(local_seed_type(123)); - - typedef typename std::uniform_real_distribution::param_type local_param_type; - - local_u_distr.param(local_param_type(-1.0, +1.0)); - } - - -template -inline -void -norm2est_randu_filler::fill(eT* mem, const uword N) - { - arma_debug_sigprint(); - - for(uword i=0; i -inline -norm2est_randu_filler< std::complex >::norm2est_randu_filler() - { - arma_debug_sigprint(); - - typedef typename std::mt19937_64::result_type local_seed_type; - - local_engine.seed(local_seed_type(123)); - - typedef typename std::uniform_real_distribution::param_type local_param_type; - - local_u_distr.param(local_param_type(-1.0, +1.0)); - } - - -template -inline -void -norm2est_randu_filler< std::complex >::fill(std::complex* mem, const uword N) - { - arma_debug_sigprint(); - - for(uword i=0; i& mem_i = mem[i]; - - mem_i.real( T(local_u_distr(local_engine)) ); - mem_i.imag( T(local_u_distr(local_engine)) ); - } - } - - - -// -// -// - - - -template -inline -typename T1::pod_type -op_norm2est::norm2est - ( - const Base& X, - const typename T1::pod_type tolerance, - const uword max_iter - ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - typedef typename T1::elem_type eT; - - arma_conform_check( (tolerance < T(0)), "norm2est(): parameter 'tolerance' must be > 0" ); - arma_conform_check( (max_iter == uword(0)), "norm2est(): parameter 'max_iter' must be > 0" ); - - const T tol = (tolerance == T(0)) ? T(1e-6) : T(tolerance); - - const quasi_unwrap U(X.get_ref()); - const Mat& A = U.M; - - if(A.n_elem == 0) { return T(0); } - - if(A.internal_has_nonfinite()) { arma_warn(1, "norm2est(): given matrix has non-finite elements"); } - - if((A.n_rows == 1) || (A.n_cols == 1)) { return op_norm::vec_norm_2( Proxy< Mat >(A) ); } - - norm2est_randu_filler randu_filler; - - Col x(A.n_rows, fill::none); - Col y(A.n_cols, fill::none); - - randu_filler.fill(y.memptr(), y.n_elem); - - T est_old = 0; - T est_cur = 0; - - for(uword i=0; i >(x) ); - - if(x_norm == T(0) || (arma_isfinite(x_norm) == false) || (x.internal_has_nonfinite())) - { - randu_filler.fill(x.memptr(), x.n_elem); - - x_norm = op_norm::vec_norm_2( Proxy< Col >(x) ); - } - - if(x_norm != T(0)) { x /= x_norm; } - - y = A.t() * x; - - est_old = est_cur; - est_cur = op_norm::vec_norm_2( Proxy< Col >(y) ); - - arma_debug_print(arma_str::format("norm2est(): est_old: %e") % est_old); - arma_debug_print(arma_str::format("norm2est(): est_cur: %e") % est_cur); - - if(arma_isfinite(est_cur) == false) { return est_old; } - - if( ((std::abs)(est_cur - est_old)) <= (tol * (std::max)(est_cur,est_old)) ) { break; } - } - - return est_cur; - } - - - -// -// -// - - - -template -inline -typename T1::pod_type -op_norm2est::norm2est - ( - const SpBase& X, - const typename T1::pod_type tolerance, - const uword max_iter - ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - typedef typename T1::elem_type eT; - - arma_conform_check( (tolerance < T(0)), "norm2est(): parameter 'tolerance' must be > 0" ); - arma_conform_check( (max_iter == uword(0)), "norm2est(): parameter 'max_iter' must be > 0" ); - - const T tol = (tolerance == T(0)) ? T(1e-6) : T(tolerance); - - const unwrap_spmat U(X.get_ref()); - const SpMat& A = U.M; - - if(A.n_nonzero == 0) { return T(0); } - - if(A.internal_has_nonfinite()) { arma_warn(1, "norm2est(): given matrix has non-finite elements"); } - - if((A.n_rows == 1) || (A.n_cols == 1)) { return spop_norm::vec_norm_k(A.values, A.n_nonzero, 2); } - - norm2est_randu_filler randu_filler; - - Mat x(A.n_rows, 1, fill::none); - Mat y(A.n_cols, 1, fill::none); - - randu_filler.fill(y.memptr(), y.n_elem); - - T est_old = 0; - T est_cur = 0; - - for(uword i=0; i >(x) ); - - if(x_norm == T(0) || (arma_isfinite(x_norm) == false) || (x.internal_has_nonfinite())) - { - randu_filler.fill(x.memptr(), x.n_elem); - - x_norm = op_norm::vec_norm_2( Proxy< Mat >(x) ); - } - - if(x_norm != T(0)) { x /= x_norm; } - - y = A.t() * x; - - est_old = est_cur; - est_cur = op_norm::vec_norm_2( Proxy< Mat >(y) ); - - arma_debug_print(arma_str::format("norm2est(): est_old: %e") % est_old); - arma_debug_print(arma_str::format("norm2est(): est_cur: %e") % est_cur); - - if(arma_isfinite(est_cur) == false) { return est_old; } - - if( ((std::abs)(est_cur - est_old)) <= (tol * (std::max)(est_cur,est_old)) ) { break; } - } - - return est_cur; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_norm_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_norm_bones.hpp deleted file mode 100644 index f40233839..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_norm_bones.hpp +++ /dev/null @@ -1,52 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_norm -//! @{ - - -class op_norm - : public traits_op_default - { - public: - - template arma_hot inline static typename T1::pod_type vec_norm_1(const Proxy& P, const typename arma_not_cx::result* junk = nullptr); - template arma_hot inline static typename T1::pod_type vec_norm_1(const Proxy& P, const typename arma_cx_only::result* junk = nullptr); - template arma_hot inline static eT vec_norm_1_direct_std(const Mat& X); - template arma_hot inline static eT vec_norm_1_direct_mem(const uword N, const eT* A); - - template arma_hot inline static typename T1::pod_type vec_norm_2(const Proxy& P, const typename arma_not_cx::result* junk = nullptr); - template arma_hot inline static typename T1::pod_type vec_norm_2(const Proxy& P, const typename arma_cx_only::result* junk = nullptr); - template arma_hot inline static eT vec_norm_2_direct_std(const Mat& X); - template arma_hot inline static eT vec_norm_2_direct_mem(const uword N, const eT* A); - template arma_hot inline static eT vec_norm_2_direct_robust(const Mat& X); - - template arma_hot inline static typename T1::pod_type vec_norm_k(const Proxy& P, const int k); - - template arma_hot inline static typename T1::pod_type vec_norm_max(const Proxy& P); - template arma_hot inline static typename T1::pod_type vec_norm_min(const Proxy& P); - - template inline static typename get_pod_type::result mat_norm_1(const Mat& X); - template inline static typename get_pod_type::result mat_norm_2(const Mat& X); - - template inline static typename get_pod_type::result mat_norm_inf(const Mat& X); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_norm_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_norm_meat.hpp deleted file mode 100644 index 210dfd8f8..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_norm_meat.hpp +++ /dev/null @@ -1,918 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_norm -//! @{ - - - -template -inline -typename T1::pod_type -op_norm::vec_norm_1(const Proxy& P, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const bool use_direct_mem = (is_Mat::stored_type>::value) || (is_subview_col::stored_type>::value) || (arma_config::openmp && Proxy::use_mp); - - if(use_direct_mem) - { - const quasi_unwrap::stored_type> tmp(P.Q); - - return op_norm::vec_norm_1_direct_std(tmp.M); - } - - typedef typename T1::pod_type T; - - T acc = T(0); - - if(Proxy::use_at == false) - { - typename Proxy::ea_type A = P.get_ea(); - - const uword N = P.get_n_elem(); - - T acc1 = T(0); - T acc2 = T(0); - - uword i,j; - for(i=0, j=1; j -inline -typename T1::pod_type -op_norm::vec_norm_1(const Proxy& P, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - T acc = T(0); - - if(Proxy::use_at == false) - { - typename Proxy::ea_type A = P.get_ea(); - - const uword N = P.get_n_elem(); - - for(uword i=0; i& X = A[i]; - - const T a = X.real(); - const T b = X.imag(); - - acc += std::sqrt( (a*a) + (b*b) ); - } - } - else - { - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - if(n_rows == 1) - { - for(uword col=0; col& X = P.at(0,col); - - const T a = X.real(); - const T b = X.imag(); - - acc += std::sqrt( (a*a) + (b*b) ); - } - } - else - { - for(uword col=0; col& X = P.at(row,col); - - const T a = X.real(); - const T b = X.imag(); - - acc += std::sqrt( (a*a) + (b*b) ); - } - } - } - - if( (acc != T(0)) && arma_isfinite(acc) ) - { - return acc; - } - else - { - arma_debug_print("detected possible underflow or overflow"); - - const quasi_unwrap::stored_type> R(P.Q); - - const uword N = R.M.n_elem; - const eT* R_mem = R.M.memptr(); - - T max_val = priv::most_neg(); - - for(uword i=0; i& X = R_mem[i]; - - const T a = std::abs(X.real()); - const T b = std::abs(X.imag()); - - if(a > max_val) { max_val = a; } - if(b > max_val) { max_val = b; } - } - - if(max_val == T(0)) { return T(0); } - - T alt_acc = T(0); - - for(uword i=0; i& X = R_mem[i]; - - const T a = X.real() / max_val; - const T b = X.imag() / max_val; - - alt_acc += std::sqrt( (a*a) + (b*b) ); - } - - return ( alt_acc * max_val ); - } - } - - - -template -inline -eT -op_norm::vec_norm_1_direct_std(const Mat& X) - { - arma_debug_sigprint(); - - const uword N = X.n_elem; - const eT* A = X.memptr(); - - eT out_val = eT(0); - - #if defined(ARMA_USE_ATLAS) - { - arma_debug_print("atlas::cblas_asum()"); - out_val = atlas::cblas_asum(N,A); - } - #elif defined(ARMA_USE_BLAS) - { - if(has_blas_float_bug::value) - { - out_val = op_norm::vec_norm_1_direct_mem(N,A); - } - else - { - arma_debug_print("blas::asum()"); - out_val = blas::asum(N,A); - } - } - #else - { - out_val = op_norm::vec_norm_1_direct_mem(N,A); - } - #endif - - return (out_val <= eT(0)) ? eT(0) : out_val; - } - - - -template -inline -eT -op_norm::vec_norm_1_direct_mem(const uword N, const eT* A) - { - arma_debug_sigprint(); - - #if (defined(ARMA_SIMPLE_LOOPS) || defined(__FAST_MATH__)) - { - eT acc1 = eT(0); - - if(memory::is_aligned(A)) - { - memory::mark_as_aligned(A); - - for(uword i=0; i -inline -typename T1::pod_type -op_norm::vec_norm_2(const Proxy& P, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - const bool use_direct_mem = (is_Mat::stored_type>::value) || (is_subview_col::stored_type>::value) || (arma_config::openmp && Proxy::use_mp); - - if(use_direct_mem) - { - const quasi_unwrap::stored_type> tmp(P.Q); - - return op_norm::vec_norm_2_direct_std(tmp.M); - } - - typedef typename T1::pod_type T; - - T acc = T(0); - - if(Proxy::use_at == false) - { - typename Proxy::ea_type A = P.get_ea(); - - const uword N = P.get_n_elem(); - - T acc1 = T(0); - T acc2 = T(0); - - uword i,j; - - for(i=0, j=1; j::stored_type> tmp(P.Q); - - return op_norm::vec_norm_2_direct_robust(tmp.M); - } - } - - - -template -inline -typename T1::pod_type -op_norm::vec_norm_2(const Proxy& P, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - T acc = T(0); - - if(Proxy::use_at == false) - { - typename Proxy::ea_type A = P.get_ea(); - - const uword N = P.get_n_elem(); - - for(uword i=0; i& X = A[i]; - - const T a = X.real(); - const T b = X.imag(); - - acc += (a*a) + (b*b); - } - } - else - { - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - if(n_rows == 1) - { - for(uword col=0; col& X = P.at(0,col); - - const T a = X.real(); - const T b = X.imag(); - - acc += (a*a) + (b*b); - } - } - else - { - for(uword col=0; col& X = P.at(row,col); - - const T a = X.real(); - const T b = X.imag(); - - acc += (a*a) + (b*b); - } - } - } - - const T sqrt_acc = std::sqrt(acc); - - if( (sqrt_acc != T(0)) && arma_isfinite(sqrt_acc) ) - { - return sqrt_acc; - } - else - { - arma_debug_print("detected possible underflow or overflow"); - - const quasi_unwrap::stored_type> R(P.Q); - - const uword N = R.M.n_elem; - const eT* R_mem = R.M.memptr(); - - T max_val = priv::most_neg(); - - for(uword i=0; i max_val) { max_val = val_i; } - } - - if(max_val == T(0)) { return T(0); } - - T alt_acc = T(0); - - for(uword i=0; i -inline -eT -op_norm::vec_norm_2_direct_std(const Mat& X) - { - arma_debug_sigprint(); - - const uword N = X.n_elem; - const eT* A = X.memptr(); - - eT out_val = eT(0); - - #if defined(ARMA_USE_ATLAS) - { - arma_debug_print("atlas::cblas_nrm2()"); - out_val = atlas::cblas_nrm2(N,A); - } - #elif defined(ARMA_USE_BLAS) - { - if(has_blas_float_bug::value) - { - out_val = op_norm::vec_norm_2_direct_mem(N,A); - } - else - { - arma_debug_print("blas::nrm2()"); - out_val = blas::nrm2(N,A); - } - } - #else - { - out_val = op_norm::vec_norm_2_direct_mem(N,A); - } - #endif - - if( (out_val != eT(0)) && arma_isfinite(out_val) ) - { - return (out_val < eT(0)) ? eT(0) : out_val; - } - else - { - arma_debug_print("detected possible underflow or overflow"); - - return op_norm::vec_norm_2_direct_robust(X); - } - } - - - -template -inline -eT -op_norm::vec_norm_2_direct_mem(const uword N, const eT* A) - { - arma_debug_sigprint(); - - eT acc = eT(0); - - #if (defined(ARMA_SIMPLE_LOOPS) || defined(__FAST_MATH__)) - { - eT acc1 = eT(0); - - if(memory::is_aligned(A)) - { - memory::mark_as_aligned(A); - - for(uword i=0; i -inline -eT -op_norm::vec_norm_2_direct_robust(const Mat& X) - { - arma_debug_sigprint(); - - const uword N = X.n_elem; - const eT* A = X.memptr(); - - eT max_val = priv::most_neg(); - - uword j; - - for(j=1; j max_val) { max_val = val_i; } - if(val_j > max_val) { max_val = val_j; } - } - - if((j-1) < N) - { - const eT val_i = std::abs(*A); - - if(val_i > max_val) { max_val = val_i; } - } - - if(max_val == eT(0)) { return eT(0); } - - const eT* B = X.memptr(); - - eT acc1 = eT(0); - eT acc2 = eT(0); - - for(j=1; j -inline -typename T1::pod_type -op_norm::vec_norm_k(const Proxy& P, const int k) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - T acc = T(0); - - if(Proxy::use_at == false) - { - typename Proxy::ea_type A = P.get_ea(); - - const uword N = P.get_n_elem(); - - for(uword i=0; i -inline -typename T1::pod_type -op_norm::vec_norm_max(const Proxy& P) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - const uword N = P.get_n_elem(); - - T max_val = (N != 1) ? priv::most_neg() : std::abs(P[0]); - - if(Proxy::use_at == false) - { - typename Proxy::ea_type A = P.get_ea(); - - uword i,j; - for(i=0, j=1; j -inline -typename T1::pod_type -op_norm::vec_norm_min(const Proxy& P) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - const uword N = P.get_n_elem(); - - T min_val = (N != 1) ? priv::most_pos() : std::abs(P[0]); - - if(Proxy::use_at == false) - { - typename Proxy::ea_type A = P.get_ea(); - - uword i,j; - for(i=0, j=1; j tmp_i) { min_val = tmp_i; } - if(min_val > tmp_j) { min_val = tmp_j; } - } - - if(i < N) - { - const T tmp_i = std::abs(A[i]); - - if(min_val > tmp_i) { min_val = tmp_i; } - } - } - else - { - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - if(n_rows != 1) - { - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - const T tmp = std::abs(P.at(row,col)); - - if(min_val > tmp) { min_val = tmp; } - } - } - else - { - for(uword col=0; col < n_cols; ++col) - { - const T tmp = std::abs(P.at(0,col)); - - if(min_val > tmp) { min_val = tmp; } - } - } - } - - return min_val; - } - - - -template -inline -typename get_pod_type::result -op_norm::mat_norm_1(const Mat& X) - { - arma_debug_sigprint(); - - // TODO: this can be sped up with a dedicated implementation - return as_scalar( max( sum(abs(X), 0), 1) ); - } - - - -template -inline -typename get_pod_type::result -op_norm::mat_norm_2(const Mat& X) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - if(X.internal_has_nonfinite()) { arma_warn(1, "norm(): given matrix has non-finite elements"); } - - Col S; - - svd(S, X); - - const T out_val = (S.n_elem > 0) ? S[0] : T(0); - - return (out_val <= T(0)) ? T(0) : out_val; - } - - - -template -inline -typename get_pod_type::result -op_norm::mat_norm_inf(const Mat& X) - { - arma_debug_sigprint(); - - // TODO: this can be sped up with a dedicated implementation - return as_scalar( max( sum(abs(X), 1), 0) ); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_normalise_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_normalise_bones.hpp deleted file mode 100644 index 4b1932c06..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_normalise_bones.hpp +++ /dev/null @@ -1,47 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_normalise -//! @{ - - - -class op_normalise_vec - : public traits_op_passthru - { - public: - - template inline static void apply(Mat& out, const Op& in); - }; - - - -class op_normalise_mat - : public traits_op_default - { - public: - - template inline static void apply(Mat& out, const Op& in); - - template inline static void apply(Mat& out, const Mat& A, const uword p, const uword dim); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_normalise_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_normalise_meat.hpp deleted file mode 100644 index 58efab2d6..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_normalise_meat.hpp +++ /dev/null @@ -1,148 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_normalise -//! @{ - - - -template -inline -void -op_normalise_vec::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const uword p = in.aux_uword_a; - - arma_conform_check( (p == 0), "normalise(): unsupported vector norm type" ); - - const quasi_unwrap U(in.m); - - const T norm_val_a = norm(U.M, p); - const T norm_val_b = (norm_val_a != T(0)) ? norm_val_a : T(1); - - if(quasi_unwrap::has_subview && U.is_alias(out)) - { - Mat tmp = U.M / norm_val_b; - - out.steal_mem(tmp); - } - else - { - out = U.M / norm_val_b; - } - } - - - -template -inline -void -op_normalise_mat::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword p = in.aux_uword_a; - const uword dim = in.aux_uword_b; - - arma_conform_check( (p == 0), "normalise(): unsupported vector norm type" ); - arma_conform_check( (dim > 1), "normalise(): parameter 'dim' must be 0 or 1" ); - - const quasi_unwrap U(in.m); - - if(quasi_unwrap::has_subview && U.is_alias(out)) - { - Mat out2; - - op_normalise_mat::apply(out2, U.M, p, dim); - - out.steal_mem(out2); - } - else - { - op_normalise_mat::apply(out, U.M, p, dim); - } - } - - - -template -inline -void -op_normalise_mat::apply(Mat& out, const Mat& A, const uword p, const uword dim) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - out.copy_size(A); - - if(A.n_elem == 0) { return; } - - if(dim == 0) - { - const uword n_cols = A.n_cols; - - for(uword i=0; i norm_vals(n_rows); - - T* norm_vals_mem = norm_vals.memptr(); - - for(uword i=0; i - inline static void apply(Mat& out, const Op& expr); - - template - inline static bool apply_direct(Mat& out, const Base& expr, typename T1::pod_type tol); - }; - - - -class op_null - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& expr); - - template - inline static bool apply_direct(Mat& out, const Base& expr, typename T1::pod_type tol); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_orth_null_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_orth_null_meat.hpp deleted file mode 100644 index b8fbb2ea3..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_orth_null_meat.hpp +++ /dev/null @@ -1,181 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_orth_null -//! @{ - - - -template -inline -void -op_orth::apply(Mat& out, const Op& expr) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - const T tol = access::tmp_real(expr.aux); - - const bool status = op_orth::apply_direct(out, expr.m, tol); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("orth(): svd failed"); - } - } - - - -template -inline -bool -op_orth::apply_direct(Mat& out, const Base& expr, typename T1::pod_type tol) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - arma_conform_check((tol < T(0)), "orth(): tolerance must be >= 0"); - - Mat A(expr.get_ref()); - - Mat U; - Col< T> s; - Mat V; - - const bool status = auxlib::svd_dc(U, s, V, A); - - V.reset(); - - if(status == false) { return false; } - - if(s.is_empty()) { out.reset(); return true; } - - const uword s_n_elem = s.n_elem; - const T* s_mem = s.memptr(); - - // set tolerance to default if it hasn't been specified - if(tol == T(0)) { tol = (std::max)(A.n_rows, A.n_cols) * s_mem[0] * std::numeric_limits::epsilon(); } - - uword count = 0; - - for(uword i=0; i < s_n_elem; ++i) { count += (s_mem[i] > tol) ? uword(1) : uword(0); } - - if(count > 0) - { - out = U.head_cols(count); // out *= eT(-1); - } - else - { - out.set_size(A.n_rows, 0); - } - - return true; - } - - - -// - - - -template -inline -void -op_null::apply(Mat& out, const Op& expr) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - const T tol = access::tmp_real(expr.aux); - - const bool status = op_null::apply_direct(out, expr.m, tol); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("null(): svd failed"); - } - } - - - -template -inline -bool -op_null::apply_direct(Mat& out, const Base& expr, typename T1::pod_type tol) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - arma_conform_check((tol < T(0)), "null(): tolerance must be >= 0"); - - Mat A(expr.get_ref()); - - Mat U; - Col< T> s; - Mat V; - - const bool status = auxlib::svd_dc(U, s, V, A); - - U.reset(); - - if(status == false) { return false; } - - if(s.is_empty()) { out.reset(); return true; } - - const uword s_n_elem = s.n_elem; - const T* s_mem = s.memptr(); - - // set tolerance to default if it hasn't been specified - if(tol == T(0)) { tol = (std::max)(A.n_rows, A.n_cols) * s_mem[0] * std::numeric_limits::epsilon(); } - - uword count = 0; - - for(uword i=0; i < s_n_elem; ++i) { count += (s_mem[i] > tol) ? uword(1) : uword(0); } - - if(count < A.n_cols) - { - out = V.tail_cols(A.n_cols - count); - - const uword out_n_elem = out.n_elem; - eT* out_mem = out.memptr(); - - for(uword i=0; i::epsilon()) { out_mem[i] = eT(0); } - } - } - else - { - out.set_size(A.n_cols, 0); - } - - return true; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_pinv_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_pinv_bones.hpp deleted file mode 100644 index bf83ddc93..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_pinv_bones.hpp +++ /dev/null @@ -1,55 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_pinv -//! @{ - - - -class op_pinv_default - : public traits_op_default - { - public: - - template inline static void apply(Mat& out, const Op& in); - - template inline static bool apply_direct(Mat& out, const Base& expr); - }; - - - -class op_pinv - : public traits_op_default - { - public: - - template inline static void apply(Mat& out, const Op& in); - - template inline static bool apply_direct(Mat& out, const Base& expr, typename T1::pod_type tol, const uword method_id); - - template inline static bool apply_diag(Mat& out, const Mat& A, typename get_pod_type::result tol); - - template inline static bool apply_sym (Mat& out, const Mat& A, typename get_pod_type::result tol, const uword method_id); - - template inline static bool apply_gen (Mat& out, Mat& A, typename get_pod_type::result tol, const uword method_id); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_pinv_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_pinv_meat.hpp deleted file mode 100644 index 9012bc3a0..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_pinv_meat.hpp +++ /dev/null @@ -1,318 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_pinv -//! @{ - - - -template -inline -void -op_pinv_default::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - const bool status = op_pinv_default::apply_direct(out, in.m); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("pinv(): svd failed"); - } - } - - - -template -inline -bool -op_pinv_default::apply_direct(Mat& out, const Base& expr) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - constexpr T tol = T(0); - constexpr uword method_id = uword(0); - - return op_pinv::apply_direct(out, expr, tol, method_id); - } - - - -// - - - -template -inline -void -op_pinv::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - const T tol = access::tmp_real(in.aux); - const uword method_id = in.aux_uword_a; - - const bool status = op_pinv::apply_direct(out, in.m, tol, method_id); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("pinv(): svd failed"); - } - } - - - -template -inline -bool -op_pinv::apply_direct(Mat& out, const Base& expr, typename T1::pod_type tol, const uword method_id) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - arma_conform_check((tol < T(0)), "pinv(): tolerance must be >= 0"); - - // method_id = 0 -> default setting - // method_id = 1 -> use standard algorithm - // method_id = 2 -> use divide and conquer algorithm - - Mat A(expr.get_ref()); - - if(A.is_empty()) { out.set_size(A.n_cols,A.n_rows); return true; } - - if(is_op_diagmat::value || A.is_diagmat()) - { - arma_debug_print("op_pinv: detected diagonal matrix"); - - return op_pinv::apply_diag(out, A, tol); - } - - bool do_sym = false; - - const bool is_sym_size_ok = (A.n_rows == A.n_cols) && (A.n_rows > (is_cx::yes ? uword(20) : uword(40))); - - if( (is_sym_size_ok) && (arma_config::optimise_sym) && (auxlib::crippled_lapack(A) == false) ) - { - do_sym = is_sym_expr::eval(expr.get_ref()); - - if(do_sym == false) - { - bool is_approx_sym = false; - bool is_approx_sympd = false; - - sym_helper::analyse_matrix(is_approx_sym, is_approx_sympd, A); - - do_sym = ((is_cx::no) ? (is_approx_sym) : (is_approx_sym && is_approx_sympd)); - } - } - - if(do_sym) - { - arma_debug_print("op_pinv: symmetric/hermitian optimisation"); - - return op_pinv::apply_sym(out, A, tol, method_id); - } - - return op_pinv::apply_gen(out, A, tol, method_id); - } - - - -template -inline -bool -op_pinv::apply_diag(Mat& out, const Mat& A, typename get_pod_type::result tol) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - out.zeros(A.n_cols, A.n_rows); - - const uword N = (std::min)(A.n_rows, A.n_cols); - - podarray diag_abs_vals(N); - - T max_abs_Aii = T(0); - - for(uword i=0; i max_abs_Aii) ? abs_Aii : max_abs_Aii; - } - - if(tol == T(0)) { tol = (std::max)(A.n_rows, A.n_cols) * max_abs_Aii * std::numeric_limits::epsilon(); } - - for(uword i=0; i= tol) - { - const eT Aii = A.at(i,i); - - if(Aii != eT(0)) { out.at(i,i) = eT(eT(1) / Aii); } - } - } - - return true; - } - - - -template -inline -bool -op_pinv::apply_sym(Mat& out, const Mat& A, typename get_pod_type::result tol, const uword method_id) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - Col< T> eigval; - Mat eigvec; - - const bool status = ((method_id == uword(0)) || (method_id == uword(2))) ? auxlib::eig_sym_dc(eigval, eigvec, A) : auxlib::eig_sym(eigval, eigvec, A); - - if(status == false) { return false; } - - if(eigval.n_elem == 0) { out.zeros(A.n_cols, A.n_rows); return true; } - - Col abs_eigval = arma::abs(eigval); - - const uvec indices = sort_index(abs_eigval, "descend"); - - abs_eigval = abs_eigval.elem(indices); - eigval = eigval.elem(indices); - eigvec = eigvec.cols(indices); - - // set tolerance to default if it hasn't been specified - if(tol == T(0)) { tol = (std::max)(A.n_rows, A.n_cols) * abs_eigval[0] * std::numeric_limits::epsilon(); } - - uword count = 0; - - for(uword i=0; i < abs_eigval.n_elem; ++i) { count += (abs_eigval[i] >= tol) ? uword(1) : uword(0); } - - if(count == 0) { out.zeros(A.n_cols, A.n_rows); return true; } - - Col eigval2(count, arma_nozeros_indicator()); - - uword count2 = 0; - - for(uword i=0; i < eigval.n_elem; ++i) - { - const T abs_val = abs_eigval[i]; - const T val = eigval[i]; - - if(abs_val >= tol) { eigval2[count2] = (val != T(0)) ? T(T(1) / val) : T(0); ++count2; } - } - - const Mat eigvec_use(eigvec.memptr(), eigvec.n_rows, count, false); - - out = (eigvec_use * diagmat(eigval2)).eval() * eigvec_use.t(); - - return true; - } - - - - -template -inline -bool -op_pinv::apply_gen(Mat& out, Mat& A, typename get_pod_type::result tol, const uword method_id) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const uword n_rows = A.n_rows; - const uword n_cols = A.n_cols; - - // economical SVD decomposition - Mat U; - Col< T> s; - Mat V; - - if(n_cols > n_rows) { A = trans(A); } - - const bool status = ((method_id == uword(0)) || (method_id == uword(2))) ? auxlib::svd_dc_econ(U, s, V, A) : auxlib::svd_econ(U, s, V, A, 'b'); - - if(status == false) { return false; } - - // set tolerance to default if it hasn't been specified - if( (tol == T(0)) && (s.n_elem > 0) ) { tol = (std::max)(n_rows, n_cols) * s[0] * std::numeric_limits::epsilon(); } - - uword count = 0; - - for(uword i=0; i < s.n_elem; ++i) { count += (s[i] >= tol) ? uword(1) : uword(0); } - - if(count == 0) { out.zeros(n_cols, n_rows); return true; } - - Col s2(count, arma_nozeros_indicator()); - - uword count2 = 0; - - for(uword i=0; i < s.n_elem; ++i) - { - const T val = s[i]; - - if(val >= tol) { s2[count2] = (val > T(0)) ? T(T(1) / val) : T(0); ++count2; } - } - - const Mat U_use(U.memptr(), U.n_rows, count, false); - const Mat V_use(V.memptr(), V.n_rows, count, false); - - Mat tmp; - - if(n_rows >= n_cols) - { - // out = ( (V.n_cols > count) ? V.cols(0,count-1) : V ) * diagmat(s2) * trans( (U.n_cols > count) ? U.cols(0,count-1) : U ); - - tmp = V_use * diagmat(s2); - - out = tmp * trans(U_use); - } - else - { - // out = ( (U.n_cols > count) ? U.cols(0,count-1) : U ) * diagmat(s2) * trans( (V.n_cols > count) ? V.cols(0,count-1) : V ); - - tmp = U_use * diagmat(s2); - - out = tmp * trans(V_use); - } - - return true; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_powmat_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_powmat_bones.hpp deleted file mode 100644 index 021522b15..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_powmat_bones.hpp +++ /dev/null @@ -1,56 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_powmat -//! @{ - - - -class op_powmat - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& expr); - - template - inline static bool apply_direct(Mat& out, const Base& X, const uword y, const bool y_neg); - - template - inline static void apply_direct_positive(Mat& out, const Mat& X, const uword y); - }; - - - -class op_powmat_cx - : public traits_op_default - { - public: - - template - inline static void apply(Mat< std::complex >& out, const mtOp,T1,op_powmat_cx>& expr); - - template - inline static bool apply_direct(Mat< std::complex >& out, const Base& X, const typename T1::pod_type y); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_powmat_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_powmat_meat.hpp deleted file mode 100644 index bbd104cf4..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_powmat_meat.hpp +++ /dev/null @@ -1,261 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_powmat -//! @{ - - -template -inline -void -op_powmat::apply(Mat& out, const Op& expr) - { - arma_debug_sigprint(); - - const uword y = expr.aux_uword_a; - const bool y_neg = (expr.aux_uword_b == uword(1)); - - const bool status = op_powmat::apply_direct(out, expr.m, y, y_neg); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("powmat(): transformation failed"); - } - } - - - -template -inline -bool -op_powmat::apply_direct(Mat& out, const Base& X, const uword y, const bool y_neg) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(y_neg) - { - if(y == uword(1)) - { - return op_inv_gen_default::apply_direct(out, X.get_ref(), "powmat()"); - } - else - { - Mat X_inv; - - const bool inv_status = op_inv_gen_default::apply_direct(X_inv, X.get_ref(), "powmat()"); - - if(inv_status == false) { return false; } - - op_powmat::apply_direct_positive(out, X_inv, y); - } - } - else - { - const quasi_unwrap U(X.get_ref()); - - arma_conform_check( (U.M.is_square() == false), "powmat(): given matrix must be square sized" ); - - op_powmat::apply_direct_positive(out, U.M, y); - } - - return true; - } - - - -template -inline -void -op_powmat::apply_direct_positive(Mat& out, const Mat& X, const uword y) - { - arma_debug_sigprint(); - - const uword N = X.n_rows; - - if(y == uword(0)) { out.eye(N,N); return; } - if(y == uword(1)) { out = X; return; } - - if(X.is_diagmat()) - { - arma_debug_print("op_powmat: detected diagonal matrix"); - - podarray tmp(N); // use temporary array in case we have aliasing - - for(uword i=0; i tmp = X*X; out = X*tmp; } - else if(y == uword(4)) { const Mat tmp = X*X; out = tmp*tmp; } - else if(y == uword(5)) { const Mat tmp = X*X; out = X*tmp*tmp; } - else - { - Mat tmp = X; - - out = X; - - uword z = y-1; - - while(z > 0) - { - if(z & 1) { out = tmp * out; } - - z /= uword(2); - - if(z > 0) { tmp = tmp * tmp; } - } - } - } - } - - - -template -inline -void -op_powmat_cx::apply(Mat< std::complex >& out, const mtOp,T1,op_powmat_cx>& expr) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type in_T; - - const in_T y = std::real(expr.aux_out_eT); - - const bool status = op_powmat_cx::apply_direct(out, expr.m, y); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("powmat(): transformation failed"); - } - } - - - -template -inline -bool -op_powmat_cx::apply_direct(Mat< std::complex >& out, const Base& X, const typename T1::pod_type y) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type in_eT; - typedef typename T1::pod_type in_T; - typedef std::complex out_eT; - - if( y == in_T(int(y)) ) - { - arma_debug_print("op_powmat_cx::apply_direct(): integer exponent detected; redirecting to op_powmat"); - - const uword y_val = (y < int(0)) ? uword(-y) : uword(y); - const bool y_neg = (y < int(0)); - - Mat tmp; - - const bool status = op_powmat::apply_direct(tmp, X.get_ref(), y_val, y_neg); - - if(status == false) { return false; } - - out = conv_to< Mat >::from(tmp); - - return true; - } - - const quasi_unwrap U(X.get_ref()); - const Mat& A = U.M; - - arma_conform_check( (A.is_square() == false), "powmat(): given matrix must be square sized" ); - - const uword N = A.n_rows; - - if(A.is_diagmat()) - { - arma_debug_print("op_powmat_cx: detected diagonal matrix"); - - podarray tmp(N); // use temporary array in case we have aliasing - - for(uword i=0; i(A.at(i,i)), y) ; } - - out.zeros(N,N); - - for(uword i=0; i eigval; - Mat eigvec; - - const bool eig_status = eig_sym(eigval, eigvec, A); - - if(eig_status) - { - eigval = pow(eigval, y); - - const Mat tmp = diagmat(eigval) * eigvec.t(); - - out = conv_to< Mat >::from(eigvec * tmp); - - return true; - } - - arma_debug_print("op_powmat_cx: sympd optimisation failed"); - - // fallthrough if optimisation failed - } - - bool powmat_status = false; - - Col eigval; - Mat eigvec; - - const bool eig_status = eig_gen(eigval, eigvec, A); - - if(eig_status) - { - eigval = pow(eigval, y); - - Mat eigvec_t = trans(eigvec); - Mat tmp = diagmat(conj(eigval)) * eigvec_t; - - const bool solve_status = auxlib::solve_square_fast(out, eigvec_t, tmp); - - if(solve_status) { out = trans(out); powmat_status = true; } - } - - return powmat_status; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_princomp_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_princomp_bones.hpp deleted file mode 100644 index 4d6abaabe..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_princomp_bones.hpp +++ /dev/null @@ -1,75 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_princomp -//! @{ - - - -class op_princomp - : public traits_op_default - { - public: - - template - inline static bool - direct_princomp - ( - Mat& coeff_out, - Mat& score_out, - Col& latent_out, - Col& tsquared_out, - const Base& X - ); - - - template - inline static bool - direct_princomp - ( - Mat& coeff_out, - Mat& score_out, - Col& latent_out, - const Base& X - ); - - template - inline static bool - direct_princomp - ( - Mat& coeff_out, - Mat& score_out, - const Base& X - ); - - template - inline static bool - direct_princomp - ( - Mat& coeff_out, - const Base& X - ); - - template - inline static void - apply(Mat& out, const Op& in); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_princomp_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_princomp_meat.hpp deleted file mode 100644 index 10894760b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_princomp_meat.hpp +++ /dev/null @@ -1,319 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_princomp -//! @{ - - - -//! \brief -//! principal component analysis -- 4 arguments version -//! computation is done via singular value decomposition -//! coeff_out -> principal component coefficients -//! score_out -> projected samples -//! latent_out -> eigenvalues of principal vectors -//! tsquared_out -> Hotelling's T^2 statistic -template -inline -bool -op_princomp::direct_princomp - ( - Mat& coeff_out, - Mat& score_out, - Col& latent_out, - Col& tsquared_out, - const Base& X - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const unwrap_check Y( X.get_ref(), score_out ); - const Mat& in = Y.M; - - const uword n_rows = in.n_rows; - const uword n_cols = in.n_cols; - - if(n_rows > 1) // more than one sample - { - // subtract the mean - use score_out as temporary matrix - score_out = in; score_out.each_row() -= mean(in); - - // singular value decomposition - Mat U; - Col< T> s; - - const bool svd_ok = (n_rows >= n_cols) ? svd_econ(U, s, coeff_out, score_out) : svd(U, s, coeff_out, score_out); - - if(svd_ok == false) { return false; } - - // normalize the eigenvalues - s /= std::sqrt( double(n_rows - 1) ); - - // project the samples to the principals - score_out *= coeff_out; - - if(n_rows <= n_cols) // number of samples is less than their dimensionality - { - score_out.cols(n_rows-1,n_cols-1).zeros(); - - Col s_tmp(n_cols, arma_zeros_indicator()); - - s_tmp.rows(0,n_rows-2) = s.rows(0,n_rows-2); - s = s_tmp; - - // compute the Hotelling's T-squared - s_tmp.rows(0,n_rows-2) = T(1) / s_tmp.rows(0,n_rows-2); - - const Mat S = score_out * diagmat(Col(s_tmp)); - tsquared_out = sum(S%S,1); - } - else - { - // compute the Hotelling's T-squared - // TODO: replace with more robust approach - const Mat S = score_out * diagmat(Col( T(1) / s)); - tsquared_out = sum(S%S,1); - } - - // compute the eigenvalues of the principal vectors - latent_out = s%s; - } - else // 0 or 1 samples - { - coeff_out.eye(n_cols, n_cols); - - score_out.copy_size(in); - score_out.zeros(); - - latent_out.set_size(n_cols); - latent_out.zeros(); - - tsquared_out.set_size(n_rows); - tsquared_out.zeros(); - } - - return true; - } - - - -//! \brief -//! principal component analysis -- 3 arguments version -//! computation is done via singular value decomposition -//! coeff_out -> principal component coefficients -//! score_out -> projected samples -//! latent_out -> eigenvalues of principal vectors -template -inline -bool -op_princomp::direct_princomp - ( - Mat& coeff_out, - Mat& score_out, - Col& latent_out, - const Base& X - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const unwrap_check Y( X.get_ref(), score_out ); - const Mat& in = Y.M; - - const uword n_rows = in.n_rows; - const uword n_cols = in.n_cols; - - if(n_rows > 1) // more than one sample - { - // subtract the mean - use score_out as temporary matrix - score_out = in; score_out.each_row() -= mean(in); - - // singular value decomposition - Mat U; - Col< T> s; - - const bool svd_ok = (n_rows >= n_cols) ? svd_econ(U, s, coeff_out, score_out) : svd(U, s, coeff_out, score_out); - - if(svd_ok == false) { return false; } - - // normalize the eigenvalues - s /= std::sqrt( double(n_rows - 1) ); - - // project the samples to the principals - score_out *= coeff_out; - - if(n_rows <= n_cols) // number of samples is less than their dimensionality - { - score_out.cols(n_rows-1,n_cols-1).zeros(); - - Col s_tmp(n_cols, arma_zeros_indicator()); - - s_tmp.rows(0,n_rows-2) = s.rows(0,n_rows-2); - s = s_tmp; - } - - // compute the eigenvalues of the principal vectors - latent_out = s%s; - } - else // 0 or 1 samples - { - coeff_out.eye(n_cols, n_cols); - - score_out.copy_size(in); - score_out.zeros(); - - latent_out.set_size(n_cols); - latent_out.zeros(); - } - - return true; - } - - - -//! \brief -//! principal component analysis -- 2 arguments version -//! computation is done via singular value decomposition -//! coeff_out -> principal component coefficients -//! score_out -> projected samples -template -inline -bool -op_princomp::direct_princomp - ( - Mat& coeff_out, - Mat& score_out, - const Base& X - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const unwrap_check Y( X.get_ref(), score_out ); - const Mat& in = Y.M; - - const uword n_rows = in.n_rows; - const uword n_cols = in.n_cols; - - if(n_rows > 1) // more than one sample - { - // subtract the mean - use score_out as temporary matrix - score_out = in; score_out.each_row() -= mean(in); - - // singular value decomposition - Mat U; - Col< T> s; - - const bool svd_ok = (n_rows >= n_cols) ? svd_econ(U, s, coeff_out, score_out) : svd(U, s, coeff_out, score_out); - - if(svd_ok == false) { return false; } - - // project the samples to the principals - score_out *= coeff_out; - - if(n_rows <= n_cols) // number of samples is less than their dimensionality - { - score_out.cols(n_rows-1,n_cols-1).zeros(); - } - } - else // 0 or 1 samples - { - coeff_out.eye(n_cols, n_cols); - score_out.copy_size(in); - score_out.zeros(); - } - - return true; - } - - - -//! \brief -//! principal component analysis -- 1 argument version -//! computation is done via singular value decomposition -//! coeff_out -> principal component coefficients -template -inline -bool -op_princomp::direct_princomp - ( - Mat& coeff_out, - const Base& X - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const unwrap Y( X.get_ref() ); - const Mat& in = Y.M; - - if(in.n_elem != 0) - { - Mat tmp = in; tmp.each_row() -= mean(in); - - // singular value decomposition - Mat U; - Col< T> s; - - const bool svd_ok = (in.n_rows >= in.n_cols) ? svd_econ(U, s, coeff_out, tmp) : svd(U, s, coeff_out, tmp); - - if(svd_ok == false) { return false; } - } - else - { - coeff_out.eye(in.n_cols, in.n_cols); - } - - return true; - } - - - -template -inline -void -op_princomp::apply - ( - Mat& out, - const Op& in - ) - { - arma_debug_sigprint(); - - const bool status = op_princomp::direct_princomp(out, in.m); - - if(status == false) - { - out.soft_reset(); - - arma_stop_runtime_error("princomp(): decomposition failed"); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_prod_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_prod_bones.hpp deleted file mode 100644 index 790401cb5..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_prod_bones.hpp +++ /dev/null @@ -1,42 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_prod -//! @{ - - -class op_prod - : public traits_op_xvec - { - public: - - template - inline static void apply_noalias(Mat& out, const Mat& X, const uword dim); - - template - inline static void apply(Mat& out, const Op& in); - - template - inline static eT prod(const subview& S); - - template - inline static typename T1::elem_type prod(const Base& X); - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_prod_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_prod_meat.hpp deleted file mode 100644 index c9f3302bc..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_prod_meat.hpp +++ /dev/null @@ -1,217 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_prod -//! @{ - - -template -inline -void -op_prod::apply_noalias(Mat& out, const Mat& X, const uword dim) - { - arma_debug_sigprint(); - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(dim == 0) // traverse across rows (ie. find the product in each column) - { - out.set_size(1, X_n_cols); - - eT* out_mem = out.memptr(); - - for(uword col=0; col < X_n_cols; ++col) - { - out_mem[col] = arrayops::product(X.colptr(col), X_n_rows); - } - } - else // traverse across columns (ie. find the product in each row) - { - out.ones(X_n_rows, 1); - - eT* out_mem = out.memptr(); - - for(uword col=0; col < X_n_cols; ++col) - { - const eT* X_col_mem = X.colptr(col); - - for(uword row=0; row < X_n_rows; ++row) - { - out_mem[row] *= X_col_mem[row]; - } - } - } - } - - - -template -inline -void -op_prod::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword dim = in.aux_uword_a; - - arma_conform_check( (dim > 1), "prod(): parameter 'dim' must be 0 or 1" ); - - const quasi_unwrap U(in.m); - - if(U.is_alias(out)) - { - Mat tmp; - - op_prod::apply_noalias(tmp, U.M, dim); - - out.steal_mem(tmp); - } - else - { - op_prod::apply_noalias(out, U.M, dim); - } - } - - - -template -inline -eT -op_prod::prod(const subview& X) - { - arma_debug_sigprint(); - - eT val = eT(1); - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(X_n_rows == 1) - { - const Mat& A = X.m; - - const uword start_row = X.aux_row1; - const uword start_col = X.aux_col1; - - const uword end_col_p1 = start_col + X_n_cols; - - uword i,j; - for(i=start_col, j=start_col+1; j < end_col_p1; i+=2, j+=2) - { - val *= A.at(start_row, i); - val *= A.at(start_row, j); - } - - if(i < end_col_p1) - { - val *= A.at(start_row, i); - } - } - else - { - for(uword col=0; col < X_n_cols; ++col) - { - val *= arrayops::product( X.colptr(col), X_n_rows ); - } - } - - return val; - } - - - -template -inline -typename T1::elem_type -op_prod::prod(const Base& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const Proxy P(X.get_ref()); - - eT val = eT(1); - - if(Proxy::use_at == false) - { - typedef typename Proxy::ea_type ea_type; - - const ea_type A = P.get_ea(); - - const uword n_elem = P.get_n_elem(); - - uword i,j; - for(i=0, j=1; j < n_elem; i+=2, j+=2) - { - val *= A[i]; - val *= A[j]; - } - - if(i < n_elem) - { - val *= A[i]; - } - } - else - { - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - if(n_rows == 1) - { - uword i,j; - for(i=0, j=1; j < n_cols; i+=2, j+=2) - { - val *= P.at(0,i); - val *= P.at(0,j); - } - - if(i < n_cols) - { - val *= P.at(0,i); - } - } - else - { - for(uword col=0; col < n_cols; ++col) - { - uword i,j; - for(i=0, j=1; j < n_rows; i+=2, j+=2) - { - val *= P.at(i,col); - val *= P.at(j,col); - } - - if(i < n_rows) - { - val *= P.at(i,col); - } - } - } - } - - return val; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_range_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_range_bones.hpp deleted file mode 100644 index 5745624b2..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_range_bones.hpp +++ /dev/null @@ -1,40 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_range -//! @{ - - -class op_range - : public traits_op_xvec - { - public: - - template - inline static void apply(Mat& out, const Op& in); - - template - inline static void apply_noalias(Mat& out, const Mat& X, const uword dim); - - template - inline static typename T1::elem_type vector_range(const T1& expr); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_range_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_range_meat.hpp deleted file mode 100644 index 6773090f0..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_range_meat.hpp +++ /dev/null @@ -1,96 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_range -//! @{ - - - -template -inline -void -op_range::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword dim = in.aux_uword_a; - arma_conform_check( (dim > 1), "range(): parameter 'dim' must be 0 or 1" ); - - const quasi_unwrap U(in.m); - const Mat& X = U.M; - - if(U.is_alias(out) == false) - { - op_range::apply_noalias(out, X, dim); - } - else - { - Mat tmp; - - op_range::apply_noalias(tmp, X, dim); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -op_range::apply_noalias(Mat& out, const Mat& X, const uword dim) - { - arma_debug_sigprint(); - - // TODO: replace with dedicated implementation which finds min and max at the same time - out = max(X,dim) - min(X,dim); - } - - - -template -inline -typename T1::elem_type -op_range::vector_range(const T1& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap U(expr); - const Mat& X = U.M; - - const eT* X_mem = X.memptr(); - const uword N = X.n_elem; - - if(N == 0) - { - arma_conform_check(true, "range(): object has no elements"); - - return Datum::nan; - } - - // TODO: replace with dedicated implementation which finds min and max at the same time - return op_max::direct_max(X_mem, N) - op_min::direct_min(X_mem, N); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_rank_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_rank_bones.hpp deleted file mode 100644 index f0c4a072f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_rank_bones.hpp +++ /dev/null @@ -1,41 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_rank -//! @{ - - - -class op_rank - : public traits_op_default - { - public: - - template inline static bool apply(uword& out, const Base& expr, const typename T1::pod_type tol); - - template inline static bool apply_gen(uword& out, Mat& A, typename get_pod_type::result tol); - - template inline static bool apply_sym(uword& out, Mat& A, typename get_pod_type::result tol); - - template inline static bool apply_diag(uword& out, Mat& A, typename get_pod_type::result tol); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_rank_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_rank_meat.hpp deleted file mode 100644 index 0a32c6b2c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_rank_meat.hpp +++ /dev/null @@ -1,191 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_rank -//! @{ - - - -template -inline -bool -op_rank::apply(uword& out, const Base& expr, const typename T1::pod_type tol) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - Mat A(expr.get_ref()); - - if(A.is_empty()) { out = uword(0); return true; } - - if(is_op_diagmat::value || A.is_diagmat()) - { - arma_debug_print("op_rank::apply(): detected diagonal matrix"); - - return op_rank::apply_diag(out, A, tol); - } - - bool do_sym = false; - - const bool is_sym_size_ok = (A.n_rows == A.n_cols) && (A.n_rows > (is_cx::yes ? uword(20) : uword(40))); // for consistency with op_pinv - - if( (is_sym_size_ok) && (arma_config::optimise_sym) && (auxlib::crippled_lapack(A) == false) ) - { - do_sym = is_sym_expr::eval(expr.get_ref()); - - if(do_sym == false) - { - bool is_approx_sym = false; - bool is_approx_sympd = false; - - sym_helper::analyse_matrix(is_approx_sym, is_approx_sympd, A); - - do_sym = (is_cx::no) ? (is_approx_sym) : (is_approx_sym && is_approx_sympd); - } - } - - if(do_sym) - { - arma_debug_print("op_rank::apply(): symmetric/hermitian optimisation"); - - return op_rank::apply_sym(out, A, tol); - } - - return op_rank::apply_gen(out, A, tol); - } - - - -template -inline -bool -op_rank::apply_diag(uword& out, Mat& A, typename get_pod_type::result tol) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const uword N = (std::min)(A.n_rows, A.n_cols); - - podarray diag_abs_vals(N); - - T max_abs_Aii = T(0); - - for(uword i=0; i max_abs_Aii) ? abs_Aii : max_abs_Aii; - } - - // set tolerance to default if it hasn't been specified - if(tol == T(0)) { tol = (std::max)(A.n_rows, A.n_cols) * max_abs_Aii * std::numeric_limits::epsilon(); } - - uword count = 0; - - for(uword i=0; i tol) ? uword(1) : uword(0); } - - out = count; - - return true; - } - - - -template -inline -bool -op_rank::apply_sym(uword& out, Mat& A, typename get_pod_type::result tol) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - if(A.is_square() == false) { out = uword(0); return false; } - - Col v; - - const bool status = auxlib::eig_sym(v, A); - - if(status == false) { out = uword(0); return false; } - - const uword v_n_elem = v.n_elem; - T* v_mem = v.memptr(); - - if(v_n_elem == 0) { out = uword(0); return true; } - - T max_abs_v = T(0); - - for(uword i=0; i < v_n_elem; ++i) { const T val = std::abs(v_mem[i]); v_mem[i] = val; if(val > max_abs_v) { max_abs_v = val; } } - - // set tolerance to default if it hasn't been specified - if(tol == T(0)) { tol = (std::max)(A.n_rows, A.n_cols) * max_abs_v * std::numeric_limits::epsilon(); } - - uword count = 0; - - for(uword i=0; i < v_n_elem; ++i) { count += (v_mem[i] > tol) ? uword(1) : uword(0); } - - out = count; - - return true; - } - - - -template -inline -bool -op_rank::apply_gen(uword& out, Mat& A, typename get_pod_type::result tol) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - Col s; - - const bool status = auxlib::svd_dc(s, A); - - if(status == false) { out = uword(0); return false; } - - const uword s_n_elem = s.n_elem; - const T* s_mem = s.memptr(); - - if(s_n_elem == 0) { out = uword(0); return true; } - - // set tolerance to default if it hasn't been specified - if(tol == T(0)) { tol = (std::max)(A.n_rows, A.n_cols) * s_mem[0] * std::numeric_limits::epsilon(); } - - uword count = 0; - - for(uword i=0; i < s_n_elem; ++i) { count += (s_mem[i] > tol) ? uword(1) : uword(0); } - - out = count; - - return true; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_rcond_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_rcond_bones.hpp deleted file mode 100644 index 88697e8dc..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_rcond_bones.hpp +++ /dev/null @@ -1,32 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_rcond -//! @{ - - -class op_rcond - : public traits_op_default - { - public: - - template static inline typename T1::pod_type apply(const Base& X); - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_rcond_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_rcond_meat.hpp deleted file mode 100644 index ae3aeaa9f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_rcond_meat.hpp +++ /dev/null @@ -1,113 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_rcond -//! @{ - - - -template -inline -typename T1::pod_type -op_rcond::apply(const Base& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - if(strip_trimat::do_trimat) - { - const strip_trimat S(X.get_ref()); - - const quasi_unwrap::stored_type> U(S.M); - - arma_conform_check( (U.M.is_square() == false), "rcond(): matrix must be square sized" ); - - const uword layout = (S.do_triu) ? uword(0) : uword(1); - - return auxlib::rcond_trimat(U.M, layout); - } - - Mat A = X.get_ref(); - - arma_conform_check( (A.is_square() == false), "rcond(): matrix must be square sized" ); - - if(A.is_empty()) { return Datum::inf; } - - if(is_op_diagmat::value || A.is_diagmat()) - { - arma_debug_print("op_rcond::apply(): detected diagonal matrix"); - - const eT* colmem = A.memptr(); - const uword N = A.n_rows; - - T abs_min = Datum::inf; - T abs_max = T(0); - - for(uword i=0; i abs_max) ? abs_val : abs_max; - - colmem += N; - } - - if((abs_min == T(0)) || (abs_max == T(0))) { return T(0); } - - return T(abs_min / abs_max); - } - - const bool is_triu = trimat_helper::is_triu(A); - const bool is_tril = (is_triu) ? false : trimat_helper::is_tril(A); - - if(is_triu || is_tril) - { - const uword layout = (is_triu) ? uword(0) : uword(1); - - return auxlib::rcond_trimat(A, layout); - } - - const bool try_sympd = arma_config::optimise_sym && (auxlib::crippled_lapack(A) ? false : sym_helper::guess_sympd(A)); - - if(try_sympd) - { - arma_debug_print("op_rcond::apply(): attempting sympd optimisation"); - - bool calc_ok = false; - - const T out_val = auxlib::rcond_sympd(A, calc_ok); - - if(calc_ok) { return out_val; } - - arma_debug_print("op_rcond::apply(): sympd optimisation failed"); - - // auxlib::rcond_sympd() may have failed because A isn't really sympd - // restore A, as auxlib::rcond_sympd() may have destroyed it - A = X.get_ref(); - // fallthrough to the next return statement - } - - return auxlib::rcond(A); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_relational_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_relational_bones.hpp deleted file mode 100644 index 0e8ecabcd..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_relational_bones.hpp +++ /dev/null @@ -1,164 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_relational -//! @{ - - - -class op_rel_lt_pre - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const mtOp& X); - - template - inline static void apply(Cube& out, const mtOpCube& X); - }; - - - -class op_rel_lt_post - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const mtOp& X); - - template - inline static void apply(Cube& out, const mtOpCube& X); - }; - - - -class op_rel_gt_pre - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const mtOp& X); - - template - inline static void apply(Cube& out, const mtOpCube& X); - }; - - - -class op_rel_gt_post - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const mtOp& X); - - template - inline static void apply(Cube& out, const mtOpCube& X); - }; - - - -class op_rel_lteq_pre - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const mtOp& X); - - template - inline static void apply(Cube& out, const mtOpCube& X); - }; - - - -class op_rel_lteq_post - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const mtOp& X); - - template - inline static void apply(Cube& out, const mtOpCube& X); - }; - - - -class op_rel_gteq_pre - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const mtOp& X); - - template - inline static void apply(Cube& out, const mtOpCube& X); - }; - - - -class op_rel_gteq_post - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const mtOp& X); - - template - inline static void apply(Cube& out, const mtOpCube& X); - }; - - - -class op_rel_eq - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const mtOp& X); - - template - inline static void apply(Cube& out, const mtOpCube& X); - }; - - - -class op_rel_noteq - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const mtOp& X); - - template - inline static void apply(Cube& out, const mtOpCube& X); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_relational_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_relational_meat.hpp deleted file mode 100644 index b9d050dfd..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_relational_meat.hpp +++ /dev/null @@ -1,510 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_relational -//! @{ - - -#undef operator_rel - -#undef arma_applier_mat_pre -#undef arma_applier_mat_post - -#undef arma_applier_cube_pre -#undef arma_applier_cube_post - - -#define arma_applier_mat_pre(operator_rel) \ - {\ - typedef typename T1::elem_type eT;\ - typedef typename Proxy::ea_type ea_type;\ - \ - const eT val = X.aux;\ - \ - const Proxy P(X.m);\ - \ - const uword n_rows = P.get_n_rows();\ - const uword n_cols = P.get_n_cols();\ - \ - const bool bad_alias = ( Proxy::has_subview && P.is_alias(out) );\ - \ - if(bad_alias == false)\ - {\ - out.set_size(n_rows, n_cols);\ - \ - uword* out_mem = out.memptr();\ - \ - if(Proxy::use_at == false)\ - {\ - ea_type PA = P.get_ea();\ - const uword n_elem = out.n_elem;\ - \ - for(uword i=0; i tmp(P.Q);\ - \ - out = (val) operator_rel (tmp);\ - }\ - } - - - -#define arma_applier_mat_post(operator_rel) \ - {\ - typedef typename T1::elem_type eT;\ - typedef typename Proxy::ea_type ea_type;\ - \ - const eT val = X.aux;\ - \ - const Proxy P(X.m);\ - \ - const uword n_rows = P.get_n_rows();\ - const uword n_cols = P.get_n_cols();\ - \ - const bool bad_alias = ( Proxy::has_subview && P.is_alias(out) );\ - \ - if(bad_alias == false)\ - {\ - out.set_size(n_rows, n_cols);\ - \ - uword* out_mem = out.memptr();\ - \ - if(Proxy::use_at == false)\ - {\ - ea_type PA = P.get_ea();\ - const uword n_elem = out.n_elem;\ - \ - for(uword i=0; i tmp(P.Q);\ - \ - out = (tmp) operator_rel (val);\ - }\ - } - - - -#define arma_applier_cube_pre(operator_rel) \ - {\ - typedef typename T1::elem_type eT;\ - typedef typename ProxyCube::ea_type ea_type;\ - \ - const eT val = X.aux;\ - \ - const ProxyCube P(X.m);\ - \ - const uword n_rows = P.get_n_rows();\ - const uword n_cols = P.get_n_cols();\ - const uword n_slices = P.get_n_slices();\ - \ - const bool bad_alias = ( ProxyCube::has_subview && P.is_alias(out) );\ - \ - if(bad_alias == false)\ - {\ - out.set_size(n_rows, n_cols, n_slices);\ - \ - uword* out_mem = out.memptr();\ - \ - if(ProxyCube::use_at == false)\ - {\ - ea_type PA = P.get_ea();\ - const uword n_elem = out.n_elem;\ - \ - for(uword i=0; i::stored_type> tmp(P.Q);\ - \ - out = (val) operator_rel (tmp.M);\ - }\ - } - - - -#define arma_applier_cube_post(operator_rel) \ - {\ - typedef typename T1::elem_type eT;\ - typedef typename ProxyCube::ea_type ea_type;\ - \ - const eT val = X.aux;\ - \ - const ProxyCube P(X.m);\ - \ - const uword n_rows = P.get_n_rows();\ - const uword n_cols = P.get_n_cols();\ - const uword n_slices = P.get_n_slices();\ - \ - const bool bad_alias = ( ProxyCube::has_subview && P.is_alias(out) );\ - \ - if(bad_alias == false)\ - {\ - out.set_size(n_rows, n_cols, n_slices);\ - \ - uword* out_mem = out.memptr();\ - \ - if(ProxyCube::use_at == false)\ - {\ - ea_type PA = P.get_ea();\ - const uword n_elem = out.n_elem;\ - \ - for(uword i=0; i::stored_type> tmp(P.Q);\ - \ - out = (tmp.M) operator_rel (val);\ - }\ - } - - - -template -inline -void -op_rel_lt_pre::apply(Mat& out, const mtOp& X) - { - arma_debug_sigprint(); - - arma_applier_mat_pre( < ); - } - - - -template -inline -void -op_rel_gt_pre::apply(Mat& out, const mtOp& X) - { - arma_debug_sigprint(); - - arma_applier_mat_pre( > ); - } - - - -template -inline -void -op_rel_lteq_pre::apply(Mat& out, const mtOp& X) - { - arma_debug_sigprint(); - - arma_applier_mat_pre( <= ); - } - - - -template -inline -void -op_rel_gteq_pre::apply(Mat& out, const mtOp& X) - { - arma_debug_sigprint(); - - arma_applier_mat_pre( >= ); - } - - - -template -inline -void -op_rel_lt_post::apply(Mat& out, const mtOp& X) - { - arma_debug_sigprint(); - - arma_applier_mat_post( < ); - } - - - -template -inline -void -op_rel_gt_post::apply(Mat& out, const mtOp& X) - { - arma_debug_sigprint(); - - arma_applier_mat_post( > ); - } - - - -template -inline -void -op_rel_lteq_post::apply(Mat& out, const mtOp& X) - { - arma_debug_sigprint(); - - arma_applier_mat_post( <= ); - } - - - -template -inline -void -op_rel_gteq_post::apply(Mat& out, const mtOp& X) - { - arma_debug_sigprint(); - - arma_applier_mat_post( >= ); - } - - - -template -inline -void -op_rel_eq::apply(Mat& out, const mtOp& X) - { - arma_debug_sigprint(); - - arma_applier_mat_post( == ); - } - - - -template -inline -void -op_rel_noteq::apply(Mat& out, const mtOp& X) - { - arma_debug_sigprint(); - - arma_applier_mat_post( != ); - } - - - -// -// -// - - - -template -inline -void -op_rel_lt_pre::apply(Cube& out, const mtOpCube& X) - { - arma_debug_sigprint(); - - arma_applier_cube_pre( < ); - } - - - -template -inline -void -op_rel_gt_pre::apply(Cube& out, const mtOpCube& X) - { - arma_debug_sigprint(); - - arma_applier_cube_pre( > ); - } - - - -template -inline -void -op_rel_lteq_pre::apply(Cube& out, const mtOpCube& X) - { - arma_debug_sigprint(); - - arma_applier_cube_pre( <= ); - } - - - -template -inline -void -op_rel_gteq_pre::apply(Cube& out, const mtOpCube& X) - { - arma_debug_sigprint(); - - arma_applier_cube_pre( >= ); - } - - - -template -inline -void -op_rel_lt_post::apply(Cube& out, const mtOpCube& X) - { - arma_debug_sigprint(); - - arma_applier_cube_post( < ); - } - - - -template -inline -void -op_rel_gt_post::apply(Cube& out, const mtOpCube& X) - { - arma_debug_sigprint(); - - arma_applier_cube_post( > ); - } - - - -template -inline -void -op_rel_lteq_post::apply(Cube& out, const mtOpCube& X) - { - arma_debug_sigprint(); - - arma_applier_cube_post( <= ); - } - - - -template -inline -void -op_rel_gteq_post::apply(Cube& out, const mtOpCube& X) - { - arma_debug_sigprint(); - - arma_applier_cube_post( >= ); - } - - - -template -inline -void -op_rel_eq::apply(Cube& out, const mtOpCube& X) - { - arma_debug_sigprint(); - - arma_applier_cube_post( == ); - } - - - -template -inline -void -op_rel_noteq::apply(Cube& out, const mtOpCube& X) - { - arma_debug_sigprint(); - - arma_applier_cube_post( != ); - } - - - -#undef arma_applier_mat_pre -#undef arma_applier_mat_post - -#undef arma_applier_cube_pre -#undef arma_applier_cube_post - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_repelem_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_repelem_bones.hpp deleted file mode 100644 index 52d20a41f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_repelem_bones.hpp +++ /dev/null @@ -1,37 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_repelem -//! @{ - - - -class op_repelem - : public traits_op_default - { - public: - - template inline static void apply_noalias(Mat& out, const obj& X, const uword copies_per_row, const uword copies_per_col); - - template inline static void apply(Mat& out, const Op& in); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_repelem_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_repelem_meat.hpp deleted file mode 100644 index b9dd1ac28..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_repelem_meat.hpp +++ /dev/null @@ -1,103 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_repelem -//! @{ - - - -template -inline -void -op_repelem::apply_noalias(Mat& out, const obj& X, const uword copies_per_row, const uword copies_per_col) - { - arma_debug_sigprint(); - - typedef typename obj::elem_type eT; - - const uword X_n_rows = obj::is_row ? uword(1) : X.n_rows; - const uword X_n_cols = obj::is_col ? uword(1) : X.n_cols; - - out.set_size(X_n_rows * copies_per_row, X_n_cols * copies_per_col); - - if(out.n_elem == 0) { return; } - - for(uword col=0; col < X_n_cols; ++col) - { - const uword out_col_offset = col * copies_per_col; - - eT* out_colptr_first = out.colptr(out_col_offset); - - for(uword row=0; row < X_n_rows; ++row) - { - const uword out_row_offset = row * copies_per_row; - - const eT copy_value = X.at(row, col); - - for(uword row_copy=0; row_copy < copies_per_row; ++row_copy) - { - out_colptr_first[out_row_offset + row_copy] = copy_value; - } - - if(copies_per_col != 1) - { - for(uword col_copy=1; col_copy < copies_per_col; ++col_copy) - { - eT* out_colptr = out.colptr(out_col_offset + col_copy); - - arrayops::copy(&out_colptr[out_row_offset], &out_colptr_first[out_row_offset], copies_per_row); - } - } - } - } - } - - - -template -inline -void -op_repelem::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword copies_per_row = in.aux_uword_a; - const uword copies_per_col = in.aux_uword_b; - - const quasi_unwrap U(in.m); - - if(U.is_alias(out)) - { - Mat tmp; - - op_repelem::apply_noalias(tmp, U.M, copies_per_row, copies_per_col); - - out.steal_mem(tmp); - } - else - { - op_repelem::apply_noalias(out, U.M, copies_per_row, copies_per_col); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_repmat_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_repmat_bones.hpp deleted file mode 100644 index 100179abf..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_repmat_bones.hpp +++ /dev/null @@ -1,37 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_repmat -//! @{ - - - -class op_repmat - : public traits_op_default - { - public: - - template inline static void apply_noalias(Mat& out, const obj& X, const uword copies_per_row, const uword copies_per_col); - - template inline static void apply(Mat& out, const Op& in); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_repmat_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_repmat_meat.hpp deleted file mode 100644 index a89cc1b8a..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_repmat_meat.hpp +++ /dev/null @@ -1,124 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_repmat -//! @{ - - - -template -inline -void -op_repmat::apply_noalias(Mat& out, const obj& X, const uword copies_per_row, const uword copies_per_col) - { - arma_debug_sigprint(); - - typedef typename obj::elem_type eT; - - const uword X_n_rows = obj::is_row ? uword(1) : X.n_rows; - const uword X_n_cols = obj::is_col ? uword(1) : X.n_cols; - - out.set_size(X_n_rows * copies_per_row, X_n_cols * copies_per_col); - - const uword out_n_rows = out.n_rows; - const uword out_n_cols = out.n_cols; - - // if( (out_n_rows > 0) && (out_n_cols > 0) ) - // { - // for(uword col = 0; col < out_n_cols; col += X_n_cols) - // for(uword row = 0; row < out_n_rows; row += X_n_rows) - // { - // out.submat(row, col, row+X_n_rows-1, col+X_n_cols-1) = X; - // } - // } - - if( (out_n_rows > 0) && (out_n_cols > 0) ) - { - if(copies_per_row != 1) - { - for(uword col_copy=0; col_copy < copies_per_col; ++col_copy) - { - const uword out_col_offset = X_n_cols * col_copy; - - for(uword col=0; col < X_n_cols; ++col) - { - eT* out_colptr = out.colptr(col + out_col_offset); - const eT* X_colptr = X.colptr(col); - - for(uword row_copy=0; row_copy < copies_per_row; ++row_copy) - { - const uword out_row_offset = X_n_rows * row_copy; - - arrayops::copy( &out_colptr[out_row_offset], X_colptr, X_n_rows ); - } - } - } - } - else - { - for(uword col_copy=0; col_copy < copies_per_col; ++col_copy) - { - const uword out_col_offset = X_n_cols * col_copy; - - for(uword col=0; col < X_n_cols; ++col) - { - eT* out_colptr = out.colptr(col + out_col_offset); - const eT* X_colptr = X.colptr(col); - - arrayops::copy( out_colptr, X_colptr, X_n_rows ); - } - } - } - } - - } - - - -template -inline -void -op_repmat::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword copies_per_row = in.aux_uword_a; - const uword copies_per_col = in.aux_uword_b; - - const quasi_unwrap U(in.m); - - if(U.is_alias(out)) - { - Mat tmp; - - op_repmat::apply_noalias(tmp, U.M, copies_per_row, copies_per_col); - - out.steal_mem(tmp); - } - else - { - op_repmat::apply_noalias(out, U.M, copies_per_row, copies_per_col); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_reshape_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_reshape_bones.hpp deleted file mode 100644 index b27f22b88..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_reshape_bones.hpp +++ /dev/null @@ -1,49 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_reshape -//! @{ - - - -class op_reshape - : public traits_op_default - { - public: - - template inline static void apply(Mat& out, const Op& in); - - template inline static void apply_mat_inplace(Mat& A, const uword new_n_rows, const uword new_n_cols); - - template inline static void apply_mat_noalias(Mat& out, const Mat& A, const uword new_n_rows, const uword new_n_cols); - - template inline static void apply_proxy_noalias(Mat& out, const Proxy& P, const uword new_n_rows, const uword new_n_cols); - - // - - template inline static void apply(Cube& out, const OpCube& in); - - template inline static void apply_cube_inplace(Cube& A, const uword new_n_rows, const uword new_n_cols, const uword new_n_slices); - - template inline static void apply_cube_noalias(Cube& out, const Cube& A, const uword new_n_rows, const uword new_n_cols, const uword new_n_slices); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_reshape_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_reshape_meat.hpp deleted file mode 100644 index 322223d27..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_reshape_meat.hpp +++ /dev/null @@ -1,249 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_reshape -//! @{ - - - -template -inline -void -op_reshape::apply(Mat& actual_out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword new_n_rows = in.aux_uword_a; - const uword new_n_cols = in.aux_uword_b; - - if(is_Mat::value || (arma_config::openmp && Proxy::use_mp)) - { - const unwrap U(in.m); - const Mat& A = U.M; - - if(&actual_out == &A) - { - op_reshape::apply_mat_inplace(actual_out, new_n_rows, new_n_cols); - } - else - { - op_reshape::apply_mat_noalias(actual_out, A, new_n_rows, new_n_cols); - } - } - else - { - const Proxy P(in.m); - - const bool is_alias = P.is_alias(actual_out); - - Mat tmp; - Mat& out = (is_alias) ? tmp : actual_out; - - if(is_Mat::stored_type>::value) - { - const quasi_unwrap::stored_type> U(P.Q); - - op_reshape::apply_mat_noalias(out, U.M, new_n_rows, new_n_cols); - } - else - { - op_reshape::apply_proxy_noalias(out, P, new_n_rows, new_n_cols); - } - - if(is_alias) { actual_out.steal_mem(tmp); } - } - } - - - -template -inline -void -op_reshape::apply_mat_inplace(Mat& A, const uword new_n_rows, const uword new_n_cols) - { - arma_debug_sigprint(); - - arma_conform_check( (A.vec_state == 1) && (new_n_cols != 1), "reshape(): requested size is not compatible with column vector layout" ); - arma_conform_check( (A.vec_state == 2) && (new_n_rows != 1), "reshape(): requested size is not compatible with row vector layout" ); - - const uword new_n_elem = new_n_rows * new_n_cols; - - if(A.n_elem == new_n_elem) { A.set_size(new_n_rows, new_n_cols); return; } - - Mat B; - - op_reshape::apply_mat_noalias(B, A, new_n_rows, new_n_cols); - - A.steal_mem(B); - } - - - -template -inline -void -op_reshape::apply_mat_noalias(Mat& out, const Mat& A, const uword new_n_rows, const uword new_n_cols) - { - arma_debug_sigprint(); - - out.set_size(new_n_rows, new_n_cols); - - const uword n_elem_to_copy = (std::min)(A.n_elem, out.n_elem); - - eT* out_mem = out.memptr(); - - arrayops::copy( out_mem, A.memptr(), n_elem_to_copy ); - - if(n_elem_to_copy < out.n_elem) - { - const uword n_elem_leftover = out.n_elem - n_elem_to_copy; - - arrayops::fill_zeros(&(out_mem[n_elem_to_copy]), n_elem_leftover); - } - } - - - -template -inline -void -op_reshape::apply_proxy_noalias(Mat& out, const Proxy& P, const uword new_n_rows, const uword new_n_cols) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - out.set_size(new_n_rows, new_n_cols); - - const uword n_elem_to_copy = (std::min)(P.get_n_elem(), out.n_elem); - - eT* out_mem = out.memptr(); - - if(Proxy::use_at == false) - { - typename Proxy::ea_type Pea = P.get_ea(); - - for(uword i=0; i < n_elem_to_copy; ++i) { out_mem[i] = Pea[i]; } - } - else - { - uword i = 0; - - const uword P_n_rows = P.get_n_rows(); - const uword P_n_cols = P.get_n_cols(); - - for(uword col=0; col < P_n_cols; ++col) - for(uword row=0; row < P_n_rows; ++row) - { - if(i >= n_elem_to_copy) { goto nested_loop_end; } - - out_mem[i] = P.at(row,col); - - ++i; - } - - nested_loop_end: ; - } - - if(n_elem_to_copy < out.n_elem) - { - const uword n_elem_leftover = out.n_elem - n_elem_to_copy; - - arrayops::fill_zeros(&(out_mem[n_elem_to_copy]), n_elem_leftover); - } - } - - - -template -inline -void -op_reshape::apply(Cube& out, const OpCube& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_cube U(in.m); - const Cube& A = U.M; - - const uword new_n_rows = in.aux_uword_a; - const uword new_n_cols = in.aux_uword_b; - const uword new_n_slices = in.aux_uword_c; - - if(&out == &A) - { - op_reshape::apply_cube_inplace(out, new_n_rows, new_n_cols, new_n_slices); - } - else - { - op_reshape::apply_cube_noalias(out, A, new_n_rows, new_n_cols, new_n_slices); - } - } - - - -template -inline -void -op_reshape::apply_cube_inplace(Cube& A, const uword new_n_rows, const uword new_n_cols, const uword new_n_slices) - { - arma_debug_sigprint(); - - const uword new_n_elem = new_n_rows * new_n_cols * new_n_slices; - - if(A.n_elem == new_n_elem) { A.set_size(new_n_rows, new_n_cols, new_n_slices); return; } - - Cube B; - - op_reshape::apply_cube_noalias(B, A, new_n_rows, new_n_cols, new_n_slices); - - A.steal_mem(B); - } - - - -template -inline -void -op_reshape::apply_cube_noalias(Cube& out, const Cube& A, const uword new_n_rows, const uword new_n_cols, const uword new_n_slices) - { - arma_debug_sigprint(); - - out.set_size(new_n_rows, new_n_cols, new_n_slices); - - const uword n_elem_to_copy = (std::min)(A.n_elem, out.n_elem); - - eT* out_mem = out.memptr(); - - arrayops::copy( out_mem, A.memptr(), n_elem_to_copy ); - - if(n_elem_to_copy < out.n_elem) - { - const uword n_elem_leftover = out.n_elem - n_elem_to_copy; - - arrayops::fill_zeros(&(out_mem[n_elem_to_copy]), n_elem_leftover); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_resize_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_resize_bones.hpp deleted file mode 100644 index d33273fab..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_resize_bones.hpp +++ /dev/null @@ -1,47 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_resize -//! @{ - - - -class op_resize - : public traits_op_default - { - public: - - template inline static void apply(Mat& out, const Op& in); - - template inline static void apply_mat_inplace(Mat& A, const uword new_n_rows, const uword new_n_cols); - - template inline static void apply_mat_noalias(Mat& out, const Mat& A, const uword new_n_rows, const uword new_n_cols); - - // - - template inline static void apply(Cube& out, const OpCube& in); - - template inline static void apply_cube_inplace(Cube& A, const uword new_n_rows, const uword new_n_cols, const uword new_n_slices); - - template inline static void apply_cube_noalias(Cube& out, const Cube& A, const uword new_n_rows, const uword new_n_cols, const uword new_n_slices); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_resize_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_resize_meat.hpp deleted file mode 100644 index 5db5d4257..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_resize_meat.hpp +++ /dev/null @@ -1,172 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_resize -//! @{ - - - -template -inline -void -op_resize::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword new_n_rows = in.aux_uword_a; - const uword new_n_cols = in.aux_uword_b; - - const unwrap tmp(in.m); - const Mat& A = tmp.M; - - if(&out == &A) - { - op_resize::apply_mat_inplace(out, new_n_rows, new_n_cols); - } - else - { - op_resize::apply_mat_noalias(out, A, new_n_rows, new_n_cols); - } - } - - - -template -inline -void -op_resize::apply_mat_inplace(Mat& A, const uword new_n_rows, const uword new_n_cols) - { - arma_debug_sigprint(); - - if( (A.n_rows == new_n_rows) && (A.n_cols == new_n_cols) ) { return; } - - arma_conform_check( (A.vec_state == 1) && (new_n_cols != 1), "resize(): requested size is not compatible with column vector layout" ); - arma_conform_check( (A.vec_state == 2) && (new_n_rows != 1), "resize(): requested size is not compatible with row vector layout" ); - - if(A.is_empty()) { A.zeros(new_n_rows, new_n_cols); return; } - - Mat B; - - op_resize::apply_mat_noalias(B, A, new_n_rows, new_n_cols); - - A.steal_mem(B); - } - - - -template -inline -void -op_resize::apply_mat_noalias(Mat& out, const Mat& A, const uword new_n_rows, const uword new_n_cols) - { - arma_debug_sigprint(); - - out.set_size(new_n_rows, new_n_cols); - - if( (new_n_rows > A.n_rows) || (new_n_cols > A.n_cols) ) { out.zeros(); } - - if( (out.n_elem > 0) && (A.n_elem > 0) ) - { - const uword end_row = (std::min)(new_n_rows, A.n_rows) - 1; - const uword end_col = (std::min)(new_n_cols, A.n_cols) - 1; - - out.submat(0, 0, end_row, end_col) = A.submat(0, 0, end_row, end_col); - } - } - - - -// - - - -template -inline -void -op_resize::apply(Cube& out, const OpCube& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword new_n_rows = in.aux_uword_a; - const uword new_n_cols = in.aux_uword_b; - const uword new_n_slices = in.aux_uword_c; - - const unwrap_cube tmp(in.m); - const Cube& A = tmp.M; - - if(&out == &A) - { - op_resize::apply_cube_inplace(out, new_n_rows, new_n_cols, new_n_slices); - } - else - { - op_resize::apply_cube_noalias(out, A, new_n_rows, new_n_cols, new_n_slices); - } - } - - - -template -inline -void -op_resize::apply_cube_inplace(Cube& A, const uword new_n_rows, const uword new_n_cols, const uword new_n_slices) - { - arma_debug_sigprint(); - - if( (A.n_rows == new_n_rows) && (A.n_cols == new_n_cols) && (A.n_slices == new_n_slices) ) { return; } - - if(A.is_empty()) { A.zeros(new_n_rows, new_n_cols, new_n_slices); return; } - - Cube B; - - op_resize::apply_cube_noalias(B, A, new_n_rows, new_n_cols, new_n_slices); - - A.steal_mem(B); - } - - - -template -inline -void -op_resize::apply_cube_noalias(Cube& out, const Cube& A, const uword new_n_rows, const uword new_n_cols, const uword new_n_slices) - { - arma_debug_sigprint(); - - out.set_size(new_n_rows, new_n_cols, new_n_slices); - - if( (new_n_rows > A.n_rows) || (new_n_cols > A.n_cols) || (new_n_slices > A.n_slices) ) { out.zeros(); } - - if( (out.n_elem > 0) && (A.n_elem > 0) ) - { - const uword end_row = (std::min)(new_n_rows, A.n_rows) - 1; - const uword end_col = (std::min)(new_n_cols, A.n_cols) - 1; - const uword end_slice = (std::min)(new_n_slices, A.n_slices) - 1; - - out.subcube(0, 0, 0, end_row, end_col, end_slice) = A.subcube(0, 0, 0, end_row, end_col, end_slice); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_reverse_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_reverse_bones.hpp deleted file mode 100644 index 8ec621760..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_reverse_bones.hpp +++ /dev/null @@ -1,46 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_reverse -//! @{ - - - -class op_reverse - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& in); - }; - - - -class op_reverse_vec - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const Op& in); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_reverse_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_reverse_meat.hpp deleted file mode 100644 index 8bf7c5d25..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_reverse_meat.hpp +++ /dev/null @@ -1,128 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_reverse -//! @{ - - - -template -inline -void -op_reverse::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword dim = in.aux_uword_a; - - arma_conform_check( (dim > 1), "reverse(): parameter 'dim' must be 0 or 1" ); - - if(is_Mat::value) - { - // allow detection of in-place operation - - const unwrap U(in.m); - - if(dim == 0) { op_flipud::apply_direct(out, U.M); } - if(dim == 1) { op_fliplr::apply_direct(out, U.M); } - } - else - { - const Proxy P(in.m); - - if(P.is_alias(out)) - { - Mat tmp; - - if(dim == 0) { op_flipud::apply_proxy_noalias(tmp, P); } - if(dim == 1) { op_fliplr::apply_proxy_noalias(tmp, P); } - - out.steal_mem(tmp); - } - else - { - if(dim == 0) { op_flipud::apply_proxy_noalias(out, P); } - if(dim == 1) { op_fliplr::apply_proxy_noalias(out, P); } - } - } - } - - - -template -inline -void -op_reverse_vec::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(is_Mat::value) - { - // allow detection of in-place operation - - const unwrap U(in.m); - - if((T1::is_xvec) ? bool(U.M.is_rowvec()) : bool(T1::is_row)) - { - op_fliplr::apply_direct(out, U.M); - } - else - { - op_flipud::apply_direct(out, U.M); - } - } - else - { - const Proxy P(in.m); - - if(P.is_alias(out)) - { - Mat tmp; - - if((T1::is_xvec) ? bool(P.get_n_rows() == 1) : bool(T1::is_row)) - { - op_fliplr::apply_proxy_noalias(tmp, P); - } - else - { - op_flipud::apply_proxy_noalias(tmp, P); - } - - out.steal_mem(tmp); - } - else - { - if((T1::is_xvec) ? bool(P.get_n_rows() == 1) : bool(T1::is_row)) - { - op_fliplr::apply_proxy_noalias(out, P); - } - else - { - op_flipud::apply_proxy_noalias(out, P); - } - } - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_roots_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_roots_bones.hpp deleted file mode 100644 index 6007d198a..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_roots_bones.hpp +++ /dev/null @@ -1,41 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_roots -//! @{ - - - -class op_roots - : public traits_op_col - { - public: - - template - inline static void apply(Mat< std::complex >& out, const mtOp, T1, op_roots>& expr); - - template - inline static bool apply_direct(Mat< std::complex >& out, const Base& X); - - template - inline static bool apply_noalias(Mat< std::complex::result> >& out, const Mat& X); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_roots_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_roots_meat.hpp deleted file mode 100644 index 4aef9d003..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_roots_meat.hpp +++ /dev/null @@ -1,140 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_roots -//! @{ - - - -template -inline -void -op_roots::apply(Mat< std::complex >& out, const mtOp, T1, op_roots>& expr) - { - arma_debug_sigprint(); - - const bool status = op_roots::apply_direct(out, expr.m); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("roots(): eigen decomposition failed"); - } - } - - - -template -inline -bool -op_roots::apply_direct(Mat< std::complex >& out, const Base& X) - { - arma_debug_sigprint(); - - typedef std::complex out_eT; - - const quasi_unwrap U(X.get_ref()); - - bool status = false; - - if(U.is_alias(out)) - { - Mat tmp; - - status = op_roots::apply_noalias(tmp, U.M); - - out.steal_mem(tmp); - } - else - { - status = op_roots::apply_noalias(out, U.M); - } - - return status; - } - - - -template -inline -bool -op_roots::apply_noalias(Mat< std::complex::result> >& out, const Mat& X) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - typedef std::complex::result> out_eT; - - arma_conform_check( (X.is_vec() == false), "roots(): given object must be a vector" ); - - if(X.internal_has_nonfinite()) { return false; } - - // treat X as a column vector - - const Col Y( const_cast(X.memptr()), X.n_elem, false, false); - - const T Y_max = (Y.is_empty() == false) ? T(max(abs(Y))) : T(0); - - if(Y_max == T(0)) { out.set_size(1,0); return true; } - - const uvec indices = find( Y / Y_max ); - - const uword n_tail_zeros = (indices.n_elem > 0) ? uword( (Y.n_elem-1) - indices[indices.n_elem-1] ) : uword(0); - - const Col Z = Y.subvec( indices[0], indices[indices.n_elem-1] ); - - if(Z.n_elem >= uword(2)) - { - Mat tmp; - - if(Z.n_elem == uword(2)) - { - tmp.set_size(1,1); - - tmp[0] = -Z[1] / Z[0]; - } - else - { - tmp = diagmat(ones< Col >(Z.n_elem - 2), -1); - - tmp.row(0) = strans(-Z.subvec(1, Z.n_elem-1) / Z[0]); - } - - Mat junk; - - const bool status = auxlib::eig_gen(out, junk, false, tmp); - - if(status == false) { return false; } - - if(n_tail_zeros > 0) - { - out.resize(out.n_rows + n_tail_zeros, 1); - } - } - else - { - out.zeros(n_tail_zeros,1); - } - - return true; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_row_as_mat_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_row_as_mat_bones.hpp deleted file mode 100644 index a8430927b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_row_as_mat_bones.hpp +++ /dev/null @@ -1,33 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_row_as_mat -//! @{ - - -class op_row_as_mat - : public traits_op_default - { - public: - - template inline static void apply(Mat& out, const CubeToMatOp& expr); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_row_as_mat_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_row_as_mat_meat.hpp deleted file mode 100644 index c82d42fc1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_row_as_mat_meat.hpp +++ /dev/null @@ -1,63 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_row_as_mat -//! @{ - - - -template -inline -void -op_row_as_mat::apply(Mat& out, const CubeToMatOp& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_cube U(expr.m); - const Cube& A = U.M; - - const uword in_row = expr.aux_uword; - - arma_conform_check_bounds( (in_row >= A.n_rows), "Cube::row_as_mat(): index out of bounds" ); - - const uword A_n_cols = A.n_cols; - const uword A_n_rows = A.n_rows; - const uword A_n_slices = A.n_slices; - - out.set_size(A_n_slices, A_n_cols); - - for(uword s=0; s < A_n_slices; ++s) - { - const eT* A_mem = &(A.at(in_row, 0, s)); - eT* out_mem = &(out.at(s,0)); - - for(uword c=0; c < A_n_cols; ++c) - { - (*out_mem) = (*A_mem); - - A_mem += A_n_rows; - out_mem += A_n_slices; - } - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_shift_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_shift_bones.hpp deleted file mode 100644 index 74e490254..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_shift_bones.hpp +++ /dev/null @@ -1,45 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_shift -//! @{ - - - -class op_shift_vec - : public traits_op_passthru - { - public: - - template inline static void apply(Mat& out, const Op& in); - }; - - - -class op_shift - : public traits_op_default - { - public: - - template inline static void apply_noalias(Mat& out, const Mat& X, const uword len, const uword neg, const uword dim); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_shift_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_shift_meat.hpp deleted file mode 100644 index 00dc72772..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_shift_meat.hpp +++ /dev/null @@ -1,183 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_shift -//! @{ - - - -template -inline -void -op_shift_vec::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap U(in.m); - - const uword len = in.aux_uword_a; - const uword neg = in.aux_uword_b; - - const uword dim = (T1::is_xvec) ? uword(U.M.is_rowvec() ? 1 : 0) : uword((T1::is_row) ? 1 : 0); - - if(U.is_alias(out)) - { - Mat tmp; - - op_shift::apply_noalias(tmp, U.M, len, neg, dim); - - out.steal_mem(tmp); - } - else - { - op_shift::apply_noalias(out, U.M, len, neg, dim); - } - } - - - -template -inline -void -op_shift::apply_noalias(Mat& out, const Mat& X, const uword len, const uword neg, const uword dim) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( ((dim == 0) && (len >= X.n_rows)), "shift(): shift amount out of bounds" ); - arma_conform_check_bounds( ((dim == 1) && (len >= X.n_cols)), "shift(): shift amount out of bounds" ); - - if(len == 0) { out = X; return; } - - out.copy_size(X); - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(dim == 0) - { - if(neg == 0) - { - for(uword col=0; col < X_n_cols; ++col) - { - eT* out_ptr = out.colptr(col); - const eT* X_ptr = X.colptr(col); - - for(uword out_row=len, row=0; row < (X_n_rows - len); ++row, ++out_row) - { - out_ptr[out_row] = X_ptr[row]; - } - - for(uword out_row=0, row=(X_n_rows - len); row < X_n_rows; ++row, ++out_row) - { - out_ptr[out_row] = X_ptr[row]; - } - } - } - else - if(neg == 1) - { - for(uword col=0; col < X_n_cols; ++col) - { - eT* out_ptr = out.colptr(col); - const eT* X_ptr = X.colptr(col); - - for(uword out_row=0, row=len; row < X_n_rows; ++row, ++out_row) - { - out_ptr[out_row] = X_ptr[row]; - } - - for(uword out_row=(X_n_rows-len), row=0; row < len; ++row, ++out_row) - { - out_ptr[out_row] = X_ptr[row]; - } - } - } - } - else - if(dim == 1) - { - if(neg == 0) - { - if(X_n_rows == 1) - { - eT* out_ptr = out.memptr(); - const eT* X_ptr = X.memptr(); - - for(uword out_col=len, col=0; col < (X_n_cols - len); ++col, ++out_col) - { - out_ptr[out_col] = X_ptr[col]; - } - - for(uword out_col=0, col=(X_n_cols - len); col < X_n_cols; ++col, ++out_col) - { - out_ptr[out_col] = X_ptr[col]; - } - } - else - { - for(uword out_col=len, col=0; col < (X_n_cols - len); ++col, ++out_col) - { - arrayops::copy( out.colptr(out_col), X.colptr(col), X_n_rows ); - } - - for(uword out_col=0, col=(X_n_cols - len); col < X_n_cols; ++col, ++out_col) - { - arrayops::copy( out.colptr(out_col), X.colptr(col), X_n_rows ); - } - } - } - else - if(neg == 1) - { - if(X_n_rows == 1) - { - eT* out_ptr = out.memptr(); - const eT* X_ptr = X.memptr(); - - for(uword out_col=0, col=len; col < X_n_cols; ++col, ++out_col) - { - out_ptr[out_col] = X_ptr[col]; - } - - for(uword out_col=(X_n_cols-len), col=0; col < len; ++col, ++out_col) - { - out_ptr[out_col] = X_ptr[col]; - } - } - else - { - for(uword out_col=0, col=len; col < X_n_cols; ++col, ++out_col) - { - arrayops::copy( out.colptr(out_col), X.colptr(col), X_n_rows ); - } - - for(uword out_col=(X_n_cols-len), col=0; col < len; ++col, ++out_col) - { - arrayops::copy( out.colptr(out_col), X.colptr(col), X_n_rows ); - } - } - } - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_shuffle_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_shuffle_bones.hpp deleted file mode 100644 index 8150d1309..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_shuffle_bones.hpp +++ /dev/null @@ -1,47 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_shuffle -//! @{ - - - -class op_shuffle - : public traits_op_default - { - public: - - template inline static void apply_direct(Mat& out, const Mat& X, const uword dim); - - template inline static void apply(Mat& out, const Op& in); - }; - - - -class op_shuffle_vec - : public traits_op_passthru - { - public: - - template inline static void apply(Mat& out, const Op& in); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_shuffle_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_shuffle_meat.hpp deleted file mode 100644 index d1228ad53..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_shuffle_meat.hpp +++ /dev/null @@ -1,234 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_shuffle -//! @{ - - - -template -inline -void -op_shuffle::apply_direct(Mat& out, const Mat& X, const uword dim) - { - arma_debug_sigprint(); - - if(X.is_empty()) { out.copy_size(X); return; } - - const uword N = (dim == 0) ? X.n_rows : X.n_cols; - - // see op_sort_index_bones.hpp for the definition of arma_sort_index_packet - // and the associated comparison functor - - typedef arma_sort_index_packet packet; - - std::vector packet_vec(N); - - for(uword i=0; i()); - packet_vec[i].index = i; - } - - arma_sort_index_helper_ascend comparator; - - std::sort( packet_vec.begin(), packet_vec.end(), comparator ); - - const bool is_alias = (&out == &X); - - if(X.is_vec() == false) - { - if(is_alias == false) - { - arma_debug_print("op_shuffle::apply(): matrix"); - - out.copy_size(X); - - if(dim == 0) - { - for(uword i=0; i 1) // ie. column vector - { - for(uword i=0; i 1) // ie. row vector - { - for(uword i=0; i 1) // ie. column vector - { - for(uword i=0; i 1) // ie. row vector - { - for(uword i=0; i -inline -void -op_shuffle::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - const unwrap U(in.m); - - const uword dim = in.aux_uword_a; - - arma_conform_check( (dim > 1), "shuffle(): parameter 'dim' must be 0 or 1" ); - - op_shuffle::apply_direct(out, U.M, dim); - } - - - -template -inline -void -op_shuffle_vec::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - const unwrap U(in.m); - - const uword dim = (T1::is_xvec) ? uword(U.M.is_rowvec() ? 1 : 0) : uword((T1::is_row) ? 1 : 0); - - op_shuffle::apply_direct(out, U.M, dim); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sort_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sort_bones.hpp deleted file mode 100644 index 37449fe91..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sort_bones.hpp +++ /dev/null @@ -1,61 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sort -//! @{ - - - -class op_sort - : public traits_op_default - { - public: - - template - inline static void copy_row(eT* X, const Mat& A, const uword row); - - template - inline static void copy_row(Mat& A, const eT* X, const uword row); - - template - inline static void direct_sort(eT* X, const uword N, const uword sort_type = 0); - - template - inline static void direct_sort_ascending(eT* X, const uword N); - - template - inline static void apply_noalias(Mat& out, const Mat& X, const uword sort_type, const uword dim); - - template - inline static void apply(Mat& out, const Op& in); - }; - - - -class op_sort_vec - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const Op& in); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sort_index_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sort_index_bones.hpp deleted file mode 100644 index 7229ed5b5..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sort_index_bones.hpp +++ /dev/null @@ -1,137 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sort_index -//! @{ - - - -class op_sort_index - : public traits_op_col - { - public: - - template - static inline bool apply_noalias(Mat& out, const Proxy& P, const uword sort_type); - - template - static inline void apply(Mat& out, const mtOp& in); - }; - - - -class op_stable_sort_index - : public traits_op_col - { - public: - - template - static inline bool apply_noalias(Mat& out, const Proxy& P, const uword sort_type); - - template - static inline void apply(Mat& out, const mtOp& in); - }; - - - -template -struct arma_sort_index_packet - { - eT val; - uword index; - }; - - - -template -struct arma_sort_index_helper_ascend - { - arma_inline - bool - operator() (const arma_sort_index_packet& A, const arma_sort_index_packet& B) const - { - return (A.val < B.val); - } - }; - - - -template -struct arma_sort_index_helper_descend - { - arma_inline - bool - operator() (const arma_sort_index_packet& A, const arma_sort_index_packet& B) const - { - return (A.val > B.val); - } - }; - - - -template -struct arma_sort_index_helper_ascend< std::complex > - { - typedef typename std::complex eT; - - inline - bool - operator() (const arma_sort_index_packet& A, const arma_sort_index_packet& B) const - { - return (std::abs(A.val) < std::abs(B.val)); - } - - // inline - // bool - // operator() (const arma_sort_index_packet& A, const arma_sort_index_packet& B) const - // { - // const T abs_A_val = std::abs(A.val); - // const T abs_B_val = std::abs(B.val); - // - // return ( (abs_A_val != abs_B_val) ? (abs_A_val < abs_B_val) : (std::arg(A.val) < std::arg(B.val)) ); - // } - }; - - - -template -struct arma_sort_index_helper_descend< std::complex > - { - typedef typename std::complex eT; - - inline - bool - operator() (const arma_sort_index_packet& A, const arma_sort_index_packet& B) const - { - return (std::abs(A.val) > std::abs(B.val)); - } - - // inline - // bool - // operator() (const arma_sort_index_packet& A, const arma_sort_index_packet& B) const - // { - // const T abs_A_val = std::abs(A.val); - // const T abs_B_val = std::abs(B.val); - // - // return ( (abs_A_val != abs_B_val) ? (abs_A_val > abs_B_val) : (std::arg(A.val) > std::arg(B.val)) ); - // } - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sort_index_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sort_index_meat.hpp deleted file mode 100644 index 1d02be7f4..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sort_index_meat.hpp +++ /dev/null @@ -1,206 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sort_index -//! @{ - - - -template -inline -bool -arma_sort_index_helper(Mat& out, const Proxy& P, const uword sort_type) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_elem = P.get_n_elem(); - - out.set_size(n_elem, 1); - - std::vector< arma_sort_index_packet > packet_vec(n_elem); - - if(Proxy::use_at == false) - { - for(uword i=0; i comparator; - - if(sort_stable == false) - { - std::sort( packet_vec.begin(), packet_vec.end(), comparator ); - } - else - { - std::stable_sort( packet_vec.begin(), packet_vec.end(), comparator ); - } - } - else - { - // descend - - arma_sort_index_helper_descend comparator; - - if(sort_stable == false) - { - std::sort( packet_vec.begin(), packet_vec.end(), comparator ); - } - else - { - std::stable_sort( packet_vec.begin(), packet_vec.end(), comparator ); - } - } - - uword* out_mem = out.memptr(); - - for(uword i=0; i -inline -bool -op_sort_index::apply_noalias(Mat& out, const Proxy& P, const uword sort_type) - { - arma_debug_sigprint(); - - return arma_sort_index_helper(out, P, sort_type); - } - - - -template -inline -void -op_sort_index::apply(Mat& out, const mtOp& in) - { - arma_debug_sigprint(); - - const Proxy P(in.m); - - if(P.get_n_elem() == 0) { out.set_size(0,1); return; } - - const uword sort_type = in.aux_uword_a; - - bool all_non_nan = false; - - if(P.is_alias(out)) - { - Mat out2; - - all_non_nan = op_sort_index::apply_noalias(out2, P, sort_type); - - out.steal_mem(out2); - } - else - { - all_non_nan = op_sort_index::apply_noalias(out, P, sort_type); - } - - arma_conform_check( (all_non_nan == false), "sort_index(): detected NaN" ); - } - - - -template -inline -bool -op_stable_sort_index::apply_noalias(Mat& out, const Proxy& P, const uword sort_type) - { - arma_debug_sigprint(); - - return arma_sort_index_helper(out, P, sort_type); - } - - - -template -inline -void -op_stable_sort_index::apply(Mat& out, const mtOp& in) - { - arma_debug_sigprint(); - - const Proxy P(in.m); - - if(P.get_n_elem() == 0) { out.set_size(0,1); return; } - - const uword sort_type = in.aux_uword_a; - - bool all_non_nan = false; - - if(P.is_alias(out)) - { - Mat out2; - - all_non_nan = op_stable_sort_index::apply_noalias(out2, P, sort_type); - - out.steal_mem(out2); - } - else - { - all_non_nan = op_stable_sort_index::apply_noalias(out, P, sort_type); - } - - arma_conform_check( (all_non_nan == false), "stable_sort_index(): detected NaN" ); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sort_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sort_meat.hpp deleted file mode 100644 index 2e83055f8..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sort_meat.hpp +++ /dev/null @@ -1,242 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sort -//! @{ - - - -template -inline -void -op_sort::direct_sort(eT* X, const uword n_elem, const uword sort_type) - { - arma_debug_sigprint(); - - if(sort_type == 0) - { - arma_lt_comparator comparator; - - std::sort(&X[0], &X[n_elem], comparator); - } - else - { - arma_gt_comparator comparator; - - std::sort(&X[0], &X[n_elem], comparator); - } - } - - - -template -inline -void -op_sort::direct_sort_ascending(eT* X, const uword n_elem) - { - arma_debug_sigprint(); - - arma_lt_comparator comparator; - - std::sort(&X[0], &X[n_elem], comparator); - } - - - -template -inline -void -op_sort::copy_row(eT* X, const Mat& A, const uword row) - { - const uword N = A.n_cols; - - uword i,j; - - for(i=0, j=1; j -inline -void -op_sort::copy_row(Mat& A, const eT* X, const uword row) - { - const uword N = A.n_cols; - - uword i,j; - - for(i=0, j=1; j -inline -void -op_sort::apply_noalias(Mat& out, const Mat& X, const uword sort_type, const uword dim) - { - arma_debug_sigprint(); - - if((X.n_rows * X.n_cols) <= 1) { out = X; return; } - - if(dim == 0) // sort the contents of each column - { - arma_debug_print("op_sort::apply(): dim = 0"); - - out = X; - - const uword n_rows = out.n_rows; - const uword n_cols = out.n_cols; - - for(uword col=0; col < n_cols; ++col) - { - op_sort::direct_sort( out.colptr(col), n_rows, sort_type ); - } - } - else - if(dim == 1) // sort the contents of each row - { - if(X.n_rows == 1) // a row vector - { - arma_debug_print("op_sort::apply(): dim = 1, vector specific"); - - out = X; - op_sort::direct_sort(out.memptr(), out.n_elem, sort_type); - } - else // not a row vector - { - arma_debug_print("op_sort::apply(): dim = 1, generic"); - - out.copy_size(X); - - const uword n_rows = out.n_rows; - const uword n_cols = out.n_cols; - - podarray tmp_array(n_cols); - - for(uword row=0; row < n_rows; ++row) - { - op_sort::copy_row(tmp_array.memptr(), X, row); - - op_sort::direct_sort( tmp_array.memptr(), n_cols, sort_type ); - - op_sort::copy_row(out, tmp_array.memptr(), row); - } - } - } - } - - - -template -inline -void -op_sort::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap U(in.m); - const Mat& X = U.M; - - const uword sort_type = in.aux_uword_a; - const uword dim = in.aux_uword_b; - - arma_conform_check( (sort_type > 1), "sort(): parameter 'sort_type' must be 0 or 1" ); - arma_conform_check( (dim > 1), "sort(): parameter 'dim' must be 0 or 1" ); - arma_conform_check( (X.internal_has_nan()), "sort(): detected NaN" ); - - if(U.is_alias(out)) - { - Mat tmp; - - op_sort::apply_noalias(tmp, X, sort_type, dim); - - out.steal_mem(tmp); - } - else - { - op_sort::apply_noalias(out, X, sort_type, dim); - } - } - - - -template -inline -void -op_sort_vec::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap U(in.m); // not using quasi_unwrap, to ensure there is no aliasing with subviews - const Mat& X = U.M; - - const uword sort_type = in.aux_uword_a; - - arma_conform_check( (sort_type > 1), "sort(): parameter 'sort_type' must be 0 or 1" ); - arma_conform_check( (X.internal_has_nan()), "sort(): detected NaN" ); - - out = X; // not checking for aliasing, to allow inplace sorting of vectors - - if(out.n_elem <= 1) { return; } - - eT* out_mem = out.memptr(); - - eT* start_ptr = out_mem; - eT* endp1_ptr = &out_mem[out.n_elem]; - - if(sort_type == 0) - { - arma_lt_comparator comparator; - - std::sort(start_ptr, endp1_ptr, comparator); - } - else - { - arma_gt_comparator comparator; - - std::sort(start_ptr, endp1_ptr, comparator); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_as_dense_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_as_dense_bones.hpp deleted file mode 100644 index 2b59236ec..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_as_dense_bones.hpp +++ /dev/null @@ -1,33 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sp_as_dense -//! @{ - - -class op_sp_as_dense - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const SpToDOp& expr); - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_as_dense_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_as_dense_meat.hpp deleted file mode 100644 index 6b10ab988..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_as_dense_meat.hpp +++ /dev/null @@ -1,36 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sp_as_dense -//! @{ - - - -template -inline -void -op_sp_as_dense::apply(Mat& out, const SpToDOp& expr) - { - arma_debug_sigprint(); - - out = expr.m; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_diagvec_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_diagvec_bones.hpp deleted file mode 100644 index f5b6ad470..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_diagvec_bones.hpp +++ /dev/null @@ -1,35 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sp_diagvec -//! @{ - - - -class op_sp_diagvec - : public traits_op_col - { - public: - - template - inline static void apply(Mat& out, const mtSpReduceOp& in); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_diagvec_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_diagvec_meat.hpp deleted file mode 100644 index a332f8524..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_diagvec_meat.hpp +++ /dev/null @@ -1,62 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sp_diagvec -//! @{ - - - -template -inline -void -op_sp_diagvec::apply(Mat& out, const mtSpReduceOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat U(in.m); - const SpMat& X = U.M; - - const uword a = in.aux_uword_a; - const uword b = in.aux_uword_b; - - const uword row_offset = (b > 0) ? a : 0; - const uword col_offset = (b == 0) ? a : 0; - - arma_conform_check_bounds - ( - ((row_offset > 0) && (row_offset >= X.n_rows)) || ((col_offset > 0) && (col_offset >= X.n_cols)), - "diagvec(): requested diagonal out of bounds" - ); - - const uword len = (std::min)(X.n_rows - row_offset, X.n_cols - col_offset); - - out.set_size(len, 1); - - eT* out_mem = out.memptr(); - - for(uword i=0; i < len; ++i) - { - out_mem[i] = X.at(i + row_offset, i + col_offset); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_max_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_max_bones.hpp deleted file mode 100644 index 1268a6795..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_max_bones.hpp +++ /dev/null @@ -1,60 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sp_max -//! @{ - -class op_sp_max - : public traits_op_xvec - { - public: - - template - inline static void apply(Mat& out, const mtSpReduceOp& in); - - // - - template - inline static void apply_proxy(Mat& out, const SpProxy& p, const uword dim, const typename arma_not_cx::result* junk = nullptr); - - template - inline static typename T1::elem_type vector_max(const T1& X, const typename arma_not_cx::result* junk = nullptr); - - template - inline static typename arma_not_cx::result max(const SpBase& X); - - template - inline static typename arma_not_cx::result max_with_index(const SpProxy& P, uword& index_of_max_val); - - // - - template - inline static void apply_proxy(Mat& out, const SpProxy& p, const uword dim, const typename arma_cx_only::result* junk = nullptr); - - template - inline static typename T1::elem_type vector_max(const T1& X, const typename arma_cx_only::result* junk = nullptr); - - template - inline static typename arma_cx_only::result max(const SpBase& X); - - template - inline static typename arma_cx_only::result max_with_index(const SpProxy& P, uword& index_of_max_val); - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_max_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_max_meat.hpp deleted file mode 100644 index b86bf280b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_max_meat.hpp +++ /dev/null @@ -1,683 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sp_max -//! @{ - - - -template -inline -void -op_sp_max::apply(Mat& out, const mtSpReduceOp& in) - { - arma_debug_sigprint(); - - const uword dim = in.aux_uword_a; - - arma_conform_check( (dim > 1), "max(): parameter 'dim' must be 0 or 1" ); - - const SpProxy p(in.m); - - const uword p_n_rows = p.get_n_rows(); - const uword p_n_cols = p.get_n_cols(); - - if( (p_n_rows == 0) || (p_n_cols == 0) || (p.get_n_nonzero() == 0) ) - { - if(dim == 0) { out.zeros((p_n_rows > 0) ? 1 : 0, p_n_cols); } - if(dim == 1) { out.zeros(p_n_rows, (p_n_cols > 0) ? 1 : 0); } - - return; - } - - op_sp_max::apply_proxy(out, p, dim); - } - - - -template -inline -void -op_sp_max::apply_proxy - ( - Mat& out, - const SpProxy& p, - const uword dim, - const typename arma_not_cx::result* junk - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - - typename SpProxy::const_iterator_type it = p.begin(); - typename SpProxy::const_iterator_type it_end = p.end(); - - const uword p_n_cols = p.get_n_cols(); - const uword p_n_rows = p.get_n_rows(); - - if(dim == 0) // find the maximum in each column - { - out.zeros(1, p_n_cols); - - urowvec count(p_n_cols, arma_zeros_indicator()); - - while(it != it_end) - { - const uword col = it.col(); - - out[col] = (count[col] == 0) ? (*it) : (std::max)(out[col], (*it)); - count[col]++; - ++it; - } - - for(uword col=0; col -inline -typename T1::elem_type -op_sp_max::vector_max - ( - const T1& x, - const typename arma_not_cx::result* junk - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - - const SpProxy p(x); - - if(p.get_n_elem() == 0) - { - arma_conform_check(true, "max(): object has no elements"); - - return Datum::nan; - } - - if(p.get_n_nonzero() == 0) { return eT(0); } - - if(SpProxy::use_iterator == false) - { - // direct access of values - if(p.get_n_nonzero() == p.get_n_elem()) - { - return op_max::direct_max(p.get_values(), p.get_n_nonzero()); - } - else - { - return (std::max)(eT(0), op_max::direct_max(p.get_values(), p.get_n_nonzero())); - } - } - else - { - // use iterator - typename SpProxy::const_iterator_type it = p.begin(); - typename SpProxy::const_iterator_type it_end = p.end(); - - eT result = (*it); - ++it; - - while(it != it_end) - { - if((*it) > result) { result = (*it); } - - ++it; - } - - if(p.get_n_nonzero() == p.get_n_elem()) - { - return result; - } - else - { - return (std::max)(eT(0), result); - } - } - } - - - -template -inline -typename arma_not_cx::result -op_sp_max::max(const SpBase& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const SpProxy P(X.get_ref()); - - const uword n_elem = P.get_n_elem(); - const uword n_nonzero = P.get_n_nonzero(); - - if(n_elem == 0) - { - arma_conform_check(true, "max(): object has no elements"); - - return Datum::nan; - } - - eT max_val = priv::most_neg(); - - if(SpProxy::use_iterator) - { - // We have to iterate over the elements. - typedef typename SpProxy::const_iterator_type it_type; - - it_type it = P.begin(); - it_type it_end = P.end(); - - while(it != it_end) - { - if((*it) > max_val) { max_val = *it; } - - ++it; - } - } - else - { - // We can do direct access of the values, row_indices, and col_ptrs. - // We don't need the location of the max value, so we can just call out to - // other functions... - max_val = op_max::direct_max(P.get_values(), n_nonzero); - } - - if(n_elem == n_nonzero) - { - return max_val; - } - else - { - return (std::max)(eT(0), max_val); - } - } - - - -template -inline -typename arma_not_cx::result -op_sp_max::max_with_index(const SpProxy& P, uword& index_of_max_val) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_elem = P.get_n_elem(); - const uword n_nonzero = P.get_n_nonzero(); - const uword n_rows = P.get_n_rows(); - - if(n_elem == 0) - { - arma_conform_check(true, "max(): object has no elements"); - - index_of_max_val = uword(0); - - return Datum::nan; - } - - eT max_val = priv::most_neg(); - - if(SpProxy::use_iterator) - { - // We have to iterate over the elements. - typedef typename SpProxy::const_iterator_type it_type; - - it_type it = P.begin(); - it_type it_end = P.end(); - - while(it != it_end) - { - if((*it) > max_val) - { - max_val = *it; - index_of_max_val = it.row() + it.col() * n_rows; - } - - ++it; - } - } - else - { - // We can do direct access. - max_val = op_max::direct_max(P.get_values(), n_nonzero, index_of_max_val); - - // Convert to actual position in matrix. - const uword row = P.get_row_indices()[index_of_max_val]; - uword col = 0; - while(P.get_col_ptrs()[++col] <= index_of_max_val) { } - index_of_max_val = (col - 1) * n_rows + row; - } - - - if(n_elem != n_nonzero) - { - max_val = (std::max)(eT(0), max_val); - - // If the max_val is a nonzero element, we need its actual position in the matrix. - if(max_val == eT(0)) - { - // Find first zero element. - uword last_row = 0; - uword last_col = 0; - - typedef typename SpProxy::const_iterator_type it_type; - - it_type it = P.begin(); - it_type it_end = P.end(); - - while(it != it_end) - { - // Have we moved more than one position from the last place? - if((it.col() == last_col) && (it.row() - last_row > 1)) - { - index_of_max_val = it.col() * n_rows + last_row + 1; - break; - } - else if((it.col() >= last_col + 1) && (last_row < n_rows - 1)) - { - index_of_max_val = last_col * n_rows + last_row + 1; - break; - } - else if((it.col() == last_col + 1) && (it.row() > 0)) - { - index_of_max_val = it.col() * n_rows; - break; - } - else if(it.col() > last_col + 1) - { - index_of_max_val = (last_col + 1) * n_rows; - break; - } - - last_row = it.row(); - last_col = it.col(); - ++it; - } - } - } - - return max_val; - } - - - -template -inline -void -op_sp_max::apply_proxy - ( - Mat& out, - const SpProxy& p, - const uword dim, - const typename arma_cx_only::result* junk - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - typename SpProxy::const_iterator_type it = p.begin(); - typename SpProxy::const_iterator_type it_end = p.end(); - - const uword p_n_cols = p.get_n_cols(); - const uword p_n_rows = p.get_n_rows(); - - if(dim == 0) // find the maximum in each column - { - out.zeros(1, p_n_cols); - - Row absval(p_n_cols, arma_zeros_indicator()); - - while(it != it_end) - { - const uword col = it.col(); - - const eT& v = (*it); - const T a = std::abs(v); - - if(a > absval[col]) - { - absval[col] = a; - out[col] = v; - } - - ++it; - } - } - else - if(dim == 1) // find the maximum in each row - { - out.zeros(p_n_rows, 1); - - Col absval(p_n_rows, arma_zeros_indicator()); - - while(it != it_end) - { - const uword row = it.row(); - - const eT& v = (*it); - const T a = std::abs(v); - - if(a > absval[row]) - { - absval[row] = a; - out[row] = v; - } - - ++it; - } - } - } - - - -template -inline -typename T1::elem_type -op_sp_max::vector_max - ( - const T1& x, - const typename arma_cx_only::result* junk - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - const SpProxy p(x); - - if(p.get_n_elem() == 0) - { - arma_conform_check(true, "max(): object has no elements"); - - return Datum::nan; - } - - if(p.get_n_nonzero() == 0) { return eT(0); } - - if(SpProxy::use_iterator == false) - { - // direct access of values - if(p.get_n_nonzero() == p.get_n_elem()) - { - return op_max::direct_max(p.get_values(), p.get_n_nonzero()); - } - else - { - const eT val1 = eT(0); - const eT val2 = op_max::direct_max(p.get_values(), p.get_n_nonzero()); - - return ( std::abs(val1) >= std::abs(val2) ) ? val1 : val2; - } - } - else - { - // use iterator - typename SpProxy::const_iterator_type it = p.begin(); - typename SpProxy::const_iterator_type it_end = p.end(); - - eT best_val_orig = *it; - T best_val_abs = std::abs(best_val_orig); - - ++it; - - while(it != it_end) - { - eT val_orig = *it; - T val_abs = std::abs(val_orig); - - if(val_abs > best_val_abs) - { - best_val_abs = val_abs; - best_val_orig = val_orig; - } - - ++it; - } - - if(p.get_n_nonzero() == p.get_n_elem()) - { - return best_val_orig; - } - else - { - const eT val1 = eT(0); - - return ( std::abs(val1) >= best_val_abs ) ? val1 : best_val_orig; - } - } - } - - - -template -inline -typename arma_cx_only::result -op_sp_max::max(const SpBase& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - const SpProxy P(X.get_ref()); - - const uword n_elem = P.get_n_elem(); - const uword n_nonzero = P.get_n_nonzero(); - - if(n_elem == 0) - { - arma_conform_check(true, "max(): object has no elements"); - - return Datum::nan; - } - - T max_val = priv::most_neg(); - eT ret_val; - - if(SpProxy::use_iterator) - { - // We have to iterate over the elements. - typedef typename SpProxy::const_iterator_type it_type; - - it_type it = P.begin(); - it_type it_end = P.end(); - - while(it != it_end) - { - const T tmp_val = std::abs(*it); - - if(tmp_val > max_val) - { - max_val = tmp_val; - ret_val = *it; - } - - ++it; - } - } - else - { - // We can do direct access of the values, row_indices, and col_ptrs. - // We don't need the location of the max value, so we can just call out to - // other functions... - ret_val = op_max::direct_max(P.get_values(), n_nonzero); - max_val = std::abs(ret_val); - } - - if(n_elem == n_nonzero) - { - return max_val; - } - else - { - return (T(0) > max_val) ? eT(0) : ret_val; - } - } - - - -template -inline -typename arma_cx_only::result -op_sp_max::max_with_index(const SpProxy& P, uword& index_of_max_val) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - const uword n_elem = P.get_n_elem(); - const uword n_nonzero = P.get_n_nonzero(); - const uword n_rows = P.get_n_rows(); - - if(n_elem == 0) - { - arma_conform_check(true, "max(): object has no elements"); - - index_of_max_val = uword(0); - - return Datum::nan; - } - - T max_val = priv::most_neg(); - - if(SpProxy::use_iterator) - { - // We have to iterate over the elements. - typedef typename SpProxy::const_iterator_type it_type; - - it_type it = P.begin(); - it_type it_end = P.end(); - - while(it != it_end) - { - const T tmp_val = std::abs(*it); - - if(tmp_val > max_val) - { - max_val = tmp_val; - index_of_max_val = it.row() + it.col() * n_rows; - } - - ++it; - } - } - else - { - // We can do direct access. - max_val = std::abs(op_max::direct_max(P.get_values(), n_nonzero, index_of_max_val)); - - // Convert to actual position in matrix. - const uword row = P.get_row_indices()[index_of_max_val]; - uword col = 0; - while(P.get_col_ptrs()[++col] <= index_of_max_val) { } - index_of_max_val = (col - 1) * n_rows + row; - } - - - if(n_elem != n_nonzero) - { - max_val = (std::max)(T(0), max_val); - - // If the max_val is a nonzero element, we need its actual position in the matrix. - if(max_val == T(0)) - { - // Find first zero element. - uword last_row = 0; - uword last_col = 0; - - typedef typename SpProxy::const_iterator_type it_type; - - it_type it = P.begin(); - it_type it_end = P.end(); - - while(it != it_end) - { - // Have we moved more than one position from the last place? - if((it.col() == last_col) && (it.row() - last_row > 1)) - { - index_of_max_val = it.col() * n_rows + last_row + 1; - break; - } - else if((it.col() >= last_col + 1) && (last_row < n_rows - 1)) - { - index_of_max_val = last_col * n_rows + last_row + 1; - break; - } - else if((it.col() == last_col + 1) && (it.row() > 0)) - { - index_of_max_val = it.col() * n_rows; - break; - } - else if(it.col() > last_col + 1) - { - index_of_max_val = (last_col + 1) * n_rows; - break; - } - - last_row = it.row(); - last_col = it.col(); - ++it; - } - } - } - - return P[index_of_max_val]; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_mean_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_mean_bones.hpp deleted file mode 100644 index 66358149d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_mean_bones.hpp +++ /dev/null @@ -1,62 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sp_mean -//! @{ - - -//! Class for finding mean values of a sparse matrix -class op_sp_mean - : public traits_op_xvec - { - public: - - // Apply mean into an output sparse matrix (or vector). - template - inline static void apply(Mat& out, const mtSpReduceOp& in); - - template - inline static void apply_fast(Mat& out, const SpProxy& p, const uword dim); - - template - inline static void apply_slow(Mat& out, const SpProxy& p, const uword dim); - - // Take direct mean of a set of values. Length of array and number of values can be different. - template - inline static eT direct_mean(const eT* const X, const uword length, const uword N); - - template - inline static eT direct_mean_robust(const eT* const X, const uword length, const uword N); - - template - inline static typename T1::elem_type mean_all(const SpBase& X); - - template - inline static typename T1::elem_type mean_all(const SpOp& expr); - - // Take the mean using an iterator. - template - inline static eT iterator_mean(T1& it, const T1& end, const uword n_zero, const eT junk); - - template - inline static eT iterator_mean_robust(T1& it, const T1& end, const uword n_zero, const eT junk); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_mean_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_mean_meat.hpp deleted file mode 100644 index eb4b5acc1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_mean_meat.hpp +++ /dev/null @@ -1,371 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sp_mean -//! @{ - - - -template -inline -void -op_sp_mean::apply(Mat& out, const mtSpReduceOp& in) - { - arma_debug_sigprint(); - - const uword dim = in.aux_uword_a; - arma_conform_check( (dim > 1), "mean(): parameter 'dim' must be 0 or 1" ); - - const SpProxy p(in.m); - - const uword p_n_rows = p.get_n_rows(); - const uword p_n_cols = p.get_n_cols(); - - if( (p_n_rows == 0) || (p_n_cols == 0) || (p.get_n_nonzero() == 0) ) - { - if(dim == 0) { out.zeros((p_n_rows > 0) ? 1 : 0, p_n_cols); } - if(dim == 1) { out.zeros(p_n_rows, (p_n_cols > 0) ? 1 : 0); } - - return; - } - - op_sp_mean::apply_fast(out, p, dim); - } - - - -template -inline -void -op_sp_mean::apply_fast - ( - Mat& out, - const SpProxy& p, - const uword dim - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const uword p_n_rows = p.get_n_rows(); - const uword p_n_cols = p.get_n_cols(); - - if(dim == 0) // find the mean in each column - { - arma_debug_print("op_sp_mean::apply_fast(): dim = 0"); - - out.zeros(1, p_n_cols); - - eT* out_mem = out.memptr(); - - if(SpProxy::use_iterator) - { - typename SpProxy::const_iterator_type it = p.begin(); - - const uword N = p.get_n_nonzero(); - - for(uword i=0; i < N; ++i) { out_mem[it.col()] += (*it); ++it; } - - out /= T(p_n_rows); - } - else - { - for(uword col = 0; col < p_n_cols; ++col) - { - out_mem[col] = arrayops::accumulate - ( - &p.get_values()[p.get_col_ptrs()[col]], - p.get_col_ptrs()[col + 1] - p.get_col_ptrs()[col] - ) / T(p_n_rows); - } - } - } - else - if(dim == 1) // find the mean in each row - { - arma_debug_print("op_sp_mean::apply_fast(): dim = 1"); - - out.zeros(p_n_rows, 1); - - eT* out_mem = out.memptr(); - - typename SpProxy::const_iterator_type it = p.begin(); - - const uword N = p.get_n_nonzero(); - - for(uword i=0; i < N; ++i) { out_mem[it.row()] += (*it); ++it; } - - out /= T(p_n_cols); - } - - if(out.internal_has_nonfinite()) - { - op_sp_mean::apply_slow(out, p, dim); - } - } - - - -template -inline -void -op_sp_mean::apply_slow - ( - Mat& out, - const SpProxy& p, - const uword dim - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword p_n_rows = p.get_n_rows(); - const uword p_n_cols = p.get_n_cols(); - - if(dim == 0) // find the mean in each column - { - arma_debug_print("op_sp_mean::apply_slow(): dim = 0"); - - out.zeros(1, p_n_cols); - - for(uword col = 0; col < p_n_cols; ++col) - { - // Do we have to use an iterator or can we use memory directly? - if(SpProxy::use_iterator) - { - typename SpProxy::const_iterator_type it = p.begin_col(col); - typename SpProxy::const_iterator_type end = p.begin_col(col + 1); - - const uword n_zero = p_n_rows - (end.pos() - it.pos()); - - out.at(0,col) = op_sp_mean::iterator_mean(it, end, n_zero, eT(0)); - } - else - { - out.at(0,col) = op_sp_mean::direct_mean - ( - &p.get_values()[p.get_col_ptrs()[col]], - p.get_col_ptrs()[col + 1] - p.get_col_ptrs()[col], - p_n_rows - ); - } - } - } - else - if(dim == 1) // find the mean in each row - { - arma_debug_print("op_sp_mean::apply_slow(): dim = 1"); - - out.zeros(p_n_rows, 1); - - for(uword row = 0; row < p_n_rows; ++row) - { - // We must use an iterator regardless of how it is stored. - typename SpProxy::const_row_iterator_type it = p.begin_row(row); - typename SpProxy::const_row_iterator_type end = p.end_row(row); - - const uword n_zero = p_n_cols - (end.pos() - it.pos()); - - out.at(row,0) = op_sp_mean::iterator_mean(it, end, n_zero, eT(0)); - } - } - } - - - -template -inline -eT -op_sp_mean::direct_mean - ( - const eT* const X, - const uword length, - const uword N - ) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - const eT result = ((length > 0) && (N > 0)) ? eT(arrayops::accumulate(X, length) / T(N)) : eT(0); - - return arma_isfinite(result) ? result : op_sp_mean::direct_mean_robust(X, length, N); - } - - - -template -inline -eT -op_sp_mean::direct_mean_robust - ( - const eT* const X, - const uword length, - const uword N - ) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - uword i, j; - - eT r_mean = eT(0); - - const uword diff = (N - length); // number of zeros - - for(i = 0, j = 1; j < length; i += 2, j += 2) - { - const eT Xi = X[i]; - const eT Xj = X[j]; - - r_mean += (Xi - r_mean) / T(diff + j); - r_mean += (Xj - r_mean) / T(diff + j + 1); - } - - if(i < length) - { - const eT Xi = X[i]; - - r_mean += (Xi - r_mean) / T(diff + i + 1); - } - - return r_mean; - } - - - -template -inline -typename T1::elem_type -op_sp_mean::mean_all(const SpBase& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - SpProxy p(X.get_ref()); - - if(p.get_n_elem() == 0) - { - arma_conform_check(true, "mean(): object has no elements"); - - return Datum::nan; - } - - if(SpProxy::use_iterator) - { - typename SpProxy::const_iterator_type it = p.begin(); - typename SpProxy::const_iterator_type end = p.end(); - - return op_sp_mean::iterator_mean(it, end, p.get_n_elem() - p.get_n_nonzero(), typename T1::elem_type(0)); - } - else // use_iterator == false; that is, we can directly access the values array - { - return op_sp_mean::direct_mean(p.get_values(), p.get_n_nonzero(), p.get_n_elem()); - } - } - - - -template -inline -typename T1::elem_type -op_sp_mean::mean_all(const SpOp& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - constexpr bool is_vectorise = \ - (is_same_type::yes) - || (is_same_type::yes) - || (is_same_type::yes); - - if(is_vectorise) - { - return op_sp_mean::mean_all(expr.m); - } - - const SpMat tmp = expr; - - return op_sp_mean::mean_all(tmp); - } - - - -template -inline -eT -op_sp_mean::iterator_mean(T1& it, const T1& end, const uword n_zero, const eT junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename get_pod_type::result T; - - eT acc = eT(0); - - T1 backup_it(it); // in case we have to use robust iterator_mean - - const uword it_begin_pos = it.pos(); - - while(it != end) - { - acc += (*it); - ++it; - } - - const uword count = n_zero + (it.pos() - it_begin_pos); - - const eT result = (count > 0) ? eT(acc / T(count)) : eT(0); - - return arma_isfinite(result) ? result : op_sp_mean::iterator_mean_robust(backup_it, end, n_zero, eT(0)); - } - - - -template -inline -eT -op_sp_mean::iterator_mean_robust(T1& it, const T1& end, const uword n_zero, const eT junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename get_pod_type::result T; - - eT r_mean = eT(0); - - const uword it_begin_pos = it.pos(); - - while(it != end) - { - r_mean += ((*it - r_mean) / T(n_zero + (it.pos() - it_begin_pos) + 1)); - ++it; - } - - return r_mean; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_min_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_min_bones.hpp deleted file mode 100644 index 5dda6e87e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_min_bones.hpp +++ /dev/null @@ -1,60 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sp_min -//! @{ - -class op_sp_min - : public traits_op_xvec - { - public: - - template - inline static void apply(Mat& out, const mtSpReduceOp& in); - - // - - template - inline static void apply_proxy(Mat& out, const SpProxy& p, const uword dim, const typename arma_not_cx::result* junk = nullptr); - - template - inline static typename T1::elem_type vector_min(const T1& X, const typename arma_not_cx::result* junk = nullptr); - - template - inline static typename arma_not_cx::result min(const SpBase& X); - - template - inline static typename arma_not_cx::result min_with_index(const SpProxy& P, uword& index_of_min_val); - - // - - template - inline static void apply_proxy(Mat& out, const SpProxy& p, const uword dim, const typename arma_cx_only::result* junk = nullptr); - - template - inline static typename T1::elem_type vector_min(const T1& X, const typename arma_cx_only::result* junk = nullptr); - - template - inline static typename arma_cx_only::result min(const SpBase& X); - - template - inline static typename arma_cx_only::result min_with_index(const SpProxy& P, uword& index_of_min_val); - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_min_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_min_meat.hpp deleted file mode 100644 index cb7c80d4e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_min_meat.hpp +++ /dev/null @@ -1,719 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sp_min -//! @{ - - - -template -inline -void -op_sp_min::apply(Mat& out, const mtSpReduceOp& in) - { - arma_debug_sigprint(); - - const uword dim = in.aux_uword_a; - - arma_conform_check( (dim > 1), "min(): parameter 'dim' must be 0 or 1" ); - - const SpProxy p(in.m); - - const uword p_n_rows = p.get_n_rows(); - const uword p_n_cols = p.get_n_cols(); - - if( (p_n_rows == 0) || (p_n_cols == 0) || (p.get_n_nonzero() == 0) ) - { - if(dim == 0) { out.zeros((p_n_rows > 0) ? 1 : 0, p_n_cols); } - if(dim == 1) { out.zeros(p_n_rows, (p_n_cols > 0) ? 1 : 0); } - - return; - } - - op_sp_min::apply_proxy(out, p, dim); - } - - - -template -inline -void -op_sp_min::apply_proxy - ( - Mat& out, - const SpProxy& p, - const uword dim, - const typename arma_not_cx::result* junk - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - - typename SpProxy::const_iterator_type it = p.begin(); - typename SpProxy::const_iterator_type it_end = p.end(); - - const uword p_n_cols = p.get_n_cols(); - const uword p_n_rows = p.get_n_rows(); - - if(dim == 0) // find the minimum in each column - { - out.zeros(1, p_n_cols); - - urowvec count(p_n_cols, arma_zeros_indicator()); - - while(it != it_end) - { - const uword col = it.col(); - - out[col] = (count[col] == 0) ? (*it) : (std::min)(out[col], (*it)); - count[col]++; - ++it; - } - - for(uword col=0; col -inline -typename T1::elem_type -op_sp_min::vector_min - ( - const T1& x, - const typename arma_not_cx::result* junk - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - - const SpProxy p(x); - - if(p.get_n_elem() == 0) - { - arma_conform_check(true, "min(): object has no elements"); - - return Datum::nan; - } - - if(p.get_n_nonzero() == 0) { return eT(0); } - - if(SpProxy::use_iterator == false) - { - // direct access of values - if(p.get_n_nonzero() == p.get_n_elem()) - { - return op_min::direct_min(p.get_values(), p.get_n_nonzero()); - } - else - { - return (std::min)(eT(0), op_min::direct_min(p.get_values(), p.get_n_nonzero())); - } - } - else - { - // use iterator - typename SpProxy::const_iterator_type it = p.begin(); - typename SpProxy::const_iterator_type it_end = p.end(); - - eT result = (*it); - ++it; - - while(it != it_end) - { - if((*it) < result) { result = (*it); } - - ++it; - } - - if(p.get_n_nonzero() == p.get_n_elem()) - { - return result; - } - else - { - return (std::min)(eT(0), result); - } - } - } - - - -template -inline -typename arma_not_cx::result -op_sp_min::min(const SpBase& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const SpProxy P(X.get_ref()); - - const uword n_elem = P.get_n_elem(); - const uword n_nonzero = P.get_n_nonzero(); - - if(n_elem == 0) - { - arma_conform_check(true, "min(): object has no elements"); - - return Datum::nan; - } - - eT min_val = priv::most_pos(); - - if(SpProxy::use_iterator) - { - // We have to iterate over the elements. - typedef typename SpProxy::const_iterator_type it_type; - - it_type it = P.begin(); - it_type it_end = P.end(); - - while(it != it_end) - { - if((*it) < min_val) { min_val = *it; } - - ++it; - } - } - else - { - // We can do direct access of the values, row_indices, and col_ptrs. - // We don't need the location of the min value, so we can just call out to - // other functions... - min_val = op_min::direct_min(P.get_values(), n_nonzero); - } - - if(n_elem == n_nonzero) - { - return min_val; - } - else - { - return (std::min)(eT(0), min_val); - } - } - - - -template -inline -typename arma_not_cx::result -op_sp_min::min_with_index(const SpProxy& P, uword& index_of_min_val) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_elem = P.get_n_elem(); - const uword n_nonzero = P.get_n_nonzero(); - const uword n_rows = P.get_n_rows(); - - if(n_elem == 0) - { - arma_conform_check(true, "min(): object has no elements"); - - index_of_min_val = uword(0); - - return Datum::nan; - } - - eT min_val = priv::most_pos(); - - if(SpProxy::use_iterator) - { - // We have to iterate over the elements. - typedef typename SpProxy::const_iterator_type it_type; - - it_type it = P.begin(); - it_type it_end = P.end(); - - while(it != it_end) - { - if((*it) < min_val) - { - min_val = *it; - index_of_min_val = it.row() + it.col() * n_rows; - } - - ++it; - } - } - else - { - // We can do direct access. - min_val = op_min::direct_min(P.get_values(), n_nonzero, index_of_min_val); - - // Convert to actual position in matrix. - const uword row = P.get_row_indices()[index_of_min_val]; - uword col = 0; - while(P.get_col_ptrs()[++col] < index_of_min_val + 1) { } - index_of_min_val = (col - 1) * n_rows + row; - } - - - if(n_elem != n_nonzero) - { - min_val = (std::min)(eT(0), min_val); - - // If the min_val is a nonzero element, we need its actual position in the matrix. - if(min_val == eT(0)) - { - // Find first zero element. - uword last_row = 0; - uword last_col = 0; - - typedef typename SpProxy::const_iterator_type it_type; - - it_type it = P.begin(); - it_type it_end = P.end(); - - while(it != it_end) - { - // Have we moved more than one position from the last place? - if((it.col() == last_col) && (it.row() - last_row > 1)) - { - index_of_min_val = it.col() * n_rows + last_row + 1; - break; - } - else if((it.col() >= last_col + 1) && (last_row < n_rows - 1)) - { - index_of_min_val = last_col * n_rows + last_row + 1; - break; - } - else if((it.col() == last_col + 1) && (it.row() > 0)) - { - index_of_min_val = it.col() * n_rows; - break; - } - else if(it.col() > last_col + 1) - { - index_of_min_val = (last_col + 1) * n_rows; - break; - } - - last_row = it.row(); - last_col = it.col(); - ++it; - } - } - } - - return min_val; - } - - - -template -inline -void -op_sp_min::apply_proxy - ( - Mat& out, - const SpProxy& p, - const uword dim, - const typename arma_cx_only::result* junk - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - typename SpProxy::const_iterator_type it = p.begin(); - typename SpProxy::const_iterator_type it_end = p.end(); - - const uword p_n_cols = p.get_n_cols(); - const uword p_n_rows = p.get_n_rows(); - - if(dim == 0) // find the minimum in each column - { - out.zeros(1, p_n_cols); - - Row absval(p_n_cols, arma_zeros_indicator()); - urowvec count(p_n_cols, arma_zeros_indicator()); - - while(it != it_end) - { - const uword col = it.col(); - - const eT& v = (*it); - const T a = std::abs(v); - - if(count[col] == 0) - { - absval[col] = a; - out[col] = v; - } - else - { - if(a < absval[col]) - { - absval[col] = a; - out[col] = v; - } - } - - count[col]++; - ++it; - } - - for(uword col=0; col < p_n_cols; ++col) - { - if(count[col] < p_n_rows) - { - if(T(0) < absval[col]) { out[col] = eT(0); } - } - } - } - else - if(dim == 1) // find the minimum in each row - { - out.zeros(p_n_rows, 1); - - Col absval(p_n_rows, arma_zeros_indicator()); - ucolvec count(p_n_rows, arma_zeros_indicator()); - - while(it != it_end) - { - const uword row = it.row(); - - const eT& v = (*it); - const T a = std::abs(v); - - if(count[row] == 0) - { - absval[row] = a; - out[row] = v; - } - else - { - if(a < absval[row]) - { - absval[row] = a; - out[row] = v; - } - } - - count[row]++; - ++it; - } - - for(uword row=0; row < p_n_rows; ++row) - { - if(count[row] < p_n_cols) - { - if(T(0) < absval[row]) { out[row] = eT(0); } - } - } - } - } - - - -template -inline -typename T1::elem_type -op_sp_min::vector_min - ( - const T1& x, - const typename arma_cx_only::result* junk - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - const SpProxy p(x); - - if(p.get_n_elem() == 0) - { - arma_conform_check(true, "min(): object has no elements"); - - return Datum::nan; - } - - if(p.get_n_nonzero() == 0) { return eT(0); } - - if(SpProxy::use_iterator == false) - { - // direct access of values - if(p.get_n_nonzero() == p.get_n_elem()) - { - return op_min::direct_min(p.get_values(), p.get_n_nonzero()); - } - else - { - const eT val1 = eT(0); - const eT val2 = op_min::direct_min(p.get_values(), p.get_n_nonzero()); - - return ( std::abs(val1) < std::abs(val2) ) ? val1 : val2; - } - } - else - { - // use iterator - typename SpProxy::const_iterator_type it = p.begin(); - typename SpProxy::const_iterator_type it_end = p.end(); - - eT best_val_orig = *it; - T best_val_abs = std::abs(best_val_orig); - - ++it; - - while(it != it_end) - { - eT val_orig = *it; - T val_abs = std::abs(val_orig); - - if(val_abs < best_val_abs) - { - best_val_abs = val_abs; - best_val_orig = val_orig; - } - - ++it; - } - - if(p.get_n_nonzero() == p.get_n_elem()) - { - return best_val_orig; - } - else - { - const eT val1 = eT(0); - - return ( std::abs(val1) < best_val_abs ) ? val1 : best_val_orig; - } - } - } - - - -template -inline -typename arma_cx_only::result -op_sp_min::min(const SpBase& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - const SpProxy P(X.get_ref()); - - const uword n_elem = P.get_n_elem(); - const uword n_nonzero = P.get_n_nonzero(); - - if(n_elem == 0) - { - arma_conform_check(true, "min(): object has no elements"); - - return Datum::nan; - } - - T min_val = priv::most_pos(); - eT ret_val; - - if(SpProxy::use_iterator) - { - // We have to iterate over the elements. - typedef typename SpProxy::const_iterator_type it_type; - - it_type it = P.begin(); - it_type it_end = P.end(); - - while(it != it_end) - { - const T tmp_val = std::abs(*it); - - if(tmp_val < min_val) - { - min_val = tmp_val; - ret_val = *it; - } - - ++it; - } - } - else - { - // We can do direct access of the values, row_indices, and col_ptrs. - // We don't need the location of the min value, so we can just call out to - // other functions... - ret_val = op_min::direct_min(P.get_values(), n_nonzero); - min_val = std::abs(ret_val); - } - - if(n_elem == n_nonzero) - { - return ret_val; - } - else - { - return (T(0) < min_val) ? eT(0) : ret_val; - } - } - - - -template -inline -typename arma_cx_only::result -op_sp_min::min_with_index(const SpProxy& P, uword& index_of_min_val) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - const uword n_elem = P.get_n_elem(); - const uword n_nonzero = P.get_n_nonzero(); - const uword n_rows = P.get_n_rows(); - - if(n_elem == 0) - { - arma_conform_check(true, "min(): object has no elements"); - - index_of_min_val = uword(0); - - return Datum::nan; - } - - T min_val = priv::most_pos(); - - if(SpProxy::use_iterator) - { - // We have to iterate over the elements. - typedef typename SpProxy::const_iterator_type it_type; - - it_type it = P.begin(); - it_type it_end = P.end(); - - while(it != it_end) - { - const T tmp_val = std::abs(*it); - - if(tmp_val < min_val) - { - min_val = tmp_val; - index_of_min_val = it.row() + it.col() * n_rows; - } - - ++it; - } - } - else - { - // We can do direct access. - min_val = std::abs(op_min::direct_min(P.get_values(), n_nonzero, index_of_min_val)); - - // Convert to actual position in matrix. - const uword row = P.get_row_indices()[index_of_min_val]; - uword col = 0; - while(P.get_col_ptrs()[++col] < index_of_min_val + 1) { } - index_of_min_val = (col - 1) * n_rows + row; - } - - - if(n_elem != n_nonzero) - { - min_val = (std::min)(T(0), min_val); - - // If the min_val is a nonzero element, we need its actual position in the matrix. - if(min_val == T(0)) - { - // Find first zero element. - uword last_row = 0; - uword last_col = 0; - - typedef typename SpProxy::const_iterator_type it_type; - - it_type it = P.begin(); - it_type it_end = P.end(); - - while(it != it_end) - { - // Have we moved more than one position from the last place? - if((it.col() == last_col) && (it.row() - last_row > 1)) - { - index_of_min_val = it.col() * n_rows + last_row + 1; - break; - } - else if((it.col() >= last_col + 1) && (last_row < n_rows - 1)) - { - index_of_min_val = last_col * n_rows + last_row + 1; - break; - } - else if((it.col() == last_col + 1) && (it.row() > 0)) - { - index_of_min_val = it.col() * n_rows; - break; - } - else if(it.col() > last_col + 1) - { - index_of_min_val = (last_col + 1) * n_rows; - break; - } - - last_row = it.row(); - last_col = it.col(); - ++it; - } - } - } - - return P[index_of_min_val]; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_minus_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_minus_bones.hpp deleted file mode 100644 index fb1487b60..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_minus_bones.hpp +++ /dev/null @@ -1,64 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sp_minus -//! @{ - - - -// Subtract a sparse object from a scalar; the output will be a dense object. -class op_sp_minus_pre - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const SpToDOp& in); - - // used for the optimization of sparse % (scalar - sparse) - template - inline static void apply_inside_schur(SpMat& out, const T2& x, const SpToDOp& y); - - // used for the optimization of sparse / (scalar - sparse) - template - inline static void apply_inside_div(SpMat& out, const T2& x, const SpToDOp& y); - }; - - - -// Subtract a scalar from a sparse object; the output will be a dense object. -class op_sp_minus_post - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const SpToDOp& in); - - // used for the optimization of sparse % (sparse - scalar) - template - inline static void apply_inside_schur(SpMat& out, const T2& x, const SpToDOp& y); - - // used for the optimization of sparse / (sparse - scalar) - template - inline static void apply_inside_div(SpMat& out, const T2& x, const SpToDOp& y); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_minus_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_minus_meat.hpp deleted file mode 100644 index 1086891f4..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_minus_meat.hpp +++ /dev/null @@ -1,183 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sp_minus -//! @{ - - -// scalar - SpBase -template -inline -void -op_sp_minus_pre::apply(Mat& out, const SpToDOp& in) - { - arma_debug_sigprint(); - - const SpProxy P(in.m); - - out.set_size(P.get_n_rows(), P.get_n_cols()); - out.fill(in.aux); - - out -= P.Q; - } - - - -// used for the optimization of sparse % (scalar - sparse) -template -inline -void -op_sp_minus_pre::apply_inside_schur(SpMat& out, const T2& x, const SpToDOp& y) - { - arma_debug_sigprint(); - - const SpProxy P2(x); - const SpProxy P3(y.m); - - arma_conform_assert_same_size(P2.get_n_rows(), P2.get_n_cols(), P3.get_n_rows(), P3.get_n_cols(), "element-wise multiplication"); - - out.zeros(P2.get_n_rows(), P2.get_n_cols()); - - typename SpProxy::const_iterator_type it = P2.begin(); - typename SpProxy::const_iterator_type it_end = P2.end(); - - const eT k = y.aux; - - for(; it != it_end; ++it) - { - const uword it_row = it.row(); - const uword it_col = it.col(); - - out.at(it_row, it_col) = (*it) * (k - P3.at(it_row, it_col)); - } - } - - - -// used for the optimization of sparse / (scalar - sparse) -template -inline -void -op_sp_minus_pre::apply_inside_div(SpMat& out, const T2& x, const SpToDOp& y) - { - arma_debug_sigprint(); - - const SpProxy P2(x); - const SpProxy P3(y.m); - - arma_conform_assert_same_size(P2.get_n_rows(), P2.get_n_cols(), P3.get_n_rows(), P3.get_n_cols(), "element-wise multiplication"); - - out.zeros(P2.get_n_rows(), P2.get_n_cols()); - - typename SpProxy::const_iterator_type it = P2.begin(); - typename SpProxy::const_iterator_type it_end = P2.end(); - - const eT k = y.aux; - - for(; it != it_end; ++it) - { - const uword it_row = it.row(); - const uword it_col = it.col(); - - out.at(it_row, it_col) = (*it) / (k - P3.at(it_row, it_col)); - } - } - - - -// SpBase - scalar -template -inline -void -op_sp_minus_post::apply(Mat& out, const SpToDOp& in) - { - arma_debug_sigprint(); - - const SpProxy P(in.m); - - out.set_size(P.get_n_rows(), P.get_n_cols()); - out.fill(-in.aux); - - out += P.Q; - } - - - -// used for the optimization of sparse % (sparse - scalar) -template -inline -void -op_sp_minus_post::apply_inside_schur(SpMat& out, const T2& x, const SpToDOp& y) - { - arma_debug_sigprint(); - - const SpProxy P2(x); - const SpProxy P3(y.m); - - arma_conform_assert_same_size(P2.get_n_rows(), P2.get_n_cols(), P3.get_n_rows(), P3.get_n_cols(), "element-wise multiplication"); - - out.zeros(P2.get_n_rows(), P2.get_n_cols()); - - typename SpProxy::const_iterator_type it = P2.begin(); - typename SpProxy::const_iterator_type it_end = P2.end(); - - const eT k = y.aux; - - for(; it != it_end; ++it) - { - const uword it_row = it.row(); - const uword it_col = it.col(); - - out.at(it_row, it_col) = (*it) * (P3.at(it_row, it_col) - k); - } - } - - - -// used for the optimization of sparse / (sparse - scalar) -template -inline -void -op_sp_minus_post::apply_inside_div(SpMat& out, const T2& x, const SpToDOp& y) - { - arma_debug_sigprint(); - - const SpProxy P2(x); - const SpProxy P3(y.m); - - arma_conform_assert_same_size(P2.get_n_rows(), P2.get_n_cols(), P3.get_n_rows(), P3.get_n_cols(), "element-wise multiplication"); - - out.zeros(P2.get_n_rows(), P2.get_n_cols()); - - typename SpProxy::const_iterator_type it = P2.begin(); - typename SpProxy::const_iterator_type it_end = P2.end(); - - const eT k = y.aux; - - for(; it != it_end; ++it) - { - const uword it_row = it.row(); - const uword it_col = it.col(); - - out.at(it_row, it_col) = (*it) / (P3.at(it_row, it_col) - k); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_nonzeros_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_nonzeros_bones.hpp deleted file mode 100644 index 84603012d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_nonzeros_bones.hpp +++ /dev/null @@ -1,36 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_sp_nonzeros -//! @{ - - - -class op_sp_nonzeros - : public traits_op_col - { - public: - - template - static inline void apply(Mat& out, const SpToDOp& X); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_nonzeros_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_nonzeros_meat.hpp deleted file mode 100644 index 33a8e1c36..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_nonzeros_meat.hpp +++ /dev/null @@ -1,75 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_sp_nonzeros -//! @{ - - - -template -inline -void -op_sp_nonzeros::apply(Mat& out, const SpToDOp& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const SpProxy P(X.m); - - const uword N = P.get_n_nonzero(); - - out.set_size(N,1); - - if(N == 0) { return; } - - if(is_SpMat::stored_type>::value) - { - const unwrap_spmat::stored_type> U(P.Q); - - arrayops::copy(out.memptr(), U.M.values, N); - - return; - } - - if(is_SpSubview::stored_type>::value) - { - const SpSubview& sv = reinterpret_cast< const SpSubview& >(P.Q); - - if(sv.n_rows == sv.m.n_rows) - { - const SpMat& m = sv.m; - const uword col = sv.aux_col1; - - arrayops::copy(out.memptr(), &(m.values[ m.col_ptrs[col] ]), N); - - return; - } - } - - eT* out_mem = out.memptr(); - - typename SpProxy::const_iterator_type it = P.begin(); - - for(uword i=0; i - inline static void apply(Mat& out, const SpToDOp& in); - - // used for the optimization of sparse % (sparse + scalar) - template - inline static void apply_inside_schur(SpMat& out, const T2& x, const SpToDOp& y); - - // used for the optimization of sparse / (sparse + scalar) - template - inline static void apply_inside_div(SpMat& out, const T2& x, const SpToDOp& y); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_plus_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_plus_meat.hpp deleted file mode 100644 index d80f2fb2e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_plus_meat.hpp +++ /dev/null @@ -1,102 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sp_plus -//! @{ - - -template -inline -void -op_sp_plus::apply(Mat& out, const SpToDOp& in) - { - arma_debug_sigprint(); - - const SpProxy P(in.m); - - out.set_size(P.get_n_rows(), P.get_n_cols()); - out.fill(in.aux); - - out += P.Q; - } - - - -// used for the optimization of sparse % (sparse + scalar) -template -inline -void -op_sp_plus::apply_inside_schur(SpMat& out, const T2& x, const SpToDOp& y) - { - arma_debug_sigprint(); - - const SpProxy P2(x); - const SpProxy P3(y.m); - - arma_conform_assert_same_size(P2.get_n_rows(), P2.get_n_cols(), P3.get_n_rows(), P3.get_n_cols(), "element-wise multiplication"); - - out.zeros(P2.get_n_rows(), P2.get_n_cols()); - - typename SpProxy::const_iterator_type it = P2.begin(); - typename SpProxy::const_iterator_type it_end = P2.end(); - - const eT k = y.aux; - - for(; it != it_end; ++it) - { - const uword it_row = it.row(); - const uword it_col = it.col(); - - out.at(it_row, it_col) = (*it) * (P3.at(it_row, it_col) + k); - } - } - - - -// used for the optimization of sparse / (sparse + scalar) -template -inline -void -op_sp_plus::apply_inside_div(SpMat& out, const T2& x, const SpToDOp& y) - { - arma_debug_sigprint(); - - const SpProxy P2(x); - const SpProxy P3(y.m); - - arma_conform_assert_same_size(P2.get_n_rows(), P2.get_n_cols(), P3.get_n_rows(), P3.get_n_cols(), "element-wise division"); - - out.zeros(P2.get_n_rows(), P2.get_n_cols()); - - typename SpProxy::const_iterator_type it = P2.begin(); - typename SpProxy::const_iterator_type it_end = P2.end(); - - const eT k = y.aux; - - for(; it != it_end; ++it) - { - const uword it_row = it.row(); - const uword it_col = it.col(); - - out.at(it_row, it_col) = (*it) / (P3.at(it_row, it_col) + k); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_stddev_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_stddev_bones.hpp deleted file mode 100644 index 616130d4b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_stddev_bones.hpp +++ /dev/null @@ -1,41 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sp_stddev -//! @{ - - - -class op_sp_stddev - : public traits_op_xvec - { - public: - - template - inline static void apply(Mat& out, const mtSpReduceOp& in); - - template - inline static void apply_slow(Mat& out, const SpProxy& p, const uword norm_type, const uword dim); - - template - inline static typename T1::pod_type stddev_vec(const T1& X, const uword norm_type = 0); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_stddev_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_stddev_meat.hpp deleted file mode 100644 index 56521a1ee..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_stddev_meat.hpp +++ /dev/null @@ -1,162 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sp_stddev -//! @{ - - - -template -inline -void -op_sp_stddev::apply(Mat& out, const mtSpReduceOp& in) - { - arma_debug_sigprint(); - - const uword norm_type = in.aux_uword_a; - const uword dim = in.aux_uword_b; - - arma_conform_check( (norm_type > 1), "stddev(): parameter 'norm_type' must be 0 or 1" ); - arma_conform_check( (dim > 1), "stddev(): parameter 'dim' must be 0 or 1" ); - - const SpProxy p(in.m); - - const uword p_n_rows = p.get_n_rows(); - const uword p_n_cols = p.get_n_cols(); - - if( (p_n_rows == 0) || (p_n_cols == 0) || (p.get_n_nonzero() == 0) ) - { - if(dim == 0) { out.zeros((p_n_rows > 0) ? 1 : 0, p_n_cols); } - if(dim == 1) { out.zeros(p_n_rows, (p_n_cols > 0) ? 1 : 0); } - - return; - } - - op_sp_stddev::apply_slow(out, p, norm_type, dim); - } - - - -template -inline -void -op_sp_stddev::apply_slow - ( - Mat& out, - const SpProxy& p, - const uword norm_type, - const uword dim - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type in_eT; - //typedef typename T1::pod_type out_eT; - - const uword p_n_rows = p.get_n_rows(); - const uword p_n_cols = p.get_n_cols(); - - if(dim == 0) // find variance in each column - { - arma_debug_print("op_sp_stddev::apply_slow(): dim = 0"); - - out.zeros(1, p_n_cols); - - for(uword col = 0; col < p_n_cols; ++col) - { - if(SpProxy::use_iterator) - { - // We must use an iterator; we can't access memory directly. - typename SpProxy::const_iterator_type it = p.begin_col(col); - typename SpProxy::const_iterator_type end = p.begin_col(col + 1); - - const uword n_zero = p_n_rows - (end.pos() - it.pos()); - - // in_eT is used just to get the specialization right (complex / noncomplex) - out.at(0, col) = std::sqrt( op_sp_var::iterator_var(it, end, n_zero, norm_type, in_eT(0)) ); - } - else - { - // We can use direct memory access to calculate the variance. - out.at(0, col) = std::sqrt( - op_sp_var::direct_var - ( - &p.get_values()[p.get_col_ptrs()[col]], - p.get_col_ptrs()[col + 1] - p.get_col_ptrs()[col], - p_n_rows, - norm_type - ) - ); - } - } - } - else - if(dim == 1) // find variance in each row - { - arma_debug_print("op_sp_stddev::apply_slow(): dim = 1"); - - out.zeros(p_n_rows, 1); - - for(uword row = 0; row < p_n_rows; ++row) - { - // We have to use an iterator here regardless of whether or not we can - // directly access memory. - typename SpProxy::const_row_iterator_type it = p.begin_row(row); - typename SpProxy::const_row_iterator_type end = p.end_row(row); - - const uword n_zero = p_n_cols - (end.pos() - it.pos()); - - out.at(row, 0) = std::sqrt( op_sp_var::iterator_var(it, end, n_zero, norm_type, in_eT(0)) ); - } - } - } - - - -template -inline -typename T1::pod_type -op_sp_stddev::stddev_vec - ( - const T1& X, - const uword norm_type - ) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - arma_conform_check( (norm_type > 1), "stddev(): parameter 'norm_type' must be 0 or 1" ); - - // conditionally unwrap it into a temporary and then directly operate. - - const unwrap_spmat tmp(X); - - if(tmp.M.n_elem == 0) - { - arma_conform_check(true, "stddev(): object has no elements"); - - return Datum::nan; - } - - return std::sqrt( op_sp_var::direct_var(tmp.M.values, tmp.M.n_nonzero, tmp.M.n_elem, norm_type) ); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_sum_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_sum_bones.hpp deleted file mode 100644 index 8c9c67a05..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_sum_bones.hpp +++ /dev/null @@ -1,33 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sp_sum -//! @{ - - -class op_sp_sum - : public traits_op_xvec - { - public: - - template - inline static void apply(Mat& out, const mtSpReduceOp& in); - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_sum_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_sum_meat.hpp deleted file mode 100644 index 8e9a22dac..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_sum_meat.hpp +++ /dev/null @@ -1,92 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sp_sum -//! @{ - - - -template -inline -void -op_sp_sum::apply(Mat& out, const mtSpReduceOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword dim = in.aux_uword_a; - - arma_conform_check( (dim > 1), "sum(): parameter 'dim' must be 0 or 1" ); - - const SpProxy p(in.m); - - const uword p_n_rows = p.get_n_rows(); - const uword p_n_cols = p.get_n_cols(); - - if(dim == 0) { out.zeros(1, p_n_cols); } - if(dim == 1) { out.zeros(p_n_rows, 1); } - - if(p.get_n_nonzero() == 0) { return; } - - eT* out_mem = out.memptr(); - - if(dim == 0) // find the sum in each column - { - if(SpProxy::use_iterator) - { - typename SpProxy::const_iterator_type it = p.begin(); - - const uword N = p.get_n_nonzero(); - - for(uword i=0; i < N; ++i) - { - out_mem[it.col()] += (*it); - ++it; - } - } - else - { - for(uword col = 0; col < p_n_cols; ++col) - { - out_mem[col] = arrayops::accumulate - ( - &p.get_values()[p.get_col_ptrs()[col]], - p.get_col_ptrs()[col + 1] - p.get_col_ptrs()[col] - ); - } - } - } - else - if(dim == 1) // find the sum in each row - { - typename SpProxy::const_iterator_type it = p.begin(); - - const uword N = p.get_n_nonzero(); - - for(uword i=0; i < N; ++i) - { - out_mem[it.row()] += (*it); - ++it; - } - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_var_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_var_bones.hpp deleted file mode 100644 index bdcd9b24d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_var_bones.hpp +++ /dev/null @@ -1,62 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sp_var -//! @{ - - - -//! Class for finding variance values of a sparse matrix -class op_sp_var - : public traits_op_xvec - { - public: - - template - inline static void apply(Mat& out, const mtSpReduceOp& in); - - template - inline static void apply_slow(Mat& out, const SpProxy& p, const uword norm_type, const uword dim); - - // Calculate variance of a sparse vector, where we can directly use the memory. - template - inline static typename T1::pod_type var_vec(const T1& X, const uword norm_type = 0); - - // Calculate the variance directly. Because this is for sparse matrices, we - // specify both the number of elements in the array (the length of the array) - // as well as the actual number of elements when zeros are included. - template - inline static eT direct_var(const eT* const X, const uword length, const uword N, const uword norm_type = 0); - - // For complex numbers. - - template - inline static T direct_var(const std::complex* const X, const uword length, const uword N, const uword norm_type = 0); - - // Calculate the variance using iterators, for non-complex numbers. - template - inline static eT iterator_var(T1& it, const T1& end, const uword n_zero, const uword norm_type, const eT junk1, const typename arma_not_cx::result* junk2 = nullptr); - - // Calculate the variance using iterators, for complex numbers. - template - inline static typename get_pod_type::result iterator_var(T1& it, const T1& end, const uword n_zero, const uword norm_type, const eT junk1, const typename arma_cx_only::result* junk2 = nullptr); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_var_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_var_meat.hpp deleted file mode 100644 index 8c5cdff88..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_var_meat.hpp +++ /dev/null @@ -1,414 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sp_var -//! @{ - - - -template -inline -void -op_sp_var::apply(Mat& out, const mtSpReduceOp& in) - { - arma_debug_sigprint(); - - const uword norm_type = in.aux_uword_a; - const uword dim = in.aux_uword_b; - - arma_conform_check( (norm_type > 1), "var(): parameter 'norm_type' must be 0 or 1" ); - arma_conform_check( (dim > 1), "var(): parameter 'dim' must be 0 or 1" ); - - const SpProxy p(in.m); - - const uword p_n_rows = p.get_n_rows(); - const uword p_n_cols = p.get_n_cols(); - - if( (p_n_rows == 0) || (p_n_cols == 0) || (p.get_n_nonzero() == 0) ) - { - if(dim == 0) { out.zeros((p_n_rows > 0) ? 1 : 0, p_n_cols); } - if(dim == 1) { out.zeros(p_n_rows, (p_n_cols > 0) ? 1 : 0); } - - return; - } - - op_sp_var::apply_slow(out, p, norm_type, dim); - } - - - -template -inline -void -op_sp_var::apply_slow - ( - Mat& out, - const SpProxy& p, - const uword norm_type, - const uword dim - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type in_eT; - //typedef typename T1::pod_type out_eT; - - const uword p_n_rows = p.get_n_rows(); - const uword p_n_cols = p.get_n_cols(); - - if(dim == 0) // find variance in each column - { - arma_debug_print("op_sp_var::apply_slow(): dim = 0"); - - out.zeros(1, p_n_cols); - - for(uword col = 0; col < p_n_cols; ++col) - { - if(SpProxy::use_iterator) - { - // We must use an iterator; we can't access memory directly. - typename SpProxy::const_iterator_type it = p.begin_col(col); - typename SpProxy::const_iterator_type end = p.begin_col(col + 1); - - const uword n_zero = p_n_rows - (end.pos() - it.pos()); - - // in_eT is used just to get the specialization right (complex / noncomplex) - out.at(0, col) = op_sp_var::iterator_var(it, end, n_zero, norm_type, in_eT(0)); - } - else - { - // We can use direct memory access to calculate the variance. - out.at(0, col) = op_sp_var::direct_var - ( - &p.get_values()[p.get_col_ptrs()[col]], - p.get_col_ptrs()[col + 1] - p.get_col_ptrs()[col], - p_n_rows, - norm_type - ); - } - } - } - else - if(dim == 1) // find variance in each row - { - arma_debug_print("op_sp_var::apply_slow(): dim = 1"); - - out.zeros(p_n_rows, 1); - - for(uword row = 0; row < p_n_rows; ++row) - { - // We have to use an iterator here regardless of whether or not we can - // directly access memory. - typename SpProxy::const_row_iterator_type it = p.begin_row(row); - typename SpProxy::const_row_iterator_type end = p.end_row(row); - - const uword n_zero = p_n_cols - (end.pos() - it.pos()); - - out.at(row, 0) = op_sp_var::iterator_var(it, end, n_zero, norm_type, in_eT(0)); - } - } - } - - - -template -inline -typename T1::pod_type -op_sp_var::var_vec - ( - const T1& X, - const uword norm_type - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - arma_conform_check( (norm_type > 1), "var(): parameter 'norm_type' must be 0 or 1" ); - - // conditionally unwrap it into a temporary and then directly operate. - - const unwrap_spmat tmp(X); - - if(tmp.M.n_elem == 0) - { - arma_conform_check(true, "var(): object has no elements"); - - return Datum::nan; - } - - return direct_var(tmp.M.values, tmp.M.n_nonzero, tmp.M.n_elem, norm_type); - } - - - -template -inline -eT -op_sp_var::direct_var - ( - const eT* const X, - const uword length, - const uword N, - const uword norm_type - ) - { - arma_debug_sigprint(); - - if(length >= 2 && N >= 2) - { - const eT acc1 = op_sp_mean::direct_mean(X, length, N); - - eT acc2 = eT(0); - eT acc3 = eT(0); - - uword i, j; - - for(i = 0, j = 1; j < length; i += 2, j += 2) - { - const eT Xi = X[i]; - const eT Xj = X[j]; - - const eT tmpi = acc1 - Xi; - const eT tmpj = acc1 - Xj; - - acc2 += tmpi * tmpi + tmpj * tmpj; - acc3 += tmpi + tmpj; - } - - if(i < length) - { - const eT Xi = X[i]; - - const eT tmpi = acc1 - Xi; - - acc2 += tmpi * tmpi; - acc3 += tmpi; - } - - // Now add in all zero elements. - acc2 += (N - length) * (acc1 * acc1); - acc3 += (N - length) * acc1; - - const eT norm_val = (norm_type == 0) ? eT(N - 1) : eT(N); - const eT var_val = (acc2 - (acc3 * acc3) / eT(N)) / norm_val; - - return var_val; - } - else if(length == 1 && N > 1) // if N == 1, then variance is zero. - { - const eT mean = X[0] / eT(N); - const eT val = mean - X[0]; - - const eT acc2 = (val * val) + (N - length) * (mean * mean); - const eT acc3 = val + (N - length) * mean; - - const eT norm_val = (norm_type == 0) ? eT(N - 1) : eT(N); - const eT var_val = (acc2 - (acc3 * acc3) / eT(N)) / norm_val; - - return var_val; - } - else - { - return eT(0); - } - } - - - -template -inline -T -op_sp_var::direct_var - ( - const std::complex* const X, - const uword length, - const uword N, - const uword norm_type - ) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - if(length >= 2 && N >= 2) - { - const eT acc1 = op_sp_mean::direct_mean(X, length, N); - - T acc2 = T(0); - eT acc3 = eT(0); - - for(uword i = 0; i < length; ++i) - { - const eT tmp = acc1 - X[i]; - - acc2 += std::norm(tmp); - acc3 += tmp; - } - - // Add zero elements to sums - acc2 += std::norm(acc1) * T(N - length); - acc3 += acc1 * T(N - length); - - const T norm_val = (norm_type == 0) ? T(N - 1) : T(N); - const T var_val = (acc2 - std::norm(acc3) / T(N)) / norm_val; - - return var_val; - } - else if(length == 1 && N > 1) // if N == 1, then variance is zero. - { - const eT mean = X[0] / T(N); - const eT val = mean - X[0]; - - const T acc2 = std::norm(val) + (N - length) * std::norm(mean); - const eT acc3 = val + T(N - length) * mean; - - const T norm_val = (norm_type == 0) ? T(N - 1) : T(N); - const T var_val = (acc2 - std::norm(acc3) / T(N)) / norm_val; - - return var_val; - } - else - { - return T(0); // All elements are zero - } - } - - - -template -inline -eT -op_sp_var::iterator_var - ( - T1& it, - const T1& end, - const uword n_zero, - const uword norm_type, - const eT junk1, - const typename arma_not_cx::result* junk2 - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - T1 new_it(it); // for mean - // T1 backup_it(it); // in case we have to call robust iterator_var - eT mean = op_sp_mean::iterator_mean(new_it, end, n_zero, eT(0)); - - eT acc2 = eT(0); - eT acc3 = eT(0); - - const uword it_begin_pos = it.pos(); - - while(it != end) - { - const eT tmp = mean - (*it); - - acc2 += (tmp * tmp); - acc3 += (tmp); - - ++it; - } - - const uword n_nonzero = (it.pos() - it_begin_pos); - if(n_nonzero == 0) - { - return eT(0); - } - - if(n_nonzero + n_zero == 1) - { - return eT(0); // only one element - } - - // Add in entries for zeros. - acc2 += eT(n_zero) * (mean * mean); - acc3 += eT(n_zero) * mean; - - const eT norm_val = (norm_type == 0) ? eT(n_zero + n_nonzero - 1) : eT(n_zero + n_nonzero); - const eT var_val = (acc2 - (acc3 * acc3) / eT(n_nonzero + n_zero)) / norm_val; - - return var_val; - } - - - -template -inline -typename get_pod_type::result -op_sp_var::iterator_var - ( - T1& it, - const T1& end, - const uword n_zero, - const uword norm_type, - const eT junk1, - const typename arma_cx_only::result* junk2 - ) - { - arma_debug_sigprint(); - arma_ignore(junk1); - arma_ignore(junk2); - - typedef typename get_pod_type::result T; - - T1 new_it(it); // for mean - // T1 backup_it(it); // in case we have to call robust iterator_var - eT mean = op_sp_mean::iterator_mean(new_it, end, n_zero, eT(0)); - - T acc2 = T(0); - eT acc3 = eT(0); - - const uword it_begin_pos = it.pos(); - - while(it != end) - { - eT tmp = mean - (*it); - - acc2 += std::norm(tmp); - acc3 += (tmp); - - ++it; - } - - const uword n_nonzero = (it.pos() - it_begin_pos); - if(n_nonzero == 0) - { - return T(0); - } - - if(n_nonzero + n_zero == 1) - { - return T(0); // only one element - } - - // Add in entries for zero elements. - acc2 += T(n_zero) * std::norm(mean); - acc3 += T(n_zero) * mean; - - const T norm_val = (norm_type == 0) ? T(n_zero + n_nonzero - 1) : T(n_zero + n_nonzero); - const T var_val = (acc2 - std::norm(acc3) / T(n_nonzero + n_zero)) / norm_val; - - return var_val; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_vecnorm_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_vecnorm_bones.hpp deleted file mode 100644 index aadf943bb..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_vecnorm_bones.hpp +++ /dev/null @@ -1,52 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sp_vecnorm -//! @{ - - -class op_sp_vecnorm - : public traits_op_xvec - { - public: - - template - inline static void apply(Mat& out, const mtSpReduceOp& expr); - - template - inline static void apply_direct(Mat< typename get_pod_type::result >& out, const SpMat& X, const uword k); - }; - - -// - - -class op_sp_vecnorm_ext - : public traits_op_xvec - { - public: - - template - inline static void apply(Mat& out, const mtSpReduceOp& expr); - - template - inline static void apply_direct(Mat< typename get_pod_type::result >& out, const SpMat& X, const uword method_id); - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_vecnorm_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_vecnorm_meat.hpp deleted file mode 100644 index e5cfab2b8..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sp_vecnorm_meat.hpp +++ /dev/null @@ -1,201 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sp_vecnorm -//! @{ - - - -template -inline -void -op_sp_vecnorm::apply(Mat& out, const mtSpReduceOp& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const uword k = expr.aux_uword_a; - const uword dim = expr.aux_uword_b; - - arma_conform_check( (k == 0), "vecnorm(): unsupported vector norm type" ); - arma_conform_check( (dim > 1), "vecnorm(): parameter 'dim' must be 0 or 1" ); - - const unwrap_spmat U(expr.m); - const SpMat& X = U.M; - - X.sync(); - - if(dim == 0) - { - op_sp_vecnorm::apply_direct(out, X, k); - } - else - if(dim == 1) - { - Mat< T> tmp; - SpMat Xt; - - spop_strans::apply_noalias(Xt, X); - - op_sp_vecnorm::apply_direct(tmp, Xt, k); - - out = tmp.t(); - } - } - - - -template -inline -void -op_sp_vecnorm::apply_direct(Mat< typename get_pod_type::result >& out, const SpMat& X, const uword k) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - out.zeros(1, X.n_cols); - - T* out_mem = out.memptr(); - - for(uword col=0; col < X.n_cols; ++col) - { - const uword col_offset = X.col_ptrs[col ]; - const uword next_col_offset = X.col_ptrs[col + 1]; - - const eT* start_ptr = &X.values[ col_offset]; - const eT* end_ptr = &X.values[next_col_offset]; - - const uword n_elem = end_ptr - start_ptr; - - T out_val = T(0); - - if(n_elem > 0) - { - const Col tmp(const_cast(start_ptr), n_elem, false, false); - - const Proxy< Col > P(tmp); - - if(k == uword(1)) { out_val = op_norm::vec_norm_1(P); } - if(k == uword(2)) { out_val = op_norm::vec_norm_2(P); } - } - - out_mem[col] = out_val; - } - } - - - -// - - - -template -inline -void -op_sp_vecnorm_ext::apply(Mat& out, const mtSpReduceOp& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const uword method_id = expr.aux_uword_a; - const uword dim = expr.aux_uword_b; - - arma_conform_check( (method_id == 0), "vecnorm(): unsupported vector norm type" ); - arma_conform_check( (dim > 1), "vecnorm(): parameter 'dim' must be 0 or 1" ); - - const unwrap_spmat U(expr.m); - const SpMat& X = U.M; - - X.sync(); - - if(dim == 0) - { - op_sp_vecnorm_ext::apply_direct(out, X, method_id); - } - else - if(dim == 1) - { - Mat< T> tmp; - SpMat Xt; - - spop_strans::apply_noalias(Xt, X); - - op_sp_vecnorm_ext::apply_direct(tmp, Xt, method_id); - - out = tmp.t(); - } - } - - - -template -inline -void -op_sp_vecnorm_ext::apply_direct(Mat< typename get_pod_type::result >& out, const SpMat& X, const uword method_id) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - out.zeros(1, X.n_cols); - - T* out_mem = out.memptr(); - - for(uword col=0; col < X.n_cols; ++col) - { - const uword col_offset = X.col_ptrs[col ]; - const uword next_col_offset = X.col_ptrs[col + 1]; - - const eT* start_ptr = &X.values[ col_offset]; - const eT* end_ptr = &X.values[next_col_offset]; - - const uword n_elem = end_ptr - start_ptr; - - T out_val = T(0); - - if(n_elem > 0) - { - const Col tmp(const_cast(start_ptr), n_elem, false, false); - - const Proxy< Col > P(tmp); - - if(method_id == uword(1)) - { - out_val = op_norm::vec_norm_max(P); - } - else - if(method_id == uword(2)) - { - const T tmp_val = op_norm::vec_norm_min(P); - - out_val = (n_elem < X.n_rows) ? T((std::min)(T(0), tmp_val)) : T(tmp_val); - } - } - - out_mem[col] = out_val; - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sqrtmat_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sqrtmat_bones.hpp deleted file mode 100644 index a63ae4bbd..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sqrtmat_bones.hpp +++ /dev/null @@ -1,78 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sqrtmat -//! @{ - - - -class op_sqrtmat - : public traits_op_default - { - public: - - template - inline static void apply(Mat< std::complex >& out, const mtOp,T1,op_sqrtmat>& in); - - template - inline static bool apply_direct(Mat< std::complex >& out, const Op& expr); - - template - inline static bool apply_direct(Mat< std::complex >& out, const Base& expr); - }; - - - -class op_sqrtmat_cx - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& in); - - template - inline static bool apply_direct(Mat& out, const Op& expr); - - template - inline static bool apply_direct_noalias(Mat& out, const diagmat_proxy& P); - - template - inline static bool apply_direct(Mat& out, const Base& expr); - - template - inline static bool helper(Mat< std::complex >& S); - }; - - - -class op_sqrtmat_sympd - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& in); - - template - inline static bool apply_direct(Mat& out, const Base& expr); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sqrtmat_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sqrtmat_meat.hpp deleted file mode 100644 index 44017455e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sqrtmat_meat.hpp +++ /dev/null @@ -1,549 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sqrtmat -//! @{ - - -//! implementation partly based on: -//! N. J. Higham. -//! A New sqrtm for Matlab. -//! Numerical Analysis Report No. 336, January 1999. -//! Department of Mathematics, University of Manchester. -//! ISSN 1360-1725 -//! http://www.maths.manchester.ac.uk/~higham/narep/narep336.ps.gz - - -template -inline -void -op_sqrtmat::apply(Mat< std::complex >& out, const mtOp,T1,op_sqrtmat>& in) - { - arma_debug_sigprint(); - - const bool status = op_sqrtmat::apply_direct(out, in.m); - - if(status == false) - { - arma_warn(3, "sqrtmat(): given matrix is singular; may not have a square root"); - } - } - - - -template -inline -bool -op_sqrtmat::apply_direct(Mat< std::complex >& out, const Op& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type T; - - const diagmat_proxy P(expr.m); - - arma_conform_check( (P.n_rows != P.n_cols), "sqrtmat(): given matrix must be square sized" ); - - const uword N = P.n_rows; - - out.zeros(N,N); - - bool singular = false; - - for(uword i=0; i= T(0)) - { - singular = (singular || (val == T(0))); - - out.at(i,i) = std::sqrt(val); - } - else - { - out.at(i,i) = std::sqrt( std::complex(val) ); - } - } - - return (singular) ? false : true; - } - - - -template -inline -bool -op_sqrtmat::apply_direct(Mat< std::complex >& out, const Base& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type in_T; - typedef typename std::complex out_T; - - const quasi_unwrap expr_unwrap(expr.get_ref()); - const Mat& A = expr_unwrap.M; - - arma_conform_check( (A.is_square() == false), "sqrtmat(): given matrix must be square sized" ); - - if(A.n_elem == 0) - { - out.reset(); - return true; - } - else - if(A.n_elem == 1) - { - out.set_size(1,1); - out[0] = std::sqrt( std::complex( A[0] ) ); - return true; - } - - if(A.is_diagmat()) - { - arma_debug_print("op_sqrtmat: detected diagonal matrix"); - - const uword N = A.n_rows; - - out.zeros(N,N); // aliasing can't happen as op_sqrtmat is defined as cx_mat = op(mat) - - for(uword i=0; i= in_T(0)) - { - out.at(i,i) = std::sqrt(val); - } - else - { - out.at(i,i) = std::sqrt( out_T(val) ); - } - } - - return true; - } - - const bool try_sympd = arma_config::optimise_sym && sym_helper::guess_sympd(A); - - if(try_sympd) - { - arma_debug_print("op_sqrtmat: attempting sympd optimisation"); - - // if matrix A is sympd, all its eigenvalues are positive - - Col eigval; - Mat eigvec; - - const bool eig_status = eig_sym_helper(eigval, eigvec, A, 'd', "sqrtmat()"); - - if(eig_status) - { - // ensure each eigenvalue is > 0 - - const uword N = eigval.n_elem; - const in_T* eigval_mem = eigval.memptr(); - - bool all_pos = true; - - for(uword i=0; i >::from( eigvec * diagmat(eigval) * eigvec.t() ); - - return true; - } - } - - arma_debug_print("op_sqrtmat: sympd optimisation failed"); - - // fallthrough if eigen decomposition failed or an eigenvalue is <= 0 - } - - - Mat U; - Mat S(A.n_rows, A.n_cols, arma_nozeros_indicator()); - - const in_T* Amem = A.memptr(); - out_T* Smem = S.memptr(); - - const uword n_elem = A.n_elem; - - for(uword i=0; i( Amem[i] ); - } - - const bool schur_ok = auxlib::schur(U,S); - - if(schur_ok == false) - { - arma_debug_print("sqrtmat(): schur decomposition failed"); - out.soft_reset(); - return false; - } - - const bool status = op_sqrtmat_cx::helper(S); - - const Mat X = U*S; - - S.reset(); - - out = X*U.t(); - - return status; - } - - - -template -inline -void -op_sqrtmat_cx::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - const bool status = op_sqrtmat_cx::apply_direct(out, in.m); - - if(status == false) - { - arma_warn(3, "sqrtmat(): given matrix is singular; may not have a square root"); - } - } - - - -template -inline -bool -op_sqrtmat_cx::apply_direct(Mat& out, const Op& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const diagmat_proxy P(expr.m); - - bool status = false; - - if(P.is_alias(out)) - { - Mat tmp; - - status = op_sqrtmat_cx::apply_direct_noalias(tmp, P); - - out.steal_mem(tmp); - } - else - { - status = op_sqrtmat_cx::apply_direct_noalias(out, P); - } - - return status; - } - - - -template -inline -bool -op_sqrtmat_cx::apply_direct_noalias(Mat& out, const diagmat_proxy& P) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - arma_conform_check( (P.n_rows != P.n_cols), "sqrtmat(): given matrix must be square sized" ); - - const uword N = P.n_rows; - - out.zeros(N,N); - - const eT zero = eT(0); - - bool singular = false; - - for(uword i=0; i -inline -bool -op_sqrtmat_cx::apply_direct(Mat& out, const Base& expr) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - typedef typename T1::elem_type eT; - - Mat U; - Mat S = expr.get_ref(); - - arma_conform_check( (S.n_rows != S.n_cols), "sqrtmat(): given matrix must be square sized" ); - - if(S.n_elem == 0) - { - out.reset(); - return true; - } - else - if(S.n_elem == 1) - { - out.set_size(1,1); - out[0] = std::sqrt(S[0]); - return true; - } - - if(S.is_diagmat()) - { - arma_debug_print("op_sqrtmat_cx: detected diagonal matrix"); - - const uword N = S.n_rows; - - out.zeros(N,N); // aliasing can't happen as S is generated - - for(uword i=0; i eigval; - Mat eigvec; - - const bool eig_status = eig_sym_helper(eigval, eigvec, S, 'd', "sqrtmat()"); - - if(eig_status) - { - // ensure each eigenvalue is > 0 - - const uword N = eigval.n_elem; - const T* eigval_mem = eigval.memptr(); - - bool all_pos = true; - - for(uword i=0; i X = U*S; - - S.reset(); - - out = X*U.t(); - - return status; - } - - - -template -inline -bool -op_sqrtmat_cx::helper(Mat< std::complex >& S) - { - typedef typename std::complex eT; - - if(S.is_empty()) { return true; } - - const uword N = S.n_rows; - - const eT zero = eT(0); - - eT& S_00 = S[0]; - - bool singular = (S_00 == zero); - - S_00 = std::sqrt(S_00); - - for(uword j=1; j < N; ++j) - { - eT* S_j = S.colptr(j); - - eT& S_jj = S_j[j]; - - singular = (singular || (S_jj == zero)); - - S_jj = std::sqrt(S_jj); - - for(uword ii=0; ii <= (j-1); ++ii) - { - const uword i = (j-1) - ii; - - const eT* S_i = S.colptr(i); - - //S_j[i] /= (S_i[i] + S_j[j]); - S_j[i] /= (S_i[i] + S_jj); - - for(uword k=0; k < i; ++k) - { - S_j[k] -= S_i[k] * S_j[i]; - } - } - } - - return (singular) ? false : true; - } - - - -template -inline -void -op_sqrtmat_sympd::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - const bool status = op_sqrtmat_sympd::apply_direct(out, in.m); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("sqrtmat_sympd(): transformation failed"); - } - } - - - -template -inline -bool -op_sqrtmat_sympd::apply_direct(Mat& out, const Base& expr) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_LAPACK) - { - typedef typename T1::elem_type eT; - typedef typename T1::pod_type T; - - const unwrap U(expr.get_ref()); - const Mat& X = U.M; - - arma_conform_check( (X.is_square() == false), "sqrtmat_sympd(): given matrix must be square sized" ); - - if((arma_config::check_conform) && (is_cx::yes) && (sym_helper::check_diag_imag(X) == false)) - { - arma_warn(1, "sqrtmat_sympd(): imaginary components on the diagonal are non-zero"); - } - - if(is_op_diagmat::value || X.is_diagmat()) - { - arma_debug_print("op_sqrtmat_sympd: detected diagonal matrix"); - - out = X; - - eT* colmem = out.memptr(); - - const uword N = X.n_rows; - - for(uword i=0; i eigval; - Mat eigvec; - - const bool status = eig_sym_helper(eigval, eigvec, X, 'd', "sqrtmat_sympd()"); - - if(status == false) { return false; } - - const uword N = eigval.n_elem; - const T* eigval_mem = eigval.memptr(); - - bool all_pos = true; - - for(uword i=0; i - inline static void apply(Mat& out, const mtOp& in); - - template - inline static void apply_noalias(Mat::result>& out, const Mat& X, const uword norm_type, const uword dim); - - // - - template - inline static typename get_pod_type::result stddev_vec(const subview_col& X, const uword norm_type = 0); - - template - inline static typename get_pod_type::result stddev_vec(const subview_row& X, const uword norm_type = 0); - - template - inline static typename T1::pod_type stddev_vec(const Base& X, const uword norm_type = 0); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_stddev_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_stddev_meat.hpp deleted file mode 100644 index 9bf9e3070..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_stddev_meat.hpp +++ /dev/null @@ -1,199 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_stddev -//! @{ - - - -template -inline -void -op_stddev::apply(Mat& out, const mtOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type out_eT; - - const uword norm_type = in.aux_uword_a; - const uword dim = in.aux_uword_b; - - arma_conform_check( (norm_type > 1), "stddev(): parameter 'norm_type' must be 0 or 1" ); - arma_conform_check( (dim > 1), "stddev(): parameter 'dim' must be 0 or 1" ); - - const quasi_unwrap U(in.m); - - if(U.is_alias(out)) - { - Mat tmp; - - op_stddev::apply_noalias(tmp, U.M, norm_type, dim); - - out.steal_mem(tmp); - } - else - { - op_stddev::apply_noalias(out, U.M, norm_type, dim); - } - } - - - -template -inline -void -op_stddev::apply_noalias(Mat::result>& out, const Mat& X, const uword norm_type, const uword dim) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result out_eT; - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(dim == 0) - { - arma_debug_print("op_stddev::apply_noalias(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols); - - if(X_n_rows > 0) - { - out_eT* out_mem = out.memptr(); - - for(uword col=0; col 0) ? 1 : 0); - - if(X_n_cols > 0) - { - podarray dat(X_n_cols); - - in_eT* dat_mem = dat.memptr(); - out_eT* out_mem = out.memptr(); - - for(uword row=0; row -inline -typename T1::pod_type -op_stddev::stddev_vec(const Base& X, const uword norm_type) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - arma_conform_check( (norm_type > 1), "stddev(): parameter 'norm_type' must be 0 or 1" ); - - const quasi_unwrap U(X.get_ref()); - - if(U.M.n_elem == 0) - { - arma_conform_check(true, "stddev(): object has no elements"); - - return Datum::nan; - } - - return std::sqrt( op_var::direct_var(U.M.memptr(), U.M.n_elem, norm_type) ); - } - - - -template -inline -typename get_pod_type::result -op_stddev::stddev_vec(const subview_col& X, const uword norm_type) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - arma_conform_check( (norm_type > 1), "stddev(): parameter 'norm_type' must be 0 or 1" ); - - if(X.n_elem == 0) - { - arma_conform_check(true, "stddev(): object has no elements"); - - return Datum::nan; - } - - return std::sqrt( op_var::direct_var(X.colptr(0), X.n_rows, norm_type) ); - } - - - - -template -inline -typename get_pod_type::result -op_stddev::stddev_vec(const subview_row& X, const uword norm_type) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - arma_conform_check( (norm_type > 1), "stddev(): parameter 'norm_type' must be 0 or 1" ); - - if(X.n_elem == 0) - { - arma_conform_check(true, "stddev(): object has no elements"); - - return Datum::nan; - } - - const Mat& A = X.m; - - const uword start_row = X.aux_row1; - const uword start_col = X.aux_col1; - - const uword end_col_p1 = start_col + X.n_cols; - - podarray tmp(X.n_elem); - eT* tmp_mem = tmp.memptr(); - - for(uword i=0, col=start_col; col < end_col_p1; ++col, ++i) - { - tmp_mem[i] = A.at(start_row, col); - } - - return std::sqrt( op_var::direct_var(tmp.memptr(), tmp.n_elem, norm_type) ); - } - - - -//! @} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_strans_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_strans_bones.hpp deleted file mode 100644 index 42534bfe7..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_strans_bones.hpp +++ /dev/null @@ -1,85 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_strans -//! @{ - - -//! 'matrix transpose' operation (simple transpose, ie. without taking the conjugate of the elements) - -class op_strans - { - public: - - template - struct traits - { - static constexpr bool is_row = T1::is_col; // deliberately swapped - static constexpr bool is_col = T1::is_row; - static constexpr bool is_xvec = T1::is_xvec; - }; - - template - struct pos - { - static constexpr uword n2 = (do_flip == false) ? (row + col*2) : (col + row*2); - static constexpr uword n3 = (do_flip == false) ? (row + col*3) : (col + row*3); - static constexpr uword n4 = (do_flip == false) ? (row + col*4) : (col + row*4); - }; - - template - arma_cold inline static void apply_mat_noalias_tinysq(Mat& out, const TA& A); - - template - arma_hot inline static void block_worker(eT* Y, const eT* X, const uword X_n_rows, const uword Y_n_rows, const uword n_rows, const uword n_cols); - - template - arma_hot inline static void apply_mat_noalias_large(Mat& out, const Mat& A); - - template - arma_hot inline static void apply_mat_noalias(Mat& out, const TA& A); - - template - arma_hot inline static void apply_mat_inplace(Mat& out); - - template - inline static void apply_mat(Mat& out, const TA& A); - - template - inline static void apply_proxy(Mat& out, const Proxy& P); - - template - inline static void apply_direct(Mat& out, const T1& X); - - template - inline static void apply(Mat& out, const Op& in); - }; - - - -class op_strans_cube - { - public: - - template - inline static void apply_noalias(Cube& out, const Cube& X); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_strans_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_strans_meat.hpp deleted file mode 100644 index 42d5f08d0..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_strans_meat.hpp +++ /dev/null @@ -1,475 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_strans -//! @{ - - - -//! for tiny square matrices (size <= 4x4) -template -inline -void -op_strans::apply_mat_noalias_tinysq(Mat& out, const TA& A) - { - const eT* Am = A.memptr(); - eT* outm = out.memptr(); - - switch(A.n_rows) - { - case 1: - { - outm[0] = Am[0]; - } - break; - - case 2: - { - outm[pos::n2] = Am[pos::n2]; - outm[pos::n2] = Am[pos::n2]; - - outm[pos::n2] = Am[pos::n2]; - outm[pos::n2] = Am[pos::n2]; - } - break; - - case 3: - { - outm[pos::n3] = Am[pos::n3]; - outm[pos::n3] = Am[pos::n3]; - outm[pos::n3] = Am[pos::n3]; - - outm[pos::n3] = Am[pos::n3]; - outm[pos::n3] = Am[pos::n3]; - outm[pos::n3] = Am[pos::n3]; - - outm[pos::n3] = Am[pos::n3]; - outm[pos::n3] = Am[pos::n3]; - outm[pos::n3] = Am[pos::n3]; - } - break; - - case 4: - { - outm[pos::n4] = Am[pos::n4]; - outm[pos::n4] = Am[pos::n4]; - outm[pos::n4] = Am[pos::n4]; - outm[pos::n4] = Am[pos::n4]; - - outm[pos::n4] = Am[pos::n4]; - outm[pos::n4] = Am[pos::n4]; - outm[pos::n4] = Am[pos::n4]; - outm[pos::n4] = Am[pos::n4]; - - outm[pos::n4] = Am[pos::n4]; - outm[pos::n4] = Am[pos::n4]; - outm[pos::n4] = Am[pos::n4]; - outm[pos::n4] = Am[pos::n4]; - - outm[pos::n4] = Am[pos::n4]; - outm[pos::n4] = Am[pos::n4]; - outm[pos::n4] = Am[pos::n4]; - outm[pos::n4] = Am[pos::n4]; - } - break; - - default: - ; - } - - } - - - -template -inline -void -op_strans::block_worker(eT* Y, const eT* X, const uword X_n_rows, const uword Y_n_rows, const uword n_rows, const uword n_cols) - { - for(uword row = 0; row < n_rows; ++row) - { - const uword Y_offset = row * Y_n_rows; - - for(uword col = 0; col < n_cols; ++col) - { - const uword X_offset = col * X_n_rows; - - Y[col + Y_offset] = X[row + X_offset]; - } - } - } - - - -template -inline -void -op_strans::apply_mat_noalias_large(Mat& out, const Mat& A) - { - arma_debug_sigprint(); - - const uword n_rows = A.n_rows; - const uword n_cols = A.n_cols; - - const uword block_size = 64; - - const uword n_rows_base = block_size * (n_rows / block_size); - const uword n_cols_base = block_size * (n_cols / block_size); - - const uword n_rows_extra = n_rows - n_rows_base; - const uword n_cols_extra = n_cols - n_cols_base; - - const eT* X = A.memptr(); - eT* Y = out.memptr(); - - for(uword row = 0; row < n_rows_base; row += block_size) - { - const uword Y_offset = row * n_cols; - - for(uword col = 0; col < n_cols_base; col += block_size) - { - const uword X_offset = col * n_rows; - - op_strans::block_worker(&Y[col + Y_offset], &X[row + X_offset], n_rows, n_cols, block_size, block_size); - } - - const uword X_offset = n_cols_base * n_rows; - - op_strans::block_worker(&Y[n_cols_base + Y_offset], &X[row + X_offset], n_rows, n_cols, block_size, n_cols_extra); - } - - if(n_rows_extra == 0) { return; } - - const uword Y_offset = n_rows_base * n_cols; - - for(uword col = 0; col < n_cols_base; col += block_size) - { - const uword X_offset = col * n_rows; - - op_strans::block_worker(&Y[col + Y_offset], &X[n_rows_base + X_offset], n_rows, n_cols, n_rows_extra, block_size); - } - - const uword X_offset = n_cols_base * n_rows; - - op_strans::block_worker(&Y[n_cols_base + Y_offset], &X[n_rows_base + X_offset], n_rows, n_cols, n_rows_extra, n_cols_extra); - } - - - -//! Immediate transpose of a dense matrix -template -inline -void -op_strans::apply_mat_noalias(Mat& out, const TA& A) - { - arma_debug_sigprint(); - - const uword A_n_cols = A.n_cols; - const uword A_n_rows = A.n_rows; - - out.set_size(A_n_cols, A_n_rows); - - if( (TA::is_row) || (TA::is_col) || (A_n_cols == 1) || (A_n_rows == 1) ) - { - arrayops::copy( out.memptr(), A.memptr(), A.n_elem ); - } - else - { - if( (A_n_rows <= 4) && (A_n_rows == A_n_cols) ) - { - op_strans::apply_mat_noalias_tinysq(out, A); - } - else - if( (A_n_rows >= 512) && (A_n_cols >= 512) ) - { - op_strans::apply_mat_noalias_large(out, A); - } - else - { - eT* outptr = out.memptr(); - - for(uword k=0; k < A_n_rows; ++k) - { - const eT* Aptr = &(A.at(k,0)); - - uword j; - for(j=1; j < A_n_cols; j+=2) - { - const eT tmp_i = (*Aptr); Aptr += A_n_rows; - const eT tmp_j = (*Aptr); Aptr += A_n_rows; - - (*outptr) = tmp_i; outptr++; - (*outptr) = tmp_j; outptr++; - } - - if((j-1) < A_n_cols) - { - (*outptr) = (*Aptr); outptr++;; - } - } - } - } - } - - - -template -inline -void -op_strans::apply_mat_inplace(Mat& out) - { - arma_debug_sigprint(); - - const uword n_rows = out.n_rows; - const uword n_cols = out.n_cols; - - if(n_rows == n_cols) - { - arma_debug_print("op_strans::apply_mat_inplace(): square matrix"); - - const uword N = n_rows; - - for(uword k=0; k < N; ++k) - { - eT* colptr = &(out.at(k,k)); - eT* rowptr = colptr; - - colptr++; - rowptr += N; - - uword j; - - for(j=(k+2); j < N; j+=2) - { - std::swap( (*rowptr), (*colptr) ); rowptr += N; colptr++; - std::swap( (*rowptr), (*colptr) ); rowptr += N; colptr++; - } - - if((j-1) < N) - { - std::swap( (*rowptr), (*colptr) ); - } - } - } - else - { - if( ((n_rows == 1) || (n_cols == 1)) && (out.vec_state == 0) && (out.mem_state == 0) ) - { - arma_debug_print("op_strans::apply_mat_inplace(): swapping n_rows and n_cols"); - - access::rw(out.n_rows) = n_cols; - access::rw(out.n_cols) = n_rows; - } - else - { - Mat tmp; - - op_strans::apply_mat_noalias(tmp, out); - - out.steal_mem(tmp); - } - } - } - - - -template -inline -void -op_strans::apply_mat(Mat& out, const TA& A) - { - arma_debug_sigprint(); - - if(&out != &A) - { - op_strans::apply_mat_noalias(out, A); - } - else - { - op_strans::apply_mat_inplace(out); - } - } - - - -template -inline -void -op_strans::apply_proxy(Mat& out, const Proxy& P) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - if( (resolves_to_vector::yes) && (Proxy::use_at == false) ) - { - out.set_size(n_cols, n_rows); - - eT* out_mem = out.memptr(); - - const uword n_elem = P.get_n_elem(); - - typename Proxy::ea_type Pea = P.get_ea(); - - uword i,j; - for(i=0, j=1; j < n_elem; i+=2, j+=2) - { - const eT tmp_i = Pea[i]; - const eT tmp_j = Pea[j]; - - out_mem[i] = tmp_i; - out_mem[j] = tmp_j; - } - - if(i < n_elem) - { - out_mem[i] = Pea[i]; - } - } - else // general matrix transpose - { - out.set_size(n_cols, n_rows); - - eT* outptr = out.memptr(); - - for(uword k=0; k < n_rows; ++k) - { - uword j; - for(j=1; j < n_cols; j+=2) - { - const uword i = j-1; - - const eT tmp_i = P.at(k,i); - const eT tmp_j = P.at(k,j); - - (*outptr) = tmp_i; outptr++; - (*outptr) = tmp_j; outptr++; - } - - const uword i = j-1; - - if(i < n_cols) - { - (*outptr) = P.at(k,i); outptr++; - } - } - } - } - - - -template -inline -void -op_strans::apply_direct(Mat& out, const T1& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - // allow detection of in-place transpose - if(is_Mat::value || (arma_config::openmp && Proxy::use_mp)) - { - const unwrap U(X); - - op_strans::apply_mat(out, U.M); - } - else - { - const Proxy P(X); - - const bool is_alias = P.is_alias(out); - - if(is_Mat::stored_type>::value) - { - const quasi_unwrap::stored_type> U(P.Q); - - if(is_alias) - { - Mat tmp; - - op_strans::apply_mat_noalias(tmp, U.M); - - out.steal_mem(tmp); - } - else - { - op_strans::apply_mat_noalias(out, U.M); - } - } - else - { - if(is_alias) - { - Mat tmp; - - op_strans::apply_proxy(tmp, P); - - out.steal_mem(tmp); - } - else - { - op_strans::apply_proxy(out, P); - } - } - } - } - - - -template -inline -void -op_strans::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - op_strans::apply_direct(out, in.m); - } - - - -// -// -// - - - -template -inline -void -op_strans_cube::apply_noalias(Cube& out, const Cube& X) - { - out.set_size(X.n_cols, X.n_rows, X.n_slices); - - for(uword s=0; s < X.n_slices; ++s) - { - Mat out_slice( out.slice_memptr(s), X.n_cols, X.n_rows, false, true ); - - const Mat X_slice( const_cast(X.slice_memptr(s)), X.n_rows, X.n_cols, false, true ); - - op_strans::apply_mat_noalias(out_slice, X_slice); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sum_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sum_bones.hpp deleted file mode 100644 index a72c78695..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sum_bones.hpp +++ /dev/null @@ -1,59 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sum -//! @{ - - -class op_sum - : public traits_op_xvec - { - public: - - // dense matrices - - template - arma_hot inline static void apply(Mat& out, const Op& in); - - template - arma_hot inline static void apply_noalias(Mat& out, const Proxy& P, const uword dim); - - template - arma_hot inline static void apply_noalias_unwrap(Mat& out, const Proxy& P, const uword dim); - - template - arma_hot inline static void apply_noalias_proxy(Mat& out, const Proxy& P, const uword dim); - - - // cubes - - template - arma_hot inline static void apply(Cube& out, const OpCube& in); - - template - arma_hot inline static void apply_noalias(Cube& out, const ProxyCube& P, const uword dim); - - template - arma_hot inline static void apply_noalias_unwrap(Cube& out, const ProxyCube& P, const uword dim); - - template - arma_hot inline static void apply_noalias_proxy(Cube& out, const ProxyCube& P, const uword dim); - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sum_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sum_meat.hpp deleted file mode 100644 index 16becb363..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_sum_meat.hpp +++ /dev/null @@ -1,430 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_sum -//! @{ - - - -template -inline -void -op_sum::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword dim = in.aux_uword_a; - arma_conform_check( (dim > 1), "sum(): parameter 'dim' must be 0 or 1" ); - - const Proxy P(in.m); - - if(P.is_alias(out) == false) - { - op_sum::apply_noalias(out, P, dim); - } - else - { - Mat tmp; - - op_sum::apply_noalias(tmp, P, dim); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -op_sum::apply_noalias(Mat& out, const Proxy& P, const uword dim) - { - arma_debug_sigprint(); - - if(is_Mat::stored_type>::value || (arma_config::openmp && Proxy::use_mp)) - { - op_sum::apply_noalias_unwrap(out, P, dim); - } - else - { - op_sum::apply_noalias_proxy(out, P, dim); - } - } - - - -template -inline -void -op_sum::apply_noalias_unwrap(Mat& out, const Proxy& P, const uword dim) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - typedef typename Proxy::stored_type P_stored_type; - - const unwrap tmp(P.Q); - - const typename unwrap::stored_type& X = tmp.M; - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - const uword out_n_rows = (dim == 0) ? uword(1) : X_n_rows; - const uword out_n_cols = (dim == 0) ? X_n_cols : uword(1); - - out.set_size(out_n_rows, out_n_cols); - - if(X.n_elem == 0) { out.zeros(); return; } - - const eT* X_colptr = X.memptr(); - eT* out_mem = out.memptr(); - - if(dim == 0) - { - for(uword col=0; col < X_n_cols; ++col) - { - out_mem[col] = arrayops::accumulate( X_colptr, X_n_rows ); - - X_colptr += X_n_rows; - } - } - else - { - arrayops::copy(out_mem, X_colptr, X_n_rows); - - X_colptr += X_n_rows; - - for(uword col=1; col < X_n_cols; ++col) - { - arrayops::inplace_plus( out_mem, X_colptr, X_n_rows ); - - X_colptr += X_n_rows; - } - } - } - - - -template -inline -void -op_sum::apply_noalias_proxy(Mat& out, const Proxy& P, const uword dim) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword P_n_rows = P.get_n_rows(); - const uword P_n_cols = P.get_n_cols(); - - const uword out_n_rows = (dim == 0) ? uword(1) : P_n_rows; - const uword out_n_cols = (dim == 0) ? P_n_cols : uword(1); - - out.set_size(out_n_rows, out_n_cols); - - if(P.get_n_elem() == 0) { out.zeros(); return; } - - eT* out_mem = out.memptr(); - - if(Proxy::use_at == false) - { - if(dim == 0) - { - uword count = 0; - - for(uword col=0; col < P_n_cols; ++col) - { - eT val1 = eT(0); - eT val2 = eT(0); - - uword j; - for(j=1; j < P_n_rows; j+=2) - { - val1 += P[count]; ++count; - val2 += P[count]; ++count; - } - - if((j-1) < P_n_rows) - { - val1 += P[count]; ++count; - } - - out_mem[col] = (val1 + val2); - } - } - else - { - uword count = 0; - - for(uword row=0; row < P_n_rows; ++row) - { - out_mem[row] = P[count]; ++count; - } - - for(uword col=1; col < P_n_cols; ++col) - for(uword row=0; row < P_n_rows; ++row) - { - out_mem[row] += P[count]; ++count; - } - } - } - else - { - if(dim == 0) - { - for(uword col=0; col < P_n_cols; ++col) - { - eT val1 = eT(0); - eT val2 = eT(0); - - uword i,j; - for(i=0, j=1; j < P_n_rows; i+=2, j+=2) - { - val1 += P.at(i,col); - val2 += P.at(j,col); - } - - if(i < P_n_rows) - { - val1 += P.at(i,col); - } - - out_mem[col] = (val1 + val2); - } - } - else - { - for(uword row=0; row < P_n_rows; ++row) - { - out_mem[row] = P.at(row,0); - } - - for(uword col=1; col < P_n_cols; ++col) - for(uword row=0; row < P_n_rows; ++row) - { - out_mem[row] += P.at(row,col); - } - } - } - } - - - -// -// cubes - - - -template -inline -void -op_sum::apply(Cube& out, const OpCube& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword dim = in.aux_uword_a; - arma_conform_check( (dim > 2), "sum(): parameter 'dim' must be 0 or 1 or 2" ); - - const ProxyCube P(in.m); - - if(P.is_alias(out) == false) - { - op_sum::apply_noalias(out, P, dim); - } - else - { - Cube tmp; - - op_sum::apply_noalias(tmp, P, dim); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -op_sum::apply_noalias(Cube& out, const ProxyCube& P, const uword dim) - { - arma_debug_sigprint(); - - if(is_Cube::stored_type>::value || (arma_config::openmp && ProxyCube::use_mp)) - { - op_sum::apply_noalias_unwrap(out, P, dim); - } - else - { - op_sum::apply_noalias_proxy(out, P, dim); - } - } - - - -template -inline -void -op_sum::apply_noalias_unwrap(Cube& out, const ProxyCube& P, const uword dim) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - typedef typename ProxyCube::stored_type P_stored_type; - - const unwrap_cube tmp(P.Q); - - const Cube& X = tmp.M; - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - const uword X_n_slices = X.n_slices; - - if(dim == 0) - { - out.set_size(1, X_n_cols, X_n_slices); - - for(uword slice=0; slice < X_n_slices; ++slice) - { - eT* out_mem = out.slice_memptr(slice); - - for(uword col=0; col < X_n_cols; ++col) - { - out_mem[col] = arrayops::accumulate( X.slice_colptr(slice,col), X_n_rows ); - } - } - } - else - if(dim == 1) - { - out.zeros(X_n_rows, 1, X_n_slices); - - for(uword slice=0; slice < X_n_slices; ++slice) - { - eT* out_mem = out.slice_memptr(slice); - - for(uword col=0; col < X_n_cols; ++col) - { - arrayops::inplace_plus( out_mem, X.slice_colptr(slice,col), X_n_rows ); - } - } - } - else - if(dim == 2) - { - out.zeros(X_n_rows, X_n_cols, 1); - - eT* out_mem = out.memptr(); - - for(uword slice=0; slice < X_n_slices; ++slice) - { - arrayops::inplace_plus(out_mem, X.slice_memptr(slice), X.n_elem_slice ); - } - } - } - - - -template -inline -void -op_sum::apply_noalias_proxy(Cube& out, const ProxyCube& P, const uword dim) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword P_n_rows = P.get_n_rows(); - const uword P_n_cols = P.get_n_cols(); - const uword P_n_slices = P.get_n_slices(); - - if(dim == 0) - { - out.set_size(1, P_n_cols, P_n_slices); - - for(uword slice=0; slice < P_n_slices; ++slice) - { - eT* out_mem = out.slice_memptr(slice); - - for(uword col=0; col < P_n_cols; ++col) - { - eT val1 = eT(0); - eT val2 = eT(0); - - uword i,j; - for(i=0, j=1; j < P_n_rows; i+=2, j+=2) - { - val1 += P.at(i,col,slice); - val2 += P.at(j,col,slice); - } - - if(i < P_n_rows) - { - val1 += P.at(i,col,slice); - } - - out_mem[col] = (val1 + val2); - } - } - } - else - if(dim == 1) - { - out.zeros(P_n_rows, 1, P_n_slices); - - for(uword slice=0; slice < P_n_slices; ++slice) - { - eT* out_mem = out.slice_memptr(slice); - - for(uword col=0; col < P_n_cols; ++col) - for(uword row=0; row < P_n_rows; ++row) - { - out_mem[row] += P.at(row,col,slice); - } - } - } - else - if(dim == 2) - { - out.zeros(P_n_rows, P_n_cols, 1); - - for(uword slice=0; slice < P_n_slices; ++slice) - { - for(uword col=0; col < P_n_cols; ++col) - { - eT* out_mem = out.slice_colptr(0,col); - - for(uword row=0; row < P_n_rows; ++row) - { - out_mem[row] += P.at(row,col,slice); - } - } - } - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_symmat_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_symmat_bones.hpp deleted file mode 100644 index 1e07f0e2a..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_symmat_bones.hpp +++ /dev/null @@ -1,68 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_symmat -//! @{ - - - -class op_symmatu - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& in); - }; - - - -class op_symmatl - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& in); - }; - - - -class op_symmatu_cx - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& in); - }; - - - -class op_symmatl_cx - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& in); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_symmat_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_symmat_meat.hpp deleted file mode 100644 index cc1e6d458..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_symmat_meat.hpp +++ /dev/null @@ -1,278 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_symmat -//! @{ - - - -template -inline -void -op_symmatu::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap tmp(in.m); - const Mat& A = tmp.M; - - arma_conform_check( (A.is_square() == false), "symmatu(): given matrix must be square sized" ); - - const uword N = A.n_rows; - - if(&out != &A) - { - out.copy_size(A); - - // upper triangular: copy the diagonal and the elements above the diagonal - - for(uword i=0; i -inline -void -op_symmatl::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap tmp(in.m); - const Mat& A = tmp.M; - - arma_conform_check( (A.is_square() == false), "symmatl(): given matrix must be square sized" ); - - const uword N = A.n_rows; - - if(&out != &A) - { - out.copy_size(A); - - // lower triangular: copy the diagonal and the elements below the diagonal - - for(uword i=0; i -inline -void -op_symmatu_cx::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap tmp(in.m); - const Mat& A = tmp.M; - - arma_conform_check( (A.is_square() == false), "symmatu(): given matrix must be square sized" ); - - const uword N = A.n_rows; - - const bool do_conj = (in.aux_uword_b == 1); - - if(&out != &A) - { - out.copy_size(A); - - // upper triangular: copy the diagonal and the elements above the diagonal - - for(uword i=0; i -inline -void -op_symmatl_cx::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap tmp(in.m); - const Mat& A = tmp.M; - - arma_conform_check( (A.is_square() == false), "symmatl(): given matrix must be square sized" ); - - const uword N = A.n_rows; - - const bool do_conj = (in.aux_uword_b == 1); - - if(&out != &A) - { - out.copy_size(A); - - // lower triangular: copy the diagonal and the elements below the diagonal - - for(uword i=0; i - inline static void apply(Mat& out, const Op& in); - }; - - - -class op_toeplitz_c - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& in); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_toeplitz_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_toeplitz_meat.hpp deleted file mode 100644 index a1f96c45e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_toeplitz_meat.hpp +++ /dev/null @@ -1,110 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_toeplitz -//! @{ - - - -template -inline -void -op_toeplitz::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_check tmp(in.m, out); - const Mat& X = tmp.M; - - arma_conform_check( ((X.is_vec() == false) && (X.is_empty() == false)), "toeplitz(): given object must be a vector" ); - - const uword N = X.n_elem; - const eT* X_mem = X.memptr(); - - out.set_size(N,N); - - for(uword col=0; col < N; ++col) - { - eT* col_mem = out.colptr(col); - - uword i; - - i = col; - for(uword row=0; row < col; ++row, --i) { col_mem[row] = X_mem[i]; } - - i = 0; - for(uword row=col; row < N; ++row, ++i) { col_mem[row] = X_mem[i]; } - } - } - - - -template -inline -void -op_toeplitz_c::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_check tmp(in.m, out); - const Mat& X = tmp.M; - - arma_conform_check( ((X.is_vec() == false) && (X.is_empty() == false)), "circ_toeplitz(): given object must be a vector" ); - - const uword N = X.n_elem; - const eT* X_mem = X.memptr(); - - out.set_size(N,N); - - if(X.is_rowvec()) - { - for(uword row=0; row < N; ++row) - { - uword i; - - i = row; - for(uword col=0; col < row; ++col, --i) { out.at(row,col) = X_mem[N-i]; } - - i = 0; - for(uword col=row; col < N; ++col, ++i) { out.at(row,col) = X_mem[i]; } - } - } - else - { - for(uword col=0; col < N; ++col) - { - eT* col_mem = out.colptr(col); - - uword i; - - i = col; - for(uword row=0; row < col; ++row, --i) { col_mem[row] = X_mem[N-i]; } - - i = 0; - for(uword row=col; row < N; ++row, ++i) { col_mem[row] = X_mem[i]; } - } - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_trimat_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_trimat_bones.hpp deleted file mode 100644 index f500cbd43..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_trimat_bones.hpp +++ /dev/null @@ -1,76 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_trimat -//! @{ - - - -// NOTE: don't split op_trimat into seperate op_trimatu and op_trimatl classes, -// NOTE: as several instances elsewhere rely on trimatu() and trimatl() producing the same type -class op_trimat - : public traits_op_default - { - public: - - template - inline static void fill_zeros(Mat& A, const bool upper); - - // - - template - inline static void apply(Mat& out, const Op& in); - - template - inline static void apply_unwrap(Mat& out, const Mat& A, const bool upper); - - template - inline static void apply_proxy(Mat& out, const Proxy& P, const bool upper); - }; - - - -class op_trimatu_ext - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& in); - - template - inline static void fill_zeros(Mat& A, const uword row_offset, const uword col_offset); - }; - - - -class op_trimatl_ext - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& in); - - template - inline static void fill_zeros(Mat& A, const uword row_offset, const uword col_offset); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_trimat_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_trimat_meat.hpp deleted file mode 100644 index 76b13d7ca..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_trimat_meat.hpp +++ /dev/null @@ -1,381 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_trimat -//! @{ - - - -template -inline -void -op_trimat::fill_zeros(Mat& out, const bool upper) - { - arma_debug_sigprint(); - - const uword N = out.n_rows; - - if(upper) - { - // upper triangular: set all elements below the diagonal to zero - - for(uword i=0; i -inline -void -op_trimat::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const bool upper = (in.aux_uword_a == 0); - - // allow detection of in-place operation - if(is_Mat::value || (arma_config::openmp && Proxy::use_mp)) - { - const unwrap U(in.m); - - op_trimat::apply_unwrap(out, U.M, upper); - } - else - { - const Proxy P(in.m); - - const bool is_alias = P.is_alias(out); - - if(is_Mat::stored_type>::value) - { - const quasi_unwrap::stored_type> U(P.Q); - - if(is_alias) - { - Mat tmp; - - op_trimat::apply_unwrap(tmp, U.M, upper); - - out.steal_mem(tmp); - } - else - { - op_trimat::apply_unwrap(out, U.M, upper); - } - } - else - { - if(is_alias) - { - Mat tmp; - - op_trimat::apply_proxy(tmp, P, upper); - - out.steal_mem(tmp); - } - else - { - op_trimat::apply_proxy(out, P, upper); - } - } - } - } - - - -template -inline -void -op_trimat::apply_unwrap(Mat& out, const Mat& A, const bool upper) - { - arma_debug_sigprint(); - - arma_conform_check( (A.is_square() == false), "trimatu()/trimatl(): given matrix must be square sized" ); - - if(&out != &A) - { - out.copy_size(A); - - const uword N = A.n_rows; - - if(upper) - { - // upper triangular: copy the diagonal and the elements above the diagonal - for(uword i=0; i -inline -void -op_trimat::apply_proxy(Mat& out, const Proxy& P, const bool upper) - { - arma_debug_sigprint(); - - arma_conform_check( (P.get_n_rows() != P.get_n_cols()), "trimatu()/trimatl(): given matrix must be square sized" ); - - const uword N = P.get_n_rows(); - - out.set_size(N,N); - - if(upper) - { - for(uword j=0; j < N; ++j) - for(uword i=0; i < (j+1); ++i) - { - out.at(i,j) = P.at(i,j); - } - } - else - { - for(uword j=0; j -inline -void -op_trimatu_ext::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap tmp(in.m); - const Mat& A = tmp.M; - - arma_conform_check( (A.is_square() == false), "trimatu(): given matrix must be square sized" ); - - const uword row_offset = in.aux_uword_a; - const uword col_offset = in.aux_uword_b; - - const uword n_rows = A.n_rows; - const uword n_cols = A.n_cols; - - arma_conform_check_bounds( ((row_offset > 0) && (row_offset >= n_rows)) || ((col_offset > 0) && (col_offset >= n_cols)), "trimatu(): requested diagonal is out of bounds" ); - - if(&out != &A) - { - out.copy_size(A); - - const uword N = (std::min)(n_rows - row_offset, n_cols - col_offset); - - for(uword i=0; i < n_cols; ++i) - { - const uword col = i + col_offset; - - if(i < N) - { - const uword end_row = i + row_offset; - - for(uword row=0; row <= end_row; ++row) - { - out.at(row,col) = A.at(row,col); - } - } - else - { - if(col < n_cols) - { - arrayops::copy(out.colptr(col), A.colptr(col), n_rows); - } - } - } - } - - op_trimatu_ext::fill_zeros(out, row_offset, col_offset); - } - - - -template -inline -void -op_trimatu_ext::fill_zeros(Mat& out, const uword row_offset, const uword col_offset) - { - arma_debug_sigprint(); - - const uword n_rows = out.n_rows; - const uword n_cols = out.n_cols; - - const uword N = (std::min)(n_rows - row_offset, n_cols - col_offset); - - for(uword col=0; col < col_offset; ++col) - { - arrayops::fill_zeros(out.colptr(col), n_rows); - } - - for(uword i=0; i < N; ++i) - { - const uword start_row = i + row_offset + 1; - const uword col = i + col_offset; - - for(uword row=start_row; row < n_rows; ++row) - { - out.at(row,col) = eT(0); - } - } - } - - - -// - - - -template -inline -void -op_trimatl_ext::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap tmp(in.m); - const Mat& A = tmp.M; - - arma_conform_check( (A.is_square() == false), "trimatl(): given matrix must be square sized" ); - - const uword row_offset = in.aux_uword_a; - const uword col_offset = in.aux_uword_b; - - const uword n_rows = A.n_rows; - const uword n_cols = A.n_cols; - - arma_conform_check_bounds( ((row_offset > 0) && (row_offset >= n_rows)) || ((col_offset > 0) && (col_offset >= n_cols)), "trimatl(): requested diagonal is out of bounds" ); - - if(&out != &A) - { - out.copy_size(A); - - const uword N = (std::min)(n_rows - row_offset, n_cols - col_offset); - - for(uword col=0; col < col_offset; ++col) - { - arrayops::copy( out.colptr(col), A.colptr(col), n_rows ); - } - - for(uword i=0; i -inline -void -op_trimatl_ext::fill_zeros(Mat& out, const uword row_offset, const uword col_offset) - { - arma_debug_sigprint(); - - const uword n_rows = out.n_rows; - const uword n_cols = out.n_cols; - - const uword N = (std::min)(n_rows - row_offset, n_cols - col_offset); - - for(uword i=0; i < n_cols; ++i) - { - const uword col = i + col_offset; - - if(i < N) - { - const uword end_row = i + row_offset; - - for(uword row=0; row < end_row; ++row) - { - out.at(row,col) = eT(0); - } - } - else - { - if(col < n_cols) - { - arrayops::fill_zeros(out.colptr(col), n_rows); - } - } - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_unique_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_unique_bones.hpp deleted file mode 100644 index 7e7bb6925..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_unique_bones.hpp +++ /dev/null @@ -1,79 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_unique -//! @{ - - - -class op_unique - : public traits_op_col - { - public: - - template - inline static bool apply_helper(Mat& out, const Proxy& P, const bool P_is_row); - - template - inline static void apply(Mat& out, const Op& in); - }; - - - -class op_unique_vec - : public traits_op_passthru - { - public: - - template - inline static void apply(Mat& out, const Op& in); - }; - - - -template -struct arma_unique_comparator - { - arma_inline - bool - operator() (const eT a, const eT b) const - { - return ( a < b ); - } - }; - - - -template -struct arma_unique_comparator< std::complex > - { - arma_inline - bool - operator() (const std::complex& a, const std::complex& b) const - { - const T a_real = a.real(); - const T b_real = b.real(); - - return ( (a_real < b_real) ? true : ((a_real == b_real) ? (a.imag() < b.imag()) : false) ); - } - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_unique_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_unique_meat.hpp deleted file mode 100644 index 66a3e3925..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_unique_meat.hpp +++ /dev/null @@ -1,174 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_unique -//! @{ - - - -template -inline -bool -op_unique::apply_helper(Mat& out, const Proxy& P, const bool P_is_row) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_elem = P.get_n_elem(); - - if(n_elem == 0) - { - if(P_is_row) - { - out.set_size(1,0); - } - else - { - out.set_size(0,1); - } - - return true; - } - - if(n_elem == 1) - { - const eT tmp = (Proxy::use_at) ? P.at(0,0) : P[0]; - - out.set_size(1, 1); - - out[0] = tmp; - - return true; - } - - Mat X(n_elem, 1, arma_nozeros_indicator()); - - eT* X_mem = X.memptr(); - - if(Proxy::use_at == false) - { - typename Proxy::ea_type Pea = P.get_ea(); - - for(uword i=0; i comparator; - - std::sort( X.begin(), X.end(), comparator ); - - uword N_unique = 1; - - for(uword i=1; i < n_elem; ++i) - { - const eT a = X_mem[i-1]; - const eT b = X_mem[i ]; - - const eT diff = a - b; - - if(diff != eT(0)) { ++N_unique; } - } - - if(P_is_row) - { - out.set_size(1, N_unique); - } - else - { - out.set_size(N_unique, 1); - } - - eT* out_mem = out.memptr(); - - if(n_elem > 0) { (*out_mem) = X_mem[0]; out_mem++; } - - for(uword i=1; i < n_elem; ++i) - { - const eT a = X_mem[i-1]; - const eT b = X_mem[i ]; - - const eT diff = a - b; - - if(diff != eT(0)) { (*out_mem) = b; out_mem++; } - } - - return true; - } - - - -template -inline -void -op_unique::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - const Proxy P(in.m); - - const bool all_non_nan = op_unique::apply_helper(out, P, false); - - arma_conform_check( (all_non_nan == false), "unique(): detected NaN" ); - } - - - -template -inline -void -op_unique_vec::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - const Proxy P(in.m); - - const bool P_is_row = (T1::is_xvec) ? bool(P.get_n_rows() == 1) : bool(T1::is_row); - - const bool all_non_nan = op_unique::apply_helper(out, P, P_is_row); - - arma_conform_check( (all_non_nan == false), "unique(): detected NaN" ); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_var_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_var_bones.hpp deleted file mode 100644 index ee13bd483..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_var_bones.hpp +++ /dev/null @@ -1,67 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_var -//! @{ - - - -class op_var - : public traits_op_xvec - { - public: - - template - inline static void apply(Mat& out, const mtOp& in); - - template - inline static void apply_noalias(Mat::result>& out, const Mat& X, const uword norm_type, const uword dim); - - // - - template - inline static typename get_pod_type::result var_vec(const subview_col& X, const uword norm_type = 0); - - template - inline static typename get_pod_type::result var_vec(const subview_row& X, const uword norm_type = 0); - - template - inline static typename T1::pod_type var_vec(const Base& X, const uword norm_type = 0); - - - // - - template - inline static eT direct_var(const eT* const X, const uword N, const uword norm_type = 0); - - template - inline static eT direct_var_robust(const eT* const X, const uword N, const uword norm_type = 0); - - - // - - template - inline static T direct_var(const std::complex* const X, const uword N, const uword norm_type = 0); - - template - inline static T direct_var_robust(const std::complex* const X, const uword N, const uword norm_type = 0); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_var_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_var_meat.hpp deleted file mode 100644 index 64d82d046..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_var_meat.hpp +++ /dev/null @@ -1,357 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_var -//! @{ - - - -template -inline -void -op_var::apply(Mat& out, const mtOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type out_eT; - - const uword norm_type = in.aux_uword_a; - const uword dim = in.aux_uword_b; - - arma_conform_check( (norm_type > 1), "var(): parameter 'norm_type' must be 0 or 1" ); - arma_conform_check( (dim > 1), "var(): parameter 'dim' must be 0 or 1" ); - - const quasi_unwrap U(in.m); - - if(U.is_alias(out)) - { - Mat tmp; - - op_var::apply_noalias(tmp, U.M, norm_type, dim); - - out.steal_mem(tmp); - } - else - { - op_var::apply_noalias(out, U.M, norm_type, dim); - } - } - - - -template -inline -void -op_var::apply_noalias(Mat::result>& out, const Mat& X, const uword norm_type, const uword dim) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result out_eT; - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(dim == 0) - { - arma_debug_print("op_var::apply_noalias(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols); - - if(X_n_rows > 0) - { - out_eT* out_mem = out.memptr(); - - for(uword col=0; col 0) ? 1 : 0); - - if(X_n_cols > 0) - { - podarray dat(X_n_cols); - - in_eT* dat_mem = dat.memptr(); - out_eT* out_mem = out.memptr(); - - for(uword row=0; row -inline -typename T1::pod_type -op_var::var_vec(const Base& X, const uword norm_type) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - - arma_conform_check( (norm_type > 1), "var(): parameter 'norm_type' must be 0 or 1" ); - - const quasi_unwrap U(X.get_ref()); - - if(U.M.n_elem == 0) - { - arma_conform_check(true, "var(): object has no elements"); - - return Datum::nan; - } - - return op_var::direct_var(U.M.memptr(), U.M.n_elem, norm_type); - } - - - -template -inline -typename get_pod_type::result -op_var::var_vec(const subview_col& X, const uword norm_type) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - arma_conform_check( (norm_type > 1), "var(): parameter 'norm_type' must be 0 or 1" ); - - if(X.n_elem == 0) - { - arma_conform_check(true, "var(): object has no elements"); - - return Datum::nan; - } - - return op_var::direct_var(X.colptr(0), X.n_rows, norm_type); - } - - - - -template -inline -typename get_pod_type::result -op_var::var_vec(const subview_row& X, const uword norm_type) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - arma_conform_check( (norm_type > 1), "var(): parameter 'norm_type' must be 0 or 1" ); - - if(X.n_elem == 0) - { - arma_conform_check(true, "var(): object has no elements"); - - return Datum::nan; - } - - const Mat& A = X.m; - - const uword start_row = X.aux_row1; - const uword start_col = X.aux_col1; - - const uword end_col_p1 = start_col + X.n_cols; - - podarray tmp(X.n_elem); - eT* tmp_mem = tmp.memptr(); - - for(uword i=0, col=start_col; col < end_col_p1; ++col, ++i) - { - tmp_mem[i] = A.at(start_row, col); - } - - return op_var::direct_var(tmp.memptr(), tmp.n_elem, norm_type); - } - - - -//! find the variance of an array -template -inline -eT -op_var::direct_var(const eT* const X, const uword n_elem, const uword norm_type) - { - arma_debug_sigprint(); - - if(n_elem >= 2) - { - const eT acc1 = op_mean::direct_mean(X, n_elem); - - eT acc2 = eT(0); - eT acc3 = eT(0); - - uword i,j; - - for(i=0, j=1; j -inline -eT -op_var::direct_var_robust(const eT* const X, const uword n_elem, const uword norm_type) - { - arma_debug_sigprint(); - - if(n_elem > 1) - { - eT r_mean = X[0]; - eT r_var = eT(0); - - for(uword i=1; i -inline -T -op_var::direct_var(const std::complex* const X, const uword n_elem, const uword norm_type) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - if(n_elem >= 2) - { - const eT acc1 = op_mean::direct_mean(X, n_elem); - - T acc2 = T(0); - eT acc3 = eT(0); - - for(uword i=0; i -inline -T -op_var::direct_var_robust(const std::complex* const X, const uword n_elem, const uword norm_type) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - if(n_elem > 1) - { - eT r_mean = X[0]; - T r_var = T(0); - - for(uword i=1; i - inline static void apply(Mat& out, const mtOp& in); - - template - inline static void apply_noalias(Mat::result>& out, const Mat& X, const uword k, const uword dim); - - template - inline static void apply_rawmem(typename get_pod_type::result& out_val, const in_eT* mem, const uword N, const uword k); - }; - - -class op_vecnorm_ext - : public traits_op_xvec - { - public: - - template - inline static void apply(Mat& out, const mtOp& in); - - template - inline static void apply_noalias(Mat::result>& out, const Mat& X, const uword method_id, const uword dim); - - template - inline static void apply_rawmem(typename get_pod_type::result& out_val, const in_eT* mem, const uword N, const uword method_id); - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_vecnorm_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_vecnorm_meat.hpp deleted file mode 100644 index 8e5ee1729..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_vecnorm_meat.hpp +++ /dev/null @@ -1,254 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_vecnorm -//! @{ - - - -template -inline -void -op_vecnorm::apply(Mat& out, const mtOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type in_eT; - typedef typename T1::pod_type out_eT; - - const quasi_unwrap U(in.m); - const Mat& X = U.M; - - const uword k = in.aux_uword_a; - const uword dim = in.aux_uword_b; - - arma_conform_check( (k == 0), "vecnorm(): unsupported vector norm type" ); - arma_conform_check( (dim > 1), "vecnorm(): parameter 'dim' must be 0 or 1" ); - - if(U.is_alias(out)) - { - Mat tmp; - - op_vecnorm::apply_noalias(tmp, X, k, dim); - - out.steal_mem(tmp); - } - else - { - op_vecnorm::apply_noalias(out, X, k, dim); - } - } - - - - -template -inline -void -op_vecnorm::apply_noalias(Mat::result>& out, const Mat& X, const uword k, const uword dim) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result out_eT; - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(dim == 0) - { - arma_debug_print("op_vecnorm::apply(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols); - - if(X_n_rows > 0) - { - out_eT* out_mem = out.memptr(); - - for(uword col=0; col < X_n_cols; ++col) - { - op_vecnorm::apply_rawmem( out_mem[col], X.colptr(col), X_n_rows, k ); - } - } - } - else - if(dim == 1) - { - arma_debug_print("op_vecnorm::apply(): dim = 1"); - - out.set_size(X_n_rows, (X_n_cols > 0) ? 1 : 0); - - if(X_n_cols > 0) - { - podarray dat(X_n_cols); - - in_eT* dat_mem = dat.memptr(); - out_eT* out_mem = out.memptr(); - - for(uword row=0; row < X_n_rows; ++row) - { - dat.copy_row(X, row); - - op_vecnorm::apply_rawmem( out_mem[row], dat_mem, X_n_cols, k ); - } - } - } - } - - - -template -inline -void -op_vecnorm::apply_rawmem(typename get_pod_type::result& out_val, const in_eT* mem, const uword N, const uword k) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result out_eT; - - const Col tmp(const_cast(mem), N, false, false); - - const Proxy< Col > P(tmp); - - if(P.get_n_elem() == 0) { out_val = out_eT(0); return; } - - if(k == uword(1)) { out_val = op_norm::vec_norm_1(P); return; } - if(k == uword(2)) { out_val = op_norm::vec_norm_2(P); return; } - - out_val = op_norm::vec_norm_k(P, int(k)); - } - - - -// - - - -template -inline -void -op_vecnorm_ext::apply(Mat& out, const mtOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type in_eT; - typedef typename T1::pod_type out_eT; - - const quasi_unwrap U(in.m); - const Mat& X = U.M; - - const uword method_id = in.aux_uword_a; - const uword dim = in.aux_uword_b; - - arma_conform_check( (method_id == 0), "vecnorm(): unsupported vector norm type" ); - arma_conform_check( (dim > 1), "vecnorm(): parameter 'dim' must be 0 or 1" ); - - if(U.is_alias(out)) - { - Mat tmp; - - op_vecnorm_ext::apply_noalias(tmp, X, method_id, dim); - - out.steal_mem(tmp); - } - else - { - op_vecnorm_ext::apply_noalias(out, X, method_id, dim); - } - } - - - - -template -inline -void -op_vecnorm_ext::apply_noalias(Mat::result>& out, const Mat& X, const uword method_id, const uword dim) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result out_eT; - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - if(dim == 0) - { - arma_debug_print("op_vecnorm_ext::apply(): dim = 0"); - - out.set_size((X_n_rows > 0) ? 1 : 0, X_n_cols); - - if(X_n_rows > 0) - { - out_eT* out_mem = out.memptr(); - - for(uword col=0; col < X_n_cols; ++col) - { - op_vecnorm_ext::apply_rawmem( out_mem[col], X.colptr(col), X_n_rows, method_id ); - } - } - } - else - if(dim == 1) - { - arma_debug_print("op_vecnorm_ext::apply(): dim = 1"); - - out.set_size(X_n_rows, (X_n_cols > 0) ? 1 : 0); - - if(X_n_cols > 0) - { - podarray dat(X_n_cols); - - in_eT* dat_mem = dat.memptr(); - out_eT* out_mem = out.memptr(); - - for(uword row=0; row < X_n_rows; ++row) - { - dat.copy_row(X, row); - - op_vecnorm_ext::apply_rawmem( out_mem[row], dat_mem, X_n_cols, method_id ); - } - } - } - } - - - -template -inline -void -op_vecnorm_ext::apply_rawmem(typename get_pod_type::result& out_val, const in_eT* mem, const uword N, const uword method_id) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result out_eT; - - const Col tmp(const_cast(mem), N, false, false); - - const Proxy< Col > P(tmp); - - if(P.get_n_elem() == 0) { out_val = out_eT(0); return; } - - if(method_id == uword(1)) { out_val = op_norm::vec_norm_max(P); return; } - if(method_id == uword(2)) { out_val = op_norm::vec_norm_min(P); return; } - - out_val = out_eT(0); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_vectorise_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_vectorise_bones.hpp deleted file mode 100644 index 91f7df7c9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_vectorise_bones.hpp +++ /dev/null @@ -1,81 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_vectorise -//! @{ - - - -class op_vectorise_col - : public traits_op_col - { - public: - - template inline static void apply(Mat& out, const Op& in); - - template inline static void apply_direct(Mat& out, const T1& expr); - - template inline static void apply_subview(Mat& out, const subview& sv); - - template inline static void apply_proxy(Mat& out, const Proxy& P); - }; - - - -class op_vectorise_row - : public traits_op_row - { - public: - - template inline static void apply(Mat& out, const Op& in); - - template inline static void apply_direct(Mat& out, const T1& expr); - - template inline static void apply_proxy(Mat& out, const Proxy& P); - }; - - - -class op_vectorise_all - : public traits_op_xvec - { - public: - - template inline static void apply(Mat& out, const Op& in); - }; - - - -class op_vectorise_cube_col - : public traits_op_col - { - public: - - template inline static void apply(Mat& out, const CubeToMatOp& in); - - template inline static void apply_subview(Mat& out, const subview_cube& sv); - - template inline static void apply_unwrap(Mat& out, const T1& expr); - - template inline static void apply_proxy(Mat& out, const T1& expr); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_vectorise_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_vectorise_meat.hpp deleted file mode 100644 index 243c0819e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_vectorise_meat.hpp +++ /dev/null @@ -1,463 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup op_vectorise -//! @{ - - - -template -inline -void -op_vectorise_col::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - op_vectorise_col::apply_direct(out, in.m); - } - - - -template -inline -void -op_vectorise_col::apply_direct(Mat& out, const T1& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - // allow detection of in-place operation - if(is_Mat::value || (arma_config::openmp && Proxy::use_mp)) - { - const unwrap U(expr); - - if(&out == &(U.M)) - { - // output matrix is the same as the input matrix - - out.set_size(out.n_elem, 1); // set_size() doesn't destroy data as long as the number of elements in the matrix remains the same - } - else - { - out.set_size(U.M.n_elem, 1); - - arrayops::copy(out.memptr(), U.M.memptr(), U.M.n_elem); - } - } - else - if(is_subview::value) - { - const subview& sv = reinterpret_cast< const subview& >(expr); - - if(&out == &(sv.m)) - { - Mat tmp; - - op_vectorise_col::apply_subview(tmp, sv); - - out.steal_mem(tmp); - } - else - { - op_vectorise_col::apply_subview(out, sv); - } - } - else - { - const Proxy P(expr); - - const bool is_alias = P.is_alias(out); - - if(is_Mat::stored_type>::value) - { - const quasi_unwrap::stored_type> U(P.Q); - - if(is_alias) - { - Mat tmp(U.M.memptr(), U.M.n_elem, 1); - - out.steal_mem(tmp); - } - else - { - out.set_size(U.M.n_elem, 1); - - arrayops::copy(out.memptr(), U.M.memptr(), U.M.n_elem); - } - } - else - { - if(is_alias) - { - Mat tmp; - - op_vectorise_col::apply_proxy(tmp, P); - - out.steal_mem(tmp); - } - else - { - op_vectorise_col::apply_proxy(out, P); - } - } - } - } - - - -template -inline -void -op_vectorise_col::apply_subview(Mat& out, const subview& sv) - { - arma_debug_sigprint(); - - const uword sv_n_rows = sv.n_rows; - const uword sv_n_cols = sv.n_cols; - - out.set_size(sv.n_elem, 1); - - eT* out_mem = out.memptr(); - - for(uword col=0; col < sv_n_cols; ++col) - { - arrayops::copy(out_mem, sv.colptr(col), sv_n_rows); - - out_mem += sv_n_rows; - } - } - - - -template -inline -void -op_vectorise_col::apply_proxy(Mat& out, const Proxy& P) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword N = P.get_n_elem(); - - out.set_size(N, 1); - - eT* outmem = out.memptr(); - - if(Proxy::use_at == false) - { - // TODO: add handling of aligned access ? - - typename Proxy::ea_type A = P.get_ea(); - - uword i,j; - - for(i=0, j=1; j < N; i+=2, j+=2) - { - const eT tmp_i = A[i]; - const eT tmp_j = A[j]; - - outmem[i] = tmp_i; - outmem[j] = tmp_j; - } - - if(i < N) - { - outmem[i] = A[i]; - } - } - else - { - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - if(n_rows == 1) - { - for(uword i=0; i < n_cols; ++i) - { - outmem[i] = P.at(0,i); - } - } - else - { - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - *outmem = P.at(row,col); - outmem++; - } - } - } - } - - - -template -inline -void -op_vectorise_row::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - op_vectorise_row::apply_direct(out, in.m); - } - - - -template -inline -void -op_vectorise_row::apply_direct(Mat& out, const T1& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const Proxy P(expr); - - if(P.is_alias(out)) - { - Mat tmp; - - op_vectorise_row::apply_proxy(tmp, P); - - out.steal_mem(tmp); - } - else - { - op_vectorise_row::apply_proxy(out, P); - } - } - - - -template -inline -void -op_vectorise_row::apply_proxy(Mat& out, const Proxy& P) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - const uword n_elem = P.get_n_elem(); - - out.set_size(1, n_elem); - - eT* outmem = out.memptr(); - - if(n_cols == 1) - { - if(is_Mat::stored_type>::value) - { - const unwrap::stored_type> tmp(P.Q); - - arrayops::copy(out.memptr(), tmp.M.memptr(), n_elem); - } - else - { - for(uword i=0; i < n_elem; ++i) { outmem[i] = P.at(i,0); } - } - } - else - { - for(uword row=0; row < n_rows; ++row) - { - uword i,j; - - for(i=0, j=1; j < n_cols; i+=2, j+=2) - { - const eT tmp_i = P.at(row,i); - const eT tmp_j = P.at(row,j); - - *outmem = tmp_i; outmem++; - *outmem = tmp_j; outmem++; - } - - if(i < n_cols) - { - *outmem = P.at(row,i); outmem++; - } - } - } - } - - - -template -inline -void -op_vectorise_all::apply(Mat& out, const Op& in) - { - arma_debug_sigprint(); - - const uword dim = in.aux_uword_a; - - if(dim == 0) - { - op_vectorise_col::apply_direct(out, in.m); - } - else - { - op_vectorise_row::apply_direct(out, in.m); - } - } - - - -// - - - -template -inline -void -op_vectorise_cube_col::apply(Mat& out, const CubeToMatOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(is_same_type< T1, subview_cube >::yes) - { - op_vectorise_cube_col::apply_subview(out, reinterpret_cast< const subview_cube& >(in.m)); - } - else - { - if(is_Cube::value || (arma_config::openmp && ProxyCube::use_mp)) - { - op_vectorise_cube_col::apply_unwrap(out, in.m); - } - else - { - op_vectorise_cube_col::apply_proxy(out, in.m); - } - } - } - - - -template -inline -void -op_vectorise_cube_col::apply_subview(Mat& out, const subview_cube& sv) - { - arma_debug_sigprint(); - - const uword sv_nr = sv.n_rows; - const uword sv_nc = sv.n_cols; - const uword sv_ns = sv.n_slices; - - out.set_size(sv.n_elem, 1); - - eT* out_mem = out.memptr(); - - for(uword s=0; s < sv_ns; ++s) - for(uword c=0; c < sv_nc; ++c) - { - arrayops::copy(out_mem, sv.slice_colptr(s,c), sv_nr); - - out_mem += sv_nr; - } - } - - - -template -inline -void -op_vectorise_cube_col::apply_unwrap(Mat& out, const T1& expr) - { - arma_debug_sigprint(); - - const unwrap_cube U(expr); - - out.set_size(U.M.n_elem, 1); - - arrayops::copy(out.memptr(), U.M.memptr(), U.M.n_elem); - } - - - -template -inline -void -op_vectorise_cube_col::apply_proxy(Mat& out, const T1& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const ProxyCube P(expr); - - if(is_Cube::stored_type>::value) - { - op_vectorise_cube_col::apply_unwrap(out, P.Q); - - return; - } - - const uword N = P.get_n_elem(); - - out.set_size(N, 1); - - eT* outmem = out.memptr(); - - if(ProxyCube::use_at == false) - { - typename ProxyCube::ea_type A = P.get_ea(); - - uword i,j; - - for(i=0, j=1; j < N; i+=2, j+=2) - { - const eT tmp_i = A[i]; - const eT tmp_j = A[j]; - - outmem[i] = tmp_i; - outmem[j] = tmp_j; - } - - if(i < N) - { - outmem[i] = A[i]; - } - } - else - { - const uword nr = P.get_n_rows(); - const uword nc = P.get_n_cols(); - const uword ns = P.get_n_slices(); - - for(uword s=0; s < ns; ++s) - for(uword c=0; c < nc; ++c) - for(uword r=0; r < nr; ++r) - { - *outmem = P.at(r,c,s); - outmem++; - } - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_wishrnd_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_wishrnd_bones.hpp deleted file mode 100644 index b85a72d45..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_wishrnd_bones.hpp +++ /dev/null @@ -1,63 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_wishrnd -//! @{ - - -class op_wishrnd - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& expr); - - template - inline static bool apply_direct(Mat& out, const Base& X, const typename T1::elem_type df, const uword mode); - - template - inline static bool apply_noalias_mode1(Mat& out, const Mat& S, const eT df); - - template - inline static bool apply_noalias_mode2(Mat& out, const Mat& D, const eT df); - }; - - - -class op_iwishrnd - : public traits_op_default - { - public: - - template - inline static void apply(Mat& out, const Op& expr); - - template - inline static bool apply_direct(Mat& out, const Base& X, const typename T1::elem_type df, const uword mode); - - template - inline static bool apply_noalias_mode1(Mat& out, const Mat& T, const eT df); - - template - inline static bool apply_noalias_mode2(Mat& out, const Mat& Dinv, const eT df); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_wishrnd_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_wishrnd_meat.hpp deleted file mode 100644 index 865e15caf..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/op_wishrnd_meat.hpp +++ /dev/null @@ -1,281 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_wishrnd -//! @{ - - -// implementation based on: -// Yu-Cheng Ku and Peter Bloomfield. -// Generating Random Wishart Matrices with Fractional Degrees of Freedom in OX. -// Oxmetrics User Conference, 2010. - - -template -inline -void -op_wishrnd::apply(Mat& out, const Op& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const eT df = expr.aux; - const uword mode = expr.aux_uword_a; - - const bool status = op_wishrnd::apply_direct(out, expr.m, df, mode); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("wishrnd(): given matrix is not symmetric positive definite"); - } - } - - - -template -inline -bool -op_wishrnd::apply_direct(Mat& out, const Base& X, const typename T1::elem_type df, const uword mode) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap U(X.get_ref()); - - bool status = false; - - if(U.is_alias(out)) - { - Mat tmp; - - if(mode == 1) { status = op_wishrnd::apply_noalias_mode1(tmp, U.M, df); } - if(mode == 2) { status = op_wishrnd::apply_noalias_mode2(tmp, U.M, df); } - - out.steal_mem(tmp); - } - else - { - if(mode == 1) { status = op_wishrnd::apply_noalias_mode1(out, U.M, df); } - if(mode == 2) { status = op_wishrnd::apply_noalias_mode2(out, U.M, df); } - } - - return status; - } - - - -template -inline -bool -op_wishrnd::apply_noalias_mode1(Mat& out, const Mat& S, const eT df) - { - arma_debug_sigprint(); - - arma_conform_check( (S.is_square() == false), "wishrnd(): given matrix must be square sized" ); - - if(S.is_empty()) { out.reset(); return true; } - - if(auxlib::rudimentary_sym_check(S) == false) { return false; } - - Mat D; - - const bool status = op_chol::apply_direct(D, S, 0); - - if(status == false) { return false; } - - return op_wishrnd::apply_noalias_mode2(out, D, df); - } - - - -template -inline -bool -op_wishrnd::apply_noalias_mode2(Mat& out, const Mat& D, const eT df) - { - arma_debug_sigprint(); - - arma_conform_check( (df <= eT(0)), "df must be greater than zero" ); - arma_conform_check( (D.is_square() == false), "wishrnd(): given matrix must be square sized" ); - - if(D.is_empty()) { out.reset(); return true; } - - const uword N = D.n_rows; - - if(df < eT(N)) - { - arma_debug_print("simple generator"); - - const uword df_floor = uword(std::floor(df)); - - const Mat tmp = (randn< Mat >(df_floor, N)) * D; - - out = tmp.t() * tmp; - } - else - { - arma_debug_print("standard generator"); - - op_chi2rnd_varying_df chi2rnd_generator; - - Mat A(N, N, arma_zeros_indicator()); - - for(uword i=0; i::fill( A.colptr(i), i ); - } - - const Mat tmp = A * D; - - A.reset(); - - out = tmp.t() * tmp; - } - - return true; - } - - - -// - - - -template -inline -void -op_iwishrnd::apply(Mat& out, const Op& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const eT df = expr.aux; - const uword mode = expr.aux_uword_a; - - const bool status = op_iwishrnd::apply_direct(out, expr.m, df, mode); - - if(status == false) - { - out.soft_reset(); - arma_stop_runtime_error("iwishrnd(): given matrix is not symmetric positive definite and/or df is too low"); - } - } - - - -template -inline -bool -op_iwishrnd::apply_direct(Mat& out, const Base& X, const typename T1::elem_type df, const uword mode) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const quasi_unwrap U(X.get_ref()); - - bool status = false; - - if(U.is_alias(out)) - { - Mat tmp; - - if(mode == 1) { status = op_iwishrnd::apply_noalias_mode1(tmp, U.M, df); } - if(mode == 2) { status = op_iwishrnd::apply_noalias_mode2(tmp, U.M, df); } - - out.steal_mem(tmp); - } - else - { - if(mode == 1) { status = op_iwishrnd::apply_noalias_mode1(out, U.M, df); } - if(mode == 2) { status = op_iwishrnd::apply_noalias_mode2(out, U.M, df); } - } - - return status; - } - - - -template -inline -bool -op_iwishrnd::apply_noalias_mode1(Mat& out, const Mat& T, const eT df) - { - arma_debug_sigprint(); - - arma_conform_check( (T.is_square() == false), "iwishrnd(): given matrix must be square sized" ); - - if(T.is_empty()) { out.reset(); return true; } - - if(auxlib::rudimentary_sym_check(T) == false) { return false; } - - Mat Tinv; - Mat Dinv; - - const bool inv_status = auxlib::inv_sympd(Tinv, T); - - if(inv_status == false) { return false; } - - const bool chol_status = op_chol::apply_direct(Dinv, Tinv, 0); - - if(chol_status == false) { return false; } - - return op_iwishrnd::apply_noalias_mode2(out, Dinv, df); - } - - - -template -inline -bool -op_iwishrnd::apply_noalias_mode2(Mat& out, const Mat& Dinv, const eT df) - { - arma_debug_sigprint(); - - arma_conform_check( (df <= eT(0)), "df must be greater than zero" ); - arma_conform_check( (Dinv.is_square() == false), "iwishrnd(): given matrix must be square sized" ); - - if(Dinv.is_empty()) { out.reset(); return true; } - - Mat tmp; - - const bool wishrnd_status = op_wishrnd::apply_noalias_mode2(tmp, Dinv, df); - - if(wishrnd_status == false) { return false; } - - const bool inv_status1 = auxlib::inv_sympd(out, tmp); - - const bool inv_status2 = (inv_status1) ? bool(true) : bool(auxlib::inv(out, tmp)); - - if(inv_status2 == false) { return false; } - - return true; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_cube_div.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_cube_div.hpp deleted file mode 100644 index b96163a08..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_cube_div.hpp +++ /dev/null @@ -1,197 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup operator_cube_div -//! @{ - - - -//! BaseCube / scalar -template -arma_inline -const eOpCube -operator/ - ( - const BaseCube& X, - const typename T1::elem_type k - ) - { - arma_debug_sigprint(); - - return eOpCube(X.get_ref(), k); - } - - - -//! scalar / BaseCube -template -arma_inline -const eOpCube -operator/ - ( - const typename T1::elem_type k, - const BaseCube& X - ) - { - arma_debug_sigprint(); - - return eOpCube(X.get_ref(), k); - } - - - -//! complex scalar / non-complex BaseCube (experimental) -template -arma_inline -const mtOpCube, T1, op_cx_scalar_div_pre> -operator/ - ( - const std::complex& k, - const BaseCube& X - ) - { - arma_debug_sigprint(); - - return mtOpCube, T1, op_cx_scalar_div_pre>('j', X.get_ref(), k); - } - - - -//! non-complex BaseCube / complex scalar (experimental) -template -arma_inline -const mtOpCube, T1, op_cx_scalar_div_post> -operator/ - ( - const BaseCube& X, - const std::complex& k - ) - { - arma_debug_sigprint(); - - return mtOpCube, T1, op_cx_scalar_div_post>('j', X.get_ref(), k); - } - - - -//! element-wise division of BaseCube objects with same element type -template -arma_inline -const eGlueCube -operator/ - ( - const BaseCube& X, - const BaseCube& Y - ) - { - arma_debug_sigprint(); - - return eGlueCube(X.get_ref(), Y.get_ref()); - } - - - -//! element-wise division of BaseCube objects with different element types -template -inline -const mtGlueCube::result, T1, T2, glue_mixed_div> -operator/ - ( - const BaseCube< typename force_different_type::T1_result, T1>& X, - const BaseCube< typename force_different_type::T2_result, T2>& Y - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - return mtGlueCube( X.get_ref(), Y.get_ref() ); - } - - - -template -arma_inline -Cube -operator/ - ( - const subview_cube_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return subview_cube_each1_aux::operator_div(X, Y.get_ref()); - } - - - -template -arma_inline -Cube -operator/ - ( - const Base& X, - const subview_cube_each1& Y - ) - { - arma_debug_sigprint(); - - return subview_cube_each1_aux::operator_div(X.get_ref(), Y); - } - - - -template -arma_inline -Cube -operator/ - ( - const subview_cube_each2& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return subview_cube_each2_aux::operator_div(X, Y.get_ref()); - } - - - -template -arma_inline -Cube -operator/ - ( - const Base& X, - const subview_cube_each2& Y - ) - { - arma_debug_sigprint(); - - return subview_cube_each2_aux::operator_div(X.get_ref(), Y); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_cube_minus.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_cube_minus.hpp deleted file mode 100644 index ce0cd83e9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_cube_minus.hpp +++ /dev/null @@ -1,213 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup operator_cube_minus -//! @{ - - - -//! unary - -template -arma_inline -const eOpCube -operator- - ( - const BaseCube& X - ) - { - arma_debug_sigprint(); - - return eOpCube(X.get_ref()); - } - - - -//! BaseCube - scalar -template -arma_inline -const eOpCube -operator- - ( - const BaseCube& X, - const typename T1::elem_type k - ) - { - arma_debug_sigprint(); - - return eOpCube(X.get_ref(), k); - } - - - -//! scalar - BaseCube -template -arma_inline -const eOpCube -operator- - ( - const typename T1::elem_type k, - const BaseCube& X - ) - { - arma_debug_sigprint(); - - return eOpCube(X.get_ref(), k); - } - - - -//! complex scalar - non-complex BaseCube (experimental) -template -arma_inline -const mtOpCube, T1, op_cx_scalar_minus_pre> -operator- - ( - const std::complex& k, - const BaseCube& X - ) - { - arma_debug_sigprint(); - - return mtOpCube, T1, op_cx_scalar_minus_pre>('j', X.get_ref(), k); - } - - - -//! non-complex BaseCube - complex scalar (experimental) -template -arma_inline -const mtOpCube, T1, op_cx_scalar_minus_post> -operator- - ( - const BaseCube& X, - const std::complex& k - ) - { - arma_debug_sigprint(); - - return mtOpCube, T1, op_cx_scalar_minus_post>('j', X.get_ref(), k); - } - - - -//! subtraction of BaseCube objects with same element type -template -arma_inline -const eGlueCube -operator- - ( - const BaseCube& X, - const BaseCube& Y - ) - { - arma_debug_sigprint(); - - return eGlueCube(X.get_ref(), Y.get_ref()); - } - - - -//! subtraction of BaseCube objects with different element types -template -inline -const mtGlueCube::result, T1, T2, glue_mixed_minus> -operator- - ( - const BaseCube< typename force_different_type::T1_result, T1>& X, - const BaseCube< typename force_different_type::T2_result, T2>& Y - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - return mtGlueCube( X.get_ref(), Y.get_ref() ); - } - - - -template -arma_inline -Cube -operator- - ( - const subview_cube_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return subview_cube_each1_aux::operator_minus(X, Y.get_ref()); - } - - - -template -arma_inline -Cube -operator- - ( - const Base& X, - const subview_cube_each1& Y - ) - { - arma_debug_sigprint(); - - return subview_cube_each1_aux::operator_minus(X.get_ref(), Y); - } - - - -template -arma_inline -Cube -operator- - ( - const subview_cube_each2& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return subview_cube_each2_aux::operator_minus(X, Y.get_ref()); - } - - - -template -arma_inline -Cube -operator- - ( - const Base& X, - const subview_cube_each2& Y - ) - { - arma_debug_sigprint(); - - return subview_cube_each2_aux::operator_minus(X.get_ref(), Y); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_cube_plus.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_cube_plus.hpp deleted file mode 100644 index 982952568..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_cube_plus.hpp +++ /dev/null @@ -1,213 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup operator_cube_plus -//! @{ - - - -//! unary plus operation (does nothing, but is required for completeness) -template -arma_inline -const BaseCube& -operator+ - ( - const BaseCube& X - ) - { - arma_debug_sigprint(); - - return X; - } - - - -//! BaseCube + scalar -template -arma_inline -const eOpCube -operator+ - ( - const BaseCube& X, - const typename T1::elem_type k - ) - { - arma_debug_sigprint(); - - return eOpCube(X.get_ref(), k); - } - - - -//! scalar + BaseCube -template -arma_inline -const eOpCube -operator+ - ( - const typename T1::elem_type k, - const BaseCube& X - ) - { - arma_debug_sigprint(); - - return eOpCube(X.get_ref(), k); - } - - - -//! non-complex BaseCube + complex scalar (experimental) -template -arma_inline -const mtOpCube, T1, op_cx_scalar_plus> -operator+ - ( - const BaseCube& X, - const std::complex& k - ) - { - arma_debug_sigprint(); - - return mtOpCube, T1, op_cx_scalar_plus>('j', X.get_ref(), k); - } - - - -//! complex scalar + non-complex BaseCube (experimental) -template -arma_inline -const mtOpCube, T1, op_cx_scalar_plus> -operator+ - ( - const std::complex& k, - const BaseCube& X - ) - { - arma_debug_sigprint(); - - return mtOpCube, T1, op_cx_scalar_plus>('j', X.get_ref(), k); // NOTE: order is swapped - } - - - -//! addition of BaseCube objects with same element type -template -arma_inline -const eGlueCube -operator+ - ( - const BaseCube& X, - const BaseCube& Y - ) - { - arma_debug_sigprint(); - - return eGlueCube(X.get_ref(), Y.get_ref()); - } - - - -//! addition of BaseCube objects with different element types -template -inline -const mtGlueCube::result, T1, T2, glue_mixed_plus> -operator+ - ( - const BaseCube< typename force_different_type::T1_result, T1>& X, - const BaseCube< typename force_different_type::T2_result, T2>& Y - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - return mtGlueCube( X.get_ref(), Y.get_ref() ); - } - - - -template -arma_inline -Cube -operator+ - ( - const subview_cube_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return subview_cube_each1_aux::operator_plus(X, Y.get_ref()); - } - - - -template -arma_inline -Cube -operator+ - ( - const Base& X, - const subview_cube_each1& Y - ) - { - arma_debug_sigprint(); - - return subview_cube_each1_aux::operator_plus(Y, X.get_ref()); // NOTE: swapped order - } - - - -template -arma_inline -Cube -operator+ - ( - const subview_cube_each2& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return subview_cube_each2_aux::operator_plus(X, Y.get_ref()); - } - - - -template -arma_inline -Cube -operator+ - ( - const Base& X, - const subview_cube_each2& Y - ) - { - arma_debug_sigprint(); - - return subview_cube_each2_aux::operator_plus(Y, X.get_ref()); // NOTE: swapped order - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_cube_relational.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_cube_relational.hpp deleted file mode 100644 index 6615af46d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_cube_relational.hpp +++ /dev/null @@ -1,301 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup operator_cube_relational -//! @{ - - - -// < : lt -// > : gt -// <= : lteq -// >= : gteq -// == : eq -// != : noteq -// && : and -// || : or - - - -template -inline -const mtGlueCube -operator< -(const BaseCube::result,T1>& X, const BaseCube::result,T2>& Y) - { - arma_debug_sigprint(); - - return mtGlueCube( X.get_ref(), Y.get_ref() ); - } - - - -template -inline -const mtGlueCube -operator> -(const BaseCube::result,T1>& X, const BaseCube::result,T2>& Y) - { - arma_debug_sigprint(); - - return mtGlueCube( X.get_ref(), Y.get_ref() ); - } - - - -template -inline -const mtGlueCube -operator<= -(const BaseCube::result,T1>& X, const BaseCube::result,T2>& Y) - { - arma_debug_sigprint(); - - return mtGlueCube( X.get_ref(), Y.get_ref() ); - } - - - -template -inline -const mtGlueCube -operator>= -(const BaseCube::result,T1>& X, const BaseCube::result,T2>& Y) - { - arma_debug_sigprint(); - - return mtGlueCube( X.get_ref(), Y.get_ref() ); - } - - - -template -inline -const mtGlueCube -operator== -(const BaseCube& X, const BaseCube& Y) - { - arma_debug_sigprint(); - - return mtGlueCube( X.get_ref(), Y.get_ref() ); - } - - - -template -inline -const mtGlueCube -operator!= -(const BaseCube& X, const BaseCube& Y) - { - arma_debug_sigprint(); - - return mtGlueCube( X.get_ref(), Y.get_ref() ); - } - - - -template -inline -const mtGlueCube -operator&& -(const BaseCube::result,T1>& X, const BaseCube::result,T2>& Y) - { - arma_debug_sigprint(); - - return mtGlueCube( X.get_ref(), Y.get_ref() ); - } - - - -template -inline -const mtGlueCube -operator|| -(const BaseCube::result,T1>& X, const BaseCube::result,T2>& Y) - { - arma_debug_sigprint(); - - return mtGlueCube( X.get_ref(), Y.get_ref() ); - } - - - -// -// -// - - - -template -inline -const mtOpCube -operator< -(const typename arma_not_cx::result val, const BaseCube::result,T1>& X) - { - arma_debug_sigprint(); - - return mtOpCube(X.get_ref(), val); - } - - - -template -inline -const mtOpCube -operator< -(const BaseCube::result,T1>& X, const typename arma_not_cx::result val) - { - arma_debug_sigprint(); - - return mtOpCube(X.get_ref(), val); - } - - - -template -inline -const mtOpCube -operator> -(const typename arma_not_cx::result val, const BaseCube::result,T1>& X) - { - arma_debug_sigprint(); - - return mtOpCube(X.get_ref(), val); - } - - - -template -inline -const mtOpCube -operator> -(const BaseCube::result,T1>& X, const typename arma_not_cx::result val) - { - arma_debug_sigprint(); - - return mtOpCube(X.get_ref(), val); - } - - - -template -inline -const mtOpCube -operator<= -(const typename arma_not_cx::result val, const BaseCube::result,T1>& X) - { - arma_debug_sigprint(); - - return mtOpCube(X.get_ref(), val); - } - - - -template -inline -const mtOpCube -operator<= -(const BaseCube::result,T1>& X, const typename arma_not_cx::result val) - { - arma_debug_sigprint(); - - return mtOpCube(X.get_ref(), val); - } - - - -template -inline -const mtOpCube -operator>= -(const typename arma_not_cx::result val, const BaseCube::result,T1>& X) - { - arma_debug_sigprint(); - - return mtOpCube(X.get_ref(), val); - } - - - -template -inline -const mtOpCube -operator>= -(const BaseCube::result,T1>& X, const typename arma_not_cx::result val) - { - arma_debug_sigprint(); - - return mtOpCube(X.get_ref(), val); - } - - - -template -inline -const mtOpCube -operator== -(const typename T1::elem_type val, const BaseCube& X) - { - arma_debug_sigprint(); - - return mtOpCube(X.get_ref(), val); - } - - - -template -inline -const mtOpCube -operator== -(const BaseCube& X, const typename T1::elem_type val) - { - arma_debug_sigprint(); - - return mtOpCube(X.get_ref(), val); - } - - - -template -inline -const mtOpCube -operator!= -(const typename T1::elem_type val, const BaseCube& X) - { - arma_debug_sigprint(); - - return mtOpCube(X.get_ref(), val); - } - - - -template -inline -const mtOpCube -operator!= -(const BaseCube& X, const typename T1::elem_type val) - { - arma_debug_sigprint(); - - return mtOpCube(X.get_ref(), val); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_cube_schur.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_cube_schur.hpp deleted file mode 100644 index abe28249b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_cube_schur.hpp +++ /dev/null @@ -1,131 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup operator_cube_schur -//! @{ - - -// operator %, which we define it to do a schur product (element-wise multiplication) - - -//! element-wise multiplication of BaseCube objects with same element type -template -arma_inline -const eGlueCube -operator% - ( - const BaseCube& X, - const BaseCube& Y - ) - { - arma_debug_sigprint(); - - return eGlueCube(X.get_ref(), Y.get_ref()); - } - - - -//! element-wise multiplication of BaseCube objects with different element types -template -inline -const mtGlueCube::result, T1, T2, glue_mixed_schur> -operator% - ( - const BaseCube< typename force_different_type::T1_result, T1>& X, - const BaseCube< typename force_different_type::T2_result, T2>& Y - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - return mtGlueCube( X.get_ref(), Y.get_ref() ); - } - - - -template -arma_inline -Cube -operator% - ( - const subview_cube_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return subview_cube_each1_aux::operator_schur(X, Y.get_ref()); - } - - - -template -arma_inline -Cube -operator% - ( - const Base& X, - const subview_cube_each1& Y - ) - { - arma_debug_sigprint(); - - return subview_cube_each1_aux::operator_schur(Y, X.get_ref()); // NOTE: swapped order - } - - - -template -arma_inline -Cube -operator% - ( - const subview_cube_each2& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return subview_cube_each2_aux::operator_schur(X, Y.get_ref()); - } - - - -template -arma_inline -Cube -operator% - ( - const Base& X, - const subview_cube_each2& Y - ) - { - arma_debug_sigprint(); - - return subview_cube_each2_aux::operator_schur(Y, X.get_ref()); // NOTE: swapped order - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_cube_times.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_cube_times.hpp deleted file mode 100644 index 267c490d1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_cube_times.hpp +++ /dev/null @@ -1,124 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup operator_cube_times -//! @{ - - - -//! BaseCube * scalar -template -arma_inline -const eOpCube -operator* - ( - const BaseCube& X, - const typename T1::elem_type k - ) - { - arma_debug_sigprint(); - - return eOpCube(X.get_ref(), k); - } - - - -//! scalar * BaseCube -template -arma_inline -const eOpCube -operator* - ( - const typename T1::elem_type k, - const BaseCube& X - ) - { - arma_debug_sigprint(); - - return eOpCube(X.get_ref(), k); - } - - - -//! non-complex BaseCube * complex scalar (experimental) -template -arma_inline -const mtOpCube, T1, op_cx_scalar_times> -operator* - ( - const BaseCube& X, - const std::complex& k - ) - { - arma_debug_sigprint(); - - return mtOpCube, T1, op_cx_scalar_times>('j', X.get_ref(), k); - } - - - -//! complex scalar * non-complex BaseCube (experimental) -template -arma_inline -const mtOpCube, T1, op_cx_scalar_times> -operator* - ( - const std::complex& k, - const BaseCube& X - ) - { - arma_debug_sigprint(); - - return mtOpCube, T1, op_cx_scalar_times>('j', X.get_ref(), k); - } - - - -template -arma_inline -Cube -operator* - ( - const subview_cube_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return subview_cube_each1_aux::operator_times(X, Y.get_ref()); - } - - - -template -arma_inline -Cube -operator* - ( - const Base& X, - const subview_cube_each1& Y - ) - { - arma_debug_sigprint(); - - return subview_cube_each1_aux::operator_times(X.get_ref(), Y); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_div.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_div.hpp deleted file mode 100644 index 6f77364c0..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_div.hpp +++ /dev/null @@ -1,382 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup operator_div -//! @{ - - - -//! Base / scalar -template -arma_inline -typename -enable_if2< is_arma_type::value, const eOp< T1, eop_scalar_div_post> >::result -operator/ - ( - const T1& X, - const typename T1::elem_type k - ) - { - arma_debug_sigprint(); - - return eOp(X, k); - } - - - -//! scalar / Base -template -arma_inline -typename -enable_if2< is_arma_type::value, const eOp< T1, eop_scalar_div_pre> >::result -operator/ - ( - const typename T1::elem_type k, - const T1& X - ) - { - arma_debug_sigprint(); - - return eOp(X, k); - } - - - -//! complex scalar / non-complex Base -template -arma_inline -typename -enable_if2 - < - (is_arma_type::value && is_cx::no), - const mtOp, T1, op_cx_scalar_div_pre> - >::result -operator/ - ( - const std::complex& k, - const T1& X - ) - { - arma_debug_sigprint(); - - return mtOp, T1, op_cx_scalar_div_pre>('j', X, k); - } - - - -//! non-complex Base / complex scalar -template -arma_inline -typename -enable_if2 - < - (is_arma_type::value && is_cx::no), - const mtOp, T1, op_cx_scalar_div_post> - >::result -operator/ - ( - const T1& X, - const std::complex& k - ) - { - arma_debug_sigprint(); - - return mtOp, T1, op_cx_scalar_div_post>('j', X, k); - } - - - -//! element-wise division of Base objects with same element type -template -arma_inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value && is_same_type::value), - const eGlue - >::result -operator/ - ( - const T1& X, - const T2& Y - ) - { - arma_debug_sigprint(); - - return eGlue(X, Y); - } - - - -//! element-wise division of Base objects with different element types -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value && (is_same_type::no)), - const mtGlue::result, T1, T2, glue_mixed_div> - >::result -operator/ - ( - const T1& X, - const T2& Y - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - return mtGlue( X, Y ); - } - - - -//! element-wise division of sparse matrix by scalar -template -inline -typename -enable_if2< is_arma_sparse_type::value, SpMat >::result -operator/ - ( - const T1& X, - const typename T1::elem_type y - ) - { - arma_debug_sigprint(); - - SpMat result(X); - - result /= y; - - return result; - } - - - -//! element-wise division of one sparse and one dense object -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_type::value && is_same_type::value), - SpMat - >::result -operator/ - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const SpProxy pa(x); - const Proxy pb(y); - - const uword n_rows = pa.get_n_rows(); - const uword n_cols = pa.get_n_cols(); - - arma_conform_assert_same_size(n_rows, n_cols, pb.get_n_rows(), pb.get_n_cols(), "element-wise division"); - - uword new_n_nonzero = 0; - - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - const eT val = pa.at(row,col) / pb.at(row, col); - - if(val != eT(0)) - { - ++new_n_nonzero; - } - } - - SpMat result(arma_reserve_indicator(), n_rows, n_cols, new_n_nonzero); - - uword cur_pos = 0; - - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - const eT val = pa.at(row,col) / pb.at(row, col); - - if(val != eT(0)) - { - access::rw(result.values[cur_pos]) = val; - access::rw(result.row_indices[cur_pos]) = row; - ++access::rw(result.col_ptrs[col + 1]); - ++cur_pos; - } - } - - // Fix column pointers - for(uword col = 1; col <= result.n_cols; ++col) - { - access::rw(result.col_ptrs[col]) += result.col_ptrs[col - 1]; - } - - return result; - } - - - -//! optimization: element-wise division of sparse / (sparse +/- scalar) -template -inline -typename -enable_if2 - < - ( - is_arma_sparse_type::value && is_arma_sparse_type::value && - is_same_type::yes && - (is_same_type::value || - is_same_type::value || - is_same_type::value) - ), - SpMat - >::result -operator/ - ( - const T1& x, - const SpToDOp& y - ) - { - arma_debug_sigprint(); - - SpMat out; - - op_type::apply_inside_div(out, x, y); - - return out; - } - - - -//! element-wise division of one dense and one sparse object -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_sparse_type::value && is_same_type::value), - Mat - >::result -operator/ - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const Proxy pa(x); - const SpProxy pb(y); - - const uword n_rows = pa.get_n_rows(); - const uword n_cols = pa.get_n_cols(); - - arma_conform_assert_same_size(n_rows, n_cols, pb.get_n_rows(), pb.get_n_cols(), "element-wise division"); - - Mat result(n_rows, n_cols, arma_nozeros_indicator()); - - for(uword col=0; col < n_cols; ++col) - for(uword row=0; row < n_rows; ++row) - { - result.at(row, col) = pa.at(row, col) / pb.at(row, col); - } - - return result; - } - - - -template -arma_inline -Mat -operator/ - ( - const subview_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return subview_each1_aux::operator_div(X, Y.get_ref()); - } - - - -template -arma_inline -Mat -operator/ - ( - const Base& X, - const subview_each1& Y - ) - { - arma_debug_sigprint(); - - return subview_each1_aux::operator_div(X.get_ref(), Y); - } - - - -template -arma_inline -Mat -operator/ - ( - const subview_each2& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return subview_each2_aux::operator_div(X, Y.get_ref()); - } - - - -template -arma_inline -Mat -operator/ - ( - const Base& X, - const subview_each2& Y - ) - { - arma_debug_sigprint(); - - return subview_each2_aux::operator_div(X.get_ref(), Y); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_minus.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_minus.hpp deleted file mode 100644 index 3cc1bba2f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_minus.hpp +++ /dev/null @@ -1,607 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup operator_minus -//! @{ - - - -//! unary - -template -arma_inline -typename -enable_if2< is_arma_type::value, const eOp >::result -operator- -(const T1& X) - { - arma_debug_sigprint(); - - return eOp(X); - } - - - -// //! unary - -// template -// arma_inline -// typename -// enable_if2< (is_arma_type::value && is_signed::value), const eOp >::result -// operator- -// (const T1& X) -// { -// arma_debug_sigprint(); -// -// return eOp(X); -// } -// -// -// -// template -// arma_inline -// typename enable_if2< (is_arma_type::value && (is_signed::value == false)), const eOp >::result -// operator- -// (const T1& X) -// { -// arma_debug_sigprint(); -// -// typedef typename T1::elem_type eT; -// -// return eOp(X, eT(-1)); -// } - - - -//! Base - scalar -template -arma_inline -typename -enable_if2< is_arma_type::value, const eOp >::result -operator- - ( - const T1& X, - const typename T1::elem_type k - ) - { - arma_debug_sigprint(); - - return eOp(X, k); - } - - - -//! scalar - Base -template -arma_inline -typename -enable_if2< is_arma_type::value, const eOp >::result -operator- - ( - const typename T1::elem_type k, - const T1& X - ) - { - arma_debug_sigprint(); - - return eOp(X, k); - } - - - -//! complex scalar - non-complex Base -template -arma_inline -typename -enable_if2 - < - (is_arma_type::value && is_cx::no), - const mtOp, T1, op_cx_scalar_minus_pre> - >::result -operator- - ( - const std::complex& k, - const T1& X - ) - { - arma_debug_sigprint(); - - return mtOp, T1, op_cx_scalar_minus_pre>('j', X, k); - } - - - -//! non-complex Base - complex scalar -template -arma_inline -typename -enable_if2 - < - (is_arma_type::value && is_cx::no), - const mtOp, T1, op_cx_scalar_minus_post> - >::result -operator- - ( - const T1& X, - const std::complex& k - ) - { - arma_debug_sigprint(); - - return mtOp, T1, op_cx_scalar_minus_post>('j', X, k); - } - - - -//! subtraction of Base objects with same element type -template -arma_inline -typename -enable_if2 - < - is_arma_type::value && is_arma_type::value && is_same_type::value, - const eGlue - >::result -operator- - ( - const T1& X, - const T2& Y - ) - { - arma_debug_sigprint(); - - return eGlue(X, Y); - } - - - -//! subtraction of Base objects with different element types -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value && (is_same_type::no)), - const mtGlue::result, T1, T2, glue_mixed_minus> - >::result -operator- - ( - const T1& X, - const T2& Y - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - return mtGlue( X, Y ); - } - - - -//! unary "-" for sparse objects -template -inline -typename -enable_if2 - < - is_arma_sparse_type::value && is_signed::value, - SpOp - >::result -operator- -(const T1& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - return SpOp(X, eT(-1)); - } - - - -//! subtraction of two sparse objects -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_sparse_type::value && is_same_type::value), - const SpGlue - >::result -operator- - ( - const T1& X, - const T2& Y - ) - { - arma_debug_sigprint(); - - return SpGlue(X,Y); - } - - - -//! subtraction of one sparse and one dense object -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_type::value && is_same_type::value), - Mat - >::result -operator- - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const SpProxy pa(x); - - const quasi_unwrap UB(y); - const Mat& B = UB.M; - - Mat result = -B; - - arma_conform_assert_same_size( pa.get_n_rows(), pa.get_n_cols(), result.n_rows, result.n_cols, "subtraction" ); - - typename SpProxy::const_iterator_type it = pa.begin(); - typename SpProxy::const_iterator_type it_end = pa.end(); - - for(; it != it_end; ++it) - { - const uword r = it.row(); - const uword c = it.col(); - - result.at(r, c) = (*it) - B.at(r,c); - } - - return result; - } - - - -//! subtraction of one dense and one sparse object -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_sparse_type::value && is_same_type::value), - Mat - >::result -operator- - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - Mat result(x); - - const SpProxy pb(y); - - arma_conform_assert_same_size( result.n_rows, result.n_cols, pb.get_n_rows(), pb.get_n_cols(), "subtraction" ); - - typename SpProxy::const_iterator_type it = pb.begin(); - typename SpProxy::const_iterator_type it_end = pb.end(); - - while(it != it_end) - { - result.at(it.row(), it.col()) -= (*it); - ++it; - } - - return result; - } - - - -//! subtraction of two sparse objects with different element types -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_sparse_type::value && is_same_type::no), - const mtSpGlue< typename promote_type::result, T1, T2, spglue_minus_mixed > - >::result -operator- - ( - const T1& X, - const T2& Y - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - return mtSpGlue( X, Y ); - } - - - -//! subtraction of sparse and non-sparse objects with different element types -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_type::value && is_same_type::no), - Mat< typename promote_type::result > - >::result -operator- - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - Mat< typename promote_type::result > out; - - spglue_minus_mixed::sparse_minus_dense(out, x, y); - - return out; - } - - - -//! subtraction of sparse and non-sparse objects with different element types -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_sparse_type::value && is_same_type::no), - Mat< typename promote_type::result > - >::result -operator- - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - Mat< typename promote_type::result > out; - - spglue_minus_mixed::dense_minus_sparse(out, x, y); - - return out; - } - - - -//! sparse - scalar -template -arma_inline -typename -enable_if2< is_arma_sparse_type::value, const SpToDOp >::result -operator- - ( - const T1& X, - const typename T1::elem_type k - ) - { - arma_debug_sigprint(); - - return SpToDOp(X, k); - } - - - -//! scalar - sparse -template -arma_inline -typename -enable_if2< is_arma_sparse_type::value, const SpToDOp >::result -operator- - ( - const typename T1::elem_type k, - const T1& X - ) - { - arma_debug_sigprint(); - - return SpToDOp(X, k); - } - - - -// TODO: this is an uncommon use case; remove? -//! multiple applications of add/subtract scalars can be condensed -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && - (is_same_type::value || - is_same_type::value)), - const SpToDOp - >::result -operator- - ( - const SpToDOp& x, - const typename T1::elem_type k - ) - { - arma_debug_sigprint(); - - const typename T1::elem_type aux = (is_same_type::value) ? -x.aux : x.aux; - - return SpToDOp(x.m, aux + k); - } - - - -// TODO: this is an uncommon use case; remove? -//! multiple applications of add/subtract scalars can be condensed -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && - (is_same_type::value || - is_same_type::value)), - const SpToDOp - >::result -operator- - ( - const typename T1::elem_type k, - const SpToDOp& x - ) - { - arma_debug_sigprint(); - - const typename T1::elem_type aux = (is_same_type::value) ? -x.aux : x.aux; - - return SpToDOp(x.m, k + aux); - } - - - -// TODO: this is an uncommon use case; remove? -//! multiple applications of add/subtract scalars can be condensed -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && - is_same_type::value), - const SpToDOp - >::result -operator- - ( - const SpToDOp& x, - const typename T1::elem_type k - ) - { - arma_debug_sigprint(); - - return SpToDOp(x.m, x.aux - k); - } - - - -// TODO: this is an uncommon use case; remove? -//! multiple applications of add/subtract scalars can be condensed -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && - is_same_type::value), - const SpToDOp - >::result -operator- - ( - const typename T1::elem_type k, - const SpToDOp& x - ) - { - arma_debug_sigprint(); - - return SpToDOp(x.m, k - x.aux); - } - - - -template -arma_inline -Mat -operator- - ( - const subview_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return subview_each1_aux::operator_minus(X, Y.get_ref()); - } - - - -template -arma_inline -Mat -operator- - ( - const Base& X, - const subview_each1& Y - ) - { - arma_debug_sigprint(); - - return subview_each1_aux::operator_minus(X.get_ref(), Y); - } - - - -template -arma_inline -Mat -operator- - ( - const subview_each2& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return subview_each2_aux::operator_minus(X, Y.get_ref()); - } - - - -template -arma_inline -Mat -operator- - ( - const Base& X, - const subview_each2& Y - ) - { - arma_debug_sigprint(); - - return subview_each2_aux::operator_minus(X.get_ref(), Y); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_ostream.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_ostream.hpp deleted file mode 100644 index 77567106d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_ostream.hpp +++ /dev/null @@ -1,186 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup operator_ostream -//! @{ - - - -template -inline -std::ostream& -operator<< (std::ostream& o, const Base& X) - { - arma_debug_sigprint(); - - const unwrap tmp(X.get_ref()); - - arma_ostream::print(o, tmp.M, true); - - return o; - } - - - -template -inline -std::ostream& -operator<< (std::ostream& o, const SpBase& X) - { - arma_debug_sigprint(); - - const unwrap_spmat tmp(X.get_ref()); - - arma_ostream::print(o, tmp.M, true); - - return o; - } - - - -template -inline -std::ostream& -operator<< (std::ostream& o, const SpValProxy& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - o << eT(X); - - return o; - } - - - -template -inline -std::ostream& -operator<< (std::ostream& o, const MapMat_val& X) - { - arma_debug_sigprint(); - - o << eT(X); - - return o; - } - - - -template -inline -std::ostream& -operator<< (std::ostream& o, const SpMat_MapMat_val& X) - { - arma_debug_sigprint(); - - o << eT(X); - - return o; - } - - - -template -inline -std::ostream& -operator<< (std::ostream& o, const SpSubview_MapMat_val& X) - { - arma_debug_sigprint(); - - o << eT(X); - - return o; - } - - - -template -inline -std::ostream& -operator<< (std::ostream& o, const BaseCube& X) - { - arma_debug_sigprint(); - - const unwrap_cube tmp(X.get_ref()); - - arma_ostream::print(o, tmp.M, true); - - return o; - } - - - -//! Print the contents of a field to the specified stream. -template -inline -std::ostream& -operator<< (std::ostream& o, const field& X) - { - arma_debug_sigprint(); - - arma_ostream::print(o, X); - - return o; - } - - - -//! Print the contents of a subfield to the specified stream -template -inline -std::ostream& -operator<< (std::ostream& o, const subview_field& X) - { - arma_debug_sigprint(); - - arma_ostream::print(o, X); - - return o; - } - - - -inline -std::ostream& -operator<< (std::ostream& o, const SizeMat& S) - { - arma_debug_sigprint(); - - arma_ostream::print(o, S); - - return o; - } - - - -inline -std::ostream& -operator<< (std::ostream& o, const SizeCube& S) - { - arma_debug_sigprint(); - - arma_ostream::print(o, S); - - return o; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_plus.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_plus.hpp deleted file mode 100644 index fd0603d06..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_plus.hpp +++ /dev/null @@ -1,540 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup operator_plus -//! @{ - - - -//! unary plus operation (does nothing, but is required for completeness) -template -arma_inline -typename enable_if2< is_arma_type::value, const T1& >::result -operator+ -(const T1& X) - { - arma_debug_sigprint(); - - return X; - } - - - -//! Base + scalar -template -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -operator+ -(const T1& X, const typename T1::elem_type k) - { - arma_debug_sigprint(); - - return eOp(X, k); - } - - - -//! scalar + Base -template -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -operator+ -(const typename T1::elem_type k, const T1& X) - { - arma_debug_sigprint(); - - return eOp(X, k); // NOTE: order is swapped - } - - - -//! non-complex Base + complex scalar -template -arma_inline -typename -enable_if2 - < - (is_arma_type::value && is_cx::no), - const mtOp, T1, op_cx_scalar_plus> - >::result -operator+ - ( - const T1& X, - const std::complex& k - ) - { - arma_debug_sigprint(); - - return mtOp, T1, op_cx_scalar_plus>('j', X, k); - } - - - -//! complex scalar + non-complex Base -template -arma_inline -typename -enable_if2 - < - (is_arma_type::value && is_cx::no), - const mtOp, T1, op_cx_scalar_plus> - >::result -operator+ - ( - const std::complex& k, - const T1& X - ) - { - arma_debug_sigprint(); - - return mtOp, T1, op_cx_scalar_plus>('j', X, k); // NOTE: order is swapped - } - - - -//! addition of user-accessible Armadillo objects with same element type -template -arma_inline -typename -enable_if2 - < - is_arma_type::value && is_arma_type::value && is_same_type::value, - const eGlue - >::result -operator+ - ( - const T1& X, - const T2& Y - ) - { - arma_debug_sigprint(); - - return eGlue(X, Y); - } - - - -//! addition of user-accessible Armadillo objects with different element types -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value && (is_same_type::no)), - const mtGlue::result, T1, T2, glue_mixed_plus> - >::result -operator+ - ( - const T1& X, - const T2& Y - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - return mtGlue( X, Y ); - } - - - -//! addition of two sparse objects -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_sparse_type::value && is_same_type::value), - SpGlue - >::result -operator+ - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - return SpGlue(x, y); - } - - - -//! addition of one dense and one sparse object -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_sparse_type::value && is_same_type::value), - Mat - >::result -operator+ - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - Mat result(x); - - const SpProxy pb(y); - - arma_conform_assert_same_size( result.n_rows, result.n_cols, pb.get_n_rows(), pb.get_n_cols(), "addition" ); - - typename SpProxy::const_iterator_type it = pb.begin(); - typename SpProxy::const_iterator_type it_end = pb.end(); - - while(it != it_end) - { - result.at(it.row(), it.col()) += (*it); - ++it; - } - - return result; - } - - - -//! addition of one sparse and one dense object -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_type::value && is_same_type::value), - Mat - >::result -operator+ - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - const SpProxy pa(x); - - Mat result(y); - - arma_conform_assert_same_size( pa.get_n_rows(), pa.get_n_cols(), result.n_rows, result.n_cols, "addition" ); - - typename SpProxy::const_iterator_type it = pa.begin(); - typename SpProxy::const_iterator_type it_end = pa.end(); - - while(it != it_end) - { - result.at(it.row(), it.col()) += (*it); - ++it; - } - - return result; - } - - - -//! addition of two sparse objects with different element types -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_sparse_type::value && is_same_type::no), - const mtSpGlue< typename promote_type::result, T1, T2, spglue_plus_mixed > - >::result -operator+ - ( - const T1& X, - const T2& Y - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - return mtSpGlue( X, Y ); - } - - - -//! addition of sparse and non-sparse objects with different element types -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_sparse_type::value && is_same_type::no), - Mat< typename promote_type::result > - >::result -operator+ - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - Mat< typename promote_type::result > out; - - spglue_plus_mixed::dense_plus_sparse(out, x, y); - - return out; - } - - - -//! addition of sparse and non-sparse objects with different element types -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_type::value && is_same_type::no), - Mat< typename promote_type::result > - >::result -operator+ - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - Mat< typename promote_type::result > out; - - // Just call the other order (these operations are commutative) - // TODO: if there is a matrix size mismatch, the debug assert will print the matrix sizes in wrong order - spglue_plus_mixed::dense_plus_sparse(out, y, x); - - return out; - } - - - -//! addition of sparse object with scalar -template -inline -typename enable_if2< is_arma_sparse_type::value, const SpToDOp >::result -operator+ - ( - const T1& X, - const typename T1::elem_type k - ) - { - arma_debug_sigprint(); - - return SpToDOp(X, k); - } - - - -template -inline -typename enable_if2< is_arma_sparse_type::value, const SpToDOp >::result -operator+ - ( - const typename T1::elem_type k, - const T1& X - ) - { - arma_debug_sigprint(); - - return SpToDOp(X, k); // NOTE: swapped order - } - - - -// TODO: this is an uncommon use case; remove? -//! multiple applications of add/subtract scalars can be condensed -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && - (is_same_type::value || - is_same_type::value)), - const SpToDOp - >::result -operator+ - ( - const SpToDOp& x, - const typename T1::elem_type k - ) - { - arma_debug_sigprint(); - - const typename T1::elem_type aux = (is_same_type::value) ? x.aux : -x.aux; - - return SpToDOp(x.m, aux + k); - } - - - -// TODO: this is an uncommon use case; remove? -//! multiple applications of add/subtract scalars can be condensed -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && - is_same_type::value), - const SpToDOp - >::result -operator+ - ( - const SpToDOp& x, - const typename T1::elem_type k - ) - { - arma_debug_sigprint(); - - return SpToDOp(x.m, x.aux + k); - } - - - -// TODO: this is an uncommon use case; remove? -//! multiple applications of add/subtract scalars can be condensed -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && - (is_same_type::value || - is_same_type::value)), - const SpToDOp - >::result -operator+ - ( - const typename T1::elem_type k, - const SpToDOp& x - ) - { - arma_debug_sigprint(); - - const typename T1::elem_type aux = (is_same_type::value) ? x.aux : -x.aux; - - return SpToDOp(x.m, aux + k); - } - - - -// TODO: this is an uncommon use case; remove? -//! multiple applications of add/subtract scalars can be condensed -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && - is_same_type::value), - const SpToDOp - >::result -operator+ - ( - const typename T1::elem_type k, - const SpToDOp& x - ) - { - arma_debug_sigprint(); - - return SpToDOp(x.m, x.aux + k); - } - - - - -template -arma_inline -Mat -operator+ - ( - const subview_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return subview_each1_aux::operator_plus(X, Y.get_ref()); - } - - - -template -arma_inline -Mat -operator+ - ( - const Base& X, - const subview_each1& Y - ) - { - arma_debug_sigprint(); - - return subview_each1_aux::operator_plus(Y, X.get_ref()); // NOTE: swapped order - } - - - -template -arma_inline -Mat -operator+ - ( - const subview_each2& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return subview_each2_aux::operator_plus(X, Y.get_ref()); - } - - - -template -arma_inline -Mat -operator+ - ( - const Base& X, - const subview_each2& Y - ) - { - arma_debug_sigprint(); - - return subview_each2_aux::operator_plus(Y, X.get_ref()); // NOTE: swapped order - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_relational.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_relational.hpp deleted file mode 100644 index 5bd6d7cab..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_relational.hpp +++ /dev/null @@ -1,705 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup operator_relational -//! @{ - - -// < : lt -// > : gt -// <= : lteq -// >= : gteq -// == : eq -// != : noteq -// && : and -// || : or - - -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value && (is_cx::no) && (is_cx::no)), - const mtGlue - >::result -operator< -(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - return mtGlue( X, Y ); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value && (is_cx::no) && (is_cx::no)), - const mtGlue - >::result -operator> -(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - return mtGlue( X, Y ); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value && (is_cx::no) && (is_cx::no)), - const mtGlue - >::result -operator<= -(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - return mtGlue( X, Y ); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value && (is_cx::no) && (is_cx::no)), - const mtGlue - >::result -operator>= -(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - return mtGlue( X, Y ); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value), - const mtGlue - >::result -operator== -(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - return mtGlue( X, Y ); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value), - const mtGlue - >::result -operator!= -(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - return mtGlue( X, Y ); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value && (is_cx::no) && (is_cx::no)), - const mtGlue - >::result -operator&& -(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - return mtGlue( X, Y ); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value && (is_cx::no) && (is_cx::no)), - const mtGlue - >::result -operator|| -(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - return mtGlue( X, Y ); - } - - - -// -// -// - - - -template -inline -typename -enable_if2 - < - (is_arma_type::value && (is_cx::no)), - const mtOp - >::result -operator< -(const typename T1::elem_type val, const T1& X) - { - arma_debug_sigprint(); - - return mtOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_type::value && (is_cx::no)), - const mtOp - >::result -operator< -(const T1& X, const typename T1::elem_type val) - { - arma_debug_sigprint(); - - return mtOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_type::value && (is_cx::no)), - const mtOp - >::result -operator> -(const typename T1::elem_type val, const T1& X) - { - arma_debug_sigprint(); - - return mtOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_type::value && (is_cx::no)), - const mtOp - >::result -operator> -(const T1& X, const typename T1::elem_type val) - { - arma_debug_sigprint(); - - return mtOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_type::value && (is_cx::no)), - const mtOp - >::result -operator<= -(const typename T1::elem_type val, const T1& X) - { - arma_debug_sigprint(); - - return mtOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_type::value && (is_cx::no)), - const mtOp - >::result -operator<= -(const T1& X, const typename T1::elem_type val) - { - arma_debug_sigprint(); - - return mtOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_type::value && (is_cx::no)), - const mtOp - >::result -operator>= -(const typename T1::elem_type val, const T1& X) - { - arma_debug_sigprint(); - - return mtOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_type::value && (is_cx::no)), - const mtOp - >::result -operator>= -(const T1& X, const typename T1::elem_type val) - { - arma_debug_sigprint(); - - return mtOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - is_arma_type::value, - const mtOp - >::result -operator== -(const typename T1::elem_type val, const T1& X) - { - arma_debug_sigprint(); - - return mtOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - is_arma_type::value, - const mtOp - >::result -operator== -(const T1& X, const typename T1::elem_type val) - { - arma_debug_sigprint(); - - return mtOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - is_arma_type::value, - const mtOp - >::result -operator!= -(const typename T1::elem_type val, const T1& X) - { - arma_debug_sigprint(); - - return mtOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - is_arma_type::value, - const mtOp - >::result -operator!= -(const T1& X, const typename T1::elem_type val) - { - arma_debug_sigprint(); - - return mtOp(X, val); - } - - - -// - - - -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_sparse_type::value && (is_cx::no) && (is_cx::no)), - const mtSpGlue - >::result -operator< -(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - // TODO: ensure T1::elem_type and T2::elem_type are the same - - return mtSpGlue( X, Y ); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_sparse_type::value && (is_cx::no) && (is_cx::no)), - const mtSpGlue - >::result -operator> -(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - // TODO: ensure T1::elem_type and T2::elem_type are the same - - return mtSpGlue( X, Y ); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_sparse_type::value && (is_cx::no) && (is_cx::no)), - const mtSpGlue - >::result -operator&& -(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - // TODO: ensure T1::elem_type and T2::elem_type are the same - - return mtSpGlue( X, Y ); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_sparse_type::value && (is_cx::no) && (is_cx::no)), - const mtSpGlue - >::result -operator|| -(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - // TODO: ensure T1::elem_type and T2::elem_type are the same - - return mtSpGlue( X, Y ); - } - - - -// -// -// - - - -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && (is_cx::no)), - const mtSpOp - >::result -operator< -(const typename T1::elem_type val, const T1& X) - { - arma_debug_sigprint(); - - return mtSpOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && (is_cx::no)), - const mtSpOp - >::result -operator< -(const T1& X, const typename T1::elem_type val) - { - arma_debug_sigprint(); - - return mtSpOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && (is_cx::no)), - const mtSpOp - >::result -operator> -(const typename T1::elem_type val, const T1& X) - { - arma_debug_sigprint(); - - return mtSpOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && (is_cx::no)), - const mtSpOp - >::result -operator> -(const T1& X, const typename T1::elem_type val) - { - arma_debug_sigprint(); - - return mtSpOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && (is_cx::no)), - const mtSpOp - >::result -operator<= -(const typename T1::elem_type val, const T1& X) - { - arma_debug_sigprint(); - - return mtSpOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && (is_cx::no)), - const mtSpOp - >::result -operator<= -(const T1& X, const typename T1::elem_type val) - { - arma_debug_sigprint(); - - return mtSpOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && (is_cx::no)), - const mtSpOp - >::result -operator>= -(const typename T1::elem_type val, const T1& X) - { - arma_debug_sigprint(); - - return mtSpOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && (is_cx::no)), - const mtSpOp - >::result -operator>= -(const T1& X, const typename T1::elem_type val) - { - arma_debug_sigprint(); - - return mtSpOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - is_arma_sparse_type::value, - const mtSpOp - >::result -operator== -(const typename T1::elem_type val, const T1& X) - { - arma_debug_sigprint(); - - return mtSpOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - is_arma_sparse_type::value, - const mtSpOp - >::result -operator== -(const T1& X, const typename T1::elem_type val) - { - arma_debug_sigprint(); - - return mtSpOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - is_arma_sparse_type::value, - const mtSpOp - >::result -operator!= -(const typename T1::elem_type val, const T1& X) - { - arma_debug_sigprint(); - - return mtSpOp(X, val); - } - - - -template -inline -typename -enable_if2 - < - is_arma_sparse_type::value, - const mtSpOp - >::result -operator!= -(const T1& X, const typename T1::elem_type val) - { - arma_debug_sigprint(); - - return mtSpOp(X, val); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_schur.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_schur.hpp deleted file mode 100644 index dfb0b31b7..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_schur.hpp +++ /dev/null @@ -1,366 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup operator_schur -//! @{ - - -// operator %, which we define it to do a schur product (element-wise multiplication) - - -//! element-wise multiplication of user-accessible Armadillo objects with same element type -template -arma_inline -typename -enable_if2 - < - is_arma_type::value && is_arma_type::value && is_same_type::value, - const eGlue - >::result -operator% - ( - const T1& X, - const T2& Y - ) - { - arma_debug_sigprint(); - - return eGlue(X, Y); - } - - - -//! element-wise multiplication of user-accessible Armadillo objects with different element types -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value && (is_same_type::no)), - const mtGlue::result, T1, T2, glue_mixed_schur> - >::result -operator% - ( - const T1& X, - const T2& Y - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - return mtGlue( X, Y ); - } - - - -//! element-wise multiplication of two sparse matrices -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_sparse_type::value && is_same_type::value), - SpGlue - >::result -operator% - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - return SpGlue(x, y); - } - - - -//! element-wise multiplication of one dense and one sparse object -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_sparse_type::value && is_same_type::value), - SpMat - >::result -operator% - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - SpMat out; - - spglue_schur_misc::dense_schur_sparse(out, x, y); - - return out; - } - - - -//! element-wise multiplication of one sparse and one dense object -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_type::value && is_same_type::value), - SpMat - >::result -operator% - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - SpMat out; - - // Just call the other order (these operations are commutative) - // TODO: if there is a matrix size mismatch, the debug assert will print the matrix sizes in wrong order - spglue_schur_misc::dense_schur_sparse(out, y, x); - - return out; - } - - - -//! optimization: sparse % (sparse +/- scalar) can be done without forming the dense result of the (sparse +/- scalar) term -template -inline -typename -enable_if2 - < - ( - is_arma_sparse_type::value && is_arma_sparse_type::value && - is_same_type::yes && - (is_same_type::value || - is_same_type::value || - is_same_type::value) - ), - SpMat - >::result -operator% - ( - const T1& x, - const SpToDOp& y - ) - { - arma_debug_sigprint(); - - SpMat out; - - op_type::apply_inside_schur(out, x, y); - - return out; - } - - - -//! optimization: (sparse +/- scalar) % sparse can be done without forming the dense result of the (sparse +/- scalar) term -template -inline -typename -enable_if2 - < - ( - is_arma_sparse_type::value && is_arma_sparse_type::value && - is_same_type::yes && - (is_same_type::value || - is_same_type::value || - is_same_type::value) - ), - SpMat - >::result -operator% - ( - const SpToDOp& x, - const T2& y - ) - { - arma_debug_sigprint(); - - SpMat out; - - // Just call the other order (these operations are commutative) - // TODO: if there is a matrix size mismatch, the debug assert will print the matrix sizes in wrong order - op_type::apply_inside_schur(out, y, x); - - return out; - } - - - -//! element-wise multiplication of two sparse objects with different element types -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_sparse_type::value && is_same_type::no), - const mtSpGlue< typename promote_type::result, T1, T2, spglue_schur_mixed > - >::result -operator% - ( - const T1& X, - const T2& Y - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - return mtSpGlue( X, Y ); - } - - - -//! element-wise multiplication of one dense and one sparse object with different element types -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_sparse_type::value && is_same_type::no), - SpMat< typename promote_type::result > - >::result -operator% - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - SpMat< typename promote_type::result > out; - - spglue_schur_mixed::dense_schur_sparse(out, x, y); - - return out; - } - - - -//! element-wise multiplication of one sparse and one dense object with different element types -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_type::value && is_same_type::no), - SpMat< typename promote_type::result > - >::result -operator% - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - SpMat< typename promote_type::result > out; - - // Just call the other order (these operations are commutative) - // TODO: if there is a matrix size mismatch, the debug assert will print the matrix sizes in wrong order - spglue_schur_mixed::dense_schur_sparse(out, y, x); - - return out; - } - - - -template -inline -Mat -operator% - ( - const subview_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return subview_each1_aux::operator_schur(X, Y.get_ref()); - } - - - -template -arma_inline -Mat -operator% - ( - const Base& X, - const subview_each1& Y - ) - { - arma_debug_sigprint(); - - return subview_each1_aux::operator_schur(Y, X.get_ref()); // NOTE: swapped order - } - - - -template -inline -Mat -operator% - ( - const subview_each2& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - return subview_each2_aux::operator_schur(X, Y.get_ref()); - } - - - -template -arma_inline -Mat -operator% - ( - const Base& X, - const subview_each2& Y - ) - { - arma_debug_sigprint(); - - return subview_each2_aux::operator_schur(Y, X.get_ref()); // NOTE: swapped order - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_times.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_times.hpp deleted file mode 100644 index 2070bc6c1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/operator_times.hpp +++ /dev/null @@ -1,482 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup operator_times -//! @{ - - - -//! Base * scalar -template -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -operator* -(const T1& X, const typename T1::elem_type k) - { - arma_debug_sigprint(); - - return eOp(X,k); - } - - - -//! scalar * Base -template -arma_inline -typename enable_if2< is_arma_type::value, const eOp >::result -operator* -(const typename T1::elem_type k, const T1& X) - { - arma_debug_sigprint(); - - return eOp(X,k); // NOTE: order is swapped - } - - - -//! non-complex Base * complex scalar -template -arma_inline -typename -enable_if2 - < - (is_arma_type::value && is_cx::no), - const mtOp, T1, op_cx_scalar_times> - >::result -operator* - ( - const T1& X, - const std::complex& k - ) - { - arma_debug_sigprint(); - - return mtOp, T1, op_cx_scalar_times>('j', X, k); - } - - - -//! complex scalar * non-complex Base -template -arma_inline -typename -enable_if2 - < - (is_arma_type::value && is_cx::no), - const mtOp, T1, op_cx_scalar_times> - >::result -operator* - ( - const std::complex& k, - const T1& X - ) - { - arma_debug_sigprint(); - - return mtOp, T1, op_cx_scalar_times>('j', X, k); - } - - - -//! scalar * trans(T1) -template -arma_inline -const Op -operator* -(const typename T1::elem_type k, const Op& X) - { - arma_debug_sigprint(); - - return Op(X.m, k); - } - - - -//! trans(T1) * scalar -template -arma_inline -const Op -operator* -(const Op& X, const typename T1::elem_type k) - { - arma_debug_sigprint(); - - return Op(X.m, k); - } - - - -//! Base * diagmat -template -arma_inline -typename -enable_if2 - < - (is_arma_type::value && is_same_type::value), - const Glue, glue_times_diag> - >::result -operator* -(const T1& X, const Op& Y) - { - arma_debug_sigprint(); - - return Glue, glue_times_diag>(X, Y); - } - - - -//! diagmat * Base -template -arma_inline -typename -enable_if2 - < - (is_arma_type::value && is_same_type::value), - const Glue, T2, glue_times_diag> - >::result -operator* -(const Op& X, const T2& Y) - { - arma_debug_sigprint(); - - return Glue, T2, glue_times_diag>(X, Y); - } - - - -//! diagmat * diagmat -template -inline -Mat< typename promote_type::result > -operator* -(const Op& X, const Op& Y) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - const diagmat_proxy A(X.m); - const diagmat_proxy B(Y.m); - - arma_conform_assert_mul_size(A.n_rows, A.n_cols, B.n_rows, B.n_cols, "matrix multiplication"); - - Mat out(A.n_rows, B.n_cols, arma_zeros_indicator()); - - const uword A_length = (std::min)(A.n_rows, A.n_cols); - const uword B_length = (std::min)(B.n_rows, B.n_cols); - - const uword N = (std::min)(A_length, B_length); - - for(uword i=0; i::apply( A[i] ) * upgrade_val::apply( B[i] ); - } - - return out; - } - - - -//! multiplication of Base objects with same element type -template -arma_inline -typename -enable_if2 - < - is_arma_type::value && is_arma_type::value && is_same_type::value, - const Glue - >::result -operator* -(const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - return Glue(X, Y); - } - - - -//! multiplication of Base objects with different element types -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_type::value && (is_same_type::no)), - const mtGlue< typename promote_type::result, T1, T2, glue_mixed_times > - >::result -operator* - ( - const T1& X, - const T2& Y - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - return mtGlue( X, Y ); - } - - - -//! sparse multiplied by scalar -template -inline -typename -enable_if2 - < - is_arma_sparse_type::value, - SpOp - >::result -operator* - ( - const T1& X, - const typename T1::elem_type k - ) - { - arma_debug_sigprint(); - - return SpOp(X, k); - } - - - -template -inline -typename -enable_if2 - < - is_arma_sparse_type::value, - SpOp - >::result -operator* - ( - const typename T1::elem_type k, - const T1& X - ) - { - arma_debug_sigprint(); - - return SpOp(X, k); - } - - - -//! non-complex sparse * complex scalar -template -arma_inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_cx::no), - const mtSpOp, T1, spop_cx_scalar_times> - >::result -operator* - ( - const T1& X, - const std::complex& k - ) - { - arma_debug_sigprint(); - - return mtSpOp, T1, spop_cx_scalar_times>('j', X, k); - } - - - -//! complex scalar * non-complex sparse -template -arma_inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_cx::no), - const mtSpOp, T1, spop_cx_scalar_times> - >::result -operator* - ( - const std::complex& k, - const T1& X - ) - { - arma_debug_sigprint(); - - return mtSpOp, T1, spop_cx_scalar_times>('j', X, k); - } - - - -//! multiplication of two sparse objects -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_sparse_type::value && is_same_type::value), - const SpGlue - >::result -operator* - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - return SpGlue(x, y); - } - - - -//! multiplication of one sparse and one dense object -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_type::value && is_same_type::value), - const SpToDGlue - >::result -operator* - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - return SpToDGlue(x, y); - } - - - -//! multiplication of one dense and one sparse object -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_sparse_type::value && is_same_type::value), - const SpToDGlue - >::result -operator* - ( - const T1& x, - const T2& y - ) - { - arma_debug_sigprint(); - - return SpToDGlue(x, y); - } - - - -//! multiplication of two sparse objects with different element types -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_sparse_type::value && (is_same_type::no)), - const mtSpGlue< typename promote_type::result, T1, T2, spglue_times_mixed > - >::result -operator* - ( - const T1& X, - const T2& Y - ) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - return mtSpGlue( X, Y ); - } - - - -//! multiplication of one sparse and one dense object with different element types -template -inline -typename -enable_if2 - < - (is_arma_sparse_type::value && is_arma_type::value && is_same_type::no), - Mat< typename promote_type::result > - >::result -operator* - ( - const T1& X, - const T2& Y - ) - { - arma_debug_sigprint(); - - Mat< typename promote_type::result > out; - - glue_times_sparse_dense::apply_mixed(out, X, Y); - - return out; - } - - - -//! multiplication of one dense and one sparse object with different element types -template -inline -typename -enable_if2 - < - (is_arma_type::value && is_arma_sparse_type::value && is_same_type::no), - Mat< typename promote_type::result > - >::result -operator* - ( - const T1& X, - const T2& Y - ) - { - arma_debug_sigprint(); - - Mat< typename promote_type::result > out; - - glue_times_dense_sparse::apply_mixed(out, X, Y); - - return out; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/podarray_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/podarray_bones.hpp deleted file mode 100644 index 9aa2cf1e8..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/podarray_bones.hpp +++ /dev/null @@ -1,90 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup podarray -//! @{ - - - -struct podarray_prealloc_n_elem - { - static constexpr uword val = 16; - }; - - - -//! A lightweight array for POD types. For internal use only! -template -class podarray - { - public: - - arma_aligned const uword n_elem; //!< number of elements held - arma_aligned eT* mem; //!< pointer to memory used by the object - - - protected: - //! internal memory, to avoid calling the 'new' operator for small amounts of memory. - arma_align_mem eT mem_local[ podarray_prealloc_n_elem::val ]; - - - public: - - inline ~podarray(); - inline podarray(); - - inline podarray (const podarray& x); - inline const podarray& operator=(const podarray& x); - - arma_inline explicit podarray(const uword new_N); - - template - inline explicit podarray(const uword new_N, const arma_initmode_indicator&); - - arma_inline eT& operator[] (const uword i); - arma_inline eT operator[] (const uword i) const; - - arma_inline eT& operator() (const uword i); - arma_inline eT operator() (const uword i) const; - - inline void set_min_size(const uword min_n_elem); - - inline void set_size(const uword new_n_elem); - inline void reset(); - - - inline void fill(const eT val); - - inline void zeros(); - inline void zeros(const uword new_n_elem); - - arma_inline eT* memptr(); - arma_inline const eT* memptr() const; - - inline void copy_row(const Mat& A, const uword row); - - - protected: - - inline void init_cold(const uword new_n_elem); - inline void init_warm(const uword new_n_elem); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/podarray_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/podarray_meat.hpp deleted file mode 100644 index 17be32161..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/podarray_meat.hpp +++ /dev/null @@ -1,309 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup podarray -//! @{ - - -template -inline -podarray::~podarray() - { - arma_debug_sigprint_this(this); - - if(n_elem > podarray_prealloc_n_elem::val ) - { - memory::release( mem ); - } - } - - - -template -inline -podarray::podarray() - : n_elem(0) - , mem (0) - { - arma_debug_sigprint_this(this); - } - - - -template -inline -podarray::podarray(const podarray& x) - : n_elem(x.n_elem) - { - arma_debug_sigprint(); - - const uword x_n_elem = x.n_elem; - - init_cold(x_n_elem); - - arrayops::copy( memptr(), x.memptr(), x_n_elem ); - } - - - -template -inline -const podarray& -podarray::operator=(const podarray& x) - { - arma_debug_sigprint(); - - if(this != &x) - { - const uword x_n_elem = x.n_elem; - - init_warm(x_n_elem); - - arrayops::copy( memptr(), x.memptr(), x_n_elem ); - } - - return *this; - } - - - -template -arma_inline -podarray::podarray(const uword new_n_elem) - : n_elem(new_n_elem) - { - arma_debug_sigprint_this(this); - - init_cold(new_n_elem); - } - - - -template -template -inline -podarray::podarray(const uword new_n_elem, const arma_initmode_indicator&) - : n_elem(new_n_elem) - { - arma_debug_sigprint_this(this); - - init_cold(new_n_elem); - - if(do_zeros) - { - arma_debug_print("podarray::constructor: zeroing memory"); - arrayops::fill_zeros(memptr(), n_elem); - } - } - - - -template -arma_inline -eT -podarray::operator[] (const uword i) const - { - return mem[i]; - } - - - -template -arma_inline -eT& -podarray::operator[] (const uword i) - { - return access::rw(mem[i]); - } - - - -template -arma_inline -eT -podarray::operator() (const uword i) const - { - arma_conform_check_bounds( (i >= n_elem), "podarray::operator(): index out of bounds" ); - - return mem[i]; - } - - - -template -arma_inline -eT& -podarray::operator() (const uword i) - { - arma_conform_check_bounds( (i >= n_elem), "podarray::operator(): index out of bounds" ); - - return access::rw(mem[i]); - } - - - -template -inline -void -podarray::set_min_size(const uword min_n_elem) - { - arma_debug_sigprint(); - - if(min_n_elem > n_elem) { init_warm(min_n_elem); } - } - - - -template -inline -void -podarray::set_size(const uword new_n_elem) - { - arma_debug_sigprint(); - - init_warm(new_n_elem); - } - - - -template -inline -void -podarray::reset() - { - arma_debug_sigprint(); - - init_warm(0); - } - - - -template -inline -void -podarray::fill(const eT val) - { - arma_debug_sigprint(); - - arrayops::inplace_set(memptr(), val, n_elem); - } - - - -template -inline -void -podarray::zeros() - { - arma_debug_sigprint(); - - arrayops::fill_zeros(memptr(), n_elem); - } - - - -template -inline -void -podarray::zeros(const uword new_n_elem) - { - arma_debug_sigprint(); - - init_warm(new_n_elem); - - arrayops::fill_zeros(memptr(), n_elem); - } - - - -template -arma_inline -eT* -podarray::memptr() - { - return mem; - } - - - -template -arma_inline -const eT* -podarray::memptr() const - { - return mem; - } - - - -template -inline -void -podarray::copy_row(const Mat& A, const uword row) - { - arma_debug_sigprint(); - - // note: this function assumes that the podarray has been set to the correct size beforehand - - const uword n_rows = A.n_rows; - const uword n_cols = A.n_cols; - - const eT* A_mem = &(A.at(row,0)); - eT* out_mem = memptr(); - - for(uword i=0; i < n_cols; ++i) - { - out_mem[i] = (*A_mem); - - A_mem += n_rows; - } - } - - - -template -inline -void -podarray::init_cold(const uword new_n_elem) - { - arma_debug_sigprint(); - - mem = (new_n_elem <= podarray_prealloc_n_elem::val) ? mem_local : memory::acquire(new_n_elem); - } - - - -template -inline -void -podarray::init_warm(const uword new_n_elem) - { - arma_debug_sigprint(); - - if(n_elem == new_n_elem) { return; } - - if(n_elem > podarray_prealloc_n_elem::val) { memory::release( mem ); } - - mem = (new_n_elem <= podarray_prealloc_n_elem::val) ? mem_local : memory::acquire(new_n_elem); - - access::rw(n_elem) = new_n_elem; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/promote_type.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/promote_type.hpp deleted file mode 100644 index d53eb3226..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/promote_type.hpp +++ /dev/null @@ -1,216 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup promote_type -//! @{ - - -template -struct is_promotable - { - static constexpr bool value = false; - typedef T1 result; - }; - - -struct is_promotable_ok - { - static constexpr bool value = true; - }; - - -template struct is_promotable : public is_promotable_ok { typedef T result; }; -template struct is_promotable, T> : public is_promotable_ok { typedef std::complex result; }; - -template<> struct is_promotable, std::complex> : public is_promotable_ok { typedef std::complex result; }; -template<> struct is_promotable, float> : public is_promotable_ok { typedef std::complex result; }; -template<> struct is_promotable, double> : public is_promotable_ok { typedef std::complex result; }; - - -template struct is_promotable, u64> : public is_promotable_ok { typedef std::complex result; }; -template struct is_promotable, s64> : public is_promotable_ok { typedef std::complex result; }; -template struct is_promotable, ulng_t> : public is_promotable_ok { typedef std::complex result; }; -template struct is_promotable, slng_t> : public is_promotable_ok { typedef std::complex result; }; -template struct is_promotable, s32> : public is_promotable_ok { typedef std::complex result; }; -template struct is_promotable, u32> : public is_promotable_ok { typedef std::complex result; }; -template struct is_promotable, s16> : public is_promotable_ok { typedef std::complex result; }; -template struct is_promotable, u16> : public is_promotable_ok { typedef std::complex result; }; -template struct is_promotable, s8> : public is_promotable_ok { typedef std::complex result; }; -template struct is_promotable, u8> : public is_promotable_ok { typedef std::complex result; }; - - -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; - -template<> struct is_promotable : public is_promotable_ok { typedef float result; }; -template<> struct is_promotable : public is_promotable_ok { typedef float result; }; -template<> struct is_promotable : public is_promotable_ok { typedef float result; }; -template<> struct is_promotable : public is_promotable_ok { typedef float result; }; -template<> struct is_promotable : public is_promotable_ok { typedef float result; }; -template<> struct is_promotable : public is_promotable_ok { typedef float result; }; -template<> struct is_promotable : public is_promotable_ok { typedef float result; }; -template<> struct is_promotable : public is_promotable_ok { typedef float result; }; -template<> struct is_promotable : public is_promotable_ok { typedef float result; }; -template<> struct is_promotable : public is_promotable_ok { typedef float result; }; - -template<> struct is_promotable : public is_promotable_ok { typedef u64 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef u64 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef u64 result; }; - -template<> struct is_promotable : public is_promotable_ok { typedef s64 result; }; // float ? -template<> struct is_promotable : public is_promotable_ok { typedef s64 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef s64 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef s64 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef s64 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef s64 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef s64 result; }; - -template<> struct is_promotable : public is_promotable_ok { typedef s32 result; }; // float ? -template<> struct is_promotable : public is_promotable_ok { typedef s32 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef s32 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef s32 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef s32 result; }; - -template<> struct is_promotable : public is_promotable_ok { typedef s32 result; }; // float ? -template<> struct is_promotable : public is_promotable_ok { typedef u32 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef s32 result; }; // float ? -template<> struct is_promotable : public is_promotable_ok { typedef u32 result; }; - -template<> struct is_promotable : public is_promotable_ok { typedef s16 result; }; // s32 ? -template<> struct is_promotable : public is_promotable_ok { typedef s16 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef s16 result; }; - -template<> struct is_promotable : public is_promotable_ok { typedef s16 result; }; // s32 ? -template<> struct is_promotable : public is_promotable_ok { typedef u16 result; }; - -template<> struct is_promotable : public is_promotable_ok { typedef s8 result; }; // s16 ? - - - - -// -// mirrored versions - -template struct is_promotable> : public is_promotable_ok { typedef std::complex result; }; - -template<> struct is_promotable, std::complex> : public is_promotable_ok { typedef std::complex result; }; -template<> struct is_promotable> : public is_promotable_ok { typedef std::complex result; }; -template<> struct is_promotable > : public is_promotable_ok { typedef std::complex result; }; - -template struct is_promotable> : public is_promotable_ok { typedef std::complex result; }; -template struct is_promotable> : public is_promotable_ok { typedef std::complex result; }; -template struct is_promotable> : public is_promotable_ok { typedef std::complex result; }; -template struct is_promotable> : public is_promotable_ok { typedef std::complex result; }; -template struct is_promotable> : public is_promotable_ok { typedef std::complex result; }; -template struct is_promotable> : public is_promotable_ok { typedef std::complex result; }; -template struct is_promotable> : public is_promotable_ok { typedef std::complex result; }; -template struct is_promotable> : public is_promotable_ok { typedef std::complex result; }; -template struct is_promotable> : public is_promotable_ok { typedef std::complex result; }; -template struct is_promotable> : public is_promotable_ok { typedef std::complex result; }; - - -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; -template<> struct is_promotable : public is_promotable_ok { typedef double result; }; - -template<> struct is_promotable : public is_promotable_ok { typedef float result; }; -template<> struct is_promotable : public is_promotable_ok { typedef float result; }; -template<> struct is_promotable : public is_promotable_ok { typedef float result; }; -template<> struct is_promotable : public is_promotable_ok { typedef float result; }; -template<> struct is_promotable : public is_promotable_ok { typedef float result; }; -template<> struct is_promotable : public is_promotable_ok { typedef float result; }; -template<> struct is_promotable : public is_promotable_ok { typedef float result; }; -template<> struct is_promotable : public is_promotable_ok { typedef float result; }; -template<> struct is_promotable : public is_promotable_ok { typedef float result; }; -template<> struct is_promotable : public is_promotable_ok { typedef float result; }; - -template<> struct is_promotable : public is_promotable_ok { typedef u64 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef u64 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef u64 result; }; - -template<> struct is_promotable : public is_promotable_ok { typedef s64 result; }; // float ? -template<> struct is_promotable : public is_promotable_ok { typedef s64 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef s64 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef s64 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef s64 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef s64 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef s64 result; }; - -template<> struct is_promotable : public is_promotable_ok { typedef s32 result; }; // float ? -template<> struct is_promotable : public is_promotable_ok { typedef s32 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef s32 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef s32 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef s32 result; }; - -template<> struct is_promotable : public is_promotable_ok { typedef s32 result; }; // float ? -template<> struct is_promotable : public is_promotable_ok { typedef u32 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef s32 result; }; // float ? -template<> struct is_promotable : public is_promotable_ok { typedef u32 result; }; - -template<> struct is_promotable : public is_promotable_ok { typedef s16 result; }; // s32 ? -template<> struct is_promotable : public is_promotable_ok { typedef s16 result; }; -template<> struct is_promotable : public is_promotable_ok { typedef s16 result; }; - -template<> struct is_promotable : public is_promotable_ok { typedef s16 result; }; // s32 ? -template<> struct is_promotable : public is_promotable_ok { typedef u16 result; }; - -template<> struct is_promotable : public is_promotable_ok { typedef s8 result; }; // s16 ? - - - - - -template -struct promote_type - { - inline static void check() - { - arma_type_check(( is_promotable::value == false )); - } - - typedef typename is_promotable::result result; - }; - - - -template -struct eT_promoter - { - typedef typename promote_type::result eT; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/restrictors.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/restrictors.hpp deleted file mode 100644 index 78d84f8ac..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/restrictors.hpp +++ /dev/null @@ -1,229 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup restrictors -//! @{ - - - -// structures for template based restrictions of input/output arguments -// (part of the SFINAE approach) -// http://en.wikipedia.org/wiki/SFINAE - - -template struct arma_scalar_only { }; - -template<> struct arma_scalar_only< u8 > { typedef u8 result; }; -template<> struct arma_scalar_only< s8 > { typedef s8 result; }; -template<> struct arma_scalar_only< u16 > { typedef u16 result; }; -template<> struct arma_scalar_only< s16 > { typedef s16 result; }; -template<> struct arma_scalar_only< u32 > { typedef u32 result; }; -template<> struct arma_scalar_only< s32 > { typedef s32 result; }; -template<> struct arma_scalar_only< u64 > { typedef u64 result; }; -template<> struct arma_scalar_only< s64 > { typedef s64 result; }; -template<> struct arma_scalar_only< ulng_t > { typedef ulng_t result; }; -template<> struct arma_scalar_only< slng_t > { typedef slng_t result; }; -template<> struct arma_scalar_only< float > { typedef float result; }; -template<> struct arma_scalar_only< double > { typedef double result; }; -template<> struct arma_scalar_only< cx_float > { typedef cx_float result; }; -template<> struct arma_scalar_only< cx_double > { typedef cx_double result; }; - - - -template struct arma_integral_only { }; - -template<> struct arma_integral_only< u8 > { typedef u8 result; }; -template<> struct arma_integral_only< s8 > { typedef s8 result; }; -template<> struct arma_integral_only< u16 > { typedef u16 result; }; -template<> struct arma_integral_only< s16 > { typedef s16 result; }; -template<> struct arma_integral_only< u32 > { typedef u32 result; }; -template<> struct arma_integral_only< s32 > { typedef s32 result; }; -template<> struct arma_integral_only< u64 > { typedef u64 result; }; -template<> struct arma_integral_only< s64 > { typedef s64 result; }; -template<> struct arma_integral_only< ulng_t > { typedef ulng_t result; }; -template<> struct arma_integral_only< slng_t > { typedef slng_t result; }; - - - -template struct arma_unsigned_integral_only { }; - -template<> struct arma_unsigned_integral_only< u8 > { typedef u8 result; }; -template<> struct arma_unsigned_integral_only< u16 > { typedef u16 result; }; -template<> struct arma_unsigned_integral_only< u32 > { typedef u32 result; }; -template<> struct arma_unsigned_integral_only< u64 > { typedef u64 result; }; -template<> struct arma_unsigned_integral_only< ulng_t > { typedef ulng_t result; }; - - - -template struct arma_signed_integral_only { }; - -template<> struct arma_signed_integral_only< s8 > { typedef s8 result; }; -template<> struct arma_signed_integral_only< s16 > { typedef s16 result; }; -template<> struct arma_signed_integral_only< s32 > { typedef s32 result; }; -template<> struct arma_signed_integral_only< s64 > { typedef s64 result; }; -template<> struct arma_signed_integral_only< slng_t > { typedef slng_t result; }; - - - -template struct arma_signed_only { }; - -template<> struct arma_signed_only< s8 > { typedef s8 result; }; -template<> struct arma_signed_only< s16 > { typedef s16 result; }; -template<> struct arma_signed_only< s32 > { typedef s32 result; }; -template<> struct arma_signed_only< s64 > { typedef s64 result; }; -template<> struct arma_signed_only< slng_t > { typedef slng_t result; }; -template<> struct arma_signed_only< float > { typedef float result; }; -template<> struct arma_signed_only< double > { typedef double result; }; -template<> struct arma_signed_only< cx_float > { typedef cx_float result; }; -template<> struct arma_signed_only< cx_double > { typedef cx_double result; }; - - - -template struct arma_real_only { }; - -template<> struct arma_real_only< float > { typedef float result; }; -template<> struct arma_real_only< double > { typedef double result; }; - - -template struct arma_real_or_cx_only { }; - -template<> struct arma_real_or_cx_only< float > { typedef float result; }; -template<> struct arma_real_or_cx_only< double > { typedef double result; }; -template<> struct arma_real_or_cx_only< cx_float > { typedef cx_float result; }; -template<> struct arma_real_or_cx_only< cx_double > { typedef cx_double result; }; - - - -template struct arma_cx_only { }; - -template<> struct arma_cx_only< cx_float > { typedef cx_float result; }; -template<> struct arma_cx_only< cx_double > { typedef cx_double result; }; - - - -template struct arma_not_cx { typedef T result; }; -template struct arma_not_cx< std::complex > { }; - - - -template struct arma_blas_type_only { }; - -template<> struct arma_blas_type_only< float > { typedef float result; }; -template<> struct arma_blas_type_only< double > { typedef double result; }; -template<> struct arma_blas_type_only< cx_float > { typedef cx_float result; }; -template<> struct arma_blas_type_only< cx_double > { typedef cx_double result; }; - - - -template struct arma_not_blas_type { typedef T result; }; - -template<> struct arma_not_blas_type< float > { }; -template<> struct arma_not_blas_type< double > { }; -template<> struct arma_not_blas_type< cx_float > { }; -template<> struct arma_not_blas_type< cx_double > { }; - - - -template struct arma_op_rel_only { }; - -template<> struct arma_op_rel_only< op_rel_lt_pre > { typedef int result; }; -template<> struct arma_op_rel_only< op_rel_lt_post > { typedef int result; }; -template<> struct arma_op_rel_only< op_rel_gt_pre > { typedef int result; }; -template<> struct arma_op_rel_only< op_rel_gt_post > { typedef int result; }; -template<> struct arma_op_rel_only< op_rel_lteq_pre > { typedef int result; }; -template<> struct arma_op_rel_only< op_rel_lteq_post > { typedef int result; }; -template<> struct arma_op_rel_only< op_rel_gteq_pre > { typedef int result; }; -template<> struct arma_op_rel_only< op_rel_gteq_post > { typedef int result; }; -template<> struct arma_op_rel_only< op_rel_eq > { typedef int result; }; -template<> struct arma_op_rel_only< op_rel_noteq > { typedef int result; }; - - - -template struct arma_not_op_rel { typedef int result; }; - -template<> struct arma_not_op_rel< op_rel_lt_pre > { }; -template<> struct arma_not_op_rel< op_rel_lt_post > { }; -template<> struct arma_not_op_rel< op_rel_gt_pre > { }; -template<> struct arma_not_op_rel< op_rel_gt_post > { }; -template<> struct arma_not_op_rel< op_rel_lteq_pre > { }; -template<> struct arma_not_op_rel< op_rel_lteq_post > { }; -template<> struct arma_not_op_rel< op_rel_gteq_pre > { }; -template<> struct arma_not_op_rel< op_rel_gteq_post > { }; -template<> struct arma_not_op_rel< op_rel_eq > { }; -template<> struct arma_not_op_rel< op_rel_noteq > { }; - - - -template struct arma_glue_rel_only { }; - -template<> struct arma_glue_rel_only< glue_rel_lt > { typedef int result; }; -template<> struct arma_glue_rel_only< glue_rel_gt > { typedef int result; }; -template<> struct arma_glue_rel_only< glue_rel_lteq > { typedef int result; }; -template<> struct arma_glue_rel_only< glue_rel_gteq > { typedef int result; }; -template<> struct arma_glue_rel_only< glue_rel_eq > { typedef int result; }; -template<> struct arma_glue_rel_only< glue_rel_noteq > { typedef int result; }; -template<> struct arma_glue_rel_only< glue_rel_and > { typedef int result; }; -template<> struct arma_glue_rel_only< glue_rel_or > { typedef int result; }; - - - -template struct arma_spop_rel_only { }; - -template<> struct arma_spop_rel_only< spop_rel_lt_pre > { typedef int result; }; -template<> struct arma_spop_rel_only< spop_rel_lt_post > { typedef int result; }; -template<> struct arma_spop_rel_only< spop_rel_gt_pre > { typedef int result; }; -template<> struct arma_spop_rel_only< spop_rel_gt_post > { typedef int result; }; -template<> struct arma_spop_rel_only< spop_rel_lteq_pre > { typedef int result; }; -template<> struct arma_spop_rel_only< spop_rel_lteq_post > { typedef int result; }; -template<> struct arma_spop_rel_only< spop_rel_gteq_pre > { typedef int result; }; -template<> struct arma_spop_rel_only< spop_rel_gteq_post > { typedef int result; }; -template<> struct arma_spop_rel_only< spop_rel_eq > { typedef int result; }; -template<> struct arma_spop_rel_only< spop_rel_noteq > { typedef int result; }; - - - -template struct arma_Mat_Col_Row_only { }; - -template struct arma_Mat_Col_Row_only< Mat > { typedef Mat result; }; -template struct arma_Mat_Col_Row_only< Col > { typedef Col result; }; -template struct arma_Mat_Col_Row_only< Row > { typedef Row result; }; - - - -template struct arma_Cube_only { }; -template struct arma_Cube_only< Cube > { typedef Cube result; }; - - -template struct arma_SpMat_SpCol_SpRow_only { }; - -template struct arma_SpMat_SpCol_SpRow_only< SpMat > { typedef SpMat result; }; -template struct arma_SpMat_SpCol_SpRow_only< SpCol > { typedef SpCol result; }; -template struct arma_SpMat_SpCol_SpRow_only< SpRow > { typedef SpRow result; }; - - - -template struct enable_if { }; -template<> struct enable_if { typedef int result; }; - - -template struct enable_if2 { }; -template< typename result_type > struct enable_if2 { typedef result_type result; }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/running_stat_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/running_stat_bones.hpp deleted file mode 100644 index bd25e1d27..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/running_stat_bones.hpp +++ /dev/null @@ -1,121 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup running_stat -//! @{ - - - -template -class arma_counter - { - public: - - inline ~arma_counter(); - inline arma_counter(); - - inline const arma_counter& operator++(); - inline void operator++(int); - - inline void reset(); - inline eT value() const; - inline eT value_plus_1() const; - inline eT value_minus_1() const; - - - private: - - arma_aligned eT d_count; - arma_aligned uword i_count; - }; - - - -//! Class for keeping statistics of a continuously sampled process / signal. -//! Useful if the storage of individual samples is not necessary or desired. -//! Also useful if the number of samples is not known beforehand or exceeds -//! available memory. -template -class running_stat - { - public: - - typedef typename get_pod_type::result T; - - - inline ~running_stat(); - inline running_stat(); - - inline void operator() (const T sample); - inline void operator() (const std::complex& sample); - - inline void reset(); - - inline eT mean() const; - - inline T var (const uword norm_type = 0) const; - inline T stddev(const uword norm_type = 0) const; - - inline eT min() const; - inline eT max() const; - inline eT range() const; - - inline T count() const; - - // - // - - private: - - arma_aligned arma_counter counter; - - arma_aligned eT r_mean; - arma_aligned T r_var; - - arma_aligned eT min_val; - arma_aligned eT max_val; - - arma_aligned T min_val_norm; - arma_aligned T max_val_norm; - - - friend class running_stat_aux; - }; - - - -class running_stat_aux - { - public: - - template - inline static void update_stats(running_stat& x, const eT sample, const typename arma_not_cx::result* junk = nullptr); - - template - inline static void update_stats(running_stat& x, const std::complex& sample, const typename arma_not_cx::result* junk = nullptr); - - template - inline static void update_stats(running_stat& x, const typename eT::value_type sample, const typename arma_cx_only::result* junk = nullptr); - - template - inline static void update_stats(running_stat& x, const eT& sample, const typename arma_cx_only::result* junk = nullptr); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/running_stat_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/running_stat_meat.hpp deleted file mode 100644 index 00f73deb2..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/running_stat_meat.hpp +++ /dev/null @@ -1,463 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup running_stat -//! @{ - - - -template -inline -arma_counter::~arma_counter() - { - arma_debug_sigprint_this(this); - } - - - -template -inline -arma_counter::arma_counter() - : d_count( eT(0)) - , i_count(uword(0)) - { - arma_debug_sigprint_this(this); - } - - - -template -inline -const arma_counter& -arma_counter::operator++() - { - if(i_count < ARMA_MAX_UWORD) - { - i_count++; - } - else - { - d_count += eT(ARMA_MAX_UWORD); - i_count = 1; - } - - return *this; - } - - - -template -inline -void -arma_counter::operator++(int) - { - operator++(); - } - - - -template -inline -void -arma_counter::reset() - { - d_count = eT(0); - i_count = uword(0); - } - - - -template -inline -eT -arma_counter::value() const - { - return d_count + eT(i_count); - } - - - -template -inline -eT -arma_counter::value_plus_1() const - { - if(i_count < ARMA_MAX_UWORD) - { - return d_count + eT(i_count + 1); - } - else - { - return d_count + eT(ARMA_MAX_UWORD) + eT(1); - } - } - - - -template -inline -eT -arma_counter::value_minus_1() const - { - if(i_count > 0) - { - return d_count + eT(i_count - 1); - } - else - { - return d_count - eT(1); - } - } - - - -// - - - -template -inline -running_stat::~running_stat() - { - arma_debug_sigprint_this(this); - } - - - -template -inline -running_stat::running_stat() - : r_mean ( eT(0)) - , r_var (typename running_stat::T(0)) - , min_val ( eT(0)) - , max_val ( eT(0)) - , min_val_norm(typename running_stat::T(0)) - , max_val_norm(typename running_stat::T(0)) - { - arma_debug_sigprint_this(this); - } - - - -//! update statistics to reflect new sample -template -inline -void -running_stat::operator() (const typename running_stat::T sample) - { - arma_debug_sigprint(); - - if( arma_isfinite(sample) == false ) - { - arma_warn(3, "running_stat: sample ignored as it is non-finite" ); - return; - } - - running_stat_aux::update_stats(*this, sample); - } - - - -//! update statistics to reflect new sample (version for complex numbers) -template -inline -void -running_stat::operator() (const std::complex< typename running_stat::T >& sample) - { - arma_debug_sigprint(); - - if( arma_isfinite(sample) == false ) - { - arma_warn(3, "running_stat: sample ignored as it is non-finite" ); - return; - } - - running_stat_aux::update_stats(*this, sample); - } - - - -//! set all statistics to zero -template -inline -void -running_stat::reset() - { - arma_debug_sigprint(); - - // typedef typename running_stat::T T; - - counter.reset(); - - r_mean = eT(0); - r_var = T(0); - - min_val = eT(0); - max_val = eT(0); - - min_val_norm = T(0); - max_val_norm = T(0); - } - - - -//! mean or average value -template -inline -eT -running_stat::mean() const - { - arma_debug_sigprint(); - - return r_mean; - } - - - -//! variance -template -inline -typename running_stat::T -running_stat::var(const uword norm_type) const - { - arma_debug_sigprint(); - - const T N = counter.value(); - - if(N > T(1)) - { - if(norm_type == 0) - { - return r_var; - } - else - { - const T N_minus_1 = counter.value_minus_1(); - return (N_minus_1/N) * r_var; - } - } - else - { - return T(0); - } - } - - - -//! standard deviation -template -inline -typename running_stat::T -running_stat::stddev(const uword norm_type) const - { - arma_debug_sigprint(); - - return std::sqrt( (*this).var(norm_type) ); - } - - - -//! minimum value -template -inline -eT -running_stat::min() const - { - arma_debug_sigprint(); - - return min_val; - } - - - -//! maximum value -template -inline -eT -running_stat::max() const - { - arma_debug_sigprint(); - - return max_val; - } - - - -template -inline -eT -running_stat::range() const - { - arma_debug_sigprint(); - - return (max_val - min_val); - } - - - -//! number of samples so far -template -inline -typename get_pod_type::result -running_stat::count() const - { - arma_debug_sigprint(); - - return counter.value(); - } - - - -//! update statistics to reflect new sample (version for non-complex numbers, non-complex sample) -template -inline -void -running_stat_aux::update_stats(running_stat& x, const eT sample, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename running_stat::T T; - - const T N = x.counter.value(); - - if(N > T(0)) - { - if(sample < x.min_val) - { - x.min_val = sample; - } - - if(sample > x.max_val) - { - x.max_val = sample; - } - - const T N_plus_1 = x.counter.value_plus_1(); - const T N_minus_1 = x.counter.value_minus_1(); - - // note: variance has to be updated before the mean - - const eT tmp = sample - x.r_mean; - - x.r_var = N_minus_1/N * x.r_var + (tmp*tmp)/N_plus_1; - - x.r_mean = x.r_mean + (sample - x.r_mean)/N_plus_1; - //x.r_mean = (N/N_plus_1)*x.r_mean + sample/N_plus_1; - //x.r_mean = (x.r_mean + sample/N) * N/N_plus_1; - } - else - { - x.r_mean = sample; - x.min_val = sample; - x.max_val = sample; - - // r_var is initialised to zero - // in the constructor and reset() - } - - x.counter++; - } - - - -//! update statistics to reflect new sample (version for non-complex numbers, complex sample) -template -inline -void -running_stat_aux::update_stats(running_stat& x, const std::complex& sample, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - running_stat_aux::update_stats(x, std::real(sample)); - } - - - -//! update statistics to reflect new sample (version for complex numbers, non-complex sample) -template -inline -void -running_stat_aux::update_stats(running_stat& x, const typename eT::value_type sample, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename eT::value_type T; - - running_stat_aux::update_stats(x, std::complex(sample)); - } - - - -//! alter statistics to reflect new sample (version for complex numbers, complex sample) -template -inline -void -running_stat_aux::update_stats(running_stat& x, const eT& sample, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename eT::value_type T; - - const T sample_norm = std::norm(sample); - const T N = x.counter.value(); - - if(N > T(0)) - { - if(sample_norm < x.min_val_norm) - { - x.min_val_norm = sample_norm; - x.min_val = sample; - } - - if(sample_norm > x.max_val_norm) - { - x.max_val_norm = sample_norm; - x.max_val = sample; - } - - const T N_plus_1 = x.counter.value_plus_1(); - const T N_minus_1 = x.counter.value_minus_1(); - - x.r_var = N_minus_1/N * x.r_var + std::norm(sample - x.r_mean)/N_plus_1; - - x.r_mean = x.r_mean + (sample - x.r_mean)/N_plus_1; - //x.r_mean = (N/N_plus_1)*x.r_mean + sample/N_plus_1; - //x.r_mean = (x.r_mean + sample/N) * N/N_plus_1; - } - else - { - x.r_mean = sample; - x.min_val = sample; - x.max_val = sample; - x.min_val_norm = sample_norm; - x.max_val_norm = sample_norm; - - // r_var is initialised to zero - // in the constructor and reset() - } - - x.counter++; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/running_stat_vec_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/running_stat_vec_bones.hpp deleted file mode 100644 index 13b076c27..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/running_stat_vec_bones.hpp +++ /dev/null @@ -1,157 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup running_stat_vec -//! @{ - - -template struct rsv_get_elem_type_worker { }; -template struct rsv_get_elem_type_worker { typedef obj_type result; }; -template struct rsv_get_elem_type_worker { typedef typename obj_type::elem_type result; }; - -template struct rsv_get_elem_type { typedef typename rsv_get_elem_type_worker::value>::result elem_type; }; - - -template struct rsv_get_return_type1_worker { }; -template struct rsv_get_return_type1_worker { typedef Mat result; }; -template struct rsv_get_return_type1_worker { typedef obj_type result; }; - -template struct rsv_get_return_type1 { typedef typename rsv_get_return_type1_worker::value>::result return_type1; }; - - -template struct rsv_get_return_type2 { }; -template struct rsv_get_return_type2< Mat > { typedef Mat::result> return_type2; }; -template struct rsv_get_return_type2< Row > { typedef Row::result> return_type2; }; -template struct rsv_get_return_type2< Col > { typedef Col::result> return_type2; }; - - -//! Class for keeping statistics of a continuously sampled process / signal. -//! Useful if the storage of individual samples is not necessary or desired. -//! Also useful if the number of samples is not known beforehand or exceeds -//! available memory. -template -class running_stat_vec - { - public: - - // voodoo for compatibility with old user code - typedef typename rsv_get_elem_type::elem_type eT; - - typedef typename get_pod_type::result T; - - typedef typename rsv_get_return_type1::return_type1 return_type1; - typedef typename rsv_get_return_type2::return_type2 return_type2; - - inline ~running_stat_vec(); - inline running_stat_vec(const bool in_calc_cov = false); // TODO: investigate char* overload, eg. "calc_cov", "no_calc_cov" - - inline running_stat_vec(const running_stat_vec& in_rsv); - - inline running_stat_vec& operator=(const running_stat_vec& in_rsv); - - template inline void operator() (const Base< T, T1>& X); - template inline void operator() (const Base, T1>& X); - - inline void reset(); - - inline const return_type1& mean() const; - - inline const return_type2& var (const uword norm_type = 0); - inline return_type2 stddev(const uword norm_type = 0) const; - inline const Mat& cov (const uword norm_type = 0); - - inline const return_type1& min() const; - inline const return_type1& max() const; - inline return_type1 range() const; - - inline T count() const; - - // - // - - private: - - const bool calc_cov; - - arma_aligned arma_counter counter; - - arma_aligned return_type1 r_mean; - arma_aligned return_type2 r_var; - arma_aligned Mat r_cov; - - arma_aligned return_type1 min_val; - arma_aligned return_type1 max_val; - - arma_aligned Mat< T> min_val_norm; - arma_aligned Mat< T> max_val_norm; - - arma_aligned return_type2 r_var_dummy; - arma_aligned Mat r_cov_dummy; - - arma_aligned Mat tmp1; - arma_aligned Mat tmp2; - - friend class running_stat_vec_aux; - }; - - - -class running_stat_vec_aux - { - public: - - template - inline static void - update_stats - ( - running_stat_vec& x, - const Mat::eT>& sample, - const typename arma_not_cx::eT>::result* junk = nullptr - ); - - template - inline static void - update_stats - ( - running_stat_vec& x, - const Mat::T > >& sample, - const typename arma_not_cx::eT>::result* junk = nullptr - ); - - template - inline static void - update_stats - ( - running_stat_vec& x, - const Mat< typename running_stat_vec::T >& sample, - const typename arma_cx_only::eT>::result* junk = nullptr - ); - - template - inline static void - update_stats - ( - running_stat_vec& x, - const Mat::eT>& sample, - const typename arma_cx_only::eT>::result* junk = nullptr - ); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/running_stat_vec_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/running_stat_vec_meat.hpp deleted file mode 100644 index d949ac81f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/running_stat_vec_meat.hpp +++ /dev/null @@ -1,636 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup running_stat_vec -//! @{ - - - -template -inline -running_stat_vec::~running_stat_vec() - { - arma_debug_sigprint_this(this); - } - - - -template -inline -running_stat_vec::running_stat_vec(const bool in_calc_cov) - : calc_cov(in_calc_cov) - { - arma_debug_sigprint_this(this); - } - - - -template -inline -running_stat_vec::running_stat_vec(const running_stat_vec& in_rsv) - : calc_cov (in_rsv.calc_cov) - , counter (in_rsv.counter) - , r_mean (in_rsv.r_mean) - , r_var (in_rsv.r_var) - , r_cov (in_rsv.r_cov) - , min_val (in_rsv.min_val) - , max_val (in_rsv.max_val) - , min_val_norm(in_rsv.min_val_norm) - , max_val_norm(in_rsv.max_val_norm) - { - arma_debug_sigprint_this(this); - } - - - -template -inline -running_stat_vec& -running_stat_vec::operator=(const running_stat_vec& in_rsv) - { - arma_debug_sigprint(); - - access::rw(calc_cov) = in_rsv.calc_cov; - - counter = in_rsv.counter; - r_mean = in_rsv.r_mean; - r_var = in_rsv.r_var; - r_cov = in_rsv.r_cov; - min_val = in_rsv.min_val; - max_val = in_rsv.max_val; - min_val_norm = in_rsv.min_val_norm; - max_val_norm = in_rsv.max_val_norm; - - return *this; - } - - - -//! update statistics to reflect new sample -template -template -inline -void -running_stat_vec::operator() (const Base::T, T1>& X) - { - arma_debug_sigprint(); - - const quasi_unwrap tmp(X.get_ref()); - const Mat& sample = tmp.M; - - if( sample.is_empty() ) - { - return; - } - - if( sample.internal_has_nonfinite() ) - { - arma_warn(3, "running_stat_vec: sample ignored as it has non-finite elements"); - return; - } - - running_stat_vec_aux::update_stats(*this, sample); - } - - - -template -template -inline -void -running_stat_vec::operator() (const Base< std::complex::T>, T1>& X) - { - arma_debug_sigprint(); - - const quasi_unwrap tmp(X.get_ref()); - - const Mat< std::complex >& sample = tmp.M; - - if( sample.is_empty() ) - { - return; - } - - if( sample.internal_has_nonfinite() ) - { - arma_warn(3, "running_stat_vec: sample ignored as it has non-finite elements"); - return; - } - - running_stat_vec_aux::update_stats(*this, sample); - } - - - -//! set all statistics to zero -template -inline -void -running_stat_vec::reset() - { - arma_debug_sigprint(); - - counter.reset(); - - r_mean.reset(); - r_var.reset(); - r_cov.reset(); - - min_val.reset(); - max_val.reset(); - - min_val_norm.reset(); - max_val_norm.reset(); - - r_var_dummy.reset(); - r_cov_dummy.reset(); - - tmp1.reset(); - tmp2.reset(); - } - - - -//! mean or average value -template -inline -const typename running_stat_vec::return_type1& -running_stat_vec::mean() const - { - arma_debug_sigprint(); - - return r_mean; - } - - - -//! variance -template -inline -const typename running_stat_vec::return_type2& -running_stat_vec::var(const uword norm_type) - { - arma_debug_sigprint(); - - const T N = counter.value(); - - if(N > T(1)) - { - if(norm_type == 0) - { - return r_var; - } - else - { - const T N_minus_1 = counter.value_minus_1(); - - r_var_dummy = (N_minus_1/N) * r_var; - - return r_var_dummy; - } - } - else - { - r_var_dummy.zeros(r_mean.n_rows, r_mean.n_cols); - - return r_var_dummy; - } - - } - - - -//! standard deviation -template -inline -typename running_stat_vec::return_type2 -running_stat_vec::stddev(const uword norm_type) const - { - arma_debug_sigprint(); - - const T N = counter.value(); - - if(N > T(1)) - { - if(norm_type == 0) - { - return sqrt(r_var); - } - else - { - const T N_minus_1 = counter.value_minus_1(); - - return sqrt( (N_minus_1/N) * r_var ); - } - } - else - { - typedef typename running_stat_vec::return_type2 out_type; - return out_type(); - } - } - - - -//! covariance -template -inline -const Mat< typename running_stat_vec::eT >& -running_stat_vec::cov(const uword norm_type) - { - arma_debug_sigprint(); - - if(calc_cov) - { - const T N = counter.value(); - - if(N > T(1)) - { - if(norm_type == 0) - { - return r_cov; - } - else - { - const T N_minus_1 = counter.value_minus_1(); - - r_cov_dummy = (N_minus_1/N) * r_cov; - - return r_cov_dummy; - } - } - else - { - const uword out_size = (std::max)(r_mean.n_rows, r_mean.n_cols); - - r_cov_dummy.zeros(out_size, out_size); - - return r_cov_dummy; - } - } - else - { - r_cov_dummy.reset(); - - return r_cov_dummy; - } - - } - - - -//! vector with minimum values -template -inline -const typename running_stat_vec::return_type1& -running_stat_vec::min() const - { - arma_debug_sigprint(); - - return min_val; - } - - - -//! vector with maximum values -template -inline -const typename running_stat_vec::return_type1& -running_stat_vec::max() const - { - arma_debug_sigprint(); - - return max_val; - } - - - -template -inline -typename running_stat_vec::return_type1 -running_stat_vec::range() const - { - arma_debug_sigprint(); - - return (max_val - min_val); - } - - - -//! number of samples so far -template -inline -typename running_stat_vec::T -running_stat_vec::count() const - { - arma_debug_sigprint(); - - return counter.value(); - } - - - -// - - - -//! update statistics to reflect new sample (version for non-complex numbers) -template -inline -void -running_stat_vec_aux::update_stats - ( - running_stat_vec& x, - const Mat::eT>& sample, - const typename arma_not_cx::eT>::result* junk - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename running_stat_vec::eT eT; - typedef typename running_stat_vec::T T; - - const T N = x.counter.value(); - - if(N > T(0)) - { - arma_conform_assert_same_size(x.r_mean, sample, "running_stat_vec(): dimensionality mismatch"); - - const uword n_elem = sample.n_elem; - const eT* sample_mem = sample.memptr(); - eT* r_mean_mem = x.r_mean.memptr(); - T* r_var_mem = x.r_var.memptr(); - eT* min_val_mem = x.min_val.memptr(); - eT* max_val_mem = x.max_val.memptr(); - - const T N_plus_1 = x.counter.value_plus_1(); - const T N_minus_1 = x.counter.value_minus_1(); - - if(x.calc_cov) - { - Mat& tmp1 = x.tmp1; - Mat& tmp2 = x.tmp2; - - tmp1 = sample - x.r_mean; - - if(sample.n_cols == 1) - { - tmp2 = tmp1*trans(tmp1); - } - else - { - tmp2 = trans(tmp1)*tmp1; - } - - x.r_cov *= (N_minus_1/N); - x.r_cov += tmp2 / N_plus_1; - } - - - for(uword i=0; i max_val_mem[i]) - { - max_val_mem[i] = val; - } - - const eT r_mean_val = r_mean_mem[i]; - const eT tmp = val - r_mean_val; - - r_var_mem[i] = N_minus_1/N * r_var_mem[i] + (tmp*tmp)/N_plus_1; - - r_mean_mem[i] = r_mean_val + (val - r_mean_val)/N_plus_1; - } - } - else - { - arma_conform_check( (sample.is_vec() == false), "running_stat_vec(): given sample must be a vector" ); - - x.r_mean.set_size(sample.n_rows, sample.n_cols); - - x.r_var.zeros(sample.n_rows, sample.n_cols); - - if(x.calc_cov) - { - x.r_cov.zeros(sample.n_elem, sample.n_elem); - } - - x.min_val.set_size(sample.n_rows, sample.n_cols); - x.max_val.set_size(sample.n_rows, sample.n_cols); - - - const uword n_elem = sample.n_elem; - const eT* sample_mem = sample.memptr(); - eT* r_mean_mem = x.r_mean.memptr(); - eT* min_val_mem = x.min_val.memptr(); - eT* max_val_mem = x.max_val.memptr(); - - - for(uword i=0; i -inline -void -running_stat_vec_aux::update_stats - ( - running_stat_vec& x, - const Mat::T > >& sample, - const typename arma_not_cx::eT>::result* junk - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename running_stat_vec::eT eT; - - running_stat_vec_aux::update_stats(x, conv_to< Mat >::from(sample)); - } - - - -//! update statistics to reflect new sample (version for complex numbers, non-complex sample) -template -inline -void -running_stat_vec_aux::update_stats - ( - running_stat_vec& x, - const Mat::T >& sample, - const typename arma_cx_only::eT>::result* junk - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename running_stat_vec::eT eT; - - running_stat_vec_aux::update_stats(x, conv_to< Mat >::from(sample)); - } - - - -//! alter statistics to reflect new sample (version for complex numbers, complex sample) -template -inline -void -running_stat_vec_aux::update_stats - ( - running_stat_vec& x, - const Mat::eT>& sample, - const typename arma_cx_only::eT>::result* junk - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename running_stat_vec::eT eT; - typedef typename running_stat_vec::T T; - - const T N = x.counter.value(); - - if(N > T(0)) - { - arma_conform_assert_same_size(x.r_mean, sample, "running_stat_vec(): dimensionality mismatch"); - - const uword n_elem = sample.n_elem; - const eT* sample_mem = sample.memptr(); - eT* r_mean_mem = x.r_mean.memptr(); - T* r_var_mem = x.r_var.memptr(); - eT* min_val_mem = x.min_val.memptr(); - eT* max_val_mem = x.max_val.memptr(); - T* min_val_norm_mem = x.min_val_norm.memptr(); - T* max_val_norm_mem = x.max_val_norm.memptr(); - - const T N_plus_1 = x.counter.value_plus_1(); - const T N_minus_1 = x.counter.value_minus_1(); - - if(x.calc_cov) - { - Mat& tmp1 = x.tmp1; - Mat& tmp2 = x.tmp2; - - tmp1 = sample - x.r_mean; - - if(sample.n_cols == 1) - { - tmp2 = arma::conj(tmp1)*strans(tmp1); - } - else - { - tmp2 = trans(tmp1)*tmp1; //tmp2 = strans(conj(tmp1))*tmp1; - } - - x.r_cov *= (N_minus_1/N); - x.r_cov += tmp2 / N_plus_1; - } - - - for(uword i=0; i max_val_norm_mem[i]) - { - max_val_norm_mem[i] = val_norm; - max_val_mem[i] = val; - } - - const eT& r_mean_val = r_mean_mem[i]; - - r_var_mem[i] = N_minus_1/N * r_var_mem[i] + std::norm(val - r_mean_val)/N_plus_1; - - r_mean_mem[i] = r_mean_val + (val - r_mean_val)/N_plus_1; - } - } - else - { - arma_conform_check( (sample.is_vec() == false), "running_stat_vec(): given sample must be a vector" ); - - x.r_mean.set_size(sample.n_rows, sample.n_cols); - - x.r_var.zeros(sample.n_rows, sample.n_cols); - - if(x.calc_cov) - { - x.r_cov.zeros(sample.n_elem, sample.n_elem); - } - - x.min_val.set_size(sample.n_rows, sample.n_cols); - x.max_val.set_size(sample.n_rows, sample.n_cols); - - x.min_val_norm.set_size(sample.n_rows, sample.n_cols); - x.max_val_norm.set_size(sample.n_rows, sample.n_cols); - - - const uword n_elem = sample.n_elem; - const eT* sample_mem = sample.memptr(); - eT* r_mean_mem = x.r_mean.memptr(); - eT* min_val_mem = x.min_val.memptr(); - eT* max_val_mem = x.max_val.memptr(); - T* min_val_norm_mem = x.min_val_norm.memptr(); - T* max_val_norm_mem = x.max_val_norm.memptr(); - - for(uword i=0; i - inline static bool eigs_sym(Col& eigval, Mat& eigvec, const SpBase& X, const uword n_eigvals, const form_type form_val, const eigs_opts& opts); - - template - inline static bool eigs_sym(Col& eigval, Mat& eigvec, const SpBase& X, const uword n_eigvals, const eT sigma, const eigs_opts& opts); - - template - inline static bool eigs_sym_newarp(Col& eigval, Mat& eigvec, const SpMat& X, const uword n_eigvals, const form_type form_val, const eigs_opts& opts); - - template - inline static bool eigs_sym_newarp(Col& eigval, Mat& eigvec, const SpMat& X, const uword n_eigvals, const eT sigma, const eigs_opts& opts); - - template - inline static bool eigs_sym_arpack(Col& eigval, Mat& eigvec, const SpMat& X, const uword n_eigvals, const form_type form_val, const eT sigma, const eigs_opts& opts); - - // - // eigs_gen() for real matrices - - template - inline static bool eigs_gen(Col< std::complex >& eigval, Mat< std::complex >& eigvec, const SpBase& X, const uword n_eigvals, const form_type form_val, const eigs_opts& opts); - - template - inline static bool eigs_gen(Col< std::complex >& eigval, Mat< std::complex >& eigvec, const SpBase& X, const uword n_eigvals, const std::complex sigma, const eigs_opts& opts); - - template - inline static bool eigs_gen_newarp(Col< std::complex >& eigval, Mat< std::complex >& eigvec, const SpMat& X, const uword n_eigvals, const form_type form_val, const eigs_opts& opts); - - template - inline static bool eigs_gen_arpack(Col< std::complex >& eigval, Mat< std::complex >& eigvec, const SpMat& X, const uword n_eigvals, const form_type form_val, const std::complex sigma, const eigs_opts& opts); - - // - // eigs_gen() for complex matrices - - template - inline static bool eigs_gen(Col< std::complex >& eigval, Mat< std::complex >& eigvec, const SpBase< std::complex, T1>& X, const uword n_eigvals, const form_type form_val, const eigs_opts& opts); - - template - inline static bool eigs_gen(Col< std::complex >& eigval, Mat< std::complex >& eigvec, const SpBase< std::complex, T1>& X, const uword n_eigvals, const std::complex sigma, const eigs_opts& opts); - - template - inline static bool eigs_gen(Col< std::complex >& eigval, Mat< std::complex >& eigvec, const SpMat< std::complex >& X, const uword n_eigvals, const form_type form_val, const std::complex sigma, const eigs_opts& opts); - - // - // spsolve() via SuperLU - - template - inline static bool spsolve_simple(Mat& out, const SpBase& A, const Base& B, const superlu_opts& user_opts); - - template - inline static bool spsolve_refine(Mat& out, typename T1::pod_type& out_rcond, const SpBase& A, const Base& B, const superlu_opts& user_opts); - - // - // support functions - - #if defined(ARMA_USE_SUPERLU) - - template - inline static typename get_pod_type::result norm1(superlu::SuperMatrix* A); - - template - inline static typename get_pod_type::result lu_rcond(superlu::SuperMatrix* L, superlu::SuperMatrix* U, typename get_pod_type::result norm_val); - - inline static void set_superlu_opts(superlu::superlu_options_t& options, const superlu_opts& user_opts); - - template - inline static bool copy_to_supermatrix(superlu::SuperMatrix& out, const SpMat& A); - - template - inline static bool copy_to_supermatrix_with_shift(superlu::SuperMatrix& out, const SpMat& A, const eT shift); - - // // for debugging only - // template - // inline static void copy_to_spmat(SpMat& out, const superlu::SuperMatrix& A); - - template - inline static bool wrap_to_supermatrix(superlu::SuperMatrix& out, const Mat& A); - - inline static void destroy_supermatrix(superlu::SuperMatrix& out); - - #endif - - - - private: - - // calls arpack saupd()/naupd() because the code is so similar for each - // all of the extra variables are later used by seupd()/neupd(), but those - // functions are very different and we can't combine their code - - template - inline static void run_aupd_plain - ( - const uword n_eigvals, char* which, - const SpMat& X, const SpMat& Xst, const bool sym, - blas_int& n, eT& tol, blas_int& maxiter, - podarray& resid, blas_int& ncv, podarray& v, blas_int& ldv, - podarray& iparam, podarray& ipntr, - podarray& workd, podarray& workl, blas_int& lworkl, podarray& rwork, - blas_int& info - ); - - template - inline static void run_aupd_shiftinvert - ( - const uword n_eigvals, const T sigma, - const SpMat& X, const bool sym, - blas_int& n, eT& tol, blas_int& maxiter, - podarray& resid, blas_int& ncv, podarray& v, blas_int& ldv, - podarray& iparam, podarray& ipntr, - podarray& workd, podarray& workl, blas_int& lworkl, podarray& rwork, - blas_int& info - ); - - - template - inline static bool rudimentary_sym_check(const SpMat& X); - - template - inline static bool rudimentary_sym_check(const SpMat< std::complex >& X); - }; - - - -template -struct eigs_randu_filler - { - std::mt19937_64 local_engine; - std::uniform_real_distribution local_u_distr; - - inline eigs_randu_filler(); - - inline void fill(podarray& X, const uword N); - }; - - -template -struct eigs_randu_filler< std::complex > - { - std::mt19937_64 local_engine; - std::uniform_real_distribution local_u_distr; - - inline eigs_randu_filler(); - - inline void fill(podarray< std::complex >& X, const uword N); - }; - - - -#if defined(ARMA_USE_SUPERLU) - -class superlu_supermatrix_wrangler - { - private: - - bool used = false; - - arma_aligned superlu::SuperMatrix m; - - public: - - inline ~superlu_supermatrix_wrangler(); - inline superlu_supermatrix_wrangler(); - - inline superlu_supermatrix_wrangler(const superlu_supermatrix_wrangler&) = delete; - inline void operator= (const superlu_supermatrix_wrangler&) = delete; - - inline superlu::SuperMatrix& get_ref(); - inline superlu::SuperMatrix* get_ptr(); - }; - - -class superlu_stat_wrangler - { - private: - - arma_aligned superlu::SuperLUStat_t stat; - - public: - - inline ~superlu_stat_wrangler(); - inline superlu_stat_wrangler(); - - inline superlu_stat_wrangler(const superlu_stat_wrangler&) = delete; - inline void operator= (const superlu_stat_wrangler&) = delete; - - inline superlu::SuperLUStat_t* get_ptr(); - }; - - -template -class superlu_array_wrangler - { - private: - - arma_aligned eT* mem = nullptr; - - public: - - inline ~superlu_array_wrangler(); - inline superlu_array_wrangler(); - inline superlu_array_wrangler(const uword n_elem); - - inline void set_size(const uword n_elem); - inline void reset(); - - inline superlu_array_wrangler(const superlu_array_wrangler&) = delete; - inline void operator= (const superlu_array_wrangler&) = delete; - - inline eT* get_ptr(); - }; - - -template -class superlu_worker - { - private: - - bool factorisation_valid = false; - - superlu_supermatrix_wrangler* l = nullptr; - superlu_supermatrix_wrangler* u = nullptr; - - superlu_array_wrangler perm_c; - superlu_array_wrangler perm_r; - - superlu_stat_wrangler stat; - - public: - - inline ~superlu_worker(); - inline superlu_worker(); - - inline bool factorise(typename get_pod_type::result& out_rcond, const SpMat& A, const superlu_opts& user_opts); - - inline bool solve(Mat& X, const Mat& B); - - inline superlu_worker(const superlu_worker&) = delete; - inline void operator= (const superlu_worker&) = delete; - }; - -#endif - - - -//! @} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/sp_auxlib_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/sp_auxlib_meat.hpp deleted file mode 100644 index 4c91d02cf..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/sp_auxlib_meat.hpp +++ /dev/null @@ -1,2777 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup sp_auxlib -//! @{ - - -inline -sp_auxlib::form_type -sp_auxlib::interpret_form_str(const char* form_str) - { - arma_debug_sigprint(); - - // the order of the 3 if statements below is important - if( form_str == nullptr ) { return form_none; } - if( form_str[0] == char(0) ) { return form_none; } - if( form_str[1] == char(0) ) { return form_none; } - - const char c1 = form_str[0]; - const char c2 = form_str[1]; - - if(c1 == 'l') - { - if(c2 == 'm') { return form_lm; } - if(c2 == 'r') { return form_lr; } - if(c2 == 'i') { return form_li; } - if(c2 == 'a') { return form_la; } - } - else - if(c1 == 's') - { - if(c2 == 'm') { return form_sm; } - if(c2 == 'r') { return form_sr; } - if(c2 == 'i') { return form_si; } - if(c2 == 'a') { return form_sa; } - } - - return form_none; - } - - - -//! immediate eigendecomposition of symmetric real sparse object -template -inline -bool -sp_auxlib::eigs_sym(Col& eigval, Mat& eigvec, const SpBase& X, const uword n_eigvals, const form_type form_val, const eigs_opts& opts) - { - arma_debug_sigprint(); - - const unwrap_spmat U(X.get_ref()); - - arma_conform_check( (U.M.is_square() == false), "eigs_sym(): given matrix must be square sized" ); - - if((arma_config::check_conform) && (sp_auxlib::rudimentary_sym_check(U.M) == false)) - { - if(is_cx::no ) { arma_warn(1, "eigs_sym(): given matrix is not symmetric"); } - if(is_cx::yes) { arma_warn(1, "eigs_sym(): given matrix is not hermitian"); } - } - - if(arma_config::check_nonfinite && U.M.internal_has_nonfinite()) - { - arma_warn(3, "eigs_sym(): detected non-finite elements"); - return false; - } - - // TODO: investigate optional redirection of "sm" to ARPACK as it's capable of shift-invert; - // TODO: in shift-invert mode, "sm" maps to "lm" of the shift-inverted matrix (with sigma = 0) - - #if defined(ARMA_USE_NEWARP) - { - return sp_auxlib::eigs_sym_newarp(eigval, eigvec, U.M, n_eigvals, form_val, opts); - } - #elif defined(ARMA_USE_ARPACK) - { - constexpr eT sigma = eT(0); - - return sp_auxlib::eigs_sym_arpack(eigval, eigvec, U.M, n_eigvals, form_val, sigma, opts); - } - #else - { - arma_ignore(eigval); - arma_ignore(eigvec); - arma_ignore(n_eigvals); - arma_ignore(form_val); - arma_ignore(opts); - - arma_stop_logic_error("eigs_sym(): use of NEWARP or ARPACK must be enabled"); - return false; - } - #endif - } - - - -//! immediate eigendecomposition of symmetric real sparse object -template -inline -bool -sp_auxlib::eigs_sym(Col& eigval, Mat& eigvec, const SpBase& X, const uword n_eigvals, const eT sigma, const eigs_opts& opts) - { - arma_debug_sigprint(); - - const unwrap_spmat U(X.get_ref()); - - arma_conform_check( (U.M.is_square() == false), "eigs_sym(): given matrix must be square sized" ); - - if((arma_config::check_conform) && (sp_auxlib::rudimentary_sym_check(U.M) == false)) - { - if(is_cx::no ) { arma_warn(1, "eigs_sym(): given matrix is not symmetric"); } - if(is_cx::yes) { arma_warn(1, "eigs_sym(): given matrix is not hermitian"); } - } - - if(arma_config::check_nonfinite && U.M.internal_has_nonfinite()) - { - arma_warn(3, "eigs_sym(): detected non-finite elements"); - return false; - } - - #if (defined(ARMA_USE_NEWARP) && defined(ARMA_USE_SUPERLU)) - { - return sp_auxlib::eigs_sym_newarp(eigval, eigvec, U.M, n_eigvals, sigma, opts); - } - #elif (defined(ARMA_USE_ARPACK) && defined(ARMA_USE_SUPERLU)) - { - constexpr form_type form_val = form_sigma; - - return sp_auxlib::eigs_sym_arpack(eigval, eigvec, U.M, n_eigvals, form_val, sigma, opts); - } - #else - { - arma_ignore(eigval); - arma_ignore(eigvec); - arma_ignore(n_eigvals); - arma_ignore(sigma); - arma_ignore(opts); - - arma_stop_logic_error("eigs_sym(): use of NEWARP or ARPACK as well as SuperLU must be enabled to use 'sigma'"); - return false; - } - #endif - } - - - -template -inline -bool -sp_auxlib::eigs_sym_newarp(Col& eigval, Mat& eigvec, const SpMat& X, const uword n_eigvals, const form_type form_val, const eigs_opts& opts) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_NEWARP) - { - arma_conform_check( (form_val != form_lm) && (form_val != form_sm) && (form_val != form_la) && (form_val != form_sa), "eigs_sym(): unknown form specified" ); - - if(X.is_square() == false) { return false; } - - const newarp::SparseGenMatProd op(X); - - arma_conform_check( (n_eigvals >= op.n_rows), "eigs_sym(): n_eigvals must be less than the number of rows in the matrix" ); - - // If the matrix is empty, the case is trivial. - if( (op.n_cols == 0) || (n_eigvals == 0) ) // We already know n_cols == n_rows. - { - eigval.reset(); - eigvec.reset(); - return true; - } - - uword n = op.n_rows; - - // Use max(2*k+1, 20) as default subspace dimension for the sym case; MATLAB uses max(2*k, 20), but we need to be backward-compatible. - uword ncv_default = uword( ((2*n_eigvals+1)>(20)) ? (2*n_eigvals+1) : (20) ); - - // Use opts.subdim only if it's within the limits, otherwise cap it. - uword ncv = ncv_default; - - if(opts.subdim != 0) - { - if(opts.subdim < (n_eigvals + 1)) - { - arma_warn(1, "eigs_sym(): opts.subdim must be greater than k; using k+1 instead of ", opts.subdim); - ncv = uword(n_eigvals + 1); - } - else - if(opts.subdim > n) - { - arma_warn(1, "eigs_sym(): opts.subdim cannot be greater than n_rows; using n_rows instead of ", opts.subdim); - ncv = n; - } - else - { - ncv = uword(opts.subdim); - } - } - - // Re-check that we are within the limits - if(ncv < (n_eigvals + 1)) { ncv = (n_eigvals + 1); } - if(ncv > n ) { ncv = n; } - - eT tol = (std::max)(eT(opts.tol), std::numeric_limits::epsilon()); - - uword maxiter = uword(opts.maxiter); - - // eigval.set_size(n_eigvals); - // eigvec.set_size(n, n_eigvals); - - bool status = true; - - uword nconv = 0; - - try - { - if(form_val == form_lm) - { - newarp::SymEigsSolver< eT, newarp::EigsSelect::LARGEST_MAGN, newarp::SparseGenMatProd > eigs(op, n_eigvals, ncv); - eigs.init(); - nconv = eigs.compute(maxiter, tol); - eigval = eigs.eigenvalues(); - eigvec = eigs.eigenvectors(); - } - else - if(form_val == form_sm) - { - newarp::SymEigsSolver< eT, newarp::EigsSelect::SMALLEST_MAGN, newarp::SparseGenMatProd > eigs(op, n_eigvals, ncv); - eigs.init(); - nconv = eigs.compute(maxiter, tol); - eigval = eigs.eigenvalues(); - eigvec = eigs.eigenvectors(); - } - else - if(form_val == form_la) - { - newarp::SymEigsSolver< eT, newarp::EigsSelect::LARGEST_ALGE, newarp::SparseGenMatProd > eigs(op, n_eigvals, ncv); - eigs.init(); - nconv = eigs.compute(maxiter, tol); - eigval = eigs.eigenvalues(); - eigvec = eigs.eigenvectors(); - } - else - if(form_val == form_sa) - { - newarp::SymEigsSolver< eT, newarp::EigsSelect::SMALLEST_ALGE, newarp::SparseGenMatProd > eigs(op, n_eigvals, ncv); - eigs.init(); - nconv = eigs.compute(maxiter, tol); - eigval = eigs.eigenvalues(); - eigvec = eigs.eigenvectors(); - } - } - catch(const std::runtime_error&) - { - status = false; - } - - if(status == true) - { - if(nconv == 0) { status = false; } - } - - return status; - } - #else - { - arma_ignore(eigval); - arma_ignore(eigvec); - arma_ignore(X); - arma_ignore(n_eigvals); - arma_ignore(form_val); - arma_ignore(opts); - - return false; - } - #endif - } - - - -template -inline -bool -sp_auxlib::eigs_sym_newarp(Col& eigval, Mat& eigvec, const SpMat& X, const uword n_eigvals, const eT sigma, const eigs_opts& opts) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_NEWARP) - { - if(X.is_square() == false) { return false; } - - const newarp::SparseGenRealShiftSolve op(X, sigma); - - if(op.valid == false) { return false; } - - arma_conform_check( (n_eigvals >= op.n_rows), "eigs_sym(): n_eigvals must be less than the number of rows in the matrix" ); - - // If the matrix is empty, the case is trivial. - if( (op.n_cols == 0) || (n_eigvals == 0) ) // We already know n_cols == n_rows. - { - eigval.reset(); - eigvec.reset(); - return true; - } - - uword n = op.n_rows; - - // Use max(2*k+1, 20) as default subspace dimension for the sym case; MATLAB uses max(2*k, 20), but we need to be backward-compatible. - uword ncv_default = uword( ((2*n_eigvals+1)>(20)) ? (2*n_eigvals+1) : (20) ); - - // Use opts.subdim only if it's within the limits, otherwise cap it. - uword ncv = ncv_default; - - if(opts.subdim != 0) - { - if(opts.subdim < (n_eigvals + 1)) - { - arma_warn(1, "eigs_sym(): opts.subdim must be greater than k; using k+1 instead of ", opts.subdim); - ncv = uword(n_eigvals + 1); - } - else - if(opts.subdim > n) - { - arma_warn(1, "eigs_sym(): opts.subdim cannot be greater than n_rows; using n_rows instead of ", opts.subdim); - ncv = n; - } - else - { - ncv = uword(opts.subdim); - } - } - - // Re-check that we are within the limits - if(ncv < (n_eigvals + 1)) { ncv = (n_eigvals + 1); } - if(ncv > n ) { ncv = n; } - - eT tol = (std::max)(eT(opts.tol), std::numeric_limits::epsilon()); - - uword maxiter = uword(opts.maxiter); - - // eigval.set_size(n_eigvals); - // eigvec.set_size(n, n_eigvals); - - bool status = true; - - uword nconv = 0; - - try - { - newarp::SymEigsShiftSolver< eT, newarp::EigsSelect::LARGEST_MAGN, newarp::SparseGenRealShiftSolve > eigs(op, n_eigvals, ncv, sigma); - eigs.init(); - nconv = eigs.compute(maxiter, tol); - eigval = eigs.eigenvalues(); - eigvec = eigs.eigenvectors(); - } - catch(const std::runtime_error&) - { - status = false; - } - - if(status == true) - { - if(nconv == 0) { status = false; } - } - - return status; - } - #else - { - arma_ignore(eigval); - arma_ignore(eigvec); - arma_ignore(X); - arma_ignore(n_eigvals); - arma_ignore(sigma); - arma_ignore(opts); - - return false; - } - #endif - } - - - -template -inline -bool -sp_auxlib::eigs_sym_arpack(Col& eigval, Mat& eigvec, const SpMat& X, const uword n_eigvals, const form_type form_val, const eT sigma, const eigs_opts& opts) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_ARPACK) - { - arma_conform_check( (form_val != form_lm) && (form_val != form_sm) && (form_val != form_la) && (form_val != form_sa) && (form_val != form_sigma), "eigs_sym(): unknown form specified" ); - - if(X.is_square() == false) { return false; } - - char which_sm[3] = "SM"; - char which_lm[3] = "LM"; - char which_sa[3] = "SA"; - char which_la[3] = "LA"; - char* which; - - switch(form_val) - { - case form_sm: which = which_sm; break; - case form_lm: which = which_lm; break; - case form_sa: which = which_sa; break; - case form_la: which = which_la; break; - - default: which = which_lm; break; - } - - // Make sure we aren't asking for every eigenvalue. - // The _saupd() functions allow asking for one more eigenvalue than the _naupd() functions. - arma_conform_check( (n_eigvals >= X.n_rows), "eigs_sym(): n_eigvals must be less than the number of rows in the matrix" ); - - // If the matrix is empty, the case is trivial. - if( (X.n_cols == 0) || (n_eigvals == 0) ) // We already know n_cols == n_rows. - { - eigval.reset(); - eigvec.reset(); - return true; - } - - // Set up variables that get used for neupd(). - blas_int n, ncv, ncv_default, ldv, lworkl, info, maxiter; - - eT tol = eT(opts.tol); - maxiter = blas_int(opts.maxiter); - - podarray resid, v, workd, workl; - podarray iparam, ipntr; - podarray rwork; // Not used in this case. - - n = blas_int(X.n_rows); // The size of the matrix. - - // Use max(2*k+1, 20) as default subspace dimension for the sym case; MATLAB uses max(2*k, 20), but we need to be backward-compatible. - ncv_default = blas_int( ((2*n_eigvals+1)>(20)) ? (2*n_eigvals+1) : (20) ); - - // Use opts.subdim only if it's within the limits - ncv = ncv_default; - - if(opts.subdim != 0) - { - if(opts.subdim < (n_eigvals + 1)) - { - arma_warn(1, "eigs_sym(): opts.subdim must be greater than k; using k+1 instead of ", opts.subdim); - ncv = blas_int(n_eigvals + 1); - } - else - if(blas_int(opts.subdim) > n) - { - arma_warn(1, "eigs_sym(): opts.subdim cannot be greater than n_rows; using n_rows instead of ", opts.subdim); - ncv = n; - } - else - { - ncv = blas_int(opts.subdim); - } - } - - if(use_sigma) - //if(form_val == form_sigma) - { - run_aupd_shiftinvert(n_eigvals, sigma, X, true /* sym, not gen */, n, tol, maxiter, resid, ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, rwork, info); - } - else - { - const SpMat Xst = X.st(); - - run_aupd_plain(n_eigvals, which, X, Xst, true /* sym, not gen */, n, tol, maxiter, resid, ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, rwork, info); - } - - if(info != 0) { return false; } - - // The process has converged, and now we need to recover the actual eigenvectors using seupd() - blas_int rvec = 1; // .TRUE - blas_int nev = blas_int(n_eigvals); - - char howmny = 'A'; - char bmat = 'I'; // We are considering the standard eigenvalue problem. - - podarray select(ncv, arma_zeros_indicator()); // Logical array of dimension NCV. - blas_int ldz = n; - - // seupd() will output directly into the eigval and eigvec objects. - eigval.zeros( n_eigvals); - eigvec.zeros(n, n_eigvals); - - arpack::seupd(&rvec, &howmny, select.memptr(), eigval.memptr(), eigvec.memptr(), &ldz, (eT*) &sigma, &bmat, &n, which, &nev, &tol, resid.memptr(), &ncv, v.memptr(), &ldv, iparam.memptr(), ipntr.memptr(), workd.memptr(), workl.memptr(), &lworkl, &info); - - // Check for errors. - if(info != 0) { arma_warn(1, "eigs_sym(): ARPACK error ", info, " in seupd()"); return false; } - - return (info == 0); - } - #else - { - arma_ignore(eigval); - arma_ignore(eigvec); - arma_ignore(X); - arma_ignore(n_eigvals); - arma_ignore(form_val); - arma_ignore(sigma); - arma_ignore(opts); - - return false; - } - #endif - } - - - -//! immediate eigendecomposition of non-symmetric real sparse object -template -inline -bool -sp_auxlib::eigs_gen(Col< std::complex >& eigval, Mat< std::complex >& eigvec, const SpBase& X, const uword n_eigvals, const form_type form_val, const eigs_opts& opts) - { - arma_debug_sigprint(); - - const unwrap_spmat U(X.get_ref()); - - arma_conform_check( (U.M.is_square() == false), "eigs_gen(): given matrix must be square sized" ); - - if(arma_config::check_nonfinite && U.M.internal_has_nonfinite()) - { - arma_warn(3, "eigs_gen(): detected non-finite elements"); - return false; - } - - // TODO: investigate optional redirection of "sm" to ARPACK as it's capable of shift-invert; - // TODO: in shift-invert mode, "sm" maps to "lm" of the shift-inverted matrix (with sigma = 0) - - #if defined(ARMA_USE_NEWARP) - { - return sp_auxlib::eigs_gen_newarp(eigval, eigvec, U.M, n_eigvals, form_val, opts); - } - #elif defined(ARMA_USE_ARPACK) - { - constexpr std::complex sigma = T(0); - - return sp_auxlib::eigs_gen_arpack(eigval, eigvec, U.M, n_eigvals, form_val, sigma, opts); - } - #else - { - arma_ignore(eigval); - arma_ignore(eigvec); - arma_ignore(n_eigvals); - arma_ignore(form_val); - arma_ignore(opts); - - arma_stop_logic_error("eigs_gen(): use of NEWARP or ARPACK must be enabled"); - return false; - } - #endif - } - - - -//! immediate eigendecomposition of non-symmetric real sparse object -template -inline -bool -sp_auxlib::eigs_gen(Col< std::complex >& eigval, Mat< std::complex >& eigvec, const SpBase& X, const uword n_eigvals, const std::complex sigma, const eigs_opts& opts) - { - arma_debug_sigprint(); - - const unwrap_spmat U(X.get_ref()); - - arma_conform_check( (U.M.is_square() == false), "eigs_gen(): given matrix must be square sized" ); - - if(arma_config::check_nonfinite && U.M.internal_has_nonfinite()) - { - arma_warn(3, "eigs_gen(): detected non-finite elements"); - return false; - } - - #if (defined(ARMA_USE_ARPACK) && defined(ARMA_USE_SUPERLU)) - { - constexpr form_type form_val = form_sigma; - - return sp_auxlib::eigs_gen_arpack(eigval, eigvec, U.M, n_eigvals, form_val, sigma, opts); - } - #else - { - arma_ignore(eigval); - arma_ignore(eigvec); - arma_ignore(n_eigvals); - arma_ignore(sigma); - arma_ignore(opts); - - arma_stop_logic_error("eigs_gen(): use of ARPACK and SuperLU must be enabled to use 'sigma'"); - return false; - } - #endif - } - - - -template -inline -bool -sp_auxlib::eigs_gen_newarp(Col< std::complex >& eigval, Mat< std::complex >& eigvec, const SpMat& X, const uword n_eigvals, const form_type form_val, const eigs_opts& opts) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_NEWARP) - { - arma_conform_check( (form_val != form_lm) && (form_val != form_sm) && (form_val != form_lr) && (form_val != form_sr) && (form_val != form_li) && (form_val != form_si), "eigs_gen(): unknown form specified" ); - - if(X.is_square() == false) { return false; } - - const newarp::SparseGenMatProd op(X); - - arma_conform_check( (n_eigvals + 1 >= op.n_rows), "eigs_gen(): n_eigvals + 1 must be less than the number of rows in the matrix" ); - - // If the matrix is empty, the case is trivial. - if( (op.n_cols == 0) || (n_eigvals == 0) ) // We already know n_cols == n_rows. - { - eigval.reset(); - eigvec.reset(); - return true; - } - - uword n = op.n_rows; - - // Use max(2*k+1, 20) as default subspace dimension for the gen case; same as MATLAB. - uword ncv_default = uword( ((2*n_eigvals+1)>(20)) ? (2*n_eigvals+1) : (20) ); - - // Use opts.subdim only if it's within the limits - uword ncv = ncv_default; - - if(opts.subdim != 0) - { - if(opts.subdim < (n_eigvals + 3)) - { - arma_warn(1, "eigs_gen(): opts.subdim must be greater than k+2; using k+3 instead of ", opts.subdim); - ncv = uword(n_eigvals + 3); - } - else - if(opts.subdim > n) - { - arma_warn(1, "eigs_gen(): opts.subdim cannot be greater than n_rows; using n_rows instead of ", opts.subdim); - ncv = n; - } - else - { - ncv = uword(opts.subdim); - } - } - - // Re-check that we are within the limits - if(ncv < (n_eigvals + 3)) { ncv = (n_eigvals + 3); } - if(ncv > n ) { ncv = n; } - - T tol = (std::max)(T(opts.tol), std::numeric_limits::epsilon()); - - uword maxiter = uword(opts.maxiter); - - // eigval.set_size(n_eigvals); - // eigvec.set_size(n, n_eigvals); - - bool status = true; - - uword nconv = 0; - - try - { - if(form_val == form_lm) - { - newarp::GenEigsSolver< T, newarp::EigsSelect::LARGEST_MAGN, newarp::SparseGenMatProd > eigs(op, n_eigvals, ncv); - eigs.init(); - nconv = eigs.compute(maxiter, tol); - eigval = eigs.eigenvalues(); - eigvec = eigs.eigenvectors(); - } - else - if(form_val == form_sm) - { - newarp::GenEigsSolver< T, newarp::EigsSelect::SMALLEST_MAGN, newarp::SparseGenMatProd > eigs(op, n_eigvals, ncv); - eigs.init(); - nconv = eigs.compute(maxiter, tol); - eigval = eigs.eigenvalues(); - eigvec = eigs.eigenvectors(); - } - else - if(form_val == form_lr) - { - newarp::GenEigsSolver< T, newarp::EigsSelect::LARGEST_REAL, newarp::SparseGenMatProd > eigs(op, n_eigvals, ncv); - eigs.init(); - nconv = eigs.compute(maxiter, tol); - eigval = eigs.eigenvalues(); - eigvec = eigs.eigenvectors(); - } - else - if(form_val == form_sr) - { - newarp::GenEigsSolver< T, newarp::EigsSelect::SMALLEST_REAL, newarp::SparseGenMatProd > eigs(op, n_eigvals, ncv); - eigs.init(); - nconv = eigs.compute(maxiter, tol); - eigval = eigs.eigenvalues(); - eigvec = eigs.eigenvectors(); - } - else - if(form_val == form_li) - { - newarp::GenEigsSolver< T, newarp::EigsSelect::LARGEST_IMAG, newarp::SparseGenMatProd > eigs(op, n_eigvals, ncv); - eigs.init(); - nconv = eigs.compute(maxiter, tol); - eigval = eigs.eigenvalues(); - eigvec = eigs.eigenvectors(); - } - else - if(form_val == form_si) - { - newarp::GenEigsSolver< T, newarp::EigsSelect::SMALLEST_IMAG, newarp::SparseGenMatProd > eigs(op, n_eigvals, ncv); - eigs.init(); - nconv = eigs.compute(maxiter, tol); - eigval = eigs.eigenvalues(); - eigvec = eigs.eigenvectors(); - } - } - catch(const std::runtime_error&) - { - status = false; - } - - if(status == true) - { - if(nconv == 0) { status = false; } - } - - return status; - } - #else - { - arma_ignore(eigval); - arma_ignore(eigvec); - arma_ignore(X); - arma_ignore(n_eigvals); - arma_ignore(form_val); - arma_ignore(opts); - - return false; - } - #endif - } - - - - -template -inline -bool -sp_auxlib::eigs_gen_arpack(Col< std::complex >& eigval, Mat< std::complex >& eigvec, const SpMat& X, const uword n_eigvals, const form_type form_val, const std::complex sigma, const eigs_opts& opts) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_ARPACK) - { - arma_conform_check( (form_val != form_lm) && (form_val != form_sm) && (form_val != form_lr) && (form_val != form_sr) && (form_val != form_li) && (form_val != form_si) && (form_val != form_sigma), "eigs_gen(): unknown form specified" ); - - if(X.is_square() == false) { return false; } - - char which_lm[3] = "LM"; - char which_sm[3] = "SM"; - char which_lr[3] = "LR"; - char which_sr[3] = "SR"; - char which_li[3] = "LI"; - char which_si[3] = "SI"; - - char* which; - - switch(form_val) - { - case form_lm: which = which_lm; break; - case form_sm: which = which_sm; break; - case form_lr: which = which_lr; break; - case form_sr: which = which_sr; break; - case form_li: which = which_li; break; - case form_si: which = which_si; break; - - default: which = which_lm; - } - - // Make sure we aren't asking for every eigenvalue. - arma_conform_check( (n_eigvals + 1 >= X.n_rows), "eigs_gen(): n_eigvals + 1 must be less than the number of rows in the matrix" ); - - // If the matrix is empty, the case is trivial. - if( (X.n_cols == 0) || (n_eigvals == 0) ) // We already know n_cols == n_rows. - { - eigval.reset(); - eigvec.reset(); - return true; - } - - // Set up variables that get used for neupd(). - blas_int n, ncv, ncv_default, ldv, lworkl, info, maxiter; - - T tol = T(opts.tol); - maxiter = blas_int(opts.maxiter); - - podarray resid, v, workd, workl; - podarray iparam, ipntr; - podarray rwork; // Not used in the real case. - - n = blas_int(X.n_rows); // The size of the matrix. - - // Use max(2*k+1, 20) as default subspace dimension for the gen case; same as MATLAB. - ncv_default = blas_int( ((2*n_eigvals+1)>(20)) ? (2*n_eigvals+1) : (20) ); - - // Use opts.subdim only if it's within the limits - ncv = ncv_default; - - if(opts.subdim != 0) - { - if(opts.subdim < (n_eigvals + 3)) - { - arma_warn(1, "eigs_gen(): opts.subdim must be greater than k+2; using k+3 instead of ", opts.subdim); - ncv = blas_int(n_eigvals + 3); - } - else - if(blas_int(opts.subdim) > n) - { - arma_warn(1, "eigs_gen(): opts.subdim cannot be greater than n_rows; using n_rows instead of ", opts.subdim); - ncv = n; - } - else - { - ncv = blas_int(opts.subdim); - } - } - - // WARNING!!! - // We are still not able to apply truly complex shifts to real matrices, - // in which case the OP that ARPACK wants is different (see [s/d]naupd). - // Also, if sigma contains a non-zero imaginary part, retrieving the eigenvalues - // becomes utterly messy (see [s/d]eupd, remark #3). - // We should never get to the point in which the imaginary part of sigma is non-zero; - // the user-facing functions currently convert X from real to complex if a complex sigma is detected. - // The check here is just for extra safety, and as a reminder of what's missing. - T sigmar = real(sigma); - T sigmai = imag(sigma); - - if(use_sigma) - //if(form_val == form_sigma) - { - if(sigmai != T(0)) { arma_stop_logic_error("eigs_gen(): complex 'sigma' not applicable to real matrix"); return false; } - - run_aupd_shiftinvert(n_eigvals, sigmar, X, false /* gen, not sym */, n, tol, maxiter, resid, ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, rwork, info); - } - else - { - const SpMat Xst = X.st(); - - run_aupd_plain(n_eigvals, which, X, Xst, false /* gen, not sym */, n, tol, maxiter, resid, ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, rwork, info); - } - - if(info != 0) { return false; } - - // The process has converged, and now we need to recover the actual eigenvectors using neupd(). - blas_int rvec = 1; // .TRUE - blas_int nev = blas_int(n_eigvals); - - char howmny = 'A'; - char bmat = 'I'; // We are considering the standard eigenvalue problem. - - podarray select(ncv, arma_zeros_indicator()); // logical array of dimension NCV - podarray dr(nev + 1, arma_zeros_indicator()); // real array of dimension NEV + 1 - podarray di(nev + 1, arma_zeros_indicator()); // real array of dimension NEV + 1 - podarray z(n * (nev + 1), arma_zeros_indicator()); // real N by NEV array if HOWMNY = 'A' - podarray workev(3 * ncv, arma_zeros_indicator()); - - blas_int ldz = n; - - arpack::neupd(&rvec, &howmny, select.memptr(), dr.memptr(), di.memptr(), z.memptr(), &ldz, (T*) &sigmar, (T*) &sigmai, workev.memptr(), &bmat, &n, which, &nev, &tol, resid.memptr(), &ncv, v.memptr(), &ldv, iparam.memptr(), ipntr.memptr(), workd.memptr(), workl.memptr(), &lworkl, rwork.memptr(), &info); - - // Check for errors. - if(info != 0) { arma_warn(1, "eigs_gen(): ARPACK error ", info, " in neupd()"); return false; } - - // Put it into the outputs. - eigval.set_size(n_eigvals); - eigvec.zeros(n, n_eigvals); - - for(uword i = 0; i < n_eigvals; ++i) - { - eigval[i] = std::complex(dr[i], di[i]); - } - - // Now recover the eigenvectors. - for(uword i = 0; i < n_eigvals; ++i) - { - // ARPACK ?neupd lays things out kinda odd in memory; - // so does LAPACK ?geev -- see auxlib::eig_gen() - if((i < n_eigvals - 1) && (eigval[i] == std::conj(eigval[i + 1]))) - { - for(uword j = 0; j < uword(n); ++j) - { - eigvec.at(j, i) = std::complex(z[n * i + j], z[n * (i + 1) + j]); - eigvec.at(j, i + 1) = std::complex(z[n * i + j], -z[n * (i + 1) + j]); - } - ++i; // Skip the next one. - } - else - if((i == n_eigvals - 1) && (std::complex(eigval[i]).imag() != 0.0)) - { - // We don't have the matched conjugate eigenvalue. - for(uword j = 0; j < uword(n); ++j) - { - eigvec.at(j, i) = std::complex(z[n * i + j], z[n * (i + 1) + j]); - } - } - else - { - // The eigenvector is entirely real. - for(uword j = 0; j < uword(n); ++j) - { - eigvec.at(j, i) = std::complex(z[n * i + j], T(0)); - } - } - } - - return (info == 0); - } - #else - { - arma_ignore(eigval); - arma_ignore(eigvec); - arma_ignore(X); - arma_ignore(n_eigvals); - arma_ignore(form_val); - arma_ignore(sigma); - arma_ignore(opts); - - return false; - } - #endif - } - - - -//! immediate eigendecomposition of non-symmetric complex sparse object -template -inline -bool -sp_auxlib::eigs_gen(Col< std::complex >& eigval, Mat< std::complex >& eigvec, const SpBase< std::complex, T1>& X_expr, const uword n_eigvals, const form_type form_val, const eigs_opts& opts) - { - arma_debug_sigprint(); - - const unwrap_spmat U(X_expr.get_ref()); - - arma_conform_check( (U.M.is_square() == false), "eigs_gen(): given matrix must be square sized" ); - - if(arma_config::check_nonfinite && U.M.internal_has_nonfinite()) - { - arma_warn(3, "eigs_gen(): detected non-finite elements"); - return false; - } - - constexpr std::complex sigma = T(0); - - return sp_auxlib::eigs_gen(eigval, eigvec, U.M, n_eigvals, form_val, sigma, opts); - } - - - -//! immediate eigendecomposition of non-symmetric complex sparse object -template -inline -bool -sp_auxlib::eigs_gen(Col< std::complex >& eigval, Mat< std::complex >& eigvec, const SpBase< std::complex, T1>& X, const uword n_eigvals, const std::complex sigma, const eigs_opts& opts) - { - arma_debug_sigprint(); - - const unwrap_spmat U(X.get_ref()); - - arma_conform_check( (U.M.is_square() == false), "eigs_gen(): given matrix must be square sized" ); - - if(arma_config::check_nonfinite && U.M.internal_has_nonfinite()) - { - arma_warn(3, "eigs_gen(): detected non-finite elements"); - return false; - } - - #if (defined(ARMA_USE_ARPACK) && defined(ARMA_USE_SUPERLU)) - { - constexpr form_type form_val = form_sigma; - - return sp_auxlib::eigs_gen(eigval, eigvec, U.M, n_eigvals, form_val, sigma, opts); - } - #else - { - arma_ignore(eigval); - arma_ignore(eigvec); - arma_ignore(n_eigvals); - arma_ignore(sigma); - arma_ignore(opts); - - arma_stop_logic_error("eigs_gen(): use of ARPACK and SuperLU must be enabled to use 'sigma'"); - return false; - } - #endif - } - - - -template -inline -bool -sp_auxlib::eigs_gen(Col< std::complex >& eigval, Mat< std::complex >& eigvec, const SpMat< std::complex >& X, const uword n_eigvals, const form_type form_val, const std::complex sigma, const eigs_opts& opts) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_ARPACK) - { - // typedef typename std::complex eT; - - arma_conform_check( (form_val != form_lm) && (form_val != form_sm) && (form_val != form_lr) && (form_val != form_sr) && (form_val != form_li) && (form_val != form_si) && (form_val != form_sigma), "eigs_gen(): unknown form specified" ); - - if(X.is_square() == false) { return false; } - - char which_lm[3] = "LM"; - char which_sm[3] = "SM"; - char which_lr[3] = "LR"; - char which_sr[3] = "SR"; - char which_li[3] = "LI"; - char which_si[3] = "SI"; - - char* which; - - switch(form_val) - { - case form_lm: which = which_lm; break; - case form_sm: which = which_sm; break; - case form_lr: which = which_lr; break; - case form_sr: which = which_sr; break; - case form_li: which = which_li; break; - case form_si: which = which_si; break; - - default: which = which_lm; - } - - // Make sure we aren't asking for every eigenvalue. - arma_conform_check( (n_eigvals + 1 >= X.n_rows), "eigs_gen(): n_eigvals + 1 must be less than the number of rows in the matrix" ); - - // If the matrix is empty, the case is trivial. - if( (X.n_cols == 0) || (n_eigvals == 0) ) // We already know n_cols == n_rows. - { - eigval.reset(); - eigvec.reset(); - return true; - } - - // Set up variables that get used for neupd(). - blas_int n, ncv, ncv_default, ldv, lworkl, info, maxiter; - - T tol = T(opts.tol); - maxiter = blas_int(opts.maxiter); - - podarray< std::complex > resid, v, workd, workl; - podarray iparam, ipntr; - podarray rwork; - - n = blas_int(X.n_rows); // The size of the matrix. - - // Use max(2*k+1, 20) as default subspace dimension for the gen case; same as MATLAB. - ncv_default = blas_int( ((2*n_eigvals+1)>(20)) ? (2*n_eigvals+1) : (20) ); - - // Use opts.subdim only if it's within the limits - ncv = ncv_default; - - if(opts.subdim != 0) - { - if(opts.subdim < (n_eigvals + 3)) - { - arma_warn(1, "eigs_gen(): opts.subdim must be greater than k+2; using k+3 instead of ", opts.subdim); - ncv = blas_int(n_eigvals + 3); - } - else - if(blas_int(opts.subdim) > n) - { - arma_warn(1, "eigs_gen(): opts.subdim cannot be greater than n_rows; using n_rows instead of ", opts.subdim); - ncv = n; - } - else - { - ncv = blas_int(opts.subdim); - } - } - - if(use_sigma) - //if(form_val == form_sigma) - { - run_aupd_shiftinvert(n_eigvals, sigma, X, false /* gen, not sym */, n, tol, maxiter, resid, ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, rwork, info); - } - else - { - const SpMat< std::complex > Xst = X.st(); - - run_aupd_plain(n_eigvals, which, X, Xst, false /* gen, not sym */, n, tol, maxiter, resid, ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, rwork, info); - } - - if(info != 0) { return false; } - - // The process has converged, and now we need to recover the actual eigenvectors using neupd(). - blas_int rvec = 1; // .TRUE - blas_int nev = blas_int(n_eigvals); - - char howmny = 'A'; - char bmat = 'I'; // We are considering the standard eigenvalue problem. - - podarray select(ncv, arma_zeros_indicator()); // logical array of dimension NCV - podarray> d(nev + 1, arma_zeros_indicator()); // complex array of dimension NEV + 1 - podarray> z(n * nev, arma_zeros_indicator()); // complex N by NEV array if HOWMNY = 'A' - podarray> workev(2 * ncv, arma_zeros_indicator()); - - blas_int ldz = n; - - // Prepare the outputs; neupd() will write directly to them. - eigval.zeros(n_eigvals); - eigvec.zeros(n, n_eigvals); - - arpack::neupd(&rvec, &howmny, select.memptr(), eigval.memptr(), -(std::complex*) NULL, eigvec.memptr(), &ldz, (std::complex*) &sigma, (std::complex*) NULL, workev.memptr(), &bmat, &n, which, &nev, &tol, resid.memptr(), &ncv, v.memptr(), &ldv, iparam.memptr(), ipntr.memptr(), workd.memptr(), workl.memptr(), &lworkl, rwork.memptr(), &info); - - // Check for errors. - if(info != 0) { arma_warn(1, "eigs_gen(): ARPACK error ", info, " in neupd()"); return false; } - - return (info == 0); - } - #else - { - arma_ignore(eigval); - arma_ignore(eigvec); - arma_ignore(X); - arma_ignore(n_eigvals); - arma_ignore(form_val); - arma_ignore(sigma); - arma_ignore(opts); - - arma_stop_logic_error("eigs_gen(): use of ARPACK must be enabled for decomposition of complex matrices"); - return false; - } - #endif - } - - - -template -inline -bool -sp_auxlib::spsolve_simple(Mat& X, const SpBase& A_expr, const Base& B_expr, const superlu_opts& user_opts) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_SUPERLU) - { - typedef typename T1::elem_type eT; - - superlu::superlu_options_t options; - sp_auxlib::set_superlu_opts(options, user_opts); - - const unwrap_spmat tmp1(A_expr.get_ref()); - const SpMat& A = tmp1.M; - - X = B_expr.get_ref(); // superlu::gssv() uses X as input (the B matrix) and as output (the solution) - - if(A.is_square() == false) - { - X.soft_reset(); - arma_stop_logic_error("spsolve(): solving under-determined / over-determined systems is currently not supported"); - return false; - } - - arma_conform_check( (A.n_rows != X.n_rows), "spsolve(): number of rows in the given objects must be the same", [&](){ X.soft_reset(); } ); - - if(A.is_empty() || X.is_empty()) - { - X.zeros(A.n_cols, X.n_cols); - return true; - } - - if(A.n_nonzero == uword(0)) { X.soft_reset(); return false; } - - if(arma_config::check_nonfinite && (A.internal_has_nonfinite() || X.internal_has_nonfinite())) - { - arma_warn(3, "spsolve(): detected non-finite elements"); - return false; - } - - if(arma_config::check_conform) - { - bool overflow = false; - - overflow = (A.n_nonzero > INT_MAX); - overflow = (A.n_rows > INT_MAX) || overflow; - overflow = (A.n_cols > INT_MAX) || overflow; - overflow = (X.n_rows > INT_MAX) || overflow; - overflow = (X.n_cols > INT_MAX) || overflow; - - if(overflow) - { - arma_stop_runtime_error("spsolve(): integer overflow: matrix dimensions are too large for integer type used by SuperLU"); - return false; - } - } - - superlu_supermatrix_wrangler x; - superlu_supermatrix_wrangler a; - - const bool status_x = wrap_to_supermatrix(x.get_ref(), X); - const bool status_a = copy_to_supermatrix(a.get_ref(), A); - - if( (status_x == false) || (status_a == false) ) { X.soft_reset(); return false; } - - superlu_supermatrix_wrangler l; - superlu_supermatrix_wrangler u; - - // paranoia: use SuperLU's memory allocation, in case it reallocs - - superlu_array_wrangler perm_c(A.n_cols+1); // extra paranoia: increase array length by 1 - superlu_array_wrangler perm_r(A.n_rows+1); - - superlu_stat_wrangler stat; - - int info = 0; // Return code. - - arma_debug_print("superlu::gssv()"); - superlu::gssv(&options, a.get_ptr(), perm_c.get_ptr(), perm_r.get_ptr(), l.get_ptr(), u.get_ptr(), x.get_ptr(), stat.get_ptr(), &info); - - - // Process the return code. - if( (info > 0) && (info <= int(A.n_cols)) ) - { - // std::ostringstream tmp; - // tmp << "spsolve(): could not solve system; LU factorisation completed, but detected zero in U(" << (info-1) << ',' << (info-1) << ')'; - // arma_warn(1, tmp.str()); - } - else - if(info > int(A.n_cols)) - { - arma_warn(1, "spsolve(): memory allocation failure"); - } - else - if(info < 0) - { - arma_warn(1, "spsolve(): unknown SuperLU error code from gssv(): ", info); - } - - // No need to extract the data from x, since it's using the same memory as X - - return (info == 0); - } - #else - { - arma_ignore(X); - arma_ignore(A_expr); - arma_ignore(B_expr); - arma_ignore(user_opts); - arma_stop_logic_error("spsolve(): use of SuperLU must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -sp_auxlib::spsolve_refine(Mat& X, typename T1::pod_type& out_rcond, const SpBase& A_expr, const Base& B_expr, const superlu_opts& user_opts) - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_SUPERLU) - { - typedef typename T1::pod_type T; - typedef typename T1::elem_type eT; - - superlu::superlu_options_t options; - sp_auxlib::set_superlu_opts(options, user_opts); - - const unwrap_spmat tmp1(A_expr.get_ref()); - const SpMat& A = tmp1.M; - - const unwrap tmp2(B_expr.get_ref()); - const Mat& B_unwrap = tmp2.M; - - const bool B_is_modified = ( (user_opts.equilibrate) || (&B_unwrap == &X) ); - - Mat B_copy; if(B_is_modified) { B_copy = B_unwrap; } - - const Mat& B = (B_is_modified) ? B_copy : B_unwrap; - - if(A.is_square() == false) - { - X.soft_reset(); - arma_stop_logic_error("spsolve(): solving under-determined / over-determined systems is currently not supported"); - return false; - } - - arma_conform_check( (A.n_rows != B.n_rows), "spsolve(): number of rows in the given objects must be the same", [&](){ X.soft_reset(); } ); - - X.zeros(A.n_cols, B.n_cols); // set the elements to zero, as we don't trust the SuperLU spaghetti code - - if(A.is_empty() || B.is_empty()) { return true; } - - if(A.n_nonzero == uword(0)) { X.soft_reset(); return false; } - - if(arma_config::check_nonfinite && (A.internal_has_nonfinite() || B.internal_has_nonfinite())) - { - arma_warn(3, "spsolve(): detected non-finite elements"); - return false; - } - - if(arma_config::check_conform) - { - bool overflow; - - overflow = (A.n_nonzero > INT_MAX); - overflow = (A.n_rows > INT_MAX) || overflow; - overflow = (A.n_cols > INT_MAX) || overflow; - overflow = (B.n_rows > INT_MAX) || overflow; - overflow = (B.n_cols > INT_MAX) || overflow; - overflow = (X.n_rows > INT_MAX) || overflow; - overflow = (X.n_cols > INT_MAX) || overflow; - - if(overflow) - { - arma_stop_runtime_error("spsolve(): integer overflow: matrix dimensions are too large for integer type used by SuperLU"); - return false; - } - } - - superlu_supermatrix_wrangler x; - superlu_supermatrix_wrangler a; - superlu_supermatrix_wrangler b; - - const bool status_x = wrap_to_supermatrix(x.get_ref(), X); - const bool status_a = copy_to_supermatrix(a.get_ref(), A); // NOTE: superlu::gssvx() modifies 'a' if equilibration is enabled - const bool status_b = wrap_to_supermatrix(b.get_ref(), B); // NOTE: superlu::gssvx() modifies 'b' if equilibration is enabled - - if( (status_x == false) || (status_a == false) || (status_b == false) ) { X.soft_reset(); return false; } - - superlu_supermatrix_wrangler l; - superlu_supermatrix_wrangler u; - - // paranoia: use SuperLU's memory allocation, in case it reallocs - - superlu_array_wrangler perm_c(A.n_cols+1); // extra paranoia: increase array length by 1 - superlu_array_wrangler perm_r(A.n_rows+1); - superlu_array_wrangler etree(A.n_cols+1); - - superlu_array_wrangler R(A.n_rows+1); - superlu_array_wrangler C(A.n_cols+1); - superlu_array_wrangler ferr(B.n_cols+1); - superlu_array_wrangler berr(B.n_cols+1); - - superlu::GlobalLU_t glu; - arrayops::fill_zeros(reinterpret_cast(&glu), sizeof(superlu::GlobalLU_t)); - - superlu::mem_usage_t mu; - arrayops::fill_zeros(reinterpret_cast(&mu), sizeof(superlu::mem_usage_t)); - - superlu_stat_wrangler stat; - - char equed[8] = {}; // extra characters for paranoia - T rpg = T(0); - T rcond = T(0); - int info = int(0); // Return code. - - char work[8] = {}; - int lwork = int(0); // 0 means superlu will allocate memory - - arma_debug_print("superlu::gssvx()"); - superlu::gssvx(&options, a.get_ptr(), perm_c.get_ptr(), perm_r.get_ptr(), etree.get_ptr(), equed, R.get_ptr(), C.get_ptr(), l.get_ptr(), u.get_ptr(), &work[0], lwork, b.get_ptr(), x.get_ptr(), &rpg, &rcond, ferr.get_ptr(), berr.get_ptr(), &glu, &mu, stat.get_ptr(), &info); - - bool status = false; - - // Process the return code. - if(info == 0) - { - status = true; - } - if( (info > 0) && (info <= int(A.n_cols)) ) - { - // std::ostringstream tmp; - // tmp << "spsolve(): could not solve system; LU factorisation completed, but detected zero in U(" << (info-1) << ',' << (info-1) << ')'; - // arma_warn(1, tmp.str()); - } - else - if( (info == int(A.n_cols+1)) && (user_opts.allow_ugly) ) - { - arma_warn(2, "spsolve(): system is singular to working precision (rcond: ", rcond, ")"); - status = true; - } - else - if(info > int(A.n_cols+1)) - { - arma_warn(1, "spsolve(): memory allocation failure"); - } - else - if(info < 0) - { - arma_warn(1, "spsolve(): unknown SuperLU error code from gssvx(): ", info); - } - - // No need to extract the data from x, since it's using the same memory as X - - out_rcond = rcond; - - return status; - } - #else - { - arma_ignore(X); - arma_ignore(out_rcond); - arma_ignore(A_expr); - arma_ignore(B_expr); - arma_ignore(user_opts); - arma_stop_logic_error("spsolve(): use of SuperLU must be enabled"); - return false; - } - #endif - } - - - -#if defined(ARMA_USE_SUPERLU) - - template - inline - typename get_pod_type::result - sp_auxlib::norm1(superlu::SuperMatrix* A) - { - arma_debug_sigprint(); - - char norm_id = '1'; - - arma_debug_print("superlu::langs()"); - return superlu::langs(&norm_id, A); - } - - - - template - inline - typename get_pod_type::result - sp_auxlib::lu_rcond(superlu::SuperMatrix* L, superlu::SuperMatrix* U, typename get_pod_type::result norm_val) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - char norm_id = '1'; - T rcond_out = T(0); - int info = int(0); - - superlu_stat_wrangler stat; - - arma_debug_print("superlu::gscon()"); - superlu::gscon(&norm_id, L, U, norm_val, &rcond_out, stat.get_ptr(), &info); - - return (info == 0) ? T(rcond_out) : T(0); - } - - - - inline - void - sp_auxlib::set_superlu_opts(superlu::superlu_options_t& options, const superlu_opts& user_opts) - { - arma_debug_sigprint(); - - // default options as the starting point - superlu::set_default_opts(&options); - - // our settings - options.Trans = superlu::NOTRANS; - options.ConditionNumber = superlu::YES; - - // process user_opts - - if(user_opts.equilibrate == true) { options.Equil = superlu::YES; } - if(user_opts.equilibrate == false) { options.Equil = superlu::NO; } - - if(user_opts.symmetric == true) { options.SymmetricMode = superlu::YES; } - if(user_opts.symmetric == false) { options.SymmetricMode = superlu::NO; } - - options.DiagPivotThresh = user_opts.pivot_thresh; - - if(user_opts.permutation == superlu_opts::NATURAL) { options.ColPerm = superlu::NATURAL; } - if(user_opts.permutation == superlu_opts::MMD_ATA) { options.ColPerm = superlu::MMD_ATA; } - if(user_opts.permutation == superlu_opts::MMD_AT_PLUS_A) { options.ColPerm = superlu::MMD_AT_PLUS_A; } - if(user_opts.permutation == superlu_opts::COLAMD) { options.ColPerm = superlu::COLAMD; } - - if(user_opts.refine == superlu_opts::REF_NONE) { options.IterRefine = superlu::NOREFINE; } - if(user_opts.refine == superlu_opts::REF_SINGLE) { options.IterRefine = superlu::SLU_SINGLE; } - if(user_opts.refine == superlu_opts::REF_DOUBLE) { options.IterRefine = superlu::SLU_DOUBLE; } - if(user_opts.refine == superlu_opts::REF_EXTRA) { options.IterRefine = superlu::SLU_EXTRA; } - } - - - - template - inline - bool - sp_auxlib::copy_to_supermatrix(superlu::SuperMatrix& out, const SpMat& A) - { - arma_debug_sigprint(); - - // We store in column-major CSC. - out.Stype = superlu::SLU_NC; - - if( is_float::value) { out.Dtype = superlu::SLU_S; } - else if( is_double::value) { out.Dtype = superlu::SLU_D; } - else if( is_cx_float::value) { out.Dtype = superlu::SLU_C; } - else if(is_cx_double::value) { out.Dtype = superlu::SLU_Z; } - - out.Mtype = superlu::SLU_GE; // Just a general matrix. We don't know more now. - - // We have to actually create the object which stores the data. - // This gets cleaned by destroy_supermatrix(). - // We have to use SuperLU's problematic memory allocation routines since they are - // not guaranteed to be new and delete. See the comments in def_superlu.hpp - superlu::NCformat* nc = (superlu::NCformat*)superlu::malloc(sizeof(superlu::NCformat)); - - if(nc == nullptr) { return false; } - - A.sync(); - - nc->nnz = A.n_nonzero; - nc->nzval = (void*) superlu::malloc(sizeof(eT) * A.n_nonzero ); - nc->colptr = (superlu::int_t*)superlu::malloc(sizeof(superlu::int_t) * (A.n_cols + 1)); - nc->rowind = (superlu::int_t*)superlu::malloc(sizeof(superlu::int_t) * A.n_nonzero ); - - if( (nc->nzval == nullptr) || (nc->colptr == nullptr) || (nc->rowind == nullptr) ) { return false; } - - // Fill the matrix. - arrayops::copy((eT*) nc->nzval, A.values, A.n_nonzero); - - // // These have to be copied by hand, because the types may differ. - // for(uword i = 0; i <= A.n_cols; ++i) { nc->colptr[i] = (int_t) A.col_ptrs[i]; } - // for(uword i = 0; i < A.n_nonzero; ++i) { nc->rowind[i] = (int_t) A.row_indices[i]; } - - arrayops::convert(nc->colptr, A.col_ptrs, A.n_cols+1 ); - arrayops::convert(nc->rowind, A.row_indices, A.n_nonzero); - - out.nrow = superlu::int_t(A.n_rows); - out.ncol = superlu::int_t(A.n_cols); - out.Store = (void*) nc; - - return true; - } - - - - // memory efficient implementation of out = A - shift*I, where A is a square matrix - template - inline - bool - sp_auxlib::copy_to_supermatrix_with_shift(superlu::SuperMatrix& out, const SpMat& A, const eT shift) - { - arma_debug_sigprint(); - - arma_conform_check( (A.is_square() == false), "sp_auxlib::copy_to_supermatrix_with_shift(): given matrix must be square sized" ); - - if(shift == eT(0)) - { - arma_debug_print("sp_auxlib::copy_to_supermatrix_with_shift(): shift is zero; redirecting to sp_auxlib::copy_to_supermatrix()"); - return sp_auxlib::copy_to_supermatrix(out, A); - } - - // We store in column-major CSC. - out.Stype = superlu::SLU_NC; - - if( is_float::value) { out.Dtype = superlu::SLU_S; } - else if( is_double::value) { out.Dtype = superlu::SLU_D; } - else if( is_cx_float::value) { out.Dtype = superlu::SLU_C; } - else if(is_cx_double::value) { out.Dtype = superlu::SLU_Z; } - - out.Mtype = superlu::SLU_GE; // Just a general matrix. We don't know more now. - - // We have to actually create the object which stores the data. - // This gets cleaned by destroy_supermatrix(). - superlu::NCformat* nc = (superlu::NCformat*)superlu::malloc(sizeof(superlu::NCformat)); - - if(nc == nullptr) { return false; } - - A.sync(); - - uword n_nonzero_diag_old = 0; - uword n_nonzero_diag_new = 0; - - const uword n_search_cols = (std::min)(A.n_rows, A.n_cols); - - for(uword j=0; j < n_search_cols; ++j) - { - const uword col_offset = A.col_ptrs[j ]; - const uword next_col_offset = A.col_ptrs[j + 1]; - - const uword* start_ptr = &(A.row_indices[ col_offset]); - const uword* end_ptr = &(A.row_indices[next_col_offset]); - - const uword wanted_row = j; - - const uword* pos_ptr = std::lower_bound(start_ptr, end_ptr, wanted_row); // binary search - - if( (pos_ptr != end_ptr) && ((*pos_ptr) == wanted_row) ) - { - // element on the main diagonal is non-zero - ++n_nonzero_diag_old; - - const uword offset = uword(pos_ptr - start_ptr); - const uword index = offset + col_offset; - - const eT new_val = A.values[index] - shift; - - if(new_val != eT(0)) { ++n_nonzero_diag_new; } - } - else - { - // element on the main diagonal is zero, but sigma is non-zero, - // so the number of new non-zero elments on the diagonal is increased - ++n_nonzero_diag_new; - } - } - - const uword out_n_nonzero = A.n_nonzero - n_nonzero_diag_old + n_nonzero_diag_new; - - arma_debug_print( arma_str::format("A.n_nonzero: %u") % A.n_nonzero ); - arma_debug_print( arma_str::format("n_nonzero_diag_old: %u") % n_nonzero_diag_old ); - arma_debug_print( arma_str::format("n_nonzero_diag_new: %u") % n_nonzero_diag_new ); - arma_debug_print( arma_str::format("out_n_nonzero: %u") % out_n_nonzero ); - - nc->nnz = out_n_nonzero; - nc->nzval = (void*) superlu::malloc(sizeof(eT) * out_n_nonzero ); - nc->colptr = (superlu::int_t*)superlu::malloc(sizeof(superlu::int_t) * (A.n_cols + 1)); - nc->rowind = (superlu::int_t*)superlu::malloc(sizeof(superlu::int_t) * out_n_nonzero ); - - if( (nc->nzval == nullptr) || (nc->colptr == nullptr) || (nc->rowind == nullptr) ) { return false; } - - // fill the matrix column by column, and insert diagonal elements when necessary - - nc->colptr[0] = 0; - - eT* values_current = (eT*) nc->nzval; - superlu::int_t* rowind_current = nc->rowind; - - uword count = 0; - - for(uword j=0; j < A.n_cols; ++j) - { - const uword idx_start = A.col_ptrs[j ]; - const uword idx_end = A.col_ptrs[j + 1]; - - const eT* values_start = values_current; - - uword i = idx_start; - - // elements in the upper triangular part, excluding the main diagonal - for(; (i < idx_end) && (A.row_indices[i] < j); ++i) - { - (*values_current) = A.values[i]; - (*rowind_current) = superlu::int_t(A.row_indices[i]); - - ++values_current; - ++rowind_current; - - ++count; - } - - // elements on the main diagonal - if( (i < idx_end) && (A.row_indices[i] == j) ) - { - // A(j,j) is non-zero - - const eT new_diag_val = A.values[i] - shift; - - if(new_diag_val != eT(0)) - { - (*values_current) = new_diag_val; - (*rowind_current) = superlu::int_t(j); - - ++values_current; - ++rowind_current; - - ++count; - } - - ++i; - } - else - { - // A(j,j) is zero, so insert a new element - - if(j < n_search_cols) - { - (*values_current) = -shift; - (*rowind_current) = superlu::int_t(j); - - ++values_current; - ++rowind_current; - - ++count; - } - } - - // elements in the lower triangular part, excluding the main diagonal - for(; i < idx_end; ++i) - { - (*values_current) = A.values[i]; - (*rowind_current) = superlu::int_t(A.row_indices[i]); - - ++values_current; - ++rowind_current; - - ++count; - } - - // number of non-zero elements in the j-th column of out - const uword nnz_col = values_current - values_start; - nc->colptr[j + 1] = superlu::int_t(nc->colptr[j] + nnz_col); - } - - arma_debug_print( arma_str::format("count: %u") % count ); - - arma_check( (count != out_n_nonzero), "internal error: sp_auxlib::copy_to_supermatrix_with_shift(): count != out_n_nonzero" ); - - out.nrow = superlu::int_t(A.n_rows); - out.ncol = superlu::int_t(A.n_cols); - out.Store = (void*) nc; - - return true; - } - - - -// // for debugging only -// template -// inline -// void -// sp_auxlib::copy_to_spmat(SpMat& out, const superlu::SuperMatrix& A) -// { -// arma_debug_sigprint(); -// -// bool type_matched = false; -// -// if( is_float::value) { type_matched = (A.Dtype == superlu::SLU_S); } -// else if( is_double::value) { type_matched = (A.Dtype == superlu::SLU_D); } -// else if( is_cx_float::value) { type_matched = (A.Dtype == superlu::SLU_C); } -// else if(is_cx_double::value) { type_matched = (A.Dtype == superlu::SLU_Z); } -// -// arma_conform_check( (type_matched == false), "copy_to_spmat(): type mismatch" ); -// arma_conform_check( (A.Mtype != superlu::SLU_GE), "copy_to_spmat(): unknown layout" ); -// -// // NOTE: the l and u instances of SuperMatrix resulting from superlu::gstrf() -// // NOTE: do not have the superlu::SLU_GE layout -// -// const superlu::NCformat* nc = (const superlu::NCformat*)(A.Store); -// -// if(nc == nullptr) { out.reset(); return; } -// -// if( (nc->nzval == nullptr) || (nc->colptr == nullptr) || (nc->rowind == nullptr) ) { out.reset(); return; } -// -// const uword A_n_rows = uword(A.nrow ); -// const uword A_n_cols = uword(A.ncol ); -// const uword A_n_nonzero = uword(nc->nnz); -// -// if(A_n_nonzero == 0) { out.zeros(A_n_rows, A_n_cols); return; } -// -// out.reserve(A_n_rows, A_n_cols, A_n_nonzero); -// -// arrayops::copy(access::rwp(out.values), (const eT*)(nc->nzval), A_n_nonzero); -// -// arrayops::convert(access::rwp(out.col_ptrs), nc->colptr, A_n_cols+1 ); -// arrayops::convert(access::rwp(out.row_indices), nc->rowind, A_n_nonzero); -// -// out.remove_zeros(); // in case SuperLU has bugs and stores zeros in sparse matrices -// } - - - - template - inline - bool - sp_auxlib::wrap_to_supermatrix(superlu::SuperMatrix& out, const Mat& A) - { - arma_debug_sigprint(); - - // NOTE: this function re-uses memory from matrix A - - // This is being stored as a dense matrix. - out.Stype = superlu::SLU_DN; - - if( is_float::value) { out.Dtype = superlu::SLU_S; } - else if( is_double::value) { out.Dtype = superlu::SLU_D; } - else if( is_cx_float::value) { out.Dtype = superlu::SLU_C; } - else if(is_cx_double::value) { out.Dtype = superlu::SLU_Z; } - - out.Mtype = superlu::SLU_GE; - - // We have to create the object that stores the data. - superlu::DNformat* dn = (superlu::DNformat*)superlu::malloc(sizeof(superlu::DNformat)); - - if(dn == nullptr) { return false; } - - dn->lda = A.n_rows; - dn->nzval = (void*) A.memptr(); // re-use memory instead of copying - - out.nrow = A.n_rows; - out.ncol = A.n_cols; - out.Store = (void*) dn; - - return true; - } - - - - inline - void - sp_auxlib::destroy_supermatrix(superlu::SuperMatrix& out) - { - arma_debug_sigprint(); - - // Clean up. - if(out.Stype == superlu::SLU_NC) - { - superlu::destroy_compcol_mat(&out); - } - else - if(out.Stype == superlu::SLU_NCP) - { - superlu::destroy_compcolperm_mat(&out); - } - else - if(out.Stype == superlu::SLU_DN) - { - // superlu::destroy_dense_mat(&out); - - // since dn->nzval is set to re-use memory from a Mat object (which manages its own memory), - // we cannot simply call superlu::destroy_dense_mat(). - // Only the out.Store structure can be freed. - - superlu::DNformat* dn = (superlu::DNformat*) out.Store; - - if(dn != nullptr) { superlu::free(dn); } - } - else - if(out.Stype == superlu::SLU_SC) - { - superlu::destroy_supernode_mat(&out); - } - else - { - // Uh, crap. - - std::ostringstream tmp; - - tmp << "sp_auxlib::destroy_supermatrix(): unhandled Stype" << std::endl; - tmp << "Stype val: " << out.Stype << std::endl; - tmp << "Stype name: "; - - if(out.Stype == superlu::SLU_NC) { tmp << "SLU_NC"; } - if(out.Stype == superlu::SLU_NCP) { tmp << "SLU_NCP"; } - if(out.Stype == superlu::SLU_NR) { tmp << "SLU_NR"; } - if(out.Stype == superlu::SLU_SC) { tmp << "SLU_SC"; } - if(out.Stype == superlu::SLU_SCP) { tmp << "SLU_SCP"; } - if(out.Stype == superlu::SLU_SR) { tmp << "SLU_SR"; } - if(out.Stype == superlu::SLU_DN) { tmp << "SLU_DN"; } - if(out.Stype == superlu::SLU_NR_loc) { tmp << "SLU_NR_loc"; } - - arma_warn(1, tmp.str()); - arma_stop_runtime_error("internal error: sp_auxlib::destroy_supermatrix()"); - } - } - -#endif - - - -template -inline -void -sp_auxlib::run_aupd_plain - ( - const uword n_eigvals, char* which, - const SpMat& X, const SpMat& Xst, const bool sym, - blas_int& n, eT& tol, blas_int& maxiter, - podarray& resid, blas_int& ncv, podarray& v, blas_int& ldv, - podarray& iparam, podarray& ipntr, - podarray& workd, podarray& workl, blas_int& lworkl, podarray& rwork, - blas_int& info - ) - { - #if defined(ARMA_USE_ARPACK) - { - // ARPACK provides a "reverse communication interface" which is an - // entertainingly archaic FORTRAN software engineering technique that - // basically means that we call saupd()/naupd() and it tells us with some - // return code what we need to do next (usually a matrix-vector product) and - // then call it again. So this results in some type of iterative process - // where we call saupd()/naupd() many times. - - blas_int ido = 0; // This must be 0 for the first call. - char bmat = 'I'; // We are considering the standard eigenvalue problem. - n = X.n_rows; // The size of the matrix (should already be set outside). - blas_int nev = n_eigvals; - - // resid.zeros(n); - eigs_randu_filler randu_filler; - randu_filler.fill(resid, n); // use deterministic starting point - - // Two contraints on NCV: (NCV > NEV) for sym problems or - // (NCV > NEV + 2) for gen problems and (NCV <= N) - // - // We're calling either arpack::saupd() or arpack::naupd(), - // which have slighly different minimum constraint and recommended value for NCV: - // http://www.caam.rice.edu/software/ARPACK/UG/node136.html - // http://www.caam.rice.edu/software/ARPACK/UG/node138.html - - if(ncv < (nev + (sym ? 1 : 3))) { ncv = (nev + (sym ? 1 : 3)); } - if(ncv > n ) { ncv = n; } - - v.zeros(n * ncv); // Array N by NCV (output). - rwork.zeros(ncv); // Work array of size NCV for complex calls. - ldv = n; // "Leading dimension of V exactly as declared in the calling program." - - // IPARAM: integer array of length 11. - iparam.zeros(11); - iparam(0) = 1; // Exact shifts (not provided by us). - iparam(2) = maxiter; // Maximum iterations; all the examples use 300, but they were written in the ancient times. - iparam(6) = 1; // Mode 1: A * x = lambda * x. - - // IPNTR: integer array of length 14 (output). - ipntr.zeros(14); - - // Real work array used in the basic Arnoldi iteration for reverse communication. - workd.zeros(3 * n); - - // lworkl must be at least 3 * NCV^2 + 6 * NCV. - lworkl = 3 * (ncv * ncv) + 6 * ncv; - - // Real work array of length lworkl. - workl.zeros(lworkl); - - // info = 0; // resid to be filled with random values by ARPACK (non-deterministic) - info = 1; // resid is already filled with random values (deterministic) - - // All the parameters have been set or created. Time to loop a lot. - while(ido != 99) - { - // Call saupd() or naupd() with the current parameters. - if(sym) - { - arma_debug_print("arpack::saupd()"); - arpack::saupd(&ido, &bmat, &n, which, &nev, &tol, resid.memptr(), &ncv, v.memptr(), &ldv, iparam.memptr(), ipntr.memptr(), workd.memptr(), workl.memptr(), &lworkl, &info); - } - else - { - arma_debug_print("arpack::naupd()"); - arpack::naupd(&ido, &bmat, &n, which, &nev, &tol, resid.memptr(), &ncv, v.memptr(), &ldv, iparam.memptr(), ipntr.memptr(), workd.memptr(), workl.memptr(), &lworkl, rwork.memptr(), &info); - } - - // What do we do now? - switch (ido) - { - case -1: - // fallthrough - case 1: - { - // We need to calculate the matrix-vector multiplication y = OP * x - // where x is of length n and starts at workd(ipntr(0)), - // and y is of length n and starts at workd(ipntr(1)). - // We have to subtract one from FORTRAN pointers. - - Row out(workd.memptr() + ipntr(1) - 1, n, false, true); - Row in(workd.memptr() + ipntr(0) - 1, n, false, true); - - out = in * Xst; // using transposed version - - break; - } - case 99: - // Nothing to do here, things have converged. - break; - default: - { - return; // Parent frame can look at the value of info. - } - } - } - - // The process has ended; check the return code. - if( (info != 0) && (info != 1) ) - { - // Print warnings if there was a failure. - - if(sym) - { - arma_warn(1, "eigs_sym(): ARPACK error ", info, " in saupd()"); - } - else - { - arma_warn(1, "eigs_gen(): ARPACK error ", info, " in naupd()"); - } - - return; // Parent frame can look at the value of info. - } - } - #else - { - arma_ignore(n_eigvals); - arma_ignore(which); - arma_ignore(X); - arma_ignore(sym); - arma_ignore(n); - arma_ignore(tol); - arma_ignore(maxiter); - arma_ignore(resid); - arma_ignore(ncv); - arma_ignore(v); - arma_ignore(ldv); - arma_ignore(iparam); - arma_ignore(ipntr); - arma_ignore(workd); - arma_ignore(workl); - arma_ignore(lworkl); - arma_ignore(rwork); - arma_ignore(info); - } - #endif - } - - - -// Here 'sigma' is 'T', but should be 'eT'. -// Applying complex shifts to real matrices is currently not directly implemented -template -inline -void -sp_auxlib::run_aupd_shiftinvert - ( - const uword n_eigvals, const T sigma, - const SpMat& X, const bool sym, - blas_int& n, eT& tol, blas_int& maxiter, - podarray& resid, blas_int& ncv, podarray& v, blas_int& ldv, - podarray& iparam, podarray& ipntr, - podarray& workd, podarray& workl, blas_int& lworkl, podarray& rwork, - blas_int& info - ) - { - // TODO: inconsistent use of type names: T can be complex while eT can be real - - #if (defined(ARMA_USE_ARPACK) && defined(ARMA_USE_SUPERLU)) - { - char which_lm[3] = "LM"; - - char* which = which_lm; // NOTE: which_lm is the assumed operation when using shift-invert - - blas_int ido = 0; // This must be 0 for the first call. - char bmat = 'I'; // We are considering the standard eigenvalue problem. - n = X.n_rows; // The size of the matrix (should already be set outside). - blas_int nev = n_eigvals; - - // resid.zeros(n); - eigs_randu_filler randu_filler; - randu_filler.fill(resid, n); // use deterministic starting point - - // Two contraints on NCV: (NCV > NEV) for sym problems or - // (NCV > NEV + 2) for gen problems and (NCV <= N) - // - // We're calling either arpack::saupd() or arpack::naupd(), - // which have slighly different minimum constraint and recommended value for NCV: - // http://www.caam.rice.edu/software/ARPACK/UG/node136.html - // http://www.caam.rice.edu/software/ARPACK/UG/node138.html - - if(ncv < (nev + (sym ? 1 : 3))) { ncv = (nev + (sym ? 1 : 3)); } - if(ncv > n ) { ncv = n; } - - v.zeros(n * ncv); // Array N by NCV (output). - rwork.zeros(ncv); // Work array of size NCV for complex calls. - ldv = n; // "Leading dimension of V exactly as declared in the calling program." - - // IPARAM: integer array of length 11. - iparam.zeros(11); - iparam(0) = 1; // Exact shifts (not provided by us). - iparam(2) = maxiter; // Maximum iterations; all the examples use 300, but they were written in the ancient times. - // iparam(6) = 1; // Mode 1: A * x = lambda * x. - - // Change IPARAM for shift-invert - iparam(6) = 3; // Mode 3: A * x = lambda * M * x, M symmetric semi-definite. OP = inv[A - sigma*M]*M (A complex) or Real_Part{ inv[A - sigma*M]*M } (A real) and B = M. - - // IPNTR: integer array of length 14 (output). - ipntr.zeros(14); - - // Real work array used in the basic Arnoldi iteration for reverse communication. - workd.zeros(3 * n); - - // lworkl must be at least 3 * NCV^2 + 6 * NCV. - lworkl = 3 * (ncv * ncv) + 6 * ncv; - - // Real work array of length lworkl. - workl.zeros(lworkl); - - // info = 0; // resid to be filled with random values by ARPACK (non-deterministic) - info = 1; // resid is already filled with random values (deterministic) - - superlu_opts superlu_opts_default; - superlu::superlu_options_t options; - sp_auxlib::set_superlu_opts(options, superlu_opts_default); - int lwork = 0; - superlu::trans_t trans = superlu::NOTRANS; - - superlu::GlobalLU_t Glu; /* Not needed on return. */ - arrayops::fill_zeros(reinterpret_cast(&Glu), sizeof(superlu::GlobalLU_t)); - - superlu_supermatrix_wrangler x; - superlu_supermatrix_wrangler xC; - - const bool status_x = sp_auxlib::copy_to_supermatrix_with_shift(x.get_ref(), X, sigma); - - if(status_x == false) - { - arma_stop_runtime_error("run_aupd_shiftinvert(): could not construct SuperLU matrix"); - info = blas_int(-1); - return; - } - - // // for debugging only - // if(true) - // { - // cout << "*** testing output of copy_to_supermatrix_with_shift()" << endl; - // cout << "*** sigma: " << sigma << endl; - // - // SpMat Y(X); - // Y.diag() -= sigma; - // - // SpMat Z; - // - // sp_auxlib::copy_to_spmat(Z, x.get_ref()); - // - // cout << "*** size(Y): " << arma::size(Y) << endl; - // cout << "*** size(Z): " << arma::size(Z) << endl; - // cout << "*** accu(abs(Y)): " << accu(abs(Y)) << endl; - // cout << "*** accu(abs(Z)): " << accu(abs(Z)) << endl; - // - // if(arma::size(Y) == arma::size(Z)) - // { - // cout << "*** error: " << accu(abs(Y-Z)) << endl; - // } - // } - - superlu_supermatrix_wrangler l; - superlu_supermatrix_wrangler u; - - superlu_array_wrangler perm_c(X.n_cols+1); // paranoia: increase array length by 1 - superlu_array_wrangler perm_r(X.n_rows+1); - superlu_array_wrangler etree(X.n_cols+1); - - superlu_stat_wrangler stat; - - int panel_size = superlu::sp_ispec_environ(1); - int relax = superlu::sp_ispec_environ(2); - int slu_info = 0; // Return code. - - arma_debug_print("superlu::gstrf()"); - superlu::get_permutation_c(options.ColPerm, x.get_ptr(), perm_c.get_ptr()); - superlu::sp_preorder_mat(&options, x.get_ptr(), perm_c.get_ptr(), etree.get_ptr(), xC.get_ptr()); - superlu::gstrf(&options, xC.get_ptr(), relax, panel_size, etree.get_ptr(), NULL, lwork, perm_c.get_ptr(), perm_r.get_ptr(), l.get_ptr(), u.get_ptr(), &Glu, stat.get_ptr(), &slu_info); - - if(slu_info != 0) - { - arma_warn(2, "matrix is singular to working precision"); - info = blas_int(-1); - return; - } - - // NOTE: potential problem with inconsistent/mismatched use of eT and T types - eT x_norm_val = sp_auxlib::norm1(x.get_ptr()); - eT x_rcond = sp_auxlib::lu_rcond(l.get_ptr(), u.get_ptr(), x_norm_val); - - if( (x_rcond < std::numeric_limits::epsilon()) || arma_isnan(x_rcond) ) - { - arma_warn(2, "matrix is singular to working precision (rcond: ", x_rcond, ")"); - info = blas_int(-1); - return; - } - - // All the parameters have been set or created. Time to loop a lot. - while(ido != 99) - { - // Call saupd() or naupd() with the current parameters. - if(sym) - { - arma_debug_print("arpack::saupd()"); - arpack::saupd(&ido, &bmat, &n, which, &nev, &tol, resid.memptr(), &ncv, v.memptr(), &ldv, iparam.memptr(), ipntr.memptr(), workd.memptr(), workl.memptr(), &lworkl, &info); - } - else - { - arma_debug_print("arpack::naupd()"); - arpack::naupd(&ido, &bmat, &n, which, &nev, &tol, resid.memptr(), &ncv, v.memptr(), &ldv, iparam.memptr(), ipntr.memptr(), workd.memptr(), workl.memptr(), &lworkl, rwork.memptr(), &info); - } - - // What do we do now? - switch (ido) - { - case -1: - // fallthrough - case 1: - { - // We need to calculate the matrix-vector multiplication y = OP * x - // where x is of length n and starts at workd(ipntr(0)), - // and y is of length n and starts at workd(ipntr(1)). - // We have to subtract one from FORTRAN pointers. - - Col out(workd.memptr() + ipntr(1) - 1, n, false, true); - Col in(workd.memptr() + ipntr(0) - 1, n, false, true); - - // Consider getting the LU factorization from ZGSTRF, and then - // solve the system L*U*out = in (possibly with permutation matrix?) - // Instead of "spsolve(out,X,in)" we call gstrf above and gstrs below - - out = in; - superlu_supermatrix_wrangler out_slu; - - const bool status_out_slu = sp_auxlib::wrap_to_supermatrix(out_slu.get_ref(), out); - - if(status_out_slu == false) { arma_stop_runtime_error("run_aupd_shiftinvert(): could not construct SuperLU matrix"); return; } - - arma_debug_print("superlu::gstrs()"); - superlu::gstrs(trans, l.get_ptr(), u.get_ptr(), perm_c.get_ptr(), perm_r.get_ptr(), out_slu.get_ptr(), stat.get_ptr(), &info); - - // No need to modify memory further since it was all done in-place. - - break; - } - case 99: - // Nothing to do here, things have converged. - break; - default: - { - return; // Parent frame can look at the value of info. - } - } - } - - // The process has ended; check the return code. - if( (info != 0) && (info != 1) ) - { - // Print warnings if there was a failure. - - if(sym) - { - arma_warn(2, "eigs_sym(): ARPACK error ", info, " in saupd()"); - } - else - { - arma_warn(2, "eigs_gen(): ARPACK error ", info, " in naupd()"); - } - - return; // Parent frame can look at the value of info. - } - } - #else - { - arma_ignore(n_eigvals); - arma_ignore(sigma); - arma_ignore(X); - arma_ignore(sym); - arma_ignore(n); - arma_ignore(tol); - arma_ignore(maxiter); - arma_ignore(resid); - arma_ignore(ncv); - arma_ignore(v); - arma_ignore(ldv); - arma_ignore(iparam); - arma_ignore(ipntr); - arma_ignore(workd); - arma_ignore(workl); - arma_ignore(lworkl); - arma_ignore(rwork); - arma_ignore(info); - } - #endif - } - - - -template -inline -bool -sp_auxlib::rudimentary_sym_check(const SpMat& X) - { - arma_debug_sigprint(); - - if(X.n_rows != X.n_cols) { return false; } - - const eT tol = eT(10000) * std::numeric_limits::epsilon(); // allow some leeway - - typename SpMat::const_iterator it = X.begin(); - typename SpMat::const_iterator it_end = X.end(); - - const uword n_check_limit = (std::max)( uword(2), uword(X.n_nonzero/100) ); - - uword n_check = 1; - - while( (it != it_end) && (n_check <= n_check_limit) ) - { - const uword it_row = it.row(); - const uword it_col = it.col(); - - if(it_row != it_col) - { - const eT A = (*it); - const eT B = X.at( it_col, it_row ); // deliberately swapped - - const eT C = (std::max)(std::abs(A), std::abs(B)); - - const eT delta = std::abs(A - B); - - if(( (delta <= tol) || (delta <= (C * tol)) ) == false) { return false; } - - ++n_check; - } - - ++it; - } - - return true; - } - - - -template -inline -bool -sp_auxlib::rudimentary_sym_check(const SpMat< std::complex >& X) - { - arma_debug_sigprint(); - - // NOTE: the function name is a misnomer, as it checks for hermitian complex matrices; - // NOTE: for simplicity of use, the function name is the same as for real matrices - - typedef typename std::complex eT; - - if(X.n_rows != X.n_cols) { return false; } - - const T tol = T(10000) * std::numeric_limits::epsilon(); // allow some leeway - - typename SpMat::const_iterator it = X.begin(); - typename SpMat::const_iterator it_end = X.end(); - - const uword n_check_limit = (std::max)( uword(2), uword(X.n_nonzero/100) ); - - uword n_check = 1; - - while( (it != it_end) && (n_check <= n_check_limit) ) - { - const uword it_row = it.row(); - const uword it_col = it.col(); - - if(it_row != it_col) - { - const eT A = (*it); - const eT B = X.at( it_col, it_row ); // deliberately swapped - - const T C_real = (std::max)(std::abs(A.real()), std::abs(B.real())); - const T C_imag = (std::max)(std::abs(A.imag()), std::abs(B.imag())); - - const T delta_real = std::abs(A.real() - B.real()); - const T delta_imag = std::abs(A.imag() + B.imag()); // take into account the conjugate - - const bool okay_real = ( (delta_real <= tol) || (delta_real <= (C_real * tol)) ); - const bool okay_imag = ( (delta_imag <= tol) || (delta_imag <= (C_imag * tol)) ); - - if( (okay_real == false) || (okay_imag == false) ) { return false; } - - ++n_check; - } - else - { - const eT A = (*it); - - if(std::abs(A.imag()) > tol) { return false; } - } - - ++it; - } - - return true; - } - - - -// - - - -template -inline -eigs_randu_filler::eigs_randu_filler() - { - arma_debug_sigprint(); - - typedef typename std::mt19937_64::result_type local_seed_type; - - local_engine.seed(local_seed_type(123)); - - typedef typename std::uniform_real_distribution::param_type local_param_type; - - local_u_distr.param(local_param_type(-1.0, +1.0)); - } - - -template -inline -void -eigs_randu_filler::fill(podarray& X, const uword N) - { - arma_debug_sigprint(); - - X.set_size(N); - - eT* X_mem = X.memptr(); - - for(uword i=0; i -inline -eigs_randu_filler< std::complex >::eigs_randu_filler() - { - arma_debug_sigprint(); - - typedef typename std::mt19937_64::result_type local_seed_type; - - local_engine.seed(local_seed_type(123)); - - typedef typename std::uniform_real_distribution::param_type local_param_type; - - local_u_distr.param(local_param_type(-1.0, +1.0)); - } - - -template -inline -void -eigs_randu_filler< std::complex >::fill(podarray< std::complex >& X, const uword N) - { - arma_debug_sigprint(); - - typedef typename std::complex eT; - - X.set_size(N); - - eT* X_mem = X.memptr(); - - for(uword i=0; i(&m); - bool all_zero = true; - - for(size_t i=0; i < sizeof(superlu::SuperMatrix); ++i) - { - if(m_char[i] != char(0)) { all_zero = false; break; } - } - - if(all_zero == false) { sp_auxlib::destroy_supermatrix(m); } - } - -inline -superlu_supermatrix_wrangler::superlu_supermatrix_wrangler() - { - arma_debug_sigprint_this(this); - - arrayops::fill_zeros(reinterpret_cast(&m), sizeof(superlu::SuperMatrix)); - } - -inline -superlu::SuperMatrix& -superlu_supermatrix_wrangler::get_ref() - { - used = true; - - return m; - } - -inline -superlu::SuperMatrix* -superlu_supermatrix_wrangler::get_ptr() - { - used = true; - - return &m; - } - - -// - - -inline -superlu_stat_wrangler::~superlu_stat_wrangler() - { - arma_debug_sigprint_this(this); - - superlu::free_stat(&stat); - } - -inline -superlu_stat_wrangler::superlu_stat_wrangler() - { - arma_debug_sigprint_this(this); - - arrayops::fill_zeros(reinterpret_cast(&stat), sizeof(superlu::SuperLUStat_t)); - - superlu::init_stat(&stat); - } - -inline -superlu::SuperLUStat_t* -superlu_stat_wrangler::get_ptr() - { - return &stat; - } - - -// - - -template -inline -superlu_array_wrangler::~superlu_array_wrangler() - { - arma_debug_sigprint_this(this); - - (*this).reset(); - } - -template -inline -superlu_array_wrangler::superlu_array_wrangler() - : mem(nullptr) - { - arma_debug_sigprint_this(this); - } - -template -inline -superlu_array_wrangler::superlu_array_wrangler(const uword n_elem) - : mem(nullptr) - { - arma_debug_sigprint_this(this); - - (*this).set_size(n_elem); - } - -template -inline -void -superlu_array_wrangler::set_size(const uword n_elem) - { - arma_debug_sigprint(); - - if(mem != nullptr) { (*this).reset(); } - - mem = (eT*)(superlu::malloc(n_elem * sizeof(eT))); - - arma_check_bad_alloc( (mem == nullptr), "superlu::malloc(): out of memory" ); - - arrayops::fill_zeros(mem, n_elem); - } - -template -inline -void -superlu_array_wrangler::reset() - { - arma_debug_sigprint(); - - if(mem != nullptr) - { - superlu::free(mem); - mem = nullptr; - } - } - -template -inline -eT* -superlu_array_wrangler::get_ptr() - { - return mem; - } - - -// - - -template -inline -superlu_worker::~superlu_worker() - { - arma_debug_sigprint_this(this); - - if(l != nullptr) { delete l; l = nullptr; } - if(u != nullptr) { delete u; u = nullptr; } - } - - -template -inline -superlu_worker::superlu_worker() - { - arma_debug_sigprint_this(this); - } - - -template -inline -bool -superlu_worker::factorise(typename get_pod_type::result& out_rcond, const SpMat& A, const superlu_opts& user_opts) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - factorisation_valid = false; - - if(l != nullptr) { delete l; l = nullptr; } - if(u != nullptr) { delete u; u = nullptr; } - - l = new(std::nothrow) superlu_supermatrix_wrangler; - u = new(std::nothrow) superlu_supermatrix_wrangler; - - if( (l == nullptr) || (u == nullptr) ) - { - arma_warn(3, "superlu_worker()::factorise(): could not construct SuperLU matrix"); - return false; - } - - superlu_supermatrix_wrangler& l_ref = (*l); - superlu_supermatrix_wrangler& u_ref = (*u); - - superlu::superlu_options_t options; - sp_auxlib::set_superlu_opts(options, user_opts); - - superlu_supermatrix_wrangler AA; - superlu_supermatrix_wrangler AAc; - - const bool status_AA = sp_auxlib::copy_to_supermatrix(AA.get_ref(), A); - - if(status_AA == false) - { - arma_warn(3, "superlu_worker()::factorise(): could not construct SuperLU matrix"); - return false; - } - - (*this).perm_c.set_size(A.n_cols+1); // paranoia: increase array length by 1 - (*this).perm_r.set_size(A.n_rows+1); - - superlu_array_wrangler etree(A.n_cols+1); - - superlu::GlobalLU_t Glu; - arrayops::fill_zeros(reinterpret_cast(&Glu), sizeof(superlu::GlobalLU_t)); - - int panel_size = superlu::sp_ispec_environ(1); - int relax = superlu::sp_ispec_environ(2); - int lwork = 0; - int info = 0; - - arma_debug_print("superlu::superlu::get_permutation_c()"); - superlu::get_permutation_c(options.ColPerm, AA.get_ptr(), perm_c.get_ptr()); - - arma_debug_print("superlu::superlu::sp_preorder_mat()"); - superlu::sp_preorder_mat(&options, AA.get_ptr(), perm_c.get_ptr(), etree.get_ptr(), AAc.get_ptr()); - - arma_debug_print("superlu::gstrf()"); - superlu::gstrf(&options, AAc.get_ptr(), relax, panel_size, etree.get_ptr(), NULL, lwork, perm_c.get_ptr(), perm_r.get_ptr(), l_ref.get_ptr(), u_ref.get_ptr(), &Glu, stat.get_ptr(), &info); - - if(info != 0) - { - arma_warn(3, "superlu_worker()::factorise(): LU factorisation failed"); - return false; - } - - const T AA_norm = sp_auxlib::norm1(AA.get_ptr()); - const T AA_rcond = sp_auxlib::lu_rcond(l_ref.get_ptr(), u_ref.get_ptr(), AA_norm); - - out_rcond = AA_rcond; - - if(arma_isnan(AA_rcond)) { return false; } - // if(AA_rcond == T(0)) { return false; } - - factorisation_valid = true; - - return true; - } - - -template -inline -bool -superlu_worker::solve(Mat& X, const Mat& B) - { - arma_debug_sigprint(); - - if(factorisation_valid == false) { return false; } - if( (l == nullptr) || (u == nullptr) ) { return false; } - - superlu_supermatrix_wrangler& l_ref = (*l); - superlu_supermatrix_wrangler& u_ref = (*u); - - X = B; - - superlu_supermatrix_wrangler XX; - - const bool status_XX = sp_auxlib::wrap_to_supermatrix(XX.get_ref(), X); - - if(status_XX == false) - { - arma_warn(3, "superlu_worker()::solve(): could not construct SuperLU matrix"); - return false; - } - - superlu::trans_t trans = superlu::NOTRANS; - int info = 0; - - arma_debug_print("superlu::gstrs()"); - superlu::gstrs(trans, l_ref.get_ptr(), u_ref.get_ptr(), perm_c.get_ptr(), perm_r.get_ptr(), XX.get_ptr(), stat.get_ptr(), &info); - - return (info == 0); - } - - -#endif - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/span.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/span.hpp deleted file mode 100644 index 14774f146..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/span.hpp +++ /dev/null @@ -1,90 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup span -//! @{ - - -struct span_alt {}; - - -template -class span_base - { - public: - static const span_alt all; - }; - - -template -const span_alt span_base::all = span_alt(); - - -class span : public span_base<> - { - public: - - uword a; - uword b; - bool whole; - - inline - span() - : a(0) - , b(0) - , whole(true) - { - } - - - inline - span(const span_alt&) - : a(0) - , b(0) - , whole(true) - { - } - - - inline - explicit - span(const uword in_a) - : a(in_a) - , b(in_a) - , whole(false) - { - } - - - // the "explicit" keyword is required here to prevent automatic conversion of {a,b} - // into an instance of span() when submatrices are specified - inline - explicit - span(const uword in_a, const uword in_b) - : a(in_a) - , b(in_b) - , whole(false) - { - } - - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spdiagview_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spdiagview_bones.hpp deleted file mode 100644 index 238e8a38d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spdiagview_bones.hpp +++ /dev/null @@ -1,113 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spdiagview -//! @{ - - -//! Class for storing data required to extract and set the diagonals of a sparse matrix -template -class spdiagview : public SpBase< eT, spdiagview > - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - arma_aligned const SpMat& m; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - const uword row_offset; - const uword col_offset; - - const uword n_rows; // equal to n_elem - const uword n_elem; - - static constexpr uword n_cols = 1; - - - protected: - - arma_inline spdiagview(const SpMat& in_m, const uword in_row_offset, const uword in_col_offset, const uword len); - - - public: - - inline ~spdiagview(); - inline spdiagview() = delete; - - inline void operator=(const spdiagview& x); - - inline void operator+=(const eT val); - inline void operator-=(const eT val); - inline void operator*=(const eT val); - inline void operator/=(const eT val); - - template inline void operator= (const Base& x); - template inline void operator+=(const Base& x); - template inline void operator-=(const Base& x); - template inline void operator%=(const Base& x); - template inline void operator/=(const Base& x); - - template inline void operator= (const SpBase& x); - template inline void operator+=(const SpBase& x); - template inline void operator-=(const SpBase& x); - template inline void operator%=(const SpBase& x); - template inline void operator/=(const SpBase& x); - - inline SpMat_MapMat_val operator[](const uword ii); - inline eT operator[](const uword ii) const; - - inline SpMat_MapMat_val at(const uword ii); - inline eT at(const uword ii) const; - - inline SpMat_MapMat_val operator()(const uword ii); - inline eT operator()(const uword ii) const; - - inline SpMat_MapMat_val at(const uword in_n_row, const uword); - inline eT at(const uword in_n_row, const uword) const; - - inline SpMat_MapMat_val operator()(const uword in_n_row, const uword in_n_col); - inline eT operator()(const uword in_n_row, const uword in_n_col) const; - - - inline void replace(const eT old_val, const eT new_val); - - inline void clean(const pod_type threshold); - - inline void clamp(const eT min_val, const eT max_val); - - inline void fill(const eT val); - inline void zeros(); - inline void ones(); - inline void randu(); - inline void randn(); - - - inline static void extract(SpMat& out, const spdiagview& in); - inline static void extract( Mat& out, const spdiagview& in); - - - friend class SpMat; - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spdiagview_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spdiagview_meat.hpp deleted file mode 100644 index b08585d65..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spdiagview_meat.hpp +++ /dev/null @@ -1,1081 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spdiagview -//! @{ - - -template -inline -spdiagview::~spdiagview() - { - arma_debug_sigprint(); - } - - -template -arma_inline -spdiagview::spdiagview(const SpMat& in_m, const uword in_row_offset, const uword in_col_offset, const uword in_len) - : m(in_m) - , row_offset(in_row_offset) - , col_offset(in_col_offset) - , n_rows(in_len) - , n_elem(in_len) - { - arma_debug_sigprint(); - } - - - -//! set a diagonal of our matrix using a diagonal from a foreign matrix -template -inline -void -spdiagview::operator= (const spdiagview& x) - { - arma_debug_sigprint(); - - spdiagview& d = *this; - - arma_conform_check( (d.n_elem != x.n_elem), "spdiagview: diagonals have incompatible lengths" ); - - SpMat& d_m = const_cast< SpMat& >(d.m); - const SpMat& x_m = x.m; - - if( (&d_m == &x_m) || ((d.row_offset == 0) && (d.col_offset == 0)) ) - { - const Mat tmp(x); - - (*this).operator=(tmp); - } - else - { - const uword d_n_elem = d.n_elem; - const uword d_row_offset = d.row_offset; - const uword d_col_offset = d.col_offset; - - const uword x_row_offset = x.row_offset; - const uword x_col_offset = x.col_offset; - - for(uword i=0; i < d_n_elem; ++i) - { - d_m.at(i + d_row_offset, i + d_col_offset) = x_m.at(i + x_row_offset, i + x_col_offset); - } - } - } - - - -template -inline -void -spdiagview::operator+=(const eT val) - { - arma_debug_sigprint(); - - if(val == eT(0)) { return; } - - SpMat& t_m = const_cast< SpMat& >(m); - - const uword t_n_elem = n_elem; - const uword t_row_offset = row_offset; - const uword t_col_offset = col_offset; - - for(uword i=0; i < t_n_elem; ++i) - { - t_m.at(i + t_row_offset, i + t_col_offset) += val; - } - } - - - -template -inline -void -spdiagview::operator-=(const eT val) - { - arma_debug_sigprint(); - - if(val == eT(0)) { return; } - - SpMat& t_m = const_cast< SpMat& >(m); - - const uword t_n_elem = n_elem; - const uword t_row_offset = row_offset; - const uword t_col_offset = col_offset; - - for(uword i=0; i < t_n_elem; ++i) - { - t_m.at(i + t_row_offset, i + t_col_offset) -= val; - } - } - - - -template -inline -void -spdiagview::operator*=(const eT val) - { - arma_debug_sigprint(); - - if(val == eT(0)) { (*this).zeros(); return; } - - SpMat& t_m = const_cast< SpMat& >(m); - - const uword t_n_elem = n_elem; - const uword t_row_offset = row_offset; - const uword t_col_offset = col_offset; - - for(uword i=0; i < t_n_elem; ++i) - { - t_m.at(i + t_row_offset, i + t_col_offset) *= val; - } - } - - - -template -inline -void -spdiagview::operator/=(const eT val) - { - arma_debug_sigprint(); - - SpMat& t_m = const_cast< SpMat& >(m); - - const uword t_n_elem = n_elem; - const uword t_row_offset = row_offset; - const uword t_col_offset = col_offset; - - for(uword i=0; i < t_n_elem; ++i) - { - t_m.at(i + t_row_offset, i + t_col_offset) /= val; - } - } - - - -//! set a diagonal of our matrix using data from a foreign object -template -template -inline -void -spdiagview::operator= (const Base& o) - { - arma_debug_sigprint(); - - spdiagview& d = *this; - - SpMat& d_m = const_cast< SpMat& >(d.m); - - const uword d_n_elem = d.n_elem; - const uword d_row_offset = d.row_offset; - const uword d_col_offset = d.col_offset; - - if(is_same_type< T1, Gen, gen_zeros> >::yes) - { - const Proxy P(o.get_ref()); - - arma_conform_check( (d_n_elem != P.get_n_elem()), "spdiagview: given object has incompatible size" ); - - (*this).zeros(); - - return; - } - - if(is_same_type< T1, Gen, gen_ones> >::yes) - { - const Proxy P(o.get_ref()); - - arma_conform_check( (d_n_elem != P.get_n_elem()), "spdiagview: given object has incompatible size" ); - - (*this).ones(); - - return; - } - - const quasi_unwrap U(o.get_ref()); - const Mat& x = U.M; - - const eT* x_mem = x.memptr(); - - arma_conform_check - ( - ( (d_n_elem != x.n_elem) || ((x.n_rows != 1) && (x.n_cols != 1)) ), - "spdiagview: given object has incompatible size" - ); - - if( (d_row_offset == 0) && (d_col_offset == 0) ) - { - SpMat tmp1; - - tmp1.eye(d_m.n_rows, d_m.n_cols); - - bool has_zero = false; - - for(uword i=0; i < d_n_elem; ++i) - { - const eT val = x_mem[i]; - - access::rw(tmp1.values[i]) = val; - - if(val == eT(0)) { has_zero = true; } - } - - if(has_zero) { tmp1.remove_zeros(); } - - if(tmp1.n_nonzero == 0) { (*this).zeros(); return; } - - SpMat tmp2; - - spglue_merge::diagview_merge(tmp2, d_m, tmp1); - - d_m.steal_mem(tmp2); - } - else - { - for(uword i=0; i < d_n_elem; ++i) - { - d_m.at(i + d_row_offset, i + d_col_offset) = x_mem[i]; - } - } - } - - - -template -template -inline -void -spdiagview::operator+=(const Base& o) - { - arma_debug_sigprint(); - - spdiagview& d = *this; - - SpMat& d_m = const_cast< SpMat& >(d.m); - - const uword d_n_elem = d.n_elem; - const uword d_row_offset = d.row_offset; - const uword d_col_offset = d.col_offset; - - const Proxy P( o.get_ref() ); - - arma_conform_check - ( - ( (d_n_elem != P.get_n_elem()) || ((P.get_n_rows() != 1) && (P.get_n_cols() != 1)) ), - "spdiagview: given object has incompatible size" - ); - - if( (is_Mat::stored_type>::value) || (Proxy::use_at) ) - { - const unwrap::stored_type> tmp(P.Q); - const Mat& x = tmp.M; - - const eT* x_mem = x.memptr(); - - for(uword i=0; i < d_n_elem; ++i) - { - d_m.at(i + d_row_offset, i + d_col_offset) += x_mem[i]; - } - } - else - { - typename Proxy::ea_type Pea = P.get_ea(); - - for(uword i=0; i < d_n_elem; ++i) - { - d_m.at(i + d_row_offset, i + d_col_offset) += Pea[i]; - } - } - } - - - -template -template -inline -void -spdiagview::operator-=(const Base& o) - { - arma_debug_sigprint(); - - spdiagview& d = *this; - - SpMat& d_m = const_cast< SpMat& >(d.m); - - const uword d_n_elem = d.n_elem; - const uword d_row_offset = d.row_offset; - const uword d_col_offset = d.col_offset; - - const Proxy P( o.get_ref() ); - - arma_conform_check - ( - ( (d_n_elem != P.get_n_elem()) || ((P.get_n_rows() != 1) && (P.get_n_cols() != 1)) ), - "spdiagview: given object has incompatible size" - ); - - if( (is_Mat::stored_type>::value) || (Proxy::use_at) ) - { - const unwrap::stored_type> tmp(P.Q); - const Mat& x = tmp.M; - - const eT* x_mem = x.memptr(); - - for(uword i=0; i < d_n_elem; ++i) - { - d_m.at(i + d_row_offset, i + d_col_offset) -= x_mem[i]; - } - } - else - { - typename Proxy::ea_type Pea = P.get_ea(); - - for(uword i=0; i < d_n_elem; ++i) - { - d_m.at(i + d_row_offset, i + d_col_offset) -= Pea[i]; - } - } - } - - - -template -template -inline -void -spdiagview::operator%=(const Base& o) - { - arma_debug_sigprint(); - - spdiagview& d = *this; - - SpMat& d_m = const_cast< SpMat& >(d.m); - - const uword d_n_elem = d.n_elem; - const uword d_row_offset = d.row_offset; - const uword d_col_offset = d.col_offset; - - const Proxy P( o.get_ref() ); - - arma_conform_check - ( - ( (d_n_elem != P.get_n_elem()) || ((P.get_n_rows() != 1) && (P.get_n_cols() != 1)) ), - "spdiagview: given object has incompatible size" - ); - - if( (is_Mat::stored_type>::value) || (Proxy::use_at) ) - { - const unwrap::stored_type> tmp(P.Q); - const Mat& x = tmp.M; - - const eT* x_mem = x.memptr(); - - for(uword i=0; i < d_n_elem; ++i) - { - d_m.at(i + d_row_offset, i + d_col_offset) *= x_mem[i]; - } - } - else - { - typename Proxy::ea_type Pea = P.get_ea(); - - for(uword i=0; i < d_n_elem; ++i) - { - d_m.at(i + d_row_offset, i + d_col_offset) *= Pea[i]; - } - } - } - - - -template -template -inline -void -spdiagview::operator/=(const Base& o) - { - arma_debug_sigprint(); - - spdiagview& d = *this; - - SpMat& d_m = const_cast< SpMat& >(d.m); - - const uword d_n_elem = d.n_elem; - const uword d_row_offset = d.row_offset; - const uword d_col_offset = d.col_offset; - - const Proxy P( o.get_ref() ); - - arma_conform_check - ( - ( (d_n_elem != P.get_n_elem()) || ((P.get_n_rows() != 1) && (P.get_n_cols() != 1)) ), - "spdiagview: given object has incompatible size" - ); - - if( (is_Mat::stored_type>::value) || (Proxy::use_at) ) - { - const unwrap::stored_type> tmp(P.Q); - const Mat& x = tmp.M; - - const eT* x_mem = x.memptr(); - - for(uword i=0; i < d_n_elem; ++i) - { - d_m.at(i + d_row_offset, i + d_col_offset) /= x_mem[i]; - } - } - else - { - typename Proxy::ea_type Pea = P.get_ea(); - - for(uword i=0; i < d_n_elem; ++i) - { - d_m.at(i + d_row_offset, i + d_col_offset) /= Pea[i]; - } - } - } - - - -//! set a diagonal of our matrix using data from a foreign object -template -template -inline -void -spdiagview::operator= (const SpBase& o) - { - arma_debug_sigprint(); - - const unwrap_spmat U( o.get_ref() ); - const SpMat& x = U.M; - - arma_conform_check - ( - ( (n_elem != x.n_elem) || ((x.n_rows != 1) && (x.n_cols != 1)) ), - "spdiagview: given object has incompatible size" - ); - - const Mat tmp(x); - - (*this).operator=(tmp); - } - - - -template -template -inline -void -spdiagview::operator+=(const SpBase& o) - { - arma_debug_sigprint(); - - spdiagview& d = *this; - - SpMat& d_m = const_cast< SpMat& >(d.m); - - const uword d_n_elem = d.n_elem; - const uword d_row_offset = d.row_offset; - const uword d_col_offset = d.col_offset; - - const SpProxy P( o.get_ref() ); - - arma_conform_check - ( - ( (d_n_elem != P.get_n_elem()) || ((P.get_n_rows() != 1) && (P.get_n_cols() != 1)) ), - "spdiagview: given object has incompatible size" - ); - - if( SpProxy::use_iterator || P.is_alias(d_m) ) - { - const SpMat tmp(P.Q); - - if(tmp.n_cols == 1) - { - for(uword i=0; i < d_n_elem; ++i) { d_m.at(i + d_row_offset, i + d_col_offset) += tmp.at(i,0); } - } - else - if(tmp.n_rows == 1) - { - for(uword i=0; i < d_n_elem; ++i) { d_m.at(i + d_row_offset, i + d_col_offset) += tmp.at(0,i); } - } - } - else - { - if(P.get_n_cols() == 1) - { - for(uword i=0; i < d_n_elem; ++i) { d_m.at(i + d_row_offset, i + d_col_offset) += P.at(i,0); } - } - else - if(P.get_n_rows() == 1) - { - for(uword i=0; i < d_n_elem; ++i) { d_m.at(i + d_row_offset, i + d_col_offset) += P.at(0,i); } - } - } - } - - - -template -template -inline -void -spdiagview::operator-=(const SpBase& o) - { - arma_debug_sigprint(); - - spdiagview& d = *this; - - SpMat& d_m = const_cast< SpMat& >(d.m); - - const uword d_n_elem = d.n_elem; - const uword d_row_offset = d.row_offset; - const uword d_col_offset = d.col_offset; - - const SpProxy P( o.get_ref() ); - - arma_conform_check - ( - ( (d_n_elem != P.get_n_elem()) || ((P.get_n_rows() != 1) && (P.get_n_cols() != 1)) ), - "spdiagview: given object has incompatible size" - ); - - if( SpProxy::use_iterator || P.is_alias(d_m) ) - { - const SpMat tmp(P.Q); - - if(tmp.n_cols == 1) - { - for(uword i=0; i < d_n_elem; ++i) { d_m.at(i + d_row_offset, i + d_col_offset) -= tmp.at(i,0); } - } - else - if(tmp.n_rows == 1) - { - for(uword i=0; i < d_n_elem; ++i) { d_m.at(i + d_row_offset, i + d_col_offset) -= tmp.at(0,i); } - } - } - else - { - if(P.get_n_cols() == 1) - { - for(uword i=0; i < d_n_elem; ++i) { d_m.at(i + d_row_offset, i + d_col_offset) -= P.at(i,0); } - } - else - if(P.get_n_rows() == 1) - { - for(uword i=0; i < d_n_elem; ++i) { d_m.at(i + d_row_offset, i + d_col_offset) -= P.at(0,i); } - } - } - } - - - -template -template -inline -void -spdiagview::operator%=(const SpBase& o) - { - arma_debug_sigprint(); - - spdiagview& d = *this; - - SpMat& d_m = const_cast< SpMat& >(d.m); - - const uword d_n_elem = d.n_elem; - const uword d_row_offset = d.row_offset; - const uword d_col_offset = d.col_offset; - - const SpProxy P( o.get_ref() ); - - arma_conform_check - ( - ( (d_n_elem != P.get_n_elem()) || ((P.get_n_rows() != 1) && (P.get_n_cols() != 1)) ), - "spdiagview: given object has incompatible size" - ); - - if( SpProxy::use_iterator || P.is_alias(d_m) ) - { - const SpMat tmp(P.Q); - - if(tmp.n_cols == 1) - { - for(uword i=0; i < d_n_elem; ++i) { d_m.at(i + d_row_offset, i + d_col_offset) *= tmp.at(i,0); } - } - else - if(tmp.n_rows == 1) - { - for(uword i=0; i < d_n_elem; ++i) { d_m.at(i + d_row_offset, i + d_col_offset) *= tmp.at(0,i); } - } - } - else - { - if(P.get_n_cols() == 1) - { - for(uword i=0; i < d_n_elem; ++i) { d_m.at(i + d_row_offset, i + d_col_offset) *= P.at(i,0); } - } - else - if(P.get_n_rows() == 1) - { - for(uword i=0; i < d_n_elem; ++i) { d_m.at(i + d_row_offset, i + d_col_offset) *= P.at(0,i); } - } - } - } - - - -template -template -inline -void -spdiagview::operator/=(const SpBase& o) - { - arma_debug_sigprint(); - - spdiagview& d = *this; - - SpMat& d_m = const_cast< SpMat& >(d.m); - - const uword d_n_elem = d.n_elem; - const uword d_row_offset = d.row_offset; - const uword d_col_offset = d.col_offset; - - const SpProxy P( o.get_ref() ); - - arma_conform_check - ( - ( (d_n_elem != P.get_n_elem()) || ((P.get_n_rows() != 1) && (P.get_n_cols() != 1)) ), - "spdiagview: given object has incompatible size" - ); - - if( SpProxy::use_iterator || P.is_alias(d_m) ) - { - const SpMat tmp(P.Q); - - if(tmp.n_cols == 1) - { - for(uword i=0; i < d_n_elem; ++i) { d_m.at(i + d_row_offset, i + d_col_offset) /= tmp.at(i,0); } - } - else - if(tmp.n_rows == 1) - { - for(uword i=0; i < d_n_elem; ++i) { d_m.at(i + d_row_offset, i + d_col_offset) /= tmp.at(0,i); } - } - } - else - { - if(P.get_n_cols() == 1) - { - for(uword i=0; i < d_n_elem; ++i) { d_m.at(i + d_row_offset, i + d_col_offset) /= P.at(i,0); } - } - else - if(P.get_n_rows() == 1) - { - for(uword i=0; i < d_n_elem; ++i) { d_m.at(i + d_row_offset, i + d_col_offset) /= P.at(0,i); } - } - } - } - - - -template -inline -void -spdiagview::extract(SpMat& out, const spdiagview& d) - { - arma_debug_sigprint(); - - const SpMat& d_m = d.m; - - const uword d_n_elem = d.n_elem; - const uword d_row_offset = d.row_offset; - const uword d_col_offset = d.col_offset; - - Col cache(d_n_elem, arma_nozeros_indicator()); - eT* cache_mem = cache.memptr(); - - uword d_n_nonzero = 0; - - for(uword i=0; i < d_n_elem; ++i) - { - const eT val = d_m.at(i + d_row_offset, i + d_col_offset); - - cache_mem[i] = val; - - d_n_nonzero += (val != eT(0)) ? uword(1) : uword(0); - } - - out.reserve(d_n_elem, 1, d_n_nonzero); - - uword count = 0; - for(uword i=0; i < d_n_elem; ++i) - { - const eT val = cache_mem[i]; - - if(val != eT(0)) - { - access::rw(out.row_indices[count]) = i; - access::rw(out.values[count]) = val; - ++count; - } - } - - access::rw(out.col_ptrs[0]) = 0; - access::rw(out.col_ptrs[1]) = d_n_nonzero; - } - - - -//! extract a diagonal and store it as a dense column vector -template -inline -void -spdiagview::extract(Mat& out, const spdiagview& in) - { - arma_debug_sigprint(); - - // NOTE: we're assuming that the 'out' matrix has already been set to the correct size; - // size setting is done by either the Mat contructor or Mat::operator=() - - const SpMat& in_m = in.m; - - const uword in_n_elem = in.n_elem; - const uword in_row_offset = in.row_offset; - const uword in_col_offset = in.col_offset; - - eT* out_mem = out.memptr(); - - for(uword i=0; i < in_n_elem; ++i) - { - out_mem[i] = in_m.at(i + in_row_offset, i + in_col_offset); - } - } - - - -template -inline -SpMat_MapMat_val -spdiagview::operator[](const uword i) - { - return (const_cast< SpMat& >(m)).at(i+row_offset, i+col_offset); - } - - - -template -inline -eT -spdiagview::operator[](const uword i) const - { - return m.at(i+row_offset, i+col_offset); - } - - - -template -inline -SpMat_MapMat_val -spdiagview::at(const uword i) - { - return (const_cast< SpMat& >(m)).at(i+row_offset, i+col_offset); - } - - - -template -inline -eT -spdiagview::at(const uword i) const - { - return m.at(i+row_offset, i+col_offset); - } - - - -template -inline -SpMat_MapMat_val -spdiagview::operator()(const uword i) - { - arma_conform_check_bounds( (i >= n_elem), "spdiagview::operator(): out of bounds" ); - - return (const_cast< SpMat& >(m)).at(i+row_offset, i+col_offset); - } - - - -template -inline -eT -spdiagview::operator()(const uword i) const - { - arma_conform_check_bounds( (i >= n_elem), "spdiagview::operator(): out of bounds" ); - - return m.at(i+row_offset, i+col_offset); - } - - - -template -inline -SpMat_MapMat_val -spdiagview::at(const uword row, const uword) - { - return (const_cast< SpMat& >(m)).at(row+row_offset, row+col_offset); - } - - - -template -inline -eT -spdiagview::at(const uword row, const uword) const - { - return m.at(row+row_offset, row+col_offset); - } - - - -template -inline -SpMat_MapMat_val -spdiagview::operator()(const uword row, const uword col) - { - arma_conform_check_bounds( ((row >= n_elem) || (col > 0)), "spdiagview::operator(): out of bounds" ); - - return (const_cast< SpMat& >(m)).at(row+row_offset, row+col_offset); - } - - - -template -inline -eT -spdiagview::operator()(const uword row, const uword col) const - { - arma_conform_check_bounds( ((row >= n_elem) || (col > 0)), "spdiagview::operator(): out of bounds" ); - - return m.at(row+row_offset, row+col_offset); - } - - - -template -inline -void -spdiagview::replace(const eT old_val, const eT new_val) - { - arma_debug_sigprint(); - - if(old_val == eT(0)) - { - arma_warn(1, "spdiagview::replace(): replacement not done, as old_val = 0"); - } - else - { - Mat tmp(*this); - - tmp.replace(old_val, new_val); - - (*this).operator=(tmp); - } - } - - - -template -inline -void -spdiagview::clean(const typename get_pod_type::result threshold) - { - arma_debug_sigprint(); - - Mat tmp(*this); - - tmp.clean(threshold); - - (*this).operator=(tmp); - } - - - -template -inline -void -spdiagview::clamp(const eT min_val, const eT max_val) - { - arma_debug_sigprint(); - - SpMat tmp(*this); - - tmp.clamp(min_val, max_val); - - (*this).operator=(tmp); - } - - - -template -inline -void -spdiagview::fill(const eT val) - { - arma_debug_sigprint(); - - if( (row_offset == 0) && (col_offset == 0) && (m.sync_state != 1) ) - { - if(val == eT(0)) - { - SpMat tmp(arma_reserve_indicator(), m.n_rows, m.n_cols, m.n_nonzero); // worst case scenario - - typename SpMat::const_iterator it = m.begin(); - typename SpMat::const_iterator it_end = m.end(); - - uword count = 0; - - for(; it != it_end; ++it) - { - const uword row = it.row(); - const uword col = it.col(); - - if(row != col) - { - access::rw(tmp.values[count]) = (*it); - access::rw(tmp.row_indices[count]) = row; - access::rw(tmp.col_ptrs[col + 1])++; - ++count; - } - } - - for(uword i=0; i < tmp.n_cols; ++i) - { - access::rw(tmp.col_ptrs[i + 1]) += tmp.col_ptrs[i]; - } - - // quick resize without reallocating memory and copying data - access::rw( tmp.n_nonzero) = count; - access::rw( tmp.values[count]) = eT(0); - access::rw(tmp.row_indices[count]) = uword(0); - - access::rw(m).steal_mem(tmp); - } - else // val != eT(0) - { - SpMat tmp1; - - tmp1.eye(m.n_rows, m.n_cols); - - if(val != eT(1)) { tmp1 *= val; } - - SpMat tmp2; - - spglue_merge::diagview_merge(tmp2, m, tmp1); - - access::rw(m).steal_mem(tmp2); - } - } - else - { - SpMat& x = const_cast< SpMat& >(m); - - const uword local_n_elem = n_elem; - - for(uword i=0; i < local_n_elem; ++i) - { - x.at(i+row_offset, i+col_offset) = val; - } - } - } - - - -template -inline -void -spdiagview::zeros() - { - arma_debug_sigprint(); - - (*this).fill(eT(0)); - } - - - -template -inline -void -spdiagview::ones() - { - arma_debug_sigprint(); - - (*this).fill(eT(1)); - } - - - -template -inline -void -spdiagview::randu() - { - arma_debug_sigprint(); - - SpMat& x = const_cast< SpMat& >(m); - - const uword local_n_elem = n_elem; - - Col tmp(local_n_elem, arma_nozeros_indicator()); - - tmp.randu(); - - for(uword i=0; i < local_n_elem; ++i) - { - x.at(i+row_offset, i+col_offset) = tmp[i]; - } - } - - - -template -inline -void -spdiagview::randn() - { - arma_debug_sigprint(); - - SpMat& x = const_cast< SpMat& >(m); - - const uword local_n_elem = n_elem; - - Col tmp(local_n_elem, arma_nozeros_indicator()); - - tmp.randn(); - - for(uword i=0; i < local_n_elem; ++i) - { - x.at(i+row_offset, i+col_offset) = tmp[i]; - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_join_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_join_bones.hpp deleted file mode 100644 index 93829b704..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_join_bones.hpp +++ /dev/null @@ -1,78 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spglue_join -//! @{ - - - -class spglue_join_cols - { - public: - - template - struct traits - { - static constexpr bool is_row = false; - static constexpr bool is_col = (T1::is_col && T2::is_col); - static constexpr bool is_xvec = false; - }; - - template - inline static void apply(SpMat& out, const SpGlue& X); - - template - inline static void apply_noalias(SpMat& out, const SpMat& A, const SpMat& B); - - template - inline static void apply(SpMat& out, const SpBase& A, const SpBase& B, const SpBase& C); - - template - inline static void apply(SpMat& out, const SpBase& A, const SpBase& B, const SpBase& C, const SpBase& D); - }; - - - -class spglue_join_rows - { - public: - - template - struct traits - { - static constexpr bool is_row = (T1::is_row && T2::is_row); - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - }; - - template - inline static void apply(SpMat& out, const SpGlue& X); - - template - inline static void apply_noalias(SpMat& out, const SpMat& A, const SpMat& B); - - template - inline static void apply(SpMat& out, const SpBase& A, const SpBase& B, const SpBase& C); - - template - inline static void apply(SpMat& out, const SpBase& A, const SpBase& B, const SpBase& C, const SpBase& D); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_join_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_join_meat.hpp deleted file mode 100644 index 74709434b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_join_meat.hpp +++ /dev/null @@ -1,350 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spglue_join -//! @{ - - - -template -inline -void -spglue_join_cols::apply(SpMat& out, const SpGlue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat UA(X.A); - const unwrap_spmat UB(X.B); - - if(UA.is_alias(out) || UB.is_alias(out)) - { - SpMat tmp; - - spglue_join_cols::apply_noalias(tmp, UA.M, UB.M); - - out.steal_mem(tmp); - } - else - { - spglue_join_cols::apply_noalias(out, UA.M, UB.M); - } - } - - - -template -inline -void -spglue_join_cols::apply_noalias(SpMat& out, const SpMat& A, const SpMat& B) - { - arma_debug_sigprint(); - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - arma_conform_check - ( - ( (A_n_cols != B_n_cols) && ( (A_n_rows > 0) || (A_n_cols > 0) ) && ( (B_n_rows > 0) || (B_n_cols > 0) ) ), - "join_cols() / join_vert(): number of columns must be the same" - ); - - out.set_size( A_n_rows + B_n_rows, (std::max)(A_n_cols, B_n_cols) ); - - if( out.n_elem > 0 ) - { - if(A.is_empty() == false) - { - out.submat(0, 0, A_n_rows-1, out.n_cols-1) = A; - } - - if(B.is_empty() == false) - { - out.submat(A_n_rows, 0, out.n_rows-1, out.n_cols-1) = B; - } - } - } - - - -template -inline -void -spglue_join_cols::apply(SpMat& out, const SpBase& A_expr, const SpBase& B_expr, const SpBase& C_expr) - { - arma_debug_sigprint(); - - const unwrap_spmat UA(A_expr.get_ref()); - const unwrap_spmat UB(B_expr.get_ref()); - const unwrap_spmat UC(C_expr.get_ref()); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - const SpMat& C = UC.M; - - const uword out_n_rows = A.n_rows + B.n_rows + C.n_rows; - const uword out_n_cols = (std::max)((std::max)(A.n_cols, B.n_cols), C.n_cols); - - arma_conform_check( ((A.n_cols != out_n_cols) && ((A.n_rows > 0) || (A.n_cols > 0))), "join_cols() / join_vert(): number of columns must be the same" ); - arma_conform_check( ((B.n_cols != out_n_cols) && ((B.n_rows > 0) || (B.n_cols > 0))), "join_cols() / join_vert(): number of columns must be the same" ); - arma_conform_check( ((C.n_cols != out_n_cols) && ((C.n_rows > 0) || (C.n_cols > 0))), "join_cols() / join_vert(): number of columns must be the same" ); - - out.set_size(out_n_rows, out_n_cols); - - if(out.n_elem == 0) { return; } - - uword row_start = 0; - uword row_end_p1 = 0; - - if(A.n_elem > 0) { row_end_p1 += A.n_rows; out.rows(row_start, row_end_p1 - 1) = A; } - - row_start = row_end_p1; - - if(B.n_elem > 0) { row_end_p1 += B.n_rows; out.rows(row_start, row_end_p1 - 1) = B; } - - row_start = row_end_p1; - - if(C.n_elem > 0) { row_end_p1 += C.n_rows; out.rows(row_start, row_end_p1 - 1) = C; } - } - - - -template -inline -void -spglue_join_cols::apply(SpMat& out, const SpBase& A_expr, const SpBase& B_expr, const SpBase& C_expr, const SpBase& D_expr) - { - arma_debug_sigprint(); - - const unwrap_spmat UA(A_expr.get_ref()); - const unwrap_spmat UB(B_expr.get_ref()); - const unwrap_spmat UC(C_expr.get_ref()); - const unwrap_spmat UD(D_expr.get_ref()); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - const SpMat& C = UC.M; - const SpMat& D = UD.M; - - const uword out_n_rows = A.n_rows + B.n_rows + C.n_rows + D.n_rows; - const uword out_n_cols = (std::max)(((std::max)((std::max)(A.n_cols, B.n_cols), C.n_cols)), D.n_cols); - - arma_conform_check( ((A.n_cols != out_n_cols) && ((A.n_rows > 0) || (A.n_cols > 0))), "join_cols() / join_vert(): number of columns must be the same" ); - arma_conform_check( ((B.n_cols != out_n_cols) && ((B.n_rows > 0) || (B.n_cols > 0))), "join_cols() / join_vert(): number of columns must be the same" ); - arma_conform_check( ((C.n_cols != out_n_cols) && ((C.n_rows > 0) || (C.n_cols > 0))), "join_cols() / join_vert(): number of columns must be the same" ); - arma_conform_check( ((D.n_cols != out_n_cols) && ((D.n_rows > 0) || (D.n_cols > 0))), "join_cols() / join_vert(): number of columns must be the same" ); - - out.set_size(out_n_rows, out_n_cols); - - if(out.n_elem == 0) { return; } - - uword row_start = 0; - uword row_end_p1 = 0; - - if(A.n_elem > 0) { row_end_p1 += A.n_rows; out.rows(row_start, row_end_p1 - 1) = A; } - - row_start = row_end_p1; - - if(B.n_elem > 0) { row_end_p1 += B.n_rows; out.rows(row_start, row_end_p1 - 1) = B; } - - row_start = row_end_p1; - - if(C.n_elem > 0) { row_end_p1 += C.n_rows; out.rows(row_start, row_end_p1 - 1) = C; } - - row_start = row_end_p1; - - if(D.n_elem > 0) { row_end_p1 += D.n_rows; out.rows(row_start, row_end_p1 - 1) = D; } - } - - - -template -inline -void -spglue_join_rows::apply(SpMat& out, const SpGlue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat UA(X.A); - const unwrap_spmat UB(X.B); - - if(UA.is_alias(out) || UB.is_alias(out)) - { - SpMat tmp; - - spglue_join_rows::apply_noalias(tmp, UA.M, UB.M); - - out.steal_mem(tmp); - } - else - { - spglue_join_rows::apply_noalias(out, UA.M, UB.M); - } - } - - - -template -inline -void -spglue_join_rows::apply_noalias(SpMat& out, const SpMat& A, const SpMat& B) - { - arma_debug_sigprint(); - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - const uword A_n_nz = A.n_nonzero; - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - const uword B_n_nz = B.n_nonzero; - - arma_conform_check - ( - ( (A_n_rows != B.n_rows) && ( (A_n_rows > 0) || (A_n_cols > 0) ) && ( (B_n_rows > 0) || (B_n_cols > 0) ) ), - "join_rows() / join_horiz(): number of rows must be the same" - ); - - const uword C_n_rows = (std::max)(A_n_rows, B_n_rows); - const uword C_n_cols = A_n_cols + B_n_cols; - const uword C_n_nz = A_n_nz + B_n_nz; - - if( ((C_n_rows * C_n_cols) == 0) || (C_n_nz == 0) ) - { - out.zeros(C_n_rows, C_n_cols); - return; - } - - out.reserve(C_n_rows, C_n_cols, C_n_nz); - - arrayops::copy( access::rwp(out.values), A.values, A_n_nz ); - arrayops::copy( access::rwp(out.values) + A_n_nz, B.values, B_n_nz+1 ); - - arrayops::copy( access::rwp(out.row_indices), A.row_indices, A_n_nz ); - arrayops::copy( access::rwp(out.row_indices) + A_n_nz, B.row_indices, B_n_nz+1 ); - - arrayops::copy( access::rwp(out.col_ptrs), A.col_ptrs, A_n_cols ); - arrayops::copy( access::rwp(out.col_ptrs) + A_n_cols, B.col_ptrs, B_n_cols+2 ); - - arrayops::inplace_plus( access::rwp(out.col_ptrs) + A_n_cols, A_n_nz, B_n_cols+1 ); - - - // // OLD METHOD - // - // umat locs(2, C_n_nz, arma_nozeros_indicator()); - // Col vals( C_n_nz, arma_nozeros_indicator()); - // - // uword* locs_mem = locs.memptr(); - // eT* vals_mem = vals.memptr(); - // - // typename SpMat::const_iterator A_it = A.begin(); - // - // for(uword i=0; i < A_n_nz; ++i) - // { - // const uword row = A_it.row(); - // const uword col = A_it.col(); - // - // (*locs_mem) = row; locs_mem++; - // (*locs_mem) = col; locs_mem++; - // - // (*vals_mem) = (*A_it); vals_mem++; - // - // ++A_it; - // } - // - // typename SpMat::const_iterator B_it = B.begin(); - // - // for(uword i=0; i < B_n_nz; ++i) - // { - // const uword row = B_it.row(); - // const uword col = A_n_cols + B_it.col(); - // - // (*locs_mem) = row; locs_mem++; - // (*locs_mem) = col; locs_mem++; - // - // (*vals_mem) = (*B_it); vals_mem++; - // - // ++B_it; - // } - // - // // TODO: the first element of B within C will always have a larger index than the last element of A in C; - // // TODO: so, is sorting really necessary here? - // SpMat tmp(locs, vals, C_n_rows, C_n_cols, true, false); - // - // out.steal_mem(tmp); - } - - - -template -inline -void -spglue_join_rows::apply(SpMat& out, const SpBase& A_expr, const SpBase& B_expr, const SpBase& C_expr) - { - arma_debug_sigprint(); - - const unwrap_spmat UA(A_expr.get_ref()); - const unwrap_spmat UB(B_expr.get_ref()); - const unwrap_spmat UC(C_expr.get_ref()); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - const SpMat& C = UC.M; - - SpMat tmp; - - spglue_join_rows::apply_noalias(tmp, A, B); - spglue_join_rows::apply_noalias(out, tmp, C); - } - - - -template -inline -void -spglue_join_rows::apply(SpMat& out, const SpBase& A_expr, const SpBase& B_expr, const SpBase& C_expr, const SpBase& D_expr) - { - arma_debug_sigprint(); - - const unwrap_spmat UA(A_expr.get_ref()); - const unwrap_spmat UB(B_expr.get_ref()); - const unwrap_spmat UC(C_expr.get_ref()); - const unwrap_spmat UD(D_expr.get_ref()); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - const SpMat& C = UC.M; - const SpMat& D = UD.M; - - SpMat AB; - SpMat ABC; - - spglue_join_rows::apply_noalias(AB, A, B); - spglue_join_rows::apply_noalias(ABC, AB, C); - spglue_join_rows::apply_noalias(out, ABC, D); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_kron_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_kron_bones.hpp deleted file mode 100644 index e0d33b201..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_kron_bones.hpp +++ /dev/null @@ -1,45 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spglue_kron -//! @{ - - - -class spglue_kron - { - public: - - template - struct traits - { - static constexpr bool is_row = (T1::is_row && T2::is_row); - static constexpr bool is_col = (T1::is_col && T2::is_col); - static constexpr bool is_xvec = false; - }; - - template - inline static void apply(SpMat& out, const SpGlue& X); - - template - inline static void apply_noalias(SpMat& out, const SpMat& A, const SpMat& B); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_kron_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_kron_meat.hpp deleted file mode 100644 index 03d697c57..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_kron_meat.hpp +++ /dev/null @@ -1,159 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spglue_kron -//! @{ - - - -template -inline -void -spglue_kron::apply(SpMat& out, const SpGlue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat UA(X.A); - const unwrap_spmat UB(X.B); - - if(UA.is_alias(out) || UB.is_alias(out)) - { - SpMat tmp; - - spglue_kron::apply_noalias(tmp, UA.M, UB.M); - - out.steal_mem(tmp); - } - else - { - spglue_kron::apply_noalias(out, UA.M, UB.M); - } - } - - - -template -inline -void -spglue_kron::apply_noalias(SpMat& out, const SpMat& A, const SpMat& B) - { - arma_debug_sigprint(); - - const uword A_n_rows = A.n_rows; - const uword A_n_cols = A.n_cols; - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - const uword out_n_nonzero = A.n_nonzero * B.n_nonzero; - - out.reserve(A_n_rows * B_n_rows, A_n_cols * B_n_cols, out_n_nonzero); - - if(out_n_nonzero == 0) { return; } - - access::rw(out.col_ptrs[0]) = 0; - - uword count = 0; - - for(uword A_col=0; A_col < A_n_cols; ++A_col) - for(uword B_col=0; B_col < B_n_cols; ++B_col) - { - for(uword A_i = A.col_ptrs[A_col]; A_i < A.col_ptrs[A_col+1]; ++A_i) - { - const uword out_row = A.row_indices[A_i] * B_n_rows; - - const eT A_val = A.values[A_i]; - - for(uword B_i = B.col_ptrs[B_col]; B_i < B.col_ptrs[B_col+1]; ++B_i) - { - access::rw(out.values[count]) = A_val * B.values[B_i]; - access::rw(out.row_indices[count]) = out_row + B.row_indices[B_i]; - - count++; - } - } - - access::rw(out.col_ptrs[A_col * B_n_cols + B_col + 1]) = count; - } - } - - - -// template -// inline -// void -// spglue_kron::apply(SpMat& out, const SpGlue& X) -// { -// arma_debug_sigprint(); -// -// typedef typename T1::elem_type eT; -// -// const unwrap_spmat UA(X.A); -// const unwrap_spmat UB(X.B); -// -// const SpMat& A = UA.M; -// const SpMat& B = UB.M; -// -// umat locs(2, A.n_nonzero * B.n_nonzero, arma_nozeros_indicator()); -// Col vals( A.n_nonzero * B.n_nonzero, arma_nozeros_indicator()); -// -// uword* locs_mem = locs.memptr(); -// eT* vals_mem = vals.memptr(); -// -// typename SpMat::const_iterator A_it = A.begin(); -// typename SpMat::const_iterator A_it_end = A.end(); -// -// typename SpMat::const_iterator B_it_start = B.begin(); -// typename SpMat::const_iterator B_it_end = B.end(); -// -// const uword B_n_rows = B.n_rows; -// const uword B_n_cols = B.n_cols; -// -// uword i = 0; -// -// while(A_it != A_it_end) -// { -// typename SpMat::const_iterator B_it = B_it_start; -// -// const uword loc_row = A_it.row() * B_n_rows; -// const uword loc_col = A_it.col() * B_n_cols; -// -// const eT A_val = (*A_it); -// -// while(B_it != B_it_end) -// { -// (*locs_mem) = loc_row + B_it.row(); locs_mem++; -// (*locs_mem) = loc_col + B_it.col(); locs_mem++; -// -// vals_mem[i] = A_val * (*B_it); -// -// ++i; -// ++B_it; -// } -// -// ++A_it; -// } -// -// out = SpMat(locs, vals, A.n_rows*B.n_rows, A.n_cols*B.n_cols); -// } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_max_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_max_bones.hpp deleted file mode 100644 index 156eeb523..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_max_bones.hpp +++ /dev/null @@ -1,56 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spglue_max -//! @{ - - - -class spglue_max - : public traits_glue_or - { - public: - - template - inline static void apply(SpMat& out, const SpGlue& X); - - template - inline static void apply_noalias(SpMat& out, const SpProxy& pa, const SpProxy& pb); - - template - inline static void apply_noalias(SpMat& out, const SpMat& A, const SpMat& B); - - template - inline static void dense_sparse_max(Mat& out, const Base& X, const SpBase& Y); - - template - inline - static - typename enable_if2::no, eT>::result - elem_max(const eT& a, const eT& b); - - template - inline - static - typename enable_if2::yes, eT>::result - elem_max(const eT& a, const eT& b); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_max_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_max_meat.hpp deleted file mode 100644 index d6da17e17..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_max_meat.hpp +++ /dev/null @@ -1,222 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spglue_max -//! @{ - - - -template -inline -void -spglue_max::apply(SpMat& out, const SpGlue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const SpProxy pa(X.A); - const SpProxy pb(X.B); - - const bool is_alias = pa.is_alias(out) || pb.is_alias(out); - - if(is_alias == false) - { - spglue_max::apply_noalias(out, pa, pb); - } - else - { - SpMat tmp; - - spglue_max::apply_noalias(tmp, pa, pb); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -spglue_max::apply_noalias(SpMat& out, const SpProxy& pa, const SpProxy& pb) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(pa.get_n_rows(), pa.get_n_cols(), pb.get_n_rows(), pb.get_n_cols(), "element-wise max()"); - - const uword max_n_nonzero = pa.get_n_nonzero() + pb.get_n_nonzero(); - - // Resize memory to upper bound - out.reserve(pa.get_n_rows(), pa.get_n_cols(), max_n_nonzero); - - // Now iterate across both matrices. - typename SpProxy::const_iterator_type x_it = pa.begin(); - typename SpProxy::const_iterator_type x_end = pa.end(); - - typename SpProxy::const_iterator_type y_it = pb.begin(); - typename SpProxy::const_iterator_type y_end = pb.end(); - - uword count = 0; - - while( (x_it != x_end) || (y_it != y_end) ) - { - eT out_val; - - const uword x_it_col = x_it.col(); - const uword x_it_row = x_it.row(); - - const uword y_it_col = y_it.col(); - const uword y_it_row = y_it.row(); - - bool use_y_loc = false; - - if(x_it == y_it) - { - out_val = elem_max(eT(*x_it), eT(*y_it)); - - ++x_it; - ++y_it; - } - else - { - if((x_it_col < y_it_col) || ((x_it_col == y_it_col) && (x_it_row < y_it_row))) // if y is closer to the end - { - out_val = elem_max(eT(*x_it), eT(0)); - - ++x_it; - } - else - { - out_val = elem_max(eT(*y_it), eT(0)); - - ++y_it; - - use_y_loc = true; - } - } - - if(out_val != eT(0)) - { - access::rw(out.values[count]) = out_val; - - const uword out_row = (use_y_loc == false) ? x_it_row : y_it_row; - const uword out_col = (use_y_loc == false) ? x_it_col : y_it_col; - - access::rw(out.row_indices[count]) = out_row; - access::rw(out.col_ptrs[out_col + 1])++; - ++count; - } - - arma_check( (count > max_n_nonzero), "internal error: spglue_max::apply_noalias(): count > max_n_nonzero" ); - } - - const uword out_n_cols = out.n_cols; - - uword* col_ptrs = access::rwp(out.col_ptrs); - - // Fix column pointers to be cumulative. - for(uword c = 1; c <= out_n_cols; ++c) - { - col_ptrs[c] += col_ptrs[c - 1]; - } - - if(count < max_n_nonzero) - { - if(count <= (max_n_nonzero/2)) - { - out.mem_resize(count); - } - else - { - // quick resize without reallocating memory and copying data - access::rw( out.n_nonzero) = count; - access::rw( out.values[count]) = eT(0); - access::rw(out.row_indices[count]) = uword(0); - } - } - } - - - -template -inline -void -spglue_max::apply_noalias(SpMat& out, const SpMat& A, const SpMat& B) - { - arma_debug_sigprint(); - - const SpProxy< SpMat > pa(A); - const SpProxy< SpMat > pb(B); - - spglue_max::apply_noalias(out, pa, pb); - } - - - -template -inline -void -spglue_max::dense_sparse_max(Mat& out, const Base& X, const SpBase& Y) - { - arma_debug_sigprint(); - - // NOTE: this function assumes there is no aliasing between matrix 'out' and X - - const Proxy pa(X.get_ref()); - const SpProxy pb(Y.get_ref()); - - const uword n_rows = pa.get_n_rows(); - const uword n_cols = pa.get_n_cols(); - - arma_conform_assert_same_size( n_rows, n_cols, pb.get_n_rows(), pb.get_n_cols(), "element-wise max()" ); - - out.set_size(n_rows, n_cols); - - for(uword c=0; c < n_cols; ++c) - for(uword r=0; r < n_rows; ++r) - { - out.at(r,c) = elem_max(pa.at(r,c), pb.at(r,c)); - } - } - - - -//! max of non-complex elements -template -inline -typename enable_if2::no, eT>::result -spglue_max::elem_max(const eT& a, const eT& b) - { - return (std::max)(a, b); - } - - - -//! max of complex elements -template -inline -typename enable_if2::yes, eT>::result -spglue_max::elem_max(const eT& a, const eT& b) - { - return (std::abs(a) > std::abs(b)) ? a : b; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_merge_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_merge_bones.hpp deleted file mode 100644 index 2ef6c59c8..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_merge_bones.hpp +++ /dev/null @@ -1,43 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spglue_merge -//! @{ - - - -class spglue_merge - { - public: - - template - inline static void subview_merge(SpSubview& sv, const SpMat& B); - - template - inline static void subview_merge(SpSubview& sv, const Mat& B); - - template - inline static void symmat_merge(SpMat& out, const SpMat& A, const SpMat& B); - - template - inline static void diagview_merge(SpMat& out, const SpMat& A, const SpMat& B); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_merge_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_merge_meat.hpp deleted file mode 100644 index 8c75f03b3..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_merge_meat.hpp +++ /dev/null @@ -1,554 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spglue_merge -//! @{ - - - -template -inline -void -spglue_merge::subview_merge(SpSubview& sv, const SpMat& B) - { - arma_debug_sigprint(); - - if(sv.n_elem == 0) { return; } - - if(B.n_nonzero == 0) { sv.zeros(); return; } - - SpMat& A = access::rw(sv.m); - - const uword merge_n_nonzero = A.n_nonzero - sv.n_nonzero + B.n_nonzero; - - const uword sv_row_start = sv.aux_row1; - const uword sv_col_start = sv.aux_col1; - - const uword sv_row_end = sv.aux_row1 + sv.n_rows - 1; - const uword sv_col_end = sv.aux_col1 + sv.n_cols - 1; - - - if(A.n_nonzero == sv.n_nonzero) - { - // A is either all zeros or has all of its elements in the subview - // so the merge is equivalent to overwrite of A - - SpMat tmp(arma_reserve_indicator(), A.n_rows, A.n_cols, B.n_nonzero); - - typename SpMat::const_iterator B_it = B.begin(); - typename SpMat::const_iterator B_it_end = B.end(); - - uword tmp_count = 0; - - for(; B_it != B_it_end; ++B_it) - { - access::rw(tmp.values[tmp_count]) = (*B_it); - access::rw(tmp.row_indices[tmp_count]) = B_it.row() + sv_row_start; - access::rw(tmp.col_ptrs[B_it.col() + sv_col_start + 1])++; - ++tmp_count; - } - - for(uword i=0; i < tmp.n_cols; ++i) - { - access::rw(tmp.col_ptrs[i + 1]) += tmp.col_ptrs[i]; - } - - A.steal_mem(tmp); - - access::rw(sv.n_nonzero) = B.n_nonzero; - - return; - } - - - if(sv.n_nonzero > (A.n_nonzero/2)) - { - // A has most of its elements in the subview, - // so regenerate A with zeros in the subview region - // in order to increase merging efficiency - - sv.zeros(); - } - - - SpMat out(arma_reserve_indicator(), A.n_rows, A.n_cols, merge_n_nonzero); - - typename SpMat::const_iterator x_it = A.begin(); - typename SpMat::const_iterator x_end = A.end(); - - typename SpMat::const_iterator y_it = B.begin(); - typename SpMat::const_iterator y_end = B.end(); - - uword count = 0; - - bool x_it_valid = (x_it != x_end); - bool y_it_valid = (y_it != y_end); - - while(x_it_valid || y_it_valid) - { - eT out_val = eT(0); - - const uword x_it_row = (x_it_valid) ? uword(x_it.row()) : uword(0); - const uword x_it_col = (x_it_valid) ? uword(x_it.col()) : uword(0); - - const uword y_it_row = (y_it_valid) ? uword(sv_row_start + y_it.row()) : uword(0); - const uword y_it_col = (y_it_valid) ? uword(sv_col_start + y_it.col()) : uword(0); - - bool use_y_loc = false; - - if(x_it_valid && y_it_valid) - { - if( (x_it_row == y_it_row) && (x_it_col == y_it_col) ) - { - out_val = (*y_it); - - ++x_it; - ++y_it; - } - else - { - if((x_it_col < y_it_col) || ((x_it_col == y_it_col) && (x_it_row < y_it_row))) // if y is closer to the end - { - const bool x_inside_box = ((x_it_row >= sv_row_start) && (x_it_row <= sv_row_end)) && ((x_it_col >= sv_col_start) && (x_it_col <= sv_col_end)); - - out_val = (x_inside_box) ? eT(0) : (*x_it); - - ++x_it; - } - else - { - out_val = (*y_it); - - ++y_it; - - use_y_loc = true; - } - } - } - else - if(x_it_valid) - { - const bool x_inside_box = ((x_it_row >= sv_row_start) && (x_it_row <= sv_row_end)) && ((x_it_col >= sv_col_start) && (x_it_col <= sv_col_end)); - - out_val = (x_inside_box) ? eT(0) : (*x_it); - - ++x_it; - } - else - if(y_it_valid) - { - out_val = (*y_it); - - ++y_it; - - use_y_loc = true; - } - - if(out_val != eT(0)) - { - access::rw(out.values[count]) = out_val; - - const uword out_row = (use_y_loc == false) ? x_it_row : y_it_row; - const uword out_col = (use_y_loc == false) ? x_it_col : y_it_col; - - access::rw(out.row_indices[count]) = out_row; - access::rw(out.col_ptrs[out_col + 1])++; - ++count; - } - - x_it_valid = (x_it != x_end); - y_it_valid = (y_it != y_end); - } - - arma_check( (count != merge_n_nonzero), "internal error: spglue_merge::subview_merge(): count != merge_n_nonzero" ); - - const uword out_n_cols = out.n_cols; - - uword* col_ptrs = access::rwp(out.col_ptrs); - - for(uword c = 1; c <= out_n_cols; ++c) - { - col_ptrs[c] += col_ptrs[c - 1]; - } - - A.steal_mem(out); - - access::rw(sv.n_nonzero) = B.n_nonzero; - } - - - -template -inline -void -spglue_merge::subview_merge(SpSubview& sv, const Mat& B) - { - arma_debug_sigprint(); - - if(sv.n_elem == 0) { return; } - - const eT* B_memptr = B.memptr(); - const uword B_n_elem = B.n_elem; - - uword B_n_nonzero = 0; - - for(uword i=0; i < B_n_elem; ++i) - { - B_n_nonzero += (B_memptr[i] != eT(0)) ? uword(1) : uword(0); - } - - if(B_n_nonzero == 0) { sv.zeros(); return; } - - SpMat& A = access::rw(sv.m); - - const uword merge_n_nonzero = A.n_nonzero - sv.n_nonzero + B_n_nonzero; - - const uword sv_row_start = sv.aux_row1; - const uword sv_col_start = sv.aux_col1; - - const uword sv_row_end = sv.aux_row1 + sv.n_rows - 1; - const uword sv_col_end = sv.aux_col1 + sv.n_cols - 1; - - - if(A.n_nonzero == sv.n_nonzero) - { - // A is either all zeros or has all of its elements in the subview - // so the merge is equivalent to overwrite of A - - SpMat tmp(arma_reserve_indicator(), A.n_rows, A.n_cols, B_n_nonzero); - - typename Mat::const_row_col_iterator B_it = B.begin_row_col(); - typename Mat::const_row_col_iterator B_it_end = B.end_row_col(); - - uword tmp_count = 0; - - for(; B_it != B_it_end; ++B_it) - { - const eT val = (*B_it); - - if(val != eT(0)) - { - access::rw(tmp.values[tmp_count]) = val; - access::rw(tmp.row_indices[tmp_count]) = B_it.row() + sv_row_start; - access::rw(tmp.col_ptrs[B_it.col() + sv_col_start + 1])++; - ++tmp_count; - } - } - - for(uword i=0; i < tmp.n_cols; ++i) - { - access::rw(tmp.col_ptrs[i + 1]) += tmp.col_ptrs[i]; - } - - A.steal_mem(tmp); - - access::rw(sv.n_nonzero) = B_n_nonzero; - - return; - } - - - if(sv.n_nonzero > (A.n_nonzero/2)) - { - // A has most of its elements in the subview, - // so regenerate A with zeros in the subview region - // in order to increase merging efficiency - - sv.zeros(); - } - - - SpMat out(arma_reserve_indicator(), A.n_rows, A.n_cols, merge_n_nonzero); - - typename SpMat::const_iterator x_it = A.begin(); - typename SpMat::const_iterator x_end = A.end(); - - typename Mat::const_row_col_iterator y_it = B.begin_row_col(); - typename Mat::const_row_col_iterator y_end = B.end_row_col(); - - uword count = 0; - - bool x_it_valid = (x_it != x_end); - bool y_it_valid = (y_it != y_end); - - while(x_it_valid || y_it_valid) - { - eT out_val = eT(0); - - const uword x_it_row = (x_it_valid) ? uword(x_it.row()) : uword(0); - const uword x_it_col = (x_it_valid) ? uword(x_it.col()) : uword(0); - - const uword y_it_row = (y_it_valid) ? uword(sv_row_start + y_it.row()) : uword(0); - const uword y_it_col = (y_it_valid) ? uword(sv_col_start + y_it.col()) : uword(0); - - bool use_y_loc = false; - - if(x_it_valid && y_it_valid) - { - if( (x_it_row == y_it_row) && (x_it_col == y_it_col) ) - { - out_val = (*y_it); - - ++x_it; - ++y_it; - } - else - { - if((x_it_col < y_it_col) || ((x_it_col == y_it_col) && (x_it_row < y_it_row))) // if y is closer to the end - { - const bool x_inside_box = ((x_it_row >= sv_row_start) && (x_it_row <= sv_row_end)) && ((x_it_col >= sv_col_start) && (x_it_col <= sv_col_end)); - - out_val = (x_inside_box) ? eT(0) : (*x_it); - - ++x_it; - } - else - { - out_val = (*y_it); - - ++y_it; - - use_y_loc = true; - } - } - } - else - if(x_it_valid) - { - const bool x_inside_box = ((x_it_row >= sv_row_start) && (x_it_row <= sv_row_end)) && ((x_it_col >= sv_col_start) && (x_it_col <= sv_col_end)); - - out_val = (x_inside_box) ? eT(0) : (*x_it); - - ++x_it; - } - else - if(y_it_valid) - { - out_val = (*y_it); - - ++y_it; - - use_y_loc = true; - } - - if(out_val != eT(0)) - { - access::rw(out.values[count]) = out_val; - - const uword out_row = (use_y_loc == false) ? x_it_row : y_it_row; - const uword out_col = (use_y_loc == false) ? x_it_col : y_it_col; - - access::rw(out.row_indices[count]) = out_row; - access::rw(out.col_ptrs[out_col + 1])++; - ++count; - } - - x_it_valid = (x_it != x_end); - y_it_valid = (y_it != y_end); - } - - arma_check( (count != merge_n_nonzero), "internal error: spglue_merge::subview_merge(): count != merge_n_nonzero" ); - - const uword out_n_cols = out.n_cols; - - uword* col_ptrs = access::rwp(out.col_ptrs); - - for(uword c = 1; c <= out_n_cols; ++c) - { - col_ptrs[c] += col_ptrs[c - 1]; - } - - A.steal_mem(out); - - access::rw(sv.n_nonzero) = B_n_nonzero; - } - - - -template -inline -void -spglue_merge::symmat_merge(SpMat& out, const SpMat& A, const SpMat& B) - { - arma_debug_sigprint(); - - out.reserve(A.n_rows, A.n_cols, 2*A.n_nonzero); // worst case scenario - - typename SpMat::const_iterator x_it = A.begin(); - typename SpMat::const_iterator x_end = A.end(); - - typename SpMat::const_iterator y_it = B.begin(); - typename SpMat::const_iterator y_end = B.end(); - - uword count = 0; - - while( (x_it != x_end) || (y_it != y_end) ) - { - eT out_val; - - const uword x_it_col = x_it.col(); - const uword x_it_row = x_it.row(); - - const uword y_it_col = y_it.col(); - const uword y_it_row = y_it.row(); - - bool use_y_loc = false; - - if(x_it == y_it) - { - // this can only happen on the diagonal - - out_val = (*x_it); - - ++x_it; - ++y_it; - } - else - { - if((x_it_col < y_it_col) || ((x_it_col == y_it_col) && (x_it_row < y_it_row))) // if y is closer to the end - { - out_val = (*x_it); - - ++x_it; - } - else - { - out_val = (*y_it); - - ++y_it; - - use_y_loc = true; - } - } - - access::rw(out.values[count]) = out_val; - - const uword out_row = (use_y_loc == false) ? x_it_row : y_it_row; - const uword out_col = (use_y_loc == false) ? x_it_col : y_it_col; - - access::rw(out.row_indices[count]) = out_row; - access::rw(out.col_ptrs[out_col + 1])++; - ++count; - } - - const uword out_n_cols = out.n_cols; - - uword* col_ptrs = access::rwp(out.col_ptrs); - - // Fix column pointers to be cumulative. - for(uword c = 1; c <= out_n_cols; ++c) - { - col_ptrs[c] += col_ptrs[c - 1]; - } - - // quick resize without reallocating memory and copying data - access::rw( out.n_nonzero) = count; - access::rw( out.values[count]) = eT(0); - access::rw(out.row_indices[count]) = uword(0); - } - - - -template -inline -void -spglue_merge::diagview_merge(SpMat& out, const SpMat& A, const SpMat& B) - { - arma_debug_sigprint(); - - // NOTE: assuming that B has non-zero elements only on the main diagonal - - out.reserve(A.n_rows, A.n_cols, A.n_nonzero + B.n_nonzero); // worst case scenario - - typename SpMat::const_iterator x_it = A.begin(); - typename SpMat::const_iterator x_end = A.end(); - - typename SpMat::const_iterator y_it = B.begin(); - typename SpMat::const_iterator y_end = B.end(); - - uword count = 0; - - while( (x_it != x_end) || (y_it != y_end) ) - { - eT out_val = eT(0); - - const uword x_it_col = x_it.col(); - const uword x_it_row = x_it.row(); - - const uword y_it_col = y_it.col(); - const uword y_it_row = y_it.row(); - - bool use_y_loc = false; - - if(x_it == y_it) - { - // this can only happen on the diagonal - - out_val = (*y_it); - - ++x_it; - ++y_it; - } - else - { - if((x_it_col < y_it_col) || ((x_it_col == y_it_col) && (x_it_row < y_it_row))) // if y is closer to the end - { - if(x_it_col != x_it_row) { out_val = (*x_it); } // don't take values from the main diagonal of A - - ++x_it; - } - else - { - if(y_it_col == y_it_row) { out_val = (*y_it); use_y_loc = true; } // take values only from the main diagonal of B - - ++y_it; - } - } - - if(out_val != eT(0)) - { - access::rw(out.values[count]) = out_val; - - const uword out_row = (use_y_loc == false) ? x_it_row : y_it_row; - const uword out_col = (use_y_loc == false) ? x_it_col : y_it_col; - - access::rw(out.row_indices[count]) = out_row; - access::rw(out.col_ptrs[out_col + 1])++; - ++count; - } - } - - const uword out_n_cols = out.n_cols; - - uword* col_ptrs = access::rwp(out.col_ptrs); - - // Fix column pointers to be cumulative. - for(uword c = 1; c <= out_n_cols; ++c) - { - col_ptrs[c] += col_ptrs[c - 1]; - } - - // quick resize without reallocating memory and copying data - access::rw( out.n_nonzero) = count; - access::rw( out.values[count]) = eT(0); - access::rw(out.row_indices[count]) = uword(0); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_min_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_min_bones.hpp deleted file mode 100644 index 93e8c593d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_min_bones.hpp +++ /dev/null @@ -1,56 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spglue_min -//! @{ - - - -class spglue_min - : public traits_glue_or - { - public: - - template - inline static void apply(SpMat& out, const SpGlue& X); - - template - inline static void apply_noalias(SpMat& out, const SpProxy& pa, const SpProxy& pb); - - template - inline static void apply_noalias(SpMat& out, const SpMat& A, const SpMat& B); - - template - inline static void dense_sparse_min(Mat& out, const Base& X, const SpBase& Y); - - template - inline - static - typename enable_if2::no, eT>::result - elem_min(const eT& a, const eT& b); - - template - inline - static - typename enable_if2::yes, eT>::result - elem_min(const eT& a, const eT& b); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_min_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_min_meat.hpp deleted file mode 100644 index c12524801..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_min_meat.hpp +++ /dev/null @@ -1,222 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spglue_min -//! @{ - - - -template -inline -void -spglue_min::apply(SpMat& out, const SpGlue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const SpProxy pa(X.A); - const SpProxy pb(X.B); - - const bool is_alias = pa.is_alias(out) || pb.is_alias(out); - - if(is_alias == false) - { - spglue_min::apply_noalias(out, pa, pb); - } - else - { - SpMat tmp; - - spglue_min::apply_noalias(tmp, pa, pb); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -spglue_min::apply_noalias(SpMat& out, const SpProxy& pa, const SpProxy& pb) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(pa.get_n_rows(), pa.get_n_cols(), pb.get_n_rows(), pb.get_n_cols(), "element-wise min()"); - - const uword max_n_nonzero = pa.get_n_nonzero() + pb.get_n_nonzero(); - - // Resize memory to upper bound - out.reserve(pa.get_n_rows(), pa.get_n_cols(), max_n_nonzero); - - // Now iterate across both matrices. - typename SpProxy::const_iterator_type x_it = pa.begin(); - typename SpProxy::const_iterator_type x_end = pa.end(); - - typename SpProxy::const_iterator_type y_it = pb.begin(); - typename SpProxy::const_iterator_type y_end = pb.end(); - - uword count = 0; - - while( (x_it != x_end) || (y_it != y_end) ) - { - eT out_val; - - const uword x_it_col = x_it.col(); - const uword x_it_row = x_it.row(); - - const uword y_it_col = y_it.col(); - const uword y_it_row = y_it.row(); - - bool use_y_loc = false; - - if(x_it == y_it) - { - out_val = elem_min(eT(*x_it), eT(*y_it)); - - ++x_it; - ++y_it; - } - else - { - if((x_it_col < y_it_col) || ((x_it_col == y_it_col) && (x_it_row < y_it_row))) // if y is closer to the end - { - out_val = elem_min(eT(*x_it), eT(0)); - - ++x_it; - } - else - { - out_val = elem_min(eT(*y_it), eT(0)); - - ++y_it; - - use_y_loc = true; - } - } - - if(out_val != eT(0)) - { - access::rw(out.values[count]) = out_val; - - const uword out_row = (use_y_loc == false) ? x_it_row : y_it_row; - const uword out_col = (use_y_loc == false) ? x_it_col : y_it_col; - - access::rw(out.row_indices[count]) = out_row; - access::rw(out.col_ptrs[out_col + 1])++; - ++count; - } - - arma_check( (count > max_n_nonzero), "internal error: spglue_min::apply_noalias(): count > max_n_nonzero" ); - } - - const uword out_n_cols = out.n_cols; - - uword* col_ptrs = access::rwp(out.col_ptrs); - - // Fix column pointers to be cumulative. - for(uword c = 1; c <= out_n_cols; ++c) - { - col_ptrs[c] += col_ptrs[c - 1]; - } - - if(count < max_n_nonzero) - { - if(count <= (max_n_nonzero/2)) - { - out.mem_resize(count); - } - else - { - // quick resize without reallocating memory and copying data - access::rw( out.n_nonzero) = count; - access::rw( out.values[count]) = eT(0); - access::rw(out.row_indices[count]) = uword(0); - } - } - } - - - -template -inline -void -spglue_min::apply_noalias(SpMat& out, const SpMat& A, const SpMat& B) - { - arma_debug_sigprint(); - - const SpProxy< SpMat > pa(A); - const SpProxy< SpMat > pb(B); - - spglue_min::apply_noalias(out, pa, pb); - } - - - -template -inline -void -spglue_min::dense_sparse_min(Mat& out, const Base& X, const SpBase& Y) - { - arma_debug_sigprint(); - - // NOTE: this function assumes there is no aliasing between matrix 'out' and X - - const Proxy pa(X.get_ref()); - const SpProxy pb(Y.get_ref()); - - const uword n_rows = pa.get_n_rows(); - const uword n_cols = pa.get_n_cols(); - - arma_conform_assert_same_size( n_rows, n_cols, pb.get_n_rows(), pb.get_n_cols(), "element-wise min()" ); - - out.set_size(n_rows, n_cols); - - for(uword c=0; c < n_cols; ++c) - for(uword r=0; r < n_rows; ++r) - { - out.at(r,c) = elem_min(pa.at(r,c), pb.at(r,c)); - } - } - - - -// min of non-complex elements -template -inline -typename enable_if2::no, eT>::result -spglue_min::elem_min(const eT& a, const eT& b) - { - return (std::min)(a, b); - } - - - -// min of complex elements -template -inline -typename enable_if2::yes, eT>::result -spglue_min::elem_min(const eT& a, const eT& b) - { - return (std::abs(a) < std::abs(b)) ? a : b; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_minus_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_minus_bones.hpp deleted file mode 100644 index 39463c331..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_minus_bones.hpp +++ /dev/null @@ -1,59 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spglue_minus -//! @{ - - - -class spglue_minus - : public traits_glue_or - { - public: - - template - inline static void apply(SpMat& out, const SpGlue& X); - - template - inline static void apply_noalias(SpMat& result, const SpProxy& pa, const SpProxy& pb); - - template - inline static void apply_noalias(SpMat& out, const SpMat& A, const SpMat& B); - }; - - - -class spglue_minus_mixed - : public traits_glue_or - { - public: - - template - inline static void apply(SpMat::eT>& out, const mtSpGlue::eT, T1, T2, spglue_minus_mixed>& expr); - - template - inline static void sparse_minus_dense(Mat< typename promote_type::result>& out, const T1& X, const T2& Y); - - template - inline static void dense_minus_sparse(Mat< typename promote_type::result>& out, const T1& X, const T2& Y); - }; - - - -//! @} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_minus_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_minus_meat.hpp deleted file mode 100644 index 51b22f41e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_minus_meat.hpp +++ /dev/null @@ -1,340 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spglue_minus -//! @{ - - - -template -inline -void -spglue_minus::apply(SpMat& out, const SpGlue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const SpProxy pa(X.A); - const SpProxy pb(X.B); - - const bool is_alias = pa.is_alias(out) || pb.is_alias(out); - - if(is_alias == false) - { - spglue_minus::apply_noalias(out, pa, pb); - } - else - { - SpMat tmp; - - spglue_minus::apply_noalias(tmp, pa, pb); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -spglue_minus::apply_noalias(SpMat& out, const SpProxy& pa, const SpProxy& pb) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(pa.get_n_rows(), pa.get_n_cols(), pb.get_n_rows(), pb.get_n_cols(), "subtraction"); - - if(pa.get_n_nonzero() == 0) { out = pb.Q; out *= eT(-1); return; } - if(pb.get_n_nonzero() == 0) { out = pa.Q; return; } - - const uword max_n_nonzero = pa.get_n_nonzero() + pb.get_n_nonzero(); - - // Resize memory to upper bound - out.reserve(pa.get_n_rows(), pa.get_n_cols(), max_n_nonzero); - - // Now iterate across both matrices. - typename SpProxy::const_iterator_type x_it = pa.begin(); - typename SpProxy::const_iterator_type x_end = pa.end(); - - typename SpProxy::const_iterator_type y_it = pb.begin(); - typename SpProxy::const_iterator_type y_end = pb.end(); - - uword count = 0; - - while( (x_it != x_end) || (y_it != y_end) ) - { - eT out_val; - - const uword x_it_row = x_it.row(); - const uword x_it_col = x_it.col(); - - const uword y_it_row = y_it.row(); - const uword y_it_col = y_it.col(); - - bool use_y_loc = false; - - if(x_it == y_it) - { - out_val = (*x_it) - (*y_it); - - ++x_it; - ++y_it; - } - else - { - if((x_it_col < y_it_col) || ((x_it_col == y_it_col) && (x_it_row < y_it_row))) // if y is closer to the end - { - out_val = (*x_it); - - ++x_it; - } - else - { - out_val = -(*y_it); // take the negative - - ++y_it; - - use_y_loc = true; - } - } - - if(out_val != eT(0)) - { - access::rw(out.values[count]) = out_val; - - const uword out_row = (use_y_loc == false) ? x_it_row : y_it_row; - const uword out_col = (use_y_loc == false) ? x_it_col : y_it_col; - - access::rw(out.row_indices[count]) = out_row; - access::rw(out.col_ptrs[out_col + 1])++; - ++count; - } - - arma_check( (count > max_n_nonzero), "internal error: spglue_minus::apply_noalias(): count > max_n_nonzero" ); - } - - const uword out_n_cols = out.n_cols; - - uword* col_ptrs = access::rwp(out.col_ptrs); - - // Fix column pointers to be cumulative. - for(uword c = 1; c <= out_n_cols; ++c) - { - col_ptrs[c] += col_ptrs[c - 1]; - } - - if(count < max_n_nonzero) - { - if(count <= (max_n_nonzero/2)) - { - out.mem_resize(count); - } - else - { - // quick resize without reallocating memory and copying data - access::rw( out.n_nonzero) = count; - access::rw( out.values[count]) = eT(0); - access::rw(out.row_indices[count]) = uword(0); - } - } - } - - - -template -inline -void -spglue_minus::apply_noalias(SpMat& out, const SpMat& A, const SpMat& B) - { - arma_debug_sigprint(); - - const SpProxy< SpMat > pa(A); - const SpProxy< SpMat > pb(B); - - spglue_minus::apply_noalias(out, pa, pb); - } - - - -// - - - -template -inline -void -spglue_minus_mixed::apply(SpMat::eT>& out, const mtSpGlue::eT, T1, T2, spglue_minus_mixed>& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - if( (is_same_type::no) && (is_same_type::yes) ) - { - // upgrade T1 - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - - SpMat AA(arma_layout_indicator(), A); - - for(uword i=0; i < A.n_nonzero; ++i) { access::rw(AA.values[i]) = out_eT(A.values[i]); } - - const SpMat& BB = reinterpret_cast< const SpMat& >(B); - - out = AA - BB; - } - else - if( (is_same_type::yes) && (is_same_type::no) ) - { - // upgrade T2 - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - - const SpMat& AA = reinterpret_cast< const SpMat& >(A); - - SpMat BB(arma_layout_indicator(), B); - - for(uword i=0; i < B.n_nonzero; ++i) { access::rw(BB.values[i]) = out_eT(B.values[i]); } - - out = AA - BB; - } - else - { - // upgrade T1 and T2 - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - - SpMat AA(arma_layout_indicator(), A); - SpMat BB(arma_layout_indicator(), B); - - for(uword i=0; i < A.n_nonzero; ++i) { access::rw(AA.values[i]) = out_eT(A.values[i]); } - for(uword i=0; i < B.n_nonzero; ++i) { access::rw(BB.values[i]) = out_eT(B.values[i]); } - - out = AA - BB; - } - } - - - -template -inline -void -spglue_minus_mixed::sparse_minus_dense(Mat< typename promote_type::result>& out, const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - const quasi_unwrap UB(Y); - const Mat& B = UB.M; - - const uword B_n_elem = B.n_elem; - const eT2* B_mem = B.memptr(); - - out.set_size(B.n_rows, B.n_cols); - - out_eT* out_mem = out.memptr(); - - for(uword i=0; i pa(X); - - arma_conform_assert_same_size( pa.get_n_rows(), pa.get_n_cols(), out.n_rows, out.n_cols, "subtraction" ); - - typename SpProxy::const_iterator_type it = pa.begin(); - typename SpProxy::const_iterator_type it_end = pa.end(); - - while(it != it_end) - { - out.at(it.row(), it.col()) += out_eT(*it); - ++it; - } - } - - - -template -inline -void -spglue_minus_mixed::dense_minus_sparse(Mat< typename promote_type::result>& out, const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - if(is_same_type::no) - { - out = conv_to< Mat >::from(X); - } - else - { - const quasi_unwrap UA(X); - - const Mat& A = UA.M; - - out = reinterpret_cast< const Mat& >(A); - } - - const SpProxy pb(Y); - - arma_conform_assert_same_size( out.n_rows, out.n_cols, pb.get_n_rows(), pb.get_n_cols(), "subtraction" ); - - typename SpProxy::const_iterator_type it = pb.begin(); - typename SpProxy::const_iterator_type it_end = pb.end(); - - while(it != it_end) - { - out.at(it.row(), it.col()) -= out_eT(*it); - ++it; - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_plus_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_plus_bones.hpp deleted file mode 100644 index b92cb71c7..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_plus_bones.hpp +++ /dev/null @@ -1,55 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spglue_plus -//! @{ - - - -class spglue_plus - : public traits_glue_or - { - public: - - template - inline static void apply(SpMat& out, const SpGlue& X); - - template - inline static void apply_noalias(SpMat& out, const SpProxy& pa, const SpProxy& pb); - - template - inline static void apply_noalias(SpMat& out, const SpMat& A, const SpMat& B); - }; - - - -class spglue_plus_mixed - : public traits_glue_or - { - public: - - template - inline static void apply(SpMat::eT>& out, const mtSpGlue::eT, T1, T2, spglue_plus_mixed>& expr); - - template - inline static void dense_plus_sparse(Mat< typename promote_type::result>& out, const T1& X, const T2& Y); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_plus_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_plus_meat.hpp deleted file mode 100644 index 389e8faa2..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_plus_meat.hpp +++ /dev/null @@ -1,295 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spglue_plus -//! @{ - - - -template -inline -void -spglue_plus::apply(SpMat& out, const SpGlue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const SpProxy pa(X.A); - const SpProxy pb(X.B); - - const bool is_alias = pa.is_alias(out) || pb.is_alias(out); - - if(is_alias == false) - { - spglue_plus::apply_noalias(out, pa, pb); - } - else - { - SpMat tmp; - - spglue_plus::apply_noalias(tmp, pa, pb); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -spglue_plus::apply_noalias(SpMat& out, const SpProxy& pa, const SpProxy& pb) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(pa.get_n_rows(), pa.get_n_cols(), pb.get_n_rows(), pb.get_n_cols(), "addition"); - - if(pa.get_n_nonzero() == 0) { out = pb.Q; return; } - if(pb.get_n_nonzero() == 0) { out = pa.Q; return; } - - const uword max_n_nonzero = pa.get_n_nonzero() + pb.get_n_nonzero(); - - // Resize memory to upper bound - out.reserve(pa.get_n_rows(), pa.get_n_cols(), max_n_nonzero); - - // Now iterate across both matrices. - typename SpProxy::const_iterator_type x_it = pa.begin(); - typename SpProxy::const_iterator_type x_end = pa.end(); - - typename SpProxy::const_iterator_type y_it = pb.begin(); - typename SpProxy::const_iterator_type y_end = pb.end(); - - uword count = 0; - - while( (x_it != x_end) || (y_it != y_end) ) - { - eT out_val; - - const uword x_it_col = x_it.col(); - const uword x_it_row = x_it.row(); - - const uword y_it_col = y_it.col(); - const uword y_it_row = y_it.row(); - - bool use_y_loc = false; - - if(x_it == y_it) - { - out_val = (*x_it) + (*y_it); - - ++x_it; - ++y_it; - } - else - { - if((x_it_col < y_it_col) || ((x_it_col == y_it_col) && (x_it_row < y_it_row))) // if y is closer to the end - { - out_val = (*x_it); - - ++x_it; - } - else - { - out_val = (*y_it); - - ++y_it; - - use_y_loc = true; - } - } - - if(out_val != eT(0)) - { - access::rw(out.values[count]) = out_val; - - const uword out_row = (use_y_loc == false) ? x_it_row : y_it_row; - const uword out_col = (use_y_loc == false) ? x_it_col : y_it_col; - - access::rw(out.row_indices[count]) = out_row; - access::rw(out.col_ptrs[out_col + 1])++; - ++count; - } - - arma_check( (count > max_n_nonzero), "internal error: spglue_plus::apply_noalias(): count > max_n_nonzero" ); - } - - const uword out_n_cols = out.n_cols; - - uword* col_ptrs = access::rwp(out.col_ptrs); - - // Fix column pointers to be cumulative. - for(uword c = 1; c <= out_n_cols; ++c) - { - col_ptrs[c] += col_ptrs[c - 1]; - } - - if(count < max_n_nonzero) - { - if(count <= (max_n_nonzero/2)) - { - out.mem_resize(count); - } - else - { - // quick resize without reallocating memory and copying data - access::rw( out.n_nonzero) = count; - access::rw( out.values[count]) = eT(0); - access::rw(out.row_indices[count]) = uword(0); - } - } - } - - - -template -inline -void -spglue_plus::apply_noalias(SpMat& out, const SpMat& A, const SpMat& B) - { - arma_debug_sigprint(); - - const SpProxy< SpMat > pa(A); - const SpProxy< SpMat > pb(B); - - spglue_plus::apply_noalias(out, pa, pb); - } - - - -// - - - -template -inline -void -spglue_plus_mixed::apply(SpMat::eT>& out, const mtSpGlue::eT, T1, T2, spglue_plus_mixed>& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - if( (is_same_type::no) && (is_same_type::yes) ) - { - // upgrade T1 - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - - SpMat AA(arma_layout_indicator(), A); - - for(uword i=0; i < A.n_nonzero; ++i) { access::rw(AA.values[i]) = out_eT(A.values[i]); } - - const SpMat& BB = reinterpret_cast< const SpMat& >(B); - - out = AA + BB; - } - else - if( (is_same_type::yes) && (is_same_type::no) ) - { - // upgrade T2 - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - - const SpMat& AA = reinterpret_cast< const SpMat& >(A); - - SpMat BB(arma_layout_indicator(), B); - - for(uword i=0; i < B.n_nonzero; ++i) { access::rw(BB.values[i]) = out_eT(B.values[i]); } - - out = AA + BB; - } - else - { - // upgrade T1 and T2 - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - - SpMat AA(arma_layout_indicator(), A); - SpMat BB(arma_layout_indicator(), B); - - for(uword i=0; i < A.n_nonzero; ++i) { access::rw(AA.values[i]) = out_eT(A.values[i]); } - for(uword i=0; i < B.n_nonzero; ++i) { access::rw(BB.values[i]) = out_eT(B.values[i]); } - - out = AA + BB; - } - } - - - -template -inline -void -spglue_plus_mixed::dense_plus_sparse(Mat< typename promote_type::result>& out, const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - if(is_same_type::no) - { - out = conv_to< Mat >::from(X); - } - else - { - const quasi_unwrap UA(X); - - const Mat& A = UA.M; - - out = reinterpret_cast< const Mat& >(A); - } - - const SpProxy pb(Y); - - arma_conform_assert_same_size( out.n_rows, out.n_cols, pb.get_n_rows(), pb.get_n_cols(), "addition" ); - - typename SpProxy::const_iterator_type it = pb.begin(); - typename SpProxy::const_iterator_type it_end = pb.end(); - - while(it != it_end) - { - out.at(it.row(), it.col()) += out_eT(*it); - ++it; - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_relational_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_relational_bones.hpp deleted file mode 100644 index f84caf46c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_relational_bones.hpp +++ /dev/null @@ -1,80 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spglue_relational -//! @{ - - - -class spglue_rel_lt - : public traits_glue_or - { - public: - - template - inline static void apply(SpMat& out, const mtSpGlue& X); - - template - inline static void apply_noalias(SpMat& out, const SpProxy& PA, const SpProxy& PB); - }; - - - -class spglue_rel_gt - : public traits_glue_or - { - public: - - template - inline static void apply(SpMat& out, const mtSpGlue& X); - - template - inline static void apply_noalias(SpMat& out, const SpProxy& PA, const SpProxy& PB); - }; - - - -class spglue_rel_and - : public traits_glue_or - { - public: - - template - inline static void apply(SpMat& out, const mtSpGlue& X); - - template - inline static void apply_noalias(SpMat& out, const SpProxy& PA, const SpProxy& PB); - }; - - - -class spglue_rel_or - : public traits_glue_or - { - public: - - template - inline static void apply(SpMat& out, const mtSpGlue& X); - - template - inline static void apply_noalias(SpMat& out, const SpProxy& PA, const SpProxy& PB); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_relational_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_relational_meat.hpp deleted file mode 100644 index 310af4509..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_relational_meat.hpp +++ /dev/null @@ -1,545 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spglue_relational -//! @{ - - - -template -inline -void -spglue_rel_lt::apply(SpMat& out, const mtSpGlue& X) - { - arma_debug_sigprint(); - - const SpProxy PA(X.A); - const SpProxy PB(X.B); - - const bool is_alias = PA.is_alias(out) || PB.is_alias(out); - - if(is_alias == false) - { - spglue_rel_lt::apply_noalias(out, PA, PB); - } - else - { - SpMat tmp; - - spglue_rel_lt::apply_noalias(tmp, PA, PB); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -spglue_rel_lt::apply_noalias(SpMat& out, const SpProxy& PA, const SpProxy& PB) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - arma_conform_assert_same_size(PA.get_n_rows(), PA.get_n_cols(), PB.get_n_rows(), PB.get_n_cols(), "operator<"); - - const uword max_n_nonzero = PA.get_n_nonzero() + PB.get_n_nonzero(); - - // Resize memory to upper bound - out.reserve(PA.get_n_rows(), PA.get_n_cols(), max_n_nonzero); - - // Now iterate across both matrices. - typename SpProxy::const_iterator_type x_it = PA.begin(); - typename SpProxy::const_iterator_type x_end = PA.end(); - - typename SpProxy::const_iterator_type y_it = PB.begin(); - typename SpProxy::const_iterator_type y_end = PB.end(); - - uword count = 0; - - while( (x_it != x_end) || (y_it != y_end) ) - { - uword out_val; - - const uword x_it_col = x_it.col(); - const uword x_it_row = x_it.row(); - - const uword y_it_col = y_it.col(); - const uword y_it_row = y_it.row(); - - bool use_y_loc = false; - - if(x_it == y_it) - { - out_val = ((*x_it) < (*y_it)) ? uword(1) : uword(0); - - ++x_it; - ++y_it; - } - else - { - if((x_it_col < y_it_col) || ((x_it_col == y_it_col) && (x_it_row < y_it_row))) // if y is closer to the end - { - out_val = ((*x_it) < eT(0)) ? uword(1) : uword(0); - - ++x_it; - } - else - { - out_val = (eT(0) < (*y_it)) ? uword(1) : uword(0); - - ++y_it; - - use_y_loc = true; - } - } - - if(out_val != uword(0)) - { - access::rw(out.values[count]) = out_val; - - const uword out_row = (use_y_loc == false) ? x_it_row : y_it_row; - const uword out_col = (use_y_loc == false) ? x_it_col : y_it_col; - - access::rw(out.row_indices[count]) = out_row; - access::rw(out.col_ptrs[out_col + 1])++; - ++count; - } - - arma_check( (count > max_n_nonzero), "internal error: spglue_rel_lt::apply_noalias(): count > max_n_nonzero" ); - } - - const uword out_n_cols = out.n_cols; - - uword* col_ptrs = access::rwp(out.col_ptrs); - - // Fix column pointers to be cumulative. - for(uword c = 1; c <= out_n_cols; ++c) - { - col_ptrs[c] += col_ptrs[c - 1]; - } - - if(count < max_n_nonzero) - { - if(count <= (max_n_nonzero/2)) - { - out.mem_resize(count); - } - else - { - // quick resize without reallocating memory and copying data - access::rw( out.n_nonzero) = count; - access::rw( out.values[count]) = eT(0); - access::rw(out.row_indices[count]) = uword(0); - } - } - } - - - -// - - - -template -inline -void -spglue_rel_gt::apply(SpMat& out, const mtSpGlue& X) - { - arma_debug_sigprint(); - - const SpProxy PA(X.A); - const SpProxy PB(X.B); - - const bool is_alias = PA.is_alias(out) || PB.is_alias(out); - - if(is_alias == false) - { - spglue_rel_gt::apply_noalias(out, PA, PB); - } - else - { - SpMat tmp; - - spglue_rel_gt::apply_noalias(tmp, PA, PB); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -spglue_rel_gt::apply_noalias(SpMat& out, const SpProxy& PA, const SpProxy& PB) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - arma_conform_assert_same_size(PA.get_n_rows(), PA.get_n_cols(), PB.get_n_rows(), PB.get_n_cols(), "operator>"); - - const uword max_n_nonzero = PA.get_n_nonzero() + PB.get_n_nonzero(); - - // Resize memory to upper bound - out.reserve(PA.get_n_rows(), PA.get_n_cols(), max_n_nonzero); - - // Now iterate across both matrices. - typename SpProxy::const_iterator_type x_it = PA.begin(); - typename SpProxy::const_iterator_type x_end = PA.end(); - - typename SpProxy::const_iterator_type y_it = PB.begin(); - typename SpProxy::const_iterator_type y_end = PB.end(); - - uword count = 0; - - while( (x_it != x_end) || (y_it != y_end) ) - { - uword out_val; - - const uword x_it_col = x_it.col(); - const uword x_it_row = x_it.row(); - - const uword y_it_col = y_it.col(); - const uword y_it_row = y_it.row(); - - bool use_y_loc = false; - - if(x_it == y_it) - { - out_val = ((*x_it) > (*y_it)) ? uword(1) : uword(0); - - ++x_it; - ++y_it; - } - else - { - if((x_it_col < y_it_col) || ((x_it_col == y_it_col) && (x_it_row < y_it_row))) // if y is closer to the end - { - out_val = ((*x_it) > eT(0)) ? uword(1) : uword(0); - - ++x_it; - } - else - { - out_val = (eT(0) > (*y_it)) ? uword(1) : uword(0); - - ++y_it; - - use_y_loc = true; - } - } - - if(out_val != uword(0)) - { - access::rw(out.values[count]) = out_val; - - const uword out_row = (use_y_loc == false) ? x_it_row : y_it_row; - const uword out_col = (use_y_loc == false) ? x_it_col : y_it_col; - - access::rw(out.row_indices[count]) = out_row; - access::rw(out.col_ptrs[out_col + 1])++; - ++count; - } - - arma_check( (count > max_n_nonzero), "internal error: spglue_rel_gt::apply_noalias(): count > max_n_nonzero" ); - } - - const uword out_n_cols = out.n_cols; - - uword* col_ptrs = access::rwp(out.col_ptrs); - - // Fix column pointers to be cumulative. - for(uword c = 1; c <= out_n_cols; ++c) - { - col_ptrs[c] += col_ptrs[c - 1]; - } - - if(count < max_n_nonzero) - { - if(count <= (max_n_nonzero/2)) - { - out.mem_resize(count); - } - else - { - // quick resize without reallocating memory and copying data - access::rw( out.n_nonzero) = count; - access::rw( out.values[count]) = eT(0); - access::rw(out.row_indices[count]) = uword(0); - } - } - } - - - -// - - - -template -inline -void -spglue_rel_and::apply(SpMat& out, const mtSpGlue& X) - { - arma_debug_sigprint(); - - const SpProxy PA(X.A); - const SpProxy PB(X.B); - - const bool is_alias = PA.is_alias(out) || PB.is_alias(out); - - if(is_alias == false) - { - spglue_rel_and::apply_noalias(out, PA, PB); - } - else - { - SpMat tmp; - - spglue_rel_and::apply_noalias(tmp, PA, PB); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -spglue_rel_and::apply_noalias(SpMat& out, const SpProxy& PA, const SpProxy& PB) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - arma_conform_assert_same_size(PA.get_n_rows(), PA.get_n_cols(), PB.get_n_rows(), PB.get_n_cols(), "operator&&"); - - if( (PA.get_n_nonzero() == 0) || (PB.get_n_nonzero() == 0) ) - { - out.zeros(PA.get_n_rows(), PA.get_n_cols()); - return; - } - - const uword max_n_nonzero = (std::min)(PA.get_n_nonzero(), PB.get_n_nonzero()); - - // Resize memory to upper bound - out.reserve(PA.get_n_rows(), PA.get_n_cols(), max_n_nonzero); - - // Now iterate across both matrices. - typename SpProxy::const_iterator_type x_it = PA.begin(); - typename SpProxy::const_iterator_type x_end = PA.end(); - - typename SpProxy::const_iterator_type y_it = PB.begin(); - typename SpProxy::const_iterator_type y_end = PB.end(); - - uword count = 0; - - while( (x_it != x_end) || (y_it != y_end) ) - { - const uword x_it_row = x_it.row(); - const uword x_it_col = x_it.col(); - - const uword y_it_row = y_it.row(); - const uword y_it_col = y_it.col(); - - if(x_it == y_it) - { - access::rw(out.values[count]) = uword(1); - - access::rw(out.row_indices[count]) = x_it_row; - access::rw(out.col_ptrs[x_it_col + 1])++; - ++count; - - ++x_it; - ++y_it; - } - else - { - if((x_it_col < y_it_col) || ((x_it_col == y_it_col) && (x_it_row < y_it_row))) // if y is closer to the end - { - ++x_it; - } - else - { - ++y_it; - } - } - - arma_check( (count > max_n_nonzero), "internal error: spglue_rel_and::apply_noalias(): count > max_n_nonzero" ); - } - - const uword out_n_cols = out.n_cols; - - uword* col_ptrs = access::rwp(out.col_ptrs); - - // Fix column pointers to be cumulative. - for(uword c = 1; c <= out_n_cols; ++c) - { - col_ptrs[c] += col_ptrs[c - 1]; - } - - if(count < max_n_nonzero) - { - if(count <= (max_n_nonzero/2)) - { - out.mem_resize(count); - } - else - { - // quick resize without reallocating memory and copying data - access::rw( out.n_nonzero) = count; - access::rw( out.values[count]) = eT(0); - access::rw(out.row_indices[count]) = uword(0); - } - } - } - - - -// - - - -template -inline -void -spglue_rel_or::apply(SpMat& out, const mtSpGlue& X) - { - arma_debug_sigprint(); - - const SpProxy PA(X.A); - const SpProxy PB(X.B); - - const bool is_alias = PA.is_alias(out) || PB.is_alias(out); - - if(is_alias == false) - { - spglue_rel_or::apply_noalias(out, PA, PB); - } - else - { - SpMat tmp; - - spglue_rel_or::apply_noalias(tmp, PA, PB); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -spglue_rel_or::apply_noalias(SpMat& out, const SpProxy& PA, const SpProxy& PB) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - arma_conform_assert_same_size(PA.get_n_rows(), PA.get_n_cols(), PB.get_n_rows(), PB.get_n_cols(), "operator||"); - - const uword max_n_nonzero = PA.get_n_nonzero() + PB.get_n_nonzero(); - - // Resize memory to upper bound - out.reserve(PA.get_n_rows(), PA.get_n_cols(), max_n_nonzero); - - // Now iterate across both matrices. - typename SpProxy::const_iterator_type x_it = PA.begin(); - typename SpProxy::const_iterator_type x_end = PA.end(); - - typename SpProxy::const_iterator_type y_it = PB.begin(); - typename SpProxy::const_iterator_type y_end = PB.end(); - - uword count = 0; - - while( (x_it != x_end) || (y_it != y_end) ) - { - const uword x_it_col = x_it.col(); - const uword x_it_row = x_it.row(); - - const uword y_it_col = y_it.col(); - const uword y_it_row = y_it.row(); - - bool use_y_loc = false; - - if(x_it == y_it) - { - ++x_it; - ++y_it; - } - else - { - if((x_it_col < y_it_col) || ((x_it_col == y_it_col) && (x_it_row < y_it_row))) // if y is closer to the end - { - ++x_it; - } - else - { - ++y_it; - - use_y_loc = true; - } - } - - access::rw(out.values[count]) = uword(1); - - const uword out_row = (use_y_loc == false) ? x_it_row : y_it_row; - const uword out_col = (use_y_loc == false) ? x_it_col : y_it_col; - - access::rw(out.row_indices[count]) = out_row; - access::rw(out.col_ptrs[out_col + 1])++; - ++count; - - arma_check( (count > max_n_nonzero), "internal error: spglue_rel_or::apply_noalias(): count > max_n_nonzero" ); - } - - const uword out_n_cols = out.n_cols; - - uword* col_ptrs = access::rwp(out.col_ptrs); - - // Fix column pointers to be cumulative. - for(uword c = 1; c <= out_n_cols; ++c) - { - col_ptrs[c] += col_ptrs[c - 1]; - } - - if(count < max_n_nonzero) - { - if(count <= (max_n_nonzero/2)) - { - out.mem_resize(count); - } - else - { - // quick resize without reallocating memory and copying data - access::rw( out.n_nonzero) = count; - access::rw( out.values[count]) = eT(0); - access::rw(out.row_indices[count]) = uword(0); - } - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_schur_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_schur_bones.hpp deleted file mode 100644 index 605de3a83..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_schur_bones.hpp +++ /dev/null @@ -1,66 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spglue_schur -//! @{ - - - -class spglue_schur - : public traits_glue_or - { - public: - - template - inline static void apply(SpMat& out, const SpGlue& X); - - template - inline static void apply_noalias(SpMat& out, const SpProxy& pa, const SpProxy& pb); - - template - inline static void apply_noalias(SpMat& out, const SpMat& A, const SpMat& B); - }; - - - -class spglue_schur_misc - : public traits_glue_or - { - public: - - template - inline static void dense_schur_sparse(SpMat& out, const T1& x, const T2& y); - }; - - - -class spglue_schur_mixed - : public traits_glue_or - { - public: - - template - inline static void apply(SpMat::eT>& out, const mtSpGlue::eT, T1, T2, spglue_schur_mixed>& expr); - - template - inline static void dense_schur_sparse(SpMat< typename promote_type::result>& out, const T1& X, const T2& Y); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_schur_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_schur_meat.hpp deleted file mode 100644 index b8ed3193d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_schur_meat.hpp +++ /dev/null @@ -1,382 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spglue_schur -//! @{ - - - -template -inline -void -spglue_schur::apply(SpMat& out, const SpGlue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const SpProxy pa(X.A); - const SpProxy pb(X.B); - - const bool is_alias = pa.is_alias(out) || pb.is_alias(out); - - if(is_alias == false) - { - spglue_schur::apply_noalias(out, pa, pb); - } - else - { - SpMat tmp; - - spglue_schur::apply_noalias(tmp, pa, pb); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -spglue_schur::apply_noalias(SpMat& out, const SpProxy& pa, const SpProxy& pb) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(pa.get_n_rows(), pa.get_n_cols(), pb.get_n_rows(), pb.get_n_cols(), "element-wise multiplication"); - - if( (pa.get_n_nonzero() == 0) || (pb.get_n_nonzero() == 0) ) - { - out.zeros(pa.get_n_rows(), pa.get_n_cols()); - return; - } - - const uword max_n_nonzero = (std::min)(pa.get_n_nonzero(), pb.get_n_nonzero()); - - // Resize memory to upper bound - out.reserve(pa.get_n_rows(), pa.get_n_cols(), max_n_nonzero); - - // Now iterate across both matrices. - typename SpProxy::const_iterator_type x_it = pa.begin(); - typename SpProxy::const_iterator_type x_end = pa.end(); - - typename SpProxy::const_iterator_type y_it = pb.begin(); - typename SpProxy::const_iterator_type y_end = pb.end(); - - uword count = 0; - - while( (x_it != x_end) || (y_it != y_end) ) - { - const uword x_it_row = x_it.row(); - const uword x_it_col = x_it.col(); - - const uword y_it_row = y_it.row(); - const uword y_it_col = y_it.col(); - - if(x_it == y_it) - { - const eT out_val = (*x_it) * (*y_it); - - if(out_val != eT(0)) - { - access::rw(out.values[count]) = out_val; - - access::rw(out.row_indices[count]) = x_it_row; - access::rw(out.col_ptrs[x_it_col + 1])++; - ++count; - } - - ++x_it; - ++y_it; - } - else - { - if((x_it_col < y_it_col) || ((x_it_col == y_it_col) && (x_it_row < y_it_row))) // if y is closer to the end - { - ++x_it; - } - else - { - ++y_it; - } - } - - arma_check( (count > max_n_nonzero), "internal error: spglue_schur::apply_noalias(): count > max_n_nonzero" ); - } - - const uword out_n_cols = out.n_cols; - - uword* col_ptrs = access::rwp(out.col_ptrs); - - // Fix column pointers to be cumulative. - for(uword c = 1; c <= out_n_cols; ++c) - { - col_ptrs[c] += col_ptrs[c - 1]; - } - - if(count < max_n_nonzero) - { - if(count <= (max_n_nonzero/2)) - { - out.mem_resize(count); - } - else - { - // quick resize without reallocating memory and copying data - access::rw( out.n_nonzero) = count; - access::rw( out.values[count]) = eT(0); - access::rw(out.row_indices[count]) = uword(0); - } - } - } - - - -template -inline -void -spglue_schur::apply_noalias(SpMat& out, const SpMat& A, const SpMat& B) - { - arma_debug_sigprint(); - - const SpProxy< SpMat > pa(A); - const SpProxy< SpMat > pb(B); - - spglue_schur::apply_noalias(out, pa, pb); - } - - - -// -// -// - - - -template -inline -void -spglue_schur_misc::dense_schur_sparse(SpMat& out, const T1& x, const T2& y) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const Proxy pa(x); - const SpProxy pb(y); - - arma_conform_assert_same_size(pa.get_n_rows(), pa.get_n_cols(), pb.get_n_rows(), pb.get_n_cols(), "element-wise multiplication"); - - const uword max_n_nonzero = pb.get_n_nonzero(); - - // Resize memory to upper bound. - out.reserve(pa.get_n_rows(), pa.get_n_cols(), max_n_nonzero); - - uword count = 0; - - typename SpProxy::const_iterator_type it = pb.begin(); - typename SpProxy::const_iterator_type it_end = pb.end(); - - while(it != it_end) - { - const uword it_row = it.row(); - const uword it_col = it.col(); - - const eT val = (*it) * pa.at(it_row, it_col); - - if(val != eT(0)) - { - access::rw( out.values[count]) = val; - access::rw( out.row_indices[count]) = it_row; - access::rw(out.col_ptrs[it_col + 1])++; - ++count; - } - - ++it; - - arma_check( (count > max_n_nonzero), "internal error: spglue_schur_misc::dense_schur_sparse(): count > max_n_nonzero" ); - } - - // Fix column pointers. - for(uword c = 1; c <= out.n_cols; ++c) - { - access::rw(out.col_ptrs[c]) += out.col_ptrs[c - 1]; - } - - if(count < max_n_nonzero) - { - if(count <= (max_n_nonzero/2)) - { - out.mem_resize(count); - } - else - { - // quick resize without reallocating memory and copying data - access::rw( out.n_nonzero) = count; - access::rw( out.values[count]) = eT(0); - access::rw(out.row_indices[count]) = uword(0); - } - } - } - - - -// - - - -template -inline -void -spglue_schur_mixed::apply(SpMat::eT>& out, const mtSpGlue::eT, T1, T2, spglue_schur_mixed>& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - if( (is_same_type::no) && (is_same_type::yes) ) - { - // upgrade T1 - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - - SpMat AA(arma_layout_indicator(), A); - - for(uword i=0; i < A.n_nonzero; ++i) { access::rw(AA.values[i]) = out_eT(A.values[i]); } - - const SpMat& BB = reinterpret_cast< const SpMat& >(B); - - out = AA % BB; - } - else - if( (is_same_type::yes) && (is_same_type::no) ) - { - // upgrade T2 - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - - const SpMat& AA = reinterpret_cast< const SpMat& >(A); - - SpMat BB(arma_layout_indicator(), B); - - for(uword i=0; i < B.n_nonzero; ++i) { access::rw(BB.values[i]) = out_eT(B.values[i]); } - - out = AA % BB; - } - else - { - // upgrade T1 and T2 - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - - SpMat AA(arma_layout_indicator(), A); - SpMat BB(arma_layout_indicator(), B); - - for(uword i=0; i < A.n_nonzero; ++i) { access::rw(AA.values[i]) = out_eT(A.values[i]); } - for(uword i=0; i < B.n_nonzero; ++i) { access::rw(BB.values[i]) = out_eT(B.values[i]); } - - out = AA % BB; - } - } - - - -template -inline -void -spglue_schur_mixed::dense_schur_sparse(SpMat< typename promote_type::result>& out, const T1& X, const T2& Y) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename promote_type::result out_eT; - - promote_type::check(); - - const Proxy pa(X); - const SpProxy pb(Y); - - arma_conform_assert_same_size(pa.get_n_rows(), pa.get_n_cols(), pb.get_n_rows(), pb.get_n_cols(), "element-wise multiplication"); - - // count new size - uword new_n_nonzero = 0; - - typename SpProxy::const_iterator_type it = pb.begin(); - typename SpProxy::const_iterator_type it_end = pb.end(); - - while(it != it_end) - { - if( (out_eT(*it) * out_eT(pa.at(it.row(), it.col()))) != out_eT(0) ) { ++new_n_nonzero; } - - ++it; - } - - // Resize memory accordingly. - out.reserve(pa.get_n_rows(), pa.get_n_cols(), new_n_nonzero); - - uword count = 0; - - typename SpProxy::const_iterator_type it2 = pb.begin(); - - while(it2 != it_end) - { - const uword it2_row = it2.row(); - const uword it2_col = it2.col(); - - const out_eT val = out_eT(*it2) * out_eT(pa.at(it2_row, it2_col)); - - if(val != out_eT(0)) - { - access::rw( out.values[count]) = val; - access::rw( out.row_indices[count]) = it2_row; - access::rw(out.col_ptrs[it2_col + 1])++; - ++count; - } - - ++it2; - } - - // Fix column pointers. - for(uword c = 1; c <= out.n_cols; ++c) - { - access::rw(out.col_ptrs[c]) += out.col_ptrs[c - 1]; - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_times_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_times_bones.hpp deleted file mode 100644 index 63c21b3d2..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_times_bones.hpp +++ /dev/null @@ -1,66 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spglue_times -//! @{ - - - -class spglue_times - { - public: - - template - struct traits - { - static constexpr bool is_row = T1::is_row; - static constexpr bool is_col = T2::is_col; - static constexpr bool is_xvec = false; - }; - - template - inline static void apply(SpMat& out, const SpGlue& X); - - template - inline static void apply(SpMat& out, const SpGlue,T2,spglue_times>& X); - - template - inline static void apply_noalias(SpMat& c, const SpMat& x, const SpMat& y); - }; - - - -class spglue_times_mixed - { - public: - - template - struct traits - { - static constexpr bool is_row = T1::is_row; - static constexpr bool is_col = T2::is_col; - static constexpr bool is_xvec = false; - }; - - template - inline static void apply(SpMat::eT>& out, const mtSpGlue::eT, T1, T2, spglue_times_mixed>& expr); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_times_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_times_meat.hpp deleted file mode 100644 index 80d40cbfd..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spglue_times_meat.hpp +++ /dev/null @@ -1,369 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spglue_times -//! @{ - - - -template -inline -void -spglue_times::apply(SpMat& out, const SpGlue& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat UA(X.A); - const unwrap_spmat UB(X.B); - - const bool is_alias = (UA.is_alias(out) || UB.is_alias(out)); - - if(is_alias == false) - { - spglue_times::apply_noalias(out, UA.M, UB.M); - } - else - { - SpMat tmp; - - spglue_times::apply_noalias(tmp, UA.M, UB.M); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -spglue_times::apply(SpMat& out, const SpGlue,T2,spglue_times>& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat UA(X.A.m); - const unwrap_spmat UB(X.B); - - const bool is_alias = (UA.is_alias(out) || UB.is_alias(out)); - - if(is_alias == false) - { - spglue_times::apply_noalias(out, UA.M, UB.M); - } - else - { - SpMat tmp; - - spglue_times::apply_noalias(tmp, UA.M, UB.M); - - out.steal_mem(tmp); - } - - out *= X.A.aux; - } - - - -template -inline -void -spglue_times::apply_noalias(SpMat& c, const SpMat& x, const SpMat& y) - { - arma_debug_sigprint(); - - const uword x_n_rows = x.n_rows; - const uword x_n_cols = x.n_cols; - const uword y_n_rows = y.n_rows; - const uword y_n_cols = y.n_cols; - - arma_conform_assert_mul_size(x_n_rows, x_n_cols, y_n_rows, y_n_cols, "matrix multiplication"); - - // First we must determine the structure of the new matrix (column pointers). - // This follows the algorithm described in 'Sparse Matrix Multiplication - // Package (SMMP)' (R.E. Bank and C.C. Douglas, 2001). Their description of - // "SYMBMM" does not include anything about memory allocation. In addition it - // does not consider that there may be elements which space may be allocated - // for but which evaluate to zero anyway. So we have to modify the algorithm - // to work that way. For the "SYMBMM" implementation we will not determine - // the row indices but instead just the column pointers. - - //SpMat c(x_n_rows, y_n_cols); // Initializes col_ptrs to 0. - c.zeros(x_n_rows, y_n_cols); - - //if( (x.n_elem == 0) || (y.n_elem == 0) ) { return; } - if( (x.n_nonzero == 0) || (y.n_nonzero == 0) ) { return; } - - // Auxiliary storage which denotes when items have been found. - podarray index(x_n_rows); - index.fill(x_n_rows); // Fill with invalid links. - - typename SpMat::const_iterator y_it = y.begin(); - typename SpMat::const_iterator y_end = y.end(); - - // SYMBMM: calculate column pointers for resultant matrix to obtain a good - // upper bound on the number of nonzero elements. - uword cur_col_length = 0; - uword last_ind = x_n_rows + 1; - do - { - const uword y_it_row = y_it.row(); - - // Look through the column that this point (*y_it) could affect. - typename SpMat::const_iterator x_it = x.begin_col_no_sync(y_it_row); - - while(x_it.col() == y_it_row) - { - const uword x_it_row = x_it.row(); - - // A point at x(i, j) and y(j, k) implies a point at c(i, k). - if(index[x_it_row] == x_n_rows) - { - index[x_it_row] = last_ind; - last_ind = x_it_row; - ++cur_col_length; - } - - ++x_it; - } - - const uword old_col = y_it.col(); - ++y_it; - - // See if column incremented. - if(old_col != y_it.col()) - { - // Set column pointer (this is not a cumulative count; that is done later). - access::rw(c.col_ptrs[old_col + 1]) = cur_col_length; - cur_col_length = 0; - - // Return index markers to zero. Use last_ind for traversal. - while(last_ind != x_n_rows + 1) - { - const uword tmp = index[last_ind]; - index[last_ind] = x_n_rows; - last_ind = tmp; - } - } - } - while(y_it != y_end); - - // Accumulate column pointers. - for(uword i = 0; i < c.n_cols; ++i) - { - access::rw(c.col_ptrs[i + 1]) += c.col_ptrs[i]; - } - - // Now that we know a decent bound on the number of nonzero elements, - // allocate the memory and fill it. - - const uword max_n_nonzero = c.col_ptrs[c.n_cols]; - - c.mem_resize(max_n_nonzero); - - // Now the implementation of the NUMBMM algorithm. - uword cur_pos = 0; // Current position in c matrix. - podarray sums(x_n_rows); // Partial sums. - sums.zeros(); - - podarray sorted_indices(x_n_rows); // upper bound - - // last_ind is already set to x_n_rows, and cur_col_length is already set to 0. - // We will loop through all columns as necessary. - uword cur_col = 0; - while(cur_col < c.n_cols) - { - // Skip to next column with elements in it. - while((cur_col < c.n_cols) && (c.col_ptrs[cur_col] == c.col_ptrs[cur_col + 1])) - { - // Update current column pointer to actual number of nonzero elements up - // to this point. - access::rw(c.col_ptrs[cur_col]) = cur_pos; - ++cur_col; - } - - if(cur_col == c.n_cols) { break; } - - // Update current column pointer. - access::rw(c.col_ptrs[cur_col]) = cur_pos; - - // Check all elements in this column. - typename SpMat::const_iterator y_col_it = y.begin_col_no_sync(cur_col); - - while(y_col_it.col() == cur_col) - { - const uword y_col_it_row = y_col_it.row(); - - // Check all elements in the column of the other matrix corresponding to - // the row of this column. - typename SpMat::const_iterator x_col_it = x.begin_col_no_sync(y_col_it_row); - - const eT y_value = (*y_col_it); - - while(x_col_it.col() == y_col_it_row) - { - const uword x_col_it_row = x_col_it.row(); - - // A point at x(i, j) and y(j, k) implies a point at c(i, k). - // Add to partial sum. - const eT x_value = (*x_col_it); - sums[x_col_it_row] += (x_value * y_value); - - // Add point if it hasn't already been marked. - if(index[x_col_it_row] == x_n_rows) - { - index[x_col_it_row] = last_ind; - last_ind = x_col_it_row; - } - - ++x_col_it; - } - - ++y_col_it; - } - - // Now sort the indices that were used in this column. - uword cur_index = 0; - while(last_ind != x_n_rows + 1) - { - const uword tmp = last_ind; - - // Check that it wasn't a "fake" nonzero element. - if(sums[tmp] != eT(0)) - { - // Assign to next open position. - sorted_indices[cur_index] = tmp; - ++cur_index; - } - - last_ind = index[tmp]; - index[tmp] = x_n_rows; - } - - // Now sort the indices. - if(cur_index != 0) - { - op_sort::direct_sort_ascending(sorted_indices.memptr(), cur_index); - - for(uword k = 0; k < cur_index; ++k) - { - const uword row = sorted_indices[k]; - access::rw(c.row_indices[cur_pos]) = row; - access::rw(c.values[cur_pos]) = sums[row]; - sums[row] = eT(0); - ++cur_pos; - } - } - - // Move to next column. - ++cur_col; - } - - // Update last column pointer and resize to actual memory size. - - // access::rw(c.col_ptrs[c.n_cols]) = cur_pos; - // c.mem_resize(cur_pos); - - access::rw(c.col_ptrs[c.n_cols]) = cur_pos; - - if(cur_pos < max_n_nonzero) { c.mem_resize(cur_pos); } - } - - - -// -// -// - - - -template -inline -void -spglue_times_mixed::apply(SpMat::eT>& out, const mtSpGlue::eT, T1, T2, spglue_times_mixed>& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT1; - typedef typename T2::elem_type eT2; - - typedef typename eT_promoter::eT out_eT; - - if( (is_same_type::no) && (is_same_type::yes) ) - { - // upgrade T1 - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - - SpMat AA(arma_layout_indicator(), A); - - for(uword i=0; i < A.n_nonzero; ++i) { access::rw(AA.values[i]) = out_eT(A.values[i]); } - - const SpMat& BB = reinterpret_cast< const SpMat& >(B); - - out = AA * BB; - } - else - if( (is_same_type::yes) && (is_same_type::no) ) - { - // upgrade T2 - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - - const SpMat& AA = reinterpret_cast< const SpMat& >(A); - - SpMat BB(arma_layout_indicator(), B); - - for(uword i=0; i < B.n_nonzero; ++i) { access::rw(BB.values[i]) = out_eT(B.values[i]); } - - out = AA * BB; - } - else - { - // upgrade T1 and T2 - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - - SpMat AA(arma_layout_indicator(), A); - SpMat BB(arma_layout_indicator(), B); - - for(uword i=0; i < A.n_nonzero; ++i) { access::rw(AA.values[i]) = out_eT(A.values[i]); } - for(uword i=0; i < B.n_nonzero; ++i) { access::rw(BB.values[i]) = out_eT(B.values[i]); } - - out = AA * BB; - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_diagmat_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_diagmat_bones.hpp deleted file mode 100644 index 41b1ae305..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_diagmat_bones.hpp +++ /dev/null @@ -1,64 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spop_diagmat -//! @{ - - -class spop_diagmat - : public traits_op_default - { - public: - - template - inline static void apply(SpMat& out, const SpOp& in); - - template - inline static void apply_noalias(SpMat& out, const SpBase& expr); - - template - inline static void apply_noalias(SpMat& out, const SpGlue& expr); - - template - inline static void apply_noalias(SpMat& out, const SpGlue& expr); - - template - inline static void apply_noalias(SpMat& out, const SpGlue& expr); - - template - inline static void apply_noalias(SpMat& out, const SpGlue& expr); - - }; - - - -class spop_diagmat2 - : public traits_op_default - { - public: - - template - inline static void apply(SpMat& out, const SpOp& in); - - template - inline static void apply_noalias(SpMat& out, const SpMat& X, const uword row_offset, const uword col_offset); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_diagmat_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_diagmat_meat.hpp deleted file mode 100644 index 85423942d..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_diagmat_meat.hpp +++ /dev/null @@ -1,456 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spop_diagmat -//! @{ - - - -template -inline -void -spop_diagmat::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(in.is_alias(out) == false) - { - spop_diagmat::apply_noalias(out, in.m); - } - else - { - SpMat tmp; - - spop_diagmat::apply_noalias(tmp, in.m); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -spop_diagmat::apply_noalias(SpMat& out, const SpBase& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const SpProxy P(expr.get_ref()); - - const uword P_n_rows = P.get_n_rows(); - const uword P_n_cols = P.get_n_cols(); - const uword P_n_nz = P.get_n_nonzero(); - - const bool P_is_vec = (P_n_rows == 1) || (P_n_cols == 1); - - if(P_is_vec) // generate a diagonal matrix out of a vector - { - const uword N = (P_n_rows == 1) ? P_n_cols : P_n_rows; - - out.zeros(N, N); - - if(P_n_nz == 0) { return; } - - typename SpProxy::const_iterator_type it = P.begin(); - - if(P_n_cols == 1) - { - for(uword i=0; i < P_n_nz; ++i) - { - const uword row = it.row(); - - out.at(row,row) = (*it); - - ++it; - } - } - else - if(P_n_rows == 1) - { - for(uword i=0; i < P_n_nz; ++i) - { - const uword col = it.col(); - - out.at(col,col) = (*it); - - ++it; - } - } - } - else // generate a diagonal matrix out of a matrix - { - out.zeros(P_n_rows, P_n_cols); - - const uword N = (std::min)(P_n_rows, P_n_cols); - - if( (is_SpMat::stored_type>::value) && (P_n_nz >= 5*N) ) - { - const unwrap_spmat::stored_type> U(P.Q); - - const SpMat& X = U.M; - - for(uword i=0; i < N; ++i) - { - const eT val = X.at(i,i); // use binary search - - if(val != eT(0)) { out.at(i,i) = val; } - } - } - else - { - if(P_n_nz == 0) { return; } - - typename SpProxy::const_iterator_type it = P.begin(); - - for(uword i=0; i < P_n_nz; ++i) - { - const uword row = it.row(); - const uword col = it.col(); - - if(row == col) { out.at(row,row) = (*it); } - - ++it; - } - } - } - } - - - -template -inline -void -spop_diagmat::apply_noalias(SpMat& out, const SpGlue& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - - arma_conform_assert_same_size(A.n_rows, A.n_cols, B.n_rows, B.n_cols, "addition"); - - const bool is_vec = (A.n_rows == 1) || (A.n_cols == 1); - - if(is_vec) // generate a diagonal matrix out of a vector - { - const uword N = (A.n_rows == 1) ? A.n_cols : A.n_rows; - - out.zeros(N,N); - - if(A.n_rows == 1) - { - for(uword i=0; i < N; ++i) { out.at(i,i) = A.at(0,i) + B.at(0,i); } - } - else - { - for(uword i=0; i < N; ++i) { out.at(i,i) = A.at(i,0) + B.at(i,0); } - } - } - else // generate a diagonal matrix out of a matrix - { - SpMat AA; spop_diagmat::apply_noalias(AA, A); - SpMat BB; spop_diagmat::apply_noalias(BB, B); - - out = AA + BB; - } - } - - - -template -inline -void -spop_diagmat::apply_noalias(SpMat& out, const SpGlue& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - - arma_conform_assert_same_size(A.n_rows, A.n_cols, B.n_rows, B.n_cols, "subtraction"); - - const bool is_vec = (A.n_rows == 1) || (A.n_cols == 1); - - if(is_vec) // generate a diagonal matrix out of a vector - { - const uword N = (A.n_rows == 1) ? A.n_cols : A.n_rows; - - out.zeros(N,N); - - if(A.n_rows == 1) - { - for(uword i=0; i < N; ++i) { out.at(i,i) = A.at(0,i) - B.at(0,i); } - } - else - { - for(uword i=0; i < N; ++i) { out.at(i,i) = A.at(i,0) - B.at(i,0); } - } - } - else // generate a diagonal matrix out of a matrix - { - SpMat AA; spop_diagmat::apply_noalias(AA, A); - SpMat BB; spop_diagmat::apply_noalias(BB, B); - - out = AA - BB; - } - } - - - -template -inline -void -spop_diagmat::apply_noalias(SpMat& out, const SpGlue& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - - arma_conform_assert_same_size(A.n_rows, A.n_cols, B.n_rows, B.n_cols, "element-wise multiplication"); - - const bool is_vec = (A.n_rows == 1) || (A.n_cols == 1); - - if(is_vec) // generate a diagonal matrix out of a vector - { - const uword N = (A.n_rows == 1) ? A.n_cols : A.n_rows; - - out.zeros(N,N); - - if(A.n_rows == 1) - { - for(uword i=0; i < N; ++i) { out.at(i,i) = A.at(0,i) * B.at(0,i); } - } - else - { - for(uword i=0; i < N; ++i) { out.at(i,i) = A.at(i,0) * B.at(i,0); } - } - } - else // generate a diagonal matrix out of a matrix - { - SpMat AA; spop_diagmat::apply_noalias(AA, A); - SpMat BB; spop_diagmat::apply_noalias(BB, B); - - out = AA % BB; - } - } - - - -template -inline -void -spop_diagmat::apply_noalias(SpMat& out, const SpGlue& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat UA(expr.A); - const unwrap_spmat UB(expr.B); - - const SpMat& A = UA.M; - const SpMat& B = UB.M; - - arma_conform_assert_mul_size(A.n_rows, A.n_cols, B.n_rows, B.n_cols, "matrix multiplication"); - - const uword C_n_rows = A.n_rows; - const uword C_n_cols = B.n_cols; - - const bool is_vec = (C_n_rows == 1) || (C_n_cols == 1); - - if(is_vec) // generate a diagonal matrix out of a vector - { - const SpMat C = A*B; - - spop_diagmat::apply_noalias(out, C); - } - else // generate a diagonal matrix out of a matrix - { - const uword N = (std::min)(C_n_rows, C_n_cols); - - if( (A.n_nonzero >= 5*N) || (B.n_nonzero >= 5*N) ) - { - out.zeros(C_n_rows, C_n_cols); - - for(uword k=0; k < N; ++k) - { - typename SpMat::const_col_iterator B_it = B.begin_col_no_sync(k); - typename SpMat::const_col_iterator B_it_end = B.end_col_no_sync(k); - - eT acc = eT(0); - - while(B_it != B_it_end) - { - const eT B_val = (*B_it); - const uword i = B_it.row(); - - acc += A.at(k,i) * B_val; - - ++B_it; - } - - out(k,k) = acc; - } - } - else - { - const SpMat C = A*B; - - spop_diagmat::apply_noalias(out, C); - } - } - } - - - -// -// - - - -template -inline -void -spop_diagmat2::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword row_offset = in.aux_uword_a; - const uword col_offset = in.aux_uword_b; - - const unwrap_spmat U(in.m); - - if(U.is_alias(out)) - { - SpMat tmp; - - spop_diagmat2::apply_noalias(tmp, U.M, row_offset, col_offset); - - out.steal_mem(tmp); - } - else - { - spop_diagmat2::apply_noalias(out, U.M, row_offset, col_offset); - } - } - - - -template -inline -void -spop_diagmat2::apply_noalias(SpMat& out, const SpMat& X, const uword row_offset, const uword col_offset) - { - arma_debug_sigprint(); - - const uword n_rows = X.n_rows; - const uword n_cols = X.n_cols; - const uword n_elem = X.n_elem; - - if(n_elem == 0) { out.reset(); return; } - - const bool X_is_vec = (n_rows == 1) || (n_cols == 1); - - if(X_is_vec) // generate a diagonal matrix out of a vector - { - const uword n_pad = (std::max)(row_offset, col_offset); - - out.zeros(n_elem + n_pad, n_elem + n_pad); - - const uword X_n_nz = X.n_nonzero; - - if(X_n_nz == 0) { return; } - - typename SpMat::const_iterator it = X.begin(); - - if(n_cols == 1) - { - for(uword i=0; i < X_n_nz; ++i) - { - const uword row = it.row(); - - out.at(row_offset + row, col_offset + row) = (*it); - - ++it; - } - } - else - if(n_rows == 1) - { - for(uword i=0; i < X_n_nz; ++i) - { - const uword col = it.col(); - - out.at(row_offset + col, col_offset + col) = (*it); - - ++it; - } - } - } - else // generate a diagonal matrix out of a matrix - { - arma_conform_check_bounds - ( - ((row_offset > 0) && (row_offset >= n_rows)) || ((col_offset > 0) && (col_offset >= n_cols)), - "diagmat(): requested diagonal out of bounds" - ); - - out.zeros(n_rows, n_cols); - - if(X.n_nonzero == 0) { return; } - - const uword N = (std::min)(n_rows - row_offset, n_cols - col_offset); - - for(uword i=0; i - struct traits - { - static constexpr bool is_row = T1::is_col; // deliberately swapped - static constexpr bool is_col = T1::is_row; - static constexpr bool is_xvec = T1::is_xvec; - }; - - template - inline static void apply(SpMat& out, const SpOp& in, const typename arma_not_cx::result* junk = nullptr); - - template - inline static void apply(SpMat& out, const SpOp& in, const typename arma_cx_only::result* junk = nullptr); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_htrans_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_htrans_meat.hpp deleted file mode 100644 index 108207fe3..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_htrans_meat.hpp +++ /dev/null @@ -1,61 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spop_htrans -//! @{ - - - -template -inline -void -spop_htrans::apply(SpMat& out, const SpOp& in, const typename arma_not_cx::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - spop_strans::apply(out, in); - } - - - -template -inline -void -spop_htrans::apply(SpMat& out, const SpOp& in, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename T1::elem_type eT; - - spop_strans::apply(out, in); - - const uword N = out.n_nonzero; - - for(uword i=0; i - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -class spop_cx_scalar_times - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat< std::complex >& out, const mtSpOp< std::complex, T1, spop_cx_scalar_times>& in); - }; - - - -class spop_square - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -class spop_sqrt - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -class spop_cbrt - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -class spop_abs - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -class spop_cx_abs - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const mtSpOp& in); - }; - - - -class spop_arg - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -class spop_cx_arg - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const mtSpOp& in); - }; - - - -class spop_real - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const mtSpOp& in); - }; - - - -class spop_imag - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const mtSpOp& in); - }; - - - -class spop_conj - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -class spop_repelem - : public traits_op_default - { - public: - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -class spop_reshape - : public traits_op_default - { - public: - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -class spop_resize - : public traits_op_default - { - public: - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -class spop_floor - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -class spop_ceil - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -class spop_round - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -class spop_trunc - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -class spop_sign - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -class spop_flipud - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -class spop_fliplr - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_misc_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_misc_meat.hpp deleted file mode 100644 index 3560ffce8..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_misc_meat.hpp +++ /dev/null @@ -1,557 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spop_misc -//! @{ - - - -namespace priv - { - template - struct functor_scalar_times - { - const eT k; - - functor_scalar_times(const eT in_k) : k(in_k) {} - - arma_inline eT operator()(const eT val) const { return val * k; } - }; - } - - - -template -inline -void -spop_scalar_times::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(in.aux != eT(0)) - { - out.init_xform(in.m, priv::functor_scalar_times(in.aux)); - } - else - { - const SpProxy P(in.m); - - out.zeros( P.get_n_rows(), P.get_n_cols() ); - } - } - - - -namespace priv - { - template - struct functor_cx_scalar_times - { - typedef std::complex out_eT; - - const out_eT k; - - functor_cx_scalar_times(const out_eT in_k) : k(in_k) {} - - arma_inline out_eT operator()(const T val) const { return val * k; } - }; - } - - - -template -inline -void -spop_cx_scalar_times::apply(SpMat< std::complex >& out, const mtSpOp< std::complex, T1, spop_cx_scalar_times >& in) - { - arma_debug_sigprint(); - - typedef typename T1::pod_type T; - typedef typename std::complex out_eT; - - if(in.aux_out_eT != out_eT(0)) - { - out.init_xform_mt(in.m, priv::functor_cx_scalar_times(in.aux_out_eT)); - } - else - { - const SpProxy P(in.m); - - out.zeros( P.get_n_rows(), P.get_n_cols() ); - } - } - - - -namespace priv - { - struct functor_square - { - template - arma_inline eT operator()(const eT val) const { return val*val; } - }; - } - - - -template -inline -void -spop_square::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - out.init_xform(in.m, priv::functor_square()); - } - - - -namespace priv - { - struct functor_sqrt - { - template - arma_inline eT operator()(const eT val) const { return eop_aux::sqrt(val); } - }; - } - - - -template -inline -void -spop_sqrt::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - out.init_xform(in.m, priv::functor_sqrt()); - } - - - -namespace priv - { - struct functor_cbrt - { - template - arma_inline eT operator()(const eT val) const { return eop_aux::cbrt(val); } - }; - } - - - -template -inline -void -spop_cbrt::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - out.init_xform(in.m, priv::functor_cbrt()); - } - - - -namespace priv - { - struct functor_abs - { - template - arma_inline eT operator()(const eT val) const { return eop_aux::arma_abs(val); } - }; - } - - - -template -inline -void -spop_abs::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - out.init_xform(in.m, priv::functor_abs()); - } - - - -namespace priv - { - struct functor_cx_abs - { - template - arma_inline T operator()(const std::complex& val) const { return std::abs(val); } - }; - } - - - -template -inline -void -spop_cx_abs::apply(SpMat& out, const mtSpOp& in) - { - arma_debug_sigprint(); - - out.init_xform_mt(in.m, priv::functor_cx_abs()); - } - - - -namespace priv - { - struct functor_arg - { - template - arma_inline eT operator()(const eT val) const { return arma_arg::eval(val); } - }; - } - - - -template -inline -void -spop_arg::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - out.init_xform(in.m, priv::functor_arg()); - } - - - -namespace priv - { - struct functor_cx_arg - { - template - arma_inline T operator()(const std::complex& val) const { return std::arg(val); } - }; - } - - - -template -inline -void -spop_cx_arg::apply(SpMat& out, const mtSpOp& in) - { - arma_debug_sigprint(); - - out.init_xform_mt(in.m, priv::functor_cx_arg()); - } - - - -namespace priv - { - struct functor_real - { - template - arma_inline T operator()(const std::complex& val) const { return val.real(); } - }; - } - - - -template -inline -void -spop_real::apply(SpMat& out, const mtSpOp& in) - { - arma_debug_sigprint(); - - out.init_xform_mt(in.m, priv::functor_real()); - } - - - -namespace priv - { - struct functor_imag - { - template - arma_inline T operator()(const std::complex& val) const { return val.imag(); } - }; - } - - - -template -inline -void -spop_imag::apply(SpMat& out, const mtSpOp& in) - { - arma_debug_sigprint(); - - out.init_xform_mt(in.m, priv::functor_imag()); - } - - - -namespace priv - { - struct functor_conj - { - template - arma_inline eT operator()(const eT val) const { return eop_aux::conj(val); } - }; - } - - - -template -inline -void -spop_conj::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - out.init_xform(in.m, priv::functor_conj()); - } - - - -template -inline -void -spop_repelem::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat U(in.m); - const SpMat& X = U.M; - - const uword copies_per_row = in.aux_uword_a; - const uword copies_per_col = in.aux_uword_b; - - const uword out_n_rows = X.n_rows * copies_per_row; - const uword out_n_cols = X.n_cols * copies_per_col; - const uword out_nnz = X.n_nonzero * copies_per_row * copies_per_col; - - if( (out_n_rows > 0) && (out_n_cols > 0) && (out_nnz > 0) ) - { - Mat locs(2, out_nnz, arma_nozeros_indicator()); - Col vals( out_nnz, arma_nozeros_indicator()); - - uword* locs_mem = locs.memptr(); - eT* vals_mem = vals.memptr(); - - typename SpMat::const_iterator X_it = X.begin(); - typename SpMat::const_iterator X_end = X.end(); - - for(; X_it != X_end; ++X_it) - { - const uword col_base = copies_per_col * X_it.col(); - const uword row_base = copies_per_row * X_it.row(); - - const eT X_val = (*X_it); - - for(uword cols = 0; cols < copies_per_col; cols++) - for(uword rows = 0; rows < copies_per_row; rows++) - { - (*locs_mem) = row_base + rows; ++locs_mem; - (*locs_mem) = col_base + cols; ++locs_mem; - - (*vals_mem) = X_val; ++vals_mem; - } - } - - out = SpMat(locs, vals, out_n_rows, out_n_cols); - } - else - { - out.zeros(out_n_rows, out_n_cols); - } - } - - - -template -inline -void -spop_reshape::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - out = in.m; - - out.reshape(in.aux_uword_a, in.aux_uword_b); - } - - - -template -inline -void -spop_resize::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - out = in.m; - - out.resize(in.aux_uword_a, in.aux_uword_b); - } - - - -namespace priv - { - struct functor_floor - { - template - arma_inline eT operator()(const eT val) const { return eop_aux::floor(val); } - }; - } - - - -template -inline -void -spop_floor::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - out.init_xform(in.m, priv::functor_floor()); - } - - - -namespace priv - { - struct functor_ceil - { - template - arma_inline eT operator()(const eT val) const { return eop_aux::ceil(val); } - }; - } - - - -template -inline -void -spop_ceil::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - out.init_xform(in.m, priv::functor_ceil()); - } - - - -namespace priv - { - struct functor_round - { - template - arma_inline eT operator()(const eT val) const { return eop_aux::round(val); } - }; - } - - - -template -inline -void -spop_round::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - out.init_xform(in.m, priv::functor_round()); - } - - - -namespace priv - { - struct functor_trunc - { - template - arma_inline eT operator()(const eT val) const { return eop_aux::trunc(val); } - }; - } - - - -template -inline -void -spop_trunc::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - out.init_xform(in.m, priv::functor_trunc()); - } - - - -namespace priv - { - struct functor_sign - { - template - arma_inline eT operator()(const eT val) const { return arma_sign(val); } - }; - } - - - -template -inline -void -spop_sign::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - out.init_xform(in.m, priv::functor_sign()); - } - - - -template -inline -void -spop_flipud::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - out = reverse(in.m, 0); - } - - - -template -inline -void -spop_fliplr::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - out = reverse(in.m, 1); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_norm_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_norm_bones.hpp deleted file mode 100644 index 1d9445182..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_norm_bones.hpp +++ /dev/null @@ -1,39 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spop_norm -//! @{ - - -class spop_norm - : public traits_op_default - { - public: - - template inline static typename get_pod_type::result mat_norm_1(const SpMat& X); - - template inline static typename get_pod_type::result mat_norm_2(const SpMat& X, const typename arma_real_only::result* junk = nullptr); - template inline static typename get_pod_type::result mat_norm_2(const SpMat& X, const typename arma_cx_only::result* junk = nullptr); - - template inline static typename get_pod_type::result mat_norm_inf(const SpMat& X); - - template inline static typename get_pod_type::result vec_norm_k(const eT* mem, const uword N, const uword k); - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_norm_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_norm_meat.hpp deleted file mode 100644 index 517c0da83..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_norm_meat.hpp +++ /dev/null @@ -1,135 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup op_norm -//! @{ - - - -template -inline -typename get_pod_type::result -spop_norm::mat_norm_1(const SpMat& X) - { - arma_debug_sigprint(); - - // TODO: this can be sped up with a dedicated implementation - return as_scalar( max( sum(abs(X), 0), 1) ); - } - - - -template -inline -typename get_pod_type::result -spop_norm::mat_norm_2(const SpMat& X, const typename arma_real_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - // norm = sqrt( largest eigenvalue of (A^H)*A ), where ^H is the conjugate transpose - // http://math.stackexchange.com/questions/4368/computing-the-largest-eigenvalue-of-a-very-large-sparse-matrix - - typedef typename get_pod_type::result T; - - const SpMat& A = X; - const SpMat B = trans(A); - - const SpMat C = (A.n_rows <= A.n_cols) ? (A*B) : (B*A); - - Col eigval; - - eigs_sym(eigval, C, 1); - - const T out_square_val = (eigval.n_elem > 0) ? T(eigval[0]) : T(0); - - return (out_square_val <= T(0)) ? T(0) : T(std::sqrt(out_square_val)); - } - - - -template -inline -typename get_pod_type::result -spop_norm::mat_norm_2(const SpMat& X, const typename arma_cx_only::result* junk) - { - arma_debug_sigprint(); - arma_ignore(junk); - - typedef typename get_pod_type::result T; - - // we're calling eigs_gen(), which currently requires ARPACK - #if !defined(ARMA_USE_ARPACK) - { - arma_stop_logic_error("norm(): use of ARPACK must be enabled for norm of complex matrices"); - return T(0); - } - #endif - - const SpMat& A = X; - const SpMat B = trans(A); - - const SpMat C = (A.n_rows <= A.n_cols) ? (A*B) : (B*A); - - Col eigval; - - eigs_gen(eigval, C, 1); - - const T out_square_val = (eigval.n_elem > 0) ? T(std::real(eigval[0])) : T(0); - - return (out_square_val <= T(0)) ? T(0) : T(std::sqrt(out_square_val)); - } - - - -template -inline -typename get_pod_type::result -spop_norm::mat_norm_inf(const SpMat& X) - { - arma_debug_sigprint(); - - // TODO: this can be sped up with a dedicated implementation - return as_scalar( max( sum(abs(X), 1), 0) ); - } - - - -template -inline -typename get_pod_type::result -spop_norm::vec_norm_k(const eT* mem, const uword N, const uword k) - { - arma_debug_sigprint(); - - arma_conform_check( (k == 0), "norm(): unsupported vector norm type" ); - - // create a fake dense vector to allow reuse of code for dense vectors - Col fake_vector( access::rwp(mem), N, false ); - - const Proxy< Col > P_fake_vector(fake_vector); - - if(k == uword(1)) { return op_norm::vec_norm_1(P_fake_vector); } - if(k == uword(2)) { return op_norm::vec_norm_2(P_fake_vector); } - - return op_norm::vec_norm_k(P_fake_vector, int(k)); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_normalise_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_normalise_bones.hpp deleted file mode 100644 index 839b9ca7a..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_normalise_bones.hpp +++ /dev/null @@ -1,37 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spop_normalise -//! @{ - - -class spop_normalise - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const SpOp& expr); - - template - inline static void apply_direct(SpMat& out, const SpMat& X, const uword p); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_normalise_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_normalise_meat.hpp deleted file mode 100644 index d580a5f8c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_normalise_meat.hpp +++ /dev/null @@ -1,133 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spop_normalise -//! @{ - - - -template -inline -void -spop_normalise::apply(SpMat& out, const SpOp& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const uword p = expr.aux_uword_a; - const uword dim = expr.aux_uword_b; - - arma_conform_check( (p == 0), "normalise(): unsupported vector norm type" ); - arma_conform_check( (dim > 1), "normalise(): parameter 'dim' must be 0 or 1" ); - - const unwrap_spmat U(expr.m); - - const SpMat& X = U.M; - - X.sync(); - - if( X.is_empty() || (X.n_nonzero == 0) ) { out.zeros(X.n_rows, X.n_cols); return; } - - if(dim == 0) - { - spop_normalise::apply_direct(out, X, p); - } - else - if(dim == 1) - { - SpMat tmp1; - SpMat tmp2; - - spop_strans::apply_noalias(tmp1, X); - - spop_normalise::apply_direct(tmp2, tmp1, p); - - spop_strans::apply_noalias(out, tmp2); - } - } - - - -template -inline -void -spop_normalise::apply_direct(SpMat& out, const SpMat& X, const uword p) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - SpMat tmp(arma_reserve_indicator(), X.n_rows, X.n_cols, X.n_nonzero); - - bool has_zero = false; - - podarray norm_vals(X.n_cols); - - T* norm_vals_mem = norm_vals.memptr(); - - for(uword col=0; col < X.n_cols; ++col) - { - const uword col_offset = X.col_ptrs[col ]; - const uword next_col_offset = X.col_ptrs[col + 1]; - - const eT* start_ptr = &X.values[ col_offset]; - const eT* end_ptr = &X.values[next_col_offset]; - - const uword n_elem = end_ptr - start_ptr; - - const Col fake_vec(const_cast(start_ptr), n_elem, false, false); - - const T norm_val = norm(fake_vec, p); - - norm_vals_mem[col] = (norm_val != T(0)) ? norm_val : T(1); - } - - const uword N = X.n_nonzero; - - typename SpMat::const_iterator it = X.begin(); - - for(uword i=0; i < N; ++i) - { - const uword row = it.row(); - const uword col = it.col(); - - const eT val = (*it) / norm_vals_mem[col]; - - if(val == eT(0)) { has_zero = true; } - - access::rw(tmp.values[i]) = val; - access::rw(tmp.row_indices[i]) = row; - access::rw(tmp.col_ptrs[col + 1])++; - - ++it; - } - - for(uword c=0; c < tmp.n_cols; ++c) - { - access::rw(tmp.col_ptrs[c + 1]) += tmp.col_ptrs[c]; - } - - if(has_zero) { tmp.remove_zeros(); } - - out.steal_mem(tmp); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_relational_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_relational_bones.hpp deleted file mode 100644 index 780475f4b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_relational_bones.hpp +++ /dev/null @@ -1,134 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spop_relational -//! @{ - - - -class spop_rel_lt_pre - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const mtSpOp& X); - }; - - - -class spop_rel_lt_post - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const mtSpOp& X); - }; - - - -class spop_rel_gt_pre - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const mtSpOp& X); - }; - - - -class spop_rel_gt_post - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const mtSpOp& X); - }; - - - -class spop_rel_lteq_pre - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const mtSpOp& X); - }; - - - -class spop_rel_lteq_post - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const mtSpOp& X); - }; - - - -class spop_rel_gteq_pre - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const mtSpOp& X); - }; - - - -class spop_rel_gteq_post - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const mtSpOp& X); - }; - - - -class spop_rel_eq - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const mtSpOp& X); - }; - - - -class spop_rel_noteq - : public traits_op_passthru - { - public: - - template - inline static void apply(SpMat& out, const mtSpOp& X); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_relational_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_relational_meat.hpp deleted file mode 100644 index 2c4a920e8..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_relational_meat.hpp +++ /dev/null @@ -1,521 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spop_relational -//! @{ - -// NOTE: in general, relational operations between sparse matrices and scalars -// NOTE: have the risk of producing sparse matrices with most elements as non-zeros. -// NOTE: these operations should only be used as an argument to the accu() function, -// NOTE: which aims to omit the generation of intermediate sparse matrices. - - -#undef operator_rel - -#undef arma_applier_spmat_pre -#undef arma_applier_spmat_post - - -#define arma_applier_spmat_pre(operator_rel)\ - {\ - const uword zero_comp_val = (k operator_rel eT(0)) ? uword(1) : uword(0);\ - \ - const uword n_cols = A.n_cols;\ - const uword n_rows = A.n_rows;\ - const uword n_elem = A.n_elem;\ - \ - Mat tmp(n_rows, n_cols);\ - \ - typename SpMat::const_iterator it = A.begin();\ - typename SpMat::const_iterator it_end = A.end();\ - \ - uword last_pos = 0;\ - uword offset = 0;\ - \ - for(; it != it_end; ++it)\ - {\ - const uword cur_pos = it.row() + n_rows * it.col();\ - \ - if((cur_pos - last_pos) > offset)\ - {\ - arrayops::inplace_set( (tmp.memptr() + last_pos + offset), zero_comp_val, (cur_pos - last_pos - offset) );\ - }\ - \ - tmp.at(cur_pos) = (k operator_rel (*it)) ? uword(1) : uword(0);\ - \ - last_pos = cur_pos;\ - offset = 1;\ - }\ - \ - if(last_pos < n_elem)\ - {\ - arrayops::inplace_set( (tmp.memptr() + last_pos + offset), zero_comp_val, (n_elem - last_pos - offset) );\ - }\ - \ - out = tmp;\ - } - - - -#define arma_applier_spmat_post(operator_rel)\ - {\ - const uword zero_comp_val = (eT(0) operator_rel k) ? uword(1) : uword(0);\ - \ - const uword n_cols = A.n_cols;\ - const uword n_rows = A.n_rows;\ - const uword n_elem = A.n_elem;\ - \ - Mat tmp(n_rows, n_cols);\ - \ - typename SpMat::const_iterator it = A.begin();\ - typename SpMat::const_iterator it_end = A.end();\ - \ - uword last_pos = 0;\ - uword offset = 0;\ - \ - for(; it != it_end; ++it)\ - {\ - const uword cur_pos = it.row() + n_rows * it.col();\ - \ - if((cur_pos - last_pos) > offset)\ - {\ - arrayops::inplace_set( (tmp.memptr() + last_pos + offset), zero_comp_val, (cur_pos - last_pos - offset) );\ - }\ - \ - tmp.at(cur_pos) = ((*it) operator_rel k) ? uword(1) : uword(0);\ - \ - last_pos = cur_pos;\ - offset = 1;\ - }\ - \ - if(last_pos < n_elem)\ - {\ - arrayops::inplace_set( (tmp.memptr() + last_pos + offset), zero_comp_val, (n_elem - last_pos - offset) );\ - }\ - \ - out = tmp;\ - } - - - -template -inline -void -spop_rel_lt_pre::apply(SpMat& out, const mtSpOp& X) - { - arma_debug_sigprint(); - - // operation: scalar < spmat - - typedef typename T1::elem_type eT; - - const eT k = X.aux; - - const unwrap_spmat U(X.m); - const SpMat& A = U.M; - - if(k > eT(0)) - { - arma_debug_print("optimisation: k > 0"); - - SpMat tmp(A.n_rows, A.n_cols); - - typename SpMat::const_iterator it = A.begin(); - typename SpMat::const_iterator it_end = A.end(); - - for(; it != it_end; ++it) - { - if( k < (*it) ) { tmp.at(it.row(), it.col()) = uword(1); } - } - - out.steal_mem(tmp); - } - else - { - arma_applier_spmat_pre( < ); - } - } - - - -template -inline -void -spop_rel_gt_pre::apply(SpMat& out, const mtSpOp& X) - { - arma_debug_sigprint(); - - // operation: scalar > spmat - - typedef typename T1::elem_type eT; - - const eT k = X.aux; - - const unwrap_spmat U(X.m); - const SpMat& A = U.M; - - if(k < eT(0)) - { - arma_debug_print("optimisation: k < 0"); - - SpMat tmp(A.n_rows, A.n_cols); - - typename SpMat::const_iterator it = A.begin(); - typename SpMat::const_iterator it_end = A.end(); - - for(; it != it_end; ++it) - { - if( k > (*it) ) { tmp.at(it.row(), it.col()) = uword(1); } - } - - out.steal_mem(tmp); - } - else - { - arma_applier_spmat_pre( > ); - } - } - - - -template -inline -void -spop_rel_lteq_pre::apply(SpMat& out, const mtSpOp& X) - { - arma_debug_sigprint(); - - // operation: scalar <= spmat - - typedef typename T1::elem_type eT; - - const eT k = X.aux; - - const unwrap_spmat U(X.m); - const SpMat& A = U.M; - - if(k > eT(0)) - { - arma_debug_print("optimisation: k > 0"); - - SpMat tmp(A.n_rows, A.n_cols); - - typename SpMat::const_iterator it = A.begin(); - typename SpMat::const_iterator it_end = A.end(); - - for(; it != it_end; ++it) - { - if( k <= (*it) ) { tmp.at(it.row(), it.col()) = uword(1); } - } - - out.steal_mem(tmp); - } - else - { - arma_applier_spmat_pre( <= ); - } - } - - - -template -inline -void -spop_rel_gteq_pre::apply(SpMat& out, const mtSpOp& X) - { - arma_debug_sigprint(); - - // operation: scalar >= spmat - - typedef typename T1::elem_type eT; - - const eT k = X.aux; - - const unwrap_spmat U(X.m); - const SpMat& A = U.M; - - if(k < eT(0)) - { - arma_debug_print("optimisation: k < 0"); - - SpMat tmp(A.n_rows, A.n_cols); - - typename SpMat::const_iterator it = A.begin(); - typename SpMat::const_iterator it_end = A.end(); - - for(; it != it_end; ++it) - { - if( k >= (*it) ) { tmp.at(it.row(), it.col()) = uword(1); } - } - - out.steal_mem(tmp); - } - else - { - arma_applier_spmat_pre( >= ); - } - } - - - -template -inline -void -spop_rel_lt_post::apply(SpMat& out, const mtSpOp& X) - { - arma_debug_sigprint(); - - // operation: spmat < scalar - - typedef typename T1::elem_type eT; - - const eT k = X.aux; - - const unwrap_spmat U(X.m); - const SpMat& A = U.M; - - if(k < eT(0)) - { - arma_debug_print("optimisation: k < 0"); - - SpMat tmp(A.n_rows, A.n_cols); - - typename SpMat::const_iterator it = A.begin(); - typename SpMat::const_iterator it_end = A.end(); - - for(; it != it_end; ++it) - { - if( (*it) < k ) { tmp.at(it.row(), it.col()) = uword(1); } - } - - out.steal_mem(tmp); - } - else - { - arma_applier_spmat_post( < ); - } - } - - - -template -inline -void -spop_rel_gt_post::apply(SpMat& out, const mtSpOp& X) - { - arma_debug_sigprint(); - - // operation: spmat > scalar - - typedef typename T1::elem_type eT; - - const eT k = X.aux; - - const unwrap_spmat U(X.m); - const SpMat& A = U.M; - - if(k > eT(0)) - { - arma_debug_print("optimisation: k > 0"); - - SpMat tmp(A.n_rows, A.n_cols); - - typename SpMat::const_iterator it = A.begin(); - typename SpMat::const_iterator it_end = A.end(); - - for(; it != it_end; ++it) - { - if( (*it) > k ) { tmp.at(it.row(), it.col()) = uword(1); } - } - - out.steal_mem(tmp); - } - else - { - arma_applier_spmat_post( > ); - } - } - - - -template -inline -void -spop_rel_lteq_post::apply(SpMat& out, const mtSpOp& X) - { - arma_debug_sigprint(); - - // operation: spmat <= scalar - - typedef typename T1::elem_type eT; - - const eT k = X.aux; - - const unwrap_spmat U(X.m); - const SpMat& A = U.M; - - if(k < eT(0)) - { - arma_debug_print("optimisation: k < 0"); - - SpMat tmp(A.n_rows, A.n_cols); - - typename SpMat::const_iterator it = A.begin(); - typename SpMat::const_iterator it_end = A.end(); - - for(; it != it_end; ++it) - { - if( (*it) <= k ) { tmp.at(it.row(), it.col()) = uword(1); } - } - - out.steal_mem(tmp); - } - else - { - arma_applier_spmat_post( <= ); - } - } - - - -template -inline -void -spop_rel_gteq_post::apply(SpMat& out, const mtSpOp& X) - { - arma_debug_sigprint(); - - // operation: spmat >= scalar - - typedef typename T1::elem_type eT; - - const eT k = X.aux; - - const unwrap_spmat U(X.m); - const SpMat& A = U.M; - - if(k > eT(0)) - { - arma_debug_print("optimisation: k > 0"); - - SpMat tmp(A.n_rows, A.n_cols); - - typename SpMat::const_iterator it = A.begin(); - typename SpMat::const_iterator it_end = A.end(); - - for(; it != it_end; ++it) - { - if( (*it) >= k ) { tmp.at(it.row(), it.col()) = uword(1); } - } - - out.steal_mem(tmp); - } - else - { - arma_applier_spmat_post( >= ); - } - } - - - -template -inline -void -spop_rel_eq::apply(SpMat& out, const mtSpOp& X) - { - arma_debug_sigprint(); - - // operation: spmat == scalar - - typedef typename T1::elem_type eT; - - const eT k = X.aux; - - const unwrap_spmat U(X.m); - const SpMat& A = U.M; - - if(k != eT(0)) - { - arma_debug_print("optimisation: k != 0"); - - SpMat tmp(A.n_rows, A.n_cols); - - typename SpMat::const_iterator it = A.begin(); - typename SpMat::const_iterator it_end = A.end(); - - for(; it != it_end; ++it) - { - if( (*it) == k ) { tmp.at(it.row(), it.col()) = uword(1); } - } - - out.steal_mem(tmp); - } - else - { - arma_applier_spmat_post( == ); - } - } - - - -template -inline -void -spop_rel_noteq::apply(SpMat& out, const mtSpOp& X) - { - arma_debug_sigprint(); - - // operation: spmat != scalar - - typedef typename T1::elem_type eT; - - const eT k = X.aux; - - const unwrap_spmat U(X.m); - const SpMat& A = U.M; - - if(k == eT(0)) - { - arma_debug_print("optimisation: k = 0"); - - SpMat tmp(A.n_rows, A.n_cols); - - typename SpMat::const_iterator it = A.begin(); - typename SpMat::const_iterator it_end = A.end(); - - for(; it != it_end; ++it) - { - tmp.at(it.row(), it.col()) = uword(1); - } - - out.steal_mem(tmp); - } - else - { - arma_applier_spmat_post( != ); - } - } - - - -#undef arma_applier_spmat_pre -#undef arma_applier_spmat_post - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_repmat_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_repmat_bones.hpp deleted file mode 100644 index 7ee684322..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_repmat_bones.hpp +++ /dev/null @@ -1,41 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spop_repmat -//! @{ - - - -class spop_repmat - : public traits_op_default - { - public: - - template - inline static void apply(SpMat& out, const SpOp& X); - - template - inline static void apply_noalias(SpMat& out, const uword A_n_rows, const uword A_n_cols, const SpMat& B); - }; - - - -//! @} - - - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_repmat_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_repmat_meat.hpp deleted file mode 100644 index ad8109377..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_repmat_meat.hpp +++ /dev/null @@ -1,166 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spop_repmat -//! @{ - - - -template -inline -void -spop_repmat::apply(SpMat& out, const SpOp& X) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat U(X.m); - - if(U.is_alias(out)) - { - SpMat tmp; - - spop_repmat::apply_noalias(tmp, X.aux_uword_a, X.aux_uword_b, U.M); - - out.steal_mem(tmp); - } - else - { - spop_repmat::apply_noalias(out, X.aux_uword_a, X.aux_uword_b, U.M); - } - } - - - -template -inline -void -spop_repmat::apply_noalias(SpMat& out, const uword A_n_rows, const uword A_n_cols, const SpMat& B) - { - arma_debug_sigprint(); - - const uword B_n_rows = B.n_rows; - const uword B_n_cols = B.n_cols; - - const uword out_n_nonzero = A_n_rows * A_n_cols * B.n_nonzero; - - out.reserve(A_n_rows * B_n_rows, A_n_cols * B_n_cols, out_n_nonzero); - - if(out_n_nonzero == 0) { return; } - - access::rw(out.col_ptrs[0]) = 0; - - uword count = 0; - - for(uword A_col=0; A_col < A_n_cols; ++A_col) - for(uword B_col=0; B_col < B_n_cols; ++B_col) - { - for(uword A_row=0; A_row < A_n_rows; ++A_row) - { - const uword out_row = A_row * B_n_rows; - - for(uword B_i = B.col_ptrs[B_col]; B_i < B.col_ptrs[B_col+1]; ++B_i) - { - access::rw(out.values[count]) = B.values[B_i]; - access::rw(out.row_indices[count]) = out_row + B.row_indices[B_i]; - - count++; - } - } - - access::rw(out.col_ptrs[A_col * B_n_cols + B_col + 1]) = count; - } - } - - - -// template -// inline -// void -// spop_repmat::apply(SpMat& out, const SpOp& in) -// { -// arma_debug_sigprint(); -// -// typedef typename T1::elem_type eT; -// -// const unwrap_spmat U(in.m); -// const SpMat& X = U.M; -// -// const uword X_n_rows = X.n_rows; -// const uword X_n_cols = X.n_cols; -// -// const uword copies_per_row = in.aux_uword_a; -// const uword copies_per_col = in.aux_uword_b; -// -// // out.set_size(X_n_rows * copies_per_row, X_n_cols * copies_per_col); -// // -// // const uword out_n_rows = out.n_rows; -// // const uword out_n_cols = out.n_cols; -// // -// // if( (out_n_rows > 0) && (out_n_cols > 0) ) -// // { -// // for(uword col = 0; col < out_n_cols; col += X_n_cols) -// // for(uword row = 0; row < out_n_rows; row += X_n_rows) -// // { -// // out.submat(row, col, row+X_n_rows-1, col+X_n_cols-1) = X; -// // } -// // } -// -// const uword out_n_rows = X_n_rows * copies_per_row; -// const uword out_n_cols = X_n_cols * copies_per_col; -// const uword out_nnz = X.n_nonzero * copies_per_row * copies_per_col; -// -// if( (out_n_rows > 0) && (out_n_cols > 0) && (out_nnz > 0) ) -// { -// umat locs(2, out_nnz, arma_nozeros_indicator()); -// Col vals( out_nnz, arma_nozeros_indicator()); -// -// uword* locs_mem = locs.memptr(); -// eT* vals_mem = vals.memptr(); -// -// typename SpMat::const_iterator X_begin = X.begin(); -// typename SpMat::const_iterator X_end = X.end(); -// typename SpMat::const_iterator X_it; -// -// for(uword col_offset = 0; col_offset < out_n_cols; col_offset += X_n_cols) -// for(uword row_offset = 0; row_offset < out_n_rows; row_offset += X_n_rows) -// { -// for(X_it = X_begin; X_it != X_end; ++X_it) -// { -// const uword out_row = row_offset + X_it.row(); -// const uword out_col = col_offset + X_it.col(); -// -// (*locs_mem) = out_row; ++locs_mem; -// (*locs_mem) = out_col; ++locs_mem; -// -// (*vals_mem) = (*X_it); ++vals_mem; -// } -// } -// -// out = SpMat(locs, vals, out_n_rows, out_n_cols); -// } -// else -// { -// out.zeros(out_n_rows, out_n_cols); -// } -// } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_reverse_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_reverse_bones.hpp deleted file mode 100644 index 3ea80b6e4..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_reverse_bones.hpp +++ /dev/null @@ -1,40 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spop_reverse -//! @{ - - -class spop_reverse - : public traits_op_passthru - { - public: - - template - inline static void apply_spmat(SpMat& out, const SpMat& X, const uword dim); - - template - inline static void apply_proxy(SpMat& out, const T1& X, const uword dim); - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_reverse_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_reverse_meat.hpp deleted file mode 100644 index 5f8888745..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_reverse_meat.hpp +++ /dev/null @@ -1,185 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spop_reverse -//! @{ - - - -template -inline -void -spop_reverse::apply_spmat(SpMat& out, const SpMat& X, const uword dim) - { - arma_debug_sigprint(); - - const uword X_n_rows = X.n_rows; - const uword X_n_cols = X.n_cols; - - const uword X_n_rows_m1 = X_n_rows - 1; - const uword X_n_cols_m1 = X_n_cols - 1; - - const uword N = X.n_nonzero; - - if(N == uword(0)) - { - out.zeros(X_n_rows, X_n_cols); - return; - } - - umat locs(2, N, arma_nozeros_indicator()); - - uword* locs_mem = locs.memptr(); - - typename SpMat::const_iterator it = X.begin(); - - if(dim == 0) - { - for(uword i=0; i < N; ++i) - { - const uword row = it.row(); - const uword col = it.col(); - - (*locs_mem) = X_n_rows_m1 - row; locs_mem++; - (*locs_mem) = col; locs_mem++; - - ++it; - } - } - else - if(dim == 1) - { - for(uword i=0; i < N; ++i) - { - const uword row = it.row(); - const uword col = it.col(); - - (*locs_mem) = row; locs_mem++; - (*locs_mem) = X_n_cols_m1 - col; locs_mem++; - - ++it; - } - } - - const Col vals(const_cast(X.values), N, false); - - SpMat tmp(locs, vals, X_n_rows, X_n_cols, true, false); - - out.steal_mem(tmp); - } - - - -template -inline -void -spop_reverse::apply_proxy(SpMat& out, const T1& X, const uword dim) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const SpProxy P(X); - - const uword P_n_rows = P.get_n_rows(); - const uword P_n_cols = P.get_n_cols(); - - const uword P_n_rows_m1 = P_n_rows - 1; - const uword P_n_cols_m1 = P_n_cols - 1; - - const uword N = P.get_n_nonzero(); - - if(N == uword(0)) - { - out.zeros(P_n_rows, P_n_cols); - return; - } - - umat locs(2, N, arma_nozeros_indicator()); - Col vals( N, arma_nozeros_indicator()); - - uword* locs_mem = locs.memptr(); - eT* vals_mem = vals.memptr(); - - typename SpProxy::const_iterator_type it = P.begin(); - - if(dim == 0) - { - for(uword i=0; i < N; ++i) - { - const uword row = it.row(); - const uword col = it.col(); - - (*locs_mem) = P_n_rows_m1 - row; locs_mem++; - (*locs_mem) = col; locs_mem++; - - (*vals_mem) = (*it); vals_mem++; - - ++it; - } - } - else - if(dim == 1) - { - for(uword i=0; i < N; ++i) - { - const uword row = it.row(); - const uword col = it.col(); - - (*locs_mem) = row; locs_mem++; - (*locs_mem) = P_n_cols_m1 - col; locs_mem++; - - (*vals_mem) = (*it); vals_mem++; - - ++it; - } - } - - SpMat tmp(locs, vals, P_n_rows, P_n_cols, true, false); - - out.steal_mem(tmp); - } - - - -template -inline -void -spop_reverse::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - const uword dim = in.aux_uword_a; - - arma_conform_check( (dim > 1), "reverse(): parameter 'dim' must be 0 or 1" ); - - if(is_SpMat::value) - { - const unwrap_spmat tmp(in.m); - - spop_reverse::apply_spmat(out, tmp.M, dim); - } - else - { - spop_reverse::apply_proxy(out, in.m, dim); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_shift_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_shift_bones.hpp deleted file mode 100644 index 4475c4069..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_shift_bones.hpp +++ /dev/null @@ -1,35 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup spop_shift -//! @{ - - - -class spop_shift - : public traits_op_default - { - public: - - template inline static void apply_noalias(SpMat& out, const SpMat& X, const uword len, const uword neg, const uword dim); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_shift_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_shift_meat.hpp deleted file mode 100644 index f75c25424..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_shift_meat.hpp +++ /dev/null @@ -1,93 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup spop_shift -//! @{ - - - -template -inline -void -spop_shift::apply_noalias(SpMat& out, const SpMat& X, const uword len, const uword neg, const uword dim) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( ((dim == 0) && (len >= X.n_rows)), "shift(): shift amount out of bounds" ); - arma_conform_check_bounds( ((dim == 1) && (len >= X.n_cols)), "shift(): shift amount out of bounds" ); - - if(X.n_nonzero == 0) { out.zeros(X.n_rows, X.n_cols); return; } - - if(len == 0) { out = X; return; } - - typename SpMat::const_iterator it = X.begin(); - typename SpMat::const_iterator it_end = X.end(); - - Mat locs(2, X.n_nonzero, arma_nozeros_indicator()); - - uword* locs_mem = locs.memptr(); - - if(dim == 0) - { - const uword X_row_threshold = X.n_rows - len; - - for(; it != it_end; ++it) - { - const uword X_row = it.row(); - uword Y_row = 0; - - if(neg == 0) { Y_row = (X_row < X_row_threshold) ? (X_row + len) : (X_row - X_row_threshold); } - else if(neg == 1) { Y_row = (X_row >= len ) ? (X_row - len) : (X_row + X_row_threshold); } - - locs_mem[0] = Y_row; - locs_mem[1] = it.col(); - - locs_mem += 2; - } - } - else - if(dim == 1) - { - const uword X_col_threshold = X.n_cols - len; - - for(; it != it_end; ++it) - { - const uword X_col = it.col(); - uword Y_col = 0; - - if(neg == 0) { Y_col = (X_col < X_col_threshold) ? (X_col + len) : (X_col - X_col_threshold); } - else if(neg == 1) { Y_col = (X_col >= len ) ? (X_col - len) : (X_col + X_col_threshold); } - - locs_mem[0] = it.row(); - locs_mem[1] = Y_col; - - locs_mem += 2; - } - } - - const Col vals(const_cast(X.values), X.n_nonzero, false); - - SpMat Y(locs, vals, X.n_rows, X.n_cols, true, false); - - out.steal_mem(Y); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_strans_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_strans_bones.hpp deleted file mode 100644 index 7d52ccae1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_strans_bones.hpp +++ /dev/null @@ -1,49 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spop_strans -//! @{ - - -//! simple transpose operation (no complex conjugates) for sparse matrices - -class spop_strans - { - public: - - template - struct traits - { - static constexpr bool is_row = T1::is_col; // deliberately swapped - static constexpr bool is_col = T1::is_row; - static constexpr bool is_xvec = T1::is_xvec; - }; - - template - inline static void apply_noalias(SpMat& B, const SpMat& A); - - template - inline static void apply(SpMat& out, const SpOp& in); - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_strans_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_strans_meat.hpp deleted file mode 100644 index 18166d6fa..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_strans_meat.hpp +++ /dev/null @@ -1,152 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spop_strans -//! @{ - - - -template -inline -void -spop_strans::apply_noalias(SpMat& B, const SpMat& A) - { - arma_debug_sigprint(); - - B.reserve(A.n_cols, A.n_rows, A.n_nonzero); // deliberately swapped - - if(A.n_nonzero == 0) { return; } - - // This follows the TRANSP algorithm described in - // 'Sparse Matrix Multiplication Package (SMMP)' - // (R.E. Bank and C.C. Douglas, 2001) - - const uword m = A.n_rows; - const uword n = A.n_cols; - - const eT* a = A.values; - eT* b = access::rwp(B.values); - - const uword* ia = A.col_ptrs; - const uword* ja = A.row_indices; - - uword* ib = access::rwp(B.col_ptrs); - uword* jb = access::rwp(B.row_indices); - - // // ib is already zeroed, as B is freshly constructed - // - // for(uword i=0; i < (m+1); ++i) - // { - // ib[i] = 0; - // } - - for(uword i=0; i < n; ++i) - { - for(uword j = ia[i]; j < ia[i+1]; ++j) - { - ib[ ja[j] + 1 ]++; - } - } - - for(uword i=0; i < m; ++i) - { - ib[i+1] += ib[i]; - } - - for(uword i=0; i < n; ++i) - { - for(uword j = ia[i]; j < ia[i+1]; ++j) - { - const uword jj = ja[j]; - - const uword ib_jj = ib[jj]; - - jb[ib_jj] = i; - - b[ib_jj] = a[j]; - - ib[jj]++; - } - } - - for(uword i = m-1; i >= 1; --i) - { - ib[i] = ib[i-1]; - } - - ib[0] = 0; - } - - - -template -inline -void -spop_strans::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat U(in.m); - - if(U.is_alias(out)) - { - SpMat tmp; - - spop_strans::apply_noalias(tmp, U.M); - - out.steal_mem(tmp); - } - else - { - spop_strans::apply_noalias(out, U.M); - } - } - - - -//! for transpose of non-complex matrices, redirected from spop_htrans::apply() -template -inline -void -spop_strans::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat U(in.m); - - if(U.is_alias(out)) - { - SpMat tmp; - - spop_strans::apply_noalias(tmp, U.M); - - out.steal_mem(tmp); - } - else - { - spop_strans::apply_noalias(out, U.M); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_symmat_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_symmat_bones.hpp deleted file mode 100644 index cf130f29b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_symmat_bones.hpp +++ /dev/null @@ -1,46 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spop_symmat -//! @{ - - - -class spop_symmat - : public traits_op_default - { - public: - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -class spop_symmat_cx - : public traits_op_default - { - public: - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_symmat_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_symmat_meat.hpp deleted file mode 100644 index 8ce7d460c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_symmat_meat.hpp +++ /dev/null @@ -1,87 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spop_symmat -//! @{ - - - -template -inline -void -spop_symmat::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat U(in.m); - const SpMat& X = U.M; - - arma_conform_check( (X.n_rows != X.n_cols), "symmatu()/symmatl(): given matrix must be square sized" ); - - if(X.n_nonzero == uword(0)) { out.zeros(X.n_rows, X.n_cols); return; } - - const bool upper = (in.aux_uword_a == 0); - - const SpMat A = (upper) ? trimatu(X) : trimatl(X); // in this case trimatu() and trimatl() return the same type - const SpMat B = A.st(); - - spglue_merge::symmat_merge(out, A, B); - } - - - -template -inline -void -spop_symmat_cx::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat U(in.m); - const SpMat& X = U.M; - - arma_conform_check( (X.n_rows != X.n_cols), "symmatu()/symmatl(): given matrix must be square sized" ); - - if(X.n_nonzero == uword(0)) { out.zeros(X.n_rows, X.n_cols); return; } - - const bool upper = (in.aux_uword_a == 0); - const bool do_conj = (in.aux_uword_b == 1); - - const SpMat A = (upper) ? trimatu(X) : trimatl(X); // in this case trimatu() and trimatl() return the same type - - if(do_conj) - { - const SpMat B = A.t(); - - spglue_merge::symmat_merge(out, A, B); - } - else - { - const SpMat B = A.st(); - - spglue_merge::symmat_merge(out, A, B); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_trimat_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_trimat_bones.hpp deleted file mode 100644 index 5b3aeccce..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_trimat_bones.hpp +++ /dev/null @@ -1,66 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spop_trimat -//! @{ - - - -class spop_trimat - : public traits_op_default - { - public: - - template - inline static void apply_noalias(SpMat& out, const SpProxy& P, const bool upper); - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -class spop_trimatu_ext - : public traits_op_default - { - public: - - template - inline static void apply_noalias(SpMat& out, const SpMat& A, const uword row_offset, const uword col_offset); - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -class spop_trimatl_ext - : public traits_op_default - { - public: - - template - inline static void apply_noalias(SpMat& out, const SpMat& A, const uword row_offset, const uword col_offset); - - template - inline static void apply(SpMat& out, const SpOp& in); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_trimat_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_trimat_meat.hpp deleted file mode 100644 index 4fd53d8be..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_trimat_meat.hpp +++ /dev/null @@ -1,366 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spop_trimat -//! @{ - - - -template -inline -void -spop_trimat::apply_noalias(SpMat& out, const SpProxy& P, const bool upper) - { - arma_debug_sigprint(); - - typename SpProxy::const_iterator_type it = P.begin(); - - const uword old_n_nonzero = P.get_n_nonzero(); - uword new_n_nonzero = 0; - - if(upper) - { - // upper triangular: count elements on the diagonal and above the diagonal - - for(uword i=0; i < old_n_nonzero; ++i) - { - new_n_nonzero += (it.row() <= it.col()) ? uword(1) : uword(0); - ++it; - } - } - else - { - // lower triangular: count elements on the diagonal and below the diagonal - - for(uword i=0; i < old_n_nonzero; ++i) - { - new_n_nonzero += (it.row() >= it.col()) ? uword(1) : uword(0); - ++it; - } - } - - const uword n_rows = P.get_n_rows(); - const uword n_cols = P.get_n_cols(); - - out.reserve(n_rows, n_cols, new_n_nonzero); - - uword new_index = 0; - - it = P.begin(); - - if(upper) - { - // upper triangular: copy elements on the diagonal and above the diagonal - - for(uword i=0; i < old_n_nonzero; ++i) - { - const uword row = it.row(); - const uword col = it.col(); - - if(row <= col) - { - access::rw(out.values[new_index]) = (*it); - access::rw(out.row_indices[new_index]) = row; - access::rw(out.col_ptrs[col + 1])++; - ++new_index; - } - - ++it; - } - } - else - { - // lower triangular: copy elements on the diagonal and below the diagonal - - for(uword i=0; i < old_n_nonzero; ++i) - { - const uword row = it.row(); - const uword col = it.col(); - - if(row >= col) - { - access::rw(out.values[new_index]) = (*it); - access::rw(out.row_indices[new_index]) = row; - access::rw(out.col_ptrs[col + 1])++; - ++new_index; - } - - ++it; - } - } - - for(uword i=0; i < n_cols; ++i) - { - access::rw(out.col_ptrs[i + 1]) += out.col_ptrs[i]; - } - } - - - -template -inline -void -spop_trimat::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const SpProxy P(in.m); - - arma_conform_check( (P.get_n_rows() != P.get_n_cols()), "trimatu()/trimatl(): given matrix must be square sized" ); - - const bool upper = (in.aux_uword_a == 0); - - if(P.is_alias(out)) - { - SpMat tmp; - spop_trimat::apply_noalias(tmp, P, upper); - out.steal_mem(tmp); - } - else - { - spop_trimat::apply_noalias(out, P, upper); - } - } - - - -// - - - -template -inline -void -spop_trimatu_ext::apply_noalias(SpMat& out, const SpMat& A, const uword row_offset, const uword col_offset) - { - arma_debug_sigprint(); - - const uword n_rows = A.n_rows; - const uword n_cols = A.n_cols; - - arma_conform_check_bounds( ((row_offset > 0) && (row_offset >= n_rows)) || ((col_offset > 0) && (col_offset >= n_cols)), "trimatu(): requested diagonal is out of bounds" ); - - if(A.n_nonzero == 0) { out.zeros(n_rows, n_cols); return; } - - out.reserve(n_rows, n_cols, A.n_nonzero); // upper bound on n_nonzero - - uword count = 0; - - const uword N = (std::min)(n_rows - row_offset, n_cols - col_offset); - - for(uword i=0; i < n_cols; ++i) - { - const uword col = i + col_offset; - - if(i < N) - { - typename SpMat::const_col_iterator it = A.begin_col_no_sync(col); - typename SpMat::const_col_iterator it_end = A.end_col_no_sync(col); - - const uword end_row = i + row_offset; - - for(; it != it_end; ++it) - { - const uword it_row = it.row(); - - if(it_row <= end_row) - { - const uword it_col = it.col(); - - access::rw(out.values[count]) = (*it); - access::rw(out.row_indices[count]) = it_row; - access::rw(out.col_ptrs[it_col + 1])++; - ++count; - } - else - { - break; - } - } - } - else - { - if(col < n_cols) - { - typename SpMat::const_col_iterator it = A.begin_col_no_sync(col); - typename SpMat::const_col_iterator it_end = A.end_col_no_sync(col); - - for(; it != it_end; ++it) - { - const uword it_row = it.row(); - const uword it_col = it.col(); - - access::rw(out.values[count]) = (*it); - access::rw(out.row_indices[count]) = it_row; - access::rw(out.col_ptrs[it_col + 1])++; - ++count; - } - } - } - } - - for(uword i=0; i < n_cols; ++i) - { - access::rw(out.col_ptrs[i + 1]) += out.col_ptrs[i]; - } - - if(count < A.n_nonzero) { out.mem_resize(count); } - } - - - -template -inline -void -spop_trimatu_ext::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat U(in.m); - const SpMat& A = U.M; - - arma_conform_check( (A.is_square() == false), "trimatu(): given matrix must be square sized" ); - - const uword row_offset = in.aux_uword_a; - const uword col_offset = in.aux_uword_b; - - if(U.is_alias(out)) - { - SpMat tmp; - spop_trimatu_ext::apply_noalias(tmp, A, row_offset, col_offset); - out.steal_mem(tmp); - } - else - { - spop_trimatu_ext::apply_noalias(out, A, row_offset, col_offset); - } - } - - - -// - - - -template -inline -void -spop_trimatl_ext::apply_noalias(SpMat& out, const SpMat& A, const uword row_offset, const uword col_offset) - { - arma_debug_sigprint(); - - const uword n_rows = A.n_rows; - const uword n_cols = A.n_cols; - - arma_conform_check_bounds( ((row_offset > 0) && (row_offset >= n_rows)) || ((col_offset > 0) && (col_offset >= n_cols)), "trimatl(): requested diagonal is out of bounds" ); - - if(A.n_nonzero == 0) { out.zeros(n_rows, n_cols); return; } - - out.reserve(n_rows, n_cols, A.n_nonzero); // upper bound on n_nonzero - - uword count = 0; - - if(col_offset > 0) - { - typename SpMat::const_col_iterator it = A.begin_col_no_sync(0); - typename SpMat::const_col_iterator it_end = A.end_col_no_sync(col_offset-1); - - for(; it != it_end; ++it) - { - const uword it_row = it.row(); - const uword it_col = it.col(); - - access::rw(out.values[count]) = (*it); - access::rw(out.row_indices[count]) = it_row; - access::rw(out.col_ptrs[it_col + 1])++; - ++count; - } - } - - const uword N = (std::min)(n_rows - row_offset, n_cols - col_offset); - - for(uword i=0; i < N; ++i) - { - const uword start_row = i + row_offset; - const uword col = i + col_offset; - - typename SpMat::const_col_iterator it = A.begin_col_no_sync(col); - typename SpMat::const_col_iterator it_end = A.end_col_no_sync(col); - - for(; it != it_end; ++it) - { - const uword it_row = it.row(); - - if(it_row >= start_row) - { - const uword it_col = it.col(); - - access::rw(out.values[count]) = (*it); - access::rw(out.row_indices[count]) = it_row; - access::rw(out.col_ptrs[it_col + 1])++; - ++count; - } - } - } - - for(uword i=0; i < n_cols; ++i) - { - access::rw(out.col_ptrs[i + 1]) += out.col_ptrs[i]; - } - - if(count < A.n_nonzero) { out.mem_resize(count); } - } - - - -template -inline -void -spop_trimatl_ext::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - const unwrap_spmat U(in.m); - const SpMat& A = U.M; - - arma_conform_check( (A.is_square() == false), "trimatl(): given matrix must be square sized" ); - - const uword row_offset = in.aux_uword_a; - const uword col_offset = in.aux_uword_b; - - if(U.is_alias(out)) - { - SpMat tmp; - spop_trimatl_ext::apply_noalias(tmp, A, row_offset, col_offset); - out.steal_mem(tmp); - } - else - { - spop_trimatl_ext::apply_noalias(out, A, row_offset, col_offset); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_vectorise_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_vectorise_bones.hpp deleted file mode 100644 index 3e38b256f..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_vectorise_bones.hpp +++ /dev/null @@ -1,58 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup spop_vectorise -//! @{ - - -class spop_vectorise_col - : public traits_op_col - { - public: - - template inline static void apply(SpMat& out, const SpOp& in); - - template inline static void apply_direct(SpMat& out, const T1& expr); - }; - - - -class spop_vectorise_row - : public traits_op_row - { - public: - - template inline static void apply(SpMat& out, const SpOp& in); - - template inline static void apply_direct(SpMat& out, const T1& expr); - }; - - - -class spop_vectorise_all - : public traits_op_xvec - { - public: - - template inline static void apply(SpMat& out, const SpOp& in); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_vectorise_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_vectorise_meat.hpp deleted file mode 100644 index 279d1b2eb..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spop_vectorise_meat.hpp +++ /dev/null @@ -1,126 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -//! \addtogroup spop_vectorise -//! @{ - - - -template -inline -void -spop_vectorise_col::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - spop_vectorise_col::apply_direct(out, in.m); - } - - - -template -inline -void -spop_vectorise_col::apply_direct(SpMat& out, const T1& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - if(out.vec_state == 0) - { - out = expr; - - out.reshape(out.n_elem, 1); - } - else - { - SpMat tmp = expr; - - tmp.reshape(tmp.n_elem, 1); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -spop_vectorise_row::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - spop_vectorise_row::apply_direct(out, in.m); - } - - - -template -inline -void -spop_vectorise_row::apply_direct(SpMat& out, const T1& expr) - { - arma_debug_sigprint(); - - typedef typename T1::elem_type eT; - - // NOTE: row-wise vectorisation of sparse matrices is not recommended due to the CSC storage format - - if(out.vec_state == 0) - { - out = strans(expr); - - out.reshape(1, out.n_elem); - } - else - { - SpMat tmp = strans(expr); - - tmp.reshape(1, tmp.n_elem); - - out.steal_mem(tmp); - } - } - - - -template -inline -void -spop_vectorise_all::apply(SpMat& out, const SpOp& in) - { - arma_debug_sigprint(); - - const uword dim = in.aux_uword_a; - - if(dim == 0) - { - spop_vectorise_col::apply_direct(out, in.m); - } - else - { - spop_vectorise_row::apply_direct(out, in.m); - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spsolve_factoriser_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spsolve_factoriser_bones.hpp deleted file mode 100644 index 4616e26ef..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spsolve_factoriser_bones.hpp +++ /dev/null @@ -1,57 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spsolve_factoriser -//! @{ - - - -class spsolve_factoriser - { - private: - - void_ptr worker_ptr = nullptr; - uword elem_type_indicator = 0; - uword n_rows = 0; - double rcond_value = double(0); - - template inline void delete_worker(); - - inline void cleanup(); - - - public: - - inline ~spsolve_factoriser(); - inline spsolve_factoriser(); - - inline void reset(); - - inline double rcond() const; - - template inline bool factorise(const SpBase& A_expr, const spsolve_opts_base& settings = spsolve_opts_none(), const typename arma_blas_type_only::result* junk = nullptr); - - template inline bool solve(Mat& X, const Base& B_expr, const typename arma_blas_type_only::result* junk = nullptr); - - inline spsolve_factoriser(const spsolve_factoriser&) = delete; - inline void operator= (const spsolve_factoriser&) = delete; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spsolve_factoriser_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spsolve_factoriser_meat.hpp deleted file mode 100644 index 4206035c2..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/spsolve_factoriser_meat.hpp +++ /dev/null @@ -1,289 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup spsolve_factoriser -//! @{ - - - -template -inline -void -spsolve_factoriser::delete_worker() - { - arma_debug_sigprint(); - - if(worker_ptr != nullptr) - { - worker_type* ptr = reinterpret_cast(worker_ptr); - - delete ptr; - - worker_ptr = nullptr; - } - } - - - -inline -void -spsolve_factoriser::cleanup() - { - arma_debug_sigprint(); - - #if defined(ARMA_USE_SUPERLU) - { - if(elem_type_indicator == 1) { delete_worker< superlu_worker< float> >(); } - else if(elem_type_indicator == 2) { delete_worker< superlu_worker< double> >(); } - else if(elem_type_indicator == 3) { delete_worker< superlu_worker< cx_float> >(); } - else if(elem_type_indicator == 4) { delete_worker< superlu_worker >(); } - } - #endif - - worker_ptr = nullptr; - elem_type_indicator = 0; - n_rows = 0; - rcond_value = double(0); - } - - - -inline -spsolve_factoriser::~spsolve_factoriser() - { - arma_debug_sigprint_this(this); - - cleanup(); - } - - - -inline -spsolve_factoriser::spsolve_factoriser() - { - arma_debug_sigprint_this(this); - } - - - -inline -void -spsolve_factoriser::reset() - { - arma_debug_sigprint(); - - cleanup(); - } - - - -inline -double -spsolve_factoriser::rcond() const - { - arma_debug_sigprint(); - - return rcond_value; - } - - - -template -inline -bool -spsolve_factoriser::factorise - ( - const SpBase& A_expr, - const spsolve_opts_base& settings, - const typename arma_blas_type_only::result* junk - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - #if defined(ARMA_USE_SUPERLU) - { - typedef typename T1::elem_type eT; - typedef typename get_pod_type::result T; - - typedef superlu_worker worker_type; - - // - - cleanup(); - - // - - const unwrap_spmat U(A_expr.get_ref()); - const SpMat& A = U.M; - - if(A.is_square() == false) - { - arma_warn(1, "spsolve_factoriser::factorise(): solving under-determined / over-determined systems is currently not supported"); - return false; - } - - n_rows = A.n_rows; - - // - - superlu_opts superlu_opts_default; - - const superlu_opts& opts = (settings.id == 1) ? static_cast(settings) : superlu_opts_default; - - if( (opts.pivot_thresh < double(0)) || (opts.pivot_thresh > double(1)) ) - { - arma_warn(1, "spsolve_factoriser::factorise(): pivot_thresh must be in the [0,1] interval" ); - return false; - } - - // - - worker_ptr = new(std::nothrow) worker_type; - - if(worker_ptr == nullptr) - { - arma_warn(3, "spsolve_factoriser::factorise(): could not construct worker object"); - return false; - } - - // - - if( is_float::value) { elem_type_indicator = 1; } - else if( is_double::value) { elem_type_indicator = 2; } - else if( is_cx_float::value) { elem_type_indicator = 3; } - else if(is_cx_double::value) { elem_type_indicator = 4; } - - // - - worker_type* local_worker_ptr = reinterpret_cast(worker_ptr); - worker_type& local_worker_ref = (*local_worker_ptr); - - // - - T local_rcond_value = T(0); - - const bool status = local_worker_ref.factorise(local_rcond_value, A, opts); - - rcond_value = double(local_rcond_value); - - if( (status == false) || arma_isnan(local_rcond_value) || ((opts.allow_ugly == false) && (local_rcond_value < std::numeric_limits::epsilon())) ) - { - arma_warn(3, "spsolve_factoriser::factorise(): factorisation failed; rcond: ", local_rcond_value); - delete_worker(); - return false; - } - - return true; - } - #else - { - arma_ignore(A_expr); - arma_ignore(settings); - arma_stop_logic_error("spsolve_factoriser::factorise(): use of SuperLU must be enabled"); - return false; - } - #endif - } - - - -template -inline -bool -spsolve_factoriser::solve - ( - Mat& X, - const Base& B_expr, - const typename arma_blas_type_only::result* junk - ) - { - arma_debug_sigprint(); - arma_ignore(junk); - - #if defined(ARMA_USE_SUPERLU) - { - typedef typename T1::elem_type eT; - - typedef superlu_worker worker_type; - - if(worker_ptr == nullptr) - { - arma_warn(2, "spsolve_factoriser::solve(): no factorisation available"); - X.soft_reset(); - return false; - } - - bool type_mismatch = false; - - if( (is_float::value) && (elem_type_indicator != 1) ) { type_mismatch = true; } - else if( (is_double::value) && (elem_type_indicator != 2) ) { type_mismatch = true; } - else if( (is_cx_float::value) && (elem_type_indicator != 3) ) { type_mismatch = true; } - else if((is_cx_double::value) && (elem_type_indicator != 4) ) { type_mismatch = true; } - - if(type_mismatch) - { - arma_warn(1, "spsolve_factoriser::solve(): matrix type mismatch"); - X.soft_reset(); - return false; - } - - const quasi_unwrap U(B_expr.get_ref()); - const Mat& B = U.M; - - if(n_rows != B.n_rows) - { - arma_warn(1, "spsolve_factoriser::solve(): matrix size mismatch"); - X.soft_reset(); - return false; - } - - const bool is_alias = U.is_alias(X); - - Mat tmp; - Mat& out = is_alias ? tmp : X; - - worker_type* local_worker_ptr = reinterpret_cast(worker_ptr); - worker_type& local_worker_ref = (*local_worker_ptr); - - const bool status = local_worker_ref.solve(out,B); - - if(is_alias) { X.steal_mem(tmp); } - - if(status == false) - { - arma_warn(3, "spsolve_factoriser::solve(): solution not found"); - X.soft_reset(); - return false; - } - - return true; - } - #else - { - arma_ignore(X); - arma_ignore(B_expr); - arma_stop_logic_error("spsolve_factoriser::solve(): use of SuperLU must be enabled"); - return false; - } - #endif - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/strip.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/strip.hpp deleted file mode 100644 index 6e1e67153..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/strip.hpp +++ /dev/null @@ -1,231 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup strip -//! @{ - - - -template -struct strip_diagmat - { - typedef T1 stored_type; - - inline - strip_diagmat(const T1& X) - : M(X) - { - arma_debug_sigprint(); - } - - static constexpr bool do_diagmat = false; - - const T1& M; - }; - - - -template -struct strip_diagmat< Op > - { - typedef T1 stored_type; - - inline - strip_diagmat(const Op& X) - : M(X.m) - { - arma_debug_sigprint(); - } - - static constexpr bool do_diagmat = true; - - const T1& M; - }; - - - -template -struct strip_inv - { - typedef T1 stored_type; - - inline - strip_inv(const T1& X) - : M(X) - { - arma_debug_sigprint(); - } - - const T1& M; - - static constexpr bool do_inv_gen = false; - static constexpr bool do_inv_spd = false; - }; - - - -template -struct strip_inv< Op > - { - typedef T1 stored_type; - - inline - strip_inv(const Op& X) - : M(X.m) - { - arma_debug_sigprint(); - } - - const T1& M; - - static constexpr bool do_inv_gen = true; - static constexpr bool do_inv_spd = false; - }; - - - -template -struct strip_inv< Op > - { - typedef T1 stored_type; - - inline - strip_inv(const Op& X) - : M(X.m) - { - arma_debug_sigprint(); - } - - const T1& M; - - static constexpr bool do_inv_gen = false; - static constexpr bool do_inv_spd = true; - }; - - - -template -struct strip_trimat - { - typedef T1 stored_type; - - const T1& M; - - static constexpr bool do_trimat = false; - static constexpr bool do_triu = false; - static constexpr bool do_tril = false; - - inline - strip_trimat(const T1& X) - : M(X) - { - arma_debug_sigprint(); - } - }; - - - -template -struct strip_trimat< Op > - { - typedef T1 stored_type; - - const T1& M; - - static constexpr bool do_trimat = true; - - const bool do_triu; - const bool do_tril; - - inline - strip_trimat(const Op& X) - : M(X.m) - , do_triu(X.aux_uword_a == 0) - , do_tril(X.aux_uword_a == 1) - { - arma_debug_sigprint(); - } - }; - - - -// - - - -template -struct sp_strip_trans - { - typedef T1 stored_type; - - inline - sp_strip_trans(const T1& X) - : M(X) - { - arma_debug_sigprint(); - } - - static constexpr bool do_htrans = false; - static constexpr bool do_strans = false; - - const T1& M; - }; - - - -template -struct sp_strip_trans< SpOp > - { - typedef T1 stored_type; - - inline - sp_strip_trans(const SpOp& X) - : M(X.m) - { - arma_debug_sigprint(); - } - - static constexpr bool do_htrans = true; - static constexpr bool do_strans = false; - - const T1& M; - }; - - - -template -struct sp_strip_trans< SpOp > - { - typedef T1 stored_type; - - inline - sp_strip_trans(const SpOp& X) - : M(X.m) - { - arma_debug_sigprint(); - } - - static constexpr bool do_htrans = false; - static constexpr bool do_strans = true; - - const T1& M; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_bones.hpp deleted file mode 100644 index 95553a10e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_bones.hpp +++ /dev/null @@ -1,673 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup subview -//! @{ - - -//! Class for storing data required to construct or apply operations to a submatrix -//! (ie. where the submatrix starts and ends as well as a reference/pointer to the original matrix), -template -class subview : public Base< eT, subview > - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - arma_aligned const Mat& m; - - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - const uword aux_row1; - const uword aux_col1; - - const uword n_rows; - const uword n_cols; - const uword n_elem; - - protected: - - arma_inline subview(const Mat& in_m, const uword in_row1, const uword in_col1, const uword in_n_rows, const uword in_n_cols); - - - public: - - inline ~subview(); - inline subview() = delete; - - inline subview(const subview& in); - inline subview( subview&& in); - - template inline void inplace_op(const eT val ); - template inline void inplace_op(const Base& x, const char* identifier); - template inline void inplace_op(const subview& x, const char* identifier); - - // deliberately returning void - - inline void operator= (const eT val); - inline void operator+= (const eT val); - inline void operator-= (const eT val); - inline void operator*= (const eT val); - inline void operator/= (const eT val); - - inline void operator= (const subview& x); - inline void operator+= (const subview& x); - inline void operator-= (const subview& x); - inline void operator%= (const subview& x); - inline void operator/= (const subview& x); - - template inline void operator= (const Base& x); - template inline void operator+= (const Base& x); - template inline void operator-= (const Base& x); - template inline void operator%= (const Base& x); - template inline void operator/= (const Base& x); - - template inline void operator= (const SpBase& x); - template inline void operator+= (const SpBase& x); - template inline void operator-= (const SpBase& x); - template inline void operator%= (const SpBase& x); - template inline void operator/= (const SpBase& x); - - template - inline typename enable_if2< is_same_type::value, void>::result operator=(const Gen& x); - - inline void operator=(const std::initializer_list& list); - inline void operator=(const std::initializer_list< std::initializer_list >& list); - - - inline static void extract(Mat& out, const subview& in); - - inline static void plus_inplace(Mat& out, const subview& in); - inline static void minus_inplace(Mat& out, const subview& in); - inline static void schur_inplace(Mat& out, const subview& in); - inline static void div_inplace(Mat& out, const subview& in); - - template inline void for_each(functor F); - template inline void for_each(functor F) const; - - template inline void transform(functor F); - template inline void imbue(functor F); - - inline void replace(const eT old_val, const eT new_val); - - inline void clean(const pod_type threshold); - - inline void clamp(const eT min_val, const eT max_val); - - inline void fill(const eT val); - inline void zeros(); - inline void ones(); - inline void eye(); - inline void randu(); - inline void randn(); - - arma_warn_unused inline eT at_alt (const uword ii) const; - - arma_warn_unused inline eT& operator[](const uword ii); - arma_warn_unused inline eT operator[](const uword ii) const; - - arma_warn_unused inline eT& operator()(const uword ii); - arma_warn_unused inline eT operator()(const uword ii) const; - - arma_warn_unused inline eT& operator()(const uword in_row, const uword in_col); - arma_warn_unused inline eT operator()(const uword in_row, const uword in_col) const; - - arma_warn_unused inline eT& at(const uword in_row, const uword in_col); - arma_warn_unused inline eT at(const uword in_row, const uword in_col) const; - - arma_warn_unused inline eT& front(); - arma_warn_unused inline eT front() const; - - arma_warn_unused inline eT& back(); - arma_warn_unused inline eT back() const; - - arma_inline eT* colptr(const uword in_col); - arma_inline const eT* colptr(const uword in_col) const; - - template - inline bool check_overlap(const subview& x) const; - - arma_warn_unused inline bool is_vec() const; - arma_warn_unused inline bool is_finite() const; - arma_warn_unused inline bool is_zero(const pod_type tol = 0) const; - - arma_warn_unused inline bool has_inf() const; - arma_warn_unused inline bool has_nan() const; - arma_warn_unused inline bool has_nonfinite() const; - - inline subview_row row(const uword row_num); - inline const subview_row row(const uword row_num) const; - - inline subview_row operator()(const uword row_num, const span& col_span); - inline const subview_row operator()(const uword row_num, const span& col_span) const; - - inline subview_col col(const uword col_num); - inline const subview_col col(const uword col_num) const; - - inline subview_col operator()(const span& row_span, const uword col_num); - inline const subview_col operator()(const span& row_span, const uword col_num) const; - - inline Col unsafe_col(const uword col_num); - inline const Col unsafe_col(const uword col_num) const; - - inline subview rows(const uword in_row1, const uword in_row2); - inline const subview rows(const uword in_row1, const uword in_row2) const; - - inline subview cols(const uword in_col1, const uword in_col2); - inline const subview cols(const uword in_col1, const uword in_col2) const; - - inline subview submat(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2); - inline const subview submat(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2) const; - - inline subview submat (const span& row_span, const span& col_span); - inline const subview submat (const span& row_span, const span& col_span) const; - - inline subview operator()(const span& row_span, const span& col_span); - inline const subview operator()(const span& row_span, const span& col_span) const; - - inline subview_each1< subview, 0 > each_col(); - inline subview_each1< subview, 1 > each_row(); - - template inline subview_each2< subview, 0, T1 > each_col(const Base& indices); - template inline subview_each2< subview, 1, T1 > each_row(const Base& indices); - - inline void each_col(const std::function< void( Col&) >& F); - inline void each_col(const std::function< void(const Col&) >& F) const; - - inline void each_row(const std::function< void( Row&) >& F); - inline void each_row(const std::function< void(const Row&) >& F) const; - - inline diagview diag(const sword in_id = 0); - inline const diagview diag(const sword in_id = 0) const; - - inline void swap_rows(const uword in_row1, const uword in_row2); - inline void swap_cols(const uword in_col1, const uword in_col2); - - - class const_iterator; - - class iterator - { - public: - - inline iterator(); - inline iterator(const iterator& X); - inline iterator(subview& in_sv, const uword in_row, const uword in_col); - - arma_warn_unused inline eT& operator*(); - - inline iterator& operator++(); - arma_warn_unused inline iterator operator++(int); - - arma_warn_unused inline bool operator==(const iterator& rhs) const; - arma_warn_unused inline bool operator!=(const iterator& rhs) const; - arma_warn_unused inline bool operator==(const const_iterator& rhs) const; - arma_warn_unused inline bool operator!=(const const_iterator& rhs) const; - - typedef std::forward_iterator_tag iterator_category; - typedef eT value_type; - typedef std::ptrdiff_t difference_type; // TODO: not certain on this one - typedef eT* pointer; - typedef eT& reference; - - arma_aligned Mat* M; - arma_aligned eT* current_ptr; - arma_aligned uword current_row; - arma_aligned uword current_col; - - arma_aligned const uword aux_row1; - arma_aligned const uword aux_row2_p1; - }; - - - class const_iterator - { - public: - - inline const_iterator(); - inline const_iterator(const iterator& X); - inline const_iterator(const const_iterator& X); - inline const_iterator(const subview& in_sv, const uword in_row, const uword in_col); - - arma_warn_unused inline const eT& operator*(); - - inline const_iterator& operator++(); - arma_warn_unused inline const_iterator operator++(int); - - arma_warn_unused inline bool operator==(const iterator& rhs) const; - arma_warn_unused inline bool operator!=(const iterator& rhs) const; - arma_warn_unused inline bool operator==(const const_iterator& rhs) const; - arma_warn_unused inline bool operator!=(const const_iterator& rhs) const; - - // So that we satisfy the STL iterator types. - typedef std::forward_iterator_tag iterator_category; - typedef eT value_type; - typedef std::ptrdiff_t difference_type; // TODO: not certain on this one - typedef const eT* pointer; - typedef const eT& reference; - - arma_aligned const Mat* M; - arma_aligned const eT* current_ptr; - arma_aligned uword current_row; - arma_aligned uword current_col; - - arma_aligned const uword aux_row1; - arma_aligned const uword aux_row2_p1; - }; - - - class const_row_iterator; - - class row_iterator - { - public: - - inline row_iterator(); - inline row_iterator(const row_iterator& X); - inline row_iterator(subview& in_sv, const uword in_row, const uword in_col); - - arma_warn_unused inline eT& operator* (); - - inline row_iterator& operator++(); - arma_warn_unused inline row_iterator operator++(int); - - arma_warn_unused inline bool operator!=(const row_iterator& X) const; - arma_warn_unused inline bool operator==(const row_iterator& X) const; - arma_warn_unused inline bool operator!=(const const_row_iterator& X) const; - arma_warn_unused inline bool operator==(const const_row_iterator& X) const; - - typedef std::forward_iterator_tag iterator_category; - typedef eT value_type; - typedef std::ptrdiff_t difference_type; // TODO: not certain on this one - typedef eT* pointer; - typedef eT& reference; - - arma_aligned Mat* M; - arma_aligned uword current_row; - arma_aligned uword current_col; - - arma_aligned const uword aux_col1; - arma_aligned const uword aux_col2_p1; - }; - - - class const_row_iterator - { - public: - - inline const_row_iterator(); - inline const_row_iterator(const row_iterator& X); - inline const_row_iterator(const const_row_iterator& X); - inline const_row_iterator(const subview& in_sv, const uword in_row, const uword in_col); - - arma_warn_unused inline const eT& operator*() const; - - inline const_row_iterator& operator++(); - arma_warn_unused inline const_row_iterator operator++(int); - - arma_warn_unused inline bool operator!=(const row_iterator& X) const; - arma_warn_unused inline bool operator==(const row_iterator& X) const; - arma_warn_unused inline bool operator!=(const const_row_iterator& X) const; - arma_warn_unused inline bool operator==(const const_row_iterator& X) const; - - typedef std::forward_iterator_tag iterator_category; - typedef eT value_type; - typedef std::ptrdiff_t difference_type; // TODO: not certain on this one - typedef const eT* pointer; - typedef const eT& reference; - - arma_aligned const Mat* M; - arma_aligned uword current_row; - arma_aligned uword current_col; - - arma_aligned const uword aux_col1; - arma_aligned const uword aux_col2_p1; - }; - - - - inline iterator begin(); - inline const_iterator begin() const; - inline const_iterator cbegin() const; - - inline iterator end(); - inline const_iterator end() const; - inline const_iterator cend() const; - - - friend class Mat; - }; - - - -template -class subview_col : public subview - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - const eT* colmem; - - inline void operator= (const subview& x); - inline void operator= (const subview_col& x); - inline void operator= (const eT val); - inline void operator= (const std::initializer_list& list); - - template inline void operator= (const Base& x); - template inline void operator= (const SpBase& x); - - template - inline typename enable_if2< is_same_type::value, void>::result operator=(const Gen& x); - - arma_warn_unused arma_inline const Op,op_htrans> t() const; - arma_warn_unused arma_inline const Op,op_htrans> ht() const; - arma_warn_unused arma_inline const Op,op_strans> st() const; - - arma_warn_unused arma_inline const Op,op_strans> as_row() const; - - inline void fill(const eT val); - inline void zeros(); - inline void ones(); - - arma_inline eT at_alt (const uword i) const; - - arma_inline eT& operator[](const uword i); - arma_inline eT operator[](const uword i) const; - - inline eT& operator()(const uword i); - inline eT operator()(const uword i) const; - - inline eT& operator()(const uword in_row, const uword in_col); - inline eT operator()(const uword in_row, const uword in_col) const; - - inline eT& at(const uword in_row, const uword in_col); - inline eT at(const uword in_row, const uword in_col) const; - - arma_inline eT* colptr(const uword in_col); - arma_inline const eT* colptr(const uword in_col) const; - - inline subview_col rows(const uword in_row1, const uword in_row2); - inline const subview_col rows(const uword in_row1, const uword in_row2) const; - - inline subview_col subvec(const uword in_row1, const uword in_row2); - inline const subview_col subvec(const uword in_row1, const uword in_row2) const; - - inline subview_col subvec(const uword start_row, const SizeMat& s); - inline const subview_col subvec(const uword start_row, const SizeMat& s) const; - - inline subview_col head(const uword N); - inline const subview_col head(const uword N) const; - - inline subview_col tail(const uword N); - inline const subview_col tail(const uword N) const; - - arma_warn_unused inline eT min() const; - arma_warn_unused inline eT max() const; - - inline eT min(uword& index_of_min_val) const; - inline eT max(uword& index_of_max_val) const; - - arma_warn_unused inline uword index_min() const; - arma_warn_unused inline uword index_max() const; - - inline subview_col(const subview_col& in); - inline subview_col( subview_col&& in); - - - protected: - - inline subview_col(const Mat& in_m, const uword in_col); - inline subview_col(const Mat& in_m, const uword in_col, const uword in_row1, const uword in_n_rows); - inline subview_col() = delete; - - - friend class Mat; - friend class Col; - friend class subview; - }; - - - -template -class subview_cols : public subview - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - inline subview_cols(const subview_cols& in); - inline subview_cols( subview_cols&& in); - - inline void operator= (const subview& x); - inline void operator= (const subview_cols& x); - inline void operator= (const eT val); - inline void operator= (const std::initializer_list& list); - inline void operator= (const std::initializer_list< std::initializer_list >& list); - - template inline void operator= (const Base& x); - template inline void operator= (const SpBase& x); - - template - inline typename enable_if2< is_same_type::value, void>::result operator=(const Gen& x); - - arma_warn_unused arma_inline const Op,op_htrans> t() const; - arma_warn_unused arma_inline const Op,op_htrans> ht() const; - arma_warn_unused arma_inline const Op,op_strans> st() const; - - arma_warn_unused arma_inline const Op,op_vectorise_col> as_col() const; - - arma_warn_unused inline eT at_alt (const uword ii) const; - - arma_warn_unused inline eT& operator[](const uword ii); - arma_warn_unused inline eT operator[](const uword ii) const; - - arma_warn_unused inline eT& operator()(const uword ii); - arma_warn_unused inline eT operator()(const uword ii) const; - - arma_warn_unused inline eT& operator()(const uword in_row, const uword in_col); - arma_warn_unused inline eT operator()(const uword in_row, const uword in_col) const; - - arma_warn_unused inline eT& at(const uword in_row, const uword in_col); - arma_warn_unused inline eT at(const uword in_row, const uword in_col) const; - - arma_inline eT* colptr(const uword in_col); - arma_inline const eT* colptr(const uword in_col) const; - - protected: - - inline subview_cols(const Mat& in_m, const uword in_col1, const uword in_n_cols); - inline subview_cols() = delete; - - friend class Mat; - friend class subview; - }; - - - -template -class subview_row : public subview - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_row = true; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - inline void operator= (const subview& x); - inline void operator= (const subview_row& x); - inline void operator= (const eT val); - inline void operator= (const std::initializer_list& list); - - template inline void operator= (const Base& x); - template inline void operator= (const SpBase& x); - - template - inline typename enable_if2< is_same_type::value, void>::result operator=(const Gen& x); - - arma_warn_unused arma_inline const Op,op_htrans> t() const; - arma_warn_unused arma_inline const Op,op_htrans> ht() const; - arma_warn_unused arma_inline const Op,op_strans> st() const; - - arma_warn_unused arma_inline const Op,op_strans> as_col() const; - - inline eT at_alt (const uword i) const; - - inline eT& operator[](const uword i); - inline eT operator[](const uword i) const; - - inline eT& operator()(const uword i); - inline eT operator()(const uword i) const; - - inline eT& operator()(const uword in_row, const uword in_col); - inline eT operator()(const uword in_row, const uword in_col) const; - - inline eT& at(const uword in_row, const uword in_col); - inline eT at(const uword in_row, const uword in_col) const; - - inline subview_row cols(const uword in_col1, const uword in_col2); - inline const subview_row cols(const uword in_col1, const uword in_col2) const; - - inline subview_row subvec(const uword in_col1, const uword in_col2); - inline const subview_row subvec(const uword in_col1, const uword in_col2) const; - - inline subview_row subvec(const uword start_col, const SizeMat& s); - inline const subview_row subvec(const uword start_col, const SizeMat& s) const; - - inline subview_row head(const uword N); - inline const subview_row head(const uword N) const; - - inline subview_row tail(const uword N); - inline const subview_row tail(const uword N) const; - - arma_warn_unused inline uword index_min() const; - arma_warn_unused inline uword index_max() const; - - inline typename subview::row_iterator begin(); - inline typename subview::const_row_iterator begin() const; - inline typename subview::const_row_iterator cbegin() const; - - inline typename subview::row_iterator end(); - inline typename subview::const_row_iterator end() const; - inline typename subview::const_row_iterator cend() const; - - inline subview_row(const subview_row& in); - inline subview_row( subview_row&& in); - - - protected: - - inline subview_row(const Mat& in_m, const uword in_row); - inline subview_row(const Mat& in_m, const uword in_row, const uword in_col1, const uword in_n_cols); - inline subview_row() = delete; - - - friend class Mat; - friend class Row; - friend class subview; - }; - - - -template -class subview_row_strans : public Base< eT, subview_row_strans > - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const subview_row& sv_row; - - const uword n_rows; // equal to n_elem - const uword n_elem; - - static constexpr uword n_cols = 1; - - - inline explicit subview_row_strans(const subview_row& in_sv_row); - - inline void extract(Mat& out) const; - - inline eT at_alt (const uword i) const; - - inline eT operator[](const uword i) const; - inline eT operator()(const uword i) const; - - inline eT operator()(const uword in_row, const uword in_col) const; - inline eT at(const uword in_row, const uword in_col) const; - }; - - - -template -class subview_row_htrans : public Base< eT, subview_row_htrans > - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const subview_row& sv_row; - - const uword n_rows; // equal to n_elem - const uword n_elem; - - static constexpr uword n_cols = 1; - - - inline explicit subview_row_htrans(const subview_row& in_sv_row); - - inline void extract(Mat& out) const; - - inline eT at_alt (const uword i) const; - - inline eT operator[](const uword i) const; - inline eT operator()(const uword i) const; - - inline eT operator()(const uword in_row, const uword in_col) const; - inline eT at(const uword in_row, const uword in_col) const; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_cube_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_cube_bones.hpp deleted file mode 100644 index ae71e677e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_cube_bones.hpp +++ /dev/null @@ -1,248 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup subview_cube -//! @{ - - -//! Class for storing data required to construct or apply operations to a subcube -//! (ie. where the subcube starts and ends as well as a reference/pointer to the original cube), -template -class subview_cube : public BaseCube< eT, subview_cube > - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - arma_aligned const Cube& m; - - const uword aux_row1; - const uword aux_col1; - const uword aux_slice1; - - const uword n_rows; - const uword n_cols; - const uword n_elem_slice; - const uword n_slices; - const uword n_elem; - - - protected: - - arma_inline subview_cube(const Cube& in_m, const uword in_row1, const uword in_col1, const uword in_slice1, const uword in_n_rows, const uword in_n_cols, const uword in_n_slices); - - - public: - - inline ~subview_cube(); - inline subview_cube() = delete; - - inline subview_cube(const subview_cube& in); - inline subview_cube( subview_cube&& in); - - template inline void inplace_op(const eT val ); - template inline void inplace_op(const BaseCube& x, const char* identifier); - template inline void inplace_op(const subview_cube& x, const char* identifier); - - inline void operator= (const eT val); - inline void operator+= (const eT val); - inline void operator-= (const eT val); - inline void operator*= (const eT val); - inline void operator/= (const eT val); - - // deliberately returning void - template inline void operator= (const BaseCube& x); - template inline void operator+= (const BaseCube& x); - template inline void operator-= (const BaseCube& x); - template inline void operator%= (const BaseCube& x); - template inline void operator/= (const BaseCube& x); - - inline void operator= (const subview_cube& x); - inline void operator+= (const subview_cube& x); - inline void operator-= (const subview_cube& x); - inline void operator%= (const subview_cube& x); - inline void operator/= (const subview_cube& x); - - template inline void operator= (const Base& x); - template inline void operator+= (const Base& x); - template inline void operator-= (const Base& x); - template inline void operator%= (const Base& x); - template inline void operator/= (const Base& x); - - template inline void operator=(const GenCube& x); - - inline static void extract(Cube& out, const subview_cube& in); - inline static void plus_inplace(Cube& out, const subview_cube& in); - inline static void minus_inplace(Cube& out, const subview_cube& in); - inline static void schur_inplace(Cube& out, const subview_cube& in); - inline static void div_inplace(Cube& out, const subview_cube& in); - - inline static void extract(Mat& out, const subview_cube& in); - inline static void plus_inplace(Mat& out, const subview_cube& in); - inline static void minus_inplace(Mat& out, const subview_cube& in); - inline static void schur_inplace(Mat& out, const subview_cube& in); - inline static void div_inplace(Mat& out, const subview_cube& in); - - template inline void for_each(functor F); - template inline void for_each(functor F) const; - - template inline void transform(functor F); - template inline void imbue(functor F); - - inline void each_slice(const std::function< void( Mat&) >& F); - inline void each_slice(const std::function< void(const Mat&) >& F) const; - - inline void replace(const eT old_val, const eT new_val); - - inline void clean(const pod_type threshold); - - inline void clamp(const eT min_val, const eT max_val); - - inline void fill(const eT val); - inline void zeros(); - inline void ones(); - inline void randu(); - inline void randn(); - - arma_warn_unused inline bool is_finite() const; - arma_warn_unused inline bool is_zero(const pod_type tol = 0) const; - - arma_warn_unused inline bool has_inf() const; - arma_warn_unused inline bool has_nan() const; - arma_warn_unused inline bool has_nonfinite() const; - - inline eT at_alt (const uword i) const; - - inline eT& operator[](const uword i); - inline eT operator[](const uword i) const; - - inline eT& operator()(const uword i); - inline eT operator()(const uword i) const; - - arma_inline eT& operator()(const uword in_row, const uword in_col, const uword in_slice); - arma_inline eT operator()(const uword in_row, const uword in_col, const uword in_slice) const; - - arma_inline eT& at(const uword in_row, const uword in_col, const uword in_slice); - arma_inline eT at(const uword in_row, const uword in_col, const uword in_slice) const; - - arma_inline eT* slice_colptr(const uword in_slice, const uword in_col); - arma_inline const eT* slice_colptr(const uword in_slice, const uword in_col) const; - - template - inline bool check_overlap(const subview_cube& x) const; - - inline bool check_overlap(const Mat& x) const; - - - class const_iterator; - - class iterator - { - public: - - inline iterator(); - inline iterator(const iterator& X); - inline iterator(subview_cube& in_sv, const uword in_row, const uword in_col, const uword in_slice); - - arma_warn_unused inline eT& operator*(); - - inline iterator& operator++(); - arma_warn_unused inline iterator operator++(int); - - arma_warn_unused inline bool operator==(const iterator& rhs) const; - arma_warn_unused inline bool operator!=(const iterator& rhs) const; - arma_warn_unused inline bool operator==(const const_iterator& rhs) const; - arma_warn_unused inline bool operator!=(const const_iterator& rhs) const; - - typedef std::forward_iterator_tag iterator_category; - typedef eT value_type; - typedef std::ptrdiff_t difference_type; // TODO: not certain on this one - typedef eT* pointer; - typedef eT& reference; - - arma_aligned Cube* M; - arma_aligned eT* current_ptr; - arma_aligned uword current_row; - arma_aligned uword current_col; - arma_aligned uword current_slice; - - arma_aligned const uword aux_row1; - arma_aligned const uword aux_col1; - - arma_aligned const uword aux_row2_p1; - arma_aligned const uword aux_col2_p1; - }; - - - class const_iterator - { - public: - - inline const_iterator(); - inline const_iterator(const iterator& X); - inline const_iterator(const const_iterator& X); - inline const_iterator(const subview_cube& in_sv, const uword in_row, const uword in_col, const uword in_slice); - - arma_warn_unused inline const eT& operator*(); - - inline const_iterator& operator++(); - arma_warn_unused inline const_iterator operator++(int); - - arma_warn_unused inline bool operator==(const iterator& rhs) const; - arma_warn_unused inline bool operator!=(const iterator& rhs) const; - arma_warn_unused inline bool operator==(const const_iterator& rhs) const; - arma_warn_unused inline bool operator!=(const const_iterator& rhs) const; - - // So that we satisfy the STL iterator types. - typedef std::forward_iterator_tag iterator_category; - typedef eT value_type; - typedef std::ptrdiff_t difference_type; // TODO: not certain on this one - typedef const eT* pointer; - typedef const eT& reference; - - arma_aligned const Cube* M; - arma_aligned const eT* current_ptr; - arma_aligned uword current_row; - arma_aligned uword current_col; - arma_aligned uword current_slice; - - arma_aligned const uword aux_row1; - arma_aligned const uword aux_col1; - - arma_aligned const uword aux_row2_p1; - arma_aligned const uword aux_col2_p1; - }; - - - inline iterator begin(); - inline const_iterator begin() const; - inline const_iterator cbegin() const; - - inline iterator end(); - inline const_iterator end() const; - inline const_iterator cend() const; - - - friend class Mat; - friend class Cube; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_cube_each_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_cube_each_bones.hpp deleted file mode 100644 index 29d81fd24..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_cube_each_bones.hpp +++ /dev/null @@ -1,161 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup subview_cube_each -//! @{ - - - -template -class subview_cube_each_common - { - public: - - const Cube& P; - - template - inline void check_size(const Mat& A) const; - - - protected: - - arma_inline subview_cube_each_common(const Cube& in_p); - inline subview_cube_each_common() = delete; - - template - arma_cold inline const std::string incompat_size_string(const Mat& A) const; - }; - - - - -template -class subview_cube_each1 : public subview_cube_each_common - { - protected: - - arma_inline subview_cube_each1(const Cube& in_p); - inline subview_cube_each1() = delete; - - - public: - - inline ~subview_cube_each1(); - - // deliberately returning void - template inline void operator= (const Base& x); - template inline void operator+= (const Base& x); - template inline void operator-= (const Base& x); - template inline void operator%= (const Base& x); - template inline void operator/= (const Base& x); - template inline void operator*= (const Base& x); - - - friend class Cube; - }; - - - -template -class subview_cube_each2 : public subview_cube_each_common - { - protected: - - inline subview_cube_each2(const Cube& in_p, const Base& in_indices); - inline subview_cube_each2() = delete; - - - public: - - const Base& base_indices; - - inline void check_indices(const Mat& indices) const; - inline ~subview_cube_each2(); - - // deliberately returning void - template inline void operator= (const Base& x); - template inline void operator+= (const Base& x); - template inline void operator-= (const Base& x); - template inline void operator%= (const Base& x); - template inline void operator/= (const Base& x); - - - friend class Cube; - }; - - - -class subview_cube_each1_aux - { - public: - - template - static inline Cube operator_plus(const subview_cube_each1& X, const Base& Y); - - template - static inline Cube operator_minus(const subview_cube_each1& X, const Base& Y); - - template - static inline Cube operator_minus(const Base& X, const subview_cube_each1& Y); - - template - static inline Cube operator_schur(const subview_cube_each1& X, const Base& Y); - - template - static inline Cube operator_div(const subview_cube_each1& X,const Base& Y); - - template - static inline Cube operator_div(const Base& X, const subview_cube_each1& Y); - - template - static inline Cube operator_times(const subview_cube_each1& X,const Base& Y); - - template - static inline Cube operator_times(const Base& X, const subview_cube_each1& Y); - }; - - - -class subview_cube_each2_aux - { - public: - - template - static inline Cube operator_plus(const subview_cube_each2& X, const Base& Y); - - template - static inline Cube operator_minus(const subview_cube_each2& X, const Base& Y); - - template - static inline Cube operator_minus(const Base& X, const subview_cube_each2& Y); - - template - static inline Cube operator_schur(const subview_cube_each2& X, const Base& Y); - - template - static inline Cube operator_div(const subview_cube_each2& X, const Base& Y); - - template - static inline Cube operator_div(const Base& X, const subview_cube_each2& Y); - - // TODO: operator_times - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_cube_each_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_cube_each_meat.hpp deleted file mode 100644 index 96b3d582a..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_cube_each_meat.hpp +++ /dev/null @@ -1,1035 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup subview_cube_each -//! @{ - - -// -// -// subview_cube_each_common - -template -inline -subview_cube_each_common::subview_cube_each_common(const Cube& in_p) - : P(in_p) - { - arma_debug_sigprint(); - } - - - -template -template -inline -void -subview_cube_each_common::check_size(const Mat& A) const - { - if(arma_config::check_conform) - { - if( (A.n_rows != P.n_rows) || (A.n_cols != P.n_cols) ) - { - arma_stop_logic_error( incompat_size_string(A) ); - } - } - } - - - -template -template -inline -const std::string -subview_cube_each_common::incompat_size_string(const Mat& A) const - { - std::ostringstream tmp; - - tmp << "each_slice(): incompatible size; expected " << P.n_rows << 'x' << P.n_cols << ", got " << A.n_rows << 'x' << A.n_cols; - - return tmp.str(); - } - - - -// -// -// subview_cube_each1 - - - -template -inline -subview_cube_each1::~subview_cube_each1() - { - arma_debug_sigprint(); - } - - - -template -inline -subview_cube_each1::subview_cube_each1(const Cube& in_p) - : subview_cube_each_common::subview_cube_each_common(in_p) - { - arma_debug_sigprint(); - } - - - -template -template -inline -void -subview_cube_each1::operator= (const Base& in) - { - arma_debug_sigprint(); - - Cube& p = access::rw(subview_cube_each_common::P); - - const unwrap tmp( in.get_ref() ); - const Mat& A = tmp.M; - - subview_cube_each_common::check_size(A); - - const uword p_n_slices = p.n_slices; - const uword p_n_elem_slice = p.n_elem_slice; - - const eT* A_mem = A.memptr(); - - for(uword i=0; i < p_n_slices; ++i) { arrayops::copy( p.slice_memptr(i), A_mem, p_n_elem_slice ); } - } - - - -template -template -inline -void -subview_cube_each1::operator+= (const Base& in) - { - arma_debug_sigprint(); - - Cube& p = access::rw(subview_cube_each_common::P); - - const unwrap tmp( in.get_ref() ); - const Mat& A = tmp.M; - - subview_cube_each_common::check_size(A); - - const uword p_n_slices = p.n_slices; - const uword p_n_elem_slice = p.n_elem_slice; - - const eT* A_mem = A.memptr(); - - for(uword i=0; i < p_n_slices; ++i) { arrayops::inplace_plus( p.slice_memptr(i), A_mem, p_n_elem_slice ); } - } - - - -template -template -inline -void -subview_cube_each1::operator-= (const Base& in) - { - arma_debug_sigprint(); - - Cube& p = access::rw(subview_cube_each_common::P); - - const unwrap tmp( in.get_ref() ); - const Mat& A = tmp.M; - - subview_cube_each_common::check_size(A); - - const uword p_n_slices = p.n_slices; - const uword p_n_elem_slice = p.n_elem_slice; - - const eT* A_mem = A.memptr(); - - for(uword i=0; i < p_n_slices; ++i) { arrayops::inplace_minus( p.slice_memptr(i), A_mem, p_n_elem_slice ); } - } - - - -template -template -inline -void -subview_cube_each1::operator%= (const Base& in) - { - arma_debug_sigprint(); - - Cube& p = access::rw(subview_cube_each_common::P); - - const unwrap tmp( in.get_ref() ); - const Mat& A = tmp.M; - - subview_cube_each_common::check_size(A); - - const uword p_n_slices = p.n_slices; - const uword p_n_elem_slice = p.n_elem_slice; - - const eT* A_mem = A.memptr(); - - for(uword i=0; i < p_n_slices; ++i) { arrayops::inplace_mul( p.slice_memptr(i), A_mem, p_n_elem_slice ); } - } - - - -template -template -inline -void -subview_cube_each1::operator/= (const Base& in) - { - arma_debug_sigprint(); - - Cube& p = access::rw(subview_cube_each_common::P); - - const unwrap tmp( in.get_ref() ); - const Mat& A = tmp.M; - - subview_cube_each_common::check_size(A); - - const uword p_n_slices = p.n_slices; - const uword p_n_elem_slice = p.n_elem_slice; - - const eT* A_mem = A.memptr(); - - for(uword i=0; i < p_n_slices; ++i) { arrayops::inplace_div( p.slice_memptr(i), A_mem, p_n_elem_slice ); } - } - - - -template -template -inline -void -subview_cube_each1::operator*= (const Base& in) - { - arma_debug_sigprint(); - - Cube& C = access::rw(subview_cube_each_common::P); - - C = C.each_slice() * in.get_ref(); - } - - - -// -// -// subview_cube_each2 - - - -template -inline -subview_cube_each2::~subview_cube_each2() - { - arma_debug_sigprint(); - } - - - -template -inline -subview_cube_each2::subview_cube_each2(const Cube& in_p, const Base& in_indices) - : subview_cube_each_common::subview_cube_each_common(in_p) - , base_indices(in_indices) - { - arma_debug_sigprint(); - } - - - -template -inline -void -subview_cube_each2::check_indices(const Mat& indices) const - { - arma_conform_check( ((indices.is_vec() == false) && (indices.is_empty() == false)), "each_slice(): list of indices must be a vector" ); - } - - - -template -template -inline -void -subview_cube_each2::operator= (const Base& in) - { - arma_debug_sigprint(); - - Cube& p = access::rw(subview_cube_each_common::P); - - const unwrap tmp( in.get_ref() ); - const Mat& A = tmp.M; - - subview_cube_each_common::check_size(A); - - const unwrap U( base_indices.get_ref() ); - - check_indices(U.M); - - const uword p_n_slices = p.n_slices; - const uword p_n_elem_slice = p.n_elem_slice; - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - const eT* A_mem = A.memptr(); - - for(uword i=0; i < N; ++i) - { - const uword slice = indices_mem[i]; - - arma_conform_check_bounds( (slice >= p_n_slices), "each_slice(): index out of bounds" ); - - arrayops::copy(p.slice_memptr(slice), A_mem, p_n_elem_slice); - } - } - - - -template -template -inline -void -subview_cube_each2::operator+= (const Base& in) - { - arma_debug_sigprint(); - - Cube& p = access::rw(subview_cube_each_common::P); - - const unwrap tmp( in.get_ref() ); - const Mat& A = tmp.M; - - subview_cube_each_common::check_size(A); - - const unwrap U( base_indices.get_ref() ); - - check_indices(U.M); - - const uword p_n_slices = p.n_slices; - const uword p_n_elem_slice = p.n_elem_slice; - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - const eT* A_mem = A.memptr(); - - for(uword i=0; i < N; ++i) - { - const uword slice = indices_mem[i]; - - arma_conform_check_bounds( (slice >= p_n_slices), "each_slice(): index out of bounds" ); - - arrayops::inplace_plus(p.slice_memptr(slice), A_mem, p_n_elem_slice); - } - } - - - -template -template -inline -void -subview_cube_each2::operator-= (const Base& in) - { - arma_debug_sigprint(); - - Cube& p = access::rw(subview_cube_each_common::P); - - const unwrap tmp( in.get_ref() ); - const Mat& A = tmp.M; - - subview_cube_each_common::check_size(A); - - const unwrap U( base_indices.get_ref() ); - - check_indices(U.M); - - const uword p_n_slices = p.n_slices; - const uword p_n_elem_slice = p.n_elem_slice; - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - const eT* A_mem = A.memptr(); - - for(uword i=0; i < N; ++i) - { - const uword slice = indices_mem[i]; - - arma_conform_check_bounds( (slice >= p_n_slices), "each_slice(): index out of bounds" ); - - arrayops::inplace_minus(p.slice_memptr(slice), A_mem, p_n_elem_slice); - } - } - - - -template -template -inline -void -subview_cube_each2::operator%= (const Base& in) - { - arma_debug_sigprint(); - - Cube& p = access::rw(subview_cube_each_common::P); - - const unwrap tmp( in.get_ref() ); - const Mat& A = tmp.M; - - subview_cube_each_common::check_size(A); - - const unwrap U( base_indices.get_ref() ); - - check_indices(U.M); - - const uword p_n_slices = p.n_slices; - const uword p_n_elem_slice = p.n_elem_slice; - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - const eT* A_mem = A.memptr(); - - for(uword i=0; i < N; ++i) - { - const uword slice = indices_mem[i]; - - arma_conform_check_bounds( (slice >= p_n_slices), "each_slice(): index out of bounds" ); - - arrayops::inplace_mul(p.slice_memptr(slice), A_mem, p_n_elem_slice); - } - } - - - -template -template -inline -void -subview_cube_each2::operator/= (const Base& in) - { - arma_debug_sigprint(); - - Cube& p = access::rw(subview_cube_each_common::P); - - const unwrap tmp( in.get_ref() ); - const Mat& A = tmp.M; - - subview_cube_each_common::check_size(A); - - const unwrap U( base_indices.get_ref() ); - - check_indices(U.M); - - const uword p_n_slices = p.n_slices; - const uword p_n_elem_slice = p.n_elem_slice; - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - const eT* A_mem = A.memptr(); - - for(uword i=0; i < N; ++i) - { - const uword slice = indices_mem[i]; - - arma_conform_check_bounds( (slice >= p_n_slices), "each_slice(): index out of bounds" ); - - arrayops::inplace_div(p.slice_memptr(slice), A_mem, p_n_elem_slice); - } - } - - - -// -// -// subview_cube_each1_aux - - - -template -inline -Cube -subview_cube_each1_aux::operator_plus - ( - const subview_cube_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - const Cube& p = X.P; - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - const uword p_n_slices = p.n_slices; - - Cube out(p_n_rows, p_n_cols, p_n_slices, arma_nozeros_indicator()); - - const unwrap tmp(Y.get_ref()); - const Mat& A = tmp.M; - - X.check_size(A); - - for(uword i=0; i < p_n_slices; ++i) - { - Mat out_slice( out.slice_memptr(i), p_n_rows, p_n_cols, false, true); - const Mat p_slice(const_cast(p.slice_memptr(i)), p_n_rows, p_n_cols, false, true); - - out_slice = p_slice + A; - } - - return out; - } - - - -template -inline -Cube -subview_cube_each1_aux::operator_minus - ( - const subview_cube_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - const Cube& p = X.P; - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - const uword p_n_slices = p.n_slices; - - Cube out(p_n_rows, p_n_cols, p_n_slices, arma_nozeros_indicator()); - - const unwrap tmp(Y.get_ref()); - const Mat& A = tmp.M; - - X.check_size(A); - - for(uword i=0; i < p_n_slices; ++i) - { - Mat out_slice( out.slice_memptr(i), p_n_rows, p_n_cols, false, true); - const Mat p_slice(const_cast(p.slice_memptr(i)), p_n_rows, p_n_cols, false, true); - - out_slice = p_slice - A; - } - - return out; - } - - - -template -inline -Cube -subview_cube_each1_aux::operator_minus - ( - const Base& X, - const subview_cube_each1& Y - ) - { - arma_debug_sigprint(); - - const Cube& p = Y.P; - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - const uword p_n_slices = p.n_slices; - - Cube out(p_n_rows, p_n_cols, p_n_slices, arma_nozeros_indicator()); - - const unwrap tmp(X.get_ref()); - const Mat& A = tmp.M; - - Y.check_size(A); - - for(uword i=0; i < p_n_slices; ++i) - { - Mat out_slice( out.slice_memptr(i), p_n_rows, p_n_cols, false, true); - const Mat p_slice(const_cast(p.slice_memptr(i)), p_n_rows, p_n_cols, false, true); - - out_slice = A - p_slice; - } - - return out; - } - - - -template -inline -Cube -subview_cube_each1_aux::operator_schur - ( - const subview_cube_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - const Cube& p = X.P; - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - const uword p_n_slices = p.n_slices; - - Cube out(p_n_rows, p_n_cols, p_n_slices, arma_nozeros_indicator()); - - const unwrap tmp(Y.get_ref()); - const Mat& A = tmp.M; - - X.check_size(A); - - for(uword i=0; i < p_n_slices; ++i) - { - Mat out_slice( out.slice_memptr(i), p_n_rows, p_n_cols, false, true); - const Mat p_slice(const_cast(p.slice_memptr(i)), p_n_rows, p_n_cols, false, true); - - out_slice = p_slice % A; - } - - return out; - } - - - -template -inline -Cube -subview_cube_each1_aux::operator_div - ( - const subview_cube_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - const Cube& p = X.P; - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - const uword p_n_slices = p.n_slices; - - Cube out(p_n_rows, p_n_cols, p_n_slices, arma_nozeros_indicator()); - - const unwrap tmp(Y.get_ref()); - const Mat& A = tmp.M; - - X.check_size(A); - - for(uword i=0; i < p_n_slices; ++i) - { - Mat out_slice( out.slice_memptr(i), p_n_rows, p_n_cols, false, true); - const Mat p_slice(const_cast(p.slice_memptr(i)), p_n_rows, p_n_cols, false, true); - - out_slice = p_slice / A; - } - - return out; - } - - - -template -inline -Cube -subview_cube_each1_aux::operator_div - ( - const Base& X, - const subview_cube_each1& Y - ) - { - arma_debug_sigprint(); - - const Cube& p = Y.P; - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - const uword p_n_slices = p.n_slices; - - Cube out(p_n_rows, p_n_cols, p_n_slices, arma_nozeros_indicator()); - - const unwrap tmp(X.get_ref()); - const Mat& A = tmp.M; - - Y.check_size(A); - - for(uword i=0; i < p_n_slices; ++i) - { - Mat out_slice( out.slice_memptr(i), p_n_rows, p_n_cols, false, true); - const Mat p_slice(const_cast(p.slice_memptr(i)), p_n_rows, p_n_cols, false, true); - - out_slice = A / p_slice; - } - - return out; - } - - - -template -inline -Cube -subview_cube_each1_aux::operator_times - ( - const subview_cube_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - const Cube& C = X.P; - - const unwrap tmp(Y.get_ref()); - const Mat& M = tmp.M; - - Cube out(C.n_rows, M.n_cols, C.n_slices, arma_nozeros_indicator()); - - for(uword i=0; i < C.n_slices; ++i) - { - Mat out_slice( out.slice_memptr(i), C.n_rows, M.n_cols, false, true); - const Mat C_slice(const_cast(C.slice_memptr(i)), C.n_rows, C.n_cols, false, true); - - out_slice = C_slice * M; - } - - return out; - } - - - -template -inline -Cube -subview_cube_each1_aux::operator_times - ( - const Base& X, - const subview_cube_each1& Y - ) - { - arma_debug_sigprint(); - - const unwrap tmp(X.get_ref()); - const Mat& M = tmp.M; - - const Cube& C = Y.P; - - Cube out(M.n_rows, C.n_cols, C.n_slices, arma_nozeros_indicator()); - - for(uword i=0; i < C.n_slices; ++i) - { - Mat out_slice( out.slice_memptr(i), M.n_rows, C.n_cols, false, true); - const Mat C_slice(const_cast(C.slice_memptr(i)), C.n_rows, C.n_cols, false, true); - - out_slice = M * C_slice; - } - - return out; - } - - - -// -// -// subview_cube_each2_aux - - - -template -inline -Cube -subview_cube_each2_aux::operator_plus - ( - const subview_cube_each2& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - const Cube& p = X.P; - - const uword p_n_slices = p.n_slices; - const uword p_n_elem_slice = p.n_elem_slice; - - Cube out = p; - - const unwrap tmp(Y.get_ref()); - const Mat& A = tmp.M; - - const unwrap U(X.base_indices.get_ref()); - - X.check_size(A); - X.check_indices(U.M); - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - const eT* A_mem = A.memptr(); - - for(uword i=0; i < N; ++i) - { - const uword slice = indices_mem[i]; - - arma_conform_check_bounds( (slice >= p_n_slices), "each_slice(): index out of bounds" ); - - arrayops::inplace_plus(out.slice_memptr(slice), A_mem, p_n_elem_slice); - } - - return out; - } - - - -template -inline -Cube -subview_cube_each2_aux::operator_minus - ( - const subview_cube_each2& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - const Cube& p = X.P; - - const uword p_n_slices = p.n_slices; - const uword p_n_elem_slice = p.n_elem_slice; - - Cube out = p; - - const unwrap tmp(Y.get_ref()); - const Mat& A = tmp.M; - - const unwrap U(X.base_indices.get_ref()); - - X.check_size(A); - X.check_indices(U.M); - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - const eT* A_mem = A.memptr(); - - for(uword i=0; i < N; ++i) - { - const uword slice = indices_mem[i]; - - arma_conform_check_bounds( (slice >= p_n_slices), "each_slice(): index out of bounds" ); - - arrayops::inplace_minus(out.slice_memptr(slice), A_mem, p_n_elem_slice); - } - - return out; - } - - - -template -inline -Cube -subview_cube_each2_aux::operator_minus - ( - const Base& X, - const subview_cube_each2& Y - ) - { - arma_debug_sigprint(); - - const Cube& p = Y.P; - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - const uword p_n_slices = p.n_slices; - - Cube out = p; - - const unwrap tmp(X.get_ref()); - const Mat& A = tmp.M; - - const unwrap U(Y.base_indices.get_ref()); - - Y.check_size(A); - Y.check_indices(U.M); - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - for(uword i=0; i < N; ++i) - { - const uword slice = indices_mem[i]; - - arma_conform_check_bounds( (slice >= p_n_slices), "each_slice(): index out of bounds" ); - - Mat out_slice( out.slice_memptr(slice), p_n_rows, p_n_cols, false, true); - const Mat p_slice(const_cast(p.slice_memptr(slice)), p_n_rows, p_n_cols, false, true); - - out_slice = A - p_slice; - } - - return out; - } - - - -template -inline -Cube -subview_cube_each2_aux::operator_schur - ( - const subview_cube_each2& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - const Cube& p = X.P; - - const uword p_n_slices = p.n_slices; - const uword p_n_elem_slice = p.n_elem_slice; - - Cube out = p; - - const unwrap tmp(Y.get_ref()); - const Mat& A = tmp.M; - - const unwrap U(X.base_indices.get_ref()); - - X.check_size(A); - X.check_indices(U.M); - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - const eT* A_mem = A.memptr(); - - for(uword i=0; i < N; ++i) - { - const uword slice = indices_mem[i]; - - arma_conform_check_bounds( (slice >= p_n_slices), "each_slice(): index out of bounds" ); - - arrayops::inplace_mul(out.slice_memptr(slice), A_mem, p_n_elem_slice); - } - - return out; - } - - - -template -inline -Cube -subview_cube_each2_aux::operator_div - ( - const subview_cube_each2& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - const Cube& p = X.P; - - const uword p_n_slices = p.n_slices; - const uword p_n_elem_slice = p.n_elem_slice; - - Cube out = p; - - const unwrap tmp(Y.get_ref()); - const Mat& A = tmp.M; - - const unwrap U(X.base_indices.get_ref()); - - X.check_size(A); - X.check_indices(U.M); - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - const eT* A_mem = A.memptr(); - - for(uword i=0; i < N; ++i) - { - const uword slice = indices_mem[i]; - - arma_conform_check_bounds( (slice >= p_n_slices), "each_slice(): index out of bounds" ); - - arrayops::inplace_div(out.slice_memptr(slice), A_mem, p_n_elem_slice); - } - - return out; - } - - - -template -inline -Cube -subview_cube_each2_aux::operator_div - ( - const Base& X, - const subview_cube_each2& Y - ) - { - arma_debug_sigprint(); - - const Cube& p = Y.P; - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - const uword p_n_slices = p.n_slices; - - Cube out = p; - - const unwrap tmp(X.get_ref()); - const Mat& A = tmp.M; - - const unwrap U(Y.base_indices.get_ref()); - - Y.check_size(A); - Y.check_indices(U.M); - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - for(uword i=0; i < N; ++i) - { - const uword slice = indices_mem[i]; - - arma_conform_check_bounds( (slice >= p_n_slices), "each_slice(): index out of bounds" ); - - Mat out_slice( out.slice_memptr(slice), p_n_rows, p_n_cols, false, true); - const Mat p_slice(const_cast(p.slice_memptr(slice)), p_n_rows, p_n_cols, false, true); - - out_slice = A / p_slice; - } - - return out; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_cube_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_cube_meat.hpp deleted file mode 100644 index a4295aa1e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_cube_meat.hpp +++ /dev/null @@ -1,2722 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup subview_cube -//! @{ - - -template -inline -subview_cube::~subview_cube() - { - arma_debug_sigprint_this(this); - } - - - -template -arma_inline -subview_cube::subview_cube - ( - const Cube& in_m, - const uword in_row1, - const uword in_col1, - const uword in_slice1, - const uword in_n_rows, - const uword in_n_cols, - const uword in_n_slices - ) - : m (in_m) - , aux_row1 (in_row1) - , aux_col1 (in_col1) - , aux_slice1 (in_slice1) - , n_rows (in_n_rows) - , n_cols (in_n_cols) - , n_elem_slice(in_n_rows * in_n_cols) - , n_slices (in_n_slices) - , n_elem (n_elem_slice * in_n_slices) - { - arma_debug_sigprint_this(this); - } - - - -template -inline -subview_cube::subview_cube(const subview_cube& in) - : m (in.m ) - , aux_row1 (in.aux_row1 ) - , aux_col1 (in.aux_col1 ) - , aux_slice1 (in.aux_slice1 ) - , n_rows (in.n_rows ) - , n_cols (in.n_cols ) - , n_elem_slice(in.n_elem_slice) - , n_slices (in.n_slices ) - , n_elem (in.n_elem ) - { - arma_debug_sigprint(arma_str::format("this: %x; in: %x") % this % &in); - } - - - -template -inline -subview_cube::subview_cube(subview_cube&& in) - : m (in.m ) - , aux_row1 (in.aux_row1 ) - , aux_col1 (in.aux_col1 ) - , aux_slice1 (in.aux_slice1 ) - , n_rows (in.n_rows ) - , n_cols (in.n_cols ) - , n_elem_slice(in.n_elem_slice) - , n_slices (in.n_slices ) - , n_elem (in.n_elem ) - { - arma_debug_sigprint(arma_str::format("this: %x; in: %x") % this % &in); - - // for paranoia - - access::rw(in.aux_row1 ) = 0; - access::rw(in.aux_col1 ) = 0; - access::rw(in.aux_slice1 ) = 0; - access::rw(in.n_rows ) = 0; - access::rw(in.n_cols ) = 0; - access::rw(in.n_elem_slice) = 0; - access::rw(in.n_slices ) = 0; - access::rw(in.n_elem ) = 0; - } - - - -template -template -inline -void -subview_cube::inplace_op(const eT val) - { - arma_debug_sigprint(); - - subview_cube& t = *this; - - const uword t_n_rows = t.n_rows; - const uword t_n_cols = t.n_cols; - const uword t_n_slices = t.n_slices; - - for(uword s=0; s < t_n_slices; ++s) - for(uword c=0; c < t_n_cols; ++c) - { - if(is_same_type::yes) { arrayops::inplace_plus ( slice_colptr(s,c), val, t_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_minus( slice_colptr(s,c), val, t_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_mul ( slice_colptr(s,c), val, t_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_div ( slice_colptr(s,c), val, t_n_rows ); } - } - } - - - - - - -template -template -inline -void -subview_cube::inplace_op(const BaseCube& in, const char* identifier) - { - arma_debug_sigprint(); - - const ProxyCube P(in.get_ref()); - - subview_cube& t = *this; - - const uword t_n_rows = t.n_rows; - const uword t_n_cols = t.n_cols; - const uword t_n_slices = t.n_slices; - - arma_conform_assert_same_size(t, P, identifier); - - const bool use_mp = arma_config::openmp && ProxyCube::use_mp && mp_gate::eval(t.n_elem); - const bool has_overlap = P.has_overlap(t); - - if(has_overlap) { arma_debug_print("aliasing or overlap detected"); } - - if( (is_Cube::stored_type>::value) || (use_mp) || (has_overlap) ) - { - const unwrap_cube_check::stored_type> tmp(P.Q, has_overlap); - const Cube& B = tmp.M; - - if( (is_same_type::yes) && (t.aux_row1 == 0) && (t_n_rows == t.m.n_rows) ) - { - for(uword s=0; s < t_n_slices; ++s) - { - arrayops::copy( t.slice_colptr(s,0), B.slice_colptr(s,0), t.n_elem_slice ); - } - } - else - { - for(uword s=0; s < t_n_slices; ++s) - for(uword c=0; c < t_n_cols; ++c) - { - if(is_same_type::yes) { arrayops::copy ( t.slice_colptr(s,c), B.slice_colptr(s,c), t_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_plus ( t.slice_colptr(s,c), B.slice_colptr(s,c), t_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_minus( t.slice_colptr(s,c), B.slice_colptr(s,c), t_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_mul ( t.slice_colptr(s,c), B.slice_colptr(s,c), t_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_div ( t.slice_colptr(s,c), B.slice_colptr(s,c), t_n_rows ); } - } - } - } - else // use the Proxy - { - if(ProxyCube::use_at) - { - for(uword s=0; s < t_n_slices; ++s) - for(uword c=0; c < t_n_cols; ++c) - { - eT* t_col_data = t.slice_colptr(s,c); - - for(uword r=0; r < t_n_rows; ++r) - { - const eT tmp = P.at(r,c,s); - - if(is_same_type::yes) { (*t_col_data) = tmp; t_col_data++; } - if(is_same_type::yes) { (*t_col_data) += tmp; t_col_data++; } - if(is_same_type::yes) { (*t_col_data) -= tmp; t_col_data++; } - if(is_same_type::yes) { (*t_col_data) *= tmp; t_col_data++; } - if(is_same_type::yes) { (*t_col_data) /= tmp; t_col_data++; } - } - } - } - else - { - typename ProxyCube::ea_type Pea = P.get_ea(); - - uword count = 0; - - for(uword s=0; s < t_n_slices; ++s) - for(uword c=0; c < t_n_cols; ++c) - { - eT* t_col_data = t.slice_colptr(s,c); - - for(uword r=0; r < t_n_rows; ++r) - { - const eT tmp = Pea[count]; count++; - - if(is_same_type::yes) { (*t_col_data) = tmp; t_col_data++; } - if(is_same_type::yes) { (*t_col_data) += tmp; t_col_data++; } - if(is_same_type::yes) { (*t_col_data) -= tmp; t_col_data++; } - if(is_same_type::yes) { (*t_col_data) *= tmp; t_col_data++; } - if(is_same_type::yes) { (*t_col_data) /= tmp; t_col_data++; } - } - } - } - } - } - - - -template -template -inline -void -subview_cube::inplace_op(const subview_cube& x, const char* identifier) - { - arma_debug_sigprint(); - - if(check_overlap(x)) - { - const Cube tmp(x); - - if(is_same_type::yes) { (*this).operator= (tmp); } - if(is_same_type::yes) { (*this).operator+=(tmp); } - if(is_same_type::yes) { (*this).operator-=(tmp); } - if(is_same_type::yes) { (*this).operator%=(tmp); } - if(is_same_type::yes) { (*this).operator/=(tmp); } - - return; - } - - subview_cube& t = *this; - - arma_conform_assert_same_size(t, x, identifier); - - const uword t_n_rows = t.n_rows; - const uword t_n_cols = t.n_cols; - const uword t_n_slices = t.n_slices; - - for(uword s=0; s < t_n_slices; ++s) - for(uword c=0; c < t_n_cols; ++c) - { - if(is_same_type::yes) { arrayops::copy ( t.slice_colptr(s,c), x.slice_colptr(s,c), t_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_plus ( t.slice_colptr(s,c), x.slice_colptr(s,c), t_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_minus( t.slice_colptr(s,c), x.slice_colptr(s,c), t_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_mul ( t.slice_colptr(s,c), x.slice_colptr(s,c), t_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_div ( t.slice_colptr(s,c), x.slice_colptr(s,c), t_n_rows ); } - } - } - - - -template -inline -void -subview_cube::operator= (const eT val) - { - arma_debug_sigprint(); - - if(n_elem != 1) - { - arma_conform_assert_same_size(n_rows, n_cols, n_slices, 1, 1, 1, "copy into subcube"); - } - - Cube& Q = const_cast< Cube& >(m); - - Q.at(aux_row1, aux_col1, aux_slice1) = val; - } - - - -template -inline -void -subview_cube::operator+= (const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -template -inline -void -subview_cube::operator-= (const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -template -inline -void -subview_cube::operator*= (const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -template -inline -void -subview_cube::operator/= (const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -template -template -inline -void -subview_cube::operator= (const BaseCube& in) - { - arma_debug_sigprint(); - - inplace_op(in, "copy into subcube"); - } - - - -template -template -inline -void -subview_cube::operator+= (const BaseCube& in) - { - arma_debug_sigprint(); - - inplace_op(in, "addition"); - } - - - -template -template -inline -void -subview_cube::operator-= (const BaseCube& in) - { - arma_debug_sigprint(); - - inplace_op(in, "subtraction"); - } - - - -template -template -inline -void -subview_cube::operator%= (const BaseCube& in) - { - arma_debug_sigprint(); - - inplace_op(in, "element-wise multiplication"); - } - - - -template -template -inline -void -subview_cube::operator/= (const BaseCube& in) - { - arma_debug_sigprint(); - - inplace_op(in, "element-wise division"); - } - - - -//! x.subcube(...) = y.subcube(...) -template -inline -void -subview_cube::operator= (const subview_cube& x) - { - arma_debug_sigprint(); - - inplace_op(x, "copy into subcube"); - } - - - -template -inline -void -subview_cube::operator+= (const subview_cube& x) - { - arma_debug_sigprint(); - - inplace_op(x, "addition"); - } - - - -template -inline -void -subview_cube::operator-= (const subview_cube& x) - { - arma_debug_sigprint(); - - inplace_op(x, "subtraction"); - } - - - -template -inline -void -subview_cube::operator%= (const subview_cube& x) - { - arma_debug_sigprint(); - - inplace_op(x, "element-wise multiplication"); - } - - - -template -inline -void -subview_cube::operator/= (const subview_cube& x) - { - arma_debug_sigprint(); - - inplace_op(x, "element-wise division"); - } - - - -template -template -inline -void -subview_cube::operator= (const Base& in) - { - arma_debug_sigprint(); - - const quasi_unwrap tmp(in.get_ref()); - - const Mat& x = tmp.M; - subview_cube& t = *this; - - const uword t_n_rows = t.n_rows; - const uword t_n_cols = t.n_cols; - const uword t_n_slices = t.n_slices; - - const uword x_n_rows = x.n_rows; - const uword x_n_cols = x.n_cols; - - if( ((x_n_rows == 1) || (x_n_cols == 1)) && (t_n_rows == 1) && (t_n_cols == 1) && (x.n_elem == t_n_slices) ) - { - Cube& Q = const_cast< Cube& >(t.m); - - const uword t_aux_row1 = t.aux_row1; - const uword t_aux_col1 = t.aux_col1; - const uword t_aux_slice1 = t.aux_slice1; - - const eT* x_mem = x.memptr(); - - uword i,j; - for(i=0, j=1; j < t_n_slices; i+=2, j+=2) - { - const eT tmp_i = x_mem[i]; - const eT tmp_j = x_mem[j]; - - Q.at(t_aux_row1, t_aux_col1, t_aux_slice1 + i) = tmp_i; - Q.at(t_aux_row1, t_aux_col1, t_aux_slice1 + j) = tmp_j; - } - - if(i < t_n_slices) - { - Q.at(t_aux_row1, t_aux_col1, t_aux_slice1 + i) = x_mem[i]; - } - } - else - if( (t_n_rows == x_n_rows) && (t_n_cols == x_n_cols) && (t_n_slices == 1) ) - { - // interpret the matrix as a cube with one slice - - for(uword col = 0; col < t_n_cols; ++col) - { - arrayops::copy( t.slice_colptr(0, col), x.colptr(col), t_n_rows ); - } - } - else - if( (t_n_rows == x_n_rows) && (t_n_cols == 1) && (t_n_slices == x_n_cols) ) - { - for(uword i=0; i < t_n_slices; ++i) - { - arrayops::copy( t.slice_colptr(i, 0), x.colptr(i), t_n_rows ); - } - } - else - if( (t_n_rows == 1) && (t_n_cols == x_n_rows) && (t_n_slices == x_n_cols) ) - { - Cube& Q = const_cast< Cube& >(t.m); - - const uword t_aux_row1 = t.aux_row1; - const uword t_aux_col1 = t.aux_col1; - const uword t_aux_slice1 = t.aux_slice1; - - for(uword slice=0; slice < t_n_slices; ++slice) - { - const uword mod_slice = t_aux_slice1 + slice; - - const eT* x_colptr = x.colptr(slice); - - uword i,j; - for(i=0, j=1; j < t_n_cols; i+=2, j+=2) - { - const eT tmp_i = x_colptr[i]; - const eT tmp_j = x_colptr[j]; - - Q.at(t_aux_row1, t_aux_col1 + i, mod_slice) = tmp_i; - Q.at(t_aux_row1, t_aux_col1 + j, mod_slice) = tmp_j; - } - - if(i < t_n_cols) - { - Q.at(t_aux_row1, t_aux_col1 + i, mod_slice) = x_colptr[i]; - } - } - } - else - { - if(arma_config::check_conform) - { - arma_stop_logic_error( arma_incompat_size_string(t, x, "copy into subcube") ); - } - } - } - - - -template -template -inline -void -subview_cube::operator+= (const Base& in) - { - arma_debug_sigprint(); - - const quasi_unwrap tmp(in.get_ref()); - - const Mat& x = tmp.M; - subview_cube& t = *this; - - const uword t_n_rows = t.n_rows; - const uword t_n_cols = t.n_cols; - const uword t_n_slices = t.n_slices; - - const uword x_n_rows = x.n_rows; - const uword x_n_cols = x.n_cols; - - if( ((x_n_rows == 1) || (x_n_cols == 1)) && (t_n_rows == 1) && (t_n_cols == 1) && (x.n_elem == t_n_slices) ) - { - Cube& Q = const_cast< Cube& >(t.m); - - const uword t_aux_row1 = t.aux_row1; - const uword t_aux_col1 = t.aux_col1; - const uword t_aux_slice1 = t.aux_slice1; - - const eT* x_mem = x.memptr(); - - uword i,j; - for(i=0, j=1; j < t_n_slices; i+=2, j+=2) - { - const eT tmp_i = x_mem[i]; - const eT tmp_j = x_mem[j]; - - Q.at(t_aux_row1, t_aux_col1, t_aux_slice1 + i) += tmp_i; - Q.at(t_aux_row1, t_aux_col1, t_aux_slice1 + j) += tmp_j; - } - - if(i < t_n_slices) - { - Q.at(t_aux_row1, t_aux_col1, t_aux_slice1 + i) += x_mem[i]; - } - } - else - if( (t_n_rows == x_n_rows) && (t_n_cols == x_n_cols) && (t_n_slices == 1) ) - { - for(uword col = 0; col < t_n_cols; ++col) - { - arrayops::inplace_plus( t.slice_colptr(0, col), x.colptr(col), t_n_rows ); - } - } - else - if( (t_n_rows == x_n_rows) && (t_n_cols == 1) && (t_n_slices == x_n_cols) ) - { - for(uword i=0; i < t_n_slices; ++i) - { - arrayops::inplace_plus( t.slice_colptr(i, 0), x.colptr(i), t_n_rows ); - } - } - else - if( (t_n_rows == 1) && (t_n_cols == x_n_rows) && (t_n_slices == x_n_cols) ) - { - Cube& Q = const_cast< Cube& >(t.m); - - const uword t_aux_row1 = t.aux_row1; - const uword t_aux_col1 = t.aux_col1; - const uword t_aux_slice1 = t.aux_slice1; - - for(uword slice=0; slice < t_n_slices; ++slice) - { - const uword mod_slice = t_aux_slice1 + slice; - - const eT* x_colptr = x.colptr(slice); - - uword i,j; - for(i=0, j=1; j < t_n_cols; i+=2, j+=2) - { - const eT tmp_i = x_colptr[i]; - const eT tmp_j = x_colptr[j]; - - Q.at(t_aux_row1, t_aux_col1 + i, mod_slice) += tmp_i; - Q.at(t_aux_row1, t_aux_col1 + j, mod_slice) += tmp_j; - } - - if(i < t_n_cols) - { - Q.at(t_aux_row1, t_aux_col1 + i, mod_slice) += x_colptr[i]; - } - } - } - else - { - if(arma_config::check_conform) - { - arma_stop_logic_error( arma_incompat_size_string(t, x, "addition") ); - } - } - } - - - -template -template -inline -void -subview_cube::operator-= (const Base& in) - { - arma_debug_sigprint(); - - const quasi_unwrap tmp(in.get_ref()); - - const Mat& x = tmp.M; - subview_cube& t = *this; - - const uword t_n_rows = t.n_rows; - const uword t_n_cols = t.n_cols; - const uword t_n_slices = t.n_slices; - - const uword x_n_rows = x.n_rows; - const uword x_n_cols = x.n_cols; - - if( ((x_n_rows == 1) || (x_n_cols == 1)) && (t_n_rows == 1) && (t_n_cols == 1) && (x.n_elem == t_n_slices) ) - { - Cube& Q = const_cast< Cube& >(t.m); - - const uword t_aux_row1 = t.aux_row1; - const uword t_aux_col1 = t.aux_col1; - const uword t_aux_slice1 = t.aux_slice1; - - const eT* x_mem = x.memptr(); - - uword i,j; - for(i=0, j=1; j < t_n_slices; i+=2, j+=2) - { - const eT tmp_i = x_mem[i]; - const eT tmp_j = x_mem[j]; - - Q.at(t_aux_row1, t_aux_col1, t_aux_slice1 + i) -= tmp_i; - Q.at(t_aux_row1, t_aux_col1, t_aux_slice1 + j) -= tmp_j; - } - - if(i < t_n_slices) - { - Q.at(t_aux_row1, t_aux_col1, t_aux_slice1 + i) -= x_mem[i]; - } - } - else - if( (t_n_rows == x_n_rows) && (t_n_cols == x_n_cols) && (t_n_slices == 1) ) - { - for(uword col = 0; col < t_n_cols; ++col) - { - arrayops::inplace_minus( t.slice_colptr(0, col), x.colptr(col), t_n_rows ); - } - } - else - if( (t_n_rows == x_n_rows) && (t_n_cols == 1) && (t_n_slices == x_n_cols) ) - { - for(uword i=0; i < t_n_slices; ++i) - { - arrayops::inplace_minus( t.slice_colptr(i, 0), x.colptr(i), t_n_rows ); - } - } - else - if( (t_n_rows == 1) && (t_n_cols == x_n_rows) && (t_n_slices == x_n_cols) ) - { - Cube& Q = const_cast< Cube& >(t.m); - - const uword t_aux_row1 = t.aux_row1; - const uword t_aux_col1 = t.aux_col1; - const uword t_aux_slice1 = t.aux_slice1; - - for(uword slice=0; slice < t_n_slices; ++slice) - { - const uword mod_slice = t_aux_slice1 + slice; - - const eT* x_colptr = x.colptr(slice); - - uword i,j; - for(i=0, j=1; j < t_n_cols; i+=2, j+=2) - { - const eT tmp_i = x_colptr[i]; - const eT tmp_j = x_colptr[j]; - - Q.at(t_aux_row1, t_aux_col1 + i, mod_slice) -= tmp_i; - Q.at(t_aux_row1, t_aux_col1 + j, mod_slice) -= tmp_j; - } - - if(i < t_n_cols) - { - Q.at(t_aux_row1, t_aux_col1 + i, mod_slice) -= x_colptr[i]; - } - } - } - else - { - if(arma_config::check_conform) - { - arma_stop_logic_error( arma_incompat_size_string(t, x, "subtraction") ); - } - } - } - - - -template -template -inline -void -subview_cube::operator%= (const Base& in) - { - arma_debug_sigprint(); - - const quasi_unwrap tmp(in.get_ref()); - - const Mat& x = tmp.M; - subview_cube& t = *this; - - const uword t_n_rows = t.n_rows; - const uword t_n_cols = t.n_cols; - const uword t_n_slices = t.n_slices; - - const uword x_n_rows = x.n_rows; - const uword x_n_cols = x.n_cols; - - if( ((x_n_rows == 1) || (x_n_cols == 1)) && (t_n_rows == 1) && (t_n_cols == 1) && (x.n_elem == t_n_slices) ) - { - Cube& Q = const_cast< Cube& >(t.m); - - const uword t_aux_row1 = t.aux_row1; - const uword t_aux_col1 = t.aux_col1; - const uword t_aux_slice1 = t.aux_slice1; - - const eT* x_mem = x.memptr(); - - uword i,j; - for(i=0, j=1; j < t_n_slices; i+=2, j+=2) - { - const eT tmp_i = x_mem[i]; - const eT tmp_j = x_mem[j]; - - Q.at(t_aux_row1, t_aux_col1, t_aux_slice1 + i) *= tmp_i; - Q.at(t_aux_row1, t_aux_col1, t_aux_slice1 + j) *= tmp_j; - } - - if(i < t_n_slices) - { - Q.at(t_aux_row1, t_aux_col1, t_aux_slice1 + i) *= x_mem[i]; - } - } - else - if( (t_n_rows == x_n_rows) && (t_n_cols == x_n_cols) && (t_n_slices == 1) ) - { - for(uword col = 0; col < t_n_cols; ++col) - { - arrayops::inplace_mul( t.slice_colptr(0, col), x.colptr(col), t_n_rows ); - } - } - else - if( (t_n_rows == x_n_rows) && (t_n_cols == 1) && (t_n_slices == x_n_cols) ) - { - for(uword i=0; i < t_n_slices; ++i) - { - arrayops::inplace_mul( t.slice_colptr(i, 0), x.colptr(i), t_n_rows ); - } - } - else - if( (t_n_rows == 1) && (t_n_cols == x_n_rows) && (t_n_slices == x_n_cols) ) - { - Cube& Q = const_cast< Cube& >(t.m); - - const uword t_aux_row1 = t.aux_row1; - const uword t_aux_col1 = t.aux_col1; - const uword t_aux_slice1 = t.aux_slice1; - - for(uword slice=0; slice < t_n_slices; ++slice) - { - const uword mod_slice = t_aux_slice1 + slice; - - const eT* x_colptr = x.colptr(slice); - - uword i,j; - for(i=0, j=1; j < t_n_cols; i+=2, j+=2) - { - const eT tmp_i = x_colptr[i]; - const eT tmp_j = x_colptr[j]; - - Q.at(t_aux_row1, t_aux_col1 + i, mod_slice) *= tmp_i; - Q.at(t_aux_row1, t_aux_col1 + j, mod_slice) *= tmp_j; - } - - if(i < t_n_cols) - { - Q.at(t_aux_row1, t_aux_col1 + i, mod_slice) *= x_colptr[i]; - } - } - } - else - { - if(arma_config::check_conform) - { - arma_stop_logic_error( arma_incompat_size_string(t, x, "element-wise multiplication") ); - } - } - } - - - -template -template -inline -void -subview_cube::operator/= (const Base& in) - { - arma_debug_sigprint(); - - const quasi_unwrap tmp(in.get_ref()); - - const Mat& x = tmp.M; - subview_cube& t = *this; - - const uword t_n_rows = t.n_rows; - const uword t_n_cols = t.n_cols; - const uword t_n_slices = t.n_slices; - - const uword x_n_rows = x.n_rows; - const uword x_n_cols = x.n_cols; - - if( ((x_n_rows == 1) || (x_n_cols == 1)) && (t_n_rows == 1) && (t_n_cols == 1) && (x.n_elem == t_n_slices) ) - { - Cube& Q = const_cast< Cube& >(t.m); - - const uword t_aux_row1 = t.aux_row1; - const uword t_aux_col1 = t.aux_col1; - const uword t_aux_slice1 = t.aux_slice1; - - const eT* x_mem = x.memptr(); - - uword i,j; - for(i=0, j=1; j < t_n_slices; i+=2, j+=2) - { - const eT tmp_i = x_mem[i]; - const eT tmp_j = x_mem[j]; - - Q.at(t_aux_row1, t_aux_col1, t_aux_slice1 + i) /= tmp_i; - Q.at(t_aux_row1, t_aux_col1, t_aux_slice1 + j) /= tmp_j; - } - - if(i < t_n_slices) - { - Q.at(t_aux_row1, t_aux_col1, t_aux_slice1 + i) /= x_mem[i]; - } - } - else - if( (t_n_rows == x_n_rows) && (t_n_cols == x_n_cols) && (t_n_slices == 1) ) - { - for(uword col = 0; col < t_n_cols; ++col) - { - arrayops::inplace_div( t.slice_colptr(0, col), x.colptr(col), t_n_rows ); - } - } - else - if( (t_n_rows == x_n_rows) && (t_n_cols == 1) && (t_n_slices == x_n_cols) ) - { - for(uword i=0; i < t_n_slices; ++i) - { - arrayops::inplace_div( t.slice_colptr(i, 0), x.colptr(i), t_n_rows ); - } - } - else - if( (t_n_rows == 1) && (t_n_cols == x_n_rows) && (t_n_slices == x_n_cols) ) - { - Cube& Q = const_cast< Cube& >(t.m); - - const uword t_aux_row1 = t.aux_row1; - const uword t_aux_col1 = t.aux_col1; - const uword t_aux_slice1 = t.aux_slice1; - - for(uword slice=0; slice < t_n_slices; ++slice) - { - const uword mod_slice = t_aux_slice1 + slice; - - const eT* x_colptr = x.colptr(slice); - - uword i,j; - for(i=0, j=1; j < t_n_cols; i+=2, j+=2) - { - const eT tmp_i = x_colptr[i]; - const eT tmp_j = x_colptr[j]; - - Q.at(t_aux_row1, t_aux_col1 + i, mod_slice) /= tmp_i; - Q.at(t_aux_row1, t_aux_col1 + j, mod_slice) /= tmp_j; - } - - if(i < t_n_cols) - { - Q.at(t_aux_row1, t_aux_col1 + i, mod_slice) /= x_colptr[i]; - } - } - } - else - { - if(arma_config::check_conform) - { - arma_stop_logic_error( arma_incompat_size_string(t, x, "element-wise division") ); - } - } - } - - - -template -template -inline -void -subview_cube::operator= (const GenCube& in) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(n_rows, n_cols, n_slices, in.n_rows, in.n_cols, in.n_slices, "copy into subcube"); - - in.apply(*this); - } - - - -//! apply a functor to each element -template -template -inline -void -subview_cube::for_each(functor F) - { - arma_debug_sigprint(); - - Cube& Q = const_cast< Cube& >(m); - - const uword start_col = aux_col1; - const uword start_row = aux_row1; - const uword start_slice = aux_slice1; - - const uword end_col_plus1 = start_col + n_cols; - const uword end_row_plus1 = start_row + n_rows; - const uword end_slice_plus1 = start_slice + n_slices; - - for(uword uslice = start_slice; uslice < end_slice_plus1; ++uslice) - for(uword ucol = start_col; ucol < end_col_plus1; ++ucol ) - for(uword urow = start_row; urow < end_row_plus1; ++urow ) - { - F( Q.at(urow, ucol, uslice) ); - } - } - - - -template -template -inline -void -subview_cube::for_each(functor F) const - { - arma_debug_sigprint(); - - const Cube& Q = m; - - const uword start_col = aux_col1; - const uword start_row = aux_row1; - const uword start_slice = aux_slice1; - - const uword end_col_plus1 = start_col + n_cols; - const uword end_row_plus1 = start_row + n_rows; - const uword end_slice_plus1 = start_slice + n_slices; - - for(uword uslice = start_slice; uslice < end_slice_plus1; ++uslice) - for(uword ucol = start_col; ucol < end_col_plus1; ++ucol ) - for(uword urow = start_row; urow < end_row_plus1; ++urow ) - { - F( Q.at(urow, ucol, uslice) ); - } - } - - - -//! transform each element in the subview using a functor -template -template -inline -void -subview_cube::transform(functor F) - { - arma_debug_sigprint(); - - Cube& Q = const_cast< Cube& >(m); - - const uword start_col = aux_col1; - const uword start_row = aux_row1; - const uword start_slice = aux_slice1; - - const uword end_col_plus1 = start_col + n_cols; - const uword end_row_plus1 = start_row + n_rows; - const uword end_slice_plus1 = start_slice + n_slices; - - for(uword uslice = start_slice; uslice < end_slice_plus1; ++uslice) - for(uword ucol = start_col; ucol < end_col_plus1; ++ucol ) - for(uword urow = start_row; urow < end_row_plus1; ++urow ) - { - Q.at(urow, ucol, uslice) = eT( F( Q.at(urow, ucol, uslice) ) ); - } - } - - - -//! imbue (fill) the subview with values provided by a functor -template -template -inline -void -subview_cube::imbue(functor F) - { - arma_debug_sigprint(); - - Cube& Q = const_cast< Cube& >(m); - - const uword start_col = aux_col1; - const uword start_row = aux_row1; - const uword start_slice = aux_slice1; - - const uword end_col_plus1 = start_col + n_cols; - const uword end_row_plus1 = start_row + n_rows; - const uword end_slice_plus1 = start_slice + n_slices; - - for(uword uslice = start_slice; uslice < end_slice_plus1; ++uslice) - for(uword ucol = start_col; ucol < end_col_plus1; ++ucol ) - for(uword urow = start_row; urow < end_row_plus1; ++urow ) - { - Q.at(urow, ucol, uslice) = eT( F() ); - } - } - - - -//! apply a lambda function to each slice, where each slice is interpreted as a matrix -template -inline -void -subview_cube::each_slice(const std::function< void(Mat&) >& F) - { - arma_debug_sigprint(); - - Mat tmp1(n_rows, n_cols, arma_nozeros_indicator()); - Mat tmp2('j', tmp1.memptr(), n_rows, n_cols); - - for(uword slice_id=0; slice_id < n_slices; ++slice_id) - { - for(uword col_id=0; col_id < n_cols; ++col_id) - { - arrayops::copy( tmp1.colptr(col_id), slice_colptr(slice_id, col_id), n_rows ); - } - - F(tmp2); - - for(uword col_id=0; col_id < n_cols; ++col_id) - { - arrayops::copy( slice_colptr(slice_id, col_id), tmp1.colptr(col_id), n_rows ); - } - } - } - - - -template -inline -void -subview_cube::each_slice(const std::function< void(const Mat&) >& F) const - { - arma_debug_sigprint(); - - Mat tmp1(n_rows, n_cols, arma_nozeros_indicator()); - const Mat tmp2('j', tmp1.memptr(), n_rows, n_cols); - - for(uword slice_id=0; slice_id < n_slices; ++slice_id) - { - for(uword col_id=0; col_id < n_cols; ++col_id) - { - arrayops::copy( tmp1.colptr(col_id), slice_colptr(slice_id, col_id), n_rows ); - } - - F(tmp2); - } - } - - - -template -inline -void -subview_cube::replace(const eT old_val, const eT new_val) - { - arma_debug_sigprint(); - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - const uword local_n_slices = n_slices; - - for(uword slice = 0; slice < local_n_slices; ++slice) - { - for(uword col = 0; col < local_n_cols; ++col) - { - arrayops::replace(slice_colptr(slice,col), local_n_rows, old_val, new_val); - } - } - } - - - -template -inline -void -subview_cube::clean(const typename get_pod_type::result threshold) - { - arma_debug_sigprint(); - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - const uword local_n_slices = n_slices; - - for(uword slice = 0; slice < local_n_slices; ++slice) - { - for(uword col = 0; col < local_n_cols; ++col) - { - arrayops::clean( slice_colptr(slice,col), local_n_rows, threshold ); - } - } - } - - - -template -inline -void -subview_cube::clamp(const eT min_val, const eT max_val) - { - arma_debug_sigprint(); - - if(is_cx::no) - { - arma_conform_check( (access::tmp_real(min_val) > access::tmp_real(max_val)), "subview_cube::clamp(): min_val must be less than max_val" ); - } - else - { - arma_conform_check( (access::tmp_real(min_val) > access::tmp_real(max_val)), "subview_cube::clamp(): real(min_val) must be less than real(max_val)" ); - arma_conform_check( (access::tmp_imag(min_val) > access::tmp_imag(max_val)), "subview_cube::clamp(): imag(min_val) must be less than imag(max_val)" ); - } - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - const uword local_n_slices = n_slices; - - for(uword slice = 0; slice < local_n_slices; ++slice) - { - for(uword col = 0; col < local_n_cols; ++col) - { - arrayops::clamp( slice_colptr(slice,col), local_n_rows, min_val, max_val ); - } - } - } - - - -template -inline -void -subview_cube::fill(const eT val) - { - arma_debug_sigprint(); - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - const uword local_n_slices = n_slices; - - for(uword slice = 0; slice < local_n_slices; ++slice) - { - for(uword col = 0; col < local_n_cols; ++col) - { - arrayops::inplace_set( slice_colptr(slice,col), val, local_n_rows ); - } - } - } - - - -template -inline -void -subview_cube::zeros() - { - arma_debug_sigprint(); - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - const uword local_n_slices = n_slices; - - for(uword slice = 0; slice < local_n_slices; ++slice) - { - for(uword col = 0; col < local_n_cols; ++col) - { - arrayops::fill_zeros( slice_colptr(slice,col), local_n_rows ); - } - } - } - - - -template -inline -void -subview_cube::ones() - { - arma_debug_sigprint(); - - fill(eT(1)); - } - - - -template -inline -void -subview_cube::randu() - { - arma_debug_sigprint(); - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - const uword local_n_slices = n_slices; - - for(uword slice = 0; slice < local_n_slices; ++slice) - { - for(uword col = 0; col < local_n_cols; ++col) - { - arma_rng::randu::fill( slice_colptr(slice,col), local_n_rows ); - } - } - } - - - -template -inline -void -subview_cube::randn() - { - arma_debug_sigprint(); - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - const uword local_n_slices = n_slices; - - for(uword slice = 0; slice < local_n_slices; ++slice) - { - for(uword col = 0; col < local_n_cols; ++col) - { - arma_rng::randn::fill( slice_colptr(slice,col), local_n_rows ); - } - } - } - - - -template -inline -bool -subview_cube::is_finite() const - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "is_finite(): detection of non-finite values is not reliable in fast math mode"); } - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - const uword local_n_slices = n_slices; - - for(uword slice = 0; slice < local_n_slices; ++slice) - { - for(uword col = 0; col < local_n_cols; ++col) - { - if(arrayops::is_finite(slice_colptr(slice,col), local_n_rows) == false) { return false; } - } - } - - return true; - } - - - -template -inline -bool -subview_cube::is_zero(const typename get_pod_type::result tol) const - { - arma_debug_sigprint(); - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - const uword local_n_slices = n_slices; - - for(uword slice = 0; slice < local_n_slices; ++slice) - { - for(uword col = 0; col < local_n_cols; ++col) - { - if(arrayops::is_zero(slice_colptr(slice,col), local_n_rows, tol) == false) { return false; } - } - } - - return true; - } - - - -template -inline -bool -subview_cube::has_inf() const - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "has_inf(): detection of non-finite values is not reliable in fast math mode"); } - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - const uword local_n_slices = n_slices; - - for(uword slice = 0; slice < local_n_slices; ++slice) - { - for(uword col = 0; col < local_n_cols; ++col) - { - if(arrayops::has_inf(slice_colptr(slice,col), local_n_rows)) { return true; } - } - } - - return false; - } - - - -template -inline -bool -subview_cube::has_nan() const - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "has_nan(): detection of non-finite values is not reliable in fast math mode"); } - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - const uword local_n_slices = n_slices; - - for(uword slice = 0; slice < local_n_slices; ++slice) - { - for(uword col = 0; col < local_n_cols; ++col) - { - if(arrayops::has_nan(slice_colptr(slice,col), local_n_rows)) { return true; } - } - } - - return false; - } - - - -template -inline -bool -subview_cube::has_nonfinite() const - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "has_nonfinite(): detection of non-finite values is not reliable in fast math mode"); } - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - const uword local_n_slices = n_slices; - - for(uword slice = 0; slice < local_n_slices; ++slice) - { - for(uword col = 0; col < local_n_cols; ++col) - { - if(arrayops::is_finite(slice_colptr(slice,col), local_n_rows) == false) { return true; } - } - } - - return false; - } - - - -template -inline -eT -subview_cube::at_alt(const uword i) const - { - return operator[](i); - } - - - -template -inline -eT& -subview_cube::operator[](const uword i) - { - const uword in_slice = i / n_elem_slice; - const uword offset = in_slice * n_elem_slice; - const uword j = i - offset; - - const uword in_col = j / n_rows; - const uword in_row = j % n_rows; - - const uword index = (in_slice + aux_slice1)*m.n_elem_slice + (in_col + aux_col1)*m.n_rows + aux_row1 + in_row; - - return access::rw( (const_cast< Cube& >(m)).mem[index] ); - } - - - -template -inline -eT -subview_cube::operator[](const uword i) const - { - const uword in_slice = i / n_elem_slice; - const uword offset = in_slice * n_elem_slice; - const uword j = i - offset; - - const uword in_col = j / n_rows; - const uword in_row = j % n_rows; - - const uword index = (in_slice + aux_slice1)*m.n_elem_slice + (in_col + aux_col1)*m.n_rows + aux_row1 + in_row; - - return m.mem[index]; - } - - - -template -inline -eT& -subview_cube::operator()(const uword i) - { - arma_conform_check_bounds( (i >= n_elem), "subview_cube::operator(): index out of bounds" ); - - const uword in_slice = i / n_elem_slice; - const uword offset = in_slice * n_elem_slice; - const uword j = i - offset; - - const uword in_col = j / n_rows; - const uword in_row = j % n_rows; - - const uword index = (in_slice + aux_slice1)*m.n_elem_slice + (in_col + aux_col1)*m.n_rows + aux_row1 + in_row; - - return access::rw( (const_cast< Cube& >(m)).mem[index] ); - } - - - -template -inline -eT -subview_cube::operator()(const uword i) const - { - arma_conform_check_bounds( (i >= n_elem), "subview_cube::operator(): index out of bounds" ); - - const uword in_slice = i / n_elem_slice; - const uword offset = in_slice * n_elem_slice; - const uword j = i - offset; - - const uword in_col = j / n_rows; - const uword in_row = j % n_rows; - - const uword index = (in_slice + aux_slice1)*m.n_elem_slice + (in_col + aux_col1)*m.n_rows + aux_row1 + in_row; - - return m.mem[index]; - } - - - -template -arma_inline -eT& -subview_cube::operator()(const uword in_row, const uword in_col, const uword in_slice) - { - arma_conform_check_bounds( ( (in_row >= n_rows) || (in_col >= n_cols) || (in_slice >= n_slices) ), "subview_cube::operator(): location out of bounds" ); - - const uword index = (in_slice + aux_slice1)*m.n_elem_slice + (in_col + aux_col1)*m.n_rows + aux_row1 + in_row; - - return access::rw( (const_cast< Cube& >(m)).mem[index] ); - } - - - -template -arma_inline -eT -subview_cube::operator()(const uword in_row, const uword in_col, const uword in_slice) const - { - arma_conform_check_bounds( ( (in_row >= n_rows) || (in_col >= n_cols) || (in_slice >= n_slices) ), "subview_cube::operator(): location out of bounds" ); - - const uword index = (in_slice + aux_slice1)*m.n_elem_slice + (in_col + aux_col1)*m.n_rows + aux_row1 + in_row; - - return m.mem[index]; - } - - - -template -arma_inline -eT& -subview_cube::at(const uword in_row, const uword in_col, const uword in_slice) - { - const uword index = (in_slice + aux_slice1)*m.n_elem_slice + (in_col + aux_col1)*m.n_rows + aux_row1 + in_row; - - return access::rw( (const_cast< Cube& >(m)).mem[index] ); - } - - - -template -arma_inline -eT -subview_cube::at(const uword in_row, const uword in_col, const uword in_slice) const - { - const uword index = (in_slice + aux_slice1)*m.n_elem_slice + (in_col + aux_col1)*m.n_rows + aux_row1 + in_row; - - return m.mem[index]; - } - - - -template -arma_inline -eT* -subview_cube::slice_colptr(const uword in_slice, const uword in_col) - { - return & access::rw((const_cast< Cube& >(m)).mem[ (in_slice + aux_slice1)*m.n_elem_slice + (in_col + aux_col1)*m.n_rows + aux_row1 ]); - } - - - -template -arma_inline -const eT* -subview_cube::slice_colptr(const uword in_slice, const uword in_col) const - { - return & m.mem[ (in_slice + aux_slice1)*m.n_elem_slice + (in_col + aux_col1)*m.n_rows + aux_row1 ]; - } - - - -template -template -inline -bool -subview_cube::check_overlap(const subview_cube& x) const - { - if(is_same_type::value == false) { return false; } - - const subview_cube& t = (*this); - - if(void_ptr(&(t.m)) != void_ptr(&(x.m))) { return false; } - - if( (t.n_elem == 0) || (x.n_elem == 0) ) { return false; } - - const uword t_row_start = t.aux_row1; - const uword t_row_end_p1 = t_row_start + t.n_rows; - - const uword t_col_start = t.aux_col1; - const uword t_col_end_p1 = t_col_start + t.n_cols; - - const uword t_slice_start = t.aux_slice1; - const uword t_slice_end_p1 = t_slice_start + t.n_slices; - - - const uword x_row_start = x.aux_row1; - const uword x_row_end_p1 = x_row_start + x.n_rows; - - const uword x_col_start = x.aux_col1; - const uword x_col_end_p1 = x_col_start + x.n_cols; - - const uword x_slice_start = x.aux_slice1; - const uword x_slice_end_p1 = x_slice_start + x.n_slices; - - - const bool outside_rows = ( (x_row_start >= t_row_end_p1 ) || (t_row_start >= x_row_end_p1 ) ); - const bool outside_cols = ( (x_col_start >= t_col_end_p1 ) || (t_col_start >= x_col_end_p1 ) ); - const bool outside_slices = ( (x_slice_start >= t_slice_end_p1) || (t_slice_start >= x_slice_end_p1) ); - - return ( (outside_rows == false) && (outside_cols == false) && (outside_slices == false) ); - } - - - -template -inline -bool -subview_cube::check_overlap(const Mat& x) const - { - const subview_cube& t = *this; - - const uword t_aux_slice1 = t.aux_slice1; - const uword t_aux_slice2_plus_1 = t_aux_slice1 + t.n_slices; - - for(uword slice = t_aux_slice1; slice < t_aux_slice2_plus_1; ++slice) - { - if(t.m.mat_ptrs[slice] != nullptr) - { - const Mat& y = *(t.m.mat_ptrs[slice]); - - if( x.memptr() == y.memptr() ) { return true; } - } - } - - return false; - } - - - -//! cube X = Y.subcube(...) -template -inline -void -subview_cube::extract(Cube& out, const subview_cube& in) - { - arma_debug_sigprint(); - - // NOTE: we're assuming that the cube has already been set to the correct size and there is no aliasing; - // size setting and alias checking is done by either the Cube contructor or operator=() - - const uword n_rows = in.n_rows; - const uword n_cols = in.n_cols; - const uword n_slices = in.n_slices; - - arma_debug_print(arma_str::format("out.n_rows: %u; out.n_cols: %u; out.n_slices: %u; in.m.n_rows: %u; in.m.n_cols: %u; in.m.n_slices: %u") % out.n_rows % out.n_cols % out.n_slices % in.m.n_rows % in.m.n_cols % in.m.n_slices); - - if( (in.aux_row1 == 0) && (n_rows == in.m.n_rows) ) - { - for(uword s=0; s < n_slices; ++s) - { - arrayops::copy( out.slice_colptr(s,0), in.slice_colptr(s,0), in.n_elem_slice ); - } - - return; - } - - for(uword s=0; s < n_slices; ++s) - for(uword c=0; c < n_cols; ++c) - { - arrayops::copy( out.slice_colptr(s,c), in.slice_colptr(s,c), n_rows ); - } - } - - - -//! cube X += Y.subcube(...) -template -inline -void -subview_cube::plus_inplace(Cube& out, const subview_cube& in) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(out, in, "addition"); - - const uword n_rows = out.n_rows; - const uword n_cols = out.n_cols; - const uword n_slices = out.n_slices; - - for(uword slice = 0; slice -inline -void -subview_cube::minus_inplace(Cube& out, const subview_cube& in) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(out, in, "subtraction"); - - const uword n_rows = out.n_rows; - const uword n_cols = out.n_cols; - const uword n_slices = out.n_slices; - - for(uword slice = 0; slice -inline -void -subview_cube::schur_inplace(Cube& out, const subview_cube& in) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(out, in, "element-wise multiplication"); - - const uword n_rows = out.n_rows; - const uword n_cols = out.n_cols; - const uword n_slices = out.n_slices; - - for(uword slice = 0; slice -inline -void -subview_cube::div_inplace(Cube& out, const subview_cube& in) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(out, in, "element-wise division"); - - const uword n_rows = out.n_rows; - const uword n_cols = out.n_cols; - const uword n_slices = out.n_slices; - - for(uword slice = 0; slice -inline -void -subview_cube::extract(Mat& out, const subview_cube& in) - { - arma_debug_sigprint(); - - arma_conform_assert_cube_as_mat(out, in, "copy into matrix", false); - - const uword in_n_rows = in.n_rows; - const uword in_n_cols = in.n_cols; - const uword in_n_slices = in.n_slices; - - const uword out_vec_state = out.vec_state; - - if(in_n_slices == 1) - { - out.set_size(in_n_rows, in_n_cols); - - for(uword col=0; col < in_n_cols; ++col) - { - arrayops::copy( out.colptr(col), in.slice_colptr(0, col), in_n_rows ); - } - } - else - { - if(out_vec_state == 0) - { - if(in_n_cols == 1) - { - out.set_size(in_n_rows, in_n_slices); - - for(uword i=0; i < in_n_slices; ++i) - { - arrayops::copy( out.colptr(i), in.slice_colptr(i, 0), in_n_rows ); - } - } - else - if(in_n_rows == 1) - { - const Cube& Q = in.m; - - const uword in_aux_row1 = in.aux_row1; - const uword in_aux_col1 = in.aux_col1; - const uword in_aux_slice1 = in.aux_slice1; - - out.set_size(in_n_cols, in_n_slices); - - for(uword slice=0; slice < in_n_slices; ++slice) - { - const uword mod_slice = in_aux_slice1 + slice; - - eT* out_colptr = out.colptr(slice); - - uword i,j; - for(i=0, j=1; j < in_n_cols; i+=2, j+=2) - { - const eT tmp_i = Q.at(in_aux_row1, in_aux_col1 + i, mod_slice); - const eT tmp_j = Q.at(in_aux_row1, in_aux_col1 + j, mod_slice); - - out_colptr[i] = tmp_i; - out_colptr[j] = tmp_j; - } - - if(i < in_n_cols) - { - out_colptr[i] = Q.at(in_aux_row1, in_aux_col1 + i, mod_slice); - } - } - } - } - else - { - out.set_size(in_n_slices); - - eT* out_mem = out.memptr(); - - const Cube& Q = in.m; - - const uword in_aux_row1 = in.aux_row1; - const uword in_aux_col1 = in.aux_col1; - const uword in_aux_slice1 = in.aux_slice1; - - for(uword i=0; i -inline -void -subview_cube::plus_inplace(Mat& out, const subview_cube& in) - { - arma_debug_sigprint(); - - arma_conform_assert_cube_as_mat(out, in, "addition", true); - - const uword in_n_rows = in.n_rows; - const uword in_n_cols = in.n_cols; - const uword in_n_slices = in.n_slices; - - const uword out_n_rows = out.n_rows; - const uword out_n_cols = out.n_cols; - const uword out_vec_state = out.vec_state; - - if(in_n_slices == 1) - { - if( (arma_config::check_conform) && ((out_n_rows != in_n_rows) || (out_n_cols != in_n_cols)) ) - { - std::ostringstream tmp; - - tmp - << "in-place addition: " - << out_n_rows << 'x' << out_n_cols << " output matrix is incompatible with " - << in_n_rows << 'x' << in_n_cols << 'x' << in_n_slices << " cube interpreted as " - << in_n_rows << 'x' << in_n_cols << " matrix"; - - arma_stop_logic_error(tmp.str()); - } - - for(uword col=0; col < in_n_cols; ++col) - { - arrayops::inplace_plus( out.colptr(col), in.slice_colptr(0, col), in_n_rows ); - } - } - else - { - if(out_vec_state == 0) - { - if( (in_n_rows == out_n_rows) && (in_n_cols == 1) && (in_n_slices == out_n_cols) ) - { - for(uword i=0; i < in_n_slices; ++i) - { - arrayops::inplace_plus( out.colptr(i), in.slice_colptr(i, 0), in_n_rows ); - } - } - else - if( (in_n_rows == 1) && (in_n_cols == out_n_rows) && (in_n_slices == out_n_cols) ) - { - const Cube& Q = in.m; - - const uword in_aux_row1 = in.aux_row1; - const uword in_aux_col1 = in.aux_col1; - const uword in_aux_slice1 = in.aux_slice1; - - for(uword slice=0; slice < in_n_slices; ++slice) - { - const uword mod_slice = in_aux_slice1 + slice; - - eT* out_colptr = out.colptr(slice); - - uword i,j; - for(i=0, j=1; j < in_n_cols; i+=2, j+=2) - { - const eT tmp_i = Q.at(in_aux_row1, in_aux_col1 + i, mod_slice); - const eT tmp_j = Q.at(in_aux_row1, in_aux_col1 + j, mod_slice); - - out_colptr[i] += tmp_i; - out_colptr[j] += tmp_j; - } - - if(i < in_n_cols) - { - out_colptr[i] += Q.at(in_aux_row1, in_aux_col1 + i, mod_slice); - } - } - } - } - else - { - eT* out_mem = out.memptr(); - - const Cube& Q = in.m; - - const uword in_aux_row1 = in.aux_row1; - const uword in_aux_col1 = in.aux_col1; - const uword in_aux_slice1 = in.aux_slice1; - - for(uword i=0; i -inline -void -subview_cube::minus_inplace(Mat& out, const subview_cube& in) - { - arma_debug_sigprint(); - - arma_conform_assert_cube_as_mat(out, in, "subtraction", true); - - const uword in_n_rows = in.n_rows; - const uword in_n_cols = in.n_cols; - const uword in_n_slices = in.n_slices; - - const uword out_n_rows = out.n_rows; - const uword out_n_cols = out.n_cols; - const uword out_vec_state = out.vec_state; - - if(in_n_slices == 1) - { - if( (arma_config::check_conform) && ((out_n_rows != in_n_rows) || (out_n_cols != in_n_cols)) ) - { - std::ostringstream tmp; - - tmp - << "in-place subtraction: " - << out_n_rows << 'x' << out_n_cols << " output matrix is incompatible with " - << in_n_rows << 'x' << in_n_cols << 'x' << in_n_slices << " cube interpreted as " - << in_n_rows << 'x' << in_n_cols << " matrix"; - - arma_stop_logic_error(tmp.str()); - } - - for(uword col=0; col < in_n_cols; ++col) - { - arrayops::inplace_minus( out.colptr(col), in.slice_colptr(0, col), in_n_rows ); - } - } - else - { - if(out_vec_state == 0) - { - if( (in_n_rows == out_n_rows) && (in_n_cols == 1) && (in_n_slices == out_n_cols) ) - { - for(uword i=0; i < in_n_slices; ++i) - { - arrayops::inplace_minus( out.colptr(i), in.slice_colptr(i, 0), in_n_rows ); - } - } - else - if( (in_n_rows == 1) && (in_n_cols == out_n_rows) && (in_n_slices == out_n_cols) ) - { - const Cube& Q = in.m; - - const uword in_aux_row1 = in.aux_row1; - const uword in_aux_col1 = in.aux_col1; - const uword in_aux_slice1 = in.aux_slice1; - - for(uword slice=0; slice < in_n_slices; ++slice) - { - const uword mod_slice = in_aux_slice1 + slice; - - eT* out_colptr = out.colptr(slice); - - uword i,j; - for(i=0, j=1; j < in_n_cols; i+=2, j+=2) - { - const eT tmp_i = Q.at(in_aux_row1, in_aux_col1 + i, mod_slice); - const eT tmp_j = Q.at(in_aux_row1, in_aux_col1 + j, mod_slice); - - out_colptr[i] -= tmp_i; - out_colptr[j] -= tmp_j; - } - - if(i < in_n_cols) - { - out_colptr[i] -= Q.at(in_aux_row1, in_aux_col1 + i, mod_slice); - } - } - } - } - else - { - eT* out_mem = out.memptr(); - - const Cube& Q = in.m; - - const uword in_aux_row1 = in.aux_row1; - const uword in_aux_col1 = in.aux_col1; - const uword in_aux_slice1 = in.aux_slice1; - - for(uword i=0; i -inline -void -subview_cube::schur_inplace(Mat& out, const subview_cube& in) - { - arma_debug_sigprint(); - - arma_conform_assert_cube_as_mat(out, in, "element-wise multiplication", true); - - const uword in_n_rows = in.n_rows; - const uword in_n_cols = in.n_cols; - const uword in_n_slices = in.n_slices; - - const uword out_n_rows = out.n_rows; - const uword out_n_cols = out.n_cols; - const uword out_vec_state = out.vec_state; - - if(in_n_slices == 1) - { - if( (arma_config::check_conform) && ((out_n_rows != in_n_rows) || (out_n_cols != in_n_cols)) ) - { - std::ostringstream tmp; - - tmp - << "in-place element-wise multiplication: " - << out_n_rows << 'x' << out_n_cols << " output matrix is incompatible with " - << in_n_rows << 'x' << in_n_cols << 'x' << in_n_slices << " cube interpreted as " - << in_n_rows << 'x' << in_n_cols << " matrix"; - - arma_stop_logic_error(tmp.str()); - } - - for(uword col=0; col < in_n_cols; ++col) - { - arrayops::inplace_mul( out.colptr(col), in.slice_colptr(0, col), in_n_rows ); - } - } - else - { - if(out_vec_state == 0) - { - if( (in_n_rows == out_n_rows) && (in_n_cols == 1) && (in_n_slices == out_n_cols) ) - { - for(uword i=0; i < in_n_slices; ++i) - { - arrayops::inplace_mul( out.colptr(i), in.slice_colptr(i, 0), in_n_rows ); - } - } - else - if( (in_n_rows == 1) && (in_n_cols == out_n_rows) && (in_n_slices == out_n_cols) ) - { - const Cube& Q = in.m; - - const uword in_aux_row1 = in.aux_row1; - const uword in_aux_col1 = in.aux_col1; - const uword in_aux_slice1 = in.aux_slice1; - - for(uword slice=0; slice < in_n_slices; ++slice) - { - const uword mod_slice = in_aux_slice1 + slice; - - eT* out_colptr = out.colptr(slice); - - uword i,j; - for(i=0, j=1; j < in_n_cols; i+=2, j+=2) - { - const eT tmp_i = Q.at(in_aux_row1, in_aux_col1 + i, mod_slice); - const eT tmp_j = Q.at(in_aux_row1, in_aux_col1 + j, mod_slice); - - out_colptr[i] *= tmp_i; - out_colptr[j] *= tmp_j; - } - - if(i < in_n_cols) - { - out_colptr[i] *= Q.at(in_aux_row1, in_aux_col1 + i, mod_slice); - } - } - } - } - else - { - eT* out_mem = out.memptr(); - - const Cube& Q = in.m; - - const uword in_aux_row1 = in.aux_row1; - const uword in_aux_col1 = in.aux_col1; - const uword in_aux_slice1 = in.aux_slice1; - - for(uword i=0; i -inline -void -subview_cube::div_inplace(Mat& out, const subview_cube& in) - { - arma_debug_sigprint(); - - arma_conform_assert_cube_as_mat(out, in, "element-wise division", true); - - const uword in_n_rows = in.n_rows; - const uword in_n_cols = in.n_cols; - const uword in_n_slices = in.n_slices; - - const uword out_n_rows = out.n_rows; - const uword out_n_cols = out.n_cols; - const uword out_vec_state = out.vec_state; - - if(in_n_slices == 1) - { - if( (arma_config::check_conform) && ((out_n_rows != in_n_rows) || (out_n_cols != in_n_cols)) ) - { - std::ostringstream tmp; - - tmp - << "in-place element-wise division: " - << out_n_rows << 'x' << out_n_cols << " output matrix is incompatible with " - << in_n_rows << 'x' << in_n_cols << 'x' << in_n_slices << " cube interpreted as " - << in_n_rows << 'x' << in_n_cols << " matrix"; - - arma_stop_logic_error(tmp.str()); - } - - for(uword col=0; col < in_n_cols; ++col) - { - arrayops::inplace_div( out.colptr(col), in.slice_colptr(0, col), in_n_rows ); - } - } - else - { - if(out_vec_state == 0) - { - if( (in_n_rows == out_n_rows) && (in_n_cols == 1) && (in_n_slices == out_n_cols) ) - { - for(uword i=0; i < in_n_slices; ++i) - { - arrayops::inplace_div( out.colptr(i), in.slice_colptr(i, 0), in_n_rows ); - } - } - else - if( (in_n_rows == 1) && (in_n_cols == out_n_rows) && (in_n_slices == out_n_cols) ) - { - const Cube& Q = in.m; - - const uword in_aux_row1 = in.aux_row1; - const uword in_aux_col1 = in.aux_col1; - const uword in_aux_slice1 = in.aux_slice1; - - for(uword slice=0; slice < in_n_slices; ++slice) - { - const uword mod_slice = in_aux_slice1 + slice; - - eT* out_colptr = out.colptr(slice); - - uword i,j; - for(i=0, j=1; j < in_n_cols; i+=2, j+=2) - { - const eT tmp_i = Q.at(in_aux_row1, in_aux_col1 + i, mod_slice); - const eT tmp_j = Q.at(in_aux_row1, in_aux_col1 + j, mod_slice); - - out_colptr[i] /= tmp_i; - out_colptr[j] /= tmp_j; - } - - if(i < in_n_cols) - { - out_colptr[i] /= Q.at(in_aux_row1, in_aux_col1 + i, mod_slice); - } - } - } - } - else - { - eT* out_mem = out.memptr(); - - const Cube& Q = in.m; - - const uword in_aux_row1 = in.aux_row1; - const uword in_aux_col1 = in.aux_col1; - const uword in_aux_slice1 = in.aux_slice1; - - for(uword i=0; i -inline -typename subview_cube::iterator -subview_cube::begin() - { - return iterator(*this, aux_row1, aux_col1, aux_slice1); - } - - - -template -inline -typename subview_cube::const_iterator -subview_cube::begin() const - { - return const_iterator(*this, aux_row1, aux_col1, aux_slice1); - } - - - -template -inline -typename subview_cube::const_iterator -subview_cube::cbegin() const - { - return const_iterator(*this, aux_row1, aux_col1, aux_slice1); - } - - - -template -inline -typename subview_cube::iterator -subview_cube::end() - { - return iterator(*this, aux_row1, aux_col1, aux_slice1 + n_slices); - } - - - -template -inline -typename subview_cube::const_iterator -subview_cube::end() const - { - return const_iterator(*this, aux_row1, aux_col1, aux_slice1 + n_slices); - } - - - -template -inline -typename subview_cube::const_iterator -subview_cube::cend() const - { - return const_iterator(*this, aux_row1, aux_col1, aux_slice1 + n_slices); - } - - - -// -// -// - - - -template -inline -subview_cube::iterator::iterator() - : M (nullptr) - , current_ptr (nullptr) - , current_row (0 ) - , current_col (0 ) - , current_slice(0 ) - , aux_row1 (0 ) - , aux_col1 (0 ) - , aux_row2_p1 (0 ) - , aux_col2_p1 (0 ) - { - arma_debug_sigprint(); - // Technically this iterator is invalid (it does not point to a valid element) - } - - - -template -inline -subview_cube::iterator::iterator(const iterator& X) - : M (X.M ) - , current_ptr (X.current_ptr ) - , current_row (X.current_row ) - , current_col (X.current_col ) - , current_slice(X.current_slice) - , aux_row1 (X.aux_row1 ) - , aux_col1 (X.aux_col1 ) - , aux_row2_p1 (X.aux_row2_p1 ) - , aux_col2_p1 (X.aux_col2_p1 ) - { - arma_debug_sigprint(); - } - - - -template -inline -subview_cube::iterator::iterator(subview_cube& in_sv, const uword in_row, const uword in_col, const uword in_slice) - : M (&(const_cast< Cube& >(in_sv.m))) - , current_ptr (&(M->at(in_row,in_col,in_slice)) ) - , current_row (in_row ) - , current_col (in_col ) - , current_slice(in_slice ) - , aux_row1 (in_sv.aux_row1 ) - , aux_col1 (in_sv.aux_col1 ) - , aux_row2_p1 (in_sv.aux_row1 + in_sv.n_rows ) - , aux_col2_p1 (in_sv.aux_col1 + in_sv.n_cols ) - { - arma_debug_sigprint(); - } - - - -template -inline -eT& -subview_cube::iterator::operator*() - { - return (*current_ptr); - } - - - -template -inline -typename subview_cube::iterator& -subview_cube::iterator::operator++() - { - current_row++; - - if(current_row == aux_row2_p1) - { - current_row = aux_row1; - current_col++; - - if(current_col == aux_col2_p1) - { - current_col = aux_col1; - current_slice++; - } - - current_ptr = &( (*M).at(current_row,current_col,current_slice) ); - } - else - { - current_ptr++; - } - - return *this; - } - - - -template -inline -typename subview_cube::iterator -subview_cube::iterator::operator++(int) - { - typename subview_cube::iterator temp(*this); - - ++(*this); - - return temp; - } - - - -template -inline -bool -subview_cube::iterator::operator==(const iterator& rhs) const - { - return (current_ptr == rhs.current_ptr); - } - - - -template -inline -bool -subview_cube::iterator::operator!=(const iterator& rhs) const - { - return (current_ptr != rhs.current_ptr); - } - - - -template -inline -bool -subview_cube::iterator::operator==(const const_iterator& rhs) const - { - return (current_ptr == rhs.current_ptr); - } - - - -template -inline -bool -subview_cube::iterator::operator!=(const const_iterator& rhs) const - { - return (current_ptr != rhs.current_ptr); - } - - - -// -// -// - - - -template -inline -subview_cube::const_iterator::const_iterator() - : M (nullptr) - , current_ptr (nullptr) - , current_row (0 ) - , current_col (0 ) - , current_slice(0 ) - , aux_row1 (0 ) - , aux_col1 (0 ) - , aux_row2_p1 (0 ) - , aux_col2_p1 (0 ) - { - arma_debug_sigprint(); - // Technically this iterator is invalid (it does not point to a valid element) - } - - - -template -inline -subview_cube::const_iterator::const_iterator(const iterator& X) - : M (X.M ) - , current_ptr (X.current_ptr ) - , current_row (X.current_row ) - , current_col (X.current_col ) - , current_slice(X.current_slice) - , aux_row1 (X.aux_row1 ) - , aux_col1 (X.aux_col1 ) - , aux_row2_p1 (X.aux_row2_p1 ) - , aux_col2_p1 (X.aux_col2_p1 ) - { - arma_debug_sigprint(); - } - - - -template -inline -subview_cube::const_iterator::const_iterator(const const_iterator& X) - : M (X.M ) - , current_ptr (X.current_ptr ) - , current_row (X.current_row ) - , current_col (X.current_col ) - , current_slice(X.current_slice) - , aux_row1 (X.aux_row1 ) - , aux_col1 (X.aux_col1 ) - , aux_row2_p1 (X.aux_row2_p1 ) - , aux_col2_p1 (X.aux_col2_p1 ) - { - arma_debug_sigprint(); - } - - - -template -inline -subview_cube::const_iterator::const_iterator(const subview_cube& in_sv, const uword in_row, const uword in_col, const uword in_slice) - : M (&(in_sv.m) ) - , current_ptr (&(M->at(in_row,in_col,in_slice))) - , current_row (in_row ) - , current_col (in_col ) - , current_slice(in_slice ) - , aux_row1 (in_sv.aux_row1 ) - , aux_col1 (in_sv.aux_col1 ) - , aux_row2_p1 (in_sv.aux_row1 + in_sv.n_rows ) - , aux_col2_p1 (in_sv.aux_col1 + in_sv.n_cols ) - { - arma_debug_sigprint(); - } - - - -template -inline -const eT& -subview_cube::const_iterator::operator*() - { - return (*current_ptr); - } - - - -template -inline -typename subview_cube::const_iterator& -subview_cube::const_iterator::operator++() - { - current_row++; - - if(current_row == aux_row2_p1) - { - current_row = aux_row1; - current_col++; - - if(current_col == aux_col2_p1) - { - current_col = aux_col1; - current_slice++; - } - - current_ptr = &( (*M).at(current_row,current_col,current_slice) ); - } - else - { - current_ptr++; - } - - return *this; - } - - - -template -inline -typename subview_cube::const_iterator -subview_cube::const_iterator::operator++(int) - { - typename subview_cube::const_iterator temp(*this); - - ++(*this); - - return temp; - } - - - -template -inline -bool -subview_cube::const_iterator::operator==(const iterator& rhs) const - { - return (current_ptr == rhs.current_ptr); - } - - - -template -inline -bool -subview_cube::const_iterator::operator!=(const iterator& rhs) const - { - return (current_ptr != rhs.current_ptr); - } - - - -template -inline -bool -subview_cube::const_iterator::operator==(const const_iterator& rhs) const - { - return (current_ptr == rhs.current_ptr); - } - - - -template -inline -bool -subview_cube::const_iterator::operator!=(const const_iterator& rhs) const - { - return (current_ptr != rhs.current_ptr); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_cube_slices_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_cube_slices_bones.hpp deleted file mode 100644 index e19890f1c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_cube_slices_bones.hpp +++ /dev/null @@ -1,92 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup subview_cube_slices -//! @{ - - - -template -class subview_cube_slices : public BaseCube< eT, subview_cube_slices > - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - arma_aligned const Cube& m; - arma_aligned const Base& base_si; - - - protected: - - arma_inline subview_cube_slices(const Cube& in_m, const Base& in_si); - - - public: - - inline ~subview_cube_slices(); - inline subview_cube_slices() = delete; - - inline void inplace_rand(const uword rand_mode); - - template inline void inplace_op(const eT val); - template inline void inplace_op(const BaseCube& x); - - inline void fill(const eT val); - inline void zeros(); - inline void ones(); - inline void randu(); - inline void randn(); - - inline void operator+= (const eT val); - inline void operator-= (const eT val); - inline void operator*= (const eT val); - inline void operator/= (const eT val); - - - // deliberately returning void - template inline void operator_equ(const subview_cube_slices& x); - template inline void operator= (const subview_cube_slices& x); - inline void operator= (const subview_cube_slices& x); - - template inline void operator+= (const subview_cube_slices& x); - template inline void operator-= (const subview_cube_slices& x); - template inline void operator%= (const subview_cube_slices& x); - template inline void operator/= (const subview_cube_slices& x); - - template inline void operator= (const BaseCube& x); - template inline void operator+= (const BaseCube& x); - template inline void operator-= (const BaseCube& x); - template inline void operator%= (const BaseCube& x); - template inline void operator/= (const BaseCube& x); - - inline static void extract(Cube& out, const subview_cube_slices& in); - - inline static void plus_inplace(Cube& out, const subview_cube_slices& in); - inline static void minus_inplace(Cube& out, const subview_cube_slices& in); - inline static void schur_inplace(Cube& out, const subview_cube_slices& in); - inline static void div_inplace(Cube& out, const subview_cube_slices& in); - - - friend class Cube; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_cube_slices_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_cube_slices_meat.hpp deleted file mode 100644 index 29569b3ed..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_cube_slices_meat.hpp +++ /dev/null @@ -1,555 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup subview_cube_slices -//! @{ - - -template -inline -subview_cube_slices::~subview_cube_slices() - { - arma_debug_sigprint(); - } - - -template -arma_inline -subview_cube_slices::subview_cube_slices - ( - const Cube& in_m, - const Base& in_si - ) - : m (in_m ) - , base_si(in_si) - { - arma_debug_sigprint(); - } - - - -template -inline -void -subview_cube_slices::inplace_rand(const uword rand_mode) - { - arma_debug_sigprint(); - - Cube& m_local = const_cast< Cube& >(m); - - const uword m_n_slices = m_local.n_slices; - const uword m_n_elem_slice = m_local.n_elem_slice; - - const quasi_unwrap U(base_si.get_ref()); - const umat& si = U.M; - - arma_conform_check - ( - ( (si.is_vec() == false) && (si.is_empty() == false) ), - "Cube::slices(): given object must be a vector" - ); - - const uword* si_mem = si.memptr(); - const uword si_n_elem = si.n_elem; - - for(uword si_count=0; si_count < si_n_elem; ++si_count) - { - const uword i = si_mem[si_count]; - - arma_conform_check_bounds( (i >= m_n_slices), "Cube::slices(): index out of bounds" ); - - eT* m_slice_ptr = m_local.slice_memptr(i); - - if(rand_mode == 0) { arma_rng::randu::fill(m_slice_ptr, m_n_elem_slice); } - if(rand_mode == 1) { arma_rng::randn::fill(m_slice_ptr, m_n_elem_slice); } - } - } - - - -template -template -inline -void -subview_cube_slices::inplace_op(const eT val) - { - arma_debug_sigprint(); - - Cube& m_local = const_cast< Cube& >(m); - - const uword m_n_slices = m_local.n_slices; - const uword m_n_elem_slice = m_local.n_elem_slice; - - const quasi_unwrap U(base_si.get_ref()); - const umat& si = U.M; - - arma_conform_check - ( - ( (si.is_vec() == false) && (si.is_empty() == false) ), - "Cube::slices(): given object must be a vector" - ); - - const uword* si_mem = si.memptr(); - const uword si_n_elem = si.n_elem; - - for(uword si_count=0; si_count < si_n_elem; ++si_count) - { - const uword i = si_mem[si_count]; - - arma_conform_check_bounds( (i >= m_n_slices), "Cube::slices(): index out of bounds" ); - - eT* m_slice_ptr = m_local.slice_memptr(i); - - if(is_same_type::yes) { arrayops::inplace_set (m_slice_ptr, val, m_n_elem_slice); } - if(is_same_type::yes) { arrayops::inplace_plus (m_slice_ptr, val, m_n_elem_slice); } - if(is_same_type::yes) { arrayops::inplace_minus(m_slice_ptr, val, m_n_elem_slice); } - if(is_same_type::yes) { arrayops::inplace_mul (m_slice_ptr, val, m_n_elem_slice); } - if(is_same_type::yes) { arrayops::inplace_div (m_slice_ptr, val, m_n_elem_slice); } - } - } - - - -template -template -inline -void -subview_cube_slices::inplace_op(const BaseCube& x) - { - arma_debug_sigprint(); - - Cube& m_local = const_cast< Cube& >(m); - - const uword m_n_slices = m_local.n_slices; - const uword m_n_elem_slice = m_local.n_elem_slice; - - const quasi_unwrap U(base_si.get_ref()); - const umat& si = U.M; - - arma_conform_check - ( - ( (si.is_vec() == false) && (si.is_empty() == false) ), - "Cube::slices(): given object must be a vector" - ); - - const uword* si_mem = si.memptr(); - const uword si_n_elem = si.n_elem; - - const unwrap_cube_check tmp(x.get_ref(), m_local); - const Cube& X = tmp.M; - - arma_conform_assert_same_size( m_local.n_rows, m_local.n_cols, si_n_elem, X.n_rows, X.n_cols, X.n_slices, "Cube::slices()" ); - - for(uword si_count=0; si_count < si_n_elem; ++si_count) - { - const uword i = si_mem[si_count]; - - arma_conform_check_bounds( (i >= m_n_slices), "Cube::slices(): index out of bounds" ); - - eT* m_slice_ptr = m_local.slice_memptr(i); - const eT* X_slice_ptr = X.slice_memptr(si_count); - - if(is_same_type::yes) { arrayops::copy (m_slice_ptr, X_slice_ptr, m_n_elem_slice); } - if(is_same_type::yes) { arrayops::inplace_plus (m_slice_ptr, X_slice_ptr, m_n_elem_slice); } - if(is_same_type::yes) { arrayops::inplace_minus(m_slice_ptr, X_slice_ptr, m_n_elem_slice); } - if(is_same_type::yes) { arrayops::inplace_mul (m_slice_ptr, X_slice_ptr, m_n_elem_slice); } - if(is_same_type::yes) { arrayops::inplace_div (m_slice_ptr, X_slice_ptr, m_n_elem_slice); } - } - } - - - -// -// - - - -template -inline -void -subview_cube_slices::fill(const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -template -inline -void -subview_cube_slices::zeros() - { - arma_debug_sigprint(); - - inplace_op(eT(0)); - } - - - -template -inline -void -subview_cube_slices::ones() - { - arma_debug_sigprint(); - - inplace_op(eT(1)); - } - - - -template -inline -void -subview_cube_slices::randu() - { - arma_debug_sigprint(); - - inplace_rand(0); - } - - - -template -inline -void -subview_cube_slices::randn() - { - arma_debug_sigprint(); - - inplace_rand(1); - } - - - -template -inline -void -subview_cube_slices::operator+= (const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -template -inline -void -subview_cube_slices::operator-= (const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -template -inline -void -subview_cube_slices::operator*= (const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -template -inline -void -subview_cube_slices::operator/= (const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -// -// - - - -template -template -inline -void -subview_cube_slices::operator_equ(const subview_cube_slices& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - - -template -template -inline -void -subview_cube_slices::operator= (const subview_cube_slices& x) - { - arma_debug_sigprint(); - - (*this).operator_equ(x); - } - - - -//! work around compiler bugs -template -inline -void -subview_cube_slices::operator= (const subview_cube_slices& x) - { - arma_debug_sigprint(); - - (*this).operator_equ(x); - } - - - -template -template -inline -void -subview_cube_slices::operator+= (const subview_cube_slices& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_cube_slices::operator-= (const subview_cube_slices& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_cube_slices::operator%= (const subview_cube_slices& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_cube_slices::operator/= (const subview_cube_slices& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_cube_slices::operator= (const BaseCube& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_cube_slices::operator+= (const BaseCube& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_cube_slices::operator-= (const BaseCube& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_cube_slices::operator%= (const BaseCube& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_cube_slices::operator/= (const BaseCube& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -// -// - - - -template -inline -void -subview_cube_slices::extract(Cube& out, const subview_cube_slices& in) - { - arma_debug_sigprint(); - - const Cube& m_local = in.m; - - const uword m_n_slices = m_local.n_slices; - const uword m_n_elem_slice = m_local.n_elem_slice; - - const quasi_unwrap U(in.base_si.get_ref()); - const umat& si = U.M; - - arma_conform_check - ( - ( (si.is_vec() == false) && (si.is_empty() == false) ), - "Cube::slices(): given object must be a vector" - ); - - const uword* si_mem = si.memptr(); - const uword si_n_elem = si.n_elem; - - out.set_size(m_local.n_rows, m_local.n_cols, si_n_elem); - - for(uword si_count=0; si_count < si_n_elem; ++si_count) - { - const uword i = si_mem[si_count]; - - arma_conform_check_bounds( (i >= m_n_slices), "Cube::slices(): index out of bounds" ); - - eT* out_slice_ptr = out.slice_memptr(si_count); - const eT* m_slice_ptr = m_local.slice_memptr(i); - - arrayops::copy(out_slice_ptr, m_slice_ptr, m_n_elem_slice); - } - } - - - -// TODO: implement a dedicated function instead of creating a temporary -template -inline -void -subview_cube_slices::plus_inplace(Cube& out, const subview_cube_slices& in) - { - arma_debug_sigprint(); - - const Cube tmp(in); - - out += tmp; - } - - - -template -inline -void -subview_cube_slices::minus_inplace(Cube& out, const subview_cube_slices& in) - { - arma_debug_sigprint(); - - const Cube tmp(in); - - out -= tmp; - } - - - -template -inline -void -subview_cube_slices::schur_inplace(Cube& out, const subview_cube_slices& in) - { - arma_debug_sigprint(); - - const Cube tmp(in); - - out %= tmp; - } - - - -template -inline -void -subview_cube_slices::div_inplace(Cube& out, const subview_cube_slices& in) - { - arma_debug_sigprint(); - - const Cube tmp(in); - - out /= tmp; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_each_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_each_bones.hpp deleted file mode 100644 index dcb58cd83..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_each_bones.hpp +++ /dev/null @@ -1,166 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup subview_each -//! @{ - - - -template -class subview_each_common - { - public: - - typedef typename parent::elem_type eT; - - const parent& P; - - template - inline void check_size(const Mat& A) const; - - - protected: - - arma_inline subview_each_common(const parent& in_P); - inline subview_each_common() = delete; - - arma_inline const Mat& get_mat_ref_helper(const Mat & X) const; - arma_inline const Mat& get_mat_ref_helper(const subview& X) const; - - arma_inline const Mat& get_mat_ref() const; - - template - arma_cold inline const std::string incompat_size_string(const Mat& A) const; - }; - - - - -template -class subview_each1 : public subview_each_common - { - protected: - - arma_inline subview_each1(const parent& in_P); - - - public: - - typedef typename parent::elem_type eT; - - inline ~subview_each1(); - inline subview_each1() = delete; - - // deliberately returning void - template inline void operator= (const Base& x); - template inline void operator+= (const Base& x); - template inline void operator-= (const Base& x); - template inline void operator%= (const Base& x); - template inline void operator/= (const Base& x); - - - friend class Mat; - friend class subview; - }; - - - -template -class subview_each2 : public subview_each_common - { - protected: - - inline subview_each2(const parent& in_P, const Base& in_indices); - - - public: - - const Base& base_indices; - - typedef typename parent::elem_type eT; - - inline void check_indices(const Mat& indices) const; - - inline ~subview_each2(); - inline subview_each2() = delete; - - // deliberately returning void - template inline void operator= (const Base& x); - template inline void operator+= (const Base& x); - template inline void operator-= (const Base& x); - template inline void operator%= (const Base& x); - template inline void operator/= (const Base& x); - - - friend class Mat; - friend class subview; - }; - - - -class subview_each1_aux - { - public: - - template - static inline Mat operator_plus(const subview_each1& X, const Base& Y); - - template - static inline Mat operator_minus(const subview_each1& X, const Base& Y); - - template - static inline Mat operator_minus(const Base& X, const subview_each1& Y); - - template - static inline Mat operator_schur(const subview_each1& X, const Base& Y); - - template - static inline Mat operator_div(const subview_each1& X,const Base& Y); - - template - static inline Mat operator_div(const Base& X, const subview_each1& Y); - }; - - - -class subview_each2_aux - { - public: - - template - static inline Mat operator_plus(const subview_each2& X, const Base& Y); - - template - static inline Mat operator_minus(const subview_each2& X, const Base& Y); - - template - static inline Mat operator_minus(const Base& X, const subview_each2& Y); - - template - static inline Mat operator_schur(const subview_each2& X, const Base& Y); - - template - static inline Mat operator_div(const subview_each2& X, const Base& Y); - - template - static inline Mat operator_div(const Base& X, const subview_each2& Y); - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_each_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_each_meat.hpp deleted file mode 100644 index b905eeb85..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_each_meat.hpp +++ /dev/null @@ -1,1404 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup subview_each -//! @{ - - -// -// -// subview_each_common - -template -inline -subview_each_common::subview_each_common(const parent& in_P) - : P(in_P) - { - arma_debug_sigprint(); - } - - - -template -arma_inline -const Mat& -subview_each_common::get_mat_ref_helper(const Mat& X) const - { - return X; - } - - - -template -arma_inline -const Mat& -subview_each_common::get_mat_ref_helper(const subview& X) const - { - return X.m; - } - - - -template -arma_inline -const Mat& -subview_each_common::get_mat_ref() const - { - return get_mat_ref_helper(P); - } - - - -template -template -inline -void -subview_each_common::check_size(const Mat& A) const - { - if(arma_config::check_conform) - { - if(mode == 0) - { - if( (A.n_rows != P.n_rows) || (A.n_cols != 1) ) - { - arma_stop_logic_error( incompat_size_string(A) ); - } - } - else - { - if( (A.n_rows != 1) || (A.n_cols != P.n_cols) ) - { - arma_stop_logic_error( incompat_size_string(A) ); - } - } - } - } - - - -template -template -inline -const std::string -subview_each_common::incompat_size_string(const Mat& A) const - { - std::ostringstream tmp; - - if(mode == 0) - { - tmp << "each_col(): incompatible size; expected " << P.n_rows << "x1" << ", got " << A.n_rows << 'x' << A.n_cols; - } - else - { - tmp << "each_row(): incompatible size; expected 1x" << P.n_cols << ", got " << A.n_rows << 'x' << A.n_cols; - } - - return tmp.str(); - } - - - -// -// -// subview_each1 - - - -template -inline -subview_each1::~subview_each1() - { - arma_debug_sigprint(); - } - - - -template -inline -subview_each1::subview_each1(const parent& in_P) - : subview_each_common::subview_each_common(in_P) - { - arma_debug_sigprint(); - } - - - -template -template -inline -void -subview_each1::operator= (const Base& in) - { - arma_debug_sigprint(); - - parent& p = access::rw(subview_each_common::P); - - const unwrap_check tmp( in.get_ref(), (*this).get_mat_ref() ); - const Mat& A = tmp.M; - - subview_each_common::check_size(A); - - const eT* A_mem = A.memptr(); - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - if(mode == 0) // each column - { - for(uword i=0; i < p_n_cols; ++i) - { - arrayops::copy( p.colptr(i), A_mem, p_n_rows ); - } - } - else // each row - { - for(uword i=0; i < p_n_cols; ++i) - { - arrayops::inplace_set( p.colptr(i), A_mem[i], p_n_rows); - } - } - } - - - -template -template -inline -void -subview_each1::operator+= (const Base& in) - { - arma_debug_sigprint(); - - parent& p = access::rw(subview_each_common::P); - - const unwrap_check tmp( in.get_ref(), (*this).get_mat_ref() ); - const Mat& A = tmp.M; - - subview_each_common::check_size(A); - - const eT* A_mem = A.memptr(); - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - if(mode == 0) // each column - { - for(uword i=0; i < p_n_cols; ++i) - { - arrayops::inplace_plus( p.colptr(i), A_mem, p_n_rows ); - } - } - else // each row - { - for(uword i=0; i < p_n_cols; ++i) - { - arrayops::inplace_plus( p.colptr(i), A_mem[i], p_n_rows); - } - } - } - - - -template -template -inline -void -subview_each1::operator-= (const Base& in) - { - arma_debug_sigprint(); - - parent& p = access::rw(subview_each_common::P); - - const unwrap_check tmp( in.get_ref(), (*this).get_mat_ref() ); - const Mat& A = tmp.M; - - subview_each_common::check_size(A); - - const eT* A_mem = A.memptr(); - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - if(mode == 0) // each column - { - for(uword i=0; i < p_n_cols; ++i) - { - arrayops::inplace_minus( p.colptr(i), A_mem, p_n_rows ); - } - } - else // each row - { - for(uword i=0; i < p_n_cols; ++i) - { - arrayops::inplace_minus( p.colptr(i), A_mem[i], p_n_rows); - } - } - } - - - -template -template -inline -void -subview_each1::operator%= (const Base& in) - { - arma_debug_sigprint(); - - parent& p = access::rw(subview_each_common::P); - - const unwrap_check tmp( in.get_ref(), (*this).get_mat_ref() ); - const Mat& A = tmp.M; - - subview_each_common::check_size(A); - - const eT* A_mem = A.memptr(); - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - if(mode == 0) // each column - { - for(uword i=0; i < p_n_cols; ++i) - { - arrayops::inplace_mul( p.colptr(i), A_mem, p_n_rows ); - } - } - else // each row - { - for(uword i=0; i < p_n_cols; ++i) - { - arrayops::inplace_mul( p.colptr(i), A_mem[i], p_n_rows); - } - } - } - - - -template -template -inline -void -subview_each1::operator/= (const Base& in) - { - arma_debug_sigprint(); - - parent& p = access::rw(subview_each_common::P); - - const unwrap_check tmp( in.get_ref(), (*this).get_mat_ref() ); - const Mat& A = tmp.M; - - subview_each_common::check_size(A); - - const eT* A_mem = A.memptr(); - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - if(mode == 0) // each column - { - for(uword i=0; i < p_n_cols; ++i) - { - arrayops::inplace_div( p.colptr(i), A_mem, p_n_rows ); - } - } - else // each row - { - for(uword i=0; i < p_n_cols; ++i) - { - arrayops::inplace_div( p.colptr(i), A_mem[i], p_n_rows); - } - } - } - - - -// -// -// subview_each2 - - - -template -inline -subview_each2::~subview_each2() - { - arma_debug_sigprint(); - } - - - -template -inline -subview_each2::subview_each2(const parent& in_P, const Base& in_indices) - : subview_each_common::subview_each_common(in_P) - , base_indices(in_indices) - { - arma_debug_sigprint(); - } - - - -template -inline -void -subview_each2::check_indices(const Mat& indices) const - { - if(mode == 0) - { - arma_conform_check( ((indices.is_vec() == false) && (indices.is_empty() == false)), "each_col(): list of indices must be a vector" ); - } - else - { - arma_conform_check( ((indices.is_vec() == false) && (indices.is_empty() == false)), "each_row(): list of indices must be a vector" ); - } - } - - - -template -template -inline -void -subview_each2::operator= (const Base& in) - { - arma_debug_sigprint(); - - parent& p = access::rw(subview_each_common::P); - - const unwrap_check tmp( in.get_ref(), (*this).get_mat_ref() ); - const Mat& A = tmp.M; - - subview_each_common::check_size(A); - - const unwrap_check_mixed U( base_indices.get_ref(), (*this).get_mat_ref() ); - - check_indices(U.M); - - const eT* A_mem = A.memptr(); - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - if(mode == 0) // each column - { - for(uword i=0; i < N; ++i) - { - const uword col = indices_mem[i]; - - arma_conform_check_bounds( (col >= p_n_cols), "each_col(): index out of bounds" ); - - arrayops::copy( p.colptr(col), A_mem, p_n_rows ); - } - } - else // each row - { - for(uword i=0; i < N; ++i) - { - const uword row = indices_mem[i]; - - arma_conform_check_bounds( (row >= p_n_rows), "each_row(): index out of bounds" ); - - for(uword col=0; col < p_n_cols; ++col) - { - p.at(row,col) = A_mem[col]; - } - } - } - } - - - -template -template -inline -void -subview_each2::operator+= (const Base& in) - { - arma_debug_sigprint(); - - parent& p = access::rw(subview_each_common::P); - - const unwrap_check tmp( in.get_ref(), (*this).get_mat_ref() ); - const Mat& A = tmp.M; - - subview_each_common::check_size(A); - - const unwrap_check_mixed U( base_indices.get_ref(), (*this).get_mat_ref() ); - - check_indices(U.M); - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - if(mode == 0) // each column - { - const eT* A_mem = A.memptr(); - - for(uword i=0; i < N; ++i) - { - const uword col = indices_mem[i]; - - arma_conform_check_bounds( (col >= p_n_cols), "each_col(): index out of bounds" ); - - arrayops::inplace_plus( p.colptr(col), A_mem, p_n_rows ); - } - } - else // each row - { - for(uword i=0; i < N; ++i) - { - const uword row = indices_mem[i]; - - arma_conform_check_bounds( (row >= p_n_rows), "each_row(): index out of bounds" ); - - p.row(row) += A; - } - } - } - - - -template -template -inline -void -subview_each2::operator-= (const Base& in) - { - arma_debug_sigprint(); - - parent& p = access::rw(subview_each_common::P); - - const unwrap_check tmp( in.get_ref(), (*this).get_mat_ref() ); - const Mat& A = tmp.M; - - subview_each_common::check_size(A); - - const unwrap_check_mixed U( base_indices.get_ref(), (*this).get_mat_ref() ); - - check_indices(U.M); - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - if(mode == 0) // each column - { - const eT* A_mem = A.memptr(); - - for(uword i=0; i < N; ++i) - { - const uword col = indices_mem[i]; - - arma_conform_check_bounds( (col >= p_n_cols), "each_col(): index out of bounds" ); - - arrayops::inplace_minus( p.colptr(col), A_mem, p_n_rows ); - } - } - else // each row - { - for(uword i=0; i < N; ++i) - { - const uword row = indices_mem[i]; - - arma_conform_check_bounds( (row >= p_n_rows), "each_row(): index out of bounds" ); - - p.row(row) -= A; - } - } - } - - - -template -template -inline -void -subview_each2::operator%= (const Base& in) - { - arma_debug_sigprint(); - - parent& p = access::rw(subview_each_common::P); - - const unwrap_check tmp( in.get_ref(), (*this).get_mat_ref() ); - const Mat& A = tmp.M; - - subview_each_common::check_size(A); - - const unwrap_check_mixed U( base_indices.get_ref(), (*this).get_mat_ref() ); - - check_indices(U.M); - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - if(mode == 0) // each column - { - const eT* A_mem = A.memptr(); - - for(uword i=0; i < N; ++i) - { - const uword col = indices_mem[i]; - - arma_conform_check_bounds( (col >= p_n_cols), "each_col(): index out of bounds" ); - - arrayops::inplace_mul( p.colptr(col), A_mem, p_n_rows ); - } - } - else // each row - { - for(uword i=0; i < N; ++i) - { - const uword row = indices_mem[i]; - - arma_conform_check_bounds( (row >= p_n_rows), "each_row(): index out of bounds" ); - - p.row(row) %= A; - } - } - } - - - -template -template -inline -void -subview_each2::operator/= (const Base& in) - { - arma_debug_sigprint(); - - parent& p = access::rw(subview_each_common::P); - - const unwrap_check tmp( in.get_ref(), (*this).get_mat_ref() ); - const Mat& A = tmp.M; - - subview_each_common::check_size(A); - - const unwrap_check_mixed U( base_indices.get_ref(), (*this).get_mat_ref() ); - - check_indices(U.M); - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - if(mode == 0) // each column - { - const eT* A_mem = A.memptr(); - - for(uword i=0; i < N; ++i) - { - const uword col = indices_mem[i]; - - arma_conform_check_bounds( (col >= p_n_cols), "each_col(): index out of bounds" ); - - arrayops::inplace_div( p.colptr(col), A_mem, p_n_rows ); - } - } - else // each row - { - for(uword i=0; i < N; ++i) - { - const uword row = indices_mem[i]; - - arma_conform_check_bounds( (row >= p_n_rows), "each_row(): index out of bounds" ); - - p.row(row) /= A; - } - } - } - - - -// -// -// subview_each1_aux - - - -template -inline -Mat -subview_each1_aux::operator_plus - ( - const subview_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - typedef typename parent::elem_type eT; - - const parent& p = X.P; - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - Mat out(p_n_rows, p_n_cols, arma_nozeros_indicator()); - - const quasi_unwrap tmp(Y.get_ref()); - const Mat& A = tmp.M; - - X.check_size(A); - - const eT* A_mem = A.memptr(); - - if(mode == 0) // each column - { - for(uword i=0; i < p_n_cols; ++i) - { - const eT* p_mem = p.colptr(i); - eT* out_mem = out.colptr(i); - - for(uword row=0; row < p_n_rows; ++row) - { - out_mem[row] = p_mem[row] + A_mem[row]; - } - } - } - - if(mode == 1) // each row - { - for(uword i=0; i < p_n_cols; ++i) - { - const eT* p_mem = p.colptr(i); - eT* out_mem = out.colptr(i); - - const eT A_val = A_mem[i]; - - for(uword row=0; row < p_n_rows; ++row) - { - out_mem[row] = p_mem[row] + A_val; - } - } - } - - return out; - } - - - -template -inline -Mat -subview_each1_aux::operator_minus - ( - const subview_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - typedef typename parent::elem_type eT; - - const parent& p = X.P; - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - Mat out(p_n_rows, p_n_cols, arma_nozeros_indicator()); - - const quasi_unwrap tmp(Y.get_ref()); - const Mat& A = tmp.M; - - X.check_size(A); - - const eT* A_mem = A.memptr(); - - if(mode == 0) // each column - { - for(uword i=0; i < p_n_cols; ++i) - { - const eT* p_mem = p.colptr(i); - eT* out_mem = out.colptr(i); - - for(uword row=0; row < p_n_rows; ++row) - { - out_mem[row] = p_mem[row] - A_mem[row]; - } - } - } - - if(mode == 1) // each row - { - for(uword i=0; i < p_n_cols; ++i) - { - const eT* p_mem = p.colptr(i); - eT* out_mem = out.colptr(i); - - const eT A_val = A_mem[i]; - - for(uword row=0; row < p_n_rows; ++row) - { - out_mem[row] = p_mem[row] - A_val; - } - } - } - - return out; - } - - - -template -inline -Mat -subview_each1_aux::operator_minus - ( - const Base& X, - const subview_each1& Y - ) - { - arma_debug_sigprint(); - - typedef typename parent::elem_type eT; - - const parent& p = Y.P; - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - Mat out(p_n_rows, p_n_cols, arma_nozeros_indicator()); - - const quasi_unwrap tmp(X.get_ref()); - const Mat& A = tmp.M; - - Y.check_size(A); - - const eT* A_mem = A.memptr(); - - if(mode == 0) // each column - { - for(uword i=0; i < p_n_cols; ++i) - { - const eT* p_mem = p.colptr(i); - eT* out_mem = out.colptr(i); - - for(uword row=0; row < p_n_rows; ++row) - { - out_mem[row] = A_mem[row] - p_mem[row]; - } - } - } - - if(mode == 1) // each row - { - for(uword i=0; i < p_n_cols; ++i) - { - const eT* p_mem = p.colptr(i); - eT* out_mem = out.colptr(i); - - const eT A_val = A_mem[i]; - - for(uword row=0; row < p_n_rows; ++row) - { - out_mem[row] = A_val - p_mem[row]; - } - } - } - - return out; - } - - - -template -inline -Mat -subview_each1_aux::operator_schur - ( - const subview_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - typedef typename parent::elem_type eT; - - const parent& p = X.P; - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - Mat out(p_n_rows, p_n_cols, arma_nozeros_indicator()); - - const quasi_unwrap tmp(Y.get_ref()); - const Mat& A = tmp.M; - - X.check_size(A); - - const eT* A_mem = A.memptr(); - - if(mode == 0) // each column - { - for(uword i=0; i < p_n_cols; ++i) - { - const eT* p_mem = p.colptr(i); - eT* out_mem = out.colptr(i); - - for(uword row=0; row < p_n_rows; ++row) - { - out_mem[row] = p_mem[row] * A_mem[row]; - } - } - } - - if(mode == 1) // each row - { - for(uword i=0; i < p_n_cols; ++i) - { - const eT* p_mem = p.colptr(i); - eT* out_mem = out.colptr(i); - - const eT A_val = A_mem[i]; - - for(uword row=0; row < p_n_rows; ++row) - { - out_mem[row] = p_mem[row] * A_val; - } - } - } - - return out; - } - - - -template -inline -Mat -subview_each1_aux::operator_div - ( - const subview_each1& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - typedef typename parent::elem_type eT; - - const parent& p = X.P; - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - Mat out(p_n_rows, p_n_cols, arma_nozeros_indicator()); - - const quasi_unwrap tmp(Y.get_ref()); - const Mat& A = tmp.M; - - X.check_size(A); - - const eT* A_mem = A.memptr(); - - if(mode == 0) // each column - { - for(uword i=0; i < p_n_cols; ++i) - { - const eT* p_mem = p.colptr(i); - eT* out_mem = out.colptr(i); - - for(uword row=0; row < p_n_rows; ++row) - { - out_mem[row] = p_mem[row] / A_mem[row]; - } - } - } - - if(mode == 1) // each row - { - for(uword i=0; i < p_n_cols; ++i) - { - const eT* p_mem = p.colptr(i); - eT* out_mem = out.colptr(i); - - const eT A_val = A_mem[i]; - - for(uword row=0; row < p_n_rows; ++row) - { - out_mem[row] = p_mem[row] / A_val; - } - } - } - - return out; - } - - - -template -inline -Mat -subview_each1_aux::operator_div - ( - const Base& X, - const subview_each1& Y - ) - { - arma_debug_sigprint(); - - typedef typename parent::elem_type eT; - - const parent& p = Y.P; - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - Mat out(p_n_rows, p_n_cols, arma_nozeros_indicator()); - - const quasi_unwrap tmp(X.get_ref()); - const Mat& A = tmp.M; - - Y.check_size(A); - - const eT* A_mem = A.memptr(); - - if(mode == 0) // each column - { - for(uword i=0; i < p_n_cols; ++i) - { - const eT* p_mem = p.colptr(i); - eT* out_mem = out.colptr(i); - - for(uword row=0; row < p_n_rows; ++row) - { - out_mem[row] = A_mem[row] / p_mem[row]; - } - } - } - - if(mode == 1) // each row - { - for(uword i=0; i < p_n_cols; ++i) - { - const eT* p_mem = p.colptr(i); - eT* out_mem = out.colptr(i); - - const eT A_val = A_mem[i]; - - for(uword row=0; row < p_n_rows; ++row) - { - out_mem[row] = A_val / p_mem[row]; - } - } - } - - return out; - } - - - -// -// -// subview_each2_aux - - - -template -inline -Mat -subview_each2_aux::operator_plus - ( - const subview_each2& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - typedef typename parent::elem_type eT; - - const parent& p = X.P; - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - Mat out = p; - - const quasi_unwrap tmp(Y.get_ref()); - const Mat& A = tmp.M; - - const unwrap U(X.base_indices.get_ref()); - - X.check_size(A); - X.check_indices(U.M); - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - if(mode == 0) // process columns - { - const eT* A_mem = A.memptr(); - - for(uword i=0; i < N; ++i) - { - const uword col = indices_mem[i]; - - arma_conform_check_bounds( (col >= p_n_cols), "each_col(): index out of bounds" ); - - arrayops::inplace_plus( out.colptr(col), A_mem, p_n_rows ); - } - } - - if(mode == 1) // process rows - { - for(uword i=0; i < N; ++i) - { - const uword row = indices_mem[i]; - - arma_conform_check_bounds( (row >= p_n_rows), "each_row(): index out of bounds" ); - - out.row(row) += A; - } - } - - return out; - } - - - -template -inline -Mat -subview_each2_aux::operator_minus - ( - const subview_each2& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - typedef typename parent::elem_type eT; - - const parent& p = X.P; - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - Mat out = p; - - const quasi_unwrap tmp(Y.get_ref()); - const Mat& A = tmp.M; - - const unwrap U(X.base_indices.get_ref()); - - X.check_size(A); - X.check_indices(U.M); - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - if(mode == 0) // process columns - { - const eT* A_mem = A.memptr(); - - for(uword i=0; i < N; ++i) - { - const uword col = indices_mem[i]; - - arma_conform_check_bounds( (col >= p_n_cols), "each_col(): index out of bounds" ); - - arrayops::inplace_minus( out.colptr(col), A_mem, p_n_rows ); - } - } - - if(mode == 1) // process rows - { - for(uword i=0; i < N; ++i) - { - const uword row = indices_mem[i]; - - arma_conform_check_bounds( (row >= p_n_rows), "each_row(): index out of bounds" ); - - out.row(row) -= A; - } - } - - return out; - } - - - -template -inline -Mat -subview_each2_aux::operator_minus - ( - const Base& X, - const subview_each2& Y - ) - { - arma_debug_sigprint(); - - typedef typename parent::elem_type eT; - - const parent& p = Y.P; - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - Mat out = p; - - const quasi_unwrap tmp(X.get_ref()); - const Mat& A = tmp.M; - - const unwrap U(Y.base_indices.get_ref()); - - Y.check_size(A); - Y.check_indices(U.M); - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - if(mode == 0) // process columns - { - const eT* A_mem = A.memptr(); - - for(uword i=0; i < N; ++i) - { - const uword col = indices_mem[i]; - - arma_conform_check_bounds( (col >= p_n_cols), "each_col(): index out of bounds" ); - - const eT* p_mem = p.colptr(col); - eT* out_mem = out.colptr(col); - - for(uword row=0; row < p_n_rows; ++row) - { - out_mem[row] = A_mem[row] - p_mem[row]; - } - } - } - - if(mode == 1) // process rows - { - for(uword i=0; i < N; ++i) - { - const uword row = indices_mem[i]; - - arma_conform_check_bounds( (row >= p_n_rows), "each_row(): index out of bounds" ); - - out.row(row) = A - p.row(row); - } - } - - return out; - } - - - -template -inline -Mat -subview_each2_aux::operator_schur - ( - const subview_each2& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - typedef typename parent::elem_type eT; - - const parent& p = X.P; - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - Mat out = p; - - const quasi_unwrap tmp(Y.get_ref()); - const Mat& A = tmp.M; - - const unwrap U(X.base_indices.get_ref()); - - X.check_size(A); - X.check_indices(U.M); - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - if(mode == 0) // process columns - { - const eT* A_mem = A.memptr(); - - for(uword i=0; i < N; ++i) - { - const uword col = indices_mem[i]; - - arma_conform_check_bounds( (col >= p_n_cols), "each_col(): index out of bounds" ); - - arrayops::inplace_mul( out.colptr(col), A_mem, p_n_rows ); - } - } - - if(mode == 1) // process rows - { - for(uword i=0; i < N; ++i) - { - const uword row = indices_mem[i]; - - arma_conform_check_bounds( (row >= p_n_rows), "each_row(): index out of bounds" ); - - out.row(row) %= A; - } - } - - return out; - } - - - -template -inline -Mat -subview_each2_aux::operator_div - ( - const subview_each2& X, - const Base& Y - ) - { - arma_debug_sigprint(); - - typedef typename parent::elem_type eT; - - const parent& p = X.P; - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - Mat out = p; - - const quasi_unwrap tmp(Y.get_ref()); - const Mat& A = tmp.M; - - const unwrap U(X.base_indices.get_ref()); - - X.check_size(A); - X.check_indices(U.M); - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - if(mode == 0) // process columns - { - const eT* A_mem = A.memptr(); - - for(uword i=0; i < N; ++i) - { - const uword col = indices_mem[i]; - - arma_conform_check_bounds( (col >= p_n_cols), "each_col(): index out of bounds" ); - - arrayops::inplace_div( out.colptr(col), A_mem, p_n_rows ); - } - } - - if(mode == 1) // process rows - { - for(uword i=0; i < N; ++i) - { - const uword row = indices_mem[i]; - - arma_conform_check_bounds( (row >= p_n_rows), "each_row(): index out of bounds" ); - - out.row(row) /= A; - } - } - - return out; - } - - - -template -inline -Mat -subview_each2_aux::operator_div - ( - const Base& X, - const subview_each2& Y - ) - { - arma_debug_sigprint(); - - typedef typename parent::elem_type eT; - - const parent& p = Y.P; - - const uword p_n_rows = p.n_rows; - const uword p_n_cols = p.n_cols; - - Mat out = p; - - const quasi_unwrap tmp(X.get_ref()); - const Mat& A = tmp.M; - - const unwrap U(Y.base_indices.get_ref()); - - Y.check_size(A); - Y.check_indices(U.M); - - const uword* indices_mem = U.M.memptr(); - const uword N = U.M.n_elem; - - if(mode == 0) // process columns - { - const eT* A_mem = A.memptr(); - - for(uword i=0; i < N; ++i) - { - const uword col = indices_mem[i]; - - arma_conform_check_bounds( (col >= p_n_cols), "each_col(): index out of bounds" ); - - const eT* p_mem = p.colptr(col); - eT* out_mem = out.colptr(col); - - for(uword row=0; row < p_n_rows; ++row) - { - out_mem[row] = A_mem[row] / p_mem[row]; - } - } - } - - if(mode == 1) // process rows - { - for(uword i=0; i < N; ++i) - { - const uword row = indices_mem[i]; - - arma_conform_check_bounds( (row >= p_n_rows), "each_row(): index out of bounds" ); - - out.row(row) = A / p.row(row); - } - } - - return out; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_elem1_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_elem1_bones.hpp deleted file mode 100644 index 2ac3cdad6..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_elem1_bones.hpp +++ /dev/null @@ -1,109 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup subview_elem1 -//! @{ - - - -template -class subview_elem1 : public Base< eT, subview_elem1 > - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_row = false; - static constexpr bool is_col = true; - static constexpr bool is_xvec = false; - - arma_aligned const Mat fake_m; - arma_aligned const Mat& m; - arma_aligned const Base& a; - - - protected: - - arma_inline subview_elem1(const Mat& in_m, const Base& in_a); - arma_inline subview_elem1(const Cube& in_q, const Base& in_a); - - - public: - - inline ~subview_elem1(); - inline subview_elem1() = delete; - - template inline void inplace_op(const eT val); - template inline void inplace_op(const subview_elem1& x ); - template inline void inplace_op(const Base& x ); - - arma_inline const Op,op_htrans> t() const; - arma_inline const Op,op_htrans> ht() const; - arma_inline const Op,op_strans> st() const; - - inline void replace(const eT old_val, const eT new_val); - - inline void clean(const pod_type threshold); - - inline void clamp(const eT min_val, const eT max_val); - - inline void fill(const eT val); - inline void zeros(); - inline void ones(); - inline void randu(); - inline void randn(); - - inline void operator+= (const eT val); - inline void operator-= (const eT val); - inline void operator*= (const eT val); - inline void operator/= (const eT val); - - - // deliberately returning void - template inline void operator_equ(const subview_elem1& x); - template inline void operator= (const subview_elem1& x); - inline void operator= (const subview_elem1& x); - template inline void operator+= (const subview_elem1& x); - template inline void operator-= (const subview_elem1& x); - template inline void operator%= (const subview_elem1& x); - template inline void operator/= (const subview_elem1& x); - - template inline void operator= (const Base& x); - template inline void operator+= (const Base& x); - template inline void operator-= (const Base& x); - template inline void operator%= (const Base& x); - template inline void operator/= (const Base& x); - - inline static void extract(Mat& out, const subview_elem1& in); - - template inline static void mat_inplace_op(Mat& out, const subview_elem1& in); - - inline static void plus_inplace(Mat& out, const subview_elem1& in); - inline static void minus_inplace(Mat& out, const subview_elem1& in); - inline static void schur_inplace(Mat& out, const subview_elem1& in); - inline static void div_inplace(Mat& out, const subview_elem1& in); - - - friend class Mat; - friend class Cube; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_elem1_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_elem1_meat.hpp deleted file mode 100644 index 32a06caa1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_elem1_meat.hpp +++ /dev/null @@ -1,953 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup subview_elem1 -//! @{ - - -template -inline -subview_elem1::~subview_elem1() - { - arma_debug_sigprint(); - } - - -template -arma_inline -subview_elem1::subview_elem1(const Mat& in_m, const Base& in_a) - : m(in_m) - , a(in_a) - { - arma_debug_sigprint(); - } - - - -template -arma_inline -subview_elem1::subview_elem1(const Cube& in_q, const Base& in_a) - : fake_m( const_cast< eT* >(in_q.memptr()), in_q.n_elem, 1, false ) - , m( fake_m ) - , a( in_a ) - { - arma_debug_sigprint(); - } - - - -template -template -inline -void -subview_elem1::inplace_op(const eT val) - { - arma_debug_sigprint(); - - Mat& m_local = const_cast< Mat& >(m); - - eT* m_mem = m_local.memptr(); - const uword m_n_elem = m_local.n_elem; - - const unwrap_check_mixed tmp(a.get_ref(), m_local); - const umat& aa = tmp.M; - - arma_conform_check - ( - ( (aa.is_vec() == false) && (aa.is_empty() == false) ), - "Mat::elem(): given object must be a vector" - ); - - const uword* aa_mem = aa.memptr(); - const uword aa_n_elem = aa.n_elem; - - uword iq,jq; - for(iq=0, jq=1; jq < aa_n_elem; iq+=2, jq+=2) - { - const uword ii = aa_mem[iq]; - const uword jj = aa_mem[jq]; - - arma_conform_check_bounds( ( (ii >= m_n_elem) || (jj >= m_n_elem) ), "Mat::elem(): index out of bounds" ); - - if(is_same_type::yes) { m_mem[ii] = val; m_mem[jj] = val; } - if(is_same_type::yes) { m_mem[ii] += val; m_mem[jj] += val; } - if(is_same_type::yes) { m_mem[ii] -= val; m_mem[jj] -= val; } - if(is_same_type::yes) { m_mem[ii] *= val; m_mem[jj] *= val; } - if(is_same_type::yes) { m_mem[ii] /= val; m_mem[jj] /= val; } - } - - if(iq < aa_n_elem) - { - const uword ii = aa_mem[iq]; - - arma_conform_check_bounds( (ii >= m_n_elem) , "Mat::elem(): index out of bounds" ); - - if(is_same_type::yes) { m_mem[ii] = val; } - if(is_same_type::yes) { m_mem[ii] += val; } - if(is_same_type::yes) { m_mem[ii] -= val; } - if(is_same_type::yes) { m_mem[ii] *= val; } - if(is_same_type::yes) { m_mem[ii] /= val; } - } - } - - - -template -template -inline -void -subview_elem1::inplace_op(const subview_elem1& x) - { - arma_debug_sigprint(); - - subview_elem1& s = *this; - - if(&(s.m) == &(x.m)) - { - arma_debug_print("subview_elem1::inplace_op(): aliasing detected"); - - const Mat tmp(x); - - if(is_same_type::yes) { s.operator= (tmp); } - if(is_same_type::yes) { s.operator+=(tmp); } - if(is_same_type::yes) { s.operator-=(tmp); } - if(is_same_type::yes) { s.operator%=(tmp); } - if(is_same_type::yes) { s.operator/=(tmp); } - } - else - { - Mat& s_m_local = const_cast< Mat& >(s.m); - const Mat& x_m_local = x.m; - - const unwrap_check_mixed s_tmp(s.a.get_ref(), s_m_local); - const unwrap_check_mixed x_tmp(x.a.get_ref(), s_m_local); - - const umat& s_aa = s_tmp.M; - const umat& x_aa = x_tmp.M; - - arma_conform_check - ( - ( ((s_aa.is_vec() == false) && (s_aa.is_empty() == false)) || ((x_aa.is_vec() == false) && (x_aa.is_empty() == false)) ), - "Mat::elem(): given object must be a vector" - ); - - const uword* s_aa_mem = s_aa.memptr(); - const uword* x_aa_mem = x_aa.memptr(); - - const uword s_aa_n_elem = s_aa.n_elem; - - arma_conform_check( (s_aa_n_elem != x_aa.n_elem), "Mat::elem(): size mismatch" ); - - - eT* s_m_mem = s_m_local.memptr(); - const uword s_m_n_elem = s_m_local.n_elem; - - const eT* x_m_mem = x_m_local.memptr(); - const uword x_m_n_elem = x_m_local.n_elem; - - uword iq,jq; - for(iq=0, jq=1; jq < s_aa_n_elem; iq+=2, jq+=2) - { - const uword s_ii = s_aa_mem[iq]; - const uword s_jj = s_aa_mem[jq]; - - const uword x_ii = x_aa_mem[iq]; - const uword x_jj = x_aa_mem[jq]; - - arma_conform_check_bounds - ( - (s_ii >= s_m_n_elem) || (s_jj >= s_m_n_elem) || (x_ii >= x_m_n_elem) || (x_jj >= x_m_n_elem), - "Mat::elem(): index out of bounds" - ); - - if(is_same_type::yes) { s_m_mem[s_ii] = x_m_mem[x_ii]; s_m_mem[s_jj] = x_m_mem[x_jj]; } - if(is_same_type::yes) { s_m_mem[s_ii] += x_m_mem[x_ii]; s_m_mem[s_jj] += x_m_mem[x_jj]; } - if(is_same_type::yes) { s_m_mem[s_ii] -= x_m_mem[x_ii]; s_m_mem[s_jj] -= x_m_mem[x_jj]; } - if(is_same_type::yes) { s_m_mem[s_ii] *= x_m_mem[x_ii]; s_m_mem[s_jj] *= x_m_mem[x_jj]; } - if(is_same_type::yes) { s_m_mem[s_ii] /= x_m_mem[x_ii]; s_m_mem[s_jj] /= x_m_mem[x_jj]; } - } - - if(iq < s_aa_n_elem) - { - const uword s_ii = s_aa_mem[iq]; - const uword x_ii = x_aa_mem[iq]; - - arma_conform_check_bounds - ( - ( (s_ii >= s_m_n_elem) || (x_ii >= x_m_n_elem) ), - "Mat::elem(): index out of bounds" - ); - - if(is_same_type::yes) { s_m_mem[s_ii] = x_m_mem[x_ii]; } - if(is_same_type::yes) { s_m_mem[s_ii] += x_m_mem[x_ii]; } - if(is_same_type::yes) { s_m_mem[s_ii] -= x_m_mem[x_ii]; } - if(is_same_type::yes) { s_m_mem[s_ii] *= x_m_mem[x_ii]; } - if(is_same_type::yes) { s_m_mem[s_ii] /= x_m_mem[x_ii]; } - } - } - } - - - -template -template -inline -void -subview_elem1::inplace_op(const Base& x) - { - arma_debug_sigprint(); - - Mat& m_local = const_cast< Mat& >(m); - - eT* m_mem = m_local.memptr(); - const uword m_n_elem = m_local.n_elem; - - const unwrap_check_mixed aa_tmp(a.get_ref(), m_local); - const umat& aa = aa_tmp.M; - - arma_conform_check - ( - ( (aa.is_vec() == false) && (aa.is_empty() == false) ), - "Mat::elem(): given object must be a vector" - ); - - const uword* aa_mem = aa.memptr(); - const uword aa_n_elem = aa.n_elem; - - const Proxy P(x.get_ref()); - - arma_conform_check( (aa_n_elem != P.get_n_elem()), "Mat::elem(): size mismatch" ); - - const bool is_alias = P.is_alias(m); - - if( (is_alias == false) && (Proxy::use_at == false) ) - { - typename Proxy::ea_type X = P.get_ea(); - - uword iq,jq; - for(iq=0, jq=1; jq < aa_n_elem; iq+=2, jq+=2) - { - const uword ii = aa_mem[iq]; - const uword jj = aa_mem[jq]; - - arma_conform_check_bounds( ( (ii >= m_n_elem) || (jj >= m_n_elem) ), "Mat::elem(): index out of bounds" ); - - if(is_same_type::yes) { m_mem[ii] = X[iq]; m_mem[jj] = X[jq]; } - if(is_same_type::yes) { m_mem[ii] += X[iq]; m_mem[jj] += X[jq]; } - if(is_same_type::yes) { m_mem[ii] -= X[iq]; m_mem[jj] -= X[jq]; } - if(is_same_type::yes) { m_mem[ii] *= X[iq]; m_mem[jj] *= X[jq]; } - if(is_same_type::yes) { m_mem[ii] /= X[iq]; m_mem[jj] /= X[jq]; } - } - - if(iq < aa_n_elem) - { - const uword ii = aa_mem[iq]; - - arma_conform_check_bounds( (ii >= m_n_elem) , "Mat::elem(): index out of bounds" ); - - if(is_same_type::yes) { m_mem[ii] = X[iq]; } - if(is_same_type::yes) { m_mem[ii] += X[iq]; } - if(is_same_type::yes) { m_mem[ii] -= X[iq]; } - if(is_same_type::yes) { m_mem[ii] *= X[iq]; } - if(is_same_type::yes) { m_mem[ii] /= X[iq]; } - } - } - else - { - arma_debug_print("subview_elem1::inplace_op(): aliasing or use_at detected"); - - const unwrap_check::stored_type> tmp(P.Q, is_alias); - const Mat& M = tmp.M; - - const eT* X = M.memptr(); - - uword iq,jq; - for(iq=0, jq=1; jq < aa_n_elem; iq+=2, jq+=2) - { - const uword ii = aa_mem[iq]; - const uword jj = aa_mem[jq]; - - arma_conform_check_bounds( ( (ii >= m_n_elem) || (jj >= m_n_elem) ), "Mat::elem(): index out of bounds" ); - - if(is_same_type::yes) { m_mem[ii] = X[iq]; m_mem[jj] = X[jq]; } - if(is_same_type::yes) { m_mem[ii] += X[iq]; m_mem[jj] += X[jq]; } - if(is_same_type::yes) { m_mem[ii] -= X[iq]; m_mem[jj] -= X[jq]; } - if(is_same_type::yes) { m_mem[ii] *= X[iq]; m_mem[jj] *= X[jq]; } - if(is_same_type::yes) { m_mem[ii] /= X[iq]; m_mem[jj] /= X[jq]; } - } - - if(iq < aa_n_elem) - { - const uword ii = aa_mem[iq]; - - arma_conform_check_bounds( (ii >= m_n_elem) , "Mat::elem(): index out of bounds" ); - - if(is_same_type::yes) { m_mem[ii] = X[iq]; } - if(is_same_type::yes) { m_mem[ii] += X[iq]; } - if(is_same_type::yes) { m_mem[ii] -= X[iq]; } - if(is_same_type::yes) { m_mem[ii] *= X[iq]; } - if(is_same_type::yes) { m_mem[ii] /= X[iq]; } - } - } - } - - - -// -// - - - -template -arma_inline -const Op,op_htrans> -subview_elem1::t() const - { - return Op,op_htrans>(*this); - } - - - -template -arma_inline -const Op,op_htrans> -subview_elem1::ht() const - { - return Op,op_htrans>(*this); - } - - - -template -arma_inline -const Op,op_strans> -subview_elem1::st() const - { - return Op,op_strans>(*this); - } - - - -template -inline -void -subview_elem1::replace(const eT old_val, const eT new_val) - { - arma_debug_sigprint(); - - Mat& m_local = const_cast< Mat& >(m); - - eT* m_mem = m_local.memptr(); - const uword m_n_elem = m_local.n_elem; - - const unwrap_check_mixed tmp(a.get_ref(), m_local); - const umat& aa = tmp.M; - - arma_conform_check - ( - ( (aa.is_vec() == false) && (aa.is_empty() == false) ), - "Mat::elem(): given object must be a vector" - ); - - const uword* aa_mem = aa.memptr(); - const uword aa_n_elem = aa.n_elem; - - if(arma_isnan(old_val)) - { - for(uword iq=0; iq < aa_n_elem; ++iq) - { - const uword ii = aa_mem[iq]; - - arma_conform_check_bounds( (ii >= m_n_elem), "Mat::elem(): index out of bounds" ); - - eT& val = m_mem[ii]; - - val = (arma_isnan(val)) ? new_val : val; - } - } - else - { - for(uword iq=0; iq < aa_n_elem; ++iq) - { - const uword ii = aa_mem[iq]; - - arma_conform_check_bounds( (ii >= m_n_elem), "Mat::elem(): index out of bounds" ); - - eT& val = m_mem[ii]; - - val = (val == old_val) ? new_val : val; - } - } - } - - - -template -inline -void -subview_elem1::clean(const pod_type threshold) - { - arma_debug_sigprint(); - - Mat tmp(*this); - - tmp.clean(threshold); - - (*this).operator=(tmp); - } - - - -template -inline -void -subview_elem1::clamp(const eT min_val, const eT max_val) - { - arma_debug_sigprint(); - - Mat tmp(*this); - - tmp.clamp(min_val, max_val); - - (*this).operator=(tmp); - } - - - -template -inline -void -subview_elem1::fill(const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -template -inline -void -subview_elem1::zeros() - { - arma_debug_sigprint(); - - inplace_op(eT(0)); - } - - - -template -inline -void -subview_elem1::ones() - { - arma_debug_sigprint(); - - inplace_op(eT(1)); - } - - - -template -inline -void -subview_elem1::randu() - { - arma_debug_sigprint(); - - Mat& m_local = const_cast< Mat& >(m); - - eT* m_mem = m_local.memptr(); - const uword m_n_elem = m_local.n_elem; - - const unwrap_check_mixed tmp(a.get_ref(), m_local); - const umat& aa = tmp.M; - - arma_conform_check - ( - ( (aa.is_vec() == false) && (aa.is_empty() == false) ), - "Mat::elem(): given object must be a vector" - ); - - const uword* aa_mem = aa.memptr(); - const uword aa_n_elem = aa.n_elem; - - uword iq,jq; - for(iq=0, jq=1; jq < aa_n_elem; iq+=2, jq+=2) - { - const uword ii = aa_mem[iq]; - const uword jj = aa_mem[jq]; - - arma_conform_check_bounds( ( (ii >= m_n_elem) || (jj >= m_n_elem) ), "Mat::elem(): index out of bounds" ); - - const eT val1 = eT(arma_rng::randu()); - const eT val2 = eT(arma_rng::randu()); - - m_mem[ii] = val1; - m_mem[jj] = val2; - } - - if(iq < aa_n_elem) - { - const uword ii = aa_mem[iq]; - - arma_conform_check_bounds( (ii >= m_n_elem) , "Mat::elem(): index out of bounds" ); - - m_mem[ii] = eT(arma_rng::randu()); - } - } - - - -template -inline -void -subview_elem1::randn() - { - arma_debug_sigprint(); - - Mat& m_local = const_cast< Mat& >(m); - - eT* m_mem = m_local.memptr(); - const uword m_n_elem = m_local.n_elem; - - const unwrap_check_mixed tmp(a.get_ref(), m_local); - const umat& aa = tmp.M; - - arma_conform_check - ( - ( (aa.is_vec() == false) && (aa.is_empty() == false) ), - "Mat::elem(): given object must be a vector" - ); - - const uword* aa_mem = aa.memptr(); - const uword aa_n_elem = aa.n_elem; - - uword iq,jq; - for(iq=0, jq=1; jq < aa_n_elem; iq+=2, jq+=2) - { - const uword ii = aa_mem[iq]; - const uword jj = aa_mem[jq]; - - arma_conform_check_bounds( ( (ii >= m_n_elem) || (jj >= m_n_elem) ), "Mat::elem(): index out of bounds" ); - - arma_rng::randn::dual_val( m_mem[ii], m_mem[jj] ); - } - - if(iq < aa_n_elem) - { - const uword ii = aa_mem[iq]; - - arma_conform_check_bounds( (ii >= m_n_elem) , "Mat::elem(): index out of bounds" ); - - m_mem[ii] = eT(arma_rng::randn()); - } - } - - - -template -inline -void -subview_elem1::operator+= (const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -template -inline -void -subview_elem1::operator-= (const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -template -inline -void -subview_elem1::operator*= (const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -template -inline -void -subview_elem1::operator/= (const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -// -// - - - -template -template -inline -void -subview_elem1::operator_equ(const subview_elem1& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - - -template -template -inline -void -subview_elem1::operator= (const subview_elem1& x) - { - arma_debug_sigprint(); - - (*this).operator_equ(x); - } - - - -//! work around compiler bugs -template -inline -void -subview_elem1::operator= (const subview_elem1& x) - { - arma_debug_sigprint(); - - (*this).operator_equ(x); - } - - - -template -template -inline -void -subview_elem1::operator+= (const subview_elem1& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_elem1::operator-= (const subview_elem1& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_elem1::operator%= (const subview_elem1& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_elem1::operator/= (const subview_elem1& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_elem1::operator= (const Base& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_elem1::operator+= (const Base& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_elem1::operator-= (const Base& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_elem1::operator%= (const Base& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_elem1::operator/= (const Base& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -// -// - - - -template -inline -void -subview_elem1::extract(Mat& actual_out, const subview_elem1& in) - { - arma_debug_sigprint(); - - const unwrap_check_mixed tmp1(in.a.get_ref(), actual_out); - const umat& aa = tmp1.M; - - arma_conform_check - ( - ( (aa.is_vec() == false) && (aa.is_empty() == false) ), - "Mat::elem(): given object must be a vector" - ); - - const uword* aa_mem = aa.memptr(); - const uword aa_n_elem = aa.n_elem; - - const Mat& m_local = in.m; - - const eT* m_mem = m_local.memptr(); - const uword m_n_elem = m_local.n_elem; - - const bool alias = (&actual_out == &m_local); - - if(alias) { arma_debug_print("subview_elem1::extract(): aliasing detected"); } - - Mat* tmp_out = alias ? new Mat() : nullptr; - Mat& out = alias ? *tmp_out : actual_out; - - out.set_size(aa_n_elem, 1); - - eT* out_mem = out.memptr(); - - uword i,j; - for(i=0, j=1; j= m_n_elem) || (jj >= m_n_elem) ), "Mat::elem(): index out of bounds" ); - - out_mem[i] = m_mem[ii]; - out_mem[j] = m_mem[jj]; - } - - if(i < aa_n_elem) - { - const uword ii = aa_mem[i]; - - arma_conform_check_bounds( (ii >= m_n_elem) , "Mat::elem(): index out of bounds" ); - - out_mem[i] = m_mem[ii]; - } - - if(alias) - { - actual_out.steal_mem(out); - delete tmp_out; - } - } - - - -template -template -inline -void -subview_elem1::mat_inplace_op(Mat& out, const subview_elem1& in) - { - arma_debug_sigprint(); - - const unwrap tmp1(in.a.get_ref()); - const umat& aa = tmp1.M; - - arma_conform_check - ( - ( (aa.is_vec() == false) && (aa.is_empty() == false) ), - "Mat::elem(): given object must be a vector" - ); - - const uword* aa_mem = aa.memptr(); - const uword aa_n_elem = aa.n_elem; - - const unwrap_check< Mat > tmp2(in.m, out); - const Mat& m_local = tmp2.M; - - const eT* m_mem = m_local.memptr(); - const uword m_n_elem = m_local.n_elem; - - arma_conform_check( (out.n_elem != aa_n_elem), "Mat::elem(): size mismatch" ); - - eT* out_mem = out.memptr(); - - uword i,j; - for(i=0, j=1; j= m_n_elem) || (jj >= m_n_elem) ), "Mat::elem(): index out of bounds" ); - - if(is_same_type::yes) { out_mem[i] += m_mem[ii]; out_mem[j] += m_mem[jj]; } - if(is_same_type::yes) { out_mem[i] -= m_mem[ii]; out_mem[j] -= m_mem[jj]; } - if(is_same_type::yes) { out_mem[i] *= m_mem[ii]; out_mem[j] *= m_mem[jj]; } - if(is_same_type::yes) { out_mem[i] /= m_mem[ii]; out_mem[j] /= m_mem[jj]; } - } - - if(i < aa_n_elem) - { - const uword ii = aa_mem[i]; - - arma_conform_check_bounds( (ii >= m_n_elem) , "Mat::elem(): index out of bounds" ); - - if(is_same_type::yes) { out_mem[i] += m_mem[ii]; } - if(is_same_type::yes) { out_mem[i] -= m_mem[ii]; } - if(is_same_type::yes) { out_mem[i] *= m_mem[ii]; } - if(is_same_type::yes) { out_mem[i] /= m_mem[ii]; } - } - } - - - -template -inline -void -subview_elem1::plus_inplace(Mat& out, const subview_elem1& in) - { - arma_debug_sigprint(); - - mat_inplace_op(out, in); - } - - - -template -inline -void -subview_elem1::minus_inplace(Mat& out, const subview_elem1& in) - { - arma_debug_sigprint(); - - mat_inplace_op(out, in); - } - - - -template -inline -void -subview_elem1::schur_inplace(Mat& out, const subview_elem1& in) - { - arma_debug_sigprint(); - - mat_inplace_op(out, in); - } - - - -template -inline -void -subview_elem1::div_inplace(Mat& out, const subview_elem1& in) - { - arma_debug_sigprint(); - - mat_inplace_op(out, in); - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_elem2_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_elem2_bones.hpp deleted file mode 100644 index d4c4cbe6c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_elem2_bones.hpp +++ /dev/null @@ -1,112 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup subview_elem2 -//! @{ - - - -template -class subview_elem2 : public Base< eT, subview_elem2 > - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - arma_aligned const Mat& m; - - arma_aligned const Base& base_ri; - arma_aligned const Base& base_ci; - - const bool all_rows; - const bool all_cols; - - - protected: - - arma_inline subview_elem2(const Mat& in_m, const Base& in_ri, const Base& in_ci, const bool in_all_rows, const bool in_all_cols); - - - public: - - inline ~subview_elem2(); - inline subview_elem2() = delete; - - template - inline void inplace_op(const eT val); - - template - inline void inplace_op(const Base& x); - - inline void replace(const eT old_val, const eT new_val); - - inline void clean(const pod_type threshold); - - inline void clamp(const eT min_val, const eT max_val); - - inline void fill(const eT val); - inline void zeros(); - inline void ones(); - - inline void operator+= (const eT val); - inline void operator-= (const eT val); - inline void operator*= (const eT val); - inline void operator/= (const eT val); - - - // deliberately returning void - template inline void operator_equ(const subview_elem2& x); - template inline void operator= (const subview_elem2& x); - inline void operator= (const subview_elem2& x); - - template inline void operator+= (const subview_elem2& x); - template inline void operator-= (const subview_elem2& x); - template inline void operator%= (const subview_elem2& x); - template inline void operator/= (const subview_elem2& x); - - template inline void operator= (const Base& x); - template inline void operator+= (const Base& x); - template inline void operator-= (const Base& x); - template inline void operator%= (const Base& x); - template inline void operator/= (const Base& x); - - template inline void operator= (const SpBase& x); - template inline void operator+= (const SpBase& x); - template inline void operator-= (const SpBase& x); - template inline void operator%= (const SpBase& x); - template inline void operator/= (const SpBase& x); - - inline static void extract(Mat& out, const subview_elem2& in); - - inline static void plus_inplace(Mat& out, const subview_elem2& in); - inline static void minus_inplace(Mat& out, const subview_elem2& in); - inline static void schur_inplace(Mat& out, const subview_elem2& in); - inline static void div_inplace(Mat& out, const subview_elem2& in); - - - friend class Mat; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_elem2_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_elem2_meat.hpp deleted file mode 100644 index a6e9dc23b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_elem2_meat.hpp +++ /dev/null @@ -1,873 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup subview_elem2 -//! @{ - - -template -inline -subview_elem2::~subview_elem2() - { - arma_debug_sigprint(); - } - - -template -arma_inline -subview_elem2::subview_elem2 - ( - const Mat& in_m, - const Base& in_ri, - const Base& in_ci, - const bool in_all_rows, - const bool in_all_cols - ) - : m (in_m ) - , base_ri (in_ri ) - , base_ci (in_ci ) - , all_rows (in_all_rows) - , all_cols (in_all_cols) - { - arma_debug_sigprint(); - } - - - -template -template -inline -void -subview_elem2::inplace_op(const eT val) - { - arma_debug_sigprint(); - - Mat& m_local = const_cast< Mat& >(m); - - const uword m_n_rows = m_local.n_rows; - const uword m_n_cols = m_local.n_cols; - - if( (all_rows == false) && (all_cols == false) ) - { - const unwrap_check_mixed tmp1(base_ri.get_ref(), m_local); - const unwrap_check_mixed tmp2(base_ci.get_ref(), m_local); - - const umat& ri = tmp1.M; - const umat& ci = tmp2.M; - - arma_conform_check - ( - ( ((ri.is_vec() == false) && (ri.is_empty() == false)) || ((ci.is_vec() == false) && (ci.is_empty() == false)) ), - "Mat::elem(): given object must be a vector" - ); - - const uword* ri_mem = ri.memptr(); - const uword ri_n_elem = ri.n_elem; - - const uword* ci_mem = ci.memptr(); - const uword ci_n_elem = ci.n_elem; - - for(uword ci_count=0; ci_count < ci_n_elem; ++ci_count) - { - const uword col = ci_mem[ci_count]; - - arma_conform_check_bounds( (col >= m_n_cols), "Mat::elem(): index out of bounds" ); - - for(uword ri_count=0; ri_count < ri_n_elem; ++ri_count) - { - const uword row = ri_mem[ri_count]; - - arma_conform_check_bounds( (row >= m_n_rows), "Mat::elem(): index out of bounds" ); - - if(is_same_type::yes) { m_local.at(row,col) = val; } - if(is_same_type::yes) { m_local.at(row,col) += val; } - if(is_same_type::yes) { m_local.at(row,col) -= val; } - if(is_same_type::yes) { m_local.at(row,col) *= val; } - if(is_same_type::yes) { m_local.at(row,col) /= val; } - } - } - } - else - if( (all_rows == true) && (all_cols == false) ) - { - const unwrap_check_mixed tmp2(base_ci.get_ref(), m_local); - - const umat& ci = tmp2.M; - - arma_conform_check - ( - ( (ci.is_vec() == false) && (ci.is_empty() == false) ), - "Mat::elem(): given object must be a vector" - ); - - const uword* ci_mem = ci.memptr(); - const uword ci_n_elem = ci.n_elem; - - for(uword ci_count=0; ci_count < ci_n_elem; ++ci_count) - { - const uword col = ci_mem[ci_count]; - - arma_conform_check_bounds( (col >= m_n_cols), "Mat::elem(): index out of bounds" ); - - eT* colptr = m_local.colptr(col); - - if(is_same_type::yes) { arrayops::inplace_set (colptr, val, m_n_rows); } - if(is_same_type::yes) { arrayops::inplace_plus (colptr, val, m_n_rows); } - if(is_same_type::yes) { arrayops::inplace_minus(colptr, val, m_n_rows); } - if(is_same_type::yes) { arrayops::inplace_mul (colptr, val, m_n_rows); } - if(is_same_type::yes) { arrayops::inplace_div (colptr, val, m_n_rows); } - } - } - else - if( (all_rows == false) && (all_cols == true) ) - { - const unwrap_check_mixed tmp1(base_ri.get_ref(), m_local); - - const umat& ri = tmp1.M; - - arma_conform_check - ( - ( (ri.is_vec() == false) && (ri.is_empty() == false) ), - "Mat::elem(): given object must be a vector" - ); - - const uword* ri_mem = ri.memptr(); - const uword ri_n_elem = ri.n_elem; - - for(uword col=0; col < m_n_cols; ++col) - { - for(uword ri_count=0; ri_count < ri_n_elem; ++ri_count) - { - const uword row = ri_mem[ri_count]; - - arma_conform_check_bounds( (row >= m_n_rows), "Mat::elem(): index out of bounds" ); - - if(is_same_type::yes) { m_local.at(row,col) = val; } - if(is_same_type::yes) { m_local.at(row,col) += val; } - if(is_same_type::yes) { m_local.at(row,col) -= val; } - if(is_same_type::yes) { m_local.at(row,col) *= val; } - if(is_same_type::yes) { m_local.at(row,col) /= val; } - } - } - } - } - - - -template -template -inline -void -subview_elem2::inplace_op(const Base& x) - { - arma_debug_sigprint(); - - Mat& m_local = const_cast< Mat& >(m); - - const uword m_n_rows = m_local.n_rows; - const uword m_n_cols = m_local.n_cols; - - const unwrap_check tmp(x.get_ref(), m_local); - const Mat& X = tmp.M; - - if( (all_rows == false) && (all_cols == false) ) - { - const unwrap_check_mixed tmp1(base_ri.get_ref(), m_local); - const unwrap_check_mixed tmp2(base_ci.get_ref(), m_local); - - const umat& ri = tmp1.M; - const umat& ci = tmp2.M; - - arma_conform_check - ( - ( ((ri.is_vec() == false) && (ri.is_empty() == false)) || ((ci.is_vec() == false) && (ci.is_empty() == false)) ), - "Mat::elem(): given object must be a vector" - ); - - const uword* ri_mem = ri.memptr(); - const uword ri_n_elem = ri.n_elem; - - const uword* ci_mem = ci.memptr(); - const uword ci_n_elem = ci.n_elem; - - arma_conform_assert_same_size( ri_n_elem, ci_n_elem, X.n_rows, X.n_cols, "Mat::elem()" ); - - for(uword ci_count=0; ci_count < ci_n_elem; ++ci_count) - { - const uword col = ci_mem[ci_count]; - - arma_conform_check_bounds( (col >= m_n_cols), "Mat::elem(): index out of bounds" ); - - for(uword ri_count=0; ri_count < ri_n_elem; ++ri_count) - { - const uword row = ri_mem[ri_count]; - - arma_conform_check_bounds( (row >= m_n_rows), "Mat::elem(): index out of bounds" ); - - if(is_same_type::yes) { m_local.at(row,col) = X.at(ri_count, ci_count); } - if(is_same_type::yes) { m_local.at(row,col) += X.at(ri_count, ci_count); } - if(is_same_type::yes) { m_local.at(row,col) -= X.at(ri_count, ci_count); } - if(is_same_type::yes) { m_local.at(row,col) *= X.at(ri_count, ci_count); } - if(is_same_type::yes) { m_local.at(row,col) /= X.at(ri_count, ci_count); } - } - } - } - else - if( (all_rows == true) && (all_cols == false) ) - { - const unwrap_check_mixed tmp2(base_ci.get_ref(), m_local); - - const umat& ci = tmp2.M; - - arma_conform_check - ( - ( (ci.is_vec() == false) && (ci.is_empty() == false) ), - "Mat::elem(): given object must be a vector" - ); - - const uword* ci_mem = ci.memptr(); - const uword ci_n_elem = ci.n_elem; - - arma_conform_assert_same_size( m_n_rows, ci_n_elem, X.n_rows, X.n_cols, "Mat::elem()" ); - - for(uword ci_count=0; ci_count < ci_n_elem; ++ci_count) - { - const uword col = ci_mem[ci_count]; - - arma_conform_check_bounds( (col >= m_n_cols), "Mat::elem(): index out of bounds" ); - - eT* m_colptr = m_local.colptr(col); - const eT* X_colptr = X.colptr(ci_count); - - if(is_same_type::yes) { arrayops::copy (m_colptr, X_colptr, m_n_rows); } - if(is_same_type::yes) { arrayops::inplace_plus (m_colptr, X_colptr, m_n_rows); } - if(is_same_type::yes) { arrayops::inplace_minus(m_colptr, X_colptr, m_n_rows); } - if(is_same_type::yes) { arrayops::inplace_mul (m_colptr, X_colptr, m_n_rows); } - if(is_same_type::yes) { arrayops::inplace_div (m_colptr, X_colptr, m_n_rows); } - } - } - else - if( (all_rows == false) && (all_cols == true) ) - { - const unwrap_check_mixed tmp1(base_ri.get_ref(), m_local); - - const umat& ri = tmp1.M; - - arma_conform_check - ( - ( (ri.is_vec() == false) && (ri.is_empty() == false) ), - "Mat::elem(): given object must be a vector" - ); - - const uword* ri_mem = ri.memptr(); - const uword ri_n_elem = ri.n_elem; - - arma_conform_assert_same_size( ri_n_elem, m_n_cols, X.n_rows, X.n_cols, "Mat::elem()" ); - - for(uword col=0; col < m_n_cols; ++col) - { - for(uword ri_count=0; ri_count < ri_n_elem; ++ri_count) - { - const uword row = ri_mem[ri_count]; - - arma_conform_check_bounds( (row >= m_n_rows), "Mat::elem(): index out of bounds" ); - - if(is_same_type::yes) { m_local.at(row,col) = X.at(ri_count, col); } - if(is_same_type::yes) { m_local.at(row,col) += X.at(ri_count, col); } - if(is_same_type::yes) { m_local.at(row,col) -= X.at(ri_count, col); } - if(is_same_type::yes) { m_local.at(row,col) *= X.at(ri_count, col); } - if(is_same_type::yes) { m_local.at(row,col) /= X.at(ri_count, col); } - } - } - } - } - - - -// -// - - - -template -inline -void -subview_elem2::replace(const eT old_val, const eT new_val) - { - arma_debug_sigprint(); - - Mat tmp(*this); - - tmp.replace(old_val, new_val); - - (*this).operator=(tmp); - } - - - -template -inline -void -subview_elem2::clean(const pod_type threshold) - { - arma_debug_sigprint(); - - Mat tmp(*this); - - tmp.clean(threshold); - - (*this).operator=(tmp); - } - - - -template -inline -void -subview_elem2::clamp(const eT min_val, const eT max_val) - { - arma_debug_sigprint(); - - Mat tmp(*this); - - tmp.clamp(min_val, max_val); - - (*this).operator=(tmp); - } - - - -template -inline -void -subview_elem2::fill(const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -template -inline -void -subview_elem2::zeros() - { - arma_debug_sigprint(); - - inplace_op(eT(0)); - } - - - -template -inline -void -subview_elem2::ones() - { - arma_debug_sigprint(); - - inplace_op(eT(1)); - } - - - -template -inline -void -subview_elem2::operator+= (const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -template -inline -void -subview_elem2::operator-= (const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -template -inline -void -subview_elem2::operator*= (const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -template -inline -void -subview_elem2::operator/= (const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -// -// - - - -template -template -inline -void -subview_elem2::operator_equ(const subview_elem2& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - - -template -template -inline -void -subview_elem2::operator= (const subview_elem2& x) - { - arma_debug_sigprint(); - - (*this).operator_equ(x); - } - - - -//! work around compiler bugs -template -inline -void -subview_elem2::operator= (const subview_elem2& x) - { - arma_debug_sigprint(); - - (*this).operator_equ(x); - } - - - -template -template -inline -void -subview_elem2::operator+= (const subview_elem2& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_elem2::operator-= (const subview_elem2& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_elem2::operator%= (const subview_elem2& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_elem2::operator/= (const subview_elem2& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_elem2::operator= (const Base& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_elem2::operator+= (const Base& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_elem2::operator-= (const Base& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_elem2::operator%= (const Base& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -template -template -inline -void -subview_elem2::operator/= (const Base& x) - { - arma_debug_sigprint(); - - inplace_op(x); - } - - - -// -// - - - -template -template -inline -void -subview_elem2::operator= (const SpBase& x) - { - arma_debug_sigprint(); - - const Mat tmp(x); - - inplace_op(tmp); - } - - - -template -template -inline -void -subview_elem2::operator+= (const SpBase& x) - { - arma_debug_sigprint(); - - const Mat tmp(x); - - inplace_op(tmp); - } - - - -template -template -inline -void -subview_elem2::operator-= (const SpBase& x) - { - arma_debug_sigprint(); - - const Mat tmp(x); - - inplace_op(tmp); - } - - - -template -template -inline -void -subview_elem2::operator%= (const SpBase& x) - { - arma_debug_sigprint(); - - const Mat tmp(x); - - inplace_op(tmp); - } - - - -template -template -inline -void -subview_elem2::operator/= (const SpBase& x) - { - arma_debug_sigprint(); - - const Mat tmp(x); - - inplace_op(tmp); - } - - - -// -// - - - -template -inline -void -subview_elem2::extract(Mat& actual_out, const subview_elem2& in) - { - arma_debug_sigprint(); - - Mat& m_local = const_cast< Mat& >(in.m); - - const uword m_n_rows = m_local.n_rows; - const uword m_n_cols = m_local.n_cols; - - const bool alias = (&actual_out == &m_local); - - if(alias) { arma_debug_print("subview_elem2::extract(): aliasing detected"); } - - Mat* tmp_out = alias ? new Mat() : nullptr; - Mat& out = alias ? *tmp_out : actual_out; - - if( (in.all_rows == false) && (in.all_cols == false) ) - { - const unwrap_check_mixed tmp1(in.base_ri.get_ref(), actual_out); - const unwrap_check_mixed tmp2(in.base_ci.get_ref(), actual_out); - - const umat& ri = tmp1.M; - const umat& ci = tmp2.M; - - arma_conform_check - ( - ( ((ri.is_vec() == false) && (ri.is_empty() == false)) || ((ci.is_vec() == false) && (ci.is_empty() == false)) ), - "Mat::elem(): given object must be a vector" - ); - - const uword* ri_mem = ri.memptr(); - const uword ri_n_elem = ri.n_elem; - - const uword* ci_mem = ci.memptr(); - const uword ci_n_elem = ci.n_elem; - - out.set_size(ri_n_elem, ci_n_elem); - - eT* out_mem = out.memptr(); - uword out_count = 0; - - for(uword ci_count=0; ci_count < ci_n_elem; ++ci_count) - { - const uword col = ci_mem[ci_count]; - - arma_conform_check_bounds( (col >= m_n_cols), "Mat::elem(): index out of bounds" ); - - for(uword ri_count=0; ri_count < ri_n_elem; ++ri_count) - { - const uword row = ri_mem[ri_count]; - - arma_conform_check_bounds( (row >= m_n_rows), "Mat::elem(): index out of bounds" ); - - out_mem[out_count] = m_local.at(row,col); - ++out_count; - } - } - } - else - if( (in.all_rows == true) && (in.all_cols == false) ) - { - const unwrap_check_mixed tmp2(in.base_ci.get_ref(), m_local); - - const umat& ci = tmp2.M; - - arma_conform_check - ( - ( (ci.is_vec() == false) && (ci.is_empty() == false) ), - "Mat::elem(): given object must be a vector" - ); - - const uword* ci_mem = ci.memptr(); - const uword ci_n_elem = ci.n_elem; - - out.set_size(m_n_rows, ci_n_elem); - - for(uword ci_count=0; ci_count < ci_n_elem; ++ci_count) - { - const uword col = ci_mem[ci_count]; - - arma_conform_check_bounds( (col >= m_n_cols), "Mat::elem(): index out of bounds" ); - - arrayops::copy( out.colptr(ci_count), m_local.colptr(col), m_n_rows ); - } - } - else - if( (in.all_rows == false) && (in.all_cols == true) ) - { - const unwrap_check_mixed tmp1(in.base_ri.get_ref(), m_local); - - const umat& ri = tmp1.M; - - arma_conform_check - ( - ( (ri.is_vec() == false) && (ri.is_empty() == false) ), - "Mat::elem(): given object must be a vector" - ); - - const uword* ri_mem = ri.memptr(); - const uword ri_n_elem = ri.n_elem; - - out.set_size(ri_n_elem, m_n_cols); - - for(uword col=0; col < m_n_cols; ++col) - { - for(uword ri_count=0; ri_count < ri_n_elem; ++ri_count) - { - const uword row = ri_mem[ri_count]; - - arma_conform_check_bounds( (row >= m_n_rows), "Mat::elem(): index out of bounds" ); - - out.at(ri_count,col) = m_local.at(row,col); - } - } - } - - - if(alias) - { - actual_out.steal_mem(out); - - delete tmp_out; - } - } - - - -// TODO: implement a dedicated function instead of creating a temporary (but lots of potential aliasing issues) -template -inline -void -subview_elem2::plus_inplace(Mat& out, const subview_elem2& in) - { - arma_debug_sigprint(); - - const Mat tmp(in); - - out += tmp; - } - - - -template -inline -void -subview_elem2::minus_inplace(Mat& out, const subview_elem2& in) - { - arma_debug_sigprint(); - - const Mat tmp(in); - - out -= tmp; - } - - - -template -inline -void -subview_elem2::schur_inplace(Mat& out, const subview_elem2& in) - { - arma_debug_sigprint(); - - const Mat tmp(in); - - out %= tmp; - } - - - -template -inline -void -subview_elem2::div_inplace(Mat& out, const subview_elem2& in) - { - arma_debug_sigprint(); - - const Mat tmp(in); - - out /= tmp; - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_field_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_field_bones.hpp deleted file mode 100644 index 8ea831566..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_field_bones.hpp +++ /dev/null @@ -1,95 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup subview_field -//! @{ - - -//! Class for storing data required to construct or apply operations to a subfield -//! (ie. where the subfield starts and ends as well as a reference/pointer to the original field), -template -class subview_field - { - public: - - typedef oT object_type; - - const field& f; - - const uword aux_row1; - const uword aux_col1; - const uword aux_slice1; - - const uword n_rows; - const uword n_cols; - const uword n_slices; - const uword n_elem; - - - protected: - - arma_inline subview_field(const field& in_f, const uword in_row1, const uword in_col1, const uword in_n_rows, const uword in_n_cols); - arma_inline subview_field(const field& in_f, const uword in_row1, const uword in_col1, const uword in_slice1, const uword in_n_rows, const uword in_n_cols, const uword in_n_slices); - - - public: - - inline ~subview_field(); - inline subview_field() = delete; - - inline void operator= (const field& x); - inline void operator= (const subview_field& x); - - arma_warn_unused arma_inline oT& operator[](const uword i); - arma_warn_unused arma_inline const oT& operator[](const uword i) const; - - arma_warn_unused arma_inline oT& operator()(const uword i); - arma_warn_unused arma_inline const oT& operator()(const uword i) const; - - arma_warn_unused arma_inline oT& at(const uword row, const uword col); - arma_warn_unused arma_inline const oT& at(const uword row, const uword col) const; - - arma_warn_unused arma_inline oT& at(const uword row, const uword col, const uword slice); - arma_warn_unused arma_inline const oT& at(const uword row, const uword col, const uword slice) const; - - arma_warn_unused arma_inline oT& operator()(const uword row, const uword col); - arma_warn_unused arma_inline const oT& operator()(const uword row, const uword col) const; - - arma_warn_unused arma_inline oT& operator()(const uword row, const uword col, const uword slice); - arma_warn_unused arma_inline const oT& operator()(const uword row, const uword col, const uword slice) const; - - arma_warn_unused arma_inline bool is_empty() const; - - inline bool check_overlap(const subview_field& x) const; - - inline void print(const std::string extra_text = "") const; - inline void print(std::ostream& user_stream, const std::string extra_text = "") const; - - template inline void for_each(functor F); - template inline void for_each(functor F) const; - - inline void fill(const oT& x); - - inline static void extract(field& out, const subview_field& in); - - - friend class field; - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_field_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_field_meat.hpp deleted file mode 100644 index 9b5286ca6..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_field_meat.hpp +++ /dev/null @@ -1,557 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup subview_field -//! @{ - - -template -inline -subview_field::~subview_field() - { - arma_debug_sigprint(); - } - - - -template -arma_inline -subview_field::subview_field - ( - const field& in_f, - const uword in_row1, - const uword in_col1, - const uword in_n_rows, - const uword in_n_cols - ) - : f(in_f) - , aux_row1(in_row1) - , aux_col1(in_col1) - , aux_slice1(0) - , n_rows(in_n_rows) - , n_cols(in_n_cols) - , n_slices( (in_f.n_slices > 0) ? uword(1) : uword(0) ) - , n_elem(in_n_rows*in_n_cols*n_slices) - { - arma_debug_sigprint(); - } - - - -template -arma_inline -subview_field::subview_field - ( - const field& in_f, - const uword in_row1, - const uword in_col1, - const uword in_slice1, - const uword in_n_rows, - const uword in_n_cols, - const uword in_n_slices - ) - : f(in_f) - , aux_row1(in_row1) - , aux_col1(in_col1) - , aux_slice1(in_slice1) - , n_rows(in_n_rows) - , n_cols(in_n_cols) - , n_slices(in_n_slices) - , n_elem(in_n_rows*in_n_cols*in_n_slices) - { - arma_debug_sigprint(); - } - - - -template -inline -void -subview_field::operator= (const field& x) - { - arma_debug_sigprint(); - - subview_field& t = *this; - - arma_conform_check( (t.n_rows != x.n_rows) || (t.n_cols != x.n_cols) || (t.n_slices != x.n_slices), "incompatible field dimensions" ); - - if(t.n_slices == 1) - { - for(uword col=0; col < t.n_cols; ++col) - for(uword row=0; row < t.n_rows; ++row) - { - t.at(row,col) = x.at(row,col); - } - } - else - { - for(uword slice=0; slice < t.n_slices; ++slice) - for(uword col=0; col < t.n_cols; ++col ) - for(uword row=0; row < t.n_rows; ++row ) - { - t.at(row,col,slice) = x.at(row,col,slice); - } - } - } - - - -//! x.subfield(...) = y.subfield(...) -template -inline -void -subview_field::operator= (const subview_field& x) - { - arma_debug_sigprint(); - - if(check_overlap(x)) - { - const field tmp(x); - - (*this).operator=(tmp); - - return; - } - - subview_field& t = *this; - - arma_conform_check( (t.n_rows != x.n_rows) || (t.n_cols != x.n_cols) || (t.n_slices != x.n_slices), "incompatible field dimensions" ); - - if(t.n_slices == 1) - { - for(uword col=0; col < t.n_cols; ++col) - for(uword row=0; row < t.n_rows; ++row) - { - t.at(row,col) = x.at(row,col); - } - } - else - { - for(uword slice=0; slice < t.n_slices; ++slice) - for(uword col=0; col < t.n_cols; ++col ) - for(uword row=0; row < t.n_rows; ++row ) - { - t.at(row,col,slice) = x.at(row,col,slice); - } - } - } - - - -template -arma_inline -oT& -subview_field::operator[](const uword i) - { - const uword n_elem_slice = n_rows*n_cols; - - const uword in_slice = i / n_elem_slice; - const uword offset = in_slice * n_elem_slice; - const uword j = i - offset; - - const uword in_col = j / n_rows; - const uword in_row = j % n_rows; - - const uword index = (in_slice + aux_slice1)*(f.n_rows*f.n_cols) + (in_col + aux_col1)*f.n_rows + aux_row1 + in_row; - - return *((const_cast< field& >(f)).mem[index]); - } - - - -template -arma_inline -const oT& -subview_field::operator[](const uword i) const - { - const uword n_elem_slice = n_rows*n_cols; - - const uword in_slice = i / n_elem_slice; - const uword offset = in_slice * n_elem_slice; - const uword j = i - offset; - - const uword in_col = j / n_rows; - const uword in_row = j % n_rows; - - const uword index = (in_slice + aux_slice1)*(f.n_rows*f.n_cols) + (in_col + aux_col1)*f.n_rows + aux_row1 + in_row; - - return *(f.mem[index]); - } - - - -template -arma_inline -oT& -subview_field::operator()(const uword i) - { - arma_conform_check_bounds( (i >= n_elem), "subview_field::operator(): index out of bounds" ); - - return operator[](i); - } - - - -template -arma_inline -const oT& -subview_field::operator()(const uword i) const - { - arma_conform_check_bounds( (i >= n_elem), "subview_field::operator(): index out of bounds" ); - - return operator[](i); - } - - - -template -arma_inline -oT& -subview_field::operator()(const uword in_row, const uword in_col) - { - return operator()(in_row, in_col, 0); - } - - - -template -arma_inline -const oT& -subview_field::operator()(const uword in_row, const uword in_col) const - { - return operator()(in_row, in_col, 0); - } - - - -template -arma_inline -oT& -subview_field::operator()(const uword in_row, const uword in_col, const uword in_slice) - { - arma_conform_check_bounds( ((in_row >= n_rows) || (in_col >= n_cols) || (in_slice >= n_slices)), "subview_field::operator(): index out of bounds" ); - - const uword index = (in_slice + aux_slice1)*(f.n_rows*f.n_cols) + (in_col + aux_col1)*f.n_rows + aux_row1 + in_row; - - return *((const_cast< field& >(f)).mem[index]); - } - - - -template -arma_inline -const oT& -subview_field::operator()(const uword in_row, const uword in_col, const uword in_slice) const - { - arma_conform_check_bounds( ((in_row >= n_rows) || (in_col >= n_cols) || (in_slice >= n_slices)), "subview_field::operator(): index out of bounds" ); - - const uword index = (in_slice + aux_slice1)*(f.n_rows*f.n_cols) + (in_col + aux_col1)*f.n_rows + aux_row1 + in_row; - - return *(f.mem[index]); - } - - - -template -arma_inline -oT& -subview_field::at(const uword in_row, const uword in_col) - { - return at(in_row, in_col, 0); - } - - - -template -arma_inline -const oT& -subview_field::at(const uword in_row, const uword in_col) const - { - return at(in_row, in_col, 0); - } - - - -template -arma_inline -oT& -subview_field::at(const uword in_row, const uword in_col, const uword in_slice) - { - const uword index = (in_slice + aux_slice1)*(f.n_rows*f.n_cols) + (in_col + aux_col1)*f.n_rows + aux_row1 + in_row; - - return *((const_cast< field& >(f)).mem[index]); - } - - - -template -arma_inline -const oT& -subview_field::at(const uword in_row, const uword in_col, const uword in_slice) const - { - const uword index = (in_slice + aux_slice1)*(f.n_rows*f.n_cols) + (in_col + aux_col1)*f.n_rows + aux_row1 + in_row; - - return *(f.mem[index]); - } - - - -template -arma_inline -bool -subview_field::is_empty() const - { - return (n_elem == 0); - } - - - -template -inline -bool -subview_field::check_overlap(const subview_field& x) const - { - const subview_field& t = *this; - - if(&t.f != &x.f) - { - return false; - } - else - { - if( (t.n_elem == 0) || (x.n_elem == 0) ) - { - return false; - } - else - { - const uword t_row_start = t.aux_row1; - const uword t_row_end_p1 = t_row_start + t.n_rows; - - const uword t_col_start = t.aux_col1; - const uword t_col_end_p1 = t_col_start + t.n_cols; - - const uword t_slice_start = t.aux_slice1; - const uword t_slice_end_p1 = t_slice_start + t.n_slices; - - const uword x_row_start = x.aux_row1; - const uword x_row_end_p1 = x_row_start + x.n_rows; - - const uword x_col_start = x.aux_col1; - const uword x_col_end_p1 = x_col_start + x.n_cols; - - const uword x_slice_start = x.aux_slice1; - const uword x_slice_end_p1 = x_slice_start + x.n_slices; - - const bool outside_rows = ( (x_row_start >= t_row_end_p1 ) || (t_row_start >= x_row_end_p1 ) ); - const bool outside_cols = ( (x_col_start >= t_col_end_p1 ) || (t_col_start >= x_col_end_p1 ) ); - const bool outside_slices = ( (x_slice_start >= t_slice_end_p1) || (t_slice_start >= x_slice_end_p1) ); - - return ( (outside_rows == false) && (outside_cols == false) && (outside_slices == false) ); - } - } - } - - - -template -inline -void -subview_field::print(const std::string extra_text) const - { - arma_debug_sigprint(); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = get_cout_stream().width(); - - get_cout_stream() << extra_text << '\n'; - - get_cout_stream().width(orig_width); - } - - arma_ostream::print(get_cout_stream(), *this); - } - - - -template -inline -void -subview_field::print(std::ostream& user_stream, const std::string extra_text) const - { - arma_debug_sigprint(); - - if(extra_text.length() != 0) - { - const std::streamsize orig_width = user_stream.width(); - - user_stream << extra_text << '\n'; - - user_stream.width(orig_width); - } - - arma_ostream::print(user_stream, *this); - } - - - -template -template -inline -void -subview_field::for_each(functor F) - { - arma_debug_sigprint(); - - subview_field& t = *this; - - if(t.n_slices == 1) - { - for(uword col=0; col < t.n_cols; ++col) - for(uword row=0; row < t.n_rows; ++row) - { - F( t.at(row,col) ); - } - } - else - { - for(uword slice=0; slice < t.n_slices; ++slice) - for(uword col=0; col < t.n_cols; ++col ) - for(uword row=0; row < t.n_rows; ++row ) - { - F( t.at(row,col,slice) ); - } - } - } - - - -template -template -inline -void -subview_field::for_each(functor F) const - { - arma_debug_sigprint(); - - const subview_field& t = *this; - - if(t.n_slices == 1) - { - for(uword col=0; col < t.n_cols; ++col) - for(uword row=0; row < t.n_rows; ++row) - { - F( t.at(row,col) ); - } - } - else - { - for(uword slice=0; slice < t.n_slices; ++slice) - for(uword col=0; col < t.n_cols; ++col ) - for(uword row=0; row < t.n_rows; ++row ) - { - F( t.at(row,col,slice) ); - } - } - } - - - -template -inline -void -subview_field::fill(const oT& x) - { - arma_debug_sigprint(); - - subview_field& t = *this; - - if(t.n_slices == 1) - { - for(uword col=0; col < t.n_cols; ++col) - for(uword row=0; row < t.n_rows; ++row) - { - t.at(row,col) = x; - } - } - else - { - for(uword slice=0; slice < t.n_slices; ++slice) - for(uword col=0; col < t.n_cols; ++col ) - for(uword row=0; row < t.n_rows; ++row ) - { - t.at(row,col,slice) = x; - } - } - } - - - -//! X = Y.subfield(...) -template -inline -void -subview_field::extract(field& actual_out, const subview_field& in) - { - arma_debug_sigprint(); - - // - const bool alias = (&actual_out == &in.f); - - field* tmp = (alias) ? new field : nullptr; - field& out = (alias) ? (*tmp) : actual_out; - - // - - const uword n_rows = in.n_rows; - const uword n_cols = in.n_cols; - const uword n_slices = in.n_slices; - - out.set_size(n_rows, n_cols, n_slices); - - arma_debug_print(arma_str::format("out.n_rows: %u; out.n_cols: %u; out.n_slices: %u; in.f.n_rows: %u; in.f.n_cols: %u; in.f.n_slices: %u") % out.n_rows % out.n_cols % out.n_slices % in.f.n_rows % in.f.n_cols % in.f.n_slices); - - if(n_slices == 1) - { - for(uword col = 0; col < n_cols; ++col) - for(uword row = 0; row < n_rows; ++row) - { - out.at(row,col) = in.at(row,col); - } - } - else - { - for(uword slice = 0; slice < n_slices; ++slice) - for(uword col = 0; col < n_cols; ++col ) - for(uword row = 0; row < n_rows; ++row ) - { - out.at(row,col,slice) = in.at(row,col,slice); - } - } - - if(alias) - { - actual_out = out; - delete tmp; - } - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_meat.hpp deleted file mode 100644 index 81cc39f98..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/subview_meat.hpp +++ /dev/null @@ -1,4985 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup subview -//! @{ - - -template -inline -subview::~subview() - { - arma_debug_sigprint_this(this); - } - - - -template -inline -subview::subview(const Mat& in_m, const uword in_row1, const uword in_col1, const uword in_n_rows, const uword in_n_cols) - : m (in_m ) - , aux_row1(in_row1 ) - , aux_col1(in_col1 ) - , n_rows (in_n_rows) - , n_cols (in_n_cols) - , n_elem (in_n_rows*in_n_cols) - { - arma_debug_sigprint_this(this); - } - - - -template -inline -subview::subview(const subview& in) - : m (in.m ) - , aux_row1(in.aux_row1) - , aux_col1(in.aux_col1) - , n_rows (in.n_rows ) - , n_cols (in.n_cols ) - , n_elem (in.n_elem ) - { - arma_debug_sigprint(arma_str::format("this: %x; in: %x") % this % &in); - } - - - -template -inline -subview::subview(subview&& in) - : m (in.m ) - , aux_row1(in.aux_row1) - , aux_col1(in.aux_col1) - , n_rows (in.n_rows ) - , n_cols (in.n_cols ) - , n_elem (in.n_elem ) - { - arma_debug_sigprint(arma_str::format("this: %x; in: %x") % this % &in); - - // for paranoia - - access::rw(in.aux_row1) = 0; - access::rw(in.aux_col1) = 0; - access::rw(in.n_rows ) = 0; - access::rw(in.n_cols ) = 0; - access::rw(in.n_elem ) = 0; - } - - - -template -template -inline -void -subview::inplace_op(const eT val) - { - arma_debug_sigprint(); - - subview& s = *this; - - const uword s_n_rows = s.n_rows; - const uword s_n_cols = s.n_cols; - - if(s_n_rows == 1) - { - Mat& A = const_cast< Mat& >(s.m); - - const uword A_n_rows = A.n_rows; - - eT* Aptr = &(A.at(s.aux_row1,s.aux_col1)); - - uword jj; - for(jj=1; jj < s_n_cols; jj+=2) - { - if(is_same_type::yes) { (*Aptr) += val; Aptr += A_n_rows; (*Aptr) += val; Aptr += A_n_rows; } - if(is_same_type::yes) { (*Aptr) -= val; Aptr += A_n_rows; (*Aptr) -= val; Aptr += A_n_rows; } - if(is_same_type::yes) { (*Aptr) *= val; Aptr += A_n_rows; (*Aptr) *= val; Aptr += A_n_rows; } - if(is_same_type::yes) { (*Aptr) /= val; Aptr += A_n_rows; (*Aptr) /= val; Aptr += A_n_rows; } - } - - if((jj-1) < s_n_cols) - { - if(is_same_type::yes) { (*Aptr) += val; } - if(is_same_type::yes) { (*Aptr) -= val; } - if(is_same_type::yes) { (*Aptr) *= val; } - if(is_same_type::yes) { (*Aptr) /= val; } - } - } - else - { - for(uword ucol=0; ucol < s_n_cols; ++ucol) - { - if(is_same_type::yes) { arrayops::inplace_plus ( colptr(ucol), val, s_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_minus( colptr(ucol), val, s_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_mul ( colptr(ucol), val, s_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_div ( colptr(ucol), val, s_n_rows ); } - } - } - } - - - -template -template -inline -void -subview::inplace_op(const Base& in, const char* identifier) - { - arma_debug_sigprint(); - - const Proxy P(in.get_ref()); - - subview& s = *this; - - const uword s_n_rows = s.n_rows; - const uword s_n_cols = s.n_cols; - - arma_conform_assert_same_size(s, P, identifier); - - const bool use_mp = arma_config::openmp && Proxy::use_mp && mp_gate::eval(s.n_elem); - const bool has_overlap = P.has_overlap(s); - - if(has_overlap) { arma_debug_print("aliasing or overlap detected"); } - - if( (is_Mat::stored_type>::value) || (use_mp) || (has_overlap) ) - { - const unwrap_check::stored_type> tmp(P.Q, has_overlap); - const Mat& B = tmp.M; - - if(s_n_rows == 1) - { - Mat& A = const_cast< Mat& >(m); - - const uword A_n_rows = A.n_rows; - - eT* Aptr = &(A.at(aux_row1,aux_col1)); - const eT* Bptr = B.memptr(); - - uword jj; - for(jj=1; jj < s_n_cols; jj+=2) - { - const eT tmp1 = (*Bptr); Bptr++; - const eT tmp2 = (*Bptr); Bptr++; - - if(is_same_type::yes) { (*Aptr) = tmp1; Aptr += A_n_rows; (*Aptr) = tmp2; Aptr += A_n_rows; } - if(is_same_type::yes) { (*Aptr) += tmp1; Aptr += A_n_rows; (*Aptr) += tmp2; Aptr += A_n_rows; } - if(is_same_type::yes) { (*Aptr) -= tmp1; Aptr += A_n_rows; (*Aptr) -= tmp2; Aptr += A_n_rows; } - if(is_same_type::yes) { (*Aptr) *= tmp1; Aptr += A_n_rows; (*Aptr) *= tmp2; Aptr += A_n_rows; } - if(is_same_type::yes) { (*Aptr) /= tmp1; Aptr += A_n_rows; (*Aptr) /= tmp2; Aptr += A_n_rows; } - } - - if((jj-1) < s_n_cols) - { - if(is_same_type::yes) { (*Aptr) = (*Bptr); } - if(is_same_type::yes) { (*Aptr) += (*Bptr); } - if(is_same_type::yes) { (*Aptr) -= (*Bptr); } - if(is_same_type::yes) { (*Aptr) *= (*Bptr); } - if(is_same_type::yes) { (*Aptr) /= (*Bptr); } - } - } - else // not a row vector - { - if((s.aux_row1 == 0) && (s_n_rows == s.m.n_rows)) - { - if(is_same_type::yes) { arrayops::copy ( s.colptr(0), B.memptr(), s.n_elem ); } - if(is_same_type::yes) { arrayops::inplace_plus ( s.colptr(0), B.memptr(), s.n_elem ); } - if(is_same_type::yes) { arrayops::inplace_minus( s.colptr(0), B.memptr(), s.n_elem ); } - if(is_same_type::yes) { arrayops::inplace_mul ( s.colptr(0), B.memptr(), s.n_elem ); } - if(is_same_type::yes) { arrayops::inplace_div ( s.colptr(0), B.memptr(), s.n_elem ); } - } - else - { - for(uword ucol=0; ucol < s_n_cols; ++ucol) - { - if(is_same_type::yes) { arrayops::copy ( s.colptr(ucol), B.colptr(ucol), s_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_plus ( s.colptr(ucol), B.colptr(ucol), s_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_minus( s.colptr(ucol), B.colptr(ucol), s_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_mul ( s.colptr(ucol), B.colptr(ucol), s_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_div ( s.colptr(ucol), B.colptr(ucol), s_n_rows ); } - } - } - } - } - else // use the Proxy - { - if(s_n_rows == 1) - { - Mat& A = const_cast< Mat& >(m); - - const uword A_n_rows = A.n_rows; - - eT* Aptr = &(A.at(aux_row1,aux_col1)); - - uword jj; - for(jj=1; jj < s_n_cols; jj+=2) - { - const uword ii = (jj-1); - - const eT tmp1 = (Proxy::use_at) ? P.at(0,ii) : P[ii]; - const eT tmp2 = (Proxy::use_at) ? P.at(0,jj) : P[jj]; - - if(is_same_type::yes) { (*Aptr) = tmp1; Aptr += A_n_rows; (*Aptr) = tmp2; Aptr += A_n_rows; } - if(is_same_type::yes) { (*Aptr) += tmp1; Aptr += A_n_rows; (*Aptr) += tmp2; Aptr += A_n_rows; } - if(is_same_type::yes) { (*Aptr) -= tmp1; Aptr += A_n_rows; (*Aptr) -= tmp2; Aptr += A_n_rows; } - if(is_same_type::yes) { (*Aptr) *= tmp1; Aptr += A_n_rows; (*Aptr) *= tmp2; Aptr += A_n_rows; } - if(is_same_type::yes) { (*Aptr) /= tmp1; Aptr += A_n_rows; (*Aptr) /= tmp2; Aptr += A_n_rows; } - } - - const uword ii = (jj-1); - if(ii < s_n_cols) - { - if(is_same_type::yes) { (*Aptr) = (Proxy::use_at) ? P.at(0,ii) : P[ii]; } - if(is_same_type::yes) { (*Aptr) += (Proxy::use_at) ? P.at(0,ii) : P[ii]; } - if(is_same_type::yes) { (*Aptr) -= (Proxy::use_at) ? P.at(0,ii) : P[ii]; } - if(is_same_type::yes) { (*Aptr) *= (Proxy::use_at) ? P.at(0,ii) : P[ii]; } - if(is_same_type::yes) { (*Aptr) /= (Proxy::use_at) ? P.at(0,ii) : P[ii]; } - } - } - else // not a row vector - { - if(Proxy::use_at) - { - for(uword ucol=0; ucol < s_n_cols; ++ucol) - { - eT* s_col_data = s.colptr(ucol); - - uword jj; - for(jj=1; jj < s_n_rows; jj+=2) - { - const uword ii = (jj-1); - - const eT tmp1 = P.at(ii,ucol); - const eT tmp2 = P.at(jj,ucol); - - if(is_same_type::yes) { (*s_col_data) = tmp1; s_col_data++; (*s_col_data) = tmp2; s_col_data++; } - if(is_same_type::yes) { (*s_col_data) += tmp1; s_col_data++; (*s_col_data) += tmp2; s_col_data++; } - if(is_same_type::yes) { (*s_col_data) -= tmp1; s_col_data++; (*s_col_data) -= tmp2; s_col_data++; } - if(is_same_type::yes) { (*s_col_data) *= tmp1; s_col_data++; (*s_col_data) *= tmp2; s_col_data++; } - if(is_same_type::yes) { (*s_col_data) /= tmp1; s_col_data++; (*s_col_data) /= tmp2; s_col_data++; } - } - - const uword ii = (jj-1); - if(ii < s_n_rows) - { - if(is_same_type::yes) { (*s_col_data) = P.at(ii,ucol); } - if(is_same_type::yes) { (*s_col_data) += P.at(ii,ucol); } - if(is_same_type::yes) { (*s_col_data) -= P.at(ii,ucol); } - if(is_same_type::yes) { (*s_col_data) *= P.at(ii,ucol); } - if(is_same_type::yes) { (*s_col_data) /= P.at(ii,ucol); } - } - } - } - else - { - typename Proxy::ea_type Pea = P.get_ea(); - - uword count = 0; - - for(uword ucol=0; ucol < s_n_cols; ++ucol) - { - eT* s_col_data = s.colptr(ucol); - - uword jj; - for(jj=1; jj < s_n_rows; jj+=2) - { - const eT tmp1 = Pea[count]; count++; - const eT tmp2 = Pea[count]; count++; - - if(is_same_type::yes) { (*s_col_data) = tmp1; s_col_data++; (*s_col_data) = tmp2; s_col_data++; } - if(is_same_type::yes) { (*s_col_data) += tmp1; s_col_data++; (*s_col_data) += tmp2; s_col_data++; } - if(is_same_type::yes) { (*s_col_data) -= tmp1; s_col_data++; (*s_col_data) -= tmp2; s_col_data++; } - if(is_same_type::yes) { (*s_col_data) *= tmp1; s_col_data++; (*s_col_data) *= tmp2; s_col_data++; } - if(is_same_type::yes) { (*s_col_data) /= tmp1; s_col_data++; (*s_col_data) /= tmp2; s_col_data++; } - } - - if((jj-1) < s_n_rows) - { - if(is_same_type::yes) { (*s_col_data) = Pea[count]; count++; } - if(is_same_type::yes) { (*s_col_data) += Pea[count]; count++; } - if(is_same_type::yes) { (*s_col_data) -= Pea[count]; count++; } - if(is_same_type::yes) { (*s_col_data) *= Pea[count]; count++; } - if(is_same_type::yes) { (*s_col_data) /= Pea[count]; count++; } - } - } - } - } - } - } - - - -template -template -inline -void -subview::inplace_op(const subview& x, const char* identifier) - { - arma_debug_sigprint(); - - if(check_overlap(x)) - { - const Mat tmp(x); - - if(is_same_type::yes) { (*this).operator= (tmp); } - if(is_same_type::yes) { (*this).operator+=(tmp); } - if(is_same_type::yes) { (*this).operator-=(tmp); } - if(is_same_type::yes) { (*this).operator%=(tmp); } - if(is_same_type::yes) { (*this).operator/=(tmp); } - - return; - } - - subview& s = *this; - - arma_conform_assert_same_size(s, x, identifier); - - const uword s_n_cols = s.n_cols; - const uword s_n_rows = s.n_rows; - - if(s_n_rows == 1) - { - Mat& A = const_cast< Mat& >(s.m); - const Mat& B = x.m; - - const uword A_n_rows = A.n_rows; - const uword B_n_rows = B.n_rows; - - eT* Aptr = &(A.at(s.aux_row1,s.aux_col1)); - const eT* Bptr = &(B.at(x.aux_row1,x.aux_col1)); - - uword jj; - for(jj=1; jj < s_n_cols; jj+=2) - { - const eT tmp1 = (*Bptr); Bptr += B_n_rows; - const eT tmp2 = (*Bptr); Bptr += B_n_rows; - - if(is_same_type::yes) { (*Aptr) = tmp1; Aptr += A_n_rows; (*Aptr) = tmp2; Aptr += A_n_rows; } - if(is_same_type::yes) { (*Aptr) += tmp1; Aptr += A_n_rows; (*Aptr) += tmp2; Aptr += A_n_rows; } - if(is_same_type::yes) { (*Aptr) -= tmp1; Aptr += A_n_rows; (*Aptr) -= tmp2; Aptr += A_n_rows; } - if(is_same_type::yes) { (*Aptr) *= tmp1; Aptr += A_n_rows; (*Aptr) *= tmp2; Aptr += A_n_rows; } - if(is_same_type::yes) { (*Aptr) /= tmp1; Aptr += A_n_rows; (*Aptr) /= tmp2; Aptr += A_n_rows; } - } - - if((jj-1) < s_n_cols) - { - if(is_same_type::yes) { (*Aptr) = (*Bptr); } - if(is_same_type::yes) { (*Aptr) += (*Bptr); } - if(is_same_type::yes) { (*Aptr) -= (*Bptr); } - if(is_same_type::yes) { (*Aptr) *= (*Bptr); } - if(is_same_type::yes) { (*Aptr) /= (*Bptr); } - } - } - else - { - for(uword ucol=0; ucol < s_n_cols; ++ucol) - { - if(is_same_type::yes) { arrayops::copy ( s.colptr(ucol), x.colptr(ucol), s_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_plus ( s.colptr(ucol), x.colptr(ucol), s_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_minus( s.colptr(ucol), x.colptr(ucol), s_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_mul ( s.colptr(ucol), x.colptr(ucol), s_n_rows ); } - if(is_same_type::yes) { arrayops::inplace_div ( s.colptr(ucol), x.colptr(ucol), s_n_rows ); } - } - } - } - - - -template -inline -void -subview::operator= (const eT val) - { - arma_debug_sigprint(); - - if(n_elem != 1) - { - arma_conform_assert_same_size(n_rows, n_cols, 1, 1, "copy into submatrix"); - } - - Mat& X = const_cast< Mat& >(m); - - X.at(aux_row1, aux_col1) = val; - } - - - -template -inline -void -subview::operator+= (const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -template -inline -void -subview::operator-= (const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -template -inline -void -subview::operator*= (const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -template -inline -void -subview::operator/= (const eT val) - { - arma_debug_sigprint(); - - inplace_op(val); - } - - - -template -inline -void -subview::operator= (const subview& x) - { - arma_debug_sigprint(); - - inplace_op(x, "copy into submatrix"); - } - - - -template -inline -void -subview::operator+= (const subview& x) - { - arma_debug_sigprint(); - - inplace_op(x, "addition"); - } - - - -template -inline -void -subview::operator-= (const subview& x) - { - arma_debug_sigprint(); - - inplace_op(x, "subtraction"); - } - - - -template -inline -void -subview::operator%= (const subview& x) - { - arma_debug_sigprint(); - - inplace_op(x, "element-wise multiplication"); - } - - - -template -inline -void -subview::operator/= (const subview& x) - { - arma_debug_sigprint(); - - inplace_op(x, "element-wise division"); - } - - - -template -template -inline -void -subview::operator= (const Base& in) - { - arma_debug_sigprint(); - - inplace_op(in, "copy into submatrix"); - } - - - -template -template -inline -void -subview::operator+= (const Base& in) - { - arma_debug_sigprint(); - - inplace_op(in, "addition"); - } - - - -template -template -inline -void -subview::operator-= (const Base& in) - { - arma_debug_sigprint(); - - inplace_op(in, "subtraction"); - } - - - -template -template -inline -void -subview::operator%= (const Base& in) - { - arma_debug_sigprint(); - - inplace_op(in, "element-wise multiplication"); - } - - - -template -template -inline -void -subview::operator/= (const Base& in) - { - arma_debug_sigprint(); - - inplace_op(in, "element-wise division"); - } - - - -template -template -inline -void -subview::operator=(const SpBase& x) - { - arma_debug_sigprint(); - - const SpProxy p(x.get_ref()); - - arma_conform_assert_same_size(n_rows, n_cols, p.get_n_rows(), p.get_n_cols(), "copy into submatrix"); - - // Clear the subview. - zeros(); - - // Iterate through the sparse subview and set the nonzero values appropriately. - typename SpProxy::const_iterator_type cit = p.begin(); - typename SpProxy::const_iterator_type cit_end = p.end(); - - while(cit != cit_end) - { - at(cit.row(), cit.col()) = *cit; - ++cit; - } - } - - - -template -template -inline -void -subview::operator+=(const SpBase& x) - { - arma_debug_sigprint(); - - const SpProxy p(x.get_ref()); - - arma_conform_assert_same_size(n_rows, n_cols, p.get_n_rows(), p.get_n_cols(), "addition"); - - // Iterate through the sparse subview and add its values. - typename SpProxy::const_iterator_type cit = p.begin(); - typename SpProxy::const_iterator_type cit_end = p.end(); - - while(cit != cit_end) - { - at(cit.row(), cit.col()) += *cit; - ++cit; - } - } - - - -template -template -inline -void -subview::operator-=(const SpBase& x) - { - arma_debug_sigprint(); - - const SpProxy p(x.get_ref()); - - arma_conform_assert_same_size(n_rows, n_cols, p.get_n_rows(), p.get_n_cols(), "subtraction"); - - // Iterate through the sparse subview and subtract its values. - typename SpProxy::const_iterator_type cit = p.begin(); - typename SpProxy::const_iterator_type cit_end = p.end(); - - while(cit != cit_end) - { - at(cit.row(), cit.col()) -= *cit; - ++cit; - } - } - - - -template -template -inline -void -subview::operator%=(const SpBase& x) - { - arma_debug_sigprint(); - - const uword s_n_rows = (*this).n_rows; - const uword s_n_cols = (*this).n_cols; - - const SpProxy p(x.get_ref()); - - arma_conform_assert_same_size(s_n_rows, s_n_cols, p.get_n_rows(), p.get_n_cols(), "element-wise multiplication"); - - if(n_elem == 0) { return; } - - if(p.get_n_nonzero() == 0) { (*this).zeros(); return; } - - // Iterate over nonzero values. - // Any zero values in the sparse expression will result in a zero in our subview. - typename SpProxy::const_iterator_type cit = p.begin(); - typename SpProxy::const_iterator_type cit_end = p.end(); - - uword r = 0; - uword c = 0; - - while(cit != cit_end) - { - const uword cit_row = cit.row(); - const uword cit_col = cit.col(); - - while( ((r == cit_row) && (c == cit_col)) == false ) - { - at(r,c) = eT(0); - - r++; if(r >= s_n_rows) { r = 0; c++; } - } - - at(r, c) *= (*cit); - - ++cit; - r++; if(r >= s_n_rows) { r = 0; c++; } - } - } - - - -template -template -inline -void -subview::operator/=(const SpBase& x) - { - arma_debug_sigprint(); - - const SpProxy p(x.get_ref()); - - arma_conform_assert_same_size(n_rows, n_cols, p.get_n_rows(), p.get_n_cols(), "element-wise division"); - - // This is probably going to fill your subview with a bunch of NaNs, - // so I'm not going to bother to implement it fast. - // You can have slow NaNs. They're fine too. - for(uword c = 0; c < n_cols; ++c) - for(uword r = 0; r < n_rows; ++r) - { - at(r, c) /= p.at(r, c); - } - } - - - -template -template -inline -typename enable_if2< is_same_type::value, void>::result -subview::operator= (const Gen& in) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(n_rows, n_cols, in.n_rows, in.n_cols, "copy into submatrix"); - - in.apply(*this); - } - - - -template -inline -void -subview::operator=(const std::initializer_list& list) - { - arma_debug_sigprint(); - - arma_conform_check( (is_vec() == false), "copy into submatrix: size mismatch" ); - - const uword N = uword(list.size()); - - if(n_rows == 1) - { - arma_conform_assert_same_size(1, n_cols, 1, N, "copy into submatrix"); - - auto it = list.begin(); - - for(uword ii=0; ii < N; ++ii) { (*this).at(0,ii) = (*it); ++it; } - } - else - if(n_cols == 1) - { - arma_conform_assert_same_size(n_rows, 1, N, 1, "copy into submatrix"); - - arrayops::copy( (*this).colptr(0), list.begin(), N ); - } - } - - - -template -inline -void -subview::operator=(const std::initializer_list< std::initializer_list >& list) - { - arma_debug_sigprint(); - - const Mat tmp(list); - - (*this).operator=(tmp); - } - - - -//! apply a functor to each element -template -template -inline -void -subview::for_each(functor F) - { - arma_debug_sigprint(); - - Mat& X = const_cast< Mat& >(m); - - if(n_rows == 1) - { - const uword urow = aux_row1; - const uword start_col = aux_col1; - const uword end_col_plus1 = start_col + n_cols; - - for(uword ucol = start_col; ucol < end_col_plus1; ++ucol) - { - F( X.at(urow, ucol) ); - } - } - else - { - const uword start_col = aux_col1; - const uword start_row = aux_row1; - - const uword end_col_plus1 = start_col + n_cols; - const uword end_row_plus1 = start_row + n_rows; - - for(uword ucol = start_col; ucol < end_col_plus1; ++ucol) - for(uword urow = start_row; urow < end_row_plus1; ++urow) - { - F( X.at(urow, ucol) ); - } - } - } - - - -template -template -inline -void -subview::for_each(functor F) const - { - arma_debug_sigprint(); - - const Mat& X = m; - - if(n_rows == 1) - { - const uword urow = aux_row1; - const uword start_col = aux_col1; - const uword end_col_plus1 = start_col + n_cols; - - for(uword ucol = start_col; ucol < end_col_plus1; ++ucol) - { - F( X.at(urow, ucol) ); - } - } - else - { - const uword start_col = aux_col1; - const uword start_row = aux_row1; - - const uword end_col_plus1 = start_col + n_cols; - const uword end_row_plus1 = start_row + n_rows; - - for(uword ucol = start_col; ucol < end_col_plus1; ++ucol) - for(uword urow = start_row; urow < end_row_plus1; ++urow) - { - F( X.at(urow, ucol) ); - } - } - } - - - -//! transform each element in the subview using a functor -template -template -inline -void -subview::transform(functor F) - { - arma_debug_sigprint(); - - Mat& X = const_cast< Mat& >(m); - - if(n_rows == 1) - { - const uword urow = aux_row1; - const uword start_col = aux_col1; - const uword end_col_plus1 = start_col + n_cols; - - for(uword ucol = start_col; ucol < end_col_plus1; ++ucol) - { - X.at(urow, ucol) = eT( F( X.at(urow, ucol) ) ); - } - } - else - { - const uword start_col = aux_col1; - const uword start_row = aux_row1; - - const uword end_col_plus1 = start_col + n_cols; - const uword end_row_plus1 = start_row + n_rows; - - for(uword ucol = start_col; ucol < end_col_plus1; ++ucol) - for(uword urow = start_row; urow < end_row_plus1; ++urow) - { - X.at(urow, ucol) = eT( F( X.at(urow, ucol) ) ); - } - } - } - - - -//! imbue (fill) the subview with values provided by a functor -template -template -inline -void -subview::imbue(functor F) - { - arma_debug_sigprint(); - - Mat& X = const_cast< Mat& >(m); - - if(n_rows == 1) - { - const uword urow = aux_row1; - const uword start_col = aux_col1; - const uword end_col_plus1 = start_col + n_cols; - - for(uword ucol = start_col; ucol < end_col_plus1; ++ucol) - { - X.at(urow, ucol) = eT( F() ); - } - } - else - { - const uword start_col = aux_col1; - const uword start_row = aux_row1; - - const uword end_col_plus1 = start_col + n_cols; - const uword end_row_plus1 = start_row + n_rows; - - for(uword ucol = start_col; ucol < end_col_plus1; ++ucol) - for(uword urow = start_row; urow < end_row_plus1; ++urow) - { - X.at(urow, ucol) = eT( F() ); - } - } - } - - - -template -inline -void -subview::replace(const eT old_val, const eT new_val) - { - arma_debug_sigprint(); - - subview& s = *this; - - const uword s_n_cols = s.n_cols; - const uword s_n_rows = s.n_rows; - - if(s_n_rows == 1) - { - Mat& A = const_cast< Mat& >(s.m); - - const uword A_n_rows = A.n_rows; - - eT* Aptr = &(A.at(s.aux_row1,s.aux_col1)); - - if(arma_isnan(old_val)) - { - for(uword ucol=0; ucol < s_n_cols; ++ucol) - { - (*Aptr) = (arma_isnan(*Aptr)) ? new_val : (*Aptr); - - Aptr += A_n_rows; - } - } - else - { - for(uword ucol=0; ucol < s_n_cols; ++ucol) - { - (*Aptr) = ((*Aptr) == old_val) ? new_val : (*Aptr); - - Aptr += A_n_rows; - } - } - } - else - { - for(uword ucol=0; ucol < s_n_cols; ++ucol) - { - arrayops::replace(s.colptr(ucol), s_n_rows, old_val, new_val); - } - } - } - - - -template -inline -void -subview::clean(const typename get_pod_type::result threshold) - { - arma_debug_sigprint(); - - subview& s = *this; - - const uword s_n_cols = s.n_cols; - const uword s_n_rows = s.n_rows; - - for(uword ucol=0; ucol < s_n_cols; ++ucol) - { - arrayops::clean( s.colptr(ucol), s_n_rows, threshold ); - } - } - - - -template -inline -void -subview::clamp(const eT min_val, const eT max_val) - { - arma_debug_sigprint(); - - if(is_cx::no) - { - arma_conform_check( (access::tmp_real(min_val) > access::tmp_real(max_val)), "subview::clamp(): min_val must be less than max_val" ); - } - else - { - arma_conform_check( (access::tmp_real(min_val) > access::tmp_real(max_val)), "subview::clamp(): real(min_val) must be less than real(max_val)" ); - arma_conform_check( (access::tmp_imag(min_val) > access::tmp_imag(max_val)), "subview::clamp(): imag(min_val) must be less than imag(max_val)" ); - } - - subview& s = *this; - - const uword s_n_cols = s.n_cols; - const uword s_n_rows = s.n_rows; - - for(uword ucol=0; ucol < s_n_cols; ++ucol) - { - arrayops::clamp( s.colptr(ucol), s_n_rows, min_val, max_val ); - } - } - - - -template -inline -void -subview::fill(const eT val) - { - arma_debug_sigprint(); - - subview& s = *this; - - const uword s_n_cols = s.n_cols; - const uword s_n_rows = s.n_rows; - - if(s_n_rows == 1) - { - Mat& A = const_cast< Mat& >(s.m); - - const uword A_n_rows = A.n_rows; - - eT* Aptr = &(A.at(s.aux_row1,s.aux_col1)); - - uword jj; - for(jj=1; jj < s_n_cols; jj+=2) - { - (*Aptr) = val; Aptr += A_n_rows; - (*Aptr) = val; Aptr += A_n_rows; - } - - if((jj-1) < s_n_cols) - { - (*Aptr) = val; - } - } - else - { - if( (s.aux_row1 == 0) && (s_n_rows == s.m.n_rows) ) - { - arrayops::inplace_set( s.colptr(0), val, s.n_elem ); - } - else - { - for(uword ucol=0; ucol < s_n_cols; ++ucol) - { - arrayops::inplace_set( s.colptr(ucol), val, s_n_rows ); - } - } - } - } - - - -template -inline -void -subview::zeros() - { - arma_debug_sigprint(); - - (*this).fill(eT(0)); - } - - - -template -inline -void -subview::ones() - { - arma_debug_sigprint(); - - (*this).fill(eT(1)); - } - - - -template -inline -void -subview::eye() - { - arma_debug_sigprint(); - - (*this).zeros(); - - const uword N = (std::min)(n_rows, n_cols); - - for(uword ii=0; ii < N; ++ii) - { - at(ii,ii) = eT(1); - } - } - - - -template -inline -void -subview::randu() - { - arma_debug_sigprint(); - - subview& s = (*this); - - const uword s_n_rows = s.n_rows; - const uword s_n_cols = s.n_cols; - - if(s_n_rows == 1) - { - podarray tmp(s_n_cols); - - eT* tmp_mem = tmp.memptr(); - - arma_rng::randu::fill( tmp_mem, s_n_cols ); - - for(uword ii=0; ii < s_n_cols; ++ii) { at(0,ii) = tmp_mem[ii]; } - } - else - { - if( (s.aux_row1 == 0) && (s_n_rows == s.m.n_rows) ) - { - arma_rng::randu::fill( s.colptr(0), s.n_elem ); - } - else - { - for(uword ii=0; ii < s_n_cols; ++ii) - { - arma_rng::randu::fill( s.colptr(ii), s_n_rows ); - } - } - } - } - - - -template -inline -void -subview::randn() - { - arma_debug_sigprint(); - - subview& s = (*this); - - const uword s_n_rows = s.n_rows; - const uword s_n_cols = s.n_cols; - - if(s_n_rows == 1) - { - podarray tmp(s_n_cols); - - eT* tmp_mem = tmp.memptr(); - - arma_rng::randn::fill( tmp_mem, s_n_cols ); - - for(uword ii=0; ii < s_n_cols; ++ii) { at(0,ii) = tmp_mem[ii]; } - } - else - { - if( (s.aux_row1 == 0) && (s_n_rows == s.m.n_rows) ) - { - arma_rng::randn::fill( s.colptr(0), s.n_elem ); - } - else - { - for(uword ii=0; ii < s_n_cols; ++ii) - { - arma_rng::randn::fill( s.colptr(ii), s_n_rows ); - } - } - } - } - - - -template -inline -eT -subview::at_alt(const uword ii) const - { - return operator[](ii); - } - - - -template -inline -eT& -subview::operator[](const uword ii) - { - const uword in_col = ii / n_rows; - const uword in_row = ii % n_rows; - - const uword index = (in_col + aux_col1)*m.n_rows + aux_row1 + in_row; - - return access::rw( (const_cast< Mat& >(m)).mem[index] ); - } - - - -template -inline -eT -subview::operator[](const uword ii) const - { - const uword in_col = ii / n_rows; - const uword in_row = ii % n_rows; - - const uword index = (in_col + aux_col1)*m.n_rows + aux_row1 + in_row; - - return m.mem[index]; - } - - - -template -inline -eT& -subview::operator()(const uword ii) - { - arma_conform_check_bounds( (ii >= n_elem), "subview::operator(): index out of bounds" ); - - const uword in_col = ii / n_rows; - const uword in_row = ii % n_rows; - - const uword index = (in_col + aux_col1)*m.n_rows + aux_row1 + in_row; - - return access::rw( (const_cast< Mat& >(m)).mem[index] ); - } - - - -template -inline -eT -subview::operator()(const uword ii) const - { - arma_conform_check_bounds( (ii >= n_elem), "subview::operator(): index out of bounds" ); - - const uword in_col = ii / n_rows; - const uword in_row = ii % n_rows; - - const uword index = (in_col + aux_col1)*m.n_rows + aux_row1 + in_row; - - return m.mem[index]; - } - - - -template -inline -eT& -subview::operator()(const uword in_row, const uword in_col) - { - arma_conform_check_bounds( ((in_row >= n_rows) || (in_col >= n_cols)), "subview::operator(): index out of bounds" ); - - const uword index = (in_col + aux_col1)*m.n_rows + aux_row1 + in_row; - - return access::rw( (const_cast< Mat& >(m)).mem[index] ); - } - - - -template -inline -eT -subview::operator()(const uword in_row, const uword in_col) const - { - arma_conform_check_bounds( ((in_row >= n_rows) || (in_col >= n_cols)), "subview::operator(): index out of bounds" ); - - const uword index = (in_col + aux_col1)*m.n_rows + aux_row1 + in_row; - - return m.mem[index]; - } - - - -template -inline -eT& -subview::at(const uword in_row, const uword in_col) - { - const uword index = (in_col + aux_col1)*m.n_rows + aux_row1 + in_row; - - return access::rw( (const_cast< Mat& >(m)).mem[index] ); - } - - - -template -inline -eT -subview::at(const uword in_row, const uword in_col) const - { - const uword index = (in_col + aux_col1)*m.n_rows + aux_row1 + in_row; - - return m.mem[index]; - } - - - -template -inline -eT& -subview::front() - { - const uword index = aux_col1*m.n_rows + aux_row1; - - return access::rw( (const_cast< Mat& >(m)).mem[index] ); - } - - - -template -inline -eT -subview::front() const - { - const uword index = aux_col1*m.n_rows + aux_row1; - - return m.mem[index]; - } - - - -template -inline -eT& -subview::back() - { - const uword in_row = n_rows - 1; - const uword in_col = n_cols - 1; - - const uword index = (in_col + aux_col1)*m.n_rows + aux_row1 + in_row; - - return access::rw( (const_cast< Mat& >(m)).mem[index] ); - } - - - -template -inline -eT -subview::back() const - { - const uword in_row = n_rows - 1; - const uword in_col = n_cols - 1; - - const uword index = (in_col + aux_col1)*m.n_rows + aux_row1 + in_row; - - return m.mem[index]; - } - - - -template -arma_inline -eT* -subview::colptr(const uword in_col) - { - return & access::rw((const_cast< Mat& >(m)).mem[ (in_col + aux_col1)*m.n_rows + aux_row1 ]); - } - - - -template -arma_inline -const eT* -subview::colptr(const uword in_col) const - { - return & m.mem[ (in_col + aux_col1)*m.n_rows + aux_row1 ]; - } - - - -template -template -inline -bool -subview::check_overlap(const subview& x) const - { - if(is_same_type::value == false) { return false; } - - const subview& s = (*this); - - if(void_ptr(&(s.m)) != void_ptr(&(x.m))) { return false; } - - if( (s.n_elem == 0) || (x.n_elem == 0) ) { return false; } - - const uword s_row_start = s.aux_row1; - const uword s_row_end_p1 = s_row_start + s.n_rows; - - const uword s_col_start = s.aux_col1; - const uword s_col_end_p1 = s_col_start + s.n_cols; - - - const uword x_row_start = x.aux_row1; - const uword x_row_end_p1 = x_row_start + x.n_rows; - - const uword x_col_start = x.aux_col1; - const uword x_col_end_p1 = x_col_start + x.n_cols; - - - const bool outside_rows = ( (x_row_start >= s_row_end_p1) || (s_row_start >= x_row_end_p1) ); - const bool outside_cols = ( (x_col_start >= s_col_end_p1) || (s_col_start >= x_col_end_p1) ); - - return ( (outside_rows == false) && (outside_cols == false) ); - } - - - -template -inline -bool -subview::is_vec() const - { - return ( (n_rows == 1) || (n_cols == 1) ); - } - - - -template -inline -bool -subview::is_finite() const - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "is_finite(): detection of non-finite values is not reliable in fast math mode"); } - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - - for(uword ii=0; ii -inline -bool -subview::is_zero(const typename get_pod_type::result tol) const - { - arma_debug_sigprint(); - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - - for(uword ii=0; ii -inline -bool -subview::has_inf() const - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "has_inf(): detection of non-finite values is not reliable in fast math mode"); } - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - - for(uword ii=0; ii -inline -bool -subview::has_nan() const - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "has_nan(): detection of non-finite values is not reliable in fast math mode"); } - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - - for(uword ii=0; ii -inline -bool -subview::has_nonfinite() const - { - arma_debug_sigprint(); - - if(arma_config::fast_math_warn) { arma_warn(1, "has_nonfinite(): detection of non-finite values is not reliable in fast math mode"); } - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - - for(uword ii=0; ii -inline -void -subview::extract(Mat& out, const subview& in) - { - arma_debug_sigprint(); - - // NOTE: we're assuming that the matrix has already been set to the correct size and there is no aliasing; - // size setting and alias checking is done by either the Mat contructor or operator=() - - const uword n_rows = in.n_rows; // number of rows in the subview - const uword n_cols = in.n_cols; // number of columns in the subview - - arma_debug_print(arma_str::format("out.n_rows: %u; out.n_cols: %u; in.m.n_rows: %u; in.m.n_cols: %u") % out.n_rows % out.n_cols % in.m.n_rows % in.m.n_cols ); - - - if(in.is_vec()) - { - if(n_cols == 1) // a column vector - { - arma_debug_print("subview::extract(): copying col"); - - // in.colptr(0) is the first column of the subview, taking into account any row offset - arrayops::copy( out.memptr(), in.colptr(0), n_rows ); - } - else - if(n_rows == 1) // a row vector - { - arma_debug_print("subview::extract(): copying row)"); - - eT* out_mem = out.memptr(); - - const uword X_n_rows = in.m.n_rows; - - const eT* Xptr = &(in.m.at(in.aux_row1,in.aux_col1)); - - uword j; - - for(j=1; j < n_cols; j+=2) - { - const eT tmp1 = (*Xptr); Xptr += X_n_rows; - const eT tmp2 = (*Xptr); Xptr += X_n_rows; - - (*out_mem) = tmp1; out_mem++; - (*out_mem) = tmp2; out_mem++; - } - - if((j-1) < n_cols) - { - (*out_mem) = (*Xptr); - } - } - } - else // general submatrix - { - arma_debug_print("subview::extract(): general submatrix"); - - if( (in.aux_row1 == 0) && (n_rows == in.m.n_rows) ) - { - arrayops::copy( out.memptr(), in.colptr(0), in.n_elem ); - } - else - { - for(uword col=0; col < n_cols; ++col) - { - arrayops::copy( out.colptr(col), in.colptr(col), n_rows ); - } - } - } - } - - - -//! X += Y.submat(...) -template -inline -void -subview::plus_inplace(Mat& out, const subview& in) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(out, in, "addition"); - - const uword n_rows = in.n_rows; - const uword n_cols = in.n_cols; - - if(n_rows == 1) - { - eT* out_mem = out.memptr(); - - const Mat& X = in.m; - - const uword row = in.aux_row1; - const uword start_col = in.aux_col1; - - uword i,j; - for(i=0, j=1; j < n_cols; i+=2, j+=2) - { - const eT tmp1 = X.at(row, start_col+i); - const eT tmp2 = X.at(row, start_col+j); - - out_mem[i] += tmp1; - out_mem[j] += tmp2; - } - - if(i < n_cols) - { - out_mem[i] += X.at(row, start_col+i); - } - } - else - { - for(uword col=0; col < n_cols; ++col) - { - arrayops::inplace_plus(out.colptr(col), in.colptr(col), n_rows); - } - } - } - - - -//! X -= Y.submat(...) -template -inline -void -subview::minus_inplace(Mat& out, const subview& in) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(out, in, "subtraction"); - - const uword n_rows = in.n_rows; - const uword n_cols = in.n_cols; - - if(n_rows == 1) - { - eT* out_mem = out.memptr(); - - const Mat& X = in.m; - - const uword row = in.aux_row1; - const uword start_col = in.aux_col1; - - uword i,j; - for(i=0, j=1; j < n_cols; i+=2, j+=2) - { - const eT tmp1 = X.at(row, start_col+i); - const eT tmp2 = X.at(row, start_col+j); - - out_mem[i] -= tmp1; - out_mem[j] -= tmp2; - } - - if(i < n_cols) - { - out_mem[i] -= X.at(row, start_col+i); - } - } - else - { - for(uword col=0; col < n_cols; ++col) - { - arrayops::inplace_minus(out.colptr(col), in.colptr(col), n_rows); - } - } - } - - - -//! X %= Y.submat(...) -template -inline -void -subview::schur_inplace(Mat& out, const subview& in) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(out, in, "element-wise multiplication"); - - const uword n_rows = in.n_rows; - const uword n_cols = in.n_cols; - - if(n_rows == 1) - { - eT* out_mem = out.memptr(); - - const Mat& X = in.m; - - const uword row = in.aux_row1; - const uword start_col = in.aux_col1; - - uword i,j; - for(i=0, j=1; j < n_cols; i+=2, j+=2) - { - const eT tmp1 = X.at(row, start_col+i); - const eT tmp2 = X.at(row, start_col+j); - - out_mem[i] *= tmp1; - out_mem[j] *= tmp2; - } - - if(i < n_cols) - { - out_mem[i] *= X.at(row, start_col+i); - } - } - else - { - for(uword col=0; col < n_cols; ++col) - { - arrayops::inplace_mul(out.colptr(col), in.colptr(col), n_rows); - } - } - } - - - -//! X /= Y.submat(...) -template -inline -void -subview::div_inplace(Mat& out, const subview& in) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(out, in, "element-wise division"); - - const uword n_rows = in.n_rows; - const uword n_cols = in.n_cols; - - if(n_rows == 1) - { - eT* out_mem = out.memptr(); - - const Mat& X = in.m; - - const uword row = in.aux_row1; - const uword start_col = in.aux_col1; - - uword i,j; - for(i=0, j=1; j < n_cols; i+=2, j+=2) - { - const eT tmp1 = X.at(row, start_col+i); - const eT tmp2 = X.at(row, start_col+j); - - out_mem[i] /= tmp1; - out_mem[j] /= tmp2; - } - - if(i < n_cols) - { - out_mem[i] /= X.at(row, start_col+i); - } - } - else - { - for(uword col=0; col < n_cols; ++col) - { - arrayops::inplace_div(out.colptr(col), in.colptr(col), n_rows); - } - } - } - - - -//! creation of subview (row vector) -template -inline -subview_row -subview::row(const uword row_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( row_num >= n_rows, "subview::row(): out of bounds" ); - - const uword base_row = aux_row1 + row_num; - - return subview_row(m, base_row, aux_col1, n_cols); - } - - - -//! creation of subview (row vector) -template -inline -const subview_row -subview::row(const uword row_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( row_num >= n_rows, "subview::row(): out of bounds" ); - - const uword base_row = aux_row1 + row_num; - - return subview_row(m, base_row, aux_col1, n_cols); - } - - - -template -inline -subview_row -subview::operator()(const uword row_num, const span& col_span) - { - arma_debug_sigprint(); - - const bool col_all = col_span.whole; - - const uword local_n_cols = n_cols; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword submat_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - const uword base_col1 = aux_col1 + in_col1; - const uword base_row = aux_row1 + row_num; - - arma_conform_check_bounds - ( - (row_num >= n_rows) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - , - "subview::operator(): indices out of bounds or incorrectly used" - ); - - return subview_row(m, base_row, base_col1, submat_n_cols); - } - - - -template -inline -const subview_row -subview::operator()(const uword row_num, const span& col_span) const - { - arma_debug_sigprint(); - - const bool col_all = col_span.whole; - - const uword local_n_cols = n_cols; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword submat_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - const uword base_col1 = aux_col1 + in_col1; - const uword base_row = aux_row1 + row_num; - - arma_conform_check_bounds - ( - (row_num >= n_rows) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - , - "subview::operator(): indices out of bounds or incorrectly used" - ); - - return subview_row(m, base_row, base_col1, submat_n_cols); - } - - - -//! creation of subview (column vector) -template -inline -subview_col -subview::col(const uword col_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( col_num >= n_cols, "subview::col(): out of bounds" ); - - const uword base_col = aux_col1 + col_num; - - return subview_col(m, base_col, aux_row1, n_rows); - } - - - -//! creation of subview (column vector) -template -inline -const subview_col -subview::col(const uword col_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( col_num >= n_cols, "subview::col(): out of bounds" ); - - const uword base_col = aux_col1 + col_num; - - return subview_col(m, base_col, aux_row1, n_rows); - } - - - -template -inline -subview_col -subview::operator()(const span& row_span, const uword col_num) - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - - const uword local_n_rows = n_rows; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword submat_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - const uword base_row1 = aux_row1 + in_row1; - const uword base_col = aux_col1 + col_num; - - arma_conform_check_bounds - ( - (col_num >= n_cols) - || - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - , - "subview::operator(): indices out of bounds or incorrectly used" - ); - - return subview_col(m, base_col, base_row1, submat_n_rows); - } - - - -template -inline -const subview_col -subview::operator()(const span& row_span, const uword col_num) const - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - - const uword local_n_rows = n_rows; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword submat_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - const uword base_row1 = aux_row1 + in_row1; - const uword base_col = aux_col1 + col_num; - - arma_conform_check_bounds - ( - (col_num >= n_cols) - || - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - , - "subview::operator(): indices out of bounds or incorrectly used" - ); - - return subview_col(m, base_col, base_row1, submat_n_rows); - } - - - -//! create a Col object which uses memory from an existing matrix object. -//! this approach is currently not alias safe -//! and does not take into account that the parent matrix object could be deleted. -//! if deleted memory is accessed by the created Col object, -//! it will cause memory corruption and/or a crash -template -inline -Col -subview::unsafe_col(const uword col_num) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( col_num >= n_cols, "subview::unsafe_col(): out of bounds" ); - - return Col(colptr(col_num), n_rows, false, true); - } - - - -//! create a Col object which uses memory from an existing matrix object. -//! this approach is currently not alias safe -//! and does not take into account that the parent matrix object could be deleted. -//! if deleted memory is accessed by the created Col object, -//! it will cause memory corruption and/or a crash -template -inline -const Col -subview::unsafe_col(const uword col_num) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( col_num >= n_cols, "subview::unsafe_col(): out of bounds" ); - - return Col(const_cast(colptr(col_num)), n_rows, false, true); - } - - - -//! creation of subview (submatrix comprised of specified row vectors) -template -inline -subview -subview::rows(const uword in_row1, const uword in_row2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_row2 >= n_rows), - "subview::rows(): indices out of bounds or incorrectly used" - ); - - const uword subview_n_rows = in_row2 - in_row1 + 1; - const uword base_row1 = aux_row1 + in_row1; - - return subview(m, base_row1, aux_col1, subview_n_rows, n_cols ); - } - - - -//! creation of subview (submatrix comprised of specified row vectors) -template -inline -const subview -subview::rows(const uword in_row1, const uword in_row2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_row2 >= n_rows), - "subview::rows(): indices out of bounds or incorrectly used" - ); - - const uword subview_n_rows = in_row2 - in_row1 + 1; - const uword base_row1 = aux_row1 + in_row1; - - return subview(m, base_row1, aux_col1, subview_n_rows, n_cols ); - } - - - -//! creation of subview (submatrix comprised of specified column vectors) -template -inline -subview -subview::cols(const uword in_col1, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_col1 > in_col2) || (in_col2 >= n_cols), - "subview::cols(): indices out of bounds or incorrectly used" - ); - - const uword subview_n_cols = in_col2 - in_col1 + 1; - const uword base_col1 = aux_col1 + in_col1; - - return subview(m, aux_row1, base_col1, n_rows, subview_n_cols); - } - - - -//! creation of subview (submatrix comprised of specified column vectors) -template -inline -const subview -subview::cols(const uword in_col1, const uword in_col2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_col1 > in_col2) || (in_col2 >= n_cols), - "subview::cols(): indices out of bounds or incorrectly used" - ); - - const uword subview_n_cols = in_col2 - in_col1 + 1; - const uword base_col1 = aux_col1 + in_col1; - - return subview(m, aux_row1, base_col1, n_rows, subview_n_cols); - } - - - -//! creation of subview (submatrix) -template -inline -subview -subview::submat(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_col1 > in_col2) || (in_row2 >= n_rows) || (in_col2 >= n_cols), - "subview::submat(): indices out of bounds or incorrectly used" - ); - - const uword subview_n_rows = in_row2 - in_row1 + 1; - const uword subview_n_cols = in_col2 - in_col1 + 1; - - const uword base_row1 = aux_row1 + in_row1; - const uword base_col1 = aux_col1 + in_col1; - - return subview(m, base_row1, base_col1, subview_n_rows, subview_n_cols); - } - - - -//! creation of subview (generic submatrix) -template -inline -const subview -subview::submat(const uword in_row1, const uword in_col1, const uword in_row2, const uword in_col2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 > in_row2) || (in_col1 > in_col2) || (in_row2 >= n_rows) || (in_col2 >= n_cols), - "subview::submat(): indices out of bounds or incorrectly used" - ); - - const uword subview_n_rows = in_row2 - in_row1 + 1; - const uword subview_n_cols = in_col2 - in_col1 + 1; - - const uword base_row1 = aux_row1 + in_row1; - const uword base_col1 = aux_col1 + in_col1; - - return subview(m, base_row1, base_col1, subview_n_rows, subview_n_cols); - } - - - -//! creation of subview (submatrix) -template -inline -subview -subview::submat(const span& row_span, const span& col_span) - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - const bool col_all = col_span.whole; - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword submat_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword submat_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - arma_conform_check_bounds - ( - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - , - "subview::submat(): indices out of bounds or incorrectly used" - ); - - const uword base_row1 = aux_row1 + in_row1; - const uword base_col1 = aux_col1 + in_col1; - - return subview(m, base_row1, base_col1, submat_n_rows, submat_n_cols); - } - - - -//! creation of subview (generic submatrix) -template -inline -const subview -subview::submat(const span& row_span, const span& col_span) const - { - arma_debug_sigprint(); - - const bool row_all = row_span.whole; - const bool col_all = col_span.whole; - - const uword local_n_rows = n_rows; - const uword local_n_cols = n_cols; - - const uword in_row1 = row_all ? 0 : row_span.a; - const uword in_row2 = row_span.b; - const uword submat_n_rows = row_all ? local_n_rows : in_row2 - in_row1 + 1; - - const uword in_col1 = col_all ? 0 : col_span.a; - const uword in_col2 = col_span.b; - const uword submat_n_cols = col_all ? local_n_cols : in_col2 - in_col1 + 1; - - arma_conform_check_bounds - ( - ( row_all ? false : ((in_row1 > in_row2) || (in_row2 >= local_n_rows)) ) - || - ( col_all ? false : ((in_col1 > in_col2) || (in_col2 >= local_n_cols)) ) - , - "subview::submat(): indices out of bounds or incorrectly used" - ); - - const uword base_row1 = aux_row1 + in_row1; - const uword base_col1 = aux_col1 + in_col1; - - return subview(m, base_row1, base_col1, submat_n_rows, submat_n_cols); - } - - - -template -inline -subview -subview::operator()(const span& row_span, const span& col_span) - { - arma_debug_sigprint(); - - return (*this).submat(row_span, col_span); - } - - - -template -inline -const subview -subview::operator()(const span& row_span, const span& col_span) const - { - arma_debug_sigprint(); - - return (*this).submat(row_span, col_span); - } - - - -template -inline -subview_each1< subview, 0 > -subview::each_col() - { - arma_debug_sigprint(); - - return subview_each1< subview, 0 >(*this); - } - - - -template -inline -subview_each1< subview, 1 > -subview::each_row() - { - arma_debug_sigprint(); - - return subview_each1< subview, 1 >(*this); - } - - - -template -template -inline -subview_each2< subview, 0, T1 > -subview::each_col(const Base& indices) - { - arma_debug_sigprint(); - - return subview_each2< subview, 0, T1 >(*this, indices); - } - - - -template -template -inline -subview_each2< subview, 1, T1 > -subview::each_row(const Base& indices) - { - arma_debug_sigprint(); - - return subview_each2< subview, 1, T1 >(*this, indices); - } - - - -//! apply a lambda function to each column, where each column is interpreted as a column vector -template -inline -void -subview::each_col(const std::function< void(Col&) >& F) - { - arma_debug_sigprint(); - - for(uword ii=0; ii < n_cols; ++ii) - { - Col tmp(colptr(ii), n_rows, false, true); - F(tmp); - } - } - - - -template -inline -void -subview::each_col(const std::function< void(const Col&) >& F) const - { - arma_debug_sigprint(); - - for(uword ii=0; ii < n_cols; ++ii) - { - const Col tmp(colptr(ii), n_rows, false, true); - F(tmp); - } - } - - - -//! apply a lambda function to each row, where each row is interpreted as a row vector -template -inline -void -subview::each_row(const std::function< void(Row&) >& F) - { - arma_debug_sigprint(); - - podarray array1(n_cols); - podarray array2(n_cols); - - Row tmp1( array1.memptr(), n_cols, false, true ); - Row tmp2( array2.memptr(), n_cols, false, true ); - - eT* tmp1_mem = tmp1.memptr(); - eT* tmp2_mem = tmp2.memptr(); - - uword ii, jj; - - for(ii=0, jj=1; jj < n_rows; ii+=2, jj+=2) - { - for(uword col_id = 0; col_id < n_cols; ++col_id) - { - const eT* col_mem = colptr(col_id); - - tmp1_mem[col_id] = col_mem[ii]; - tmp2_mem[col_id] = col_mem[jj]; - } - - F(tmp1); - F(tmp2); - - for(uword col_id = 0; col_id < n_cols; ++col_id) - { - eT* col_mem = colptr(col_id); - - col_mem[ii] = tmp1_mem[col_id]; - col_mem[jj] = tmp2_mem[col_id]; - } - } - - if(ii < n_rows) - { - tmp1 = (*this).row(ii); - - F(tmp1); - - (*this).row(ii) = tmp1; - } - } - - - -template -inline -void -subview::each_row(const std::function< void(const Row&) >& F) const - { - arma_debug_sigprint(); - - podarray array1(n_cols); - podarray array2(n_cols); - - Row tmp1( array1.memptr(), n_cols, false, true ); - Row tmp2( array2.memptr(), n_cols, false, true ); - - eT* tmp1_mem = tmp1.memptr(); - eT* tmp2_mem = tmp2.memptr(); - - uword ii, jj; - - for(ii=0, jj=1; jj < n_rows; ii+=2, jj+=2) - { - for(uword col_id = 0; col_id < n_cols; ++col_id) - { - const eT* col_mem = colptr(col_id); - - tmp1_mem[col_id] = col_mem[ii]; - tmp2_mem[col_id] = col_mem[jj]; - } - - F(tmp1); - F(tmp2); - } - - if(ii < n_rows) - { - tmp1 = (*this).row(ii); - - F(tmp1); - } - } - - - -//! creation of diagview (diagonal) -template -inline -diagview -subview::diag(const sword in_id) - { - arma_debug_sigprint(); - - const uword row_offset = (in_id < 0) ? uword(-in_id) : 0; - const uword col_offset = (in_id > 0) ? uword( in_id) : 0; - - arma_conform_check_bounds - ( - ((row_offset > 0) && (row_offset >= n_rows)) || ((col_offset > 0) && (col_offset >= n_cols)), - "subview::diag(): requested diagonal out of bounds" - ); - - const uword len = (std::min)(n_rows - row_offset, n_cols - col_offset); - - const uword base_row_offset = aux_row1 + row_offset; - const uword base_col_offset = aux_col1 + col_offset; - - return diagview(m, base_row_offset, base_col_offset, len); - } - - - -//! creation of diagview (diagonal) -template -inline -const diagview -subview::diag(const sword in_id) const - { - arma_debug_sigprint(); - - const uword row_offset = uword( (in_id < 0) ? -in_id : 0 ); - const uword col_offset = uword( (in_id > 0) ? in_id : 0 ); - - arma_conform_check_bounds - ( - ((row_offset > 0) && (row_offset >= n_rows)) || ((col_offset > 0) && (col_offset >= n_cols)), - "subview::diag(): requested diagonal out of bounds" - ); - - const uword len = (std::min)(n_rows - row_offset, n_cols - col_offset); - - const uword base_row_offset = aux_row1 + row_offset; - const uword base_col_offset = aux_col1 + col_offset; - - return diagview(m, base_row_offset, base_col_offset, len); - } - - - -template -inline -void -subview::swap_rows(const uword in_row1, const uword in_row2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_row1 >= n_rows) || (in_row2 >= n_rows), - "subview::swap_rows(): out of bounds" - ); - - eT* mem = (const_cast< Mat& >(m)).memptr(); - - if(n_elem > 0) - { - const uword m_n_rows = m.n_rows; - - for(uword ucol=0; ucol < n_cols; ++ucol) - { - const uword offset = (aux_col1 + ucol) * m_n_rows; - const uword pos1 = aux_row1 + in_row1 + offset; - const uword pos2 = aux_row1 + in_row2 + offset; - - std::swap( access::rw(mem[pos1]), access::rw(mem[pos2]) ); - } - } - } - - - -template -inline -void -subview::swap_cols(const uword in_col1, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds - ( - (in_col1 >= n_cols) || (in_col2 >= n_cols), - "subview::swap_cols(): out of bounds" - ); - - if(n_elem > 0) - { - eT* ptr1 = colptr(in_col1); - eT* ptr2 = colptr(in_col2); - - for(uword urow=0; urow < n_rows; ++urow) - { - std::swap( ptr1[urow], ptr2[urow] ); - } - } - } - - - -template -inline -typename subview::iterator -subview::begin() - { - return iterator(*this, aux_row1, aux_col1); - } - - - -template -inline -typename subview::const_iterator -subview::begin() const - { - return const_iterator(*this, aux_row1, aux_col1); - } - - - -template -inline -typename subview::const_iterator -subview::cbegin() const - { - return const_iterator(*this, aux_row1, aux_col1); - } - - - -template -inline -typename subview::iterator -subview::end() - { - return iterator(*this, aux_row1, aux_col1 + n_cols); - } - - - -template -inline -typename subview::const_iterator -subview::end() const - { - return const_iterator(*this, aux_row1, aux_col1 + n_cols); - } - - - -template -inline -typename subview::const_iterator -subview::cend() const - { - return const_iterator(*this, aux_row1, aux_col1 + n_cols); - } - - - -// -// -// - - - -template -inline -subview::iterator::iterator() - : M (nullptr) - , current_ptr(nullptr) - , current_row(0 ) - , current_col(0 ) - , aux_row1 (0 ) - , aux_row2_p1(0 ) - { - arma_debug_sigprint(); - // Technically this iterator is invalid (it does not point to a valid element) - } - - - -template -inline -subview::iterator::iterator(const iterator& X) - : M (X.M ) - , current_ptr(X.current_ptr) - , current_row(X.current_row) - , current_col(X.current_col) - , aux_row1 (X.aux_row1 ) - , aux_row2_p1(X.aux_row2_p1) - { - arma_debug_sigprint(); - } - - - -template -inline -subview::iterator::iterator(subview& in_sv, const uword in_row, const uword in_col) - : M (&(const_cast< Mat& >(in_sv.m))) - , current_ptr(&(M->at(in_row,in_col)) ) - , current_row(in_row ) - , current_col(in_col ) - , aux_row1 (in_sv.aux_row1 ) - , aux_row2_p1(in_sv.aux_row1 + in_sv.n_rows ) - { - arma_debug_sigprint(); - } - - - -template -inline -eT& -subview::iterator::operator*() - { - return (*current_ptr); - } - - - -template -inline -typename subview::iterator& -subview::iterator::operator++() - { - current_row++; - - if(current_row == aux_row2_p1) - { - current_row = aux_row1; - current_col++; - - current_ptr = &( (*M).at(current_row,current_col) ); - } - else - { - current_ptr++; - } - - return *this; - } - - - -template -inline -typename subview::iterator -subview::iterator::operator++(int) - { - typename subview::iterator temp(*this); - - ++(*this); - - return temp; - } - - - -template -inline -bool -subview::iterator::operator==(const iterator& rhs) const - { - return (current_ptr == rhs.current_ptr); - } - - - -template -inline -bool -subview::iterator::operator!=(const iterator& rhs) const - { - return (current_ptr != rhs.current_ptr); - } - - - -template -inline -bool -subview::iterator::operator==(const const_iterator& rhs) const - { - return (current_ptr == rhs.current_ptr); - } - - - -template -inline -bool -subview::iterator::operator!=(const const_iterator& rhs) const - { - return (current_ptr != rhs.current_ptr); - } - - - -// -// -// - - - -template -inline -subview::const_iterator::const_iterator() - : M (nullptr) - , current_ptr(nullptr) - , current_row(0 ) - , current_col(0 ) - , aux_row1 (0 ) - , aux_row2_p1(0 ) - { - arma_debug_sigprint(); - // Technically this iterator is invalid (it does not point to a valid element) - } - - - -template -inline -subview::const_iterator::const_iterator(const iterator& X) - : M (X.M ) - , current_ptr(X.current_ptr) - , current_row(X.current_row) - , current_col(X.current_col) - , aux_row1 (X.aux_row1 ) - , aux_row2_p1(X.aux_row2_p1) - { - arma_debug_sigprint(); - } - - - -template -inline -subview::const_iterator::const_iterator(const const_iterator& X) - : M (X.M ) - , current_ptr(X.current_ptr) - , current_row(X.current_row) - , current_col(X.current_col) - , aux_row1 (X.aux_row1 ) - , aux_row2_p1(X.aux_row2_p1) - { - arma_debug_sigprint(); - } - - - -template -inline -subview::const_iterator::const_iterator(const subview& in_sv, const uword in_row, const uword in_col) - : M (&(in_sv.m) ) - , current_ptr(&(M->at(in_row,in_col)) ) - , current_row(in_row ) - , current_col(in_col ) - , aux_row1 (in_sv.aux_row1 ) - , aux_row2_p1(in_sv.aux_row1 + in_sv.n_rows) - { - arma_debug_sigprint(); - } - - - -template -inline -const eT& -subview::const_iterator::operator*() - { - return (*current_ptr); - } - - - -template -inline -typename subview::const_iterator& -subview::const_iterator::operator++() - { - current_row++; - - if(current_row == aux_row2_p1) - { - current_row = aux_row1; - current_col++; - - current_ptr = &( (*M).at(current_row,current_col) ); - } - else - { - current_ptr++; - } - - return *this; - } - - - -template -inline -typename subview::const_iterator -subview::const_iterator::operator++(int) - { - typename subview::const_iterator temp(*this); - - ++(*this); - - return temp; - } - - - -template -inline -bool -subview::const_iterator::operator==(const iterator& rhs) const - { - return (current_ptr == rhs.current_ptr); - } - - - -template -inline -bool -subview::const_iterator::operator!=(const iterator& rhs) const - { - return (current_ptr != rhs.current_ptr); - } - - - -template -inline -bool -subview::const_iterator::operator==(const const_iterator& rhs) const - { - return (current_ptr == rhs.current_ptr); - } - - - -template -inline -bool -subview::const_iterator::operator!=(const const_iterator& rhs) const - { - return (current_ptr != rhs.current_ptr); - } - - - -// -// -// - - - -template -inline -subview::row_iterator::row_iterator() - : M (nullptr) - , current_row(0 ) - , current_col(0 ) - , aux_col1 (0 ) - , aux_col2_p1(0 ) - { - arma_debug_sigprint(); - // Technically this iterator is invalid (it does not point to a valid element) - } - - - -template -inline -subview::row_iterator::row_iterator(const row_iterator& X) - : M (X.M ) - , current_row(X.current_row) - , current_col(X.current_col) - , aux_col1 (X.aux_col1 ) - , aux_col2_p1(X.aux_col2_p1) - { - arma_debug_sigprint(); - } - - - -template -inline -subview::row_iterator::row_iterator(subview& in_sv, const uword in_row, const uword in_col) - : M (&(const_cast< Mat& >(in_sv.m))) - , current_row(in_row ) - , current_col(in_col ) - , aux_col1 (in_sv.aux_col1 ) - , aux_col2_p1(in_sv.aux_col1 + in_sv.n_cols ) - { - arma_debug_sigprint(); - } - - - -template -inline -eT& -subview::row_iterator::operator*() - { - return M->at(current_row,current_col); - } - - - -template -inline -typename subview::row_iterator& -subview::row_iterator::operator++() - { - current_col++; - - if(current_col == aux_col2_p1) - { - current_col = aux_col1; - current_row++; - } - - return *this; - } - - - -template -inline -typename subview::row_iterator -subview::row_iterator::operator++(int) - { - typename subview::row_iterator temp(*this); - - ++(*this); - - return temp; - } - - - -template -inline -bool -subview::row_iterator::operator==(const row_iterator& rhs) const - { - return ( (current_row == rhs.current_row) && (current_col == rhs.current_col) ); - } - - - -template -inline -bool -subview::row_iterator::operator!=(const row_iterator& rhs) const - { - return ( (current_row != rhs.current_row) || (current_col != rhs.current_col) ); - } - - - -template -inline -bool -subview::row_iterator::operator==(const const_row_iterator& rhs) const - { - return ( (current_row == rhs.current_row) && (current_col == rhs.current_col) ); - } - - - -template -inline -bool -subview::row_iterator::operator!=(const const_row_iterator& rhs) const - { - return ( (current_row != rhs.current_row) || (current_col != rhs.current_col) ); - } - - - -// -// -// - - - -template -inline -subview::const_row_iterator::const_row_iterator() - : M (nullptr) - , current_row(0 ) - , current_col(0 ) - , aux_col1 (0 ) - , aux_col2_p1(0 ) - { - arma_debug_sigprint(); - // Technically this iterator is invalid (it does not point to a valid element) - } - - - -template -inline -subview::const_row_iterator::const_row_iterator(const row_iterator& X) - : M (X.M ) - , current_row(X.current_row) - , current_col(X.current_col) - , aux_col1 (X.aux_col1 ) - , aux_col2_p1(X.aux_col2_p1) - { - arma_debug_sigprint(); - } - - - -template -inline -subview::const_row_iterator::const_row_iterator(const const_row_iterator& X) - : M (X.M ) - , current_row(X.current_row) - , current_col(X.current_col) - , aux_col1 (X.aux_col1 ) - , aux_col2_p1(X.aux_col2_p1) - { - arma_debug_sigprint(); - } - - - -template -inline -subview::const_row_iterator::const_row_iterator(const subview& in_sv, const uword in_row, const uword in_col) - : M (&(in_sv.m) ) - , current_row(in_row ) - , current_col(in_col ) - , aux_col1 (in_sv.aux_col1 ) - , aux_col2_p1(in_sv.aux_col1 + in_sv.n_cols) - { - arma_debug_sigprint(); - } - - - -template -inline -const eT& -subview::const_row_iterator::operator*() const - { - return M->at(current_row,current_col); - } - - - -template -inline -typename subview::const_row_iterator& -subview::const_row_iterator::operator++() - { - current_col++; - - if(current_col == aux_col2_p1) - { - current_col = aux_col1; - current_row++; - } - - return *this; - } - - - -template -inline -typename subview::const_row_iterator -subview::const_row_iterator::operator++(int) - { - typename subview::const_row_iterator temp(*this); - - ++(*this); - - return temp; - } - - - -template -inline -bool -subview::const_row_iterator::operator==(const row_iterator& rhs) const - { - return ( (current_row == rhs.current_row) && (current_col == rhs.current_col) ); - } - - - -template -inline -bool -subview::const_row_iterator::operator!=(const row_iterator& rhs) const - { - return ( (current_row != rhs.current_row) || (current_col != rhs.current_col) ); - } - - - -template -inline -bool -subview::const_row_iterator::operator==(const const_row_iterator& rhs) const - { - return ( (current_row == rhs.current_row) && (current_col == rhs.current_col) ); - } - - - -template -inline -bool -subview::const_row_iterator::operator!=(const const_row_iterator& rhs) const - { - return ( (current_row != rhs.current_row) || (current_col != rhs.current_col) ); - } - - - -// -// -// - - - -template -inline -subview_col::subview_col(const Mat& in_m, const uword in_col) - : subview(in_m, 0, in_col, in_m.n_rows, 1) - , colmem(subview::colptr(0)) - { - arma_debug_sigprint(); - } - - - -template -inline -subview_col::subview_col(const Mat& in_m, const uword in_col, const uword in_row1, const uword in_n_rows) - : subview(in_m, in_row1, in_col, in_n_rows, 1) - , colmem(subview::colptr(0)) - { - arma_debug_sigprint(); - } - - - -template -inline -subview_col::subview_col(const subview_col& in) - : subview(in) // interprets 'subview_col' as 'subview' - , colmem(in.colmem) - { - arma_debug_sigprint(); - } - - - -template -inline -subview_col::subview_col(subview_col&& in) - : subview(std::move(in)) // interprets 'subview_col' as 'subview' - , colmem(in.colmem) - { - arma_debug_sigprint(); - - access::rw(in.colmem) = nullptr; - } - - - -template -inline -void -subview_col::operator=(const subview& X) - { - arma_debug_sigprint(); - - subview::operator=(X); - } - - - -template -inline -void -subview_col::operator=(const subview_col& X) - { - arma_debug_sigprint(); - - subview::operator=(X); // interprets 'subview_col' as 'subview' - } - - - -template -inline -void -subview_col::operator=(const std::initializer_list& list) - { - arma_debug_sigprint(); - - const uword N = uword(list.size()); - - arma_conform_assert_same_size(subview::n_rows, subview::n_cols, N, 1, "copy into submatrix"); - - arrayops::copy( access::rwp(colmem), list.begin(), N ); - } - - - -template -inline -void -subview_col::operator=(const eT val) - { - arma_debug_sigprint(); - - if(subview::n_elem != 1) - { - arma_conform_assert_same_size(subview::n_rows, subview::n_cols, 1, 1, "copy into submatrix"); - } - - access::rw( colmem[0] ) = val; - } - - - -template -template -inline -void -subview_col::operator=(const Base& expr) - { - arma_debug_sigprint(); - - if(is_Mat::value) - { - const unwrap U(expr.get_ref()); - - arma_conform_assert_same_size(subview::n_rows, uword(1), U.M.n_rows, U.M.n_cols, "copy into submatrix"); - - arrayops::copy(const_cast(colmem), U.M.memptr(), subview::n_rows); - } - else - { - subview::operator=(expr); - } - } - - - -template -template -inline -void -subview_col::operator=(const SpBase& X) - { - arma_debug_sigprint(); - - subview::operator=(X.get_ref()); - } - - - -template -template -inline -typename enable_if2< is_same_type::value, void>::result -subview_col::operator= (const Gen& in) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(subview::n_rows, uword(1), in.n_rows, (in.is_col ? uword(1) : in.n_cols), "copy into submatrix"); - - in.apply(*this); - } - - - -template -arma_inline -const Op,op_htrans> -subview_col::t() const - { - return Op,op_htrans>(*this); - } - - - -template -arma_inline -const Op,op_htrans> -subview_col::ht() const - { - return Op,op_htrans>(*this); - } - - - -template -arma_inline -const Op,op_strans> -subview_col::st() const - { - return Op,op_strans>(*this); - } - - - -template -arma_inline -const Op,op_strans> -subview_col::as_row() const - { - return Op,op_strans>(*this); - } - - - -template -inline -void -subview_col::fill(const eT val) - { - arma_debug_sigprint(); - - arrayops::inplace_set( access::rwp(colmem), val, subview::n_rows ); - } - - - -template -inline -void -subview_col::zeros() - { - arma_debug_sigprint(); - - arrayops::fill_zeros( access::rwp(colmem), subview::n_rows ); - } - - - -template -inline -void -subview_col::ones() - { - arma_debug_sigprint(); - - arrayops::inplace_set( access::rwp(colmem), eT(1), subview::n_rows ); - } - - - -template -arma_inline -eT -subview_col::at_alt(const uword ii) const - { - const eT* colmem_aligned = colmem; - memory::mark_as_aligned(colmem_aligned); - - return colmem_aligned[ii]; - } - - - -template -arma_inline -eT& -subview_col::operator[](const uword ii) - { - return access::rw( colmem[ii] ); - } - - - -template -arma_inline -eT -subview_col::operator[](const uword ii) const - { - return colmem[ii]; - } - - - -template -inline -eT& -subview_col::operator()(const uword ii) - { - arma_conform_check_bounds( (ii >= subview::n_elem), "subview::operator(): index out of bounds" ); - - return access::rw( colmem[ii] ); - } - - - -template -inline -eT -subview_col::operator()(const uword ii) const - { - arma_conform_check_bounds( (ii >= subview::n_elem), "subview::operator(): index out of bounds" ); - - return colmem[ii]; - } - - - -template -inline -eT& -subview_col::operator()(const uword in_row, const uword in_col) - { - arma_conform_check_bounds( ((in_row >= subview::n_rows) || (in_col > 0)), "subview::operator(): index out of bounds" ); - - return access::rw( colmem[in_row] ); - } - - - -template -inline -eT -subview_col::operator()(const uword in_row, const uword in_col) const - { - arma_conform_check_bounds( ((in_row >= subview::n_rows) || (in_col > 0)), "subview::operator(): index out of bounds" ); - - return colmem[in_row]; - } - - - -template -inline -eT& -subview_col::at(const uword in_row, const uword) - { - return access::rw( colmem[in_row] ); - } - - - -template -inline -eT -subview_col::at(const uword in_row, const uword) const - { - return colmem[in_row]; - } - - - -template -arma_inline -eT* -subview_col::colptr(const uword) - { - return const_cast(colmem); - } - - -template -arma_inline -const eT* -subview_col::colptr(const uword) const - { - return colmem; - } - - -template -inline -subview_col -subview_col::rows(const uword in_row1, const uword in_row2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( ( (in_row1 > in_row2) || (in_row2 >= subview::n_rows) ), "subview_col::rows(): indices out of bounds or incorrectly used" ); - - const uword subview_n_rows = in_row2 - in_row1 + 1; - - const uword base_row1 = this->aux_row1 + in_row1; - - return subview_col(this->m, this->aux_col1, base_row1, subview_n_rows); - } - - - -template -inline -const subview_col -subview_col::rows(const uword in_row1, const uword in_row2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( ( (in_row1 > in_row2) || (in_row2 >= subview::n_rows) ), "subview_col::rows(): indices out of bounds or incorrectly used" ); - - const uword subview_n_rows = in_row2 - in_row1 + 1; - - const uword base_row1 = this->aux_row1 + in_row1; - - return subview_col(this->m, this->aux_col1, base_row1, subview_n_rows); - } - - - -template -inline -subview_col -subview_col::subvec(const uword in_row1, const uword in_row2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( ( (in_row1 > in_row2) || (in_row2 >= subview::n_rows) ), "subview_col::subvec(): indices out of bounds or incorrectly used" ); - - const uword subview_n_rows = in_row2 - in_row1 + 1; - - const uword base_row1 = this->aux_row1 + in_row1; - - return subview_col(this->m, this->aux_col1, base_row1, subview_n_rows); - } - - - -template -inline -const subview_col -subview_col::subvec(const uword in_row1, const uword in_row2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( ( (in_row1 > in_row2) || (in_row2 >= subview::n_rows) ), "subview_col::subvec(): indices out of bounds or incorrectly used" ); - - const uword subview_n_rows = in_row2 - in_row1 + 1; - - const uword base_row1 = this->aux_row1 + in_row1; - - return subview_col(this->m, this->aux_col1, base_row1, subview_n_rows); - } - - - -template -inline -subview_col -subview_col::subvec(const uword start_row, const SizeMat& s) - { - arma_debug_sigprint(); - - arma_conform_check( (s.n_cols != 1), "subview_col::subvec(): given size does not specify a column vector" ); - - arma_conform_check_bounds( ( (start_row >= subview::n_rows) || ((start_row + s.n_rows) > subview::n_rows) ), "subview_col::subvec(): size out of bounds" ); - - const uword base_row1 = this->aux_row1 + start_row; - - return subview_col(this->m, this->aux_col1, base_row1, s.n_rows); - } - - - -template -inline -const subview_col -subview_col::subvec(const uword start_row, const SizeMat& s) const - { - arma_debug_sigprint(); - - arma_conform_check( (s.n_cols != 1), "subview_col::subvec(): given size does not specify a column vector" ); - - arma_conform_check_bounds( ( (start_row >= subview::n_rows) || ((start_row + s.n_rows) > subview::n_rows) ), "subview_col::subvec(): size out of bounds" ); - - const uword base_row1 = this->aux_row1 + start_row; - - return subview_col(this->m, this->aux_col1, base_row1, s.n_rows); - } - - - -template -inline -subview_col -subview_col::head(const uword N) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > subview::n_rows), "subview_col::head(): size out of bounds" ); - - return subview_col(this->m, this->aux_col1, this->aux_row1, N); - } - - - -template -inline -const subview_col -subview_col::head(const uword N) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > subview::n_rows), "subview_col::head(): size out of bounds" ); - - return subview_col(this->m, this->aux_col1, this->aux_row1, N); - } - - - -template -inline -subview_col -subview_col::tail(const uword N) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > subview::n_rows), "subview_col::tail(): size out of bounds" ); - - const uword start_row = subview::aux_row1 + subview::n_rows - N; - - return subview_col(this->m, this->aux_col1, start_row, N); - } - - - -template -inline -const subview_col -subview_col::tail(const uword N) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > subview::n_rows), "subview_col::tail(): size out of bounds" ); - - const uword start_row = subview::aux_row1 + subview::n_rows - N; - - return subview_col(this->m, this->aux_col1, start_row, N); - } - - - -template -inline -eT -subview_col::min() const - { - arma_debug_sigprint(); - - if(subview::n_elem == 0) - { - arma_conform_check(true, "min(): object has no elements"); - - return Datum::nan; - } - - return op_min::direct_min(colmem, subview::n_elem); - } - - - -template -inline -eT -subview_col::max() const - { - arma_debug_sigprint(); - - if(subview::n_elem == 0) - { - arma_conform_check(true, "max(): object has no elements"); - - return Datum::nan; - } - - return op_max::direct_max(colmem, subview::n_elem); - } - - - -template -inline -eT -subview_col::min(uword& index_of_min_val) const - { - arma_debug_sigprint(); - - if(subview::n_elem == 0) - { - arma_conform_check(true, "min(): object has no elements"); - - index_of_min_val = uword(0); - - return Datum::nan; - } - else - { - return op_min::direct_min(colmem, subview::n_elem, index_of_min_val); - } - } - - - -template -inline -eT -subview_col::max(uword& index_of_max_val) const - { - arma_debug_sigprint(); - - if(subview::n_elem == 0) - { - arma_conform_check(true, "max(): object has no elements"); - - index_of_max_val = uword(0); - - return Datum::nan; - } - else - { - return op_max::direct_max(colmem, subview::n_elem, index_of_max_val); - } - } - - - -template -inline -uword -subview_col::index_min() const - { - arma_debug_sigprint(); - - uword index = 0; - - if(subview::n_elem == 0) - { - arma_conform_check(true, "index_min(): object has no elements"); - } - else - { - op_min::direct_min(colmem, subview::n_elem, index); - } - - return index; - } - - - -template -inline -uword -subview_col::index_max() const - { - arma_debug_sigprint(); - - uword index = 0; - - if(subview::n_elem == 0) - { - arma_conform_check(true, "index_max(): object has no elements"); - } - else - { - op_max::direct_max(colmem, subview::n_elem, index); - } - - return index; - } - - - -// -// -// - - -template -inline -subview_cols::subview_cols(const Mat& in_m, const uword in_col1, const uword in_n_cols) - : subview(in_m, 0, in_col1, in_m.n_rows, in_n_cols) - { - arma_debug_sigprint(); - } - - - -template -inline -subview_cols::subview_cols(const subview_cols& in) - : subview(in) // interprets 'subview_cols' as 'subview' - { - arma_debug_sigprint(); - } - - - -template -inline -subview_cols::subview_cols(subview_cols&& in) - : subview(std::move(in)) // interprets 'subview_cols' as 'subview' - { - arma_debug_sigprint(); - } - - - -template -inline -void -subview_cols::operator=(const subview& X) - { - arma_debug_sigprint(); - - subview::operator=(X); - } - - - -template -inline -void -subview_cols::operator=(const subview_cols& X) - { - arma_debug_sigprint(); - - subview::operator=(X); // interprets 'subview_cols' as 'subview' - } - - - -template -inline -void -subview_cols::operator=(const std::initializer_list& list) - { - arma_debug_sigprint(); - - subview::operator=(list); - } - - - -template -inline -void -subview_cols::operator=(const std::initializer_list< std::initializer_list >& list) - { - arma_debug_sigprint(); - - subview::operator=(list); - } - - - -template -inline -void -subview_cols::operator=(const eT val) - { - arma_debug_sigprint(); - - subview::operator=(val); - } - - - -template -template -inline -void -subview_cols::operator=(const Base& X) - { - arma_debug_sigprint(); - - subview::operator=(X.get_ref()); - } - - - -template -template -inline -void -subview_cols::operator=(const SpBase& X) - { - arma_debug_sigprint(); - - subview::operator=(X.get_ref()); - } - - - -template -template -inline -typename enable_if2< is_same_type::value, void>::result -subview_cols::operator= (const Gen& in) - { - arma_debug_sigprint(); - - subview::operator=(in); - } - - - -template -arma_inline -const Op,op_htrans> -subview_cols::t() const - { - return Op,op_htrans>(*this); - } - - - -template -arma_inline -const Op,op_htrans> -subview_cols::ht() const - { - return Op,op_htrans>(*this); - } - - - -template -arma_inline -const Op,op_strans> -subview_cols::st() const - { - return Op,op_strans>(*this); - } - - - -template -arma_inline -const Op,op_vectorise_col> -subview_cols::as_col() const - { - return Op,op_vectorise_col>(*this); - } - - - -template -inline -eT -subview_cols::at_alt(const uword ii) const - { - return operator[](ii); - } - - - -template -inline -eT& -subview_cols::operator[](const uword ii) - { - const uword index = subview::aux_col1 * subview::m.n_rows + ii; - - return access::rw( (const_cast< Mat& >(subview::m)).mem[index] ); - } - - - -template -inline -eT -subview_cols::operator[](const uword ii) const - { - const uword index = subview::aux_col1 * subview::m.n_rows + ii; - - return subview::m.mem[index]; - } - - - -template -inline -eT& -subview_cols::operator()(const uword ii) - { - arma_conform_check_bounds( (ii >= subview::n_elem), "subview::operator(): index out of bounds" ); - - const uword index = subview::aux_col1 * subview::m.n_rows + ii; - - return access::rw( (const_cast< Mat& >(subview::m)).mem[index] ); - } - - - -template -inline -eT -subview_cols::operator()(const uword ii) const - { - arma_conform_check_bounds( (ii >= subview::n_elem), "subview::operator(): index out of bounds" ); - - const uword index = subview::aux_col1 * subview::m.n_rows + ii; - - return subview::m.mem[index]; - } - - - -template -inline -eT& -subview_cols::operator()(const uword in_row, const uword in_col) - { - arma_conform_check_bounds( ((in_row >= subview::n_rows) || (in_col >= subview::n_cols)), "subview::operator(): index out of bounds" ); - - const uword index = (in_col + subview::aux_col1) * subview::m.n_rows + in_row; - - return access::rw( (const_cast< Mat& >(subview::m)).mem[index] ); - } - - - -template -inline -eT -subview_cols::operator()(const uword in_row, const uword in_col) const - { - arma_conform_check_bounds( ((in_row >= subview::n_rows) || (in_col >= subview::n_cols)), "subview::operator(): index out of bounds" ); - - const uword index = (in_col + subview::aux_col1) * subview::m.n_rows + in_row; - - return subview::m.mem[index]; - } - - - -template -inline -eT& -subview_cols::at(const uword in_row, const uword in_col) - { - const uword index = (in_col + subview::aux_col1) * subview::m.n_rows + in_row; - - return access::rw( (const_cast< Mat& >(subview::m)).mem[index] ); - } - - - -template -inline -eT -subview_cols::at(const uword in_row, const uword in_col) const - { - const uword index = (in_col + subview::aux_col1) * subview::m.n_rows + in_row; - - return subview::m.mem[index]; - } - - - -template -arma_inline -eT* -subview_cols::colptr(const uword in_col) - { - return & access::rw((const_cast< Mat& >(subview::m)).mem[ (in_col + subview::aux_col1) * subview::m.n_rows ]); - } - - - -template -arma_inline -const eT* -subview_cols::colptr(const uword in_col) const - { - return & subview::m.mem[ (in_col + subview::aux_col1) * subview::m.n_rows ]; - } - - - -// -// -// - - - -template -inline -subview_row::subview_row(const Mat& in_m, const uword in_row) - : subview(in_m, in_row, 0, 1, in_m.n_cols) - { - arma_debug_sigprint(); - } - - - -template -inline -subview_row::subview_row(const Mat& in_m, const uword in_row, const uword in_col1, const uword in_n_cols) - : subview(in_m, in_row, in_col1, 1, in_n_cols) - { - arma_debug_sigprint(); - } - - - -template -inline -subview_row::subview_row(const subview_row& in) - : subview(in) // interprets 'subview_row' as 'subview' - { - arma_debug_sigprint(); - } - - - -template -inline -subview_row::subview_row(subview_row&& in) - : subview(std::move(in)) // interprets 'subview_row' as 'subview' - { - arma_debug_sigprint(); - } - - - -template -inline -void -subview_row::operator=(const subview& X) - { - arma_debug_sigprint(); - - subview::operator=(X); - } - - - -template -inline -void -subview_row::operator=(const subview_row& X) - { - arma_debug_sigprint(); - - subview::operator=(X); // interprets 'subview_row' as 'subview' - } - - - -template -inline -void -subview_row::operator=(const eT val) - { - arma_debug_sigprint(); - - subview::operator=(val); // interprets 'subview_row' as 'subview' - } - - - -template -inline -void -subview_row::operator=(const std::initializer_list& list) - { - arma_debug_sigprint(); - - const uword N = uword(list.size()); - - arma_conform_assert_same_size(subview::n_rows, subview::n_cols, 1, N, "copy into submatrix"); - - auto it = list.begin(); - - for(uword ii=0; ii < N; ++ii) - { - (*this).operator[](ii) = (*it); - ++it; - } - } - - - -template -template -inline -void -subview_row::operator=(const Base& X) - { - arma_debug_sigprint(); - - subview::operator=(X); - } - - - -template -template -inline -void -subview_row::operator=(const SpBase& X) - { - arma_debug_sigprint(); - - subview::operator=(X.get_ref()); - } - - - -template -template -inline -typename enable_if2< is_same_type::value, void>::result -subview_row::operator= (const Gen& in) - { - arma_debug_sigprint(); - - arma_conform_assert_same_size(uword(1), subview::n_cols, (in.is_row ? uword(1) : in.n_rows), in.n_cols, "copy into submatrix"); - - in.apply(*this); - } - - - -template -arma_inline -const Op,op_htrans> -subview_row::t() const - { - return Op,op_htrans>(*this); - } - - - -template -arma_inline -const Op,op_htrans> -subview_row::ht() const - { - return Op,op_htrans>(*this); - } - - - -template -arma_inline -const Op,op_strans> -subview_row::st() const - { - return Op,op_strans>(*this); - } - - - -template -arma_inline -const Op,op_strans> -subview_row::as_col() const - { - return Op,op_strans>(*this); - } - - - -template -inline -eT -subview_row::at_alt(const uword ii) const - { - const uword index = (ii + (subview::aux_col1))*(subview::m).n_rows + (subview::aux_row1); - - return subview::m.mem[index]; - } - - - -template -inline -eT& -subview_row::operator[](const uword ii) - { - const uword index = (ii + (subview::aux_col1))*(subview::m).n_rows + (subview::aux_row1); - - return access::rw( (const_cast< Mat& >(subview::m)).mem[index] ); - } - - - -template -inline -eT -subview_row::operator[](const uword ii) const - { - const uword index = (ii + (subview::aux_col1))*(subview::m).n_rows + (subview::aux_row1); - - return subview::m.mem[index]; - } - - - -template -inline -eT& -subview_row::operator()(const uword ii) - { - arma_conform_check_bounds( (ii >= subview::n_elem), "subview::operator(): index out of bounds" ); - - const uword index = (ii + (subview::aux_col1))*(subview::m).n_rows + (subview::aux_row1); - - return access::rw( (const_cast< Mat& >(subview::m)).mem[index] ); - } - - - -template -inline -eT -subview_row::operator()(const uword ii) const - { - arma_conform_check_bounds( (ii >= subview::n_elem), "subview::operator(): index out of bounds" ); - - const uword index = (ii + (subview::aux_col1))*(subview::m).n_rows + (subview::aux_row1); - - return subview::m.mem[index]; - } - - - -template -inline -eT& -subview_row::operator()(const uword in_row, const uword in_col) - { - arma_conform_check_bounds( ((in_row > 0) || (in_col >= subview::n_cols)), "subview::operator(): index out of bounds" ); - - const uword index = (in_col + (subview::aux_col1))*(subview::m).n_rows + (subview::aux_row1); - - return access::rw( (const_cast< Mat& >(subview::m)).mem[index] ); - } - - - -template -inline -eT -subview_row::operator()(const uword in_row, const uword in_col) const - { - arma_conform_check_bounds( ((in_row > 0) || (in_col >= subview::n_cols)), "subview::operator(): index out of bounds" ); - - const uword index = (in_col + (subview::aux_col1))*(subview::m).n_rows + (subview::aux_row1); - - return subview::m.mem[index]; - } - - - -template -inline -eT& -subview_row::at(const uword, const uword in_col) - { - const uword index = (in_col + (subview::aux_col1))*(subview::m).n_rows + (subview::aux_row1); - - return access::rw( (const_cast< Mat& >(subview::m)).mem[index] ); - } - - - -template -inline -eT -subview_row::at(const uword, const uword in_col) const - { - const uword index = (in_col + (subview::aux_col1))*(subview::m).n_rows + (subview::aux_row1); - - return subview::m.mem[index]; - } - - - -template -inline -subview_row -subview_row::cols(const uword in_col1, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( ( (in_col1 > in_col2) || (in_col2 >= subview::n_cols) ), "subview_row::cols(): indices out of bounds or incorrectly used" ); - - const uword subview_n_cols = in_col2 - in_col1 + 1; - - const uword base_col1 = this->aux_col1 + in_col1; - - return subview_row(this->m, this->aux_row1, base_col1, subview_n_cols); - } - - - -template -inline -const subview_row -subview_row::cols(const uword in_col1, const uword in_col2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( ( (in_col1 > in_col2) || (in_col2 >= subview::n_cols) ), "subview_row::cols(): indices out of bounds or incorrectly used" ); - - const uword subview_n_cols = in_col2 - in_col1 + 1; - - const uword base_col1 = this->aux_col1 + in_col1; - - return subview_row(this->m, this->aux_row1, base_col1, subview_n_cols); - } - - - -template -inline -subview_row -subview_row::subvec(const uword in_col1, const uword in_col2) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( ( (in_col1 > in_col2) || (in_col2 >= subview::n_cols) ), "subview_row::subvec(): indices out of bounds or incorrectly used" ); - - const uword subview_n_cols = in_col2 - in_col1 + 1; - - const uword base_col1 = this->aux_col1 + in_col1; - - return subview_row(this->m, this->aux_row1, base_col1, subview_n_cols); - } - - - -template -inline -const subview_row -subview_row::subvec(const uword in_col1, const uword in_col2) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( ( (in_col1 > in_col2) || (in_col2 >= subview::n_cols) ), "subview_row::subvec(): indices out of bounds or incorrectly used" ); - - const uword subview_n_cols = in_col2 - in_col1 + 1; - - const uword base_col1 = this->aux_col1 + in_col1; - - return subview_row(this->m, this->aux_row1, base_col1, subview_n_cols); - } - - - -template -inline -subview_row -subview_row::subvec(const uword start_col, const SizeMat& s) - { - arma_debug_sigprint(); - - arma_conform_check( (s.n_rows != 1), "subview_row::subvec(): given size does not specify a row vector" ); - - arma_conform_check_bounds( ( (start_col >= subview::n_cols) || ((start_col + s.n_cols) > subview::n_cols) ), "subview_row::subvec(): size out of bounds" ); - - const uword base_col1 = this->aux_col1 + start_col; - - return subview_row(this->m, this->aux_row1, base_col1, s.n_cols); - } - - - -template -inline -const subview_row -subview_row::subvec(const uword start_col, const SizeMat& s) const - { - arma_debug_sigprint(); - - arma_conform_check( (s.n_rows != 1), "subview_row::subvec(): given size does not specify a row vector" ); - - arma_conform_check_bounds( ( (start_col >= subview::n_cols) || ((start_col + s.n_cols) > subview::n_cols) ), "subview_row::subvec(): size out of bounds" ); - - const uword base_col1 = this->aux_col1 + start_col; - - return subview_row(this->m, this->aux_row1, base_col1, s.n_cols); - } - - - -template -inline -subview_row -subview_row::head(const uword N) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > subview::n_cols), "subview_row::head(): size out of bounds" ); - - return subview_row(this->m, this->aux_row1, this->aux_col1, N); - } - - - -template -inline -const subview_row -subview_row::head(const uword N) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > subview::n_cols), "subview_row::head(): size out of bounds" ); - - return subview_row(this->m, this->aux_row1, this->aux_col1, N); - } - - - -template -inline -subview_row -subview_row::tail(const uword N) - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > subview::n_cols), "subview_row::tail(): size out of bounds" ); - - const uword start_col = subview::aux_col1 + subview::n_cols - N; - - return subview_row(this->m, this->aux_row1, start_col, N); - } - - - -template -inline -const subview_row -subview_row::tail(const uword N) const - { - arma_debug_sigprint(); - - arma_conform_check_bounds( (N > subview::n_cols), "subview_row::tail(): size out of bounds" ); - - const uword start_col = subview::aux_col1 + subview::n_cols - N; - - return subview_row(this->m, this->aux_row1, start_col, N); - } - - - -template -inline -uword -subview_row::index_min() const - { - const Proxy< subview_row > P(*this); - - uword index = 0; - - if(P.get_n_elem() == 0) - { - arma_conform_check(true, "index_min(): object has no elements"); - } - else - { - op_min::min_with_index(P, index); - } - - return index; - } - - - -template -inline -uword -subview_row::index_max() const - { - const Proxy< subview_row > P(*this); - - uword index = 0; - - if(P.get_n_elem() == 0) - { - arma_conform_check(true, "index_max(): object has no elements"); - } - else - { - op_max::max_with_index(P, index); - } - - return index; - } - - - -template -inline -typename subview::row_iterator -subview_row::begin() - { - return typename subview::row_iterator(*this, subview::aux_row1, subview::aux_col1); - } - - - -template -inline -typename subview::const_row_iterator -subview_row::begin() const - { - return typename subview::const_row_iterator(*this, subview::aux_row1, subview::aux_col1); - } - - - -template -inline -typename subview::const_row_iterator -subview_row::cbegin() const - { - return typename subview::const_row_iterator(*this, subview::aux_row1, subview::aux_col1); - } - - - -template -inline -typename subview::row_iterator -subview_row::end() - { - return typename subview::row_iterator(*this, subview::aux_row1 + subview::n_rows, subview::aux_col1); - } - - - -template -inline -typename subview::const_row_iterator -subview_row::end() const - { - return typename subview::const_row_iterator(*this, subview::aux_row1 + subview::n_rows, subview::aux_col1); - } - - - -template -inline -typename subview::const_row_iterator -subview_row::cend() const - { - return typename subview::const_row_iterator(*this, subview::aux_row1 + subview::n_rows, subview::aux_col1); - } - - - -// -// -// - - - -template -inline -subview_row_strans::subview_row_strans(const subview_row& in_sv_row) - : sv_row(in_sv_row ) - , n_rows(in_sv_row.n_cols) - , n_elem(in_sv_row.n_elem) - { - arma_debug_sigprint(); - } - - - -template -inline -void -subview_row_strans::extract(Mat& out) const - { - arma_debug_sigprint(); - - // NOTE: this function assumes that matrix 'out' has already been set to the correct size - - const Mat& X = sv_row.m; - - eT* out_mem = out.memptr(); - - const uword row = sv_row.aux_row1; - const uword start_col = sv_row.aux_col1; - const uword sv_row_n_cols = sv_row.n_cols; - - uword ii,jj; - - for(ii=0, jj=1; jj < sv_row_n_cols; ii+=2, jj+=2) - { - const eT tmp1 = X.at(row, start_col+ii); - const eT tmp2 = X.at(row, start_col+jj); - - out_mem[ii] = tmp1; - out_mem[jj] = tmp2; - } - - if(ii < sv_row_n_cols) - { - out_mem[ii] = X.at(row, start_col+ii); - } - } - - - -template -inline -eT -subview_row_strans::at_alt(const uword ii) const - { - return sv_row[ii]; - } - - - -template -inline -eT -subview_row_strans::operator[](const uword ii) const - { - return sv_row[ii]; - } - - - -template -inline -eT -subview_row_strans::operator()(const uword ii) const - { - return sv_row(ii); - } - - - -template -inline -eT -subview_row_strans::operator()(const uword in_row, const uword in_col) const - { - return sv_row(in_col, in_row); // deliberately swapped - } - - - -template -inline -eT -subview_row_strans::at(const uword in_row, const uword) const - { - return sv_row.at(0, in_row); // deliberately swapped - } - - - -// -// -// - - - -template -inline -subview_row_htrans::subview_row_htrans(const subview_row& in_sv_row) - : sv_row(in_sv_row ) - , n_rows(in_sv_row.n_cols) - , n_elem(in_sv_row.n_elem) - { - arma_debug_sigprint(); - } - - - -template -inline -void -subview_row_htrans::extract(Mat& out) const - { - arma_debug_sigprint(); - - // NOTE: this function assumes that matrix 'out' has already been set to the correct size - - const Mat& X = sv_row.m; - - eT* out_mem = out.memptr(); - - const uword row = sv_row.aux_row1; - const uword start_col = sv_row.aux_col1; - const uword sv_row_n_cols = sv_row.n_cols; - - for(uword ii=0; ii < sv_row_n_cols; ++ii) - { - out_mem[ii] = access::alt_conj( X.at(row, start_col+ii) ); - } - } - - - -template -inline -eT -subview_row_htrans::at_alt(const uword ii) const - { - return access::alt_conj( sv_row[ii] ); - } - - - -template -inline -eT -subview_row_htrans::operator[](const uword ii) const - { - return access::alt_conj( sv_row[ii] ); - } - - - -template -inline -eT -subview_row_htrans::operator()(const uword ii) const - { - return access::alt_conj( sv_row(ii) ); - } - - - -template -inline -eT -subview_row_htrans::operator()(const uword in_row, const uword in_col) const - { - return access::alt_conj( sv_row(in_col, in_row) ); // deliberately swapped - } - - - -template -inline -eT -subview_row_htrans::at(const uword in_row, const uword) const - { - return access::alt_conj( sv_row.at(0, in_row) ); // deliberately swapped - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/sym_helper.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/sym_helper.hpp deleted file mode 100644 index fab7d5532..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/sym_helper.hpp +++ /dev/null @@ -1,485 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup sym_helper -//! @{ - - -namespace sym_helper -{ - -// computationally inexpensive algorithm to guess whether a matrix is positive definite: -// (1) ensure the matrix is symmetric/hermitian (within a tolerance) -// (2) ensure the diagonal entries are real and greater than zero -// (3) ensure that the value with largest modulus is on the main diagonal -// (4) ensure rudimentary diagonal dominance: (real(A_ii) + real(A_jj)) > 2*abs(real(A_ij)) -// the above conditions are necessary, but not sufficient; -// doing it properly would be too computationally expensive for our purposes -// more info: -// http://mathworld.wolfram.com/PositiveDefiniteMatrix.html -// http://mathworld.wolfram.com/DiagonallyDominantMatrix.html - -template -inline -typename enable_if2::no, bool>::result -guess_sympd_worker(const Mat& A) - { - arma_debug_sigprint(); - - // NOTE: assuming A is square-sized - - const eT tol = eT(100) * std::numeric_limits::epsilon(); // allow some leeway - - const uword N = A.n_rows; - - const eT* A_mem = A.memptr(); - const eT* A_col = A_mem; - - eT max_diag = eT(0); - - for(uword j=0; j < N; ++j) - { - const eT A_jj = A_col[j]; - - if(A_jj <= eT(0)) { return false; } - - max_diag = (A_jj > max_diag) ? A_jj : max_diag; - - A_col += N; - } - - A_col = A_mem; - - const uword Nm1 = N-1; - const uword Np1 = N+1; - - for(uword j=0; j < Nm1; ++j) - { - const eT A_jj = A_col[j]; - - const uword jp1 = j+1; - const eT* A_ji_ptr = &(A_mem[j + jp1*N]); // &(A.at(j,jp1)); - const eT* A_ii_ptr = &(A_mem[jp1 + jp1*N]); - - for(uword i=jp1; i < N; ++i) - { - const eT A_ij = A_col[i]; - const eT A_ji = (*A_ji_ptr); - - const eT A_ij_abs = (std::abs)(A_ij); - const eT A_ji_abs = (std::abs)(A_ji); - - // if( (A_ij_abs >= max_diag) || (A_ji_abs >= max_diag) ) { return false; } - if(A_ij_abs >= max_diag) { return false; } - - const eT A_delta = (std::abs)(A_ij - A_ji); - const eT A_abs_max = (std::max)(A_ij_abs, A_ji_abs); - - if( (A_delta > tol) && (A_delta > (A_abs_max*tol)) ) { return false; } - - const eT A_ii = (*A_ii_ptr); - - if( (A_ij_abs + A_ij_abs) >= (A_ii + A_jj) ) { return false; } - - A_ji_ptr += N; - A_ii_ptr += Np1; - } - - A_col += N; - } - - return true; - } - - - -template -inline -typename enable_if2::yes, bool>::result -guess_sympd_worker(const Mat& A) - { - arma_debug_sigprint(); - - // NOTE: assuming A is square-sized - - typedef typename get_pod_type::result T; - - const T tol = T(100) * std::numeric_limits::epsilon(); // allow some leeway - - const uword N = A.n_rows; - - const eT* A_mem = A.memptr(); - const eT* A_col = A_mem; - - T max_diag = T(0); - - for(uword j=0; j < N; ++j) - { - const eT& A_jj = A_col[j]; - const T A_jj_real = std::real(A_jj); - const T A_jj_imag = std::imag(A_jj); - - if( (A_jj_real <= T(0)) || (std::abs(A_jj_imag) > tol) ) { return false; } - - max_diag = (A_jj_real > max_diag) ? A_jj_real : max_diag; - - A_col += N; - } - - const T square_max_diag = max_diag * max_diag; - - if(arma_isfinite(square_max_diag) == false) { return false; } - - A_col = A_mem; - - const uword Nm1 = N-1; - const uword Np1 = N+1; - - for(uword j=0; j < Nm1; ++j) - { - const uword jp1 = j+1; - const eT* A_ji_ptr = &(A_mem[j + jp1*N]); // &(A.at(j,jp1)); - const eT* A_ii_ptr = &(A_mem[jp1 + jp1*N]); - - const T A_jj_real = std::real(A_col[j]); - - for(uword i=jp1; i < N; ++i) - { - const eT& A_ij = A_col[i]; - const T A_ij_real = std::real(A_ij); - const T A_ij_imag = std::imag(A_ij); - - // avoid using std::abs(), as that is time consuming due to division and std::sqrt() - const T square_A_ij_abs = (A_ij_real * A_ij_real) + (A_ij_imag * A_ij_imag); - - if(arma_isfinite(square_A_ij_abs) == false) { return false; } - - if(square_A_ij_abs >= square_max_diag) { return false; } - - const T A_ij_real_abs = (std::abs)(A_ij_real); - const T A_ij_imag_abs = (std::abs)(A_ij_imag); - - - const eT& A_ji = (*A_ji_ptr); - const T A_ji_real = std::real(A_ji); - const T A_ji_imag = std::imag(A_ji); - - const T A_ji_real_abs = (std::abs)(A_ji_real); - const T A_ji_imag_abs = (std::abs)(A_ji_imag); - - const T A_real_delta = (std::abs)(A_ij_real - A_ji_real); - const T A_real_abs_max = (std::max)(A_ij_real_abs, A_ji_real_abs); - - if( (A_real_delta > tol) && (A_real_delta > (A_real_abs_max*tol)) ) { return false; } - - - const T A_imag_delta = (std::abs)(A_ij_imag + A_ji_imag); // take into account complex conjugate - const T A_imag_abs_max = (std::max)(A_ij_imag_abs, A_ji_imag_abs); - - if( (A_imag_delta > tol) && (A_imag_delta > (A_imag_abs_max*tol)) ) { return false; } - - - const T A_ii_real = std::real(*A_ii_ptr); - - if( (A_ij_real_abs + A_ij_real_abs) >= (A_ii_real + A_jj_real) ) { return false; } - - A_ji_ptr += N; - A_ii_ptr += Np1; - } - - A_col += N; - } - - return true; - } - - - -template -inline -bool -guess_sympd(const Mat& A) - { - arma_debug_sigprint(); - - // analyse matrices with size >= 4x4 - - if((A.n_rows != A.n_cols) || (A.n_rows < uword(4))) { return false; } - - return guess_sympd_worker(A); - } - - - -template -inline -bool -guess_sympd(const Mat& A, const uword min_n_rows) - { - arma_debug_sigprint(); - - if((A.n_rows != A.n_cols) || (A.n_rows < min_n_rows)) { return false; } - - return guess_sympd_worker(A); - } - - - -// - - - -template -inline -typename enable_if2::no, void>::result -analyse_matrix_worker(bool& is_approx_sym, bool& is_approx_sympd, const Mat& A) - { - arma_debug_sigprint(); - - is_approx_sym = true; - is_approx_sympd = true; - - const eT tol = eT(100) * std::numeric_limits::epsilon(); // allow some leeway - - const uword N = A.n_rows; - - const eT* A_mem = A.memptr(); - const eT* A_col = A_mem; - - eT max_diag = eT(0); - - for(uword j=0; j < N; ++j) - { - const eT A_jj = A_col[j]; - - if(A_jj <= eT(0)) { is_approx_sympd = false; } - - max_diag = (A_jj > max_diag) ? A_jj : max_diag; - - A_col += N; - } - - A_col = A_mem; - - const uword Nm1 = N-1; - const uword Np1 = N+1; - - for(uword j=0; j < Nm1; ++j) - { - const eT A_jj = A_col[j]; - - const uword jp1 = j+1; - const eT* A_ji_ptr = &(A_mem[j + jp1*N]); // &(A.at(j,jp1)); - const eT* A_ii_ptr = &(A_mem[jp1 + jp1*N]); - - for(uword i=jp1; i < N; ++i) - { - const eT A_ij = A_col[i]; - const eT A_ji = (*A_ji_ptr); - - const eT A_ij_abs = (std::abs)(A_ij); - const eT A_ji_abs = (std::abs)(A_ji); - - const eT A_delta = (std::abs)(A_ij - A_ji); - const eT A_abs_max = (std::max)(A_ij_abs, A_ji_abs); - - if( (A_delta > tol) && (A_delta > (A_abs_max*tol)) ) { is_approx_sym = false; return; } - - if(is_approx_sympd) - { - // if( (A_ij_abs >= max_diag) || (A_ji_abs >= max_diag) ) { is_approx_sympd = false; } - if(A_ij_abs >= max_diag) { is_approx_sympd = false; } - - const eT A_ii = (*A_ii_ptr); - - if( (A_ij_abs + A_ij_abs) >= (A_ii + A_jj) ) { is_approx_sympd = false; } - } - - A_ji_ptr += N; - A_ii_ptr += Np1; - } - - A_col += N; - } - } - - - -template -inline -typename enable_if2::yes, void>::result -analyse_matrix_worker(bool& is_approx_sym, bool& is_approx_sympd, const Mat& A) - { - arma_debug_sigprint(); - - typedef typename get_pod_type::result T; - - is_approx_sym = true; - is_approx_sympd = true; - - const T tol = T(100) * std::numeric_limits::epsilon(); // allow some leeway - - const uword N = A.n_rows; - - const eT* A_mem = A.memptr(); - const eT* A_col = A_mem; - - T max_diag = T(0); - - for(uword j=0; j < N; ++j) - { - const eT& A_jj = A_col[j]; - const T A_jj_real = std::real(A_jj); - const T A_jj_imag = std::imag(A_jj); - - if( (A_jj_real <= T(0)) || (std::abs(A_jj_imag) > tol) ) { is_approx_sympd = false; } - - max_diag = (A_jj_real > max_diag) ? A_jj_real : max_diag; - - A_col += N; - } - - const T square_max_diag = max_diag * max_diag; - - if(arma_isfinite(square_max_diag) == false) { is_approx_sympd = false; } - - A_col = A_mem; - - const uword Nm1 = N-1; - const uword Np1 = N+1; - - for(uword j=0; j < Nm1; ++j) - { - const uword jp1 = j+1; - const eT* A_ji_ptr = &(A_mem[j + jp1*N]); // &(A.at(j,jp1)); - const eT* A_ii_ptr = &(A_mem[jp1 + jp1*N]); - - const T A_jj_real = std::real(A_col[j]); - - for(uword i=jp1; i < N; ++i) - { - const eT& A_ij = A_col[i]; - const T A_ij_real = std::real(A_ij); - const T A_ij_imag = std::imag(A_ij); - - const T A_ij_real_abs = (std::abs)(A_ij_real); - const T A_ij_imag_abs = (std::abs)(A_ij_imag); - - const eT& A_ji = (*A_ji_ptr); - const T A_ji_real = std::real(A_ji); - const T A_ji_imag = std::imag(A_ji); - - const T A_ji_real_abs = (std::abs)(A_ji_real); - const T A_ji_imag_abs = (std::abs)(A_ji_imag); - - const T A_real_delta = (std::abs)(A_ij_real - A_ji_real); - const T A_real_abs_max = (std::max)(A_ij_real_abs, A_ji_real_abs); - - if( (A_real_delta > tol) && (A_real_delta > (A_real_abs_max*tol)) ) { is_approx_sym = false; return; } - - const T A_imag_delta = (std::abs)(A_ij_imag + A_ji_imag); // take into account complex conjugate - const T A_imag_abs_max = (std::max)(A_ij_imag_abs, A_ji_imag_abs); - - if( (A_imag_delta > tol) && (A_imag_delta > (A_imag_abs_max*tol)) ) { is_approx_sym = false; return; } - - if(is_approx_sympd) - { - // avoid using std::abs(), as that is time consuming due to division and std::sqrt() - const T square_A_ij_abs = (A_ij_real * A_ij_real) + (A_ij_imag * A_ij_imag); - - if(arma_isfinite(square_A_ij_abs) == false) - { - is_approx_sympd = false; - } - else - { - const T A_ii_real = std::real(*A_ii_ptr); - - if( (A_ij_real_abs + A_ij_real_abs) >= (A_ii_real + A_jj_real) ) { is_approx_sympd = false; } - - if(square_A_ij_abs >= square_max_diag) { is_approx_sympd = false; } - } - } - - A_ji_ptr += N; - A_ii_ptr += Np1; - } - - A_col += N; - } - } - - - -template -inline -void -analyse_matrix(bool& is_approx_sym, bool& is_approx_sympd, const Mat& A) - { - arma_debug_sigprint(); - - if((A.n_rows != A.n_cols) || (A.n_rows < uword(4))) - { - is_approx_sym = false; - is_approx_sympd = false; - return; - } - - analyse_matrix_worker(is_approx_sym, is_approx_sympd, A); - - if(is_approx_sym == false) { is_approx_sympd = false; } - } - - - -template -inline -bool -check_diag_imag(const Mat& A) - { - arma_debug_sigprint(); - - // NOTE: assuming matrix A is square-sized - - typedef typename get_pod_type::result T; - - const T tol = T(10000) * std::numeric_limits::epsilon(); // allow some leeway - - const eT* colmem = A.memptr(); - - const uword N = A.n_rows; - - for(uword i=0; i tol) { return false; } - - colmem += N; - } - - return true; - } - - - -} // end of namespace sym_helper - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/traits.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/traits.hpp deleted file mode 100644 index 5318ef9fa..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/traits.hpp +++ /dev/null @@ -1,1347 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup traits -//! @{ - - -template -struct get_pod_type - { typedef T1 result; }; - -template -struct get_pod_type< std::complex > - { typedef T2 result; }; - - - -template -struct is_Mat_fixed_only - { - typedef char yes[1]; - typedef char no[2]; - - template static yes& check(typename X::Mat_fixed_type*); - template static no& check(...); - - static constexpr bool value = ( sizeof(check(0)) == sizeof(yes) ); - }; - - - -template -struct is_Row_fixed_only - { - typedef char yes[1]; - typedef char no[2]; - - template static yes& check(typename X::Row_fixed_type*); - template static no& check(...); - - static constexpr bool value = ( sizeof(check(0)) == sizeof(yes) ); - }; - - - -template -struct is_Col_fixed_only - { - typedef char yes[1]; - typedef char no[2]; - - template static yes& check(typename X::Col_fixed_type*); - template static no& check(...); - - static constexpr bool value = ( sizeof(check(0)) == sizeof(yes) ); - }; - - - -template -struct is_Mat_fixed - { static constexpr bool value = ( is_Mat_fixed_only::value || is_Row_fixed_only::value || is_Col_fixed_only::value ); }; - - - -template -struct is_Mat_only - { static constexpr bool value = is_Mat_fixed_only::value; }; - -template -struct is_Mat_only< Mat > - { static constexpr bool value = true; }; - -template -struct is_Mat_only< const Mat > - { static constexpr bool value = true; }; - - - -template -struct is_Mat - { static constexpr bool value = ( is_Mat_fixed_only::value || is_Row_fixed_only::value || is_Col_fixed_only::value ); }; - -template -struct is_Mat< Mat > - { static constexpr bool value = true; }; - -template -struct is_Mat< const Mat > - { static constexpr bool value = true; }; - -template -struct is_Mat< Row > - { static constexpr bool value = true; }; - -template -struct is_Mat< const Row > - { static constexpr bool value = true; }; - -template -struct is_Mat< Col > - { static constexpr bool value = true; }; - -template -struct is_Mat< const Col > - { static constexpr bool value = true; }; - - - -template -struct is_Row - { static constexpr bool value = is_Row_fixed_only::value; }; - -template -struct is_Row< Row > - { static constexpr bool value = true; }; - -template -struct is_Row< const Row > - { static constexpr bool value = true; }; - - - -template -struct is_Col - { static constexpr bool value = is_Col_fixed_only::value; }; - -template -struct is_Col< Col > - { static constexpr bool value = true; }; - -template -struct is_Col< const Col > - { static constexpr bool value = true; }; - - - -template -struct is_diagview - { static constexpr bool value = false; }; - -template -struct is_diagview< diagview > - { static constexpr bool value = true; }; - -template -struct is_diagview< const diagview > - { static constexpr bool value = true; }; - - -template -struct is_subview - { static constexpr bool value = false; }; - -template -struct is_subview< subview > - { static constexpr bool value = true; }; - -template -struct is_subview< const subview > - { static constexpr bool value = true; }; - - -template -struct is_subview_row - { static constexpr bool value = false; }; - -template -struct is_subview_row< subview_row > - { static constexpr bool value = true; }; - -template -struct is_subview_row< const subview_row > - { static constexpr bool value = true; }; - - -template -struct is_subview_col - { static constexpr bool value = false; }; - -template -struct is_subview_col< subview_col > - { static constexpr bool value = true; }; - -template -struct is_subview_col< const subview_col > - { static constexpr bool value = true; }; - - -template -struct is_subview_cols - { static constexpr bool value = false; }; - -template -struct is_subview_cols< subview_cols > - { static constexpr bool value = true; }; - -template -struct is_subview_cols< const subview_cols > - { static constexpr bool value = true; }; - - -template -struct is_subview_elem1 - { static constexpr bool value = false; }; - -template -struct is_subview_elem1< subview_elem1 > - { static constexpr bool value = true; }; - -template -struct is_subview_elem1< const subview_elem1 > - { static constexpr bool value = true; }; - - -template -struct is_subview_elem2 - { static constexpr bool value = false; }; - -template -struct is_subview_elem2< subview_elem2 > - { static constexpr bool value = true; }; - -template -struct is_subview_elem2< const subview_elem2 > - { static constexpr bool value = true; }; - - - -// -// -// - - - -template -struct is_Cube - { static constexpr bool value = false; }; - -template -struct is_Cube< Cube > - { static constexpr bool value = true; }; - -template -struct is_Cube< const Cube > - { static constexpr bool value = true; }; - -template -struct is_subview_cube - { static constexpr bool value = false; }; - -template -struct is_subview_cube< subview_cube > - { static constexpr bool value = true; }; - -template -struct is_subview_cube< const subview_cube > - { static constexpr bool value = true; }; - -template -struct is_subview_cube_slices - { static constexpr bool value = false; }; - -template -struct is_subview_cube_slices< subview_cube_slices > - { static constexpr bool value = true; }; - -template -struct is_subview_cube_slices< const subview_cube_slices > - { static constexpr bool value = true; }; - - -// -// -// - - -template -struct is_Gen - { static constexpr bool value = false; }; - -template -struct is_Gen< Gen > - { static constexpr bool value = true; }; - -template -struct is_Gen< const Gen > - { static constexpr bool value = true; }; - - -template -struct is_Op - { static constexpr bool value = false; }; - -template -struct is_Op< Op > - { static constexpr bool value = true; }; - -template -struct is_Op< const Op > - { static constexpr bool value = true; }; - - -template -struct is_CubeToMatOp - { static constexpr bool value = false; }; - -template -struct is_CubeToMatOp< CubeToMatOp > - { static constexpr bool value = true; }; - -template -struct is_CubeToMatOp< const CubeToMatOp > - { static constexpr bool value = true; }; - - -template -struct is_SpToDOp - { static constexpr bool value = false; }; - -template -struct is_SpToDOp< SpToDOp > - { static constexpr bool value = true; }; - -template -struct is_SpToDOp< const SpToDOp > - { static constexpr bool value = true; }; - - -template -struct is_SpToDGlue - { static constexpr bool value = false; }; - -template -struct is_SpToDGlue< SpToDGlue > - { static constexpr bool value = true; }; - -template -struct is_SpToDGlue< const SpToDGlue > - { static constexpr bool value = true; }; - - -template -struct is_eOp - { static constexpr bool value = false; }; - -template -struct is_eOp< eOp > - { static constexpr bool value = true; }; - -template -struct is_eOp< const eOp > - { static constexpr bool value = true; }; - - -template -struct is_mtOp - { static constexpr bool value = false; }; - -template -struct is_mtOp< mtOp > - { static constexpr bool value = true; }; - -template -struct is_mtOp< const mtOp > - { static constexpr bool value = true; }; - - -template -struct is_Glue - { static constexpr bool value = false; }; - -template -struct is_Glue< Glue > - { static constexpr bool value = true; }; - -template -struct is_Glue< const Glue > - { static constexpr bool value = true; }; - - -template -struct is_eGlue - { static constexpr bool value = false; }; - -template -struct is_eGlue< eGlue > - { static constexpr bool value = true; }; - -template -struct is_eGlue< const eGlue > - { static constexpr bool value = true; }; - - -template -struct is_mtGlue - { static constexpr bool value = false; }; - -template -struct is_mtGlue< mtGlue > - { static constexpr bool value = true; }; - -template -struct is_mtGlue< const mtGlue > - { static constexpr bool value = true; }; - - -// -// - - -template -struct is_glue_times - { static constexpr bool value = false; }; - -template -struct is_glue_times< Glue > - { static constexpr bool value = true; }; - -template -struct is_glue_times< const Glue > - { static constexpr bool value = true; }; - - -template -struct is_glue_times_diag - { static constexpr bool value = false; }; - -template -struct is_glue_times_diag< Glue > - { static constexpr bool value = true; }; - -template -struct is_glue_times_diag< const Glue > - { static constexpr bool value = true; }; - - -template -struct is_op_diagmat - { static constexpr bool value = false; }; - -template -struct is_op_diagmat< Op > - { static constexpr bool value = true; }; - -template -struct is_op_diagmat< const Op > - { static constexpr bool value = true; }; - - -// -// - - -template -struct is_GenCube - { static constexpr bool value = false; }; - -template -struct is_GenCube< GenCube > - { static constexpr bool value = true; }; - - -template -struct is_OpCube - { static constexpr bool value = false; }; - -template -struct is_OpCube< OpCube > - { static constexpr bool value = true; }; - - -template -struct is_eOpCube - { static constexpr bool value = false; }; - -template -struct is_eOpCube< eOpCube > - { static constexpr bool value = true; }; - - -template -struct is_mtOpCube - { static constexpr bool value = false; }; - -template -struct is_mtOpCube< mtOpCube > - { static constexpr bool value = true; }; - - -template -struct is_GlueCube - { static constexpr bool value = false; }; - -template -struct is_GlueCube< GlueCube > - { static constexpr bool value = true; }; - - -template -struct is_eGlueCube - { static constexpr bool value = false; }; - -template -struct is_eGlueCube< eGlueCube > - { static constexpr bool value = true; }; - - -template -struct is_mtGlueCube - { static constexpr bool value = false; }; - -template -struct is_mtGlueCube< mtGlueCube > - { static constexpr bool value = true; }; - - -// -// -// - - -template -struct is_arma_type2 - { - static constexpr bool value - = is_Mat::value - || is_Gen::value - || is_Op::value - || is_Glue::value - || is_eOp::value - || is_eGlue::value - || is_mtOp::value - || is_mtGlue::value - || is_diagview::value - || is_subview::value - || is_subview_row::value - || is_subview_col::value - || is_subview_cols::value - || is_subview_elem1::value - || is_subview_elem2::value - || is_CubeToMatOp::value - || is_SpToDOp::value - || is_SpToDGlue::value - ; - }; - - - -// due to rather baroque C++ rules for proving constant expressions, -// certain compilers may get confused with the combination of conditional inheritance, nested classes and the shenanigans in is_Mat_fixed_only. -// below we explicitly ensure the type is forced to be const, which seems to eliminate the confusion. -template -struct is_arma_type - { - static constexpr bool value = is_arma_type2::value; - }; - - - -template -struct is_arma_cube_type - { - static constexpr bool value - = is_Cube::value - || is_GenCube::value - || is_OpCube::value - || is_eOpCube::value - || is_mtOpCube::value - || is_GlueCube::value - || is_eGlueCube::value - || is_mtGlueCube::value - || is_subview_cube::value - || is_subview_cube_slices::value - ; - }; - - - -// -// -// - - - -template -struct is_SpMat - { static constexpr bool value = false; }; - -template -struct is_SpMat< SpMat > - { static constexpr bool value = true; }; - -template -struct is_SpMat< SpCol > - { static constexpr bool value = true; }; - -template -struct is_SpMat< SpRow > - { static constexpr bool value = true; }; - - - -template -struct is_SpRow - { static constexpr bool value = false; }; - -template -struct is_SpRow< SpRow > - { static constexpr bool value = true; }; - - - -template -struct is_SpCol - { static constexpr bool value = false; }; - -template -struct is_SpCol< SpCol > - { static constexpr bool value = true; }; - - - -template -struct is_SpSubview - { static constexpr bool value = false; }; - -template -struct is_SpSubview< SpSubview > - { static constexpr bool value = true; }; - - -template -struct is_SpSubview_col - { static constexpr bool value = false; }; - -template -struct is_SpSubview_col< SpSubview_col > - { static constexpr bool value = true; }; - - -template -struct is_SpSubview_col_list - { static constexpr bool value = false; }; - -template -struct is_SpSubview_col_list< SpSubview_col_list > - { static constexpr bool value = true; }; - - -template -struct is_SpSubview_row - { static constexpr bool value = false; }; - -template -struct is_SpSubview_row< SpSubview_row > - { static constexpr bool value = true; }; - - -template -struct is_spdiagview - { static constexpr bool value = false; }; - -template -struct is_spdiagview< spdiagview > - { static constexpr bool value = true; }; - - -template -struct is_SpOp - { static constexpr bool value = false; }; - -template -struct is_SpOp< SpOp > - { static constexpr bool value = true; }; - - -template -struct is_SpGlue - { static constexpr bool value = false; }; - -template -struct is_SpGlue< SpGlue > - { static constexpr bool value = true; }; - - -template -struct is_mtSpOp - { static constexpr bool value = false; }; - -template -struct is_mtSpOp< mtSpOp > - { static constexpr bool value = true; }; - - -template -struct is_mtSpGlue - { static constexpr bool value = false; }; - -template -struct is_mtSpGlue< mtSpGlue > - { static constexpr bool value = true; }; - - -template -struct is_mtSpReduceOp - { static constexpr bool value = false; }; - -template -struct is_mtSpReduceOp< mtSpReduceOp > - { static constexpr bool value = true; }; - - - -template -struct is_arma_sparse_type - { - static constexpr bool value - = is_SpMat::value - || is_SpSubview::value - || is_SpSubview_col::value - || is_SpSubview_col_list::value - || is_SpSubview_row::value - || is_spdiagview::value - || is_SpOp::value - || is_SpGlue::value - || is_mtSpOp::value - || is_mtSpGlue::value - || is_mtSpReduceOp::value - ; - }; - - - -// -// -// - - -template -struct is_same_type - { - static constexpr bool value = false; - static constexpr bool yes = false; - static constexpr bool no = true; - }; - - -template -struct is_same_type - { - static constexpr bool value = true; - static constexpr bool yes = true; - static constexpr bool no = false; - }; - - - -// -// -// - - -template -struct is_u8 - { static constexpr bool value = false; }; - -template<> -struct is_u8 - { static constexpr bool value = true; }; - - - -template -struct is_s8 - { static constexpr bool value = false; }; - -template<> -struct is_s8 - { static constexpr bool value = true; }; - - - -template -struct is_u16 - { static constexpr bool value = false; }; - -template<> -struct is_u16 - { static constexpr bool value = true; }; - - - -template -struct is_s16 - { static constexpr bool value = false; }; - -template<> -struct is_s16 - { static constexpr bool value = true; }; - - - -template -struct is_u32 - { static constexpr bool value = false; }; - -template<> -struct is_u32 - { static constexpr bool value = true; }; - - - -template -struct is_s32 - { static constexpr bool value = false; }; - -template<> -struct is_s32 - { static constexpr bool value = true; }; - - - -template -struct is_u64 - { static constexpr bool value = false; }; - -template<> -struct is_u64 - { static constexpr bool value = true; }; - - -template -struct is_s64 - { static constexpr bool value = false; }; - -template<> -struct is_s64 - { static constexpr bool value = true; }; - - - -template -struct is_ulng_t - { static constexpr bool value = false; }; - -template<> -struct is_ulng_t - { static constexpr bool value = true; }; - - - -template -struct is_slng_t - { static constexpr bool value = false; }; - -template<> -struct is_slng_t - { static constexpr bool value = true; }; - - - -template -struct is_ulng_t_32 - { static constexpr bool value = false; }; - -template<> -struct is_ulng_t_32 - { static constexpr bool value = (sizeof(ulng_t) == 4); }; - - - -template -struct is_slng_t_32 - { static constexpr bool value = false; }; - -template<> -struct is_slng_t_32 - { static constexpr bool value = (sizeof(slng_t) == 4); }; - - - -template -struct is_ulng_t_64 - { static constexpr bool value = false; }; - -template<> -struct is_ulng_t_64 - { static constexpr bool value = (sizeof(ulng_t) == 8); }; - - - -template -struct is_slng_t_64 - { static constexpr bool value = false; }; - -template<> -struct is_slng_t_64 - { static constexpr bool value = (sizeof(slng_t) == 8); }; - - - -template -struct is_uword - { static constexpr bool value = false; }; - -template<> -struct is_uword - { static constexpr bool value = true; }; - - - -template -struct is_sword - { static constexpr bool value = false; }; - -template<> -struct is_sword - { static constexpr bool value = true; }; - - - -template -struct is_float - { static constexpr bool value = false; }; - -template<> -struct is_float - { static constexpr bool value = true; }; - - - -template -struct is_double - { static constexpr bool value = false; }; - -template<> -struct is_double - { static constexpr bool value = true; }; - - - -template -struct is_real - { - static constexpr bool value = false; - static constexpr bool yes = false; - static constexpr bool no = true; - }; - -template<> -struct is_real - { - static constexpr bool value = true; - static constexpr bool yes = true; - static constexpr bool no = false; - }; - -template<> -struct is_real - { - static constexpr bool value = true; - static constexpr bool yes = true; - static constexpr bool no = false; - }; - - - - -template -struct is_cx - { - static constexpr bool value = false; - static constexpr bool yes = false; - static constexpr bool no = true; - }; - -// template<> -template -struct is_cx< std::complex > - { - static constexpr bool value = true; - static constexpr bool yes = true; - static constexpr bool no = false; - }; - - - -template -struct is_cx_float - { - static constexpr bool value = false; - static constexpr bool yes = false; - static constexpr bool no = true; - }; - -template<> -struct is_cx_float< std::complex > - { - static constexpr bool value = true; - static constexpr bool yes = true; - static constexpr bool no = false; - }; - - - -template -struct is_cx_double - { - static constexpr bool value = false; - static constexpr bool yes = false; - static constexpr bool no = true; - }; - -template<> -struct is_cx_double< std::complex > - { - static constexpr bool value = true; - static constexpr bool yes = true; - static constexpr bool no = false; - }; - - - -template -struct is_supported_elem_type - { - static constexpr bool value = \ - is_u8::value || - is_s8::value || - is_u16::value || - is_s16::value || - is_u32::value || - is_s32::value || - is_u64::value || - is_s64::value || - is_ulng_t::value || - is_slng_t::value || - is_float::value || - is_double::value || - is_cx_float::value || - is_cx_double::value; - }; - - - -template -struct is_supported_blas_type - { - static constexpr bool value = \ - is_float::value || - is_double::value || - is_cx_float::value || - is_cx_double::value; - }; - - - -template -struct has_blas_float_bug - { - #if defined(ARMA_BLAS_FLOAT_BUG) - static constexpr bool value = is_float::result>::value; - #else - static constexpr bool value = false; - #endif - }; - - - -template -struct is_signed - { - static constexpr bool value = true; - }; - - -template<> struct is_signed { static constexpr bool value = false; }; -template<> struct is_signed { static constexpr bool value = false; }; -template<> struct is_signed { static constexpr bool value = false; }; -template<> struct is_signed { static constexpr bool value = false; }; -template<> struct is_signed { static constexpr bool value = false; }; - - -template -struct is_non_integral - { - static constexpr bool value = false; - }; - - -template<> struct is_non_integral< float > { static constexpr bool value = true; }; -template<> struct is_non_integral< double > { static constexpr bool value = true; }; -template<> struct is_non_integral< std::complex > { static constexpr bool value = true; }; -template<> struct is_non_integral< std::complex > { static constexpr bool value = true; }; - - - - -// - -class arma_junk_class; - -template -struct force_different_type - { - typedef T1 T1_result; - typedef T2 T2_result; - }; - - -template -struct force_different_type - { - typedef T1 T1_result; - typedef arma_junk_class T2_result; - }; - - - -// - - -template -struct resolves_to_vector_default - { - static constexpr bool value = false; - static constexpr bool yes = false; - static constexpr bool no = true; - }; - -template -struct resolves_to_vector_test - { - static constexpr bool value = (T1::is_col || T1::is_row || T1::is_xvec); - static constexpr bool yes = (T1::is_col || T1::is_row || T1::is_xvec); - static constexpr bool no = ((T1::is_col || T1::is_row || T1::is_xvec) == false); - }; - - -template -struct resolves_to_vector_redirect {}; - -template -struct resolves_to_vector_redirect { typedef resolves_to_vector_default result; }; - -template -struct resolves_to_vector_redirect { typedef resolves_to_vector_test result; }; - - -template -struct resolves_to_vector : public resolves_to_vector_redirect::value>::result {}; - -template -struct resolves_to_sparse_vector : public resolves_to_vector_redirect::value>::result {}; - -// - -template -struct resolves_to_rowvector_default { static constexpr bool value = false; }; - -template -struct resolves_to_rowvector_test { static constexpr bool value = T1::is_row; }; - - -template -struct resolves_to_rowvector_redirect {}; - -template -struct resolves_to_rowvector_redirect { typedef resolves_to_rowvector_default result; }; - -template -struct resolves_to_rowvector_redirect { typedef resolves_to_rowvector_test result; }; - - -template -struct resolves_to_rowvector : public resolves_to_rowvector_redirect::value>::result {}; - -// - -template -struct resolves_to_colvector_default { static constexpr bool value = false; }; - -template -struct resolves_to_colvector_test { static constexpr bool value = T1::is_col; }; - - -template -struct resolves_to_colvector_redirect {}; - -template -struct resolves_to_colvector_redirect { typedef resolves_to_colvector_default result; }; - -template -struct resolves_to_colvector_redirect { typedef resolves_to_colvector_test result; }; - - -template -struct resolves_to_colvector : public resolves_to_colvector_redirect::value>::result {}; - - - -template -struct is_outer_product - { static constexpr bool value = false; }; - -template -struct is_outer_product< Glue > - { static constexpr bool value = (resolves_to_colvector::value && resolves_to_rowvector::value); }; - - - -template -struct has_op_inv_any - { static constexpr bool value = false; }; - -template -struct has_op_inv_any< Op > - { static constexpr bool value = true; }; - -template -struct has_op_inv_any< Op > - { static constexpr bool value = true; }; - -template -struct has_op_inv_any< Op > - { static constexpr bool value = true; }; - -template -struct has_op_inv_any< Op > - { static constexpr bool value = true; }; - -template -struct has_op_inv_any< Glue, T2, glue_times> > - { static constexpr bool value = true; }; - -template -struct has_op_inv_any< Glue, T2, glue_times> > - { static constexpr bool value = true; }; - -template -struct has_op_inv_any< Glue, T2, glue_times> > - { static constexpr bool value = true; }; - -template -struct has_op_inv_any< Glue, T2, glue_times> > - { static constexpr bool value = true; }; - -template -struct has_op_inv_any< Glue, glue_times> > - { static constexpr bool value = true; }; - -template -struct has_op_inv_any< Glue, glue_times> > - { static constexpr bool value = true; }; - -template -struct has_op_inv_any< Glue, glue_times> > - { static constexpr bool value = true; }; - -template -struct has_op_inv_any< Glue, glue_times> > - { static constexpr bool value = true; }; - - - - -template -struct has_nested_op_traits - { - typedef char yes[1]; - typedef char no[2]; - - template static yes& check(typename X::template traits*); - template static no& check(...); - - static constexpr bool value = ( sizeof(check(0)) == sizeof(yes) ); - }; - -template -struct has_nested_glue_traits - { - typedef char yes[1]; - typedef char no[2]; - - template static yes& check(typename X::template traits*); - template static no& check(...); - - static constexpr bool value = ( sizeof(check(0)) == sizeof(yes) ); - }; - - - - -template -struct is_sym_expr - { - static constexpr bool eval(const T1&) { return false; } - }; - -template -struct is_sym_expr< Glue< Mat, Op, op_htrans>, glue_times > > - { - static - arma_inline - bool - eval(const Glue< Mat, Op, op_htrans>, glue_times >& expr) - { - const Mat& X = expr.A; - const Mat& Y = expr.B.m; - - return (&X == &Y); - } - }; - -template -struct is_sym_expr< Glue< Op, op_htrans>, Mat, glue_times > > - { - static - arma_inline - bool - eval(const Glue< Op, op_htrans>, Mat, glue_times >& expr) - { - const Mat& X = expr.A.m; - const Mat& Y = expr.B; - - return (&X == &Y); - } - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/translate_arpack.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/translate_arpack.hpp deleted file mode 100644 index 8482892a0..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/translate_arpack.hpp +++ /dev/null @@ -1,114 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -#if defined(ARMA_USE_ARPACK) - -//! \namespace arpack namespace for ARPACK functions -namespace arpack - { - - // If real, then eT == eeT; otherwise, eT == std::complex. - // For real calls, rwork is ignored; it's only necessary in the complex case. - template - inline - void - naupd(blas_int* ido, char* bmat, blas_int* n, char* which, blas_int* nev, eeT* tol, eT* resid, blas_int* ncv, eT* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, eT* workd, eT* workl, blas_int* lworkl, eeT* rwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_ignore(rwork); arma_fortran(arma_snaupd)(ido, bmat, n, which, nev, (T*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, info, 1, 1); } - else if( is_double::value) { typedef double T; arma_ignore(rwork); arma_fortran(arma_dnaupd)(ido, bmat, n, which, nev, (T*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, info, 1, 1); } - else if( is_cx_float::value) { typedef cx_float T; typedef float xT; arma_fortran(arma_cnaupd)(ido, bmat, n, which, nev, (xT*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, (xT*) rwork, info, 1, 1); } - else if(is_cx_double::value) { typedef cx_double T; typedef double xT; arma_fortran(arma_znaupd)(ido, bmat, n, which, nev, (xT*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, (xT*) rwork, info, 1, 1); } - #else - if( is_float::value) { typedef float T; arma_ignore(rwork); arma_fortran(arma_snaupd)(ido, bmat, n, which, nev, (T*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, info); } - else if( is_double::value) { typedef double T; arma_ignore(rwork); arma_fortran(arma_dnaupd)(ido, bmat, n, which, nev, (T*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, info); } - else if( is_cx_float::value) { typedef cx_float T; typedef float xT; arma_fortran(arma_cnaupd)(ido, bmat, n, which, nev, (xT*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, (xT*) rwork, info); } - else if(is_cx_double::value) { typedef cx_double T; typedef double xT; arma_fortran(arma_znaupd)(ido, bmat, n, which, nev, (xT*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, (xT*) rwork, info); } - #endif - } - - - //! The use of two template types is necessary here because the compiler will - //! instantiate this method for complex types (where eT != eeT) but that in - //! practice that is never actually used. - template - inline - void - saupd(blas_int* ido, char* bmat, blas_int* n, char* which, blas_int* nev, eeT* tol, eT* resid, blas_int* ncv, eT* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, eT* workd, eT* workl, blas_int* lworkl, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_ssaupd)(ido, bmat, n, which, nev, (T*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, info, 1, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dsaupd)(ido, bmat, n, which, nev, (T*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, info, 1, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_ssaupd)(ido, bmat, n, which, nev, (T*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dsaupd)(ido, bmat, n, which, nev, (T*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, info); } - #endif - } - - - - template - inline - void - seupd(blas_int* rvec, char* howmny, blas_int* select, eT* d, eT* z, blas_int* ldz, eT* sigma, char* bmat, blas_int* n, char* which, blas_int* nev, eT* tol, eT* resid, blas_int* ncv, eT* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, eT* workd, eT* workl, blas_int* lworkl, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_sseupd)(rvec, howmny, select, (T*) d, (T*) z, ldz, (T*) sigma, bmat, n, which, nev, (T*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, info, 1, 1, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dseupd)(rvec, howmny, select, (T*) d, (T*) z, ldz, (T*) sigma, bmat, n, which, nev, (T*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, info, 1, 1, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_sseupd)(rvec, howmny, select, (T*) d, (T*) z, ldz, (T*) sigma, bmat, n, which, nev, (T*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dseupd)(rvec, howmny, select, (T*) d, (T*) z, ldz, (T*) sigma, bmat, n, which, nev, (T*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, info); } - #endif - } - - - - // for complex versions, pass d for dr, and null for di; pass sigma for - // sigmar, and null for sigmai; rwork isn't used for non-complex versions - template - inline - void - neupd(blas_int* rvec, char* howmny, blas_int* select, eT* dr, eT* di, eT* z, blas_int* ldz, eT* sigmar, eT* sigmai, eT* workev, char* bmat, blas_int* n, char* which, blas_int* nev, eeT* tol, eT* resid, blas_int* ncv, eT* v, blas_int* ldv, blas_int* iparam, blas_int* ipntr, eT* workd, eT* workl, blas_int* lworkl, eeT* rwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_ignore(rwork); arma_fortran(arma_sneupd)(rvec, howmny, select, (T*) dr, (T*) di, (T*) z, ldz, (T*) sigmar, (T*) sigmai, (T*) workev, bmat, n, which, nev, (T*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, info, 1, 1, 1); } - else if( is_double::value) { typedef double T; arma_ignore(rwork); arma_fortran(arma_dneupd)(rvec, howmny, select, (T*) dr, (T*) di, (T*) z, ldz, (T*) sigmar, (T*) sigmai, (T*) workev, bmat, n, which, nev, (T*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, info, 1, 1, 1); } - else if( is_cx_float::value) { typedef cx_float T; typedef float xT; arma_fortran(arma_cneupd)(rvec, howmny, select, (T*) dr, (T*) z, ldz, (T*) sigmar, (T*) workev, bmat, n, which, nev, (xT*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, (xT*) rwork, info, 1, 1, 1); } - else if(is_cx_double::value) { typedef cx_double T; typedef double xT; arma_fortran(arma_zneupd)(rvec, howmny, select, (T*) dr, (T*) z, ldz, (T*) sigmar, (T*) workev, bmat, n, which, nev, (xT*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, (xT*) rwork, info, 1, 1, 1); } - #else - if( is_float::value) { typedef float T; arma_ignore(rwork); arma_fortran(arma_sneupd)(rvec, howmny, select, (T*) dr, (T*) di, (T*) z, ldz, (T*) sigmar, (T*) sigmai, (T*) workev, bmat, n, which, nev, (T*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, info); } - else if( is_double::value) { typedef double T; arma_ignore(rwork); arma_fortran(arma_dneupd)(rvec, howmny, select, (T*) dr, (T*) di, (T*) z, ldz, (T*) sigmar, (T*) sigmai, (T*) workev, bmat, n, which, nev, (T*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, info); } - else if( is_cx_float::value) { typedef cx_float T; typedef float xT; arma_fortran(arma_cneupd)(rvec, howmny, select, (T*) dr, (T*) z, ldz, (T*) sigmar, (T*) workev, bmat, n, which, nev, (xT*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, (xT*) rwork, info); } - else if(is_cx_double::value) { typedef cx_double T; typedef double xT; arma_fortran(arma_zneupd)(rvec, howmny, select, (T*) dr, (T*) z, ldz, (T*) sigmar, (T*) workev, bmat, n, which, nev, (xT*) tol, (T*) resid, ncv, (T*) v, ldv, iparam, ipntr, (T*) workd, (T*) workl, lworkl, (xT*) rwork, info); } - #endif - } - - - } // namespace arpack - - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/translate_atlas.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/translate_atlas.hpp deleted file mode 100644 index 95d43d5a7..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/translate_atlas.hpp +++ /dev/null @@ -1,282 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -#if defined(ARMA_USE_ATLAS) - - -// TODO: remove support for ATLAS in next major version - -//! \namespace atlas namespace for ATLAS functions -namespace atlas - { - - template - inline static const eT& tmp_real(const eT& X) { return X; } - - template - inline static const T tmp_real(const std::complex& X) { return X.real(); } - - - - template - arma_inline - eT - cblas_asum(const int N, const eT* X) - { - arma_type_check((is_supported_blas_type::value == false)); - - if(is_float::value) - { - typedef float T; - return eT( arma_wrapper(cblas_sasum)(N, (const T*)X, 1) ); - } - else - if(is_double::value) - { - typedef double T; - return eT( arma_wrapper(cblas_dasum)(N, (const T*)X, 1) ); - } - - return eT(0); - } - - - - template - arma_inline - eT - cblas_nrm2(const int N, const eT* X) - { - arma_type_check((is_supported_blas_type::value == false)); - - if(is_float::value) - { - typedef float T; - return eT( arma_wrapper(cblas_snrm2)(N, (const T*)X, 1) ); - } - else - if(is_double::value) - { - typedef double T; - return eT( arma_wrapper(cblas_dnrm2)(N, (const T*)X, 1) ); - } - - return eT(0); - } - - - - template - arma_inline - eT - cblas_dot(const int N, const eT* X, const eT* Y) - { - arma_type_check((is_supported_blas_type::value == false)); - - if(is_float::value) - { - typedef float T; - return eT( arma_wrapper(cblas_sdot)(N, (const T*)X, 1, (const T*)Y, 1) ); - } - else - if(is_double::value) - { - typedef double T; - return eT( arma_wrapper(cblas_ddot)(N, (const T*)X, 1, (const T*)Y, 1) ); - } - - return eT(0); - } - - - - template - arma_inline - eT - cblas_cx_dot(const int N, const eT* X, const eT* Y) - { - arma_type_check((is_supported_blas_type::value == false)); - - if(is_cx_float::value) - { - typedef typename std::complex T; - - T out; - arma_wrapper(cblas_cdotu_sub)(N, (const T*)X, 1, (const T*)Y, 1, &out); - - return eT(out); - } - else - if(is_cx_double::value) - { - typedef typename std::complex T; - - T out; - arma_wrapper(cblas_zdotu_sub)(N, (const T*)X, 1, (const T*)Y, 1, &out); - - return eT(out); - } - - return eT(0); - } - - - - template - inline - void - cblas_gemv - ( - const atlas_CBLAS_LAYOUT layout, const atlas_CBLAS_TRANS TransA, - const int M, const int N, - const eT alpha, - const eT *A, const int lda, - const eT *X, const int incX, - const eT beta, - eT *Y, const int incY - ) - { - arma_type_check((is_supported_blas_type::value == false)); - - if(is_float::value) - { - typedef float T; - arma_wrapper(cblas_sgemv)(layout, TransA, M, N, (const T)tmp_real(alpha), (const T*)A, lda, (const T*)X, incX, (const T)tmp_real(beta), (T*)Y, incY); - } - else - if(is_double::value) - { - typedef double T; - arma_wrapper(cblas_dgemv)(layout, TransA, M, N, (const T)tmp_real(alpha), (const T*)A, lda, (const T*)X, incX, (const T)tmp_real(beta), (T*)Y, incY); - } - else - if(is_cx_float::value) - { - typedef std::complex T; - arma_wrapper(cblas_cgemv)(layout, TransA, M, N, (const T*)&alpha, (const T*)A, lda, (const T*)X, incX, (const T*)&beta, (T*)Y, incY); - } - else - if(is_cx_double::value) - { - typedef std::complex T; - arma_wrapper(cblas_zgemv)(layout, TransA, M, N, (const T*)&alpha, (const T*)A, lda, (const T*)X, incX, (const T*)&beta, (T*)Y, incY); - } - } - - - - template - inline - void - cblas_gemm - ( - const atlas_CBLAS_LAYOUT layout, const atlas_CBLAS_TRANS TransA, - const atlas_CBLAS_TRANS TransB, const int M, const int N, - const int K, const eT alpha, const eT *A, - const int lda, const eT *B, const int ldb, - const eT beta, eT *C, const int ldc - ) - { - arma_type_check((is_supported_blas_type::value == false)); - - if(is_float::value) - { - typedef float T; - arma_wrapper(cblas_sgemm)(layout, TransA, TransB, M, N, K, (const T)tmp_real(alpha), (const T*)A, lda, (const T*)B, ldb, (const T)tmp_real(beta), (T*)C, ldc); - } - else - if(is_double::value) - { - typedef double T; - arma_wrapper(cblas_dgemm)(layout, TransA, TransB, M, N, K, (const T)tmp_real(alpha), (const T*)A, lda, (const T*)B, ldb, (const T)tmp_real(beta), (T*)C, ldc); - } - else - if(is_cx_float::value) - { - typedef std::complex T; - arma_wrapper(cblas_cgemm)(layout, TransA, TransB, M, N, K, (const T*)&alpha, (const T*)A, lda, (const T*)B, ldb, (const T*)&beta, (T*)C, ldc); - } - else - if(is_cx_double::value) - { - typedef std::complex T; - arma_wrapper(cblas_zgemm)(layout, TransA, TransB, M, N, K, (const T*)&alpha, (const T*)A, lda, (const T*)B, ldb, (const T*)&beta, (T*)C, ldc); - } - } - - - - template - inline - void - cblas_syrk - ( - const atlas_CBLAS_LAYOUT layout, const atlas_CBLAS_UPLO Uplo, const atlas_CBLAS_TRANS Trans, - const int N, const int K, const eT alpha, - const eT* A, const int lda, const eT beta, eT* C, const int ldc - ) - { - arma_type_check((is_supported_blas_type::value == false)); - - if(is_float::value) - { - typedef float T; - arma_wrapper(cblas_ssyrk)(layout, Uplo, Trans, N, K, (const T)alpha, (const T*)A, lda, (const T)beta, (T*)C, ldc); - } - else - if(is_double::value) - { - typedef double T; - arma_wrapper(cblas_dsyrk)(layout, Uplo, Trans, N, K, (const T)alpha, (const T*)A, lda, (const T)beta, (T*)C, ldc); - } - } - - - - template - inline - void - cblas_herk - ( - const atlas_CBLAS_LAYOUT layout, const atlas_CBLAS_UPLO Uplo, const atlas_CBLAS_TRANS Trans, - const int N, const int K, const T alpha, - const std::complex* A, const int lda, const T beta, std::complex* C, const int ldc - ) - { - arma_type_check((is_supported_blas_type::value == false)); - - if(is_float::value) - { - typedef float TT; - typedef std::complex cx_TT; - - arma_wrapper(cblas_cherk)(layout, Uplo, Trans, N, K, (const TT)alpha, (const cx_TT*)A, lda, (const TT)beta, (cx_TT*)C, ldc); - } - else - if(is_double::value) - { - typedef double TT; - typedef std::complex cx_TT; - - arma_wrapper(cblas_zherk)(layout, Uplo, Trans, N, K, (const TT)alpha, (const cx_TT*)A, lda, (const TT)beta, (cx_TT*)C, ldc); - } - } - - } - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/translate_blas.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/translate_blas.hpp deleted file mode 100644 index 0cd98bdbe..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/translate_blas.hpp +++ /dev/null @@ -1,271 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -#if defined(ARMA_USE_BLAS) - - -//! \namespace blas namespace for BLAS functions -namespace blas - { - - - template - inline - void - gemv(const char* transA, const blas_int* m, const blas_int* n, const eT* alpha, const eT* A, const blas_int* ldA, const eT* x, const blas_int* incx, const eT* beta, eT* y, const blas_int* incy) - { - arma_type_check((is_supported_blas_type::value == false)); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - { - if( is_float::value) { typedef float T; arma_fortran(arma_sgemv)(transA, m, n, (const T*)alpha, (const T*)A, ldA, (const T*)x, incx, (const T*)beta, (T*)y, incy, 1); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dgemv)(transA, m, n, (const T*)alpha, (const T*)A, ldA, (const T*)x, incx, (const T*)beta, (T*)y, incy, 1); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cgemv)(transA, m, n, (const T*)alpha, (const T*)A, ldA, (const T*)x, incx, (const T*)beta, (T*)y, incy, 1); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zgemv)(transA, m, n, (const T*)alpha, (const T*)A, ldA, (const T*)x, incx, (const T*)beta, (T*)y, incy, 1); } - } - #else - { - if( is_float::value) { typedef float T; arma_fortran(arma_sgemv)(transA, m, n, (const T*)alpha, (const T*)A, ldA, (const T*)x, incx, (const T*)beta, (T*)y, incy); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dgemv)(transA, m, n, (const T*)alpha, (const T*)A, ldA, (const T*)x, incx, (const T*)beta, (T*)y, incy); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cgemv)(transA, m, n, (const T*)alpha, (const T*)A, ldA, (const T*)x, incx, (const T*)beta, (T*)y, incy); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zgemv)(transA, m, n, (const T*)alpha, (const T*)A, ldA, (const T*)x, incx, (const T*)beta, (T*)y, incy); } - } - #endif - } - - - - template - inline - void - gemm(const char* transA, const char* transB, const blas_int* m, const blas_int* n, const blas_int* k, const eT* alpha, const eT* A, const blas_int* ldA, const eT* B, const blas_int* ldB, const eT* beta, eT* C, const blas_int* ldC) - { - arma_type_check((is_supported_blas_type::value == false)); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - { - if( is_float::value) { typedef float T; arma_fortran(arma_sgemm)(transA, transB, m, n, k, (const T*)alpha, (const T*)A, ldA, (const T*)B, ldB, (const T*)beta, (T*)C, ldC, 1, 1); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dgemm)(transA, transB, m, n, k, (const T*)alpha, (const T*)A, ldA, (const T*)B, ldB, (const T*)beta, (T*)C, ldC, 1, 1); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cgemm)(transA, transB, m, n, k, (const T*)alpha, (const T*)A, ldA, (const T*)B, ldB, (const T*)beta, (T*)C, ldC, 1, 1); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zgemm)(transA, transB, m, n, k, (const T*)alpha, (const T*)A, ldA, (const T*)B, ldB, (const T*)beta, (T*)C, ldC, 1, 1); } - } - #else - { - if( is_float::value) { typedef float T; arma_fortran(arma_sgemm)(transA, transB, m, n, k, (const T*)alpha, (const T*)A, ldA, (const T*)B, ldB, (const T*)beta, (T*)C, ldC); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dgemm)(transA, transB, m, n, k, (const T*)alpha, (const T*)A, ldA, (const T*)B, ldB, (const T*)beta, (T*)C, ldC); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cgemm)(transA, transB, m, n, k, (const T*)alpha, (const T*)A, ldA, (const T*)B, ldB, (const T*)beta, (T*)C, ldC); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zgemm)(transA, transB, m, n, k, (const T*)alpha, (const T*)A, ldA, (const T*)B, ldB, (const T*)beta, (T*)C, ldC); } - } - #endif - } - - - - template - inline - void - syrk(const char* uplo, const char* transA, const blas_int* n, const blas_int* k, const eT* alpha, const eT* A, const blas_int* ldA, const eT* beta, eT* C, const blas_int* ldC) - { - arma_type_check((is_supported_blas_type::value == false)); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - { - if( is_float::value) { typedef float T; arma_fortran(arma_ssyrk)(uplo, transA, n, k, (const T*)alpha, (const T*)A, ldA, (const T*)beta, (T*)C, ldC, 1, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dsyrk)(uplo, transA, n, k, (const T*)alpha, (const T*)A, ldA, (const T*)beta, (T*)C, ldC, 1, 1); } - } - #else - { - if( is_float::value) { typedef float T; arma_fortran(arma_ssyrk)(uplo, transA, n, k, (const T*)alpha, (const T*)A, ldA, (const T*)beta, (T*)C, ldC); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dsyrk)(uplo, transA, n, k, (const T*)alpha, (const T*)A, ldA, (const T*)beta, (T*)C, ldC); } - } - #endif - } - - - - template - inline - void - herk(const char* uplo, const char* transA, const blas_int* n, const blas_int* k, const T* alpha, const std::complex* A, const blas_int* ldA, const T* beta, std::complex* C, const blas_int* ldC) - { - arma_type_check((is_supported_blas_type::value == false)); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - { - if( is_float::value) { typedef float TT; typedef blas_cxf cx_TT; arma_fortran(arma_cherk)(uplo, transA, n, k, (const TT*)alpha, (const cx_TT*)A, ldA, (const TT*)beta, (cx_TT*)C, ldC, 1, 1); } - else if(is_double::value) { typedef double TT; typedef blas_cxd cx_TT; arma_fortran(arma_zherk)(uplo, transA, n, k, (const TT*)alpha, (const cx_TT*)A, ldA, (const TT*)beta, (cx_TT*)C, ldC, 1, 1); } - } - #else - { - if( is_float::value) { typedef float TT; typedef blas_cxf cx_TT; arma_fortran(arma_cherk)(uplo, transA, n, k, (const TT*)alpha, (const cx_TT*)A, ldA, (const TT*)beta, (cx_TT*)C, ldC); } - else if(is_double::value) { typedef double TT; typedef blas_cxd cx_TT; arma_fortran(arma_zherk)(uplo, transA, n, k, (const TT*)alpha, (const cx_TT*)A, ldA, (const TT*)beta, (cx_TT*)C, ldC); } - } - #endif - } - - - - template - inline - eT - dot(const uword n_elem, const eT* x, const eT* y) - { - arma_type_check((is_supported_blas_type::value == false)); - - if(is_float::value) - { - #if defined(ARMA_BLAS_FLOAT_BUG) - { - if(n_elem == 0) { return eT(0); } - - const char trans = 'T'; - - const blas_int m = blas_int(n_elem); - const blas_int n = 1; - const blas_int inc = 1; - - const eT alpha = eT(1); - const eT beta = eT(0); - - eT result[2]; // paranoia: using two elements instead of one - - result[0] = eT(0); - result[1] = eT(0); - - blas::gemv(&trans, &m, &n, &alpha, x, &m, y, &inc, &beta, &result[0], &inc); - - return result[0]; - } - #else - { - blas_int n = blas_int(n_elem); - blas_int inc = 1; - - typedef float T; - return eT( arma_fortran(arma_sdot)(&n, (const T*)x, &inc, (const T*)y, &inc) ); - } - #endif - } - else - if(is_double::value) - { - blas_int n = blas_int(n_elem); - blas_int inc = 1; - - typedef double T; - return eT( arma_fortran(arma_ddot)(&n, (const T*)x, &inc, (const T*)y, &inc) ); - } - else - if( (is_cx_float::value) || (is_cx_double::value) ) - { - if(n_elem == 0) { return eT(0); } - - // using gemv() workaround due to compatibility issues with cdotu() and zdotu() - - const char trans = 'T'; - - const blas_int m = blas_int(n_elem); - const blas_int n = 1; - const blas_int inc = 1; - - const eT alpha = eT(1); - const eT beta = eT(0); - - eT result[2]; // paranoia: using two elements instead of one - - result[0] = eT(0); - result[1] = eT(0); - - blas::gemv(&trans, &m, &n, &alpha, x, &m, y, &inc, &beta, &result[0], &inc); - - return result[0]; - } - - return eT(0); - } - - - - template - arma_inline - eT - asum(const uword n_elem, const eT* x) - { - arma_type_check((is_supported_blas_type::value == false)); - - if(is_float::value) - { - // WARNING: sasum() from Accelerate framework (macOS) may return 'double' instead of 'float' - - blas_int n = blas_int(n_elem); - blas_int inc = 1; - - typedef float T; - return arma_fortran(arma_sasum)(&n, (const T*)x, &inc); - } - else - if(is_double::value) - { - blas_int n = blas_int(n_elem); - blas_int inc = 1; - - typedef double T; - return arma_fortran(arma_dasum)(&n, (const T*)x, &inc); - } - - return eT(0); - } - - - - template - arma_inline - eT - nrm2(const uword n_elem, const eT* x) - { - arma_type_check((is_supported_blas_type::value == false)); - - if(is_float::value) - { - // WARNING: snrm2() from Accelerate framework (macOS) may return 'double' instead of 'float' - - blas_int n = blas_int(n_elem); - blas_int inc = 1; - - typedef float T; - return arma_fortran(arma_snrm2)(&n, (const T*)x, &inc); - } - else - if(is_double::value) - { - blas_int n = blas_int(n_elem); - blas_int inc = 1; - - typedef double T; - return arma_fortran(arma_dnrm2)(&n, (const T*)x, &inc); - } - - return eT(0); - } - - - } // namespace blas - - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/translate_fftw3.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/translate_fftw3.hpp deleted file mode 100644 index c2d11b27b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/translate_fftw3.hpp +++ /dev/null @@ -1,106 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -#if defined(ARMA_USE_FFTW3) - - -namespace fftw3 - { - template - arma_inline - void_ptr - plan_dft_1d(int N, eT* input, eT* output, int fftw3_sign, unsigned int fftw3_flags) - { - arma_type_check((is_cx::value == false)); - - if(is_cx_float::value) - { - return fftwf_plan_dft_1d(N, (fftwf_complex*)(input), (fftwf_complex*)(output), fftw3_sign, fftw3_flags); - } - else - if(is_cx_double::value) - { - return fftw_plan_dft_1d(N, (fftw_complex*)(input), (fftw_complex*)(output), fftw3_sign, fftw3_flags); - } - - return nullptr; - } - - - - template - arma_inline - void - execute(void_ptr plan) - { - arma_type_check((is_cx::value == false)); - - if(is_cx_float::value) - { - fftwf_execute(fftwf_plan(plan)); - } - else - if(is_cx_double::value) - { - fftw_execute(fftw_plan(plan)); - } - } - - - - template - arma_inline - void - destroy_plan(void_ptr plan) - { - arma_type_check((is_cx::value == false)); - - if(is_cx_float::value) - { - fftwf_destroy_plan(fftwf_plan(plan)); - } - else - if(is_cx_double::value) - { - fftw_destroy_plan(fftw_plan(plan)); - } - } - - - - template - arma_inline - void - cleanup() - { - arma_type_check((is_cx::value == false)); - - if(is_cx_float::value) - { - fftwf_cleanup(); - } - else - if(is_cx_double::value) - { - fftw_cleanup(); - } - } - } - - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/translate_lapack.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/translate_lapack.hpp deleted file mode 100644 index 7ed4c0ec9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/translate_lapack.hpp +++ /dev/null @@ -1,1347 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -#if defined(ARMA_USE_LAPACK) - - -//! \namespace lapack namespace for LAPACK functions -namespace lapack - { - - template - inline - void - getrf(blas_int* m, blas_int* n, eT* a, blas_int* lda, blas_int* ipiv, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - if( is_float::value) { typedef float T; arma_fortran(arma_sgetrf)(m, n, (T*)a, lda, ipiv, info); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dgetrf)(m, n, (T*)a, lda, ipiv, info); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cgetrf)(m, n, (T*)a, lda, ipiv, info); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zgetrf)(m, n, (T*)a, lda, ipiv, info); } - } - - - - template - inline - void - getrs(char* trans, blas_int* n, blas_int* nrhs, eT* a, blas_int* lda, blas_int* ipiv, eT* b, blas_int* ldb, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_sgetrs)(trans, n, nrhs, (T*)a, lda, ipiv, (T*)b, ldb, info, 1); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dgetrs)(trans, n, nrhs, (T*)a, lda, ipiv, (T*)b, ldb, info, 1); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cgetrs)(trans, n, nrhs, (T*)a, lda, ipiv, (T*)b, ldb, info, 1); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zgetrs)(trans, n, nrhs, (T*)a, lda, ipiv, (T*)b, ldb, info, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_sgetrs)(trans, n, nrhs, (T*)a, lda, ipiv, (T*)b, ldb, info); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dgetrs)(trans, n, nrhs, (T*)a, lda, ipiv, (T*)b, ldb, info); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cgetrs)(trans, n, nrhs, (T*)a, lda, ipiv, (T*)b, ldb, info); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zgetrs)(trans, n, nrhs, (T*)a, lda, ipiv, (T*)b, ldb, info); } - #endif - } - - - - template - inline - void - getri(blas_int* n, eT* a, blas_int* lda, blas_int* ipiv, eT* work, blas_int* lwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - if( is_float::value) { typedef float T; arma_fortran(arma_sgetri)(n, (T*)a, lda, ipiv, (T*)work, lwork, info); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dgetri)(n, (T*)a, lda, ipiv, (T*)work, lwork, info); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cgetri)(n, (T*)a, lda, ipiv, (T*)work, lwork, info); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zgetri)(n, (T*)a, lda, ipiv, (T*)work, lwork, info); } - } - - - - template - inline - void - trtri(char* uplo, char* diag, blas_int* n, eT* a, blas_int* lda, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_strtri)(uplo, diag, n, (T*)a, lda, info, 1, 1); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dtrtri)(uplo, diag, n, (T*)a, lda, info, 1, 1); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_ctrtri)(uplo, diag, n, (T*)a, lda, info, 1, 1); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_ztrtri)(uplo, diag, n, (T*)a, lda, info, 1, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_strtri)(uplo, diag, n, (T*)a, lda, info); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dtrtri)(uplo, diag, n, (T*)a, lda, info); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_ctrtri)(uplo, diag, n, (T*)a, lda, info); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_ztrtri)(uplo, diag, n, (T*)a, lda, info); } - #endif - } - - - - template - inline - void - geev(char* jobvl, char* jobvr, blas_int* n, eT* a, blas_int* lda, eT* wr, eT* wi, eT* vl, blas_int* ldvl, eT* vr, blas_int* ldvr, eT* work, blas_int* lwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_sgeev)(jobvl, jobvr, n, (T*)a, lda, (T*)wr, (T*)wi, (T*)vl, ldvl, (T*)vr, ldvr, (T*)work, lwork, info, 1, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgeev)(jobvl, jobvr, n, (T*)a, lda, (T*)wr, (T*)wi, (T*)vl, ldvl, (T*)vr, ldvr, (T*)work, lwork, info, 1, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_sgeev)(jobvl, jobvr, n, (T*)a, lda, (T*)wr, (T*)wi, (T*)vl, ldvl, (T*)vr, ldvr, (T*)work, lwork, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgeev)(jobvl, jobvr, n, (T*)a, lda, (T*)wr, (T*)wi, (T*)vl, ldvl, (T*)vr, ldvr, (T*)work, lwork, info); } - #endif - } - - - - template - inline - void - cx_geev(char* jobvl, char* jobvr, blas_int* n, eT* a, blas_int* lda, eT* w, eT* vl, blas_int* ldvl, eT* vr, blas_int* ldvr, eT* work, blas_int* lwork, typename eT::value_type* rwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_cx_float::value) { typedef float T; typedef blas_cxf cx_T; arma_fortran(arma_cgeev)(jobvl, jobvr, n, (cx_T*)a, lda, (cx_T*)w, (cx_T*)vl, ldvl, (cx_T*)vr, ldvr, (cx_T*)work, lwork, (T*)rwork, info, 1, 1); } - else if(is_cx_double::value) { typedef double T; typedef blas_cxd cx_T; arma_fortran(arma_zgeev)(jobvl, jobvr, n, (cx_T*)a, lda, (cx_T*)w, (cx_T*)vl, ldvl, (cx_T*)vr, ldvr, (cx_T*)work, lwork, (T*)rwork, info, 1, 1); } - #else - if( is_cx_float::value) { typedef float T; typedef blas_cxf cx_T; arma_fortran(arma_cgeev)(jobvl, jobvr, n, (cx_T*)a, lda, (cx_T*)w, (cx_T*)vl, ldvl, (cx_T*)vr, ldvr, (cx_T*)work, lwork, (T*)rwork, info); } - else if(is_cx_double::value) { typedef double T; typedef blas_cxd cx_T; arma_fortran(arma_zgeev)(jobvl, jobvr, n, (cx_T*)a, lda, (cx_T*)w, (cx_T*)vl, ldvl, (cx_T*)vr, ldvr, (cx_T*)work, lwork, (T*)rwork, info); } - #endif - } - - - - template - inline - void - geevx(char* balanc, char* jobvl, char* jobvr, char* sense, blas_int* n, eT* a, blas_int* lda, eT* wr, eT* wi, eT* vl, blas_int* ldvl, eT* vr, blas_int* ldvr, blas_int* ilo, blas_int* ihi, eT* scale, eT* abnrm, eT* rconde, eT* rcondv, eT* work, blas_int* lwork, blas_int* iwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_sgeevx)(balanc, jobvl, jobvr, sense, n, (T*)(a), lda, (T*)(wr), (T*)(wi), (T*)(vl), ldvl, (T*)(vr), ldvr, ilo, ihi, (T*)(scale), (T*)(abnrm), (T*)(rconde), (T*)(rcondv), (T*)(work), lwork, iwork, info, 1, 1, 1, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgeevx)(balanc, jobvl, jobvr, sense, n, (T*)(a), lda, (T*)(wr), (T*)(wi), (T*)(vl), ldvl, (T*)(vr), ldvr, ilo, ihi, (T*)(scale), (T*)(abnrm), (T*)(rconde), (T*)(rcondv), (T*)(work), lwork, iwork, info, 1, 1, 1, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_sgeevx)(balanc, jobvl, jobvr, sense, n, (T*)(a), lda, (T*)(wr), (T*)(wi), (T*)(vl), ldvl, (T*)(vr), ldvr, ilo, ihi, (T*)(scale), (T*)(abnrm), (T*)(rconde), (T*)(rcondv), (T*)(work), lwork, iwork, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgeevx)(balanc, jobvl, jobvr, sense, n, (T*)(a), lda, (T*)(wr), (T*)(wi), (T*)(vl), ldvl, (T*)(vr), ldvr, ilo, ihi, (T*)(scale), (T*)(abnrm), (T*)(rconde), (T*)(rcondv), (T*)(work), lwork, iwork, info); } - #endif - } - - - - template - inline - void - cx_geevx(char* balanc, char* jobvl, char* jobvr, char* sense, blas_int* n, eT* a, blas_int* lda, eT* w, eT* vl, blas_int* ldvl, eT* vr, blas_int* ldvr, blas_int* ilo, blas_int* ihi, typename eT::value_type* scale, typename eT::value_type* abnrm, typename eT::value_type* rconde, typename eT::value_type* rcondv, eT* work, blas_int* lwork, typename eT::value_type* rwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_cx_float::value) { typedef float T; typedef blas_cxf cx_T; arma_fortran(arma_cgeevx)(balanc, jobvl, jobvr, sense, n, (cx_T*)(a), lda, (cx_T*)(w), (cx_T*)(vl), ldvl, (cx_T*)(vr), ldvr, ilo, ihi, (T*)(scale), (T*)(abnrm), (T*)(rconde), (T*)(rcondv), (cx_T*)(work), lwork, (T*)(rwork), info, 1, 1, 1, 1); } - else if(is_cx_double::value) { typedef double T; typedef blas_cxd cx_T; arma_fortran(arma_zgeevx)(balanc, jobvl, jobvr, sense, n, (cx_T*)(a), lda, (cx_T*)(w), (cx_T*)(vl), ldvl, (cx_T*)(vr), ldvr, ilo, ihi, (T*)(scale), (T*)(abnrm), (T*)(rconde), (T*)(rcondv), (cx_T*)(work), lwork, (T*)(rwork), info, 1, 1, 1, 1); } - #else - if( is_cx_float::value) { typedef float T; typedef blas_cxf cx_T; arma_fortran(arma_cgeevx)(balanc, jobvl, jobvr, sense, n, (cx_T*)(a), lda, (cx_T*)(w), (cx_T*)(vl), ldvl, (cx_T*)(vr), ldvr, ilo, ihi, (T*)(scale), (T*)(abnrm), (T*)(rconde), (T*)(rcondv), (cx_T*)(work), lwork, (T*)(rwork), info); } - else if(is_cx_double::value) { typedef double T; typedef blas_cxd cx_T; arma_fortran(arma_zgeevx)(balanc, jobvl, jobvr, sense, n, (cx_T*)(a), lda, (cx_T*)(w), (cx_T*)(vl), ldvl, (cx_T*)(vr), ldvr, ilo, ihi, (T*)(scale), (T*)(abnrm), (T*)(rconde), (T*)(rcondv), (cx_T*)(work), lwork, (T*)(rwork), info); } - #endif - } - - - - template - inline - void - syev(char* jobz, char* uplo, blas_int* n, eT* a, blas_int* lda, eT* w, eT* work, blas_int* lwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_ssyev)(jobz, uplo, n, (T*)a, lda, (T*)w, (T*)work, lwork, info, 1, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dsyev)(jobz, uplo, n, (T*)a, lda, (T*)w, (T*)work, lwork, info, 1, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_ssyev)(jobz, uplo, n, (T*)a, lda, (T*)w, (T*)work, lwork, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dsyev)(jobz, uplo, n, (T*)a, lda, (T*)w, (T*)work, lwork, info); } - #endif - } - - - - template - inline - void - heev - ( - char* jobz, char* uplo, blas_int* n, - eT* a, blas_int* lda, typename eT::value_type* w, - eT* work, blas_int* lwork, typename eT::value_type* rwork, - blas_int* info - ) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_cx_float::value) { typedef float T; typedef blas_cxf cx_T; arma_fortran(arma_cheev)(jobz, uplo, n, (cx_T*)a, lda, (T*)w, (cx_T*)work, lwork, (T*)rwork, info, 1, 1); } - else if(is_cx_double::value) { typedef double T; typedef blas_cxd cx_T; arma_fortran(arma_zheev)(jobz, uplo, n, (cx_T*)a, lda, (T*)w, (cx_T*)work, lwork, (T*)rwork, info, 1, 1); } - #else - if( is_cx_float::value) { typedef float T; typedef blas_cxf cx_T; arma_fortran(arma_cheev)(jobz, uplo, n, (cx_T*)a, lda, (T*)w, (cx_T*)work, lwork, (T*)rwork, info); } - else if(is_cx_double::value) { typedef double T; typedef blas_cxd cx_T; arma_fortran(arma_zheev)(jobz, uplo, n, (cx_T*)a, lda, (T*)w, (cx_T*)work, lwork, (T*)rwork, info); } - #endif - } - - - - template - inline - void - syevd(char* jobz, char* uplo, blas_int* n, eT* a, blas_int* lda, eT* w, eT* work, blas_int* lwork, blas_int* iwork, blas_int* liwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_ssyevd)(jobz, uplo, n, (T*)a, lda, (T*)w, (T*)work, lwork, iwork, liwork, info, 1, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dsyevd)(jobz, uplo, n, (T*)a, lda, (T*)w, (T*)work, lwork, iwork, liwork, info, 1, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_ssyevd)(jobz, uplo, n, (T*)a, lda, (T*)w, (T*)work, lwork, iwork, liwork, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dsyevd)(jobz, uplo, n, (T*)a, lda, (T*)w, (T*)work, lwork, iwork, liwork, info); } - #endif - } - - - - template - inline - void - heevd - ( - char* jobz, char* uplo, blas_int* n, - eT* a, blas_int* lda, typename eT::value_type* w, - eT* work, blas_int* lwork, typename eT::value_type* rwork, - blas_int* lrwork, blas_int* iwork, blas_int* liwork, - blas_int* info - ) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_cx_float::value) { typedef float T; typedef blas_cxf cx_T; arma_fortran(arma_cheevd)(jobz, uplo, n, (cx_T*)a, lda, (T*)w, (cx_T*)work, lwork, (T*)rwork, lrwork, iwork, liwork, info, 1, 1); } - else if(is_cx_double::value) { typedef double T; typedef blas_cxd cx_T; arma_fortran(arma_zheevd)(jobz, uplo, n, (cx_T*)a, lda, (T*)w, (cx_T*)work, lwork, (T*)rwork, lrwork, iwork, liwork, info, 1, 1); } - #else - if( is_cx_float::value) { typedef float T; typedef blas_cxf cx_T; arma_fortran(arma_cheevd)(jobz, uplo, n, (cx_T*)a, lda, (T*)w, (cx_T*)work, lwork, (T*)rwork, lrwork, iwork, liwork, info); } - else if(is_cx_double::value) { typedef double T; typedef blas_cxd cx_T; arma_fortran(arma_zheevd)(jobz, uplo, n, (cx_T*)a, lda, (T*)w, (cx_T*)work, lwork, (T*)rwork, lrwork, iwork, liwork, info); } - #endif - } - - - - template - inline - void - ggev - ( - char* jobvl, char* jobvr, blas_int* n, - eT* a, blas_int* lda, eT* b, blas_int* ldb, - eT* alphar, eT* alphai, eT* beta, - eT* vl, blas_int* ldvl, eT* vr, blas_int* ldvr, - eT* work, blas_int* lwork, - blas_int* info - ) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_sggev)(jobvl, jobvr, n, (T*)a, lda, (T*)b, ldb, (T*)alphar, (T*)alphai, (T*)beta, (T*)vl, ldvl, (T*)vr, ldvr, (T*)work, lwork, info, 1, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dggev)(jobvl, jobvr, n, (T*)a, lda, (T*)b, ldb, (T*)alphar, (T*)alphai, (T*)beta, (T*)vl, ldvl, (T*)vr, ldvr, (T*)work, lwork, info, 1, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_sggev)(jobvl, jobvr, n, (T*)a, lda, (T*)b, ldb, (T*)alphar, (T*)alphai, (T*)beta, (T*)vl, ldvl, (T*)vr, ldvr, (T*)work, lwork, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dggev)(jobvl, jobvr, n, (T*)a, lda, (T*)b, ldb, (T*)alphar, (T*)alphai, (T*)beta, (T*)vl, ldvl, (T*)vr, ldvr, (T*)work, lwork, info); } - #endif - } - - - - template - inline - void - cx_ggev - ( - char* jobvl, char* jobvr, blas_int* n, - eT* a, blas_int* lda, eT* b, blas_int* ldb, - eT* alpha, eT* beta, - eT* vl, blas_int* ldvl, eT* vr, blas_int* ldvr, - eT* work, blas_int* lwork, typename eT::value_type* rwork, - blas_int* info - ) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_cx_float::value) { typedef float T; typedef blas_cxf cx_T; arma_fortran(arma_cggev)(jobvl, jobvr, n, (cx_T*)a, lda, (cx_T*)b, ldb, (cx_T*)alpha, (cx_T*)beta, (cx_T*)vl, ldvl, (cx_T*)vr, ldvr, (cx_T*)work, lwork, (T*)rwork, info, 1, 1); } - else if(is_cx_double::value) { typedef double T; typedef blas_cxd cx_T; arma_fortran(arma_zggev)(jobvl, jobvr, n, (cx_T*)a, lda, (cx_T*)b, ldb, (cx_T*)alpha, (cx_T*)beta, (cx_T*)vl, ldvl, (cx_T*)vr, ldvr, (cx_T*)work, lwork, (T*)rwork, info, 1, 1); } - #else - if( is_cx_float::value) { typedef float T; typedef blas_cxf cx_T; arma_fortran(arma_cggev)(jobvl, jobvr, n, (cx_T*)a, lda, (cx_T*)b, ldb, (cx_T*)alpha, (cx_T*)beta, (cx_T*)vl, ldvl, (cx_T*)vr, ldvr, (cx_T*)work, lwork, (T*)rwork, info); } - else if(is_cx_double::value) { typedef double T; typedef blas_cxd cx_T; arma_fortran(arma_zggev)(jobvl, jobvr, n, (cx_T*)a, lda, (cx_T*)b, ldb, (cx_T*)alpha, (cx_T*)beta, (cx_T*)vl, ldvl, (cx_T*)vr, ldvr, (cx_T*)work, lwork, (T*)rwork, info); } - #endif - } - - - - template - inline - void - potrf(char* uplo, blas_int* n, eT* a, blas_int* lda, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_spotrf)(uplo, n, (T*)a, lda, info, 1); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dpotrf)(uplo, n, (T*)a, lda, info, 1); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cpotrf)(uplo, n, (T*)a, lda, info, 1); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zpotrf)(uplo, n, (T*)a, lda, info, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_spotrf)(uplo, n, (T*)a, lda, info); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dpotrf)(uplo, n, (T*)a, lda, info); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cpotrf)(uplo, n, (T*)a, lda, info); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zpotrf)(uplo, n, (T*)a, lda, info); } - #endif - } - - - - template - inline - void - potrs(char* uplo, blas_int* n, const blas_int* nrhs, eT* a, blas_int* lda, eT* b, blas_int* ldb, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_spotrs)(uplo, n, nrhs, (T*)a, lda, (T*)b, ldb, info, 1); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dpotrs)(uplo, n, nrhs, (T*)a, lda, (T*)b, ldb, info, 1); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cpotrs)(uplo, n, nrhs, (T*)a, lda, (T*)b, ldb, info, 1); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zpotrs)(uplo, n, nrhs, (T*)a, lda, (T*)b, ldb, info, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_spotrs)(uplo, n, nrhs, (T*)a, lda, (T*)b, ldb, info); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dpotrs)(uplo, n, nrhs, (T*)a, lda, (T*)b, ldb, info); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cpotrs)(uplo, n, nrhs, (T*)a, lda, (T*)b, ldb, info); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zpotrs)(uplo, n, nrhs, (T*)a, lda, (T*)b, ldb, info); } - #endif - } - - - - template - inline - void - pbtrf(char* uplo, blas_int* n, blas_int* kd, eT* ab, blas_int* ldab, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_spbtrf)(uplo, n, kd, (T*)ab, ldab, info, 1); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dpbtrf)(uplo, n, kd, (T*)ab, ldab, info, 1); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cpbtrf)(uplo, n, kd, (T*)ab, ldab, info, 1); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zpbtrf)(uplo, n, kd, (T*)ab, ldab, info, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_spbtrf)(uplo, n, kd, (T*)ab, ldab, info); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dpbtrf)(uplo, n, kd, (T*)ab, ldab, info); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cpbtrf)(uplo, n, kd, (T*)ab, ldab, info); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zpbtrf)(uplo, n, kd, (T*)ab, ldab, info); } - #endif - } - - - - template - inline - void - potri(char* uplo, blas_int* n, eT* a, blas_int* lda, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_spotri)(uplo, n, (T*)a, lda, info, 1); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dpotri)(uplo, n, (T*)a, lda, info, 1); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cpotri)(uplo, n, (T*)a, lda, info, 1); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zpotri)(uplo, n, (T*)a, lda, info, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_spotri)(uplo, n, (T*)a, lda, info); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dpotri)(uplo, n, (T*)a, lda, info); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cpotri)(uplo, n, (T*)a, lda, info); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zpotri)(uplo, n, (T*)a, lda, info); } - #endif - } - - - - template - inline - void - geqrf(blas_int* m, blas_int* n, eT* a, blas_int* lda, eT* tau, eT* work, blas_int* lwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - if( is_float::value) { typedef float T; arma_fortran(arma_sgeqrf)(m, n, (T*)a, lda, (T*)tau, (T*)work, lwork, info); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dgeqrf)(m, n, (T*)a, lda, (T*)tau, (T*)work, lwork, info); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cgeqrf)(m, n, (T*)a, lda, (T*)tau, (T*)work, lwork, info); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zgeqrf)(m, n, (T*)a, lda, (T*)tau, (T*)work, lwork, info); } - } - - - - template - inline - void - geqp3(blas_int* m, blas_int* n, eT* a, blas_int* lda, blas_int* jpvt, eT* tau, eT* work, blas_int* lwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - if( is_float::value) { typedef float T; arma_fortran(arma_sgeqp3)(m, n, (T*)a, lda, jpvt, (T*)tau, (T*)work, lwork, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgeqp3)(m, n, (T*)a, lda, jpvt, (T*)tau, (T*)work, lwork, info); } - } - - - - template - inline - void - cx_geqp3(blas_int* m, blas_int* n, eT* a, blas_int* lda, blas_int* jpvt, eT* tau, eT* work, blas_int* lwork, typename eT::value_type* rwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - if( is_cx_float::value) { typedef float T; typedef blas_cxf cx_T; arma_fortran(arma_cgeqp3)(m, n, (cx_T*)a, lda, jpvt, (cx_T*)tau, (cx_T*)work, lwork, (T*)rwork, info); } - else if(is_cx_double::value) { typedef double T; typedef blas_cxd cx_T; arma_fortran(arma_zgeqp3)(m, n, (cx_T*)a, lda, jpvt, (cx_T*)tau, (cx_T*)work, lwork, (T*)rwork, info); } - } - - - - template - inline - void - orgqr(blas_int* m, blas_int* n, blas_int* k, eT* a, blas_int* lda, eT* tau, eT* work, blas_int* lwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - if( is_float::value) { typedef float T; arma_fortran(arma_sorgqr)(m, n, k, (T*)a, lda, (T*)tau, (T*)work, lwork, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dorgqr)(m, n, k, (T*)a, lda, (T*)tau, (T*)work, lwork, info); } - } - - - - template - inline - void - ungqr(blas_int* m, blas_int* n, blas_int* k, eT* a, blas_int* lda, eT* tau, eT* work, blas_int* lwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cungqr)(m, n, k, (T*)a, lda, (T*)tau, (T*)work, lwork, info); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zungqr)(m, n, k, (T*)a, lda, (T*)tau, (T*)work, lwork, info); } - } - - - - template - inline - void - gesvd - ( - char* jobu, char* jobvt, blas_int* m, blas_int* n, eT* a, blas_int* lda, - eT* s, eT* u, blas_int* ldu, eT* vt, blas_int* ldvt, - eT* work, blas_int* lwork, blas_int* info - ) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_sgesvd)(jobu, jobvt, m, n, (T*)a, lda, (T*)s, (T*)u, ldu, (T*)vt, ldvt, (T*)work, lwork, info, 1, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgesvd)(jobu, jobvt, m, n, (T*)a, lda, (T*)s, (T*)u, ldu, (T*)vt, ldvt, (T*)work, lwork, info, 1, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_sgesvd)(jobu, jobvt, m, n, (T*)a, lda, (T*)s, (T*)u, ldu, (T*)vt, ldvt, (T*)work, lwork, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgesvd)(jobu, jobvt, m, n, (T*)a, lda, (T*)s, (T*)u, ldu, (T*)vt, ldvt, (T*)work, lwork, info); } - #endif - } - - - - template - inline - void - cx_gesvd - ( - char* jobu, char* jobvt, blas_int* m, blas_int* n, std::complex* a, blas_int* lda, - T* s, std::complex* u, blas_int* ldu, std::complex* vt, blas_int* ldvt, - std::complex* work, blas_int* lwork, T* rwork, blas_int* info - ) - { - arma_type_check(( is_supported_blas_type::value == false )); - arma_type_check(( is_supported_blas_type< std::complex >::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float bT; typedef blas_cxf cx_bT; arma_fortran(arma_cgesvd)(jobu, jobvt, m, n, (cx_bT*)a, lda, (bT*)s, (cx_bT*)u, ldu, (cx_bT*)vt, ldvt, (cx_bT*)work, lwork, (bT*)rwork, info, 1, 1); } - else if(is_double::value) { typedef double bT; typedef blas_cxd cx_bT; arma_fortran(arma_zgesvd)(jobu, jobvt, m, n, (cx_bT*)a, lda, (bT*)s, (cx_bT*)u, ldu, (cx_bT*)vt, ldvt, (cx_bT*)work, lwork, (bT*)rwork, info, 1, 1); } - #else - if( is_float::value) { typedef float bT; typedef blas_cxf cx_bT; arma_fortran(arma_cgesvd)(jobu, jobvt, m, n, (cx_bT*)a, lda, (bT*)s, (cx_bT*)u, ldu, (cx_bT*)vt, ldvt, (cx_bT*)work, lwork, (bT*)rwork, info); } - else if(is_double::value) { typedef double bT; typedef blas_cxd cx_bT; arma_fortran(arma_zgesvd)(jobu, jobvt, m, n, (cx_bT*)a, lda, (bT*)s, (cx_bT*)u, ldu, (cx_bT*)vt, ldvt, (cx_bT*)work, lwork, (bT*)rwork, info); } - #endif - } - - - - template - inline - void - gesdd - ( - char* jobz, blas_int* m, blas_int* n, - eT* a, blas_int* lda, eT* s, eT* u, blas_int* ldu, eT* vt, blas_int* ldvt, - eT* work, blas_int* lwork, blas_int* iwork, blas_int* info - ) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_sgesdd)(jobz, m, n, (T*)a, lda, (T*)s, (T*)u, ldu, (T*)vt, ldvt, (T*)work, lwork, iwork, info, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgesdd)(jobz, m, n, (T*)a, lda, (T*)s, (T*)u, ldu, (T*)vt, ldvt, (T*)work, lwork, iwork, info, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_sgesdd)(jobz, m, n, (T*)a, lda, (T*)s, (T*)u, ldu, (T*)vt, ldvt, (T*)work, lwork, iwork, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgesdd)(jobz, m, n, (T*)a, lda, (T*)s, (T*)u, ldu, (T*)vt, ldvt, (T*)work, lwork, iwork, info); } - #endif - } - - - - template - inline - void - cx_gesdd - ( - char* jobz, blas_int* m, blas_int* n, - std::complex* a, blas_int* lda, T* s, std::complex* u, blas_int* ldu, std::complex* vt, blas_int* ldvt, - std::complex* work, blas_int* lwork, T* rwork, blas_int* iwork, blas_int* info - ) - { - arma_type_check(( is_supported_blas_type::value == false )); - arma_type_check(( is_supported_blas_type< std::complex >::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float bT; typedef blas_cxf cx_bT; arma_fortran(arma_cgesdd)(jobz, m, n, (cx_bT*)a, lda, (bT*)s, (cx_bT*)u, ldu, (cx_bT*)vt, ldvt, (cx_bT*)work, lwork, (bT*)rwork, iwork, info, 1); } - else if(is_double::value) { typedef double bT; typedef blas_cxd cx_bT; arma_fortran(arma_zgesdd)(jobz, m, n, (cx_bT*)a, lda, (bT*)s, (cx_bT*)u, ldu, (cx_bT*)vt, ldvt, (cx_bT*)work, lwork, (bT*)rwork, iwork, info, 1); } - #else - if( is_float::value) { typedef float bT; typedef blas_cxf cx_bT; arma_fortran(arma_cgesdd)(jobz, m, n, (cx_bT*)a, lda, (bT*)s, (cx_bT*)u, ldu, (cx_bT*)vt, ldvt, (cx_bT*)work, lwork, (bT*)rwork, iwork, info); } - else if(is_double::value) { typedef double bT; typedef blas_cxd cx_bT; arma_fortran(arma_zgesdd)(jobz, m, n, (cx_bT*)a, lda, (bT*)s, (cx_bT*)u, ldu, (cx_bT*)vt, ldvt, (cx_bT*)work, lwork, (bT*)rwork, iwork, info); } - #endif - } - - - - template - inline - void - gesv(blas_int* n, blas_int* nrhs, eT* a, blas_int* lda, blas_int* ipiv, eT* b, blas_int* ldb, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - if( is_float::value) { typedef float T; arma_fortran(arma_sgesv)(n, nrhs, (T*)a, lda, ipiv, (T*)b, ldb, info); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dgesv)(n, nrhs, (T*)a, lda, ipiv, (T*)b, ldb, info); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cgesv)(n, nrhs, (T*)a, lda, ipiv, (T*)b, ldb, info); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zgesv)(n, nrhs, (T*)a, lda, ipiv, (T*)b, ldb, info); } - } - - - - template - inline - void - gesvx(char* fact, char* trans, blas_int* n, blas_int* nrhs, eT* a, blas_int* lda, eT* af, blas_int* ldaf, blas_int* ipiv, char* equed, eT* r, eT* c, eT* b, blas_int* ldb, eT* x, blas_int* ldx, eT* rcond, eT* ferr, eT* berr, eT* work, blas_int* iwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_sgesvx)(fact, trans, n, nrhs, (T*)a, lda, (T*)af, ldaf, ipiv, equed, (T*)r, (T*)c, (T*)b, ldb, (T*)x, ldx, (T*)rcond, (T*)ferr, (T*)berr, (T*)work, iwork, info, 1, 1, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgesvx)(fact, trans, n, nrhs, (T*)a, lda, (T*)af, ldaf, ipiv, equed, (T*)r, (T*)c, (T*)b, ldb, (T*)x, ldx, (T*)rcond, (T*)ferr, (T*)berr, (T*)work, iwork, info, 1, 1, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_sgesvx)(fact, trans, n, nrhs, (T*)a, lda, (T*)af, ldaf, ipiv, equed, (T*)r, (T*)c, (T*)b, ldb, (T*)x, ldx, (T*)rcond, (T*)ferr, (T*)berr, (T*)work, iwork, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgesvx)(fact, trans, n, nrhs, (T*)a, lda, (T*)af, ldaf, ipiv, equed, (T*)r, (T*)c, (T*)b, ldb, (T*)x, ldx, (T*)rcond, (T*)ferr, (T*)berr, (T*)work, iwork, info); } - #endif - } - - - - template - inline - void - cx_gesvx(char* fact, char* trans, blas_int* n, blas_int* nrhs, eT* a, blas_int* lda, eT* af, blas_int* ldaf, blas_int* ipiv, char* equed, T* r, T* c, eT* b, blas_int* ldb, eT* x, blas_int* ldx, T* rcond, T* ferr, T* berr, eT* work, T* rwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf cx_T; arma_fortran(arma_cgesvx)(fact, trans, n, nrhs, (cx_T*)a, lda, (cx_T*)af, ldaf, ipiv, equed, (pod_T*)r, (pod_T*)c, (cx_T*)b, ldb, (cx_T*)x, ldx, (pod_T*)rcond, (pod_T*)ferr, (pod_T*)berr, (cx_T*)work, (pod_T*)rwork, info, 1, 1, 1); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd cx_T; arma_fortran(arma_zgesvx)(fact, trans, n, nrhs, (cx_T*)a, lda, (cx_T*)af, ldaf, ipiv, equed, (pod_T*)r, (pod_T*)c, (cx_T*)b, ldb, (cx_T*)x, ldx, (pod_T*)rcond, (pod_T*)ferr, (pod_T*)berr, (cx_T*)work, (pod_T*)rwork, info, 1, 1, 1); } - #else - if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf cx_T; arma_fortran(arma_cgesvx)(fact, trans, n, nrhs, (cx_T*)a, lda, (cx_T*)af, ldaf, ipiv, equed, (pod_T*)r, (pod_T*)c, (cx_T*)b, ldb, (cx_T*)x, ldx, (pod_T*)rcond, (pod_T*)ferr, (pod_T*)berr, (cx_T*)work, (pod_T*)rwork, info); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd cx_T; arma_fortran(arma_zgesvx)(fact, trans, n, nrhs, (cx_T*)a, lda, (cx_T*)af, ldaf, ipiv, equed, (pod_T*)r, (pod_T*)c, (cx_T*)b, ldb, (cx_T*)x, ldx, (pod_T*)rcond, (pod_T*)ferr, (pod_T*)berr, (cx_T*)work, (pod_T*)rwork, info); } - #endif - } - - - - template - inline - void - posv(char* uplo, blas_int* n, blas_int* nrhs, eT* a, blas_int* lda, eT* b, blas_int* ldb, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_sposv)(uplo, n, nrhs, (T*)a, lda, (T*)b, ldb, info, 1); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dposv)(uplo, n, nrhs, (T*)a, lda, (T*)b, ldb, info, 1); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cposv)(uplo, n, nrhs, (T*)a, lda, (T*)b, ldb, info, 1); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zposv)(uplo, n, nrhs, (T*)a, lda, (T*)b, ldb, info, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_sposv)(uplo, n, nrhs, (T*)a, lda, (T*)b, ldb, info); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dposv)(uplo, n, nrhs, (T*)a, lda, (T*)b, ldb, info); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cposv)(uplo, n, nrhs, (T*)a, lda, (T*)b, ldb, info); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zposv)(uplo, n, nrhs, (T*)a, lda, (T*)b, ldb, info); } - #endif - } - - - - template - inline - void - posvx(char* fact, char* uplo, blas_int* n, blas_int* nrhs, eT* a, blas_int* lda, eT* af, blas_int* ldaf, char* equed, eT* s, eT* b, blas_int* ldb, eT* x, blas_int* ldx, eT* rcond, eT* ferr, eT* berr, eT* work, blas_int* iwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_sposvx)(fact, uplo, n, nrhs, (T*)a, lda, (T*)af, ldaf, equed, (T*)s, (T*)b, ldb, (T*)x, ldx, (T*)rcond, (T*)ferr, (T*)berr, (T*)work, iwork, info, 1, 1, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dposvx)(fact, uplo, n, nrhs, (T*)a, lda, (T*)af, ldaf, equed, (T*)s, (T*)b, ldb, (T*)x, ldx, (T*)rcond, (T*)ferr, (T*)berr, (T*)work, iwork, info, 1, 1, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_sposvx)(fact, uplo, n, nrhs, (T*)a, lda, (T*)af, ldaf, equed, (T*)s, (T*)b, ldb, (T*)x, ldx, (T*)rcond, (T*)ferr, (T*)berr, (T*)work, iwork, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dposvx)(fact, uplo, n, nrhs, (T*)a, lda, (T*)af, ldaf, equed, (T*)s, (T*)b, ldb, (T*)x, ldx, (T*)rcond, (T*)ferr, (T*)berr, (T*)work, iwork, info); } - #endif - } - - - - template - inline - void - cx_posvx(char* fact, char* uplo, blas_int* n, blas_int* nrhs, eT* a, blas_int* lda, eT* af, blas_int* ldaf, char* equed, T* s, eT* b, blas_int* ldb, eT* x, blas_int* ldx, T* rcond, T* ferr, T* berr, eT* work, T* rwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf cx_T; arma_fortran(arma_cposvx)(fact, uplo, n, nrhs, (cx_T*)a, lda, (cx_T*)af, ldaf, equed, (pod_T*)s, (cx_T*)b, ldb, (cx_T*)x, ldx, (pod_T*)rcond, (pod_T*)ferr, (pod_T*)berr, (cx_T*)work, (pod_T*)rwork, info, 1, 1, 1); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd cx_T; arma_fortran(arma_zposvx)(fact, uplo, n, nrhs, (cx_T*)a, lda, (cx_T*)af, ldaf, equed, (pod_T*)s, (cx_T*)b, ldb, (cx_T*)x, ldx, (pod_T*)rcond, (pod_T*)ferr, (pod_T*)berr, (cx_T*)work, (pod_T*)rwork, info, 1, 1, 1); } - #else - if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf cx_T; arma_fortran(arma_cposvx)(fact, uplo, n, nrhs, (cx_T*)a, lda, (cx_T*)af, ldaf, equed, (pod_T*)s, (cx_T*)b, ldb, (cx_T*)x, ldx, (pod_T*)rcond, (pod_T*)ferr, (pod_T*)berr, (cx_T*)work, (pod_T*)rwork, info); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd cx_T; arma_fortran(arma_zposvx)(fact, uplo, n, nrhs, (cx_T*)a, lda, (cx_T*)af, ldaf, equed, (pod_T*)s, (cx_T*)b, ldb, (cx_T*)x, ldx, (pod_T*)rcond, (pod_T*)ferr, (pod_T*)berr, (cx_T*)work, (pod_T*)rwork, info); } - #endif - } - - - - template - inline - void - gels(char* trans, blas_int* m, blas_int* n, blas_int* nrhs, eT* a, blas_int* lda, eT* b, blas_int* ldb, eT* work, blas_int* lwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_sgels)(trans, m, n, nrhs, (T*)a, lda, (T*)b, ldb, (T*)work, lwork, info, 1); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dgels)(trans, m, n, nrhs, (T*)a, lda, (T*)b, ldb, (T*)work, lwork, info, 1); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cgels)(trans, m, n, nrhs, (T*)a, lda, (T*)b, ldb, (T*)work, lwork, info, 1); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zgels)(trans, m, n, nrhs, (T*)a, lda, (T*)b, ldb, (T*)work, lwork, info, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_sgels)(trans, m, n, nrhs, (T*)a, lda, (T*)b, ldb, (T*)work, lwork, info); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dgels)(trans, m, n, nrhs, (T*)a, lda, (T*)b, ldb, (T*)work, lwork, info); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cgels)(trans, m, n, nrhs, (T*)a, lda, (T*)b, ldb, (T*)work, lwork, info); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zgels)(trans, m, n, nrhs, (T*)a, lda, (T*)b, ldb, (T*)work, lwork, info); } - #endif - } - - - - template - inline - void - gelsd(blas_int* m, blas_int* n, blas_int* nrhs, eT* a, blas_int* lda, eT* b, blas_int* ldb, eT* S, eT* rcond, blas_int* rank, eT* work, blas_int* lwork, blas_int* iwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - if( is_float::value) { typedef float T; arma_fortran(arma_sgelsd)(m, n, nrhs, (T*)a, lda, (T*)b, ldb, (T*)S, (T*)rcond, rank, (T*)work, lwork, iwork, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgelsd)(m, n, nrhs, (T*)a, lda, (T*)b, ldb, (T*)S, (T*)rcond, rank, (T*)work, lwork, iwork, info); } - } - - - - template - inline - void - cx_gelsd(blas_int* m, blas_int* n, blas_int* nrhs, std::complex* a, blas_int* lda, std::complex* b, blas_int* ldb, T* S, T* rcond, blas_int* rank, std::complex* work, blas_int* lwork, T* rwork, blas_int* iwork, blas_int* info) - { - typedef typename std::complex eT; - - arma_type_check(( is_supported_blas_type::value == false )); - - if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf cx_T; arma_fortran(arma_cgelsd)(m, n, nrhs, (cx_T*)a, lda, (cx_T*)b, ldb, (pod_T*)S, (pod_T*)rcond, rank, (cx_T*)work, lwork, (pod_T*)rwork, iwork, info); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd cx_T; arma_fortran(arma_zgelsd)(m, n, nrhs, (cx_T*)a, lda, (cx_T*)b, ldb, (pod_T*)S, (pod_T*)rcond, rank, (cx_T*)work, lwork, (pod_T*)rwork, iwork, info); } - } - - - - template - inline - void - trtrs(char* uplo, char* trans, char* diag, blas_int* n, blas_int* nrhs, const eT* a, blas_int* lda, eT* b, blas_int* ldb, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_strtrs)(uplo, trans, diag, n, nrhs, (T*)a, lda, (T*)b, ldb, info, 1, 1, 1); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dtrtrs)(uplo, trans, diag, n, nrhs, (T*)a, lda, (T*)b, ldb, info, 1, 1, 1); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_ctrtrs)(uplo, trans, diag, n, nrhs, (T*)a, lda, (T*)b, ldb, info, 1, 1, 1); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_ztrtrs)(uplo, trans, diag, n, nrhs, (T*)a, lda, (T*)b, ldb, info, 1, 1, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_strtrs)(uplo, trans, diag, n, nrhs, (T*)a, lda, (T*)b, ldb, info); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dtrtrs)(uplo, trans, diag, n, nrhs, (T*)a, lda, (T*)b, ldb, info); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_ctrtrs)(uplo, trans, diag, n, nrhs, (T*)a, lda, (T*)b, ldb, info); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_ztrtrs)(uplo, trans, diag, n, nrhs, (T*)a, lda, (T*)b, ldb, info); } - #endif - } - - - - template - inline - void - gbtrf(blas_int* m, blas_int* n, blas_int* kl, blas_int* ku, eT* ab, blas_int* ldab, blas_int* ipiv, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - if( is_float::value) { typedef float T; arma_fortran(arma_sgbtrf)(m, n, kl, ku, (T*)ab, ldab, ipiv, info); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dgbtrf)(m, n, kl, ku, (T*)ab, ldab, ipiv, info); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cgbtrf)(m, n, kl, ku, (T*)ab, ldab, ipiv, info); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zgbtrf)(m, n, kl, ku, (T*)ab, ldab, ipiv, info); } - } - - - - template - inline - void - gbtrs(char* trans, blas_int* n, blas_int* kl, blas_int* ku, blas_int* nrhs, eT* ab, blas_int* ldab, blas_int* ipiv, eT* b, blas_int* ldb, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_sgbtrs)(trans, n, kl, ku, nrhs, (T*)ab, ldab, ipiv, (T*)b, ldb, info, 1); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dgbtrs)(trans, n, kl, ku, nrhs, (T*)ab, ldab, ipiv, (T*)b, ldb, info, 1); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cgbtrs)(trans, n, kl, ku, nrhs, (T*)ab, ldab, ipiv, (T*)b, ldb, info, 1); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zgbtrs)(trans, n, kl, ku, nrhs, (T*)ab, ldab, ipiv, (T*)b, ldb, info, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_sgbtrs)(trans, n, kl, ku, nrhs, (T*)ab, ldab, ipiv, (T*)b, ldb, info); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dgbtrs)(trans, n, kl, ku, nrhs, (T*)ab, ldab, ipiv, (T*)b, ldb, info); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cgbtrs)(trans, n, kl, ku, nrhs, (T*)ab, ldab, ipiv, (T*)b, ldb, info); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zgbtrs)(trans, n, kl, ku, nrhs, (T*)ab, ldab, ipiv, (T*)b, ldb, info); } - #endif - } - - - - template - inline - void - gbsv(blas_int* n, blas_int* kl, blas_int* ku, blas_int* nrhs, eT* ab, blas_int* ldab, blas_int* ipiv, eT* b, blas_int* ldb, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - if( is_float::value) { typedef float T; arma_fortran(arma_sgbsv)(n, kl, ku, nrhs, (T*)ab, ldab, ipiv, (T*)b, ldb, info); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dgbsv)(n, kl, ku, nrhs, (T*)ab, ldab, ipiv, (T*)b, ldb, info); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cgbsv)(n, kl, ku, nrhs, (T*)ab, ldab, ipiv, (T*)b, ldb, info); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zgbsv)(n, kl, ku, nrhs, (T*)ab, ldab, ipiv, (T*)b, ldb, info); } - } - - - - template - inline - void - gbsvx(char* fact, char* trans, blas_int* n, blas_int* kl, blas_int* ku, blas_int* nrhs, eT* ab, blas_int* ldab, eT* afb, blas_int* ldafb, blas_int* ipiv, char* equed, eT* r, eT* c, eT* b, blas_int* ldb, eT* x, blas_int* ldx, eT* rcond, eT* ferr, eT* berr, eT* work, blas_int* iwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_sgbsvx)(fact, trans, n, kl, ku, nrhs, (T*)ab, ldab, (T*)afb, ldafb, ipiv, equed, (T*)r, (T*)c, (T*)b, ldb, (T*)x, ldx, (T*)rcond, (T*)ferr, (T*)berr, (T*)work, iwork, info, 1, 1, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgbsvx)(fact, trans, n, kl, ku, nrhs, (T*)ab, ldab, (T*)afb, ldafb, ipiv, equed, (T*)r, (T*)c, (T*)b, ldb, (T*)x, ldx, (T*)rcond, (T*)ferr, (T*)berr, (T*)work, iwork, info, 1, 1, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_sgbsvx)(fact, trans, n, kl, ku, nrhs, (T*)ab, ldab, (T*)afb, ldafb, ipiv, equed, (T*)r, (T*)c, (T*)b, ldb, (T*)x, ldx, (T*)rcond, (T*)ferr, (T*)berr, (T*)work, iwork, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgbsvx)(fact, trans, n, kl, ku, nrhs, (T*)ab, ldab, (T*)afb, ldafb, ipiv, equed, (T*)r, (T*)c, (T*)b, ldb, (T*)x, ldx, (T*)rcond, (T*)ferr, (T*)berr, (T*)work, iwork, info); } - #endif - } - - - - template - inline - void - cx_gbsvx(char* fact, char* trans, blas_int* n, blas_int* kl, blas_int* ku, blas_int* nrhs, eT* ab, blas_int* ldab, eT* afb, blas_int* ldafb, blas_int* ipiv, char* equed, T* r, T* c, eT* b, blas_int* ldb, eT* x, blas_int* ldx, T* rcond, T* ferr, T* berr, eT* work, T* rwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf cx_T; arma_fortran(arma_cgbsvx)(fact, trans, n, kl, ku, nrhs, (cx_T*)ab, ldab, (cx_T*)afb, ldafb, ipiv, equed, (pod_T*)r, (pod_T*)c, (cx_T*)b, ldb, (cx_T*)x, ldx, (pod_T*)rcond, (pod_T*)ferr, (pod_T*)berr, (cx_T*)work, (pod_T*)rwork, info, 1, 1, 1); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd cx_T; arma_fortran(arma_zgbsvx)(fact, trans, n, kl, ku, nrhs, (cx_T*)ab, ldab, (cx_T*)afb, ldafb, ipiv, equed, (pod_T*)r, (pod_T*)c, (cx_T*)b, ldb, (cx_T*)x, ldx, (pod_T*)rcond, (pod_T*)ferr, (pod_T*)berr, (cx_T*)work, (pod_T*)rwork, info, 1, 1, 1); } - #else - if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf cx_T; arma_fortran(arma_cgbsvx)(fact, trans, n, kl, ku, nrhs, (cx_T*)ab, ldab, (cx_T*)afb, ldafb, ipiv, equed, (pod_T*)r, (pod_T*)c, (cx_T*)b, ldb, (cx_T*)x, ldx, (pod_T*)rcond, (pod_T*)ferr, (pod_T*)berr, (cx_T*)work, (pod_T*)rwork, info); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd cx_T; arma_fortran(arma_zgbsvx)(fact, trans, n, kl, ku, nrhs, (cx_T*)ab, ldab, (cx_T*)afb, ldafb, ipiv, equed, (pod_T*)r, (pod_T*)c, (cx_T*)b, ldb, (cx_T*)x, ldx, (pod_T*)rcond, (pod_T*)ferr, (pod_T*)berr, (cx_T*)work, (pod_T*)rwork, info); } - #endif - } - - - - template - inline - void - gtsv(blas_int* n, blas_int* nrhs, eT* dl, eT* d, eT* du, eT* b, blas_int* ldb, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - if( is_float::value) { typedef float T; arma_fortran(arma_sgtsv)(n, nrhs, (T*)dl, (T*)d, (T*)du, (T*)b, ldb, info); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dgtsv)(n, nrhs, (T*)dl, (T*)d, (T*)du, (T*)b, ldb, info); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cgtsv)(n, nrhs, (T*)dl, (T*)d, (T*)du, (T*)b, ldb, info); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zgtsv)(n, nrhs, (T*)dl, (T*)d, (T*)du, (T*)b, ldb, info); } - } - - - - template - inline - void - gtsvx(char* fact, char* trans, blas_int* n, blas_int* nrhs, eT* dl, eT* d, eT* du, eT* dlf, eT* df, eT* duf, eT* du2, blas_int* ipiv, eT* b, blas_int* ldb, eT* x, blas_int* ldx, eT* rcond, eT* ferr, eT* berr, eT* work, blas_int* iwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_sgtsvx)(fact, trans, n, nrhs, (T*)dl, (T*)d, (T*)du, (T*)dlf, (T*)df, (T*)duf, (T*)du2, ipiv, (T*)b, ldb, (T*)x, ldx, (T*)rcond, (T*)ferr, (T*)berr, (T*)work, iwork, info, 1, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgtsvx)(fact, trans, n, nrhs, (T*)dl, (T*)d, (T*)du, (T*)dlf, (T*)df, (T*)duf, (T*)du2, ipiv, (T*)b, ldb, (T*)x, ldx, (T*)rcond, (T*)ferr, (T*)berr, (T*)work, iwork, info, 1, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_sgtsvx)(fact, trans, n, nrhs, (T*)dl, (T*)d, (T*)du, (T*)dlf, (T*)df, (T*)duf, (T*)du2, ipiv, (T*)b, ldb, (T*)x, ldx, (T*)rcond, (T*)ferr, (T*)berr, (T*)work, iwork, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgtsvx)(fact, trans, n, nrhs, (T*)dl, (T*)d, (T*)du, (T*)dlf, (T*)df, (T*)duf, (T*)du2, ipiv, (T*)b, ldb, (T*)x, ldx, (T*)rcond, (T*)ferr, (T*)berr, (T*)work, iwork, info); } - #endif - } - - - - template - inline - void - cx_gtsvx(char* fact, char* trans, blas_int* n, blas_int* nrhs, eT* dl, eT* d, eT* du, eT* dlf, eT* df, eT* duf, eT* du2, blas_int* ipiv, eT* b, blas_int* ldb, eT* x, blas_int* ldx, T* rcond, T* ferr, T* berr, eT* work, T* rwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf cx_T; arma_fortran(arma_cgtsvx)(fact, trans, n, nrhs, (cx_T*)dl, (cx_T*)d, (cx_T*)du, (cx_T*)dlf, (cx_T*)df, (cx_T*)duf, (cx_T*)du2, ipiv, (cx_T*)b, ldb, (cx_T*)x, ldx, (pod_T*)rcond, (pod_T*)ferr, (pod_T*)berr, (cx_T*)work, (pod_T*)rwork, info, 1, 1); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd cx_T; arma_fortran(arma_zgtsvx)(fact, trans, n, nrhs, (cx_T*)dl, (cx_T*)d, (cx_T*)du, (cx_T*)dlf, (cx_T*)df, (cx_T*)duf, (cx_T*)du2, ipiv, (cx_T*)b, ldb, (cx_T*)x, ldx, (pod_T*)rcond, (pod_T*)ferr, (pod_T*)berr, (cx_T*)work, (pod_T*)rwork, info, 1, 1); } - #else - if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf cx_T; arma_fortran(arma_cgtsvx)(fact, trans, n, nrhs, (cx_T*)dl, (cx_T*)d, (cx_T*)du, (cx_T*)dlf, (cx_T*)df, (cx_T*)duf, (cx_T*)du2, ipiv, (cx_T*)b, ldb, (cx_T*)x, ldx, (pod_T*)rcond, (pod_T*)ferr, (pod_T*)berr, (cx_T*)work, (pod_T*)rwork, info); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd cx_T; arma_fortran(arma_zgtsvx)(fact, trans, n, nrhs, (cx_T*)dl, (cx_T*)d, (cx_T*)du, (cx_T*)dlf, (cx_T*)df, (cx_T*)duf, (cx_T*)du2, ipiv, (cx_T*)b, ldb, (cx_T*)x, ldx, (pod_T*)rcond, (pod_T*)ferr, (pod_T*)berr, (cx_T*)work, (pod_T*)rwork, info); } - #endif - } - - - - template - inline - void - gees(char* jobvs, char* sort, void* select, blas_int* n, eT* a, blas_int* lda, blas_int* sdim, eT* wr, eT* wi, eT* vs, blas_int* ldvs, eT* work, blas_int* lwork, blas_int* bwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_sgees)(jobvs, sort, (fn_select_s2)select, n, (T*)a, lda, sdim, (T*)wr, (T*)wi, (T*)vs, ldvs, (T*)work, lwork, bwork, info, 1, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgees)(jobvs, sort, (fn_select_d2)select, n, (T*)a, lda, sdim, (T*)wr, (T*)wi, (T*)vs, ldvs, (T*)work, lwork, bwork, info, 1, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_sgees)(jobvs, sort, (fn_select_s2)select, n, (T*)a, lda, sdim, (T*)wr, (T*)wi, (T*)vs, ldvs, (T*)work, lwork, bwork, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgees)(jobvs, sort, (fn_select_d2)select, n, (T*)a, lda, sdim, (T*)wr, (T*)wi, (T*)vs, ldvs, (T*)work, lwork, bwork, info); } - #endif - } - - - - template - inline - void - cx_gees(char* jobvs, char* sort, void* select, blas_int* n, std::complex* a, blas_int* lda, blas_int* sdim, std::complex* w, std::complex* vs, blas_int* ldvs, std::complex* work, blas_int* lwork, T* rwork, blas_int* bwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - arma_type_check(( is_supported_blas_type< std::complex >::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float bT; typedef blas_cxf cT; arma_fortran(arma_cgees)(jobvs, sort, (fn_select_c1)select, n, (cT*)a, lda, sdim, (cT*)w, (cT*)vs, ldvs, (cT*)work, lwork, (bT*)rwork, bwork, info, 1, 1); } - else if(is_double::value) { typedef double bT; typedef blas_cxd cT; arma_fortran(arma_zgees)(jobvs, sort, (fn_select_z1)select, n, (cT*)a, lda, sdim, (cT*)w, (cT*)vs, ldvs, (cT*)work, lwork, (bT*)rwork, bwork, info, 1, 1); } - #else - if( is_float::value) { typedef float bT; typedef blas_cxf cT; arma_fortran(arma_cgees)(jobvs, sort, (fn_select_c1)select, n, (cT*)a, lda, sdim, (cT*)w, (cT*)vs, ldvs, (cT*)work, lwork, (bT*)rwork, bwork, info); } - else if(is_double::value) { typedef double bT; typedef blas_cxd cT; arma_fortran(arma_zgees)(jobvs, sort, (fn_select_z1)select, n, (cT*)a, lda, sdim, (cT*)w, (cT*)vs, ldvs, (cT*)work, lwork, (bT*)rwork, bwork, info); } - #endif - } - - - - template - inline - void - trsyl(char* transa, char* transb, blas_int* isgn, blas_int* m, blas_int* n, const eT* a, blas_int* lda, const eT* b, blas_int* ldb, eT* c, blas_int* ldc, eT* scale, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_strsyl)(transa, transb, isgn, m, n, (T*)a, lda, (T*)b, ldb, (T*)c, ldc, (T*)scale, info, 1, 1); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dtrsyl)(transa, transb, isgn, m, n, (T*)a, lda, (T*)b, ldb, (T*)c, ldc, (T*)scale, info, 1, 1); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_ctrsyl)(transa, transb, isgn, m, n, (T*)a, lda, (T*)b, ldb, (T*)c, ldc, (float*)scale, info, 1, 1); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_ztrsyl)(transa, transb, isgn, m, n, (T*)a, lda, (T*)b, ldb, (T*)c, ldc, (double*)scale, info, 1, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_strsyl)(transa, transb, isgn, m, n, (T*)a, lda, (T*)b, ldb, (T*)c, ldc, (T*)scale, info); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dtrsyl)(transa, transb, isgn, m, n, (T*)a, lda, (T*)b, ldb, (T*)c, ldc, (T*)scale, info); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_ctrsyl)(transa, transb, isgn, m, n, (T*)a, lda, (T*)b, ldb, (T*)c, ldc, (float*)scale, info); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_ztrsyl)(transa, transb, isgn, m, n, (T*)a, lda, (T*)b, ldb, (T*)c, ldc, (double*)scale, info); } - #endif - } - - - - template - inline - void - gges - ( - char* jobvsl, char* jobvsr, char* sort, void* selctg, blas_int* n, - eT* a, blas_int* lda, eT* b, blas_int* ldb, blas_int* sdim, - eT* alphar, eT* alphai, eT* beta, - eT* vsl, blas_int* ldvsl, eT* vsr, blas_int* ldvsr, - eT* work, blas_int* lwork, - blas_int* bwork, - blas_int* info - ) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_sgges)(jobvsl, jobvsr, sort, (fn_select_s3)selctg, n, (T*)a, lda, (T*)b, ldb, sdim, (T*)alphar, (T*)alphai, (T*)beta, (T*)vsl, ldvsl, (T*)vsr, ldvsr, (T*)work, lwork, bwork, info, 1, 1, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgges)(jobvsl, jobvsr, sort, (fn_select_d3)selctg, n, (T*)a, lda, (T*)b, ldb, sdim, (T*)alphar, (T*)alphai, (T*)beta, (T*)vsl, ldvsl, (T*)vsr, ldvsr, (T*)work, lwork, bwork, info, 1, 1, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_sgges)(jobvsl, jobvsr, sort, (fn_select_s3)selctg, n, (T*)a, lda, (T*)b, ldb, sdim, (T*)alphar, (T*)alphai, (T*)beta, (T*)vsl, ldvsl, (T*)vsr, ldvsr, (T*)work, lwork, bwork, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgges)(jobvsl, jobvsr, sort, (fn_select_d3)selctg, n, (T*)a, lda, (T*)b, ldb, sdim, (T*)alphar, (T*)alphai, (T*)beta, (T*)vsl, ldvsl, (T*)vsr, ldvsr, (T*)work, lwork, bwork, info); } - #endif - } - - - - template - inline - void - cx_gges - ( - char* jobvsl, char* jobvsr, char* sort, void* selctg, blas_int* n, - eT* a, blas_int* lda, eT* b, blas_int* ldb, blas_int* sdim, - eT* alpha, eT* beta, - eT* vsl, blas_int* ldvsl, eT* vsr, blas_int* ldvsr, - eT* work, blas_int* lwork, typename eT::value_type* rwork, - blas_int* bwork, - blas_int* info - ) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_cx_float::value) { typedef float T; typedef blas_cxf cx_T; arma_fortran(arma_cgges)(jobvsl, jobvsr, sort, (fn_select_c2)selctg, n, (cx_T*)a, lda, (cx_T*)b, ldb, sdim, (cx_T*)alpha, (cx_T*)beta, (cx_T*)vsl, ldvsl, (cx_T*)vsr, ldvsr, (cx_T*)work, lwork, (T*)rwork, bwork, info, 1, 1, 1); } - else if(is_cx_double::value) { typedef double T; typedef blas_cxd cx_T; arma_fortran(arma_zgges)(jobvsl, jobvsr, sort, (fn_select_z2)selctg, n, (cx_T*)a, lda, (cx_T*)b, ldb, sdim, (cx_T*)alpha, (cx_T*)beta, (cx_T*)vsl, ldvsl, (cx_T*)vsr, ldvsr, (cx_T*)work, lwork, (T*)rwork, bwork, info, 1, 1, 1); } - #else - if( is_cx_float::value) { typedef float T; typedef blas_cxf cx_T; arma_fortran(arma_cgges)(jobvsl, jobvsr, sort, (fn_select_c2)selctg, n, (cx_T*)a, lda, (cx_T*)b, ldb, sdim, (cx_T*)alpha, (cx_T*)beta, (cx_T*)vsl, ldvsl, (cx_T*)vsr, ldvsr, (cx_T*)work, lwork, (T*)rwork, bwork, info); } - else if(is_cx_double::value) { typedef double T; typedef blas_cxd cx_T; arma_fortran(arma_zgges)(jobvsl, jobvsr, sort, (fn_select_z2)selctg, n, (cx_T*)a, lda, (cx_T*)b, ldb, sdim, (cx_T*)alpha, (cx_T*)beta, (cx_T*)vsl, ldvsl, (cx_T*)vsr, ldvsr, (cx_T*)work, lwork, (T*)rwork, bwork, info); } - #endif - } - - - - template - inline - typename get_pod_type::result - lange(char* norm, blas_int* m, blas_int* n, eT* a, blas_int* lda, typename get_pod_type::result* work) - { - arma_type_check(( is_supported_blas_type::value == false )); - - typedef typename get_pod_type::result out_T; - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float pod_T; typedef float T; return out_T( arma_fortran(arma_slange)(norm, m, n, (T*)a, lda, (pod_T*)work, 1) ); } - else if( is_double::value) { typedef double pod_T; typedef double T; return out_T( arma_fortran(arma_dlange)(norm, m, n, (T*)a, lda, (pod_T*)work, 1) ); } - else if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf T; return out_T( arma_fortran(arma_clange)(norm, m, n, (T*)a, lda, (pod_T*)work, 1) ); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd T; return out_T( arma_fortran(arma_zlange)(norm, m, n, (T*)a, lda, (pod_T*)work, 1) ); } - #else - if( is_float::value) { typedef float pod_T; typedef float T; return out_T( arma_fortran(arma_slange)(norm, m, n, (T*)a, lda, (pod_T*)work) ); } - else if( is_double::value) { typedef double pod_T; typedef double T; return out_T( arma_fortran(arma_dlange)(norm, m, n, (T*)a, lda, (pod_T*)work) ); } - else if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf T; return out_T( arma_fortran(arma_clange)(norm, m, n, (T*)a, lda, (pod_T*)work) ); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd T; return out_T( arma_fortran(arma_zlange)(norm, m, n, (T*)a, lda, (pod_T*)work) ); } - #endif - - return out_T(0); - } - - - - template - inline - typename get_pod_type::result - lansy(char* norm, char* uplo, blas_int* n, eT* a, blas_int* lda, typename get_pod_type::result* work) - { - arma_type_check(( is_supported_blas_type::value == false )); - - typedef typename get_pod_type::result out_T; - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float pod_T; typedef float T; return out_T( arma_fortran(arma_slansy)(norm, uplo, n, (T*)a, lda, (pod_T*)work, 1, 1) ); } - else if( is_double::value) { typedef double pod_T; typedef double T; return out_T( arma_fortran(arma_dlansy)(norm, uplo, n, (T*)a, lda, (pod_T*)work, 1, 1) ); } - else if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf T; return out_T( arma_fortran(arma_clansy)(norm, uplo, n, (T*)a, lda, (pod_T*)work, 1, 1) ); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd T; return out_T( arma_fortran(arma_zlansy)(norm, uplo, n, (T*)a, lda, (pod_T*)work, 1, 1) ); } - #else - if( is_float::value) { typedef float pod_T; typedef float T; return out_T( arma_fortran(arma_slansy)(norm, uplo, n, (T*)a, lda, (pod_T*)work) ); } - else if( is_double::value) { typedef double pod_T; typedef double T; return out_T( arma_fortran(arma_dlansy)(norm, uplo, n, (T*)a, lda, (pod_T*)work) ); } - else if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf T; return out_T( arma_fortran(arma_clansy)(norm, uplo, n, (T*)a, lda, (pod_T*)work) ); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd T; return out_T( arma_fortran(arma_zlansy)(norm, uplo, n, (T*)a, lda, (pod_T*)work) ); } - #endif - - return out_T(0); - } - - - - template - inline - typename get_pod_type::result - lanhe(char* norm, char* uplo, blas_int* n, eT* a, blas_int* lda, typename get_pod_type::result* work) - { - arma_type_check(( is_supported_blas_type::value == false )); - - typedef typename get_pod_type::result out_T; - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf T; return out_T( arma_fortran(arma_clanhe)(norm, uplo, n, (T*)a, lda, (pod_T*)work, 1, 1) ); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd T; return out_T( arma_fortran(arma_zlanhe)(norm, uplo, n, (T*)a, lda, (pod_T*)work, 1, 1) ); } - #else - if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf T; return out_T( arma_fortran(arma_clanhe)(norm, uplo, n, (T*)a, lda, (pod_T*)work) ); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd T; return out_T( arma_fortran(arma_zlanhe)(norm, uplo, n, (T*)a, lda, (pod_T*)work) ); } - #endif - - return out_T(0); - } - - - - template - inline - typename get_pod_type::result - langb(char* norm, blas_int* n, blas_int* kl, blas_int* ku, eT* ab, blas_int* ldab, typename get_pod_type::result* work) - { - arma_type_check(( is_supported_blas_type::value == false )); - - typedef typename get_pod_type::result out_T; - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float pod_T; typedef float T; return out_T( arma_fortran(arma_slangb)(norm, n, kl, ku, (T*)ab, ldab, (pod_T*)work, 1) ); } - else if( is_double::value) { typedef double pod_T; typedef double T; return out_T( arma_fortran(arma_dlangb)(norm, n, kl, ku, (T*)ab, ldab, (pod_T*)work, 1) ); } - else if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf T; return out_T( arma_fortran(arma_clangb)(norm, n, kl, ku, (T*)ab, ldab, (pod_T*)work, 1) ); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd T; return out_T( arma_fortran(arma_zlangb)(norm, n, kl, ku, (T*)ab, ldab, (pod_T*)work, 1) ); } - #else - if( is_float::value) { typedef float pod_T; typedef float T; return out_T( arma_fortran(arma_slangb)(norm, n, kl, ku, (T*)ab, ldab, (pod_T*)work) ); } - else if( is_double::value) { typedef double pod_T; typedef double T; return out_T( arma_fortran(arma_dlangb)(norm, n, kl, ku, (T*)ab, ldab, (pod_T*)work) ); } - else if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf T; return out_T( arma_fortran(arma_clangb)(norm, n, kl, ku, (T*)ab, ldab, (pod_T*)work) ); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd T; return out_T( arma_fortran(arma_zlangb)(norm, n, kl, ku, (T*)ab, ldab, (pod_T*)work) ); } - #endif - - return out_T(0); - } - - - - template - inline - void - gecon(char* norm, blas_int* n, const eT* a, blas_int* lda, const eT* anorm, eT* rcond, eT* work, blas_int* iwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_sgecon)(norm, n, (T*)a, lda, (T*)anorm, (T*)rcond, (T*)work, iwork, info, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgecon)(norm, n, (T*)a, lda, (T*)anorm, (T*)rcond, (T*)work, iwork, info, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_sgecon)(norm, n, (T*)a, lda, (T*)anorm, (T*)rcond, (T*)work, iwork, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgecon)(norm, n, (T*)a, lda, (T*)anorm, (T*)rcond, (T*)work, iwork, info); } - #endif - } - - - - template - inline - void - cx_gecon(char* norm, blas_int* n, const std::complex* a, blas_int* lda, const T* anorm, T* rcond, std::complex* work, T* rwork, blas_int* info) - { - typedef typename std::complex eT; - - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf cx_T; arma_fortran(arma_cgecon)(norm, n, (cx_T*)a, lda, (pod_T*)anorm, (pod_T*)rcond, (cx_T*)work, (pod_T*)rwork, info, 1); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd cx_T; arma_fortran(arma_zgecon)(norm, n, (cx_T*)a, lda, (pod_T*)anorm, (pod_T*)rcond, (cx_T*)work, (pod_T*)rwork, info, 1); } - #else - if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf cx_T; arma_fortran(arma_cgecon)(norm, n, (cx_T*)a, lda, (pod_T*)anorm, (pod_T*)rcond, (cx_T*)work, (pod_T*)rwork, info); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd cx_T; arma_fortran(arma_zgecon)(norm, n, (cx_T*)a, lda, (pod_T*)anorm, (pod_T*)rcond, (cx_T*)work, (pod_T*)rwork, info); } - #endif - } - - - - template - inline - void - pocon(char* uplo, blas_int* n, const eT* a, blas_int* lda, const eT* anorm, eT* rcond, eT* work, blas_int* iwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_spocon)(uplo, n, (T*)a, lda, (T*)anorm, (T*)rcond, (T*)work, iwork, info, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dpocon)(uplo, n, (T*)a, lda, (T*)anorm, (T*)rcond, (T*)work, iwork, info, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_spocon)(uplo, n, (T*)a, lda, (T*)anorm, (T*)rcond, (T*)work, iwork, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dpocon)(uplo, n, (T*)a, lda, (T*)anorm, (T*)rcond, (T*)work, iwork, info); } - #endif - } - - - - template - inline - void - cx_pocon(char* uplo, blas_int* n, const std::complex* a, blas_int* lda, const T* anorm, T* rcond, std::complex* work, T* rwork, blas_int* info) - { - typedef typename std::complex eT; - - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf cx_T; arma_fortran(arma_cpocon)(uplo, n, (cx_T*)a, lda, (pod_T*)anorm, (pod_T*)rcond, (cx_T*)work, (pod_T*)rwork, info, 1); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd cx_T; arma_fortran(arma_zpocon)(uplo, n, (cx_T*)a, lda, (pod_T*)anorm, (pod_T*)rcond, (cx_T*)work, (pod_T*)rwork, info, 1); } - #else - if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf cx_T; arma_fortran(arma_cpocon)(uplo, n, (cx_T*)a, lda, (pod_T*)anorm, (pod_T*)rcond, (cx_T*)work, (pod_T*)rwork, info); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd cx_T; arma_fortran(arma_zpocon)(uplo, n, (cx_T*)a, lda, (pod_T*)anorm, (pod_T*)rcond, (cx_T*)work, (pod_T*)rwork, info); } - #endif - } - - - - template - inline - void - trcon(char* norm, char* uplo, char* diag, blas_int* n, const eT* a, blas_int* lda, eT* rcond, eT* work, blas_int* iwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_strcon)(norm, uplo, diag, n, (T*)a, lda, (T*)rcond, (T*)work, iwork, info, 1, 1, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dtrcon)(norm, uplo, diag, n, (T*)a, lda, (T*)rcond, (T*)work, iwork, info, 1, 1, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_strcon)(norm, uplo, diag, n, (T*)a, lda, (T*)rcond, (T*)work, iwork, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dtrcon)(norm, uplo, diag, n, (T*)a, lda, (T*)rcond, (T*)work, iwork, info); } - #endif - } - - - - template - inline - void - cx_trcon(char* norm, char* uplo, char* diag, blas_int* n, const std::complex* a, blas_int* lda, T* rcond, std::complex* work, T* rwork, blas_int* info) - { - typedef typename std::complex eT; - - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf cx_T; arma_fortran(arma_ctrcon)(norm, uplo, diag, n, (cx_T*)a, lda, (pod_T*)rcond, (cx_T*)work, (pod_T*)rwork, info, 1, 1, 1); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd cx_T; arma_fortran(arma_ztrcon)(norm, uplo, diag, n, (cx_T*)a, lda, (pod_T*)rcond, (cx_T*)work, (pod_T*)rwork, info, 1, 1, 1); } - #else - if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf cx_T; arma_fortran(arma_ctrcon)(norm, uplo, diag, n, (cx_T*)a, lda, (pod_T*)rcond, (cx_T*)work, (pod_T*)rwork, info); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd cx_T; arma_fortran(arma_ztrcon)(norm, uplo, diag, n, (cx_T*)a, lda, (pod_T*)rcond, (cx_T*)work, (pod_T*)rwork, info); } - #endif - } - - - - template - inline - void - gbcon(char* norm, blas_int* n, blas_int* kl, blas_int* ku, const eT* ab, blas_int* ldab, const blas_int* ipiv, const eT* anorm, eT* rcond, eT* work, blas_int* iwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_sgbcon)(norm, n, kl, ku, (T*)ab, ldab, ipiv, (T*)anorm, (T*)rcond, (T*)work, iwork, info, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgbcon)(norm, n, kl, ku, (T*)ab, ldab, ipiv, (T*)anorm, (T*)rcond, (T*)work, iwork, info, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_sgbcon)(norm, n, kl, ku, (T*)ab, ldab, ipiv, (T*)anorm, (T*)rcond, (T*)work, iwork, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dgbcon)(norm, n, kl, ku, (T*)ab, ldab, ipiv, (T*)anorm, (T*)rcond, (T*)work, iwork, info); } - #endif - } - - - - template - inline - void - cx_gbcon(char* norm, blas_int* n, blas_int* kl, blas_int* ku, const std::complex* ab, blas_int* ldab, const blas_int* ipiv, const T* anorm, T* rcond, std::complex* work, T* rwork, blas_int* info) - { - typedef typename std::complex eT; - - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf cx_T; arma_fortran(arma_cgbcon)(norm, n, kl, ku, (cx_T*)ab, ldab, ipiv, (pod_T*)anorm, (pod_T*)rcond, (cx_T*)work, (pod_T*)rwork, info, 1); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd cx_T; arma_fortran(arma_zgbcon)(norm, n, kl, ku, (cx_T*)ab, ldab, ipiv, (pod_T*)anorm, (pod_T*)rcond, (cx_T*)work, (pod_T*)rwork, info, 1); } - #else - if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf cx_T; arma_fortran(arma_cgbcon)(norm, n, kl, ku, (cx_T*)ab, ldab, ipiv, (pod_T*)anorm, (pod_T*)rcond, (cx_T*)work, (pod_T*)rwork, info); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd cx_T; arma_fortran(arma_zgbcon)(norm, n, kl, ku, (cx_T*)ab, ldab, ipiv, (pod_T*)anorm, (pod_T*)rcond, (cx_T*)work, (pod_T*)rwork, info); } - #endif - } - - - - inline - blas_int - laenv(blas_int* ispec, char* name, char* opts, blas_int* n1, blas_int* n2, blas_int* n3, blas_int* n4, blas_len name_len, blas_len opts_len) - { - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - return arma_fortran(arma_ilaenv)(ispec, name, opts, n1, n2, n3, n4, name_len, opts_len); - #else - arma_ignore(name_len); - arma_ignore(opts_len); - return arma_fortran(arma_ilaenv)(ispec, name, opts, n1, n2, n3, n4); // not advised! - #endif - } - - - - template - inline - void - lahqr(blas_int* wantt, blas_int* wantz, blas_int* n, blas_int* ilo, blas_int* ihi, eT* h, blas_int* ldh, eT* wr, eT* wi, blas_int* iloz, blas_int* ihiz, eT* z, blas_int* ldz, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - if( is_float::value) { typedef float T; arma_fortran(arma_slahqr)(wantt, wantz, n, ilo, ihi, (T*)h, ldh, (T*)wr, (T*)wi, iloz, ihiz, (T*)z, ldz, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dlahqr)(wantt, wantz, n, ilo, ihi, (T*)h, ldh, (T*)wr, (T*)wi, iloz, ihiz, (T*)z, ldz, info); } - } - - - - template - inline - void - stedc(char* compz, blas_int* n, eT* d, eT* e, eT* z, blas_int* ldz, eT* work, blas_int* lwork, blas_int* iwork, blas_int* liwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_sstedc)(compz, n, (T*)d, (T*)e, (T*)z, ldz, (T*)work, lwork, iwork, liwork, info, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dstedc)(compz, n, (T*)d, (T*)e, (T*)z, ldz, (T*)work, lwork, iwork, liwork, info, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_sstedc)(compz, n, (T*)d, (T*)e, (T*)z, ldz, (T*)work, lwork, iwork, liwork, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dstedc)(compz, n, (T*)d, (T*)e, (T*)z, ldz, (T*)work, lwork, iwork, liwork, info); } - #endif - } - - - - template - inline - void - trevc(char* side, char* howmny, blas_int* select, blas_int* n, eT* t, blas_int* ldt, eT* vl, blas_int* ldvl, eT* vr, blas_int* ldvr, blas_int* mm, blas_int* m, eT* work, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float T; arma_fortran(arma_strevc)(side, howmny, select, n, (T*)t, ldt, (T*)vl, ldvl, (T*)vr, ldvr, mm, m, (T*)work, info, 1, 1); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dtrevc)(side, howmny, select, n, (T*)t, ldt, (T*)vl, ldvl, (T*)vr, ldvr, mm, m, (T*)work, info, 1, 1); } - #else - if( is_float::value) { typedef float T; arma_fortran(arma_strevc)(side, howmny, select, n, (T*)t, ldt, (T*)vl, ldvl, (T*)vr, ldvr, mm, m, (T*)work, info); } - else if(is_double::value) { typedef double T; arma_fortran(arma_dtrevc)(side, howmny, select, n, (T*)t, ldt, (T*)vl, ldvl, (T*)vr, ldvr, mm, m, (T*)work, info); } - #endif - } - - - - template - inline - void - gehrd(blas_int* n, blas_int* ilo, blas_int* ihi, eT* a, blas_int* lda, eT* tao, eT* work, blas_int* lwork, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - if( is_float::value) { typedef float T; arma_fortran(arma_sgehrd)(n, ilo, ihi, (T*)a, lda, (T*)tao, (T*)work, lwork, info); } - else if( is_double::value) { typedef double T; arma_fortran(arma_dgehrd)(n, ilo, ihi, (T*)a, lda, (T*)tao, (T*)work, lwork, info); } - else if( is_cx_float::value) { typedef blas_cxf T; arma_fortran(arma_cgehrd)(n, ilo, ihi, (T*)a, lda, (T*)tao, (T*)work, lwork, info); } - else if(is_cx_double::value) { typedef blas_cxd T; arma_fortran(arma_zgehrd)(n, ilo, ihi, (T*)a, lda, (T*)tao, (T*)work, lwork, info); } - } - - - - template - inline - void - pstrf(const char* uplo, const blas_int* n, eT* a, const blas_int* lda, blas_int* piv, blas_int* rank, const typename get_pod_type::result* tol, const typename get_pod_type::result* work, blas_int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - #if defined(ARMA_USE_FORTRAN_HIDDEN_ARGS) - if( is_float::value) { typedef float pod_T; typedef float T; arma_fortran(arma_spstrf)(uplo, n, (T*)a, lda, piv, rank, (const pod_T*)tol, (pod_T*)work, info, 1); } - else if( is_double::value) { typedef double pod_T; typedef double T; arma_fortran(arma_dpstrf)(uplo, n, (T*)a, lda, piv, rank, (const pod_T*)tol, (pod_T*)work, info, 1); } - else if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf T; arma_fortran(arma_cpstrf)(uplo, n, (T*)a, lda, piv, rank, (const pod_T*)tol, (pod_T*)work, info, 1); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd T; arma_fortran(arma_zpstrf)(uplo, n, (T*)a, lda, piv, rank, (const pod_T*)tol, (pod_T*)work, info, 1); } - #else - if( is_float::value) { typedef float pod_T; typedef float T; arma_fortran(arma_spstrf)(uplo, n, (T*)a, lda, piv, rank, (const pod_T*)tol, (pod_T*)work, info); } - else if( is_double::value) { typedef double pod_T; typedef double T; arma_fortran(arma_dpstrf)(uplo, n, (T*)a, lda, piv, rank, (const pod_T*)tol, (pod_T*)work, info); } - else if( is_cx_float::value) { typedef float pod_T; typedef blas_cxf T; arma_fortran(arma_cpstrf)(uplo, n, (T*)a, lda, piv, rank, (const pod_T*)tol, (pod_T*)work, info); } - else if(is_cx_double::value) { typedef double pod_T; typedef blas_cxd T; arma_fortran(arma_zpstrf)(uplo, n, (T*)a, lda, piv, rank, (const pod_T*)tol, (pod_T*)work, info); } - #endif - } - - - } - - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/translate_superlu.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/translate_superlu.hpp deleted file mode 100644 index a04f01e8b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/translate_superlu.hpp +++ /dev/null @@ -1,348 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - - -#if defined(ARMA_USE_SUPERLU) - -//! \namespace superlu namespace for SuperLU functions -namespace superlu - { - - template - inline - void - gssv(superlu_options_t* options, SuperMatrix* A, int* perm_c, int* perm_r, SuperMatrix* L, SuperMatrix* U, SuperMatrix* B, SuperLUStat_t* stat, int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - if(is_float::value) - { - arma_wrapper(sgssv)(options, A, perm_c, perm_r, L, U, B, stat, info); - } - else - if(is_double::value) - { - arma_wrapper(dgssv)(options, A, perm_c, perm_r, L, U, B, stat, info); - } - else - if(is_cx_float::value) - { - arma_wrapper(cgssv)(options, A, perm_c, perm_r, L, U, B, stat, info); - } - else - if(is_cx_double::value) - { - arma_wrapper(zgssv)(options, A, perm_c, perm_r, L, U, B, stat, info); - } - } - - - - template - inline - void - gssvx( - superlu_options_t* opts, - SuperMatrix* A, - int* perm_c, int* perm_r, - int* etree, char* equed, - typename get_pod_type::result* R, typename get_pod_type::result* C, - SuperMatrix* L, SuperMatrix* U, - void* work, int lwork, - SuperMatrix* B, SuperMatrix* X, - typename get_pod_type::result* rpg, typename get_pod_type::result* rcond, - typename get_pod_type::result* ferr, typename get_pod_type::result* berr, - GlobalLU_t* glu, mem_usage_t* mu, SuperLUStat_t* stat, int* info - ) - { - arma_type_check(( is_supported_blas_type::value == false )); - - if(is_float::value) - { - typedef float T; - arma_wrapper(sgssvx)(opts, A, perm_c, perm_r, etree, equed, (T*)R, (T*)C, L, U, work, lwork, B, X, (T*)rpg, (T*)rcond, (T*)ferr, (T*)berr, glu, mu, stat, info); - } - else - if(is_double::value) - { - typedef double T; - arma_wrapper(dgssvx)(opts, A, perm_c, perm_r, etree, equed, (T*)R, (T*)C, L, U, work, lwork, B, X, (T*)rpg, (T*)rcond, (T*)ferr, (T*)berr, glu, mu, stat, info); - } - else - if(is_cx_float::value) - { - typedef float T; - arma_wrapper(cgssvx)(opts, A, perm_c, perm_r, etree, equed, (T*)R, (T*)C, L, U, work, lwork, B, X, (T*)rpg, (T*)rcond, (T*)ferr, (T*)berr, glu, mu, stat, info); - } - else - if(is_cx_double::value) - { - typedef double T; - arma_wrapper(zgssvx)(opts, A, perm_c, perm_r, etree, equed, (T*)R, (T*)C, L, U, work, lwork, B, X, (T*)rpg, (T*)rcond, (T*)ferr, (T*)berr, glu, mu, stat, info); - } - } - - - - template - inline - void - gstrf(superlu_options_t* options, - SuperMatrix* A, - int relax, - int panel_size, int *etree, - void *work, int lwork, - int* perm_c, int* perm_r, - SuperMatrix* L, SuperMatrix* U, - GlobalLU_t* Glu, SuperLUStat_t* stat, int* info - ) - { - arma_type_check(( is_supported_blas_type::value == false )); - - if(is_float::value) - { - arma_wrapper(sgstrf)(options, A, relax, panel_size, etree, work, lwork, perm_c, perm_r, L, U, Glu, stat, info); - } - else - if(is_double::value) - { - arma_wrapper(dgstrf)(options, A, relax, panel_size, etree, work, lwork, perm_c, perm_r, L, U, Glu, stat, info); - } - else - if(is_cx_float::value) - { - arma_wrapper(cgstrf)(options, A, relax, panel_size, etree, work, lwork, perm_c, perm_r, L, U, Glu, stat, info); - } - else - if(is_cx_double::value) - { - arma_wrapper(zgstrf)(options, A, relax, panel_size, etree, work, lwork, perm_c, perm_r, L, U, Glu, stat, info); - } - } - - - - template - inline - void - gstrs(trans_t trans, - SuperMatrix* L, SuperMatrix* U, - int* perm_c, int* perm_r, - SuperMatrix* B, SuperLUStat_t* stat, int* info - ) - { - arma_type_check(( is_supported_blas_type::value == false )); - - if(is_float::value) - { - arma_wrapper(sgstrs)(trans, L, U, perm_c, perm_r, B, stat, info); - } - else - if(is_double::value) - { - arma_wrapper(dgstrs)(trans, L, U, perm_c, perm_r, B, stat, info); - } - else - if(is_cx_float::value) - { - arma_wrapper(cgstrs)(trans, L, U, perm_c, perm_r, B, stat, info); - } - else - if(is_cx_double::value) - { - arma_wrapper(zgstrs)(trans, L, U, perm_c, perm_r, B, stat, info); - } - } - - - - template - inline - typename get_pod_type::result - langs(char* norm, superlu::SuperMatrix* A) - { - arma_type_check(( is_supported_blas_type::value == false )); - - typedef typename get_pod_type::result T; - - if(is_float::value) - { - return arma_wrapper(slangs)(norm, A); - } - else - if(is_double::value) - { - return arma_wrapper(dlangs)(norm, A); - } - else - if(is_cx_float::value) - { - return arma_wrapper(clangs)(norm, A); - } - else - if(is_cx_double::value) - { - return arma_wrapper(zlangs)(norm, A); - } - - return T(0); // to avoid false warnigns from the compiler - } - - - - template - inline - void - gscon(char* norm, superlu::SuperMatrix* L, superlu::SuperMatrix* U, typename get_pod_type::result anorm, typename get_pod_type::result* rcond, superlu::SuperLUStat_t* stat, int* info) - { - arma_type_check(( is_supported_blas_type::value == false )); - - if(is_float::value) - { - typedef float T; - arma_wrapper(sgscon)(norm, L, U, (T)anorm, (T*)rcond, stat, info); - } - else - if(is_double::value) - { - typedef double T; - arma_wrapper(dgscon)(norm, L, U, (T)anorm, (T*)rcond, stat, info); - } - else - if(is_cx_float::value) - { - typedef float T; - arma_wrapper(cgscon)(norm, L, U, (T)anorm, (T*)rcond, stat, info); - } - else - if(is_cx_double::value) - { - typedef double T; - arma_wrapper(zgscon)(norm, L, U, (T)anorm, (T*)rcond, stat, info); - } - } - - - - inline - void - init_stat(SuperLUStat_t* stat) - { - arma_wrapper(StatInit)(stat); - } - - - inline - void - free_stat(SuperLUStat_t* stat) - { - arma_wrapper(StatFree)(stat); - } - - - - inline - void - set_default_opts(superlu_options_t* opts) - { - arma_wrapper(set_default_options)(opts); - } - - - inline - void - get_permutation_c(int ispec, SuperMatrix* A, int* perm_c) - { - arma_wrapper(get_perm_c)(ispec, A, perm_c); - } - - - - inline - void - sp_preorder_mat(superlu_options_t* opts, SuperMatrix* A, int* perm_c, int* etree, SuperMatrix* AC) - { - arma_wrapper(sp_preorder)(opts, A, perm_c, etree, AC); - } - - - - inline - int - sp_ispec_environ(int ispec) - { - return arma_wrapper(sp_ienv)(ispec); - } - - - - inline - void - destroy_supernode_mat(SuperMatrix* a) - { - arma_wrapper(Destroy_SuperNode_Matrix)(a); - } - - - - inline - void - destroy_compcol_mat(SuperMatrix* a) - { - arma_wrapper(Destroy_CompCol_Matrix)(a); - } - - - - inline - void - destroy_compcolperm_mat(SuperMatrix* a) - { - arma_wrapper(Destroy_CompCol_Permuted)(a); - } - - - - inline - void - destroy_dense_mat(SuperMatrix* a) - { - arma_wrapper(Destroy_SuperMatrix_Store)(a); - } - - - - inline - void* - malloc(size_t N) - { - return arma_wrapper(superlu_malloc)(N); - } - - - - inline - void - free(void* mem) - { - arma_wrapper(superlu_free)(mem); - } - - } // namespace superlu - -#endif diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/trimat_helper.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/trimat_helper.hpp deleted file mode 100644 index 416cd2f3b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/trimat_helper.hpp +++ /dev/null @@ -1,165 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup trimat_helper -//! @{ - - -namespace trimat_helper -{ - - - -template -inline -bool -is_triu(const Mat& A) - { - arma_debug_sigprint(); - - // NOTE: assuming that A has a square size - - const uword N = A.n_rows; - const uword Nm1 = N-1; - - if(N < 2) { return false; } - - const eT* A_col = A.memptr(); - const eT eT_zero = eT(0); - - // quickly check element at bottom-left - - if(A_col[Nm1] != eT_zero) { return false; } - - // if we got to this point, do a thorough check - - for(uword j=0; j < Nm1; ++j) - { - for(uword i=(j+1); i < N; ++i) - { - const eT A_ij = A_col[i]; - - if(A_ij != eT_zero) { return false; } - } - - A_col += N; - } - - return true; - } - - - -template -inline -bool -is_tril(const Mat& A) - { - arma_debug_sigprint(); - - // NOTE: assuming that A has a square size - - const uword N = A.n_rows; - - if(N < 2) { return false; } - - const eT eT_zero = eT(0); - - // quickly check element at top-right - - const eT* A_colNm1 = A.colptr(N-1); - - if(A_colNm1[0] != eT_zero) { return false; } - - // if we got to this point, do a thorough check - - const eT* A_col = A.memptr() + N; - - for(uword j=1; j < N; ++j) - { - for(uword i=0; i < j; ++i) - { - const eT A_ij = A_col[i]; - - if(A_ij != eT_zero) { return false; } - } - - A_col += N; - } - - return true; - } - - - -template -inline -bool -has_nonfinite_tril(const Mat& A) - { - arma_debug_sigprint(); - - // NOTE: assuming that A has a square size - - const eT* colptr = A.memptr(); - const uword N = A.n_rows; - - for(uword i=0; i -inline -bool -has_nonfinite_triu(const Mat& A) - { - arma_debug_sigprint(); - - // NOTE: assuming that A has a square size - - const eT* colptr = A.memptr(); - const uword N = A.n_rows; - - for(uword i=0; i= 0xff - typedef unsigned char u8; - typedef char s8; - #elif defined(UINT8_MAX) - typedef uint8_t u8; - typedef int8_t s8; - #else - #error "don't know how to typedef 'u8' on this system" - #endif -#endif - -// NOTE: "char" can be either "signed char" or "unsigned char" -// NOTE: https://en.wikipedia.org/wiki/C_data_types - - -#if USHRT_MAX >= 0xffff - typedef unsigned short u16; - typedef short s16; -#elif defined(UINT16_MAX) - typedef uint16_t u16; - typedef int16_t s16; -#else - #error "don't know how to typedef 'u16' on this system" -#endif - - -#if UINT_MAX >= 0xffffffff - typedef unsigned int u32; - typedef int s32; -#elif defined(UINT32_MAX) - typedef uint32_t u32; - typedef int32_t s32; -#else - #error "don't know how to typedef 'u32' on this system" -#endif - - -#if ULLONG_MAX >= 0xffffffffffffffff - typedef unsigned long long u64; - typedef long long s64; -#elif defined(UINT64_MAX) - typedef uint64_t u64; - typedef int64_t s64; -#else - #error "don't know how to typedef 'u64' on this system" -#endif - - -// for compatibility with earlier versions of Armadillo -typedef unsigned long ulng_t; -typedef long slng_t; - - -#if defined(ARMA_64BIT_WORD) - typedef u64 uword; - typedef s64 sword; - - typedef u32 uhword; - typedef s32 shword; - - #define ARMA_MAX_UWORD 0xffffffffffffffff - #define ARMA_MAX_UHWORD 0xffffffff -#else - typedef u32 uword; - typedef s32 sword; - - typedef u16 uhword; - typedef s16 shword; - - #define ARMA_MAX_UWORD 0xffffffff - #define ARMA_MAX_UHWORD 0xffff -#endif - - -typedef std::complex cx_float; -typedef std::complex cx_double; - -typedef void* void_ptr; - - -// - - -#if defined(ARMA_BLAS_LONG_LONG) - typedef long long blas_int; - #define ARMA_MAX_BLAS_INT 0x7fffffffffffffffULL -#elif defined(ARMA_BLAS_LONG) - typedef long blas_int; - #define ARMA_MAX_BLAS_INT 0x7fffffffffffffffUL -#else - typedef int blas_int; - #define ARMA_MAX_BLAS_INT 0x7fffffffU -#endif - - -// - - -#if defined(ARMA_USE_MKL_TYPES) - // for compatibility with MKL - typedef MKL_Complex8 blas_cxf; - typedef MKL_Complex16 blas_cxd; -#else - // standard BLAS and LAPACK prototypes use "void*" pointers for complex arrays - typedef void blas_cxf; - typedef void blas_cxd; -#endif - - -// - - -// NOTE: blas_len is the fortran type for "hidden" arguments that specify the length of character arguments; -// NOTE: it varies across compilers, compiler versions and systems (eg. 32 bit vs 64 bit); -// NOTE: the default setting of "size_t" is an educated guess. -// NOTE: --- -// NOTE: for gcc / gfortran: https://gcc.gnu.org/onlinedocs/gfortran/Argument-passing-conventions.html -// NOTE: gcc 7 and earlier: int -// NOTE: gcc 8 and 9: size_t -// NOTE: --- -// NOTE: for ifort (intel fortran compiler): -// NOTE: "Intel Fortran Compiler User and Reference Guides", Document Number: 304970-006US, 2009, p. 301 -// NOTE: http://www.complexfluids.ethz.ch/MK/ifort.pdf -// NOTE: the type is unsigned 4-byte integer on 32 bit systems -// NOTE: the type is unsigned 8-byte integer on 64 bit systems -// NOTE: --- -// NOTE: for NAG fortran: https://www.nag.co.uk/nagware/np/r62_doc/manual/compiler_11_1.html#AUTOTOC_11_1 -// NOTE: Chrlen = usually int, or long long on 64-bit Windows -// NOTE: --- -// TODO: flang: https://github.com/flang-compiler/flang/wiki -// TODO: other compilers: http://fortranwiki.org/fortran/show/Compilers - -#if !defined(ARMA_FORTRAN_CHARLEN_TYPE) - #if defined(__GNUC__) && !defined(__clang__) - #if (__GNUC__ <= 7) - #define ARMA_FORTRAN_CHARLEN_TYPE int - #else - #define ARMA_FORTRAN_CHARLEN_TYPE size_t - #endif - #else - // TODO: determine the type for other compilers - #define ARMA_FORTRAN_CHARLEN_TYPE size_t - #endif -#endif - -typedef ARMA_FORTRAN_CHARLEN_TYPE blas_len; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/typedef_elem_check.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/typedef_elem_check.hpp deleted file mode 100644 index db462ab18..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/typedef_elem_check.hpp +++ /dev/null @@ -1,48 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup typedef_elem -//! @{ - - -namespace junk - { - struct arma_elem_size_test - { - arma_static_check( (sizeof(u8) != 1), "error: type 'u8' has unsupported size" ); - arma_static_check( (sizeof(s8) != 1), "error: type 's8' has unsupported size" ); - - arma_static_check( (sizeof(u16) != 2), "error: type 'u16' has unsupported size" ); - arma_static_check( (sizeof(s16) != 2), "error: type 's16' has unsupported size" ); - - arma_static_check( (sizeof(u32) != 4), "error: type 'u32' has unsupported size" ); - arma_static_check( (sizeof(s32) != 4), "error: type 's32' has unsupported size" ); - - arma_static_check( (sizeof(u64) != 8), "error: type 'u64' has unsupported size" ); - arma_static_check( (sizeof(s64) != 8), "error: type 's64' has unsupported size" ); - - arma_static_check( (sizeof(float) != 4), "error: type 'float' has unsupported size" ); - arma_static_check( (sizeof(double) != 8), "error: type 'double' has unsupported size" ); - - arma_static_check( (sizeof(std::complex) != 8), "type 'std::complex' has unsupported size" ); - arma_static_check( (sizeof(std::complex) != 16), "type 'std::complex' has unsupported size" ); - }; - } - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/typedef_mat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/typedef_mat.hpp deleted file mode 100644 index 69a4c90ff..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/typedef_mat.hpp +++ /dev/null @@ -1,144 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup typedef_mat -//! @{ - - -typedef Mat uchar_mat; -typedef Col uchar_vec; -typedef Col uchar_colvec; -typedef Row uchar_rowvec; -typedef Cube uchar_cube; - -typedef Mat u32_mat; -typedef Col u32_vec; -typedef Col u32_colvec; -typedef Row u32_rowvec; -typedef Cube u32_cube; - -typedef Mat s32_mat; -typedef Col s32_vec; -typedef Col s32_colvec; -typedef Row s32_rowvec; -typedef Cube s32_cube; - -typedef Mat u64_mat; -typedef Col u64_vec; -typedef Col u64_colvec; -typedef Row u64_rowvec; -typedef Cube u64_cube; - -typedef Mat s64_mat; -typedef Col s64_vec; -typedef Col s64_colvec; -typedef Row s64_rowvec; -typedef Cube s64_cube; - -typedef Mat umat; -typedef Col uvec; -typedef Col ucolvec; -typedef Row urowvec; -typedef Cube ucube; - -typedef Mat imat; -typedef Col ivec; -typedef Col icolvec; -typedef Row irowvec; -typedef Cube icube; - -typedef Mat fmat; -typedef Col fvec; -typedef Col fcolvec; -typedef Row frowvec; -typedef Cube fcube; - -typedef Mat dmat; -typedef Col dvec; -typedef Col dcolvec; -typedef Row drowvec; -typedef Cube dcube; - -typedef Mat mat; -typedef Col vec; -typedef Col colvec; -typedef Row rowvec; -typedef Cube cube; - -typedef Mat cx_fmat; -typedef Col cx_fvec; -typedef Col cx_fcolvec; -typedef Row cx_frowvec; -typedef Cube cx_fcube; - -typedef Mat cx_dmat; -typedef Col cx_dvec; -typedef Col cx_dcolvec; -typedef Row cx_drowvec; -typedef Cube cx_dcube; - -typedef Mat cx_mat; -typedef Col cx_vec; -typedef Col cx_colvec; -typedef Row cx_rowvec; -typedef Cube cx_cube; - - - -typedef SpMat sp_umat; -typedef SpCol sp_uvec; -typedef SpCol sp_ucolvec; -typedef SpRow sp_urowvec; - -typedef SpMat sp_imat; -typedef SpCol sp_ivec; -typedef SpCol sp_icolvec; -typedef SpRow sp_irowvec; - -typedef SpMat sp_fmat; -typedef SpCol sp_fvec; -typedef SpCol sp_fcolvec; -typedef SpRow sp_frowvec; - -typedef SpMat sp_dmat; -typedef SpCol sp_dvec; -typedef SpCol sp_dcolvec; -typedef SpRow sp_drowvec; - -typedef SpMat sp_mat; -typedef SpCol sp_vec; -typedef SpCol sp_colvec; -typedef SpRow sp_rowvec; - -typedef SpMat sp_cx_fmat; -typedef SpCol sp_cx_fvec; -typedef SpCol sp_cx_fcolvec; -typedef SpRow sp_cx_frowvec; - -typedef SpMat sp_cx_dmat; -typedef SpCol sp_cx_dvec; -typedef SpCol sp_cx_dcolvec; -typedef SpRow sp_cx_drowvec; - -typedef SpMat sp_cx_mat; -typedef SpCol sp_cx_vec; -typedef SpCol sp_cx_colvec; -typedef SpRow sp_cx_rowvec; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/typedef_mat_fixed.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/typedef_mat_fixed.hpp deleted file mode 100644 index bd45615a0..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/typedef_mat_fixed.hpp +++ /dev/null @@ -1,326 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup typedef_mat_fixed -//! @{ - - - -typedef umat::fixed<2,2> umat22; -typedef umat::fixed<3,3> umat33; -typedef umat::fixed<4,4> umat44; -typedef umat::fixed<5,5> umat55; -typedef umat::fixed<6,6> umat66; -typedef umat::fixed<7,7> umat77; -typedef umat::fixed<8,8> umat88; -typedef umat::fixed<9,9> umat99; - -typedef imat::fixed<2,2> imat22; -typedef imat::fixed<3,3> imat33; -typedef imat::fixed<4,4> imat44; -typedef imat::fixed<5,5> imat55; -typedef imat::fixed<6,6> imat66; -typedef imat::fixed<7,7> imat77; -typedef imat::fixed<8,8> imat88; -typedef imat::fixed<9,9> imat99; - -typedef fmat::fixed<2,2> fmat22; -typedef fmat::fixed<3,3> fmat33; -typedef fmat::fixed<4,4> fmat44; -typedef fmat::fixed<5,5> fmat55; -typedef fmat::fixed<6,6> fmat66; -typedef fmat::fixed<7,7> fmat77; -typedef fmat::fixed<8,8> fmat88; -typedef fmat::fixed<9,9> fmat99; - -typedef dmat::fixed<2,2> dmat22; -typedef dmat::fixed<3,3> dmat33; -typedef dmat::fixed<4,4> dmat44; -typedef dmat::fixed<5,5> dmat55; -typedef dmat::fixed<6,6> dmat66; -typedef dmat::fixed<7,7> dmat77; -typedef dmat::fixed<8,8> dmat88; -typedef dmat::fixed<9,9> dmat99; - -typedef mat::fixed<2,2> mat22; -typedef mat::fixed<3,3> mat33; -typedef mat::fixed<4,4> mat44; -typedef mat::fixed<5,5> mat55; -typedef mat::fixed<6,6> mat66; -typedef mat::fixed<7,7> mat77; -typedef mat::fixed<8,8> mat88; -typedef mat::fixed<9,9> mat99; - -typedef cx_fmat::fixed<2,2> cx_fmat22; -typedef cx_fmat::fixed<3,3> cx_fmat33; -typedef cx_fmat::fixed<4,4> cx_fmat44; -typedef cx_fmat::fixed<5,5> cx_fmat55; -typedef cx_fmat::fixed<6,6> cx_fmat66; -typedef cx_fmat::fixed<7,7> cx_fmat77; -typedef cx_fmat::fixed<8,8> cx_fmat88; -typedef cx_fmat::fixed<9,9> cx_fmat99; - -typedef cx_dmat::fixed<2,2> cx_dmat22; -typedef cx_dmat::fixed<3,3> cx_dmat33; -typedef cx_dmat::fixed<4,4> cx_dmat44; -typedef cx_dmat::fixed<5,5> cx_dmat55; -typedef cx_dmat::fixed<6,6> cx_dmat66; -typedef cx_dmat::fixed<7,7> cx_dmat77; -typedef cx_dmat::fixed<8,8> cx_dmat88; -typedef cx_dmat::fixed<9,9> cx_dmat99; - -typedef cx_mat::fixed<2,2> cx_mat22; -typedef cx_mat::fixed<3,3> cx_mat33; -typedef cx_mat::fixed<4,4> cx_mat44; -typedef cx_mat::fixed<5,5> cx_mat55; -typedef cx_mat::fixed<6,6> cx_mat66; -typedef cx_mat::fixed<7,7> cx_mat77; -typedef cx_mat::fixed<8,8> cx_mat88; -typedef cx_mat::fixed<9,9> cx_mat99; - - -// - - -typedef uvec::fixed<2> uvec2; -typedef uvec::fixed<3> uvec3; -typedef uvec::fixed<4> uvec4; -typedef uvec::fixed<5> uvec5; -typedef uvec::fixed<6> uvec6; -typedef uvec::fixed<7> uvec7; -typedef uvec::fixed<8> uvec8; -typedef uvec::fixed<9> uvec9; - -typedef ivec::fixed<2> ivec2; -typedef ivec::fixed<3> ivec3; -typedef ivec::fixed<4> ivec4; -typedef ivec::fixed<5> ivec5; -typedef ivec::fixed<6> ivec6; -typedef ivec::fixed<7> ivec7; -typedef ivec::fixed<8> ivec8; -typedef ivec::fixed<9> ivec9; - -typedef fvec::fixed<2> fvec2; -typedef fvec::fixed<3> fvec3; -typedef fvec::fixed<4> fvec4; -typedef fvec::fixed<5> fvec5; -typedef fvec::fixed<6> fvec6; -typedef fvec::fixed<7> fvec7; -typedef fvec::fixed<8> fvec8; -typedef fvec::fixed<9> fvec9; - -typedef dvec::fixed<2> dvec2; -typedef dvec::fixed<3> dvec3; -typedef dvec::fixed<4> dvec4; -typedef dvec::fixed<5> dvec5; -typedef dvec::fixed<6> dvec6; -typedef dvec::fixed<7> dvec7; -typedef dvec::fixed<8> dvec8; -typedef dvec::fixed<9> dvec9; - -typedef vec::fixed<2> vec2; -typedef vec::fixed<3> vec3; -typedef vec::fixed<4> vec4; -typedef vec::fixed<5> vec5; -typedef vec::fixed<6> vec6; -typedef vec::fixed<7> vec7; -typedef vec::fixed<8> vec8; -typedef vec::fixed<9> vec9; - -typedef cx_fvec::fixed<2> cx_fvec2; -typedef cx_fvec::fixed<3> cx_fvec3; -typedef cx_fvec::fixed<4> cx_fvec4; -typedef cx_fvec::fixed<5> cx_fvec5; -typedef cx_fvec::fixed<6> cx_fvec6; -typedef cx_fvec::fixed<7> cx_fvec7; -typedef cx_fvec::fixed<8> cx_fvec8; -typedef cx_fvec::fixed<9> cx_fvec9; - -typedef cx_dvec::fixed<2> cx_dvec2; -typedef cx_dvec::fixed<3> cx_dvec3; -typedef cx_dvec::fixed<4> cx_dvec4; -typedef cx_dvec::fixed<5> cx_dvec5; -typedef cx_dvec::fixed<6> cx_dvec6; -typedef cx_dvec::fixed<7> cx_dvec7; -typedef cx_dvec::fixed<8> cx_dvec8; -typedef cx_dvec::fixed<9> cx_dvec9; - -typedef cx_vec::fixed<2> cx_vec2; -typedef cx_vec::fixed<3> cx_vec3; -typedef cx_vec::fixed<4> cx_vec4; -typedef cx_vec::fixed<5> cx_vec5; -typedef cx_vec::fixed<6> cx_vec6; -typedef cx_vec::fixed<7> cx_vec7; -typedef cx_vec::fixed<8> cx_vec8; -typedef cx_vec::fixed<9> cx_vec9; - - -// - - -typedef ucolvec::fixed<2> ucolvec2; -typedef ucolvec::fixed<3> ucolvec3; -typedef ucolvec::fixed<4> ucolvec4; -typedef ucolvec::fixed<5> ucolvec5; -typedef ucolvec::fixed<6> ucolvec6; -typedef ucolvec::fixed<7> ucolvec7; -typedef ucolvec::fixed<8> ucolvec8; -typedef ucolvec::fixed<9> ucolvec9; - -typedef icolvec::fixed<2> icolvec2; -typedef icolvec::fixed<3> icolvec3; -typedef icolvec::fixed<4> icolvec4; -typedef icolvec::fixed<5> icolvec5; -typedef icolvec::fixed<6> icolvec6; -typedef icolvec::fixed<7> icolvec7; -typedef icolvec::fixed<8> icolvec8; -typedef icolvec::fixed<9> icolvec9; - -typedef fcolvec::fixed<2> fcolvec2; -typedef fcolvec::fixed<3> fcolvec3; -typedef fcolvec::fixed<4> fcolvec4; -typedef fcolvec::fixed<5> fcolvec5; -typedef fcolvec::fixed<6> fcolvec6; -typedef fcolvec::fixed<7> fcolvec7; -typedef fcolvec::fixed<8> fcolvec8; -typedef fcolvec::fixed<9> fcolvec9; - -typedef dcolvec::fixed<2> dcolvec2; -typedef dcolvec::fixed<3> dcolvec3; -typedef dcolvec::fixed<4> dcolvec4; -typedef dcolvec::fixed<5> dcolvec5; -typedef dcolvec::fixed<6> dcolvec6; -typedef dcolvec::fixed<7> dcolvec7; -typedef dcolvec::fixed<8> dcolvec8; -typedef dcolvec::fixed<9> dcolvec9; - -typedef colvec::fixed<2> colvec2; -typedef colvec::fixed<3> colvec3; -typedef colvec::fixed<4> colvec4; -typedef colvec::fixed<5> colvec5; -typedef colvec::fixed<6> colvec6; -typedef colvec::fixed<7> colvec7; -typedef colvec::fixed<8> colvec8; -typedef colvec::fixed<9> colvec9; - -typedef cx_fcolvec::fixed<2> cx_fcolvec2; -typedef cx_fcolvec::fixed<3> cx_fcolvec3; -typedef cx_fcolvec::fixed<4> cx_fcolvec4; -typedef cx_fcolvec::fixed<5> cx_fcolvec5; -typedef cx_fcolvec::fixed<6> cx_fcolvec6; -typedef cx_fcolvec::fixed<7> cx_fcolvec7; -typedef cx_fcolvec::fixed<8> cx_fcolvec8; -typedef cx_fcolvec::fixed<9> cx_fcolvec9; - -typedef cx_dcolvec::fixed<2> cx_dcolvec2; -typedef cx_dcolvec::fixed<3> cx_dcolvec3; -typedef cx_dcolvec::fixed<4> cx_dcolvec4; -typedef cx_dcolvec::fixed<5> cx_dcolvec5; -typedef cx_dcolvec::fixed<6> cx_dcolvec6; -typedef cx_dcolvec::fixed<7> cx_dcolvec7; -typedef cx_dcolvec::fixed<8> cx_dcolvec8; -typedef cx_dcolvec::fixed<9> cx_dcolvec9; - -typedef cx_colvec::fixed<2> cx_colvec2; -typedef cx_colvec::fixed<3> cx_colvec3; -typedef cx_colvec::fixed<4> cx_colvec4; -typedef cx_colvec::fixed<5> cx_colvec5; -typedef cx_colvec::fixed<6> cx_colvec6; -typedef cx_colvec::fixed<7> cx_colvec7; -typedef cx_colvec::fixed<8> cx_colvec8; -typedef cx_colvec::fixed<9> cx_colvec9; - - -// - - -typedef urowvec::fixed<2> urowvec2; -typedef urowvec::fixed<3> urowvec3; -typedef urowvec::fixed<4> urowvec4; -typedef urowvec::fixed<5> urowvec5; -typedef urowvec::fixed<6> urowvec6; -typedef urowvec::fixed<7> urowvec7; -typedef urowvec::fixed<8> urowvec8; -typedef urowvec::fixed<9> urowvec9; - -typedef irowvec::fixed<2> irowvec2; -typedef irowvec::fixed<3> irowvec3; -typedef irowvec::fixed<4> irowvec4; -typedef irowvec::fixed<5> irowvec5; -typedef irowvec::fixed<6> irowvec6; -typedef irowvec::fixed<7> irowvec7; -typedef irowvec::fixed<8> irowvec8; -typedef irowvec::fixed<9> irowvec9; - -typedef frowvec::fixed<2> frowvec2; -typedef frowvec::fixed<3> frowvec3; -typedef frowvec::fixed<4> frowvec4; -typedef frowvec::fixed<5> frowvec5; -typedef frowvec::fixed<6> frowvec6; -typedef frowvec::fixed<7> frowvec7; -typedef frowvec::fixed<8> frowvec8; -typedef frowvec::fixed<9> frowvec9; - -typedef drowvec::fixed<2> drowvec2; -typedef drowvec::fixed<3> drowvec3; -typedef drowvec::fixed<4> drowvec4; -typedef drowvec::fixed<5> drowvec5; -typedef drowvec::fixed<6> drowvec6; -typedef drowvec::fixed<7> drowvec7; -typedef drowvec::fixed<8> drowvec8; -typedef drowvec::fixed<9> drowvec9; - -typedef rowvec::fixed<2> rowvec2; -typedef rowvec::fixed<3> rowvec3; -typedef rowvec::fixed<4> rowvec4; -typedef rowvec::fixed<5> rowvec5; -typedef rowvec::fixed<6> rowvec6; -typedef rowvec::fixed<7> rowvec7; -typedef rowvec::fixed<8> rowvec8; -typedef rowvec::fixed<9> rowvec9; - -typedef cx_frowvec::fixed<2> cx_frowvec2; -typedef cx_frowvec::fixed<3> cx_frowvec3; -typedef cx_frowvec::fixed<4> cx_frowvec4; -typedef cx_frowvec::fixed<5> cx_frowvec5; -typedef cx_frowvec::fixed<6> cx_frowvec6; -typedef cx_frowvec::fixed<7> cx_frowvec7; -typedef cx_frowvec::fixed<8> cx_frowvec8; -typedef cx_frowvec::fixed<9> cx_frowvec9; - -typedef cx_drowvec::fixed<2> cx_drowvec2; -typedef cx_drowvec::fixed<3> cx_drowvec3; -typedef cx_drowvec::fixed<4> cx_drowvec4; -typedef cx_drowvec::fixed<5> cx_drowvec5; -typedef cx_drowvec::fixed<6> cx_drowvec6; -typedef cx_drowvec::fixed<7> cx_drowvec7; -typedef cx_drowvec::fixed<8> cx_drowvec8; -typedef cx_drowvec::fixed<9> cx_drowvec9; - -typedef cx_rowvec::fixed<2> cx_rowvec2; -typedef cx_rowvec::fixed<3> cx_rowvec3; -typedef cx_rowvec::fixed<4> cx_rowvec4; -typedef cx_rowvec::fixed<5> cx_rowvec5; -typedef cx_rowvec::fixed<6> cx_rowvec6; -typedef cx_rowvec::fixed<7> cx_rowvec7; -typedef cx_rowvec::fixed<8> cx_rowvec8; -typedef cx_rowvec::fixed<9> cx_rowvec9; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/unwrap.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/unwrap.hpp deleted file mode 100644 index 7e9363179..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/unwrap.hpp +++ /dev/null @@ -1,3586 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup unwrap -//! @{ - - -// TODO: document the conditions and restrictions for the use of each unwrap variant: -// TODO: unwrap, unwrap_check, quasi_unwrap, partial_unwrap, partial_unwrap_check - - -template -struct unwrap_default - { - typedef typename T1::elem_type eT; - typedef Mat stored_type; - - inline - unwrap_default(const T1& A) - : M(A) - { - arma_debug_sigprint(); - } - - const Mat M; - }; - - - -template -struct unwrap_fixed - { - typedef T1 stored_type; - - inline explicit - unwrap_fixed(const T1& A) - : M(A) - { - arma_debug_sigprint(); - } - - const T1& M; - }; - - - -template -struct unwrap_redirect {}; - -template -struct unwrap_redirect { typedef unwrap_default result; }; - -template -struct unwrap_redirect { typedef unwrap_fixed result; }; - - -template -struct unwrap : public unwrap_redirect::value>::result - { - inline - unwrap(const T1& A) - : unwrap_redirect::value>::result(A) - { - } - }; - - - -template -struct unwrap< Mat > - { - typedef Mat stored_type; - - inline - unwrap(const Mat& A) - : M(A) - { - arma_debug_sigprint(); - } - - const Mat& M; - }; - - - -template -struct unwrap< Row > - { - typedef Row stored_type; - - inline - unwrap(const Row& A) - : M(A) - { - arma_debug_sigprint(); - } - - const Row& M; - }; - - - -template -struct unwrap< Col > - { - typedef Col stored_type; - - inline - unwrap(const Col& A) - : M(A) - { - arma_debug_sigprint(); - } - - const Col& M; - }; - - - -template -struct unwrap< subview_col > - { - typedef Col stored_type; - - inline - unwrap(const subview_col& A) - : M(A.colmem, A.n_rows) - { - arma_debug_sigprint(); - } - - const Col M; - }; - - - -template -struct unwrap< subview_cols > - { - typedef Mat stored_type; - - inline - unwrap(const subview_cols& A) - : M(A.colptr(0), A.n_rows, A.n_cols) - { - arma_debug_sigprint(); - } - - const Mat M; - }; - - - -template -struct unwrap< mtGlue > - { - typedef Mat stored_type; - - inline - unwrap(const mtGlue& A) - : M(A) - { - arma_debug_sigprint(); - } - - const Mat M; - }; - - - -template -struct unwrap< mtOp > - { - typedef Mat stored_type; - - inline - unwrap(const mtOp& A) - : M(A) - { - arma_debug_sigprint(); - } - - const Mat M; - }; - - - -// -// -// - - - -template -struct quasi_unwrap_default - { - typedef typename T1::elem_type eT; - - inline - quasi_unwrap_default(const T1& A) - : M(A) - { - arma_debug_sigprint(); - } - - // NOTE: DO NOT DIRECTLY CHECK FOR ALIASING BY TAKING THE ADDRESS OF THE "M" OBJECT IN ANY quasi_unwrap CLASS !!! - Mat M; - - static constexpr bool is_const = false; - static constexpr bool has_subview = false; - static constexpr bool has_orig_mem = false; - - template - constexpr bool is_alias(const Mat&) const { return false; } - }; - - - -template -struct quasi_unwrap_fixed - { - typedef typename T1::elem_type eT; - - inline explicit - quasi_unwrap_fixed(const T1& A) - : M(A) - { - arma_debug_sigprint(); - } - - const T1& M; - - static constexpr bool is_const = true; - static constexpr bool has_subview = false; - static constexpr bool has_orig_mem = true; - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&M) == void_ptr(&X)); } - }; - - - -template -struct quasi_unwrap_redirect {}; - -template -struct quasi_unwrap_redirect { typedef quasi_unwrap_default result; }; - -template -struct quasi_unwrap_redirect { typedef quasi_unwrap_fixed result; }; - - -template -struct quasi_unwrap : public quasi_unwrap_redirect::value>::result - { - typedef typename quasi_unwrap_redirect::value>::result quasi_unwrap_extra; - - inline - quasi_unwrap(const T1& A) - : quasi_unwrap_extra(A) - { - } - - static constexpr bool is_const = quasi_unwrap_extra::is_const; - static constexpr bool has_subview = quasi_unwrap_extra::has_subview; - static constexpr bool has_orig_mem = quasi_unwrap_extra::has_orig_mem; - - using quasi_unwrap_extra::M; - using quasi_unwrap_extra::is_alias; - }; - - - -template -struct quasi_unwrap< Mat > - { - inline - quasi_unwrap(const Mat& A) - : M(A) - { - arma_debug_sigprint(); - } - - const Mat& M; - - static constexpr bool is_const = true; - static constexpr bool has_subview = false; - static constexpr bool has_orig_mem = true; - - template - arma_inline bool is_alias(const Mat& X) const { return (is_same_type::yes) && (void_ptr(&M) == void_ptr(&X)); } - }; - - - -template -struct quasi_unwrap< Row > - { - - inline - quasi_unwrap(const Row& A) - : M(A) - { - arma_debug_sigprint(); - } - - const Row& M; - - static constexpr bool is_const = true; - static constexpr bool has_subview = false; - static constexpr bool has_orig_mem = true; - - template - arma_inline bool is_alias(const Mat& X) const { return (is_same_type::yes) && (void_ptr(&M) == void_ptr(&X)); } - }; - - - -template -struct quasi_unwrap< Col > - { - inline - quasi_unwrap(const Col& A) - : M(A) - { - arma_debug_sigprint(); - } - - const Col& M; - - static constexpr bool is_const = true; - static constexpr bool has_subview = false; - static constexpr bool has_orig_mem = true; - - template - arma_inline bool is_alias(const Mat& X) const { return (is_same_type::yes) && (void_ptr(&M) == void_ptr(&X)); } - }; - - - -template -struct quasi_unwrap< subview > - { - inline - quasi_unwrap(const subview& A) - : sv( A ) - , M ( A, ((A.aux_row1 == 0) && (A.n_rows == A.m.n_rows)) ) // reuse memory if the subview is a contiguous chunk - { - arma_debug_sigprint(); - } - - const subview& sv; - const Mat M; - - static constexpr bool is_const = true; - static constexpr bool has_subview = true; - static constexpr bool has_orig_mem = false; // NOTE: set to false as this is the general case; original memory is only used when the subview is a contiguous chunk - - template - arma_inline bool is_alias(const Mat& X) const { return (is_same_type::yes) && ( ((sv.aux_row1 == 0) && (sv.n_rows == sv.m.n_rows)) ? (void_ptr(&(sv.m)) == void_ptr(&X)) : false ); } - }; - - - -template -struct quasi_unwrap< subview_row > - { - inline - quasi_unwrap(const subview_row& A) - : M(A) - { - arma_debug_sigprint(); - } - - Row M; - - static constexpr bool is_const = false; - static constexpr bool has_subview = false; - static constexpr bool has_orig_mem = false; - - template - constexpr bool is_alias(const Mat&) const { return false; } - }; - - - -template -struct quasi_unwrap< subview_col > - { - inline - quasi_unwrap(const subview_col& A) - : orig( A.m ) - , M ( const_cast( A.colmem ), A.n_rows, false, false ) - { - arma_debug_sigprint(); - } - - const Mat& orig; - const Col M; - - static constexpr bool is_const = true; - static constexpr bool has_subview = true; - static constexpr bool has_orig_mem = true; - - template - arma_inline bool is_alias(const Mat& X) const { return (is_same_type::yes) && (void_ptr(&orig) == void_ptr(&X)); } - }; - - - -template -struct quasi_unwrap< subview_cols > - { - inline - quasi_unwrap(const subview_cols& A) - : orig( A.m ) - , M ( const_cast( A.colptr(0) ), A.n_rows, A.n_cols, false, false ) - { - arma_debug_sigprint(); - } - - const Mat& orig; - const Mat M; - - static constexpr bool is_const = true; - static constexpr bool has_subview = true; - static constexpr bool has_orig_mem = true; - - template - arma_inline bool is_alias(const Mat& X) const { return (is_same_type::yes) && (void_ptr(&orig) == void_ptr(&X)); } - }; - - - -template -struct quasi_unwrap< mtGlue > - { - inline - quasi_unwrap(const mtGlue& A) - : M(A) - { - arma_debug_sigprint(); - } - - Mat M; - - static constexpr bool is_const = false; - static constexpr bool has_subview = false; - static constexpr bool has_orig_mem = false; - - template - constexpr bool is_alias(const Mat&) const { return false; } - }; - - - -template -struct quasi_unwrap< mtOp > - { - inline - quasi_unwrap(const mtOp& A) - : M(A) - { - arma_debug_sigprint(); - } - - Mat M; - - static constexpr bool is_const = false; - static constexpr bool has_subview = false; - static constexpr bool has_orig_mem = false; - - template - constexpr bool is_alias(const Mat&) const { return false; } - }; - - - -template -struct quasi_unwrap< Op > - { - typedef typename T1::elem_type eT; - - inline - quasi_unwrap(const Op& A) - : U( A.m ) - , M( const_cast(U.M.memptr()), U.M.n_elem, 1, false, false ) - { - arma_debug_sigprint(); - } - - const quasi_unwrap U; - const Mat M; - - static constexpr bool is_const = true; - static constexpr bool has_subview = true; - static constexpr bool has_orig_mem = true; - - template - arma_inline bool is_alias(const Mat& X) const { return U.is_alias(X); } - }; - - - -template -struct quasi_unwrap< Op, op_strans> > - { - inline - quasi_unwrap(const Op, op_strans>& A) - : orig(A.m) - , M (const_cast(A.m.memptr()), A.m.n_elem, false, false) - { - arma_debug_sigprint(); - } - - const Col& orig; - const Row M; - - static constexpr bool is_const = true; - static constexpr bool has_subview = true; - static constexpr bool has_orig_mem = true; - - template - arma_inline bool is_alias(const Mat& X) const { return (is_same_type::yes) && (void_ptr(&orig) == void_ptr(&X)); } - }; - - - -template -struct quasi_unwrap< Op, op_strans> > - { - inline - quasi_unwrap(const Op, op_strans>& A) - : orig(A.m) - , M (const_cast(A.m.memptr()), A.m.n_elem, false, false) - { - arma_debug_sigprint(); - } - - const Row& orig; - const Col M; - - static constexpr bool is_const = true; - static constexpr bool has_subview = true; - static constexpr bool has_orig_mem = true; - - template - arma_inline bool is_alias(const Mat& X) const { return (is_same_type::yes) && (void_ptr(&orig) == void_ptr(&X)); } - }; - - - -template -struct quasi_unwrap< Op, op_strans> > - { - inline - quasi_unwrap(const Op, op_strans>& A) - : orig( A.m.m ) - , M ( const_cast( A.m.colmem ), A.m.n_rows, false, false ) - { - arma_debug_sigprint(); - } - - const Mat& orig; - const Row M; - - static constexpr bool is_const = true; - static constexpr bool has_subview = true; - static constexpr bool has_orig_mem = true; - - template - arma_inline bool is_alias(const Mat& X) const { return (is_same_type::yes) && (void_ptr(&X) == void_ptr(&orig)); } - }; - - - -template -struct quasi_unwrap_Col_htrans - { - inline quasi_unwrap_Col_htrans(const T1&) {} - }; - - - -template -struct quasi_unwrap_Col_htrans< Op, op_htrans> > - { - inline - quasi_unwrap_Col_htrans(const Op, op_htrans>& A) - : orig(A.m) - , M (const_cast(A.m.memptr()), A.m.n_elem, false, false) - { - arma_debug_sigprint(); - } - - const Col& orig; - const Row M; - - static constexpr bool is_const = true; - static constexpr bool has_subview = true; - static constexpr bool has_orig_mem = true; - - template - arma_inline bool is_alias(const Mat& X) const { return (is_same_type::yes) && (void_ptr(&orig) == void_ptr(&X)); } - }; - - - -template -struct quasi_unwrap_Col_htrans_redirect {}; - -template -struct quasi_unwrap_Col_htrans_redirect { typedef quasi_unwrap_default result; }; - -template -struct quasi_unwrap_Col_htrans_redirect { typedef quasi_unwrap_Col_htrans result; }; - - -template -struct quasi_unwrap< Op, op_htrans> > - : public quasi_unwrap_Col_htrans_redirect< Op, op_htrans>, is_cx::value >::result - { - typedef typename quasi_unwrap_Col_htrans_redirect< Op, op_htrans>, is_cx::value >::result quasi_unwrap_Col_htrans_extra; - - inline - quasi_unwrap(const Op, op_htrans>& A) - : quasi_unwrap_Col_htrans_extra(A) - { - } - - static constexpr bool is_const = quasi_unwrap_Col_htrans_extra::is_const; - static constexpr bool has_subview = quasi_unwrap_Col_htrans_extra::has_subview; - static constexpr bool has_orig_mem = quasi_unwrap_Col_htrans_extra::has_orig_mem; - - using quasi_unwrap_Col_htrans_extra::M; - using quasi_unwrap_Col_htrans_extra::is_alias; - }; - - - -template -struct quasi_unwrap_Row_htrans - { - inline quasi_unwrap_Row_htrans(const T1&) {} - }; - - - -template -struct quasi_unwrap_Row_htrans< Op, op_htrans> > - { - inline - quasi_unwrap_Row_htrans(const Op, op_htrans>& A) - : orig(A.m) - , M (const_cast(A.m.memptr()), A.m.n_elem, false, false) - { - arma_debug_sigprint(); - } - - const Row& orig; - const Col M; - - static constexpr bool is_const = true; - static constexpr bool has_subview = true; - static constexpr bool has_orig_mem = true; - - template - arma_inline bool is_alias(const Mat& X) const { return (is_same_type::yes) && (void_ptr(&orig) == void_ptr(&X)); } - }; - - - -template -struct quasi_unwrap_Row_htrans_redirect {}; - -template -struct quasi_unwrap_Row_htrans_redirect { typedef quasi_unwrap_default result; }; - -template -struct quasi_unwrap_Row_htrans_redirect { typedef quasi_unwrap_Row_htrans result; }; - - -template -struct quasi_unwrap< Op, op_htrans> > - : public quasi_unwrap_Row_htrans_redirect< Op, op_htrans>, is_cx::value >::result - { - typedef typename quasi_unwrap_Row_htrans_redirect< Op, op_htrans>, is_cx::value >::result quasi_unwrap_Row_htrans_extra; - - inline - quasi_unwrap(const Op, op_htrans>& A) - : quasi_unwrap_Row_htrans_extra(A) - { - } - - static constexpr bool is_const = quasi_unwrap_Row_htrans_extra::is_const; - static constexpr bool has_subview = quasi_unwrap_Row_htrans_extra::has_subview; - static constexpr bool has_orig_mem = quasi_unwrap_Row_htrans_extra::has_orig_mem; - - using quasi_unwrap_Row_htrans_extra::M; - using quasi_unwrap_Row_htrans_extra::is_alias; - }; - - - -template -struct quasi_unwrap_subview_col_htrans - { - inline quasi_unwrap_subview_col_htrans(const T1&) {} - }; - - - -template -struct quasi_unwrap_subview_col_htrans< Op, op_htrans> > - { - inline - quasi_unwrap_subview_col_htrans(const Op, op_htrans>& A) - : orig(A.m.m) - , M (const_cast(A.m.colmem), A.m.n_rows, false, false) - { - arma_debug_sigprint(); - } - - const Mat& orig; - const Row M; - - static constexpr bool is_const = true; - static constexpr bool has_subview = true; - static constexpr bool has_orig_mem = true; - - template - arma_inline bool is_alias(const Mat& X) const { return (is_same_type::yes) && (void_ptr(&orig) == void_ptr(&X)); } - }; - - - -template -struct quasi_unwrap_subview_col_htrans_redirect {}; - -template -struct quasi_unwrap_subview_col_htrans_redirect { typedef quasi_unwrap_default result; }; - -template -struct quasi_unwrap_subview_col_htrans_redirect { typedef quasi_unwrap_subview_col_htrans result; }; - - -template -struct quasi_unwrap< Op, op_htrans> > - : public quasi_unwrap_subview_col_htrans_redirect< Op, op_htrans>, is_cx::value >::result - { - typedef typename quasi_unwrap_subview_col_htrans_redirect< Op, op_htrans>, is_cx::value >::result quasi_unwrap_subview_col_htrans_extra; - - inline - quasi_unwrap(const Op, op_htrans>& A) - : quasi_unwrap_subview_col_htrans_extra(A) - { - } - - static constexpr bool is_const = quasi_unwrap_subview_col_htrans_extra::is_const; - static constexpr bool has_subview = quasi_unwrap_subview_col_htrans_extra::has_subview; - static constexpr bool has_orig_mem = quasi_unwrap_subview_col_htrans_extra::has_orig_mem; - - using quasi_unwrap_subview_col_htrans_extra::M; - using quasi_unwrap_subview_col_htrans_extra::is_alias; - }; - - - -template -struct quasi_unwrap< CubeToMatOp > - { - typedef typename T1::elem_type eT; - - inline - quasi_unwrap(const CubeToMatOp& A) - : U( A.m ) - , M( const_cast(U.M.memptr()), U.M.n_elem, 1, false, true ) - { - arma_debug_sigprint(); - } - - const unwrap_cube U; - const Mat M; - - static constexpr bool is_const = true; - static constexpr bool has_subview = true; - static constexpr bool has_orig_mem = true; - - template - constexpr bool is_alias(const Mat&) const { return false; } - }; - - - -template -struct quasi_unwrap< SpToDOp, op_sp_nonzeros> > - { - inline - quasi_unwrap(const SpToDOp, op_sp_nonzeros>& A) - : orig( A.m ) - , M( const_cast(orig.values), orig.n_nonzero, 1, false, true ) - { - arma_debug_sigprint(); - } - - const SpMat& orig; - const Mat M; - - static constexpr bool is_const = true; - static constexpr bool has_subview = true; - static constexpr bool has_orig_mem = true; - - template - constexpr bool is_alias(const Mat&) const { return false; } - }; - - - -// -// -// - - - -template -struct unwrap_check_default - { - typedef typename T1::elem_type eT; - typedef Mat stored_type; - - inline - unwrap_check_default(const T1& A, const Mat&) - : M(A) - { - arma_debug_sigprint(); - } - - inline - unwrap_check_default(const T1& A, const bool) - : M(A) - { - arma_debug_sigprint(); - } - - const Mat M; - }; - - - -template -struct unwrap_check_fixed - { - typedef typename T1::elem_type eT; - typedef T1 stored_type; - - inline - unwrap_check_fixed(const T1& A, const Mat& B) - : M_local( (&A == &B) ? new T1(A) : nullptr ) - , M ( (&A == &B) ? *M_local : A ) - { - arma_debug_sigprint(); - } - - inline - unwrap_check_fixed(const T1& A, const bool is_alias) - : M_local( is_alias ? new T1(A) : nullptr ) - , M ( is_alias ? *M_local : A ) - { - arma_debug_sigprint(); - } - - inline - ~unwrap_check_fixed() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - - // the order below is important - const T1* M_local; - const T1& M; - }; - - - -template -struct unwrap_check_redirect {}; - -template -struct unwrap_check_redirect { typedef unwrap_check_default result; }; - -template -struct unwrap_check_redirect { typedef unwrap_check_fixed result; }; - - -template -struct unwrap_check : public unwrap_check_redirect::value>::result - { - inline unwrap_check(const T1& A, const Mat& B) - : unwrap_check_redirect::value>::result(A, B) - { - } - - inline unwrap_check(const T1& A, const bool is_alias) - : unwrap_check_redirect::value>::result(A, is_alias) - { - } - }; - - - -template -struct unwrap_check< Mat > - { - typedef Mat stored_type; - - inline - unwrap_check(const Mat& A, const Mat& B) - : M_local( (&A == &B) ? new Mat(A) : nullptr ) - , M ( (&A == &B) ? (*M_local) : A ) - { - arma_debug_sigprint(); - } - - inline - unwrap_check(const Mat& A, const bool is_alias) - : M_local( is_alias ? new Mat(A) : nullptr ) - , M ( is_alias ? (*M_local) : A ) - { - arma_debug_sigprint(); - } - - inline - ~unwrap_check() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - - // the order below is important - const Mat* M_local; - const Mat& M; - }; - - - -template -struct unwrap_check< Row > - { - typedef Row stored_type; - - inline - unwrap_check(const Row& A, const Mat& B) - : M_local( (&A == &B) ? new Row(A) : nullptr ) - , M ( (&A == &B) ? (*M_local) : A ) - { - arma_debug_sigprint(); - } - - inline - unwrap_check(const Row& A, const bool is_alias) - : M_local( is_alias ? new Row(A) : nullptr ) - , M ( is_alias ? (*M_local) : A ) - { - arma_debug_sigprint(); - } - - inline - ~unwrap_check() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - - // the order below is important - const Row* M_local; - const Row& M; - }; - - - -template -struct unwrap_check< Col > - { - typedef Col stored_type; - - inline - unwrap_check(const Col& A, const Mat& B) - : M_local( (&A == &B) ? new Col(A) : nullptr ) - , M ( (&A == &B) ? (*M_local) : A ) - { - arma_debug_sigprint(); - } - - inline - unwrap_check(const Col& A, const bool is_alias) - : M_local( is_alias ? new Col(A) : nullptr ) - , M ( is_alias ? (*M_local) : A ) - { - arma_debug_sigprint(); - } - - inline - ~unwrap_check() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - - // the order below is important - const Col* M_local; - const Col& M; - }; - - - -// -// -// - - - -template -struct unwrap_check_mixed - { - typedef typename T1::elem_type eT1; - - template - inline - unwrap_check_mixed(const T1& A, const Mat&) - : M(A) - { - arma_debug_sigprint(); - } - - //template - inline - unwrap_check_mixed(const T1& A, const bool) - : M(A) - { - arma_debug_sigprint(); - } - - const Mat M; - }; - - - -template -struct unwrap_check_mixed< Mat > - { - template - inline - unwrap_check_mixed(const Mat& A, const Mat& B) - : M_local( (void_ptr(&A) == void_ptr(&B)) ? new Mat(A) : nullptr ) - , M ( (void_ptr(&A) == void_ptr(&B)) ? (*M_local) : A ) - { - arma_debug_sigprint(); - } - - //template - inline - unwrap_check_mixed(const Mat& A, const bool is_alias) - : M_local( is_alias ? new Mat(A) : nullptr ) - , M ( is_alias ? (*M_local) : A ) - { - arma_debug_sigprint(); - } - - inline - ~unwrap_check_mixed() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - - // the order below is important - const Mat* M_local; - const Mat& M; - }; - - - -template -struct unwrap_check_mixed< Row > - { - template - inline - unwrap_check_mixed(const Row& A, const Mat& B) - : M_local( (void_ptr(&A) == void_ptr(&B)) ? new Row(A) : nullptr ) - , M ( (void_ptr(&A) == void_ptr(&B)) ? (*M_local) : A ) - { - arma_debug_sigprint(); - } - - - //template - inline - unwrap_check_mixed(const Row& A, const bool is_alias) - : M_local( is_alias ? new Row(A) : nullptr ) - , M ( is_alias ? (*M_local) : A ) - { - arma_debug_sigprint(); - } - - inline - ~unwrap_check_mixed() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - - // the order below is important - const Row* M_local; - const Row& M; - }; - - - -template -struct unwrap_check_mixed< Col > - { - template - inline - unwrap_check_mixed(const Col& A, const Mat& B) - : M_local( (void_ptr(&A) == void_ptr(&B)) ? new Col(A) : nullptr ) - , M ( (void_ptr(&A) == void_ptr(&B)) ? (*M_local) : A ) - { - arma_debug_sigprint(); - } - - //template - inline - unwrap_check_mixed(const Col& A, const bool is_alias) - : M_local( is_alias ? new Col(A) : nullptr ) - , M ( is_alias ? (*M_local) : A ) - { - arma_debug_sigprint(); - } - - inline - ~unwrap_check_mixed() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - - // the order below is important - const Col* M_local; - const Col& M; - }; - - - -// -// -// - - - -template -struct partial_unwrap_default - { - typedef typename T1::elem_type eT; - typedef Mat stored_type; - - inline - partial_unwrap_default(const T1& A) - : M(A) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - static constexpr bool do_trans = false; - static constexpr bool do_times = false; - static constexpr bool is_fast = false; - - const Mat M; - }; - - -template -struct partial_unwrap_fixed - { - typedef typename T1::elem_type eT; - typedef T1 stored_type; - - inline explicit - partial_unwrap_fixed(const T1& A) - : M(A) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&M)); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = false; - static constexpr bool is_fast = true; - - const T1& M; - }; - - - -template -struct partial_unwrap_redirect {}; - -template -struct partial_unwrap_redirect { typedef partial_unwrap_default result; }; - -template -struct partial_unwrap_redirect { typedef partial_unwrap_fixed result; }; - -template -struct partial_unwrap : public partial_unwrap_redirect::value>::result - { - inline - partial_unwrap(const T1& A) - : partial_unwrap_redirect< T1, is_Mat_fixed::value>::result(A) - { - } - }; - - - -template -struct partial_unwrap< Mat > - { - typedef Mat stored_type; - - inline - partial_unwrap(const Mat& A) - : M(A) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&M)); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = false; - static constexpr bool is_fast = true; - - const Mat& M; - }; - - - -template -struct partial_unwrap< Row > - { - typedef Row stored_type; - - inline - partial_unwrap(const Row& A) - : M(A) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&M)); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = false; - static constexpr bool is_fast = true; - - const Row& M; - }; - - - -template -struct partial_unwrap< Col > - { - typedef Col stored_type; - - inline - partial_unwrap(const Col& A) - : M(A) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&M)); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = false; - static constexpr bool is_fast = true; - - const Col& M; - }; - - - -template -struct partial_unwrap< subview > - { - typedef Mat stored_type; - - inline - partial_unwrap(const subview& A) - : sv( A ) - , M ( A, ((A.aux_row1 == 0) && (A.n_rows == A.m.n_rows)) ) // reuse memory if the subview is a contiguous chunk - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - template - arma_inline bool is_alias(const Mat& X) const { return ( ((sv.aux_row1 == 0) && (sv.n_rows == sv.m.n_rows)) ? (void_ptr(&(sv.m)) == void_ptr(&X)) : false ); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = false; - static constexpr bool is_fast = false; // can't determine at compile time that memory is reused - - const subview& sv; - const Mat M; - }; - - - -template -struct partial_unwrap< subview_col > - { - typedef Col stored_type; - - inline - partial_unwrap(const subview_col& A) - : orig( A.m ) - , M ( const_cast( A.colmem ), A.n_rows, false, false ) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&orig)); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = false; - static constexpr bool is_fast = true; - - const Mat& orig; - const Col M; - }; - - - -template -struct partial_unwrap< subview_cols > - { - typedef Mat stored_type; - - inline - partial_unwrap(const subview_cols& A) - : orig( A.m ) - , M ( const_cast( A.colptr(0) ), A.n_rows, A.n_cols, false, false ) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&orig)); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = false; - static constexpr bool is_fast = true; - - const Mat& orig; - const Mat M; - }; - - - -template -struct partial_unwrap< subview_row > - { - typedef Row stored_type; - - inline - partial_unwrap(const subview_row& A) - : M(A) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - static constexpr bool do_trans = false; - static constexpr bool do_times = false; - static constexpr bool is_fast = false; - - const Row M; - }; - - - -template -struct partial_unwrap_htrans_default - { - typedef typename T1::elem_type eT; - typedef Mat stored_type; - - inline - partial_unwrap_htrans_default(const Op& A) - : M(A.m) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - static constexpr bool do_trans = true; - static constexpr bool do_times = false; - static constexpr bool is_fast = false; - - const Mat M; - }; - - -template -struct partial_unwrap_htrans_fixed - { - typedef typename T1::elem_type eT; - typedef T1 stored_type; - - inline explicit - partial_unwrap_htrans_fixed(const Op& A) - : M(A.m) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&M)); } - - static constexpr bool do_trans = true; - static constexpr bool do_times = false; - static constexpr bool is_fast = true; - - const T1& M; - }; - - - -template -struct partial_unwrap_htrans_redirect {}; - -template -struct partial_unwrap_htrans_redirect { typedef partial_unwrap_htrans_default result; }; - -template -struct partial_unwrap_htrans_redirect { typedef partial_unwrap_htrans_fixed result; }; - -template -struct partial_unwrap< Op > : public partial_unwrap_htrans_redirect::value>::result - { - inline partial_unwrap(const Op& A) - : partial_unwrap_htrans_redirect::value>::result(A) - { - } - }; - - - -template -struct partial_unwrap< Op< Mat, op_htrans> > - { - typedef Mat stored_type; - - inline - partial_unwrap(const Op< Mat, op_htrans>& A) - : M(A.m) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&M)); } - - static constexpr bool do_trans = true; - static constexpr bool do_times = false; - static constexpr bool is_fast = true; - - const Mat& M; - }; - - - -template -struct partial_unwrap< Op< Row, op_htrans> > - { - typedef Row stored_type; - - inline - partial_unwrap(const Op< Row, op_htrans>& A) - : M(A.m) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&M)); } - - static constexpr bool do_trans = true; - static constexpr bool do_times = false; - static constexpr bool is_fast = true; - - const Row& M; - }; - - - -template -struct partial_unwrap< Op< Col, op_htrans> > - { - typedef Col stored_type; - - inline - partial_unwrap(const Op< Col, op_htrans>& A) - : M(A.m) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&M)); } - - static constexpr bool do_trans = true; - static constexpr bool do_times = false; - static constexpr bool is_fast = true; - - const Col& M; - }; - - - -template -struct partial_unwrap< Op< subview, op_htrans> > - { - typedef Mat stored_type; - - inline - partial_unwrap(const Op< subview, op_htrans>& A) - : sv( A.m ) - , M ( A.m, ((A.m.aux_row1 == 0) && (A.m.n_rows == A.m.m.n_rows)) ) // reuse memory if the subview is a contiguous chunk - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - template - arma_inline bool is_alias(const Mat& X) const { return ( ((sv.aux_row1 == 0) && (sv.n_rows == sv.m.n_rows)) ? (void_ptr(&(sv.m)) == void_ptr(&X)) : false ); } - - static constexpr bool do_trans = true; - static constexpr bool do_times = false; - static constexpr bool is_fast = false; // can't determine at compile time that memory is reused - - const subview& sv; - const Mat M; - }; - - - -template -struct partial_unwrap< Op< subview_cols, op_htrans> > - { - typedef Mat stored_type; - - inline - partial_unwrap(const Op< subview_cols, op_htrans>& A) - : orig( A.m.m ) - , M ( const_cast( A.m.colptr(0) ), A.m.n_rows, A.m.n_cols, false, false ) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&orig) == void_ptr(&X)); } - - static constexpr bool do_trans = true; - static constexpr bool do_times = false; - static constexpr bool is_fast = true; - - const Mat& orig; - const Mat M; - }; - - - -template -struct partial_unwrap< Op< subview_col, op_htrans> > - { - typedef Col stored_type; - - inline - partial_unwrap(const Op< subview_col, op_htrans>& A) - : orig( A.m.m ) - , M ( const_cast( A.m.colmem ), A.m.n_rows, false, false ) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&orig)); } - - static constexpr bool do_trans = true; - static constexpr bool do_times = false; - static constexpr bool is_fast = true; - - const Mat& orig; - const Col M; - }; - - - -template -struct partial_unwrap< Op< subview_row, op_htrans> > - { - typedef Row stored_type; - - inline - partial_unwrap(const Op< subview_row, op_htrans>& A) - : M(A.m) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - static constexpr bool do_trans = true; - static constexpr bool do_times = false; - static constexpr bool is_fast = false; - - const Row M; - }; - - - -template -struct partial_unwrap_htrans2_default - { - typedef typename T1::elem_type eT; - typedef Mat stored_type; - - inline - partial_unwrap_htrans2_default(const Op& A) - : val(A.aux) - , M (A.m) - { - arma_debug_sigprint(); - } - - arma_inline eT get_val() const { return val; } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - static constexpr bool do_trans = true; - static constexpr bool do_times = true; - static constexpr bool is_fast = false; - - const eT val; - const Mat M; - }; - - -template -struct partial_unwrap_htrans2_fixed - { - typedef typename T1::elem_type eT; - typedef T1 stored_type; - - inline explicit - partial_unwrap_htrans2_fixed(const Op& A) - : val(A.aux) - , M (A.m) - { - arma_debug_sigprint(); - } - - arma_inline eT get_val() const { return val; } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&M)); } - - static constexpr bool do_trans = true; - static constexpr bool do_times = true; - static constexpr bool is_fast = true; - - const eT val; - const T1& M; - }; - - - -template -struct partial_unwrap_htrans2_redirect {}; - -template -struct partial_unwrap_htrans2_redirect { typedef partial_unwrap_htrans2_default result; }; - -template -struct partial_unwrap_htrans2_redirect { typedef partial_unwrap_htrans2_fixed result; }; - -template -struct partial_unwrap< Op > : public partial_unwrap_htrans2_redirect::value>::result - { - inline partial_unwrap(const Op& A) - : partial_unwrap_htrans2_redirect::value>::result(A) - { - } - }; - - - -template -struct partial_unwrap< Op< Mat, op_htrans2> > - { - typedef Mat stored_type; - - inline - partial_unwrap(const Op< Mat, op_htrans2>& A) - : val(A.aux) - , M (A.m) - { - arma_debug_sigprint(); - } - - inline eT get_val() const { return val; } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&M)); } - - static constexpr bool do_trans = true; - static constexpr bool do_times = true; - static constexpr bool is_fast = true; - - const eT val; - const Mat& M; - }; - - - -template -struct partial_unwrap< Op< Row, op_htrans2> > - { - typedef Row stored_type; - - inline - partial_unwrap(const Op< Row, op_htrans2>& A) - : val(A.aux) - , M (A.m) - { - arma_debug_sigprint(); - } - - inline eT get_val() const { return val; } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&M)); } - - static constexpr bool do_trans = true; - static constexpr bool do_times = true; - static constexpr bool is_fast = true; - - const eT val; - const Row& M; - }; - - - -template -struct partial_unwrap< Op< Col, op_htrans2> > - { - typedef Col stored_type; - - inline - partial_unwrap(const Op< Col, op_htrans2>& A) - : val(A.aux) - , M (A.m) - { - arma_debug_sigprint(); - } - - inline eT get_val() const { return val; } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&M)); } - - static constexpr bool do_trans = true; - static constexpr bool do_times = true; - static constexpr bool is_fast = true; - - const eT val; - const Col& M; - }; - - - -template -struct partial_unwrap< Op< subview, op_htrans2> > - { - typedef Mat stored_type; - - inline - partial_unwrap(const Op< subview, op_htrans2>& A) - : sv ( A.m ) - , val( A.aux ) - , M ( A.m, ((A.m.aux_row1 == 0) && (A.m.n_rows == A.m.m.n_rows)) ) // reuse memory if the subview is a contiguous chunk - { - arma_debug_sigprint(); - } - - inline eT get_val() const { return val; } - - template - arma_inline bool is_alias(const Mat& X) const { return ( ((sv.aux_row1 == 0) && (sv.n_rows == sv.m.n_rows)) ? (void_ptr(&(sv.m)) == void_ptr(&X)) : false ); } - - static constexpr bool do_trans = true; - static constexpr bool do_times = true; - static constexpr bool is_fast = false; // can't determine at compile time that memory is reused - - const subview& sv; - const eT val; - const Mat M; - }; - - - -template -struct partial_unwrap< Op< subview_cols, op_htrans2> > - { - typedef Mat stored_type; - - inline - partial_unwrap(const Op< subview_cols, op_htrans2>& A) - : orig( A.m.m ) - , val ( A.aux ) - , M ( const_cast( A.m.colptr(0) ), A.m.n_rows, A.m.n_cols, false, false ) - { - arma_debug_sigprint(); - } - - inline eT get_val() const { return val; } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&orig) == void_ptr(&X)); } - - static constexpr bool do_trans = true; - static constexpr bool do_times = true; - static constexpr bool is_fast = true; - - const Mat& orig; - const eT val; - const Mat M; - }; - - - -template -struct partial_unwrap< Op< subview_col, op_htrans2> > - { - typedef Col stored_type; - - inline - partial_unwrap(const Op< subview_col, op_htrans2>& A) - : orig( A.m.m ) - , val ( A.aux ) - , M ( const_cast( A.m.colmem ), A.m.n_rows, false, false ) - { - arma_debug_sigprint(); - } - - inline eT get_val() const { return val; } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&orig)); } - - static constexpr bool do_trans = true; - static constexpr bool do_times = true; - static constexpr bool is_fast = true; - - const Mat& orig; - - const eT val; - const Col M; - }; - - - -template -struct partial_unwrap< Op< subview_row, op_htrans2> > - { - typedef Row stored_type; - - inline - partial_unwrap(const Op< subview_row, op_htrans2>& A) - : val(A.aux) - , M (A.m ) - { - arma_debug_sigprint(); - } - - arma_inline eT get_val() const { return val; } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - static constexpr bool do_trans = true; - static constexpr bool do_times = true; - static constexpr bool is_fast = false; - - const eT val; - const Row M; - }; - - - -template -struct partial_unwrap_scalar_times_default - { - typedef typename T1::elem_type eT; - typedef Mat stored_type; - - inline - partial_unwrap_scalar_times_default(const eOp& A) - : val(A.aux) - , M (A.P.Q) - { - arma_debug_sigprint(); - } - - arma_inline eT get_val() const { return val; } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - static constexpr bool is_fast = false; - - const eT val; - const Mat M; - }; - - - -template -struct partial_unwrap_scalar_times_fixed - { - typedef typename T1::elem_type eT; - typedef T1 stored_type; - - inline explicit - partial_unwrap_scalar_times_fixed(const eOp& A) - : val(A.aux) - , M (A.P.Q) - { - arma_debug_sigprint(); - } - - arma_inline eT get_val() const { return val; } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&M)); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - static constexpr bool is_fast = true; - - const eT val; - const T1& M; - }; - - - -template -struct partial_unwrap_scalar_times_redirect {}; - -template -struct partial_unwrap_scalar_times_redirect { typedef partial_unwrap_scalar_times_default result; }; - -template -struct partial_unwrap_scalar_times_redirect { typedef partial_unwrap_scalar_times_fixed result; }; - - -template -struct partial_unwrap< eOp > : public partial_unwrap_scalar_times_redirect::value>::result - { - typedef typename T1::elem_type eT; - - inline - partial_unwrap(const eOp& A) - : partial_unwrap_scalar_times_redirect< T1, is_Mat_fixed::value>::result(A) - { - } - }; - - - -template -struct partial_unwrap< eOp, eop_scalar_times> > - { - typedef Mat stored_type; - - inline - partial_unwrap(const eOp,eop_scalar_times>& A) - : val(A.aux) - , M (A.P.Q) - { - arma_debug_sigprint(); - } - - inline eT get_val() const { return val; } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&M)); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - static constexpr bool is_fast = true; - - const eT val; - const Mat& M; - }; - - - -template -struct partial_unwrap< eOp, eop_scalar_times> > - { - typedef Row stored_type; - - inline - partial_unwrap(const eOp,eop_scalar_times>& A) - : val(A.aux) - , M (A.P.Q) - { - arma_debug_sigprint(); - } - - inline eT get_val() const { return val; } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&M)); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - static constexpr bool is_fast = true; - - const eT val; - const Row& M; - }; - - - -template -struct partial_unwrap< eOp, eop_scalar_times> > - { - typedef Col stored_type; - - inline - partial_unwrap(const eOp,eop_scalar_times>& A) - : val(A.aux) - , M (A.P.Q) - { - arma_debug_sigprint(); - } - - inline eT get_val() const { return val; } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&M)); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - static constexpr bool is_fast = true; - - const eT val; - const Col& M; - }; - - - -template -struct partial_unwrap< eOp, eop_scalar_times> > - { - typedef Col stored_type; - - inline - partial_unwrap(const eOp,eop_scalar_times>& A) - : orig( A.P.Q.m ) - , val ( A.aux ) - , M ( const_cast( A.P.Q.colmem ), A.P.Q.n_rows, false, false ) - { - arma_debug_sigprint(); - } - - arma_inline eT get_val() const { return val; } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&orig)); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - static constexpr bool is_fast = true; - - const Mat& orig; - - const eT val; - const Col M; - }; - - - -template -struct partial_unwrap< eOp, eop_scalar_times> > - { - typedef Row stored_type; - - inline - partial_unwrap(const eOp,eop_scalar_times>& A) - : val(A.aux) - , M (A.P.Q) - { - arma_debug_sigprint(); - } - - arma_inline eT get_val() const { return val; } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - static constexpr bool is_fast = false; - - const eT val; - const Row M; - }; - - - -template -struct partial_unwrap_neg_default - { - typedef typename T1::elem_type eT; - typedef Mat stored_type; - - inline - partial_unwrap_neg_default(const eOp& A) - : M(A.P.Q) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(-1); } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - static constexpr bool is_fast = false; - - const Mat M; - }; - - - -template -struct partial_unwrap_neg_fixed - { - typedef typename T1::elem_type eT; - typedef T1 stored_type; - - inline explicit - partial_unwrap_neg_fixed(const eOp& A) - : M(A.P.Q) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(-1); } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&M)); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - static constexpr bool is_fast = true; - - const T1& M; - }; - - - -template -struct partial_unwrap_neg_redirect {}; - -template -struct partial_unwrap_neg_redirect { typedef partial_unwrap_neg_default result; }; - -template -struct partial_unwrap_neg_redirect { typedef partial_unwrap_neg_fixed result; }; - - -template -struct partial_unwrap< eOp > : public partial_unwrap_neg_redirect::value>::result - { - typedef typename T1::elem_type eT; - - inline - partial_unwrap(const eOp& A) - : partial_unwrap_neg_redirect< T1, is_Mat_fixed::value>::result(A) - { - } - }; - - - -template -struct partial_unwrap< eOp, eop_neg> > - { - typedef Mat stored_type; - - inline - partial_unwrap(const eOp,eop_neg>& A) - : M(A.P.Q) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(-1); } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&M)); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - static constexpr bool is_fast = true; - - const Mat& M; - }; - - - -template -struct partial_unwrap< eOp, eop_neg> > - { - typedef Row stored_type; - - inline - partial_unwrap(const eOp,eop_neg>& A) - : M(A.P.Q) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(-1); } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&M)); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - static constexpr bool is_fast = true; - - const Row& M; - }; - - - -template -struct partial_unwrap< eOp, eop_neg> > - { - typedef Col stored_type; - - inline - partial_unwrap(const eOp,eop_neg>& A) - : M(A.P.Q) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(-1); } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&M)); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - static constexpr bool is_fast = true; - - const Col& M; - }; - - - -template -struct partial_unwrap< eOp, eop_neg> > - { - typedef Col stored_type; - - inline - partial_unwrap(const eOp,eop_neg>& A) - : orig( A.P.Q.m ) - , M ( const_cast( A.P.Q.colmem ), A.P.Q.n_rows, false, false ) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(-1); } - - template - arma_inline bool is_alias(const Mat& X) const { return (void_ptr(&X) == void_ptr(&orig)); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - static constexpr bool is_fast = true; - - const Mat& orig; - const Col M; - }; - - - -template -struct partial_unwrap< eOp, eop_neg> > - { - typedef Row stored_type; - - inline - partial_unwrap(const eOp,eop_neg>& A) - : M(A.P.Q) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(-1); } - - template - constexpr bool is_alias(const Mat&) const { return false; } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - static constexpr bool is_fast = false; - - const Row M; - }; - - - -// - - - -template -struct partial_unwrap_check_default - { - typedef typename T1::elem_type eT; - typedef Mat stored_type; - - inline - partial_unwrap_check_default(const T1& A, const Mat&) - : M(A) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = false; - - const Mat M; - }; - - -template -struct partial_unwrap_check_fixed - { - typedef typename T1::elem_type eT; - typedef T1 stored_type; - - inline explicit - partial_unwrap_check_fixed(const T1& A, const Mat& B) - : M_local( (&A == &B) ? new T1(A) : nullptr ) - , M ( (&A == &B) ? (*M_local) : A ) - { - arma_debug_sigprint(); - } - - inline - ~partial_unwrap_check_fixed() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - constexpr eT get_val() const { return eT(1); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = false; - - const T1* M_local; - const T1& M; - }; - - - -template -struct partial_unwrap_check_redirect {}; - -template -struct partial_unwrap_check_redirect { typedef partial_unwrap_check_default result; }; - -template -struct partial_unwrap_check_redirect { typedef partial_unwrap_check_fixed result; }; - -template -struct partial_unwrap_check : public partial_unwrap_check_redirect::value>::result - { - typedef typename T1::elem_type eT; - - inline partial_unwrap_check(const T1& A, const Mat& B) - : partial_unwrap_check_redirect::value>::result(A, B) - { - } - }; - - - -template -struct partial_unwrap_check< Mat > - { - typedef Mat stored_type; - - inline - partial_unwrap_check(const Mat& A, const Mat& B) - : M_local ( (&A == &B) ? new Mat(A) : nullptr ) - , M ( (&A == &B) ? (*M_local) : A ) - { - arma_debug_sigprint(); - } - - - inline - ~partial_unwrap_check() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - constexpr eT get_val() const { return eT(1); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = false; - - // the order below is important - const Mat* M_local; - const Mat& M; - }; - - - -template -struct partial_unwrap_check< Row > - { - typedef Row stored_type; - - inline - partial_unwrap_check(const Row& A, const Mat& B) - : M_local ( (&A == &B) ? new Row(A) : nullptr ) - , M ( (&A == &B) ? (*M_local) : A ) - { - arma_debug_sigprint(); - } - - - inline - ~partial_unwrap_check() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - constexpr eT get_val() const { return eT(1); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = false; - - // the order below is important - const Row* M_local; - const Row& M; - }; - - - -template -struct partial_unwrap_check< Col > - { - typedef Col stored_type; - - inline - partial_unwrap_check(const Col& A, const Mat& B) - : M_local ( (&A == &B) ? new Col(A) : nullptr ) - , M ( (&A == &B) ? (*M_local) : A ) - { - arma_debug_sigprint(); - } - - - inline - ~partial_unwrap_check() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - constexpr eT get_val() const { return eT(1); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = false; - - // the order below is important - const Col* M_local; - const Col& M; - }; - - - -// NOTE: we can get away with this shortcut as the partial_unwrap_check class is only used by the glue_times class, -// NOTE: which relies on partial_unwrap_check to check for aliasing -template -struct partial_unwrap_check< subview_col > - { - typedef Col stored_type; - - inline - partial_unwrap_check(const subview_col& A, const Mat& B) - : M ( const_cast( A.colmem ), A.n_rows, (&(A.m) == &B), false ) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = false; - - const Col M; - }; - - - -template -struct partial_unwrap_check_htrans_default - { - typedef typename T1::elem_type eT; - typedef Mat stored_type; - - inline - partial_unwrap_check_htrans_default(const Op& A, const Mat&) - : M(A.m) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - static constexpr bool do_trans = true; - static constexpr bool do_times = false; - - const Mat M; - }; - - -template -struct partial_unwrap_check_htrans_fixed - { - typedef typename T1::elem_type eT; - typedef T1 stored_type; - - inline explicit - partial_unwrap_check_htrans_fixed(const Op& A, const Mat& B) - : M_local( (&(A.m) == &B) ? new T1(A.m) : nullptr ) - , M ( (&(A.m) == &B) ? (*M_local) : A.m ) - { - arma_debug_sigprint(); - } - - inline - ~partial_unwrap_check_htrans_fixed() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - constexpr eT get_val() const { return eT(1); } - - static constexpr bool do_trans = true; - static constexpr bool do_times = false; - - const T1* M_local; - const T1& M; - }; - - - -template -struct partial_unwrap_check_htrans_redirect {}; - -template -struct partial_unwrap_check_htrans_redirect { typedef partial_unwrap_check_htrans_default result; }; - -template -struct partial_unwrap_check_htrans_redirect { typedef partial_unwrap_check_htrans_fixed result; }; - - -template -struct partial_unwrap_check< Op > : public partial_unwrap_check_htrans_redirect::value>::result - { - typedef typename T1::elem_type eT; - - inline partial_unwrap_check(const Op& A, const Mat& B) - : partial_unwrap_check_htrans_redirect::value>::result(A, B) - { - } - }; - - - -template -struct partial_unwrap_check< Op< Mat, op_htrans> > - { - typedef Mat stored_type; - - inline - partial_unwrap_check(const Op< Mat, op_htrans>& A, const Mat& B) - : M_local ( (&A.m == &B) ? new Mat(A.m) : nullptr ) - , M ( (&A.m == &B) ? (*M_local) : A.m ) - { - arma_debug_sigprint(); - } - - inline - ~partial_unwrap_check() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - constexpr eT get_val() const { return eT(1); } - - static constexpr bool do_trans = true; - static constexpr bool do_times = false; - - // the order below is important - const Mat* M_local; - const Mat& M; - }; - - - -template -struct partial_unwrap_check< Op< Row, op_htrans> > - { - typedef Row stored_type; - - inline - partial_unwrap_check(const Op< Row, op_htrans>& A, const Mat& B) - : M_local ( (&A.m == &B) ? new Row(A.m) : nullptr ) - , M ( (&A.m == &B) ? (*M_local) : A.m ) - { - arma_debug_sigprint(); - } - - inline - ~partial_unwrap_check() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - constexpr eT get_val() const { return eT(1); } - - static constexpr bool do_trans = true; - static constexpr bool do_times = false; - - // the order below is important - const Row* M_local; - const Row& M; - }; - - - -template -struct partial_unwrap_check< Op< Col, op_htrans> > - { - typedef Col stored_type; - - inline - partial_unwrap_check(const Op< Col, op_htrans>& A, const Mat& B) - : M_local ( (&A.m == &B) ? new Col(A.m) : nullptr ) - , M ( (&A.m == &B) ? (*M_local) : A.m ) - { - arma_debug_sigprint(); - } - - inline - ~partial_unwrap_check() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - constexpr eT get_val() const { return eT(1); } - - static constexpr bool do_trans = true; - static constexpr bool do_times = false; - - // the order below is important - const Col* M_local; - const Col& M; - }; - - - -// NOTE: we can get away with this shortcut as the partial_unwrap_check class is only used by the glue_times class, -// NOTE: which relies on partial_unwrap_check to check for aliasing -template -struct partial_unwrap_check< Op< subview_col, op_htrans> > - { - typedef Col stored_type; - - inline - partial_unwrap_check(const Op< subview_col, op_htrans>& A, const Mat& B) - : M ( const_cast( A.m.colmem ), A.m.n_rows, (&(A.m.m) == &B), false ) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(1); } - - static constexpr bool do_trans = true; - static constexpr bool do_times = false; - - const Col M; - }; - - - -template -struct partial_unwrap_check_htrans2_default - { - typedef typename T1::elem_type eT; - typedef Mat stored_type; - - inline - partial_unwrap_check_htrans2_default(const Op& A, const Mat&) - : val(A.aux) - , M (A.m) - { - arma_debug_sigprint(); - } - - arma_inline eT get_val() const { return val; } - - static constexpr bool do_trans = true; - static constexpr bool do_times = true; - - const eT val; - const Mat M; - }; - - - -template -struct partial_unwrap_check_htrans2_fixed - { - typedef typename T1::elem_type eT; - typedef T1 stored_type; - - inline explicit - partial_unwrap_check_htrans2_fixed(const Op& A, const Mat& B) - : val (A.aux) - , M_local( (&(A.m) == &B) ? new T1(A.m) : nullptr ) - , M ( (&(A.m) == &B) ? (*M_local) : A.m ) - { - arma_debug_sigprint(); - } - - inline - ~partial_unwrap_check_htrans2_fixed() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - arma_inline eT get_val() const { return val; } - - static constexpr bool do_trans = true; - static constexpr bool do_times = true; - - const eT val; - const T1* M_local; - const T1& M; - }; - - - -template -struct partial_unwrap_check_htrans2_redirect {}; - -template -struct partial_unwrap_check_htrans2_redirect { typedef partial_unwrap_check_htrans2_default result; }; - -template -struct partial_unwrap_check_htrans2_redirect { typedef partial_unwrap_check_htrans2_fixed result; }; - - -template -struct partial_unwrap_check< Op > : public partial_unwrap_check_htrans2_redirect::value>::result - { - typedef typename T1::elem_type eT; - - inline partial_unwrap_check(const Op& A, const Mat& B) - : partial_unwrap_check_htrans2_redirect::value>::result(A, B) - { - } - }; - - - -template -struct partial_unwrap_check< Op< Mat, op_htrans2> > - { - typedef Mat stored_type; - - inline - partial_unwrap_check(const Op< Mat, op_htrans2>& A, const Mat& B) - : val (A.aux) - , M_local ( (&A.m == &B) ? new Mat(A.m) : nullptr ) - , M ( (&A.m == &B) ? (*M_local) : A.m ) - { - arma_debug_sigprint(); - } - - inline - ~partial_unwrap_check() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - arma_inline eT get_val() const { return val; } - - static constexpr bool do_trans = true; - static constexpr bool do_times = true; - - // the order below is important - const eT val; - const Mat* M_local; - const Mat& M; - }; - - - -template -struct partial_unwrap_check< Op< Row, op_htrans2> > - { - typedef Row stored_type; - - inline - partial_unwrap_check(const Op< Row, op_htrans2>& A, const Mat& B) - : val (A.aux) - , M_local ( (&A.m == &B) ? new Row(A.m) : nullptr ) - , M ( (&A.m == &B) ? (*M_local) : A.m ) - { - arma_debug_sigprint(); - } - - inline - ~partial_unwrap_check() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - arma_inline eT get_val() const { return val; } - - static constexpr bool do_trans = true; - static constexpr bool do_times = true; - - // the order below is important - const eT val; - const Row* M_local; - const Row& M; - }; - - - -template -struct partial_unwrap_check< Op< Col, op_htrans2> > - { - typedef Col stored_type; - - inline - partial_unwrap_check(const Op< Col, op_htrans2>& A, const Mat& B) - : val (A.aux) - , M_local ( (&A.m == &B) ? new Col(A.m) : nullptr ) - , M ( (&A.m == &B) ? (*M_local) : A.m ) - { - arma_debug_sigprint(); - } - - inline - ~partial_unwrap_check() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - arma_inline eT get_val() const { return val; } - - static constexpr bool do_trans = true; - static constexpr bool do_times = true; - - // the order below is important - const eT val; - const Col* M_local; - const Col& M; - }; - - - -// NOTE: we can get away with this shortcut as the partial_unwrap_check class is only used by the glue_times class, -// NOTE: which relies on partial_unwrap_check to check for aliasing -template -struct partial_unwrap_check< Op< subview_col, op_htrans2> > - { - typedef Col stored_type; - - inline - partial_unwrap_check(const Op< subview_col, op_htrans2>& A, const Mat& B) - : val( A.aux ) - , M ( const_cast( A.m.colmem ), A.m.n_rows, (&(A.m.m) == &B), false ) - { - arma_debug_sigprint(); - } - - arma_inline eT get_val() const { return val; } - - static constexpr bool do_trans = true; - static constexpr bool do_times = true; - - const eT val; - const Col M; - }; - - - -template -struct partial_unwrap_check_scalar_times_default - { - typedef typename T1::elem_type eT; - typedef Mat stored_type; - - inline - partial_unwrap_check_scalar_times_default(const eOp& A, const Mat&) - : val(A.aux) - , M (A.P.Q) - { - arma_debug_sigprint(); - } - - arma_inline eT get_val() const { return val; } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - - const eT val; - const Mat M; - }; - - - -template -struct partial_unwrap_check_scalar_times_fixed - { - typedef typename T1::elem_type eT; - typedef T1 stored_type; - - inline explicit - partial_unwrap_check_scalar_times_fixed(const eOp& A, const Mat& B) - : val ( A.aux ) - , M_local( (&(A.P.Q) == &B) ? new T1(A.P.Q) : nullptr ) - , M ( (&(A.P.Q) == &B) ? (*M_local) : A.P.Q ) - { - arma_debug_sigprint(); - } - - inline - ~partial_unwrap_check_scalar_times_fixed() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - arma_inline eT get_val() const { return val; } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - - const eT val; - const T1* M_local; - const T1& M; - }; - - - -template -struct partial_unwrap_check_scalar_times_redirect {}; - -template -struct partial_unwrap_check_scalar_times_redirect { typedef partial_unwrap_check_scalar_times_default result; }; - -template -struct partial_unwrap_check_scalar_times_redirect { typedef partial_unwrap_check_scalar_times_fixed result; }; - - -template -struct partial_unwrap_check< eOp > : public partial_unwrap_check_scalar_times_redirect::value>::result - { - typedef typename T1::elem_type eT; - - inline partial_unwrap_check(const eOp& A, const Mat& B) - : partial_unwrap_check_scalar_times_redirect::value>::result(A, B) - { - } - }; - - - -template -struct partial_unwrap_check< eOp, eop_scalar_times> > - { - typedef Mat stored_type; - - inline - partial_unwrap_check(const eOp,eop_scalar_times>& A, const Mat& B) - : val (A.aux) - , M_local( (&(A.P.Q) == &B) ? new Mat(A.P.Q) : nullptr ) - , M ( (&(A.P.Q) == &B) ? *M_local : A.P.Q ) - { - arma_debug_sigprint(); - } - - inline - ~partial_unwrap_check() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - arma_inline eT get_val() const { return val; } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - - const eT val; - const Mat* M_local; - const Mat& M; - }; - - - -template -struct partial_unwrap_check< eOp, eop_scalar_times> > - { - typedef Row stored_type; - - inline - partial_unwrap_check(const eOp,eop_scalar_times>& A, const Mat& B) - : val(A.aux) - , M_local( (&(A.P.Q) == &B) ? new Row(A.P.Q) : nullptr ) - , M ( (&(A.P.Q) == &B) ? *M_local : A.P.Q ) - { - arma_debug_sigprint(); - } - - inline - ~partial_unwrap_check() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - arma_inline eT get_val() const { return val; } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - - const eT val; - const Row* M_local; - const Row& M; - }; - - - -template -struct partial_unwrap_check< eOp, eop_scalar_times> > - { - typedef Col stored_type; - - inline - partial_unwrap_check(const eOp,eop_scalar_times>& A, const Mat& B) - : val ( A.aux ) - , M_local( (&(A.P.Q) == &B) ? new Col(A.P.Q) : nullptr ) - , M ( (&(A.P.Q) == &B) ? *M_local : A.P.Q ) - { - arma_debug_sigprint(); - } - - inline - ~partial_unwrap_check() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - arma_inline eT get_val() const { return val; } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - - const eT val; - const Col* M_local; - const Col& M; - }; - - - -// NOTE: we can get away with this shortcut as the partial_unwrap_check class is only used by the glue_times class, -// NOTE: which relies on partial_unwrap_check to check for aliasing -template -struct partial_unwrap_check< eOp, eop_scalar_times> > - { - typedef Col stored_type; - - inline - partial_unwrap_check(const eOp,eop_scalar_times>& A, const Mat& B) - : val( A.aux ) - , M ( const_cast( A.P.Q.colmem ), A.P.Q.n_rows, (&(A.P.Q.m) == &B), false ) - { - arma_debug_sigprint(); - } - - arma_inline eT get_val() const { return val; } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - - const eT val; - const Col M; - }; - - - -template -struct partial_unwrap_check_neg_default - { - typedef typename T1::elem_type eT; - typedef Mat stored_type; - - inline - partial_unwrap_check_neg_default(const eOp& A, const Mat&) - : M(A.P.Q) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(-1); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - - const Mat M; - }; - - - -template -struct partial_unwrap_check_neg_fixed - { - typedef typename T1::elem_type eT; - typedef T1 stored_type; - - inline explicit - partial_unwrap_check_neg_fixed(const eOp& A, const Mat& B) - : M_local( (&(A.P.Q) == &B) ? new T1(A.P.Q) : nullptr ) - , M ( (&(A.P.Q) == &B) ? (*M_local) : A.P.Q ) - { - arma_debug_sigprint(); - } - - inline - ~partial_unwrap_check_neg_fixed() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - constexpr eT get_val() const { return eT(-1); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - - const T1* M_local; - const T1& M; - }; - - - -template -struct partial_unwrap_check_neg_redirect {}; - -template -struct partial_unwrap_check_neg_redirect { typedef partial_unwrap_check_neg_default result; }; - -template -struct partial_unwrap_check_neg_redirect { typedef partial_unwrap_check_neg_fixed result; }; - - -template -struct partial_unwrap_check< eOp > : public partial_unwrap_check_neg_redirect::value>::result - { - typedef typename T1::elem_type eT; - - inline partial_unwrap_check(const eOp& A, const Mat& B) - : partial_unwrap_check_neg_redirect::value>::result(A, B) - { - } - }; - - - -template -struct partial_unwrap_check< eOp, eop_neg> > - { - typedef Mat stored_type; - - inline - partial_unwrap_check(const eOp,eop_neg>& A, const Mat& B) - : M_local( (&(A.P.Q) == &B) ? new Mat(A.P.Q) : nullptr ) - , M ( (&(A.P.Q) == &B) ? *M_local : A.P.Q ) - { - arma_debug_sigprint(); - } - - inline - ~partial_unwrap_check() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - constexpr eT get_val() const { return eT(-1); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - - const Mat* M_local; - const Mat& M; - }; - - - -template -struct partial_unwrap_check< eOp, eop_neg> > - { - typedef Row stored_type; - - inline - partial_unwrap_check(const eOp,eop_neg>& A, const Mat& B) - : M_local( (&(A.P.Q) == &B) ? new Row(A.P.Q) : nullptr ) - , M ( (&(A.P.Q) == &B) ? *M_local : A.P.Q ) - { - arma_debug_sigprint(); - } - - inline - ~partial_unwrap_check() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - constexpr eT get_val() const { return eT(-1); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - - const Row* M_local; - const Row& M; - }; - - - -template -struct partial_unwrap_check< eOp, eop_neg> > - { - typedef Col stored_type; - - inline - partial_unwrap_check(const eOp,eop_neg>& A, const Mat& B) - : M_local( (&(A.P.Q) == &B) ? new Col(A.P.Q) : nullptr ) - , M ( (&(A.P.Q) == &B) ? *M_local : A.P.Q ) - { - arma_debug_sigprint(); - } - - inline - ~partial_unwrap_check() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - constexpr eT get_val() const { return eT(-1); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - - const Col* M_local; - const Col& M; - }; - - - -// NOTE: we can get away with this shortcut as the partial_unwrap_check class is only used by the glue_times class, -// NOTE: which relies on partial_unwrap_check to check for aliasing -template -struct partial_unwrap_check< eOp, eop_neg> > - { - typedef Col stored_type; - - inline - partial_unwrap_check(const eOp,eop_neg>& A, const Mat& B) - : M ( const_cast( A.P.Q.colmem ), A.P.Q.n_rows, (&(A.P.Q.m) == &B), false ) - { - arma_debug_sigprint(); - } - - constexpr eT get_val() const { return eT(-1); } - - static constexpr bool do_trans = false; - static constexpr bool do_times = true; - - const Col M; - }; - - - -// -// -// - - - -template -struct sv_keep_unwrap - { - typedef typename T1::elem_type eT; - typedef Mat stored_type; - - inline - sv_keep_unwrap(const T1& A) - : M(A) - { - arma_debug_sigprint(); - } - - const Mat M; - }; - - - -template -struct sv_keep_unwrap< subview > - { - typedef subview stored_type; - - inline - sv_keep_unwrap(const subview& A) - : M(A) - { - arma_debug_sigprint(); - } - - const subview& M; - }; - - - -template -struct sv_keep_unwrap< subview_row > - { - typedef subview_row stored_type; - - inline - sv_keep_unwrap(const subview_row& A) - : M(A) - { - arma_debug_sigprint(); - } - - const subview_row& M; - }; - - - -template -struct sv_keep_unwrap< subview_col > - { - typedef subview_col stored_type; - - inline - sv_keep_unwrap(const subview_col& A) - : M(A) - { - arma_debug_sigprint(); - } - - const subview_col& M; - }; - - - -template -struct sv_keep_unwrap< Mat > - { - typedef Mat stored_type; - - inline - sv_keep_unwrap(const Mat& A) - : M(A) - { - arma_debug_sigprint(); - } - - const Mat& M; - }; - - - -template -struct sv_keep_unwrap< Row > - { - typedef Row stored_type; - - inline - sv_keep_unwrap(const Row& A) - : M(A) - { - arma_debug_sigprint(); - } - - const Row& M; - }; - - - -template -struct sv_keep_unwrap< Col > - { - typedef Col stored_type; - - inline - sv_keep_unwrap(const Col& A) - : M(A) - { - arma_debug_sigprint(); - } - - const Col& M; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/unwrap_cube.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/unwrap_cube.hpp deleted file mode 100644 index 8017b2f11..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/unwrap_cube.hpp +++ /dev/null @@ -1,133 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup unwrap_cube -//! @{ - - - -template -struct unwrap_cube - { - typedef typename T1::elem_type eT; - - inline - unwrap_cube(const T1& A) - : M(A) - { - arma_debug_sigprint(); - } - - const Cube M; - - template - constexpr bool is_alias(const Cube&) const { return false; } - }; - - - -template -struct unwrap_cube< Cube > - { - inline - unwrap_cube(const Cube& A) - : M(A) - { - arma_debug_sigprint(); - } - - const Cube& M; - - template - arma_inline bool is_alias(const Cube& X) const { return (void_ptr(&M) == void_ptr(&X)); } - }; - - - -// -// -// - - - -template -struct unwrap_cube_check - { - typedef typename T1::elem_type eT; - - inline - unwrap_cube_check(const T1& A, const Cube&) - : M(A) - { - arma_debug_sigprint(); - - arma_type_check(( is_arma_cube_type::value == false )); - } - - inline - unwrap_cube_check(const T1& A, const bool) - : M(A) - { - arma_debug_sigprint(); - - arma_type_check(( is_arma_cube_type::value == false )); - } - - const Cube M; - }; - - - -template -struct unwrap_cube_check< Cube > - { - inline - unwrap_cube_check(const Cube& A, const Cube& B) - : M_local( (&A == &B) ? new Cube(A) : nullptr ) - , M ( (&A == &B) ? (*M_local) : A ) - { - arma_debug_sigprint(); - } - - - inline - unwrap_cube_check(const Cube& A, const bool is_alias) - : M_local( is_alias ? new Cube(A) : nullptr ) - , M ( is_alias ? (*M_local) : A ) - { - arma_debug_sigprint(); - } - - - inline - ~unwrap_cube_check() - { - arma_debug_sigprint(); - - if(M_local) { delete M_local; } - } - - - // the order below is important - const Cube* M_local; - const Cube& M; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/unwrap_spmat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/unwrap_spmat.hpp deleted file mode 100644 index 8cd55a32e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/unwrap_spmat.hpp +++ /dev/null @@ -1,216 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup unwrap_spmat -//! @{ - - - -template -struct unwrap_spmat - { - typedef typename T1::elem_type eT; - - typedef SpMat stored_type; - - inline - unwrap_spmat(const T1& A) - : M(A) - { - arma_debug_sigprint(); - } - - const SpMat M; - - template - constexpr bool is_alias(const SpMat&) const { return false; } - }; - - - -template -struct unwrap_spmat< SpMat > - { - typedef SpMat stored_type; - - inline - unwrap_spmat(const SpMat& A) - : M(A) - { - arma_debug_sigprint(); - - M.sync(); - } - - const SpMat& M; - - template - arma_inline bool is_alias(const SpMat& X) const { return (is_same_type::yes) && (void_ptr(&M) == void_ptr(&X)); } - }; - - - -template -struct unwrap_spmat< SpRow > - { - typedef SpRow stored_type; - - inline - unwrap_spmat(const SpRow& A) - : M(A) - { - arma_debug_sigprint(); - - M.sync(); - } - - const SpRow& M; - - template - arma_inline bool is_alias(const SpMat& X) const { return (is_same_type::yes) && (void_ptr(&M) == void_ptr(&X)); } - }; - - - -template -struct unwrap_spmat< SpCol > - { - typedef SpCol stored_type; - - inline - unwrap_spmat(const SpCol& A) - : M(A) - { - arma_debug_sigprint(); - - M.sync(); - } - - const SpCol& M; - - template - arma_inline bool is_alias(const SpMat& X) const { return (is_same_type::yes) && (void_ptr(&M) == void_ptr(&X)); } - }; - - - -template -struct unwrap_spmat< SpOp > - { - typedef typename T1::elem_type eT; - - typedef SpMat stored_type; - - inline - unwrap_spmat(const SpOp& A) - : M(A) - { - arma_debug_sigprint(); - } - - const SpMat M; - - template - constexpr bool is_alias(const SpMat&) const { return false; } - }; - - - -template -struct unwrap_spmat< SpGlue > - { - typedef typename T1::elem_type eT; - - typedef SpMat stored_type; - - inline - unwrap_spmat(const SpGlue& A) - : M(A) - { - arma_debug_sigprint(); - } - - const SpMat M; - - template - constexpr bool is_alias(const SpMat&) const { return false; } - }; - - - -template -struct unwrap_spmat< mtSpOp > - { - typedef SpMat stored_type; - - inline - unwrap_spmat(const mtSpOp& A) - : M(A) - { - arma_debug_sigprint(); - } - - const SpMat M; - - template - constexpr bool is_alias(const SpMat&) const { return false; } - }; - - - -template -struct unwrap_spmat< mtSpGlue > - { - typedef SpMat stored_type; - - inline - unwrap_spmat(const mtSpGlue& A) - : M(A) - { - arma_debug_sigprint(); - } - - const SpMat M; - - template - constexpr bool is_alias(const SpMat&) const { return false; } - }; - - - -template -struct unwrap_spmat< mtSpReduceOp > - { - typedef SpMat stored_type; - - inline - unwrap_spmat(const mtSpReduceOp& A) - : M(A) - { - arma_debug_sigprint(); - } - - const SpMat M; - - template - constexpr bool is_alias(const SpMat&) const { return false; } - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/upgrade_val.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/upgrade_val.hpp deleted file mode 100644 index a5e9da2b3..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/upgrade_val.hpp +++ /dev/null @@ -1,161 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup upgrade_val -//! @{ - - - -//! upgrade_val is used to ensure an operation such as multiplication is possible between two types. -//! values are upgraded only where necessary. - -template -struct upgrade_val - { - typedef typename promote_type::result T1_result; - typedef typename promote_type::result T2_result; - - arma_inline - static - typename promote_type::result - apply(const T1 x) - { - typedef typename promote_type::result out_type; - return out_type(x); - } - - arma_inline - static - typename promote_type::result - apply(const T2 x) - { - typedef typename promote_type::result out_type; - return out_type(x); - } - - }; - - -// template<> -template -struct upgrade_val - { - typedef T T1_result; - typedef T T2_result; - - arma_inline static const T& apply(const T& x) { return x; } - }; - - -//! upgrade a type to allow multiplication with a complex type -//! eg. the int in "int * complex" is upgraded to a double -// template<> -template -struct upgrade_val< std::complex, T2 > - { - typedef std::complex T1_result; - typedef T T2_result; - - arma_inline static const std::complex& apply(const std::complex& x) { return x; } - arma_inline static T apply(const T2 x) { return T(x); } - }; - - -// template<> -template -struct upgrade_val< T1, std::complex > - { - typedef T T1_result; - typedef std::complex T2_result; - - arma_inline static T apply(const T1 x) { return T(x); } - arma_inline static const std::complex& apply(const std::complex& x) { return x; } - }; - - -//! ensure we don't lose precision when multiplying a complex number with a higher precision real number -template<> -struct upgrade_val< std::complex, double > - { - typedef std::complex T1_result; - typedef double T2_result; - - arma_inline static const std::complex apply(const std::complex& x) { return std::complex(x); } - arma_inline static double apply(const double x) { return x; } - }; - - -template<> -struct upgrade_val< double, std::complex > - { - typedef double T1_result; - typedef std::complex T2_result; - - arma_inline static double apply(const double x) { return x; } - arma_inline static const std::complex apply(const std::complex& x) { return std::complex(x); } - }; - - -//! ensure we don't lose precision when multiplying complex numbers with different underlying types -template<> -struct upgrade_val< std::complex, std::complex > - { - typedef std::complex T1_result; - typedef std::complex T2_result; - - arma_inline static const std::complex apply(const std::complex& x) { return std::complex(x); } - arma_inline static const std::complex& apply(const std::complex& x) { return x; } - }; - - -template<> -struct upgrade_val< std::complex, std::complex > - { - typedef std::complex T1_result; - typedef std::complex T2_result; - - arma_inline static const std::complex& apply(const std::complex& x) { return x; } - arma_inline static const std::complex apply(const std::complex& x) { return std::complex(x); } - }; - - -//! work around limitations in the complex class (at least as present in gcc 4.1 & 4.3) -template<> -struct upgrade_val< std::complex, float > - { - typedef std::complex T1_result; - typedef double T2_result; - - arma_inline static const std::complex& apply(const std::complex& x) { return x; } - arma_inline static double apply(const float x) { return double(x); } - }; - - -template<> -struct upgrade_val< float, std::complex > - { - typedef double T1_result; - typedef std::complex T2_result; - - arma_inline static double apply(const float x) { return double(x); } - arma_inline static const std::complex& apply(const std::complex& x) { return x; } - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/wall_clock_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/wall_clock_bones.hpp deleted file mode 100644 index 1a1a4e278..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/wall_clock_bones.hpp +++ /dev/null @@ -1,43 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup wall_clock -//! @{ - - -//! Class for measuring time intervals -class wall_clock - { - public: - - inline wall_clock(); - inline ~wall_clock(); - - inline void tic(); //!< start the timer - arma_warn_unused inline double toc(); //!< return the number of seconds since the last call to tic() - - - private: - - std::chrono::steady_clock::time_point chrono_time1; - - bool valid = false; - }; - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/wall_clock_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/wall_clock_meat.hpp deleted file mode 100644 index 1e2eebf55..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/wall_clock_meat.hpp +++ /dev/null @@ -1,70 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup wall_clock -//! @{ - - -inline -wall_clock::wall_clock() - { - arma_debug_sigprint(); - - chrono_time1 = std::chrono::steady_clock::now(); // warmup - } - - - -inline -wall_clock::~wall_clock() - { - arma_debug_sigprint(); - } - - - -inline -void -wall_clock::tic() - { - arma_debug_sigprint(); - - valid = true; - - chrono_time1 = std::chrono::steady_clock::now(); - } - - - -inline -double -wall_clock::toc() - { - arma_debug_sigprint(); - - const std::chrono::steady_clock::time_point chrono_time2 = std::chrono::steady_clock::now(); - - typedef std::chrono::duration duration_type; // TODO: check this - - const duration_type chrono_span = std::chrono::duration_cast< duration_type >(chrono_time2 - chrono_time1); - - return (valid) ? double(chrono_span.count()) : double(0); - } - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/xtrans_mat_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/xtrans_mat_bones.hpp deleted file mode 100644 index 587566620..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/xtrans_mat_bones.hpp +++ /dev/null @@ -1,56 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup xtrans_mat -//! @{ - - -template -class xtrans_mat : public Base< eT, xtrans_mat > - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = false; - - static constexpr bool really_do_conj = (do_conj && is_cx::yes); - - arma_aligned const Mat& X; - arma_aligned mutable Mat Y; - - arma_aligned const uword n_rows; - arma_aligned const uword n_cols; - arma_aligned const uword n_elem; - - inline explicit xtrans_mat(const Mat& in_X); - - inline void extract(Mat& out) const; - - inline eT operator[](const uword ii) const; - inline eT at_alt (const uword ii) const; - - arma_inline eT at(const uword in_row, const uword in_col) const; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/xtrans_mat_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/xtrans_mat_meat.hpp deleted file mode 100644 index 7be5b62ad..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/xtrans_mat_meat.hpp +++ /dev/null @@ -1,87 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup xtrans_mat -//! @{ - - -template -inline -xtrans_mat::xtrans_mat(const Mat& in_X) - : X (in_X ) - , n_rows(in_X.n_cols) // deliberately swapped - , n_cols(in_X.n_rows) - , n_elem(in_X.n_elem) - { - arma_debug_sigprint(); - } - - - -template -inline -void -xtrans_mat::extract(Mat& out) const - { - arma_debug_sigprint(); - - really_do_conj ? op_htrans::apply_mat(out, X) : op_strans::apply_mat(out, X); - } - - - -template -inline -eT -xtrans_mat::operator[](const uword ii) const - { - if(Y.n_elem > 0) - { - return Y[ii]; - } - else - { - really_do_conj ? op_htrans::apply_mat(Y, X) : op_strans::apply_mat(Y, X); - return Y[ii]; - } - } - - - -template -inline -eT -xtrans_mat::at_alt(const uword ii) const - { - return (*this).operator[](ii); - } - - - -template -arma_inline -eT -xtrans_mat::at(const uword in_row, const uword in_col) const - { - return really_do_conj ? eT(access::alt_conj(X.at(in_col, in_row))) : eT(X.at(in_col, in_row)); - // in_row and in_col deliberately swapped above - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/xvec_htrans_bones.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/xvec_htrans_bones.hpp deleted file mode 100644 index 6eab71019..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/xvec_htrans_bones.hpp +++ /dev/null @@ -1,54 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup xvec_htrans -//! @{ - - -template -class xvec_htrans : public Base< eT, xvec_htrans > - { - public: - - typedef eT elem_type; - typedef typename get_pod_type::result pod_type; - - static constexpr bool is_row = false; - static constexpr bool is_col = false; - static constexpr bool is_xvec = true; - - arma_aligned const eT* const mem; - - const uword n_rows; - const uword n_cols; - const uword n_elem; - - - inline explicit xvec_htrans(const eT* const in_mem, const uword in_n_rows, const uword in_n_cols); - - inline void extract(Mat& out) const; - - inline eT operator[](const uword ii) const; - inline eT at_alt (const uword ii) const; - - inline eT at (const uword in_row, const uword in_col) const; - }; - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/xvec_htrans_meat.hpp b/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/xvec_htrans_meat.hpp deleted file mode 100644 index 00f517cb0..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/include/armadillo_bits/xvec_htrans_meat.hpp +++ /dev/null @@ -1,90 +0,0 @@ -// SPDX-License-Identifier: Apache-2.0 -// -// Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au) -// Copyright 2008-2016 National ICT Australia (NICTA) -// -// Licensed under the Apache License, Version 2.0 (the "License"); -// you may not use this file except in compliance with the License. -// You may obtain a copy of the License at -// http://www.apache.org/licenses/LICENSE-2.0 -// -// Unless required by applicable law or agreed to in writing, software -// distributed under the License is distributed on an "AS IS" BASIS, -// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -// See the License for the specific language governing permissions and -// limitations under the License. -// ------------------------------------------------------------------------ - - -//! \addtogroup xvec_htrans -//! @{ - - -template -inline -xvec_htrans::xvec_htrans(const eT* const in_mem, const uword in_n_rows, const uword in_n_cols) - : mem (in_mem ) - , n_rows(in_n_cols ) // deliberately swapped - , n_cols(in_n_rows ) - , n_elem(in_n_rows*in_n_cols) - { - arma_debug_sigprint(); - } - - - -template -inline -void -xvec_htrans::extract(Mat& out) const - { - arma_debug_sigprint(); - - // NOTE: this function assumes that matrix 'out' has already been set to the correct size - - const eT* in_mem = mem; - eT* out_mem = out.memptr(); - - const uword N = n_elem; - - for(uword ii=0; ii < N; ++ii) - { - out_mem[ii] = access::alt_conj( in_mem[ii] ); - } - } - - - -template -inline -eT -xvec_htrans::operator[](const uword ii) const - { - return access::alt_conj( mem[ii] ); - } - - - -template -inline -eT -xvec_htrans::at_alt(const uword ii) const - { - return access::alt_conj( mem[ii] ); - } - - - -template -inline -eT -xvec_htrans::at(const uword in_row, const uword in_col) const - { - //return (n_rows == 1) ? access::alt_conj( mem[in_col] ) : access::alt_conj( mem[in_row] ); - - return access::alt_conj( mem[in_row + in_col] ); // either in_row or in_col must be zero, as we're storing a vector - } - - - -//! @} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/libs/RcppArmadillo.so b/Luminescence.BuildResults/Library/RcppArmadillo/libs/RcppArmadillo.so deleted file mode 100755 index c0068e0d3..000000000 Binary files a/Luminescence.BuildResults/Library/RcppArmadillo/libs/RcppArmadillo.so and /dev/null differ diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/skeleton/Makevars b/Luminescence.BuildResults/Library/RcppArmadillo/skeleton/Makevars deleted file mode 100644 index 22c756683..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/skeleton/Makevars +++ /dev/null @@ -1,19 +0,0 @@ - -## With R 3.1.0 or later, you can uncomment the following line to tell R to -## enable compilation with C++11 (where available) -## -## Also, OpenMP support in Armadillo prefers C++11 support. However, for wider -## availability of the package we do not yet enforce this here. It is however -## recommended for client packages to set it. -## -## And with R 3.4.0, and RcppArmadillo 0.7.960.*, we turn C++11 on as OpenMP -## support within Armadillo prefers / requires it -## -## R 4.0.0 made C++11 the default, R 4.1.0 switched to C++14, R 4.3.0 to C++17 -## _In general_ we should no longer need to set a standard as any recent R -## installation will do the right thing. Should you need it, uncomment it and -## set the appropriate value, possibly CXX17. -#CXX_STD = CXX11 - -PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS) -PKG_LIBS = $(SHLIB_OPENMP_CXXFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/skeleton/Makevars.win b/Luminescence.BuildResults/Library/RcppArmadillo/skeleton/Makevars.win deleted file mode 100644 index 22c756683..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/skeleton/Makevars.win +++ /dev/null @@ -1,19 +0,0 @@ - -## With R 3.1.0 or later, you can uncomment the following line to tell R to -## enable compilation with C++11 (where available) -## -## Also, OpenMP support in Armadillo prefers C++11 support. However, for wider -## availability of the package we do not yet enforce this here. It is however -## recommended for client packages to set it. -## -## And with R 3.4.0, and RcppArmadillo 0.7.960.*, we turn C++11 on as OpenMP -## support within Armadillo prefers / requires it -## -## R 4.0.0 made C++11 the default, R 4.1.0 switched to C++14, R 4.3.0 to C++17 -## _In general_ we should no longer need to set a standard as any recent R -## installation will do the right thing. Should you need it, uncomment it and -## set the appropriate value, possibly CXX17. -#CXX_STD = CXX11 - -PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS) -PKG_LIBS = $(SHLIB_OPENMP_CXXFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/skeleton/rcpparma_hello_world.Rd b/Luminescence.BuildResults/Library/RcppArmadillo/skeleton/rcpparma_hello_world.Rd deleted file mode 100644 index 723de64c1..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/skeleton/rcpparma_hello_world.Rd +++ /dev/null @@ -1,50 +0,0 @@ -\name{RcppArmadillo-Functions} -\alias{rcpparma_hello_world} -\alias{rcpparma_innerproduct} -\alias{rcpparma_outerproduct} -\alias{rcpparma_bothproducts} -\title{Set of functions in example RcppArmadillo package} -\description{ - These four functions are created when - \code{RcppArmadillo.package.skeleton()} is invoked to create a - skeleton packages. -} -\usage{ -rcpparma_hello_world() -rcpparma_outerproduct(x) -rcpparma_innerproduct(x) -rcpparma_bothproducts(x) -} -\arguments{ - \item{x}{a numeric vector} -} -\value{ - \code{rcpparma_hello_world()} does not return a value, but displays a - message to the console. - - \code{rcpparma_outerproduct()} returns a numeric matrix computed as the - outer (vector) product of \code{x}. - - \code{rcpparma_innerproduct()} returns a double computer as the inner - (vector) product of \code{x}. - - \code{rcpparma_bothproducts()} returns a list with both the outer and - inner products. - -} -\details{ - These are example functions which should be largely - self-explanatory. Their main benefit is to demonstrate how to write a - function using the Armadillo C++ classes, and to have to such a - function accessible from R. -} -\references{ - See the documentation for Armadillo, and RcppArmadillo, for more details. -} -\examples{ - x <- sqrt(1:4) - rcpparma_innerproduct(x) - rcpparma_outerproduct(x) -} -\author{Dirk Eddelbuettel} - diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/skeleton/rcpparma_hello_world.cpp b/Luminescence.BuildResults/Library/RcppArmadillo/skeleton/rcpparma_hello_world.cpp deleted file mode 100644 index 4a1856409..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/skeleton/rcpparma_hello_world.cpp +++ /dev/null @@ -1,52 +0,0 @@ -// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- - -// we only include RcppArmadillo.h which pulls Rcpp.h in for us -#include "RcppArmadillo.h" - -// via the depends attribute we tell Rcpp to create hooks for -// RcppArmadillo so that the build process will know what to do -// -// [[Rcpp::depends(RcppArmadillo)]] - -// simple example of creating two matrices and -// returning the result of an operatioon on them -// -// via the exports attribute we tell Rcpp to make this function -// available from R -// -// [[Rcpp::export]] -arma::mat rcpparma_hello_world() { - arma::mat m1 = arma::eye(3, 3); - arma::mat m2 = arma::eye(3, 3); - - return m1 + 3 * (m1 + m2); -} - - -// another simple example: outer product of a vector, -// returning a matrix -// -// [[Rcpp::export]] -arma::mat rcpparma_outerproduct(const arma::colvec & x) { - arma::mat m = x * x.t(); - return m; -} - -// and the inner product returns a scalar -// -// [[Rcpp::export]] -double rcpparma_innerproduct(const arma::colvec & x) { - double v = arma::as_scalar(x.t() * x); - return v; -} - - -// and we can use Rcpp::List to return both at the same time -// -// [[Rcpp::export]] -Rcpp::List rcpparma_bothproducts(const arma::colvec & x) { - arma::mat op = x * x.t(); - double ip = arma::as_scalar(x.t() * x); - return Rcpp::List::create(Rcpp::Named("outer")=op, - Rcpp::Named("inner")=ip); -} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/Rlapack.cpp b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/Rlapack.cpp deleted file mode 100644 index e92cdddb9..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/Rlapack.cpp +++ /dev/null @@ -1,135 +0,0 @@ -// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- -// -// Rlapack.cpp: RcppArmadillo unit tests for borked Lapack -// -// Copyright (C) 2018 Keith O'Hara and Dirk Eddelbuettel -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -// #define ARMA_EXTRA_DEBUG - -#include - -using namespace Rcpp; - -// [[Rcpp::depends(RcppArmadillo)]] - -// [[Rcpp::export]] -arma::cx_mat cx_eig_pair_test(const int n) -{ - arma::cx_mat A = arma::randu(n,n); - arma::cx_mat B = arma::randu(n,n); - - arma::cx_vec eigval; - arma::cx_mat eigvec; - - arma::eig_pair(eigval, eigvec, A, B); - - return A*eigvec - B*eigvec*arma::diagmat(eigval); -} - -// [[Rcpp::export]] -arma::cx_mat cx_qz_test(const int n) -{ - // test qz in complex matrix case - arma::cx_mat A = arma::randu(n,n); - arma::cx_mat B = arma::randu(n,n); - - arma::cx_mat AA; - arma::cx_mat BB; - arma::cx_mat Q; - arma::cx_mat Z; - - arma::qz(AA,BB,Q,Z,A,B); - - return A - Q.t()*AA*Z.t(); -} - -// [[Rcpp::export]] -int cx_rank_test(const int n) -{ - // test svd_dc - arma::cx_mat A = arma::randu(n,n+1); - - int rA = arma::rank(A); - - return rA; -} - -// [[Rcpp::export]] -arma::cx_mat cx_pinv_test(const int n) -{ - // test svd_dc - arma::cx_mat A = arma::randu(n,n+1); - - arma::cx_mat B = arma::pinv(A); - - return A*B; -} - -// [[Rcpp::export]] -arma::cx_mat cx_schur_test(const int n) -{ - arma::cx_mat A = arma::randu(n,n); - arma::cx_mat U; - arma::cx_mat S; - - arma::schur(U,S,A); - - return A - U*S*U.t(); -} - -// [[Rcpp::export]] -arma::cx_mat cx_solve_test(const int n) -{ - arma::cx_mat A = arma::randu(n,n); - arma::cx_vec b = arma::randu(n); - arma::cx_mat B = arma::randu(n,n); - - arma::cx_vec x1 = solve(A, b); - - arma::cx_vec x2; - solve(x2, A, b); - - arma::cx_mat X1 = solve(A, B); - arma::cx_mat X2 = solve(A, B, arma::solve_opts::fast); // enable fast mode - - // next for non-square matrices; to test solve_approx_svd - - arma::cx_mat C = arma::randu(n,n+1); - - arma::cx_vec x3 = solve(C, b); - - return C*x3 - b; -} - -// [[Rcpp::export]] -arma::cx_mat cx_solve_band_test(const int n) -{ - // trigger solve_tridiag_refine - - int n_tri_rows = std::min(34,n); - arma::cx_mat A_tri = arma::zeros(n_tri_rows,n_tri_rows); - - A_tri.diag() = arma::randu(n_tri_rows,1); - A_tri.diag(1) = arma::randu(n_tri_rows-1,1); - A_tri.diag(-1) = arma::randu(n_tri_rows-1,1); - - arma::cx_vec b_tri = arma::randu(n_tri_rows); - arma::cx_vec x_tri = solve(A_tri, b_tri); - - return A_tri*x_tri - b_tri; -} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/any_as_vec.cpp b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/any_as_vec.cpp deleted file mode 100644 index 3e5abe975..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/any_as_vec.cpp +++ /dev/null @@ -1,12 +0,0 @@ -// [[Rcpp::depends(RcppArmadillo)]] -#define RCPP_ARMADILLO_RETURN_ANYVEC_AS_VECTOR - -#include - -using namespace Rcpp; - -// [[Rcpp::export]] -arma::vec veccany_as_v_test(arma::vec v) { return(v); } - -// [[Rcpp::export]] -arma::rowvec vecrany_as_v_test(arma::rowvec v) { return(v); } diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/armadillo.cpp b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/armadillo.cpp deleted file mode 100644 index a8626fc7b..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/armadillo.cpp +++ /dev/null @@ -1,314 +0,0 @@ -// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- -// -// armadillo.cpp: RcppArmadillo unit test code -// -// Copyright (C) 2010 - 2019 Dirk Eddelbuettel, Romain Francois and Douglas Bates -// Copyright (C) 2019 - 2022 Dirk Eddelbuettel -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -// [[Rcpp::depends(RcppArmadillo)]] -#include - -using namespace Rcpp; - -// [[Rcpp::export]] -bool has_old_field_behavior() { -//#if defined(RCPP_ARMADILLO_OLD_Field_BEHAVIOR) -#if !defined(RCPP_ARMADILLO_FIX_Field) - return true; -#else - return false; -#endif -} - -// [[Rcpp::export]] -List wrap_() { - - // using the Named(.) = . notation - List cols = List::create(Named( "Col" ) = arma::zeros(5,1), - Named( "Col" ) = arma::zeros(5,1)); - - // using the Named(., .) notation - List rows = List::create(Named( "Row", arma::zeros(1,5) ), - Named( "Row" , arma::zeros(1,5) )); - - // using the _[.] = . notation - List matrices = List::create(_["Mat"] = arma::eye( 3,3 ), - _["Mat"] = arma::eye( 3,3 ), - _["Mat"] = arma::eye( 3, 3 ), - _["Mat"] = arma::eye( 3, 3 )); - - // creating an empty list and grow it on demand - List fields; - arma::field f1( 2, 2 ); - f1( 0, 0 ) = 0; - f1( 1, 0 ) = 1; - f1( 0, 1 ) = 2; - f1( 1, 1 ) = 3; - fields["field"] = f1; - - arma::field f2(2,2); - f2( 0, 0 ) = "a"; - f2( 1, 0 ) = "b"; - f2( 0, 1 ) = "c"; - f2( 1, 1 ) = "d"; - fields["field"] = f2; - - arma::field f3(2,2); - f3(0,0) = arma::zeros(5,1); - f3(1,0) = arma::zeros(4,1); - f3(0,1) = arma::zeros(3,1); - f3(1,1) = arma::zeros(2,1); - fields["field"] = f3; - - List output = List::create(_["matrices : Mat"] = matrices, - _["rows : Row"] = rows, - _["columns : Col"] = cols, - _["fields : field"] = fields ); - - return output; -} - -// [[Rcpp::export]] -List wrapGlue_() { - arma::mat m1 = arma::eye( 3, 3 ); - arma::mat m2 = arma::eye( 3, 3 ); - - List res; - res["mat+mat"] = m1 + m2; - return res; -} - -// [[Rcpp::export]] -List wrapOp_() { - arma::mat m1 = arma::eye( 3, 3 ); - - List res; - res["- mat"] = - m1; - return res; -} - -// [[Rcpp::export]] -List asMat_(List input) { - arma::imat m1 = input[0]; /* implicit as */ - arma::mat m2 = input[1]; /* implicit as */ - arma::umat m3 = input[0]; /* implicit as */ - arma::fmat m4 = input[1]; /* implicit as */ - - List res = List::create(arma::accu( m1 ), - arma::accu( m2 ), - arma::accu( m3 ), - arma::accu( m4 ) ); - - return res; -} - -// [[Rcpp::export]] -List asCol_(List input) { - arma::icolvec m1 = input[0]; /* implicit as */ - arma::colvec m2 = input[1]; /* implicit as */ - arma::ucolvec m3 = input[0]; /* implicit as */ - arma::fcolvec m4 = input[1]; /* implicit as */ - - List res = List::create(arma::accu( m1 ), - arma::accu( m2 ), - arma::accu( m3 ), - arma::accu( m4 ) ); - return res; -} - -// [[Rcpp::export]] -List asRow_(List input) { - arma::irowvec m1 = input[0]; /* implicit as */ - arma::rowvec m2 = input[1]; /* implicit as */ - arma::urowvec m3 = input[0]; /* implicit as */ - arma::frowvec m4 = input[1]; /* implicit as */ - - List res = List::create(arma::accu( m1 ), - arma::accu( m2 ), - arma::accu( m3 ), - arma::accu( m4 ) ); - return res; -} - -// [[Rcpp::export]] -List cxMat_() { - arma::cx_mat m1 = arma::eye ( 3, 3 ); - arma::cx_fmat m2 = arma::eye( 3, 3 ); - return List::create( _["double"] = m1, _["float"] = m2 ); -} - -// [[Rcpp::export]] -ComplexMatrix mtOp_() { - std::complex x( 1.0, 2.0 ); - arma::mat m1 = arma::eye ( 3, 3 ); - - return wrap( x * m1 ); -} - -// [[Rcpp::export]] -NumericMatrix mtGlue_() { - arma::imat m2 = arma::eye ( 3, 3 ); - arma::mat m1 = arma::eye ( 3, 3 ); - - return wrap( m1 + m2 ); -} - -// [[Rcpp::export]] -NumericMatrix sugar_(NumericVector xx) { - arma::mat m = xx + xx; - return wrap( m ); -} - -// [[Rcpp::export]] -ComplexMatrix sugarCplx_(ComplexVector xx) { - arma::cx_mat m = exp( xx ); - return wrap( m ); -} - -// [[Rcpp::export]] -List sugarCtor_(NumericVector xx) { - arma::mat m = xx + xx; - arma::colvec co = xx; - arma::rowvec ro = xx; - return List::create(_["mat"] = m + m, - _["rowvec"] = ro, - _["colvec"] = co); -} - -double norm( double x, double y){ - return ::sqrt( x*x + y*y ); -} - -// [[Rcpp::export]] -List sugarMatrixCtor_(NumericVector xx) { - NumericVector yy = NumericVector::create( 1 ); - arma::mat m = diag( xx ); - arma::colvec co = outer( xx, yy, ::norm ); - arma::rowvec ro = outer( yy, xx, ::norm ); - return List::create(_["mat"] = m + m , - _["rowvec"] = ro, - _["colvec"] = co); -} - -// test.armadillo.rtti.check <- function() { - -// inc <- ' -// void blah(arma::mat& X) { -// X.set_size(5,5); -// } -// ' -// src <- ' -// arma::vec V; -// blah(V); // if blah() worked, we have a problem -// ' -// fun <- cxxfunction(signature(), body=src, inc=inc, plugin = "RcppArmadillo") - -// checkException(fun(), msg="RTTI check on matrix constructor exception") - -// } - - -// [[Rcpp::export]] -int mat_plain(arma::mat x) { - return x.n_elem; -} - -// [[Rcpp::export]] -int mat_const(const arma::mat x) { - return x.n_elem; -} - -// [[Rcpp::export]] -int mat_ref(arma::mat & x) { - return x.n_elem; -} - -// [[Rcpp::export]] -int mat_const_ref(const arma::mat & x) { - return x.n_elem; -} - -// [[Rcpp::export]] -int vec_plain(arma::vec x) { - return x.n_elem; -} - -// [[Rcpp::export]] -int vec_const(const arma::vec x) { - return x.n_elem; -} - -// [[Rcpp::export]] -int vec_ref(arma::vec & x) { - return x.n_elem; -} - -// [[Rcpp::export]] -int vec_const_ref(const arma::vec & x) { - return x.n_elem; -} - -// [[Rcpp::export]] -int cx_mat_plain(arma::cx_mat x) { - return x.n_elem; -} - -// [[Rcpp::export]] -int cx_mat_const(const arma::cx_mat x) { - return x.n_elem; -} - -// [[Rcpp::export]] -int cx_mat_ref(arma::cx_mat & x) { - return x.n_elem; -} - -// [[Rcpp::export]] -int cx_mat_const_ref(const arma::cx_mat & x) { - return x.n_elem; -} - -// [[Rcpp::export]] -arma::uvec uvec_test(arma::uvec v) { return(v); } - -// [[Rcpp::export]] -arma::uvec c_uvec_test(const arma::uvec v) { return(v); } - -// [[Rcpp::export]] -arma::uvec r_uvec_test(arma::uvec& v) { return(v); } - -// [[Rcpp::export]] -arma::uvec cr_uvec_test(const arma::uvec& v) { return(v); } - -// [[Rcpp::export]] -arma::umat umat_test(arma::umat v) { return(v); } - -// [[Rcpp::export]] -arma::umat c_umat_test(const arma::umat v) { return(v); } - -// [[Rcpp::export]] -arma::umat r_umat_test(arma::umat& v) { return(v); } - -// [[Rcpp::export]] -arma::umat cr_umat_test(const arma::umat& v) { return(v); } - -// [[Rcpp::export]] -arma::vec vecc_test(arma::vec v) { return(v); } - -// [[Rcpp::export]] -arma::rowvec vecr_test(arma::rowvec v) { return(v); } diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/colrow_as_vec.cpp b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/colrow_as_vec.cpp deleted file mode 100644 index b15366720..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/colrow_as_vec.cpp +++ /dev/null @@ -1,12 +0,0 @@ -// [[Rcpp::depends(RcppArmadillo)]] -#define RCPP_ARMADILLO_RETURN_COLVEC_AS_VECTOR -#define RCPP_ARMADILLO_RETURN_ROWVEC_AS_VECTOR -#include - -using namespace Rcpp; - -// [[Rcpp::export]] -arma::vec vecc_as_v_test(arma::vec v) { return(v); } - -// [[Rcpp::export]] -arma::rowvec vecr_as_v_test(arma::rowvec v) { return(v); } diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/complex.cpp b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/complex.cpp deleted file mode 100644 index cf874b9d5..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/complex.cpp +++ /dev/null @@ -1,60 +0,0 @@ -// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- -// -// complex.cpp: RcppArmadillo unit tests for complex vectors and matrices -// -// Copyright (C) 2013 - 2019 Baptiste Auguie and Dirk Eddelbuettel -// Copyright (C) 2019 Dirk Eddelbuettel -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -#include - -using namespace Rcpp; -using namespace arma; - -// [[Rcpp::depends(RcppArmadillo)]] - -// [[Rcpp::export]] -List complexCppTests(const arma::mat& A, - const arma::mat& B, - const arma::cx_colvec& V, - const arma::mat& S) { - - arma::cx_mat C(A, B); // create complex matrix - arma::cx_mat Cst = strans(C), Ct = trans(C); // transpose - arma::cx_mat conjC = conj(C); // conjugate - arma::mat absC = abs(C); // modulus - - arma::cx_colvec CtV = C * V; // multiply matrix-vector - arma::cx_mat CtS = C * S; // multiply matrix-matrix - arma::cx_mat CC = C % C; // element-wise multiplication - arma::cx_mat CdC = C / C; // division - arma::cx_mat CpC = C + C; // addition - arma::cx_mat CmC = C - C; // subtraction - - return List::create(_["C"] = C, - _["Cst"] = Cst, - _["Ct"] = Ct, - _["conjC"] = conjC, - _["absC"] = absC, - _["CV"] = CtV, - _["CS"] = CtS, - _["CC"] = CC, - _["CdC"] = CdC, - _["CpC"] = CpC, - _["CmC"] = CmC - ); -} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/cube.cpp b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/cube.cpp deleted file mode 100644 index a2bbc59c3..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/cube.cpp +++ /dev/null @@ -1,90 +0,0 @@ -// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- -// -// cube.cpp: RcppArmadillo unit test code for cube types -// -// Copyright (C) 2015 - 2019 Dirk Eddelbuettel and Nathan Russell -// Copyright (C) 2019 Dirk Eddelbuettel -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -// [[Rcpp::depends(RcppArmadillo)]] -#include - -// [[Rcpp::export]] -arma::cube cube_test(const arma::cube& x) { - return arma::pow(x, 2); -} - -// [[Rcpp::export]] -arma::fcube fcube_test(const arma::fcube& x) { - return arma::pow(x, 2); -} - -// [[Rcpp::export]] -arma::icube icube_test(const arma::icube& x) { - return arma::pow(x, 2); -} - -// [[Rcpp::export]] -arma::ucube ucube_test(const arma::ucube& x) { - return arma::pow(x, 2); -} - -// [[Rcpp::export]] -arma::cx_cube cx_cube_test(const arma::cx_cube& x) { - return arma::pow(x, 2); -} - -// [[Rcpp::export]] -arma::cx_fcube cx_fcube_test(const arma::cx_fcube& x) { - return arma::pow(x, 2); -} - -// [[Rcpp::export]] -arma::cube as_cube(Rcpp::NumericVector x) { - arma::cube y = Rcpp::as(x); - return arma::pow(y, 2); -} - -// [[Rcpp::export]] -arma::fcube as_fcube(Rcpp::NumericVector x) { - arma::fcube y = Rcpp::as(x); - return arma::pow(y, 2); -} - -// [[Rcpp::export]] -arma::icube as_icube(Rcpp::IntegerVector x) { - arma::icube y = Rcpp::as(x); - return arma::pow(y, 2); -} - -// [[Rcpp::export]] -arma::ucube as_ucube(Rcpp::IntegerVector x) { - arma::ucube y = Rcpp::as(x); - return arma::pow(y, 2); -} - -// [[Rcpp::export]] -arma::cx_cube as_cx_cube(Rcpp::ComplexVector x) { - arma::cx_cube y = Rcpp::as(x); - return arma::pow(y, 2); -} - -// [[Rcpp::export]] -arma::cx_fcube as_cx_fcube(Rcpp::ComplexVector x) { - arma::cx_fcube y = Rcpp::as(x); - return arma::pow(y, 2); -} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/fields.cpp b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/fields.cpp deleted file mode 100644 index 3dabe7a7c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/fields.cpp +++ /dev/null @@ -1,141 +0,0 @@ -// fields.cpp: RcppArmadillo unit test code for field types -// -// Copyright (C) 2021 - 2022 Dirk Eddelbuettel -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -// [[Rcpp::depends(RcppArmadillo)]] -#include - -// [[Rcpp::export]] -bool has_old_field_behavior() { -//#if defined(RCPP_ARMADILLO_OLD_Field_BEHAVIOR) -#if !defined(RCPP_ARMADILLO_FIX_Field) - return true; -#else - return false; -#endif -} - -// [[Rcpp::export]] -arma::field field1m22() { - arma::mat A = arma::randn(2,2); - - arma::field F(1); - F(0) = A; - - return F; -} - -// [[Rcpp::export]] -arma::field field11m22() { - arma::mat A = arma::randn(2,2); - - arma::field F(1,1); - F(0,0) = A; - - return F; -} - -// [[Rcpp::export]] -arma::field field12m22() { - arma::mat A = arma::randn(2,2); - arma::mat B = arma::randn(2,2); - - arma::field F(1,2); - F(0,0) = A; - F(0,1) = B; - - return F; -} - -// [[Rcpp::export]] -arma::field field21m22() { - arma::mat A = arma::randn(2,2); - arma::mat B = arma::randn(2,2); - - arma::field F(2,1); - F(0,0) = A; - F(1,0) = B; - - return F; -} - -// [[Rcpp::export]] -arma::field field22m2233() { - arma::mat A = arma::randn(2,2); - arma::mat B = arma::randn(3,3); - - arma::field F(2,2); - F(0,1) = A; - F(1,0) = B; - - return F; -} - -// [[Rcpp::export]] -arma::field field222m223344() { - arma::mat A = arma::randn(2,2); - arma::mat B = arma::randn(3,3); - arma::mat C = arma::randn(4,4); - - arma::field F(2,2,2); - F(0,1,0) = A; - F(1,0,0) = B; - F(0,0,1) = B; - - return F; -} - - - - -// [[Rcpp::export]] -arma::ivec infield1m22(arma::field F) { - arma::uvec v = { F.n_rows, F.n_cols, F.n_slices }; - return arma::conv_to::from(v); -} - -// [[Rcpp::export]] -arma::ivec infield11m22(arma::field F) { - arma::uvec v = { F.n_rows, F.n_cols, F.n_slices }; - return arma::conv_to::from(v); -} - -// [[Rcpp::export]] -arma::ivec infield12m22(arma::field F) { - arma::uvec v = { F.n_rows, F.n_cols, F.n_slices }; - return arma::conv_to::from(v); -} - -// [[Rcpp::export]] -arma::ivec infield21m22(arma::field F) { - arma::uvec v = { F.n_rows, F.n_cols, F.n_slices }; - return arma::conv_to::from(v); -} - -// [[Rcpp::export]] -arma::ivec infield22m2233(arma::field F) { - arma::uvec v = { F.n_rows, F.n_cols, F.n_slices }; - return arma::conv_to::from(v); -} - -// [[Rcpp::export]] -arma::ivec infield222m223344(arma::field F) { - F.print("F"); - arma::uvec v = { F.n_rows, F.n_cols, F.n_slices }; - return arma::conv_to::from(v); -} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/fields_new.cpp b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/fields_new.cpp deleted file mode 100644 index 5a7db2300..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/fields_new.cpp +++ /dev/null @@ -1,135 +0,0 @@ - -// fields_new.cpp: RcppArmadillo unit test code for field types -// -// Copyright (C) 2021 Dirk Eddelbuettel -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -#define RCPP_ARMADILLO_FIX_Field 1 - -// [[Rcpp::depends(RcppArmadillo)]] -#include - -// [[Rcpp::export]] -arma::field field1m22n() { - arma::mat A = arma::randn(2,2); - - arma::field F(1); - F(0) = A; - - return F; -} - - -// [[Rcpp::export]] -arma::field field11m22n() { - arma::mat A = arma::randn(2,2); - - arma::field F(1,1); - F(0,0) = A; - - return F; -} - -// [[Rcpp::export]] -arma::field field12m22n() { - arma::mat A = arma::randn(2,2); - arma::mat B = arma::randn(2,2); - - arma::field F(1,2); - F(0,0) = A; - F(0,1) = B; - //F.print("12m22xx"); - return F; -} - -// [[Rcpp::export]] -arma::field field21m22n() { - arma::mat A = arma::randn(2,2); - arma::mat B = arma::randn(2,2); - - arma::field F(2,1); - F(0,0) = A; - F(1,0) = B; - - return F; -} - -// [[Rcpp::export]] -arma::field field22m2233n() { - arma::mat A = arma::randn(2,2); - arma::mat B = arma::randn(3,3); - - arma::field F(2,2); - F(0,1) = A; - F(1,0) = B; - - return F; -} - -// [[Rcpp::export]] -arma::field field222m223344n() { - arma::mat A = arma::randn(2,2); - arma::mat B = arma::randn(3,3); - arma::mat C = arma::randn(4,4); - - arma::field F(2,2,2); - F(0,1,0) = A; - F(1,0,0) = B; - F(0,0,1) = C; - - return F; -} - - - - - -// [[Rcpp::export]] -arma::ivec infield1m22n(arma::field F) { - arma::uvec v = { F.n_rows, F.n_cols, F.n_slices }; - return arma::conv_to::from(v); -} - -// [[Rcpp::export]] -arma::ivec infield11m22n(arma::field F) { - arma::uvec v = { F.n_rows, F.n_cols, F.n_slices }; - return arma::conv_to::from(v); -} - -// [[Rcpp::export]] -arma::ivec infield12m22n(arma::field F) { - arma::uvec v = { F.n_rows, F.n_cols, F.n_slices }; - return arma::conv_to::from(v); -} - -// [[Rcpp::export]] -arma::ivec infield21m22n(arma::field F) { - arma::uvec v = { F.n_rows, F.n_cols, F.n_slices }; - return arma::conv_to::from(v); -} - -// [[Rcpp::export]] -arma::ivec infield22m2233n(arma::field F) { - arma::uvec v = { F.n_rows, F.n_cols, F.n_slices }; - return arma::conv_to::from(v); -} - -// [[Rcpp::export]] -arma::ivec infield222m223344n(arma::field F) { - arma::uvec v = { F.n_rows, F.n_cols, F.n_slices }; - return arma::conv_to::from(v); -} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/rmultinom.cpp b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/rmultinom.cpp deleted file mode 100644 index c56f1168c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/rmultinom.cpp +++ /dev/null @@ -1,19 +0,0 @@ -// [[Rcpp::depends(RcppArmadillo)]] -#include -#include - -using namespace Rcpp; - -// [[Rcpp::export]] -IntegerVector rmultinomC(int n, int size, NumericVector prob) { - IntegerMatrix draws(prob.size(), n); - // FixProb modifies in-place - arma::colvec fixprob(prob.begin(), prob.size()); // forced copy - RcppArmadillo::FixProb(fixprob, 1, true); - NumericVector newprob(Rcpp::wrap(fixprob)); - RNGScope scope; - for (int ii=0; ii. - -// [[Rcpp::depends(RcppArmadillo)]] -#include - -// [[Rcpp::export]] -int setSeed(int val) { - arma::arma_rng::set_seed(val); // should trigger warning - return 0; -} - -// [[Rcpp::export]] -arma::vec randu(int n) { - return arma::randu(n); -} - -// [[Rcpp::export]] -arma::ivec randi(int n) { - return arma::randi(n); -} - -// [[Rcpp::export]] -arma::vec randn(int n) { - return arma::randn(n); -} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/sample.cpp b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/sample.cpp deleted file mode 100644 index 54df128cc..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/sample.cpp +++ /dev/null @@ -1,70 +0,0 @@ -// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- -// -// sample.cpp: RcppArmadillo unit test code for sample() function -// -// Copyright (C) 2012 - 2013 Christian Gunning and Dirk Eddelbuettel -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -// [[Rcpp::depends(RcppArmadillo)]] -#include - -#include - -using namespace Rcpp; - -// function defns exported to R -- instantiate templated sample -// functions are identical except for class of sampled vector and return val - -// [[Rcpp::export]] -IntegerVector csample_integer( IntegerVector x, int size, bool replace, - NumericVector prob = NumericVector::create()) { - RNGScope scope; - IntegerVector ret = RcppArmadillo::sample(x, size, replace, prob); - return ret; -} - -// [[Rcpp::export]] -NumericVector csample_numeric( NumericVector x, int size, bool replace, - NumericVector prob = NumericVector::create()) { - RNGScope scope; - NumericVector ret = RcppArmadillo::sample(x, size, replace, prob); - return ret; -} - -// [[Rcpp::export]] -ComplexVector csample_complex( ComplexVector x, int size, bool replace, - NumericVector prob = NumericVector::create()) { - RNGScope scope; - ComplexVector ret = RcppArmadillo::sample(x, size, replace, prob); - return ret; -} - -// [[Rcpp::export]] -CharacterVector csample_character( CharacterVector x, int size, bool replace, - NumericVector prob = NumericVector::create()) { - RNGScope scope; - CharacterVector ret = RcppArmadillo::sample(x, size, replace, prob); - return ret; -} - -// [[Rcpp::export]] -LogicalVector csample_logical( LogicalVector x, int size, bool replace, - NumericVector prob = NumericVector::create()) { - RNGScope scope; - LogicalVector ret = RcppArmadillo::sample(x, size, replace, prob); - return ret; -} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/sparse.cpp b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/sparse.cpp deleted file mode 100644 index 611b1539e..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/cpp/sparse.cpp +++ /dev/null @@ -1,88 +0,0 @@ -// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- -// -// sparse.cpp: RcppArmadillo unit test code for sparse matrices -// -// Copyright (C) 2014 Dirk Eddelbuettel -// -// This file is part of RcppArmadillo. -// -// RcppArmadillo is free software: you can redistribute it and/or modify it -// under the terms of the GNU General Public License as published by -// the Free Software Foundation, either version 2 of the License, or -// (at your option) any later version. -// -// RcppArmadillo is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with RcppArmadillo. If not, see . - -// [[Rcpp::depends(RcppArmadillo)]] -#include - -// [[Rcpp::export]] -arma::sp_mat asSpMat(SEXP S) { - return Rcpp::as(S); -} -// [[Rcpp::export]] -Rcpp::List asStm(SEXP S) { - return Rcpp::simple_triplet_matrix(Rcpp::as(S)); -} - -// [[Rcpp::export]] -arma::sp_mat sparseAddition(arma::sp_mat SM) { - return SM + SM; -} - -// [[Rcpp::export]] -arma::sp_mat sparseMultiplication(arma::sp_mat SM, int k) { - return k * SM; -} - -// [[Rcpp::export]] -arma::sp_mat fromTriplet(arma::urowvec ri, arma::urowvec ci, arma::colvec values) { - arma::umat loc = arma::join_vert(ri, ci);// form 2*N 'locations' matrix - arma::sp_mat sp(loc, values); // create sparse from locations and values - return sp; -} - -// [[Rcpp::export]] -arma::sp_mat sparseTranspose(arma::sp_mat SM) { - return SM.t(); -} - -// [[Rcpp::export]] -arma::sp_mat sparseSqrt(arma::sp_mat SM) { - return arma::sqrt(SM); -} - -// [[Rcpp::export]] -arma::sp_mat sparseSquare(arma::sp_mat SM) { - return arma::square(SM); -} - -// [[Rcpp::export]] -arma::sp_mat sparseIterators(arma::sp_mat SM, double val) { - arma::sp_mat::iterator begin = SM.begin(); - arma::sp_mat::iterator end = SM.end(); - - for (arma::sp_mat::iterator it = begin; it != end; ++it) - (*it) += val; - - return SM; -} - -// [[Rcpp::export]] -Rcpp::List sparseList(Rcpp::List l) { - arma::sp_mat mat1 = l[0]; - arma::sp_mat mat2 = l[0]; - - return Rcpp::List::create(mat1, mat2); -} - -// [[Rcpp::export]] -arma::sp_mat speye(int nrow, int ncol) { - return arma::speye(nrow, ncol); -} diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_Rlapack.R b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_Rlapack.R deleted file mode 100644 index fba72ac13..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_Rlapack.R +++ /dev/null @@ -1,51 +0,0 @@ -#!/usr/bin/r -t -# -# Copyright (C) 2018 - 2022 Keith O'Hara and Dirk Eddelbuettel -# Copyright (C) 2019 - 2022 Dirk Eddelbuettel -# -# This file is part of RcppArmadillo. -# -# RcppArmadillo is free software: you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 2 of the License, or -# (at your option) any later version. -# -# RcppArmadillo is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with RcppArmadillo. If not, see . - -library(RcppArmadillo) - -if (isFALSE(tryCatch({svd(matrix(complex(1, 1, 1),1,1)); TRUE}, error=function(e) FALSE))) - exit_file("Skipping for lack of Fortran complex functions in this R build") - -Rcpp::sourceCpp("cpp/Rlapack.cpp") - -set.seed(123) - -## create variables - -n <- 5 # size the of matrices generated in tests -n_tri <- 50 # size the of matrices generated in tridiagonal tests - -## Basic operations - -rl1 <- norm(cx_eig_pair_test(n),"2") -rl2 <- norm(cx_qz_test(n),"2") -rl3 <- cx_rank_test(n) # should equal n -rl4 <- norm(cx_solve_test(n),"2") -rl5 <- norm(cx_solve_band_test(n_tri),"2") -rl6 <- norm(cx_pinv_test(n),"2") # should be (approx) an identity matrix -rl7 <- norm(cx_schur_test(n),"2") - -expect_equal(rl1, 0)#, msg="eig_pair for complex matrices") -expect_equal(rl2, 0)#, msg="qz for complex matrices") -expect_equal(rl3, n)#, msg="rank complex matrices") -expect_equal(rl4, 0)#, msg="solve for complex matrices") -expect_equal(rl5, 0)#, msg="solve for band complex matrices") -expect_equal(rl6, 1)#, msg="pinv for complex matrices") -expect_equal(rl7, 0)#, msg="schur for complex matrices") diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_complex.R b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_complex.R deleted file mode 100644 index e652cd9cf..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_complex.R +++ /dev/null @@ -1,56 +0,0 @@ -#!/usr/bin/r -t -# -# Copyright (C) 2013 - 2019 Baptiste Auguie and Dirk Eddelbuettel -# Copyright (C) 2019 - 2020 Dirk Eddelbuettel -# -# This file is part of RcppArmadillo. -# -# RcppArmadillo is free software: you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 2 of the License, or -# (at your option) any later version. -# -# RcppArmadillo is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with RcppArmadillo. If not, see . - -library(RcppArmadillo) - -## It now (Apr 2020) appears to fail on 32-bit Windows -.onWindows <- .Platform$OS.type == "windows" -.is32bit <- .Platform$r_arch == "i386" - -if (.onWindows && .is32bit) exit_file("Do not bother on 32-bit Windows") - -Rcpp::sourceCpp("cpp/complex.cpp") - -set.seed(123) - -## create variables - -A <- matrix(rnorm(9), 3) -B <- matrix(rnorm(9), 3) -C <- A + 1i * B - -V <- rnorm(3) + 1i * rnorm(3) -S <- matrix(rnorm(5*3), nrow=3) - -## Basic operations - -rl <- complexCppTests(A, B, V, S) # returns results list from C++ - -expect_equal(rl[["C"]], C)#, msg="complex matrix") -expect_equal(rl[["Cst"]], t(C))#, msg="complex matrix transpose") -expect_equal(rl[["Ct"]], Conj(t(C)))#, msg="complex matrix transpose conjugated") -expect_equal(rl[["conjC"]], Conj(C))#, msg="complex matrix conjugated") -expect_equal(rl[["absC"]], Mod(C))#, msg="complex matrix mod") -expect_equal(rl[["CV"]], C %*% V)#, msg="complex matrix product") -expect_equal(rl[["CS"]], C %*% S)#, msg="complex matrix times vector") -expect_equal(rl[["CC"]], C * C)#, msg="complex matrix ops mult") -expect_equal(rl[["CdC"]], C / C)#, msg="complex matrix ops div") -expect_equal(rl[["CpC"]], C + C)#, msg="complex matrix ops plus") -expect_equal(rl[["CmC"]], C - C)#, msg="complex matrix ops minus") diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_cube.R b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_cube.R deleted file mode 100644 index fa078f739..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_cube.R +++ /dev/null @@ -1,82 +0,0 @@ -#!/usr/bin/r -t -# -# Copyright (C) 2015 - 2021 Dirk Eddelbuettel and Nathan Russell -# Copyright (C) 2019 Dirk Eddelbuettel -# -# This file is part of RcppArmadillo. -# -# RcppArmadillo is free software: you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 2 of the License, or -# (at your option) any later version. -# -# RcppArmadillo is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with RcppArmadillo. If not, see . - - -library(RcppArmadillo) - -Rcpp::sourceCpp("cpp/cube.cpp") - -.onWindows <- .Platform$OS.type == "windows" -critTol <- if (.onWindows) 1.0e-6 else 1.5e-7 - -## test arrays -dbl_cube <- array(1.5:27.5, rep(3, 3)) -int_cube <- array(1L:27L, rep(3, 3)) -cplx_cube <- array(1.5:27.5 + 2i, rep(3, 3)) - -## check cube (Cube) and fcube (Cube) -expect_equal(cube_test(dbl_cube), (dbl_cube ** 2)) #, "cube_test") -expect_equal(fcube_test(dbl_cube), (dbl_cube ** 2)) #, "fcube_test") - -## check icube (Cube) and ucube (Cube) -expect_equal(icube_test(int_cube), (int_cube ** 2)) #, "icube_test") -expect_equal(ucube_test(int_cube), (int_cube ** 2)) #, "ucube_test") - -## check cx_cube (Cube) and cx_fcube (Cube) -expect_equal(cx_cube_test(cplx_cube), (cplx_cube ** 2)) #, "cx_cube_test") -expect_equivalent(cx_fcube_test(cplx_cube), (cplx_cube ** 2), #"cx_fcube_test", - tolerance = critTol) - - -## test that exception is thrown with dims(x) != 3 -dbl_cube <- array(1.5:16.5, rep(2, 4)) -int_cube <- array(1L:16L, rep(2, 4)) -cplx_cube <- array(1.5:16.5 + 2i, rep(2, 4)) - -## cube_test and fcube_test should throw here -expect_error(cube_test(dbl_cube)) #"cube_test bad dimensions") -expect_error(fcube_test(dbl_cube)) #"fcube_test bad dimensions") - -## icube_test and ucube_test should throw here -expect_error(icube_test(int_cube)) #"icube_test bad dimensions") -expect_error(ucube_test(int_cube)) #"ucube_test bad dimensions") - -## cx_cube_test and cx_fcube_test should throw here -expect_error(cx_cube_test(cplx_cube)) #"cx_cube_test bad dimensions") -expect_error(cx_fcube_test(cplx_cube)) #"cx_fcube_test bad dimensions") - - -## sanity check for explicit calls to Rcpp::as< arma::Cube > -dbl_cube <- array(1.5:27.5, rep(3, 3)) -int_cube <- array(1L:27L, rep(3, 3)) -cplx_cube <- array(1.5:27.5 + 2i, rep(3, 3)) - -## check cube (Cube) and fcube (Cube) -expect_equal(as_cube(dbl_cube), (dbl_cube ** 2))#, "as_cube") -expect_equal(as_fcube(dbl_cube), (dbl_cube ** 2))#, "as_fcube") - -## check icube (Cube) and ucube (Cube) -expect_equal(as_icube(int_cube), (int_cube ** 2))#, "as_icube") -expect_equal(as_ucube(int_cube), (int_cube ** 2))#, "as_ucube") - -## check cx_cube (Cube) and cx_fcube (Cube) -expect_equal(as_cx_cube(cplx_cube), (cplx_cube ** 2))#, "as_cx_cube") -expect_equivalent(as_cx_fcube(cplx_cube), (cplx_cube ** 2), #"as_cx_fcube", - tolerance = critTol) diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_fastLm.R b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_fastLm.R deleted file mode 100644 index 3aef3fc02..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_fastLm.R +++ /dev/null @@ -1,89 +0,0 @@ -#!/usr/bin/r -t -## -## Copyright (C) 2010 - 2019 Dirk Eddelbuettel, Romain Francois and Douglas Bates -## -## This file is part of RcppArmadillo. -## -## RcppArmadillo is free software: you can redistribute it and/or modify it -## under the terms of the GNU General Public License as published by -## the Free Software Foundation, either version 2 of the License, or -## (at your option) any later version. -## -## RcppArmadillo is distributed in the hope that it will be useful, but -## WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with RcppArmadillo. If not, see . - -library(RcppArmadillo) -library(datasets) - -#test.fastLm <- function() { -data(trees, package="datasets") -flm <- fastLmPure(cbind(1, log(trees$Girth)), log(trees$Volume)) -fit <- lm(log(Volume) ~ log(Girth), data=trees) - -expect_equal(as.numeric(flm$coefficients), as.numeric(coef(fit)))#,msg="fastLm.coef") -expect_equal(as.numeric(flm$stderr), as.numeric(coef(summary(fit))[,2]))#,msg="fastLm.stderr") -expect_equal(as.numeric(flm$df.residual), as.numeric(fit$df.residual))#,msg="fastLm.df.residual") - - -#test.fastLm.default <- function() { -data(trees, package="datasets") -flm <- RcppArmadillo:::fastLm.default(cbind(1, log(trees$Girth)), log(trees$Volume)) -fit <- lm(log(Volume) ~ log(Girth), data=trees) - -expect_equal(as.numeric(flm$coefficients), as.numeric(coef(fit)))#,msg="fastLm.default.coef") -expect_equal(as.numeric(flm$stderr), as.numeric(coef(summary(fit))[,2]))#,msg="fastLm.default.stderr") -expect_equal(as.numeric(flm$df.residual), as.numeric(fit$df.residual))#,msg="fastLm.default.df.residual") -expect_equal(as.numeric(flm$residuals), as.numeric(fit$residuals))#,msg="fastLm.default.residuals") -expect_equal(as.numeric(flm$fitted.values), as.numeric(fit$fitted.values))#,msg="fastLm.default.fitted.values") - -#test.summary.fastLm <- function() { -data(trees, package="datasets") -sflm <- summary(fastLm(log(Volume) ~ log(Girth), data=trees)) -sfit <- summary(lm(log(Volume) ~ log(Girth), data=trees)) - -expect_equal(as.numeric(coef(sflm)), as.numeric(coef(sfit)))#,msg="summary.fastLm.coef") -expect_equal(sflm$r.squared, sfit$r.squared)#,msg="summary.fastLm.r.squared") -expect_equal(sflm$adj.r.squared, sfit$adj.r.squared)#,msg="summary.fastLm.r.squared") -expect_equal(sflm$sigma, sfit$sigma)#,msg="summary.fastLm.sigma") - -## no intercept case -sflm <- summary(fastLm(log(Volume) ~ log(Girth) - 1, data=trees)) -sfit <- summary(lm(log(Volume) ~ log(Girth) - 1, data=trees)) -expect_equal(as.numeric(coef(sflm)), as.numeric(coef(sfit)))#,msg="summary.fastLm.coef.noint") -expect_equal(sflm$r.squared, sfit$r.squared)#,msg="summary.fastLm.r.squared.noint") -expect_equal(sflm$adj.r.squared, sfit$adj.r.squared)#,msg="summary.fastLm.r.squared.noint") -expect_equal(sflm$sigma, sfit$sigma)#,msg="summary.fastLm.sigma.noint") - -## non-formula use -sflm <- summary(fastLm(log(trees$Girth), log(trees$Volume))) -sfit <- summary(lm(log(Volume) ~ log(Girth) - 1, data=trees)) -expect_equal(as.numeric(coef(sflm)), as.numeric(coef(sfit)))#,msg="summary.fastLm.coef.nonform") -expect_equal(sflm$r.squared, sfit$r.squared)#,msg="summary.fastLm.r.squared.nonform") -expect_equal(sflm$adj.r.squared, sfit$adj.r.squared)#,msg="summary.fastLm.r.squared.nonform") -expect_equal(sflm$sigma, sfit$sigma)#,msg="summary.fastLm.sigma.nonform") - - -#test.fastLm.formula <- function() { -data(trees, package="datasets") -flm <- fastLm(log(Volume) ~ log(Girth), data=trees) -fit <- lm(log(Volume) ~ log(Girth), data=trees) - -expect_equal(flm$coefficients, coef(fit))#, msg="fastLm.formula.coef") -expect_equal(as.numeric(flm$stderr), as.numeric(coef(summary(fit))[,2]))#,msg="fastLm.formula.stderr") -expect_equal(as.numeric(flm$df.residual), as.numeric(fit$df.residual))#,msg="fastLm.formula.df.residual") -expect_equal(as.numeric(flm$residuals), as.numeric(fit$residuals))#,msg="fastLm.formula.residuals") -expect_equal(as.numeric(flm$fitted.values), as.numeric(fit$fitted.values))#,msg="fastLm.formula.fitted.values") - -## also tickle print and predict methods -expect_stdout(print(flm)) -expect_stdout(print(summary(flm))) -vec <- predict(flm, newdata=data.frame(Girth=c(1,2,3), Volume=c(2,3,4))) -expect_equal(class(vec), "numeric") -expect_equal(length(vec), 3L) -vec <- predict(flm, newdata=NULL) -expect_equal(vec, fitted(flm)) diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_fields.R b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_fields.R deleted file mode 100644 index 2f3a4e0d7..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_fields.R +++ /dev/null @@ -1,84 +0,0 @@ - -# Copyright (C) 2021 - 2022 Dirk Eddelbuettel -# -# This file is part of RcppArmadillo. -# -# RcppArmadillo is free software: you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 2 of the License, or -# (at your option) any later version. -# -# RcppArmadillo is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with RcppArmadillo. If not, see . - -library(RcppArmadillo) - -Rcpp::sourceCpp("cpp/fields.cpp") - -.onWindows <- .Platform$OS.type == "windows" - -f1m22 <- field1m22() -expect_true(inherits(f1m22, "array")) -expect_true(inherits(f1m22[[1]], "matrix")) -if (!has_old_field_behavior()) expect_equal(dim(f1m22), c(1,1,1)) -expect_equal(dim(f1m22[[1]]), c(2,2)) - -f11m22 <- field11m22() -expect_true(inherits(f11m22, "array")) -expect_true(inherits(f11m22[[1]], "matrix")) -if (!has_old_field_behavior()) expect_equal(dim(f11m22), c(1,1,1)) -expect_equal(dim(f11m22[[1]]), c(2,2)) - -f12m22 <- field12m22() -expect_true(inherits(f12m22, "array")) -expect_true(inherits(f12m22[[1]], "matrix")) -if (!has_old_field_behavior()) expect_equal(dim(f12m22), c(1,2,1)) -expect_equal(dim(f12m22[[1]]), c(2,2)) -expect_equal(dim(f12m22[[2]]), c(2,2)) - -f21m22 <- field21m22() -expect_true(inherits(f21m22, "array")) -expect_true(inherits(f21m22[[1]], "matrix")) -if (!has_old_field_behavior()) expect_equal(dim(f21m22), c(2,1,1)) -expect_equal(dim(f21m22[[1]]), c(2,2)) -expect_equal(dim(f21m22[[2]]), c(2,2)) - -f22m2233 <- field22m2233() -expect_true(inherits(f22m2233, "array")) -expect_true(inherits(f22m2233[[1]], "matrix")) -if (!has_old_field_behavior()) expect_equal(dim(f22m2233), c(2,2,1)) -expect_equal(dim(f22m2233[[2]]), c(3,3)) -expect_equal(dim(f22m2233[[3]]), c(2,2)) - -if (!has_old_field_behavior()) { - f222m223344 <- field222m223344() - expect_true(inherits(f222m223344, "array")) - expect_true(inherits(f222m223344[[1]], "matrix")) - expect_equal(dim(f222m223344), c(2,2,2)) - expect_equal(dim(f222m223344[[2]]), c(3,3)) - expect_equal(dim(f222m223344[[3]]), c(2,2)) -} - -v <- infield1m22( field1m22() ) -expect_equal(v, matrix(c(1L, 1L, 1L),3,1)) - -v <- infield11m22( field11m22() ) -expect_equal(v, matrix(c(1L, 1L, 1L),3,1)) - -v <- infield12m22( field12m22() ) -expect_equal(v, matrix(c(2L, 1L, 1L),3,1)) # should be 1,2,1 ? - -v <- infield21m22( field21m22() ) -expect_equal(v, matrix(c(2L, 1L, 1L),3,1)) - -v <- infield22m2233( field22m2233() ) -expect_equal(v, matrix(c(4L, 1L, 1L),3,1)) # should 2,2,1 ? - -#v <- infield222m223344( field222m223344() ) -#expect_equal(v, matrix(c(4L, 1L, 1L),3,1)) # should 2,2,1 ? -#print(v) diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_fields_new.R b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_fields_new.R deleted file mode 100644 index 688e9bdf0..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_fields_new.R +++ /dev/null @@ -1,83 +0,0 @@ - -# Copyright (C) 2021 Dirk Eddelbuettel -# -# This file is part of RcppArmadillo. -# -# RcppArmadillo is free software: you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 2 of the License, or -# (at your option) any later version. -# -# RcppArmadillo is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with RcppArmadillo. If not, see . - -library(RcppArmadillo) - -Rcpp::sourceCpp("cpp/fields_new.cpp") - -.onWindows <- .Platform$OS.type == "windows" - -f1m22 <- field1m22n() -expect_true(inherits(f1m22, "array")) -expect_true(inherits(f1m22[[1]], "matrix")) -expect_equal(dim(f1m22), c(1,1,1)) -expect_equal(dim(f1m22[[1]]), c(2,2)) - -f11m22 <- field11m22n() -expect_true(inherits(f11m22, "array")) -expect_true(inherits(f11m22[[1]], "matrix")) -expect_equal(dim(f11m22), c(1,1,1)) -expect_equal(dim(f11m22[[1]]), c(2,2)) - -f12m22 <- field12m22n() -expect_true(inherits(f12m22, "array")) -expect_true(inherits(f12m22[[1]], "matrix")) -expect_equal(dim(f12m22), c(1,2,1)) -expect_equal(dim(f12m22[[1]]), c(2,2)) -expect_equal(dim(f12m22[[2]]), c(2,2)) - -f21m22 <- field21m22n() -expect_true(inherits(f21m22, "array")) -expect_true(inherits(f21m22[[1]], "matrix")) -expect_equal(dim(f21m22), c(2,1,1)) -expect_equal(dim(f21m22[[1]]), c(2,2)) -expect_equal(dim(f21m22[[2]]), c(2,2)) - -f22m2233 <- field22m2233n() -expect_true(inherits(f22m2233, "array")) -expect_true(inherits(f22m2233[[1]], "matrix")) -expect_equal(dim(f22m2233), c(2,2,1)) -expect_equal(dim(f22m2233[[2]]), c(3,3)) -expect_equal(dim(f22m2233[[3]]), c(2,2)) - -f222m223344 <- field222m223344n() -expect_true(inherits(f222m223344, "array")) -expect_true(inherits(f222m223344[[1]], "matrix")) -expect_equal(dim(f222m223344), c(2,2,2)) -expect_equal(dim(f222m223344[[2]]), c(3,3)) -expect_equal(dim(f222m223344[[3]]), c(2,2)) -expect_equal(dim(f222m223344[[5]]), c(4,4)) - - -v <- infield1m22n( field1m22n() ) -expect_equal(v, matrix(c(1L, 1L, 1L),3,1)) - -v <- infield11m22n( field11m22n() ) -expect_equal(v, matrix(c(1L, 1L, 1L),3,1)) - -v <- infield12m22n( field12m22n() ) -expect_equal(v, matrix(c(1L, 2L, 1L),3,1)) - -v <- infield21m22n( field21m22n() ) -expect_equal(v, matrix(c(2L, 1L, 1L),3,1)) - -v <- infield22m2233n( field22m2233n() ) -expect_equal(v, matrix(c(2L, 2L, 1L),3,1)) - -v <- infield222m223344n( field222m223344n() ) -expect_equal(v, matrix(c(2L, 2L, 2L),3,1)) diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_misc.R b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_misc.R deleted file mode 100644 index c52b5d249..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_misc.R +++ /dev/null @@ -1,45 +0,0 @@ -#!/usr/bin/r -t -# -# Copyright (C) 2021-2023 Dirk Eddelbuettel -# -# This file is part of RcppArmadillo. -# -# RcppArmadillo is free software: you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 2 of the License, or -# (at your option) any later version. -# -# RcppArmadillo is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with RcppArmadillo. If not, see . - -library(RcppArmadillo) - -## -- src/RcppArmadillo.cpp -arma <- armadillo_version(FALSE) -expect_equal(length(arma), 3) # major minor patch -expect_equal(names(arma), c("major","minor","patch")) -arma <- armadillo_version(TRUE) -expect_equal(class(arma), "integer") -expect_equal(length(arma), 1L) - -## no tests as we have no (current) accessor as we prefer R RNGs -expect_warning(armadillo_set_seed_random()) -armadillo_set_seed(42L) # no test as we have no (current) accessor as we prefer R RNGs - - -## -- R/flags.R -cxxflags <- RcppArmadillo:::RcppArmadilloCxxFlags() -expect_true(is.character(cxxflags)) -expect_stdout(RcppArmadillo:::CxxFlags()) - -## 'set number of threads' helper -- adding simple test -expect_true(is.integer(armadillo_get_number_of_omp_threads())) -expect_silent(armadillo_set_number_of_omp_threads(2)) -## startup throttle/restore helpers -expect_silent(armadillo_throttle_cores()) -expect_silent(armadillo_reset_cores()) diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_rcpparmadillo.R b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_rcpparmadillo.R deleted file mode 100644 index bf0021808..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_rcpparmadillo.R +++ /dev/null @@ -1,218 +0,0 @@ -#!/usr/bin/r -t -# -# Copyright (C) 2010 - 2019 Dirk Eddelbuettel, Romain Francois and Douglas Bates -# Copyright (C) 2019 - 2022 Dirk Eddelbuettel -# -# This file is part of RcppArmadillo. -# -# RcppArmadillo is free software: you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 2 of the License, or -# (at your option) any later version. -# -# RcppArmadillo is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with RcppArmadillo. If not, see . - -library(RcppArmadillo) - -Rcpp::sourceCpp("cpp/armadillo.cpp") - -## test.wrap.R -fx <- wrap_ -res <- fx() - -expect_equal( res[[1]][[1]], matrix(as.integer((diag(3))),nr=3))#, msg = "eye(3,3)" ) -expect_equal( res[[1]][[2]], diag(3))#, msg = "eye(3,3)" ) -expect_equal( res[[1]][[3]], diag(3))#, msg = "eye(3,3)" ) -expect_equal( res[[1]][[4]], matrix(as.integer((diag(3))),nr=3))#, msg = "eye(3,3)" ) - -expect_equal( res[[2]][[1]], matrix(0, ncol = 5, nrow=1))#, msg = "zeros(5,1)" ) -expect_equal( res[[2]][[2]], matrix(0, ncol = 5, nrow=1))#, msg = "zeros(5,1)" ) - -expect_equal( res[[3]][[1]], matrix(0, ncol = 1, nrow=5))#, msg = "zeros(1,5)" ) -expect_equal( res[[3]][[2]], matrix(0, ncol = 1, nrow=5))#, msg = "zeros(1,5)" ) - -if (!has_old_field_behavior()) { - expect_equal( res[[4]][[1]], array(0:3, dim=c(2,2,1)))#, msg = "field" ) - expect_equal( res[[4]][[2]], array(letters[1:4], dim=c(2,2,1)))#, msg = "field" ) -} - -# test.wrap.Glue <- function(){ -fx <- wrapGlue_ -res <- fx() -expect_equal( res[[1]], 2*diag(3))#, msg = "wrap(Glue)" ) - - -# test.wrap.Op <- function(){ -fx <- wrapOp_ -res <- fx() -expect_equal( res[[1]], -1*diag(3))#, msg = "wrap(Op)" ) - - -# test.as.Mat <- function(){ -fx <- asMat_ -integer_mat <- matrix( as.integer(diag(4)), ncol = 4, nrow = 4 ) -numeric_mat <- diag(5) -res <- fx( list( integer_mat, numeric_mat ) ) -expect_equal( unlist( res), c(4L, 5L, 4L, 5L ))#, msg = "as" ) -#} - -#test.as.Col <- function(){ -fx <- asCol_ -res <- fx( list( 1:10, as.numeric(1:10) ) ) -expect_equal( unlist( res ), rep(55.0, 4 ))#, msg = "as" ) -#} - -#test.as.Row <- function(){ -fx <- asRow_ -res <- fx( list( 1:10, as.numeric(1:10) ) ) -expect_equal( unlist( res ), rep(55.0, 4 ))#, msg = "as" ) - - -#test.cxmat <- function(){ -fx <- cxMat_ -expect_equal(fx(), list(double=(1+0i)*diag(3), float=(1+0i)*diag(3))) #,msg = "support for complex matrices" ) - -#test.mtOp <- function(){ -fx <- mtOp_ -expect_equal(fx(), (1+2i)*diag(3))#, msg = "support for mtOp" ) - -#test.mtGlue <- function(){ -fx <- mtGlue_ -expect_equal(fx(), 2.0 * diag(3))# , msg = "support for mtGlue" ) - -#test.sugar <- function(){ -fx <- sugar_ -expect_equal(fx(1:10), matrix( 2*(1:10), nrow = 10 ))# , msg = "RcppArmadillo and sugar" ) - -#test.sugar.cplx <- function(){ -fx <- sugarCplx_ -x <- 1:10*(1+1i) -expect_equal(fx(x), matrix( exp(x), nrow = 10 ))# , msg = "RcppArmadillo and sugar (complex)" ) - -#test.armadillo.sugar.ctor <- function(){ -fx <- sugarCtor_ -expect_equal(fx(1:10), list(mat = matrix( 4*(1:10), nrow = 10 ), - rowvec = matrix( 1:10, nrow = 1 ), - colvec = matrix( 1:10, ncol = 1 ))) #,msg = "Mat( sugar expression )" ) - -#test.armadillo.sugar.matrix.ctor <- function(){ -fx <- sugarMatrixCtor_ -res <- fx(1:10) -norm <- function(x, y) sqrt( x*x + y*y ) -expect_equal(res, list(mat = diag(2*(1:10)), - rowvec = outer( 1, 1:10, norm ), - colvec = outer( 1:10, 1, norm ))) #msg = "Mat( sugar expression )" ) - -## test.armadillo.rtti.check <- function() { - -## inc <- ' -## void blah(arma::mat& X) { -## X.set_size(5,5); -## } -## ' -## src <- ' -## arma::vec V; -## blah(V); // if blah() worked, we have a problem -## ' -## fun <- cxxfunction(signature(), body=src, inc=inc, plugin = "RcppArmadillo") - -## checkException(fun(), msg="RTTI check on matrix constructor exception") - -## } - -#test.armadillo.mat.plain <- function() { -fx <- mat_plain -m <- matrix(1:9, 3, 3) -expect_equal(fx(m), 9)#, msg = "Plain Matrix function signature" ) - -#test.armadillo.mat.const <- function() { -fx <- mat_const -m <- matrix(1:9, 3, 3) -expect_equal(fx(m), 9)#, msg = "Const Matrix function signature" ) - -#test.armadillo.mat.ref <- function() { -fx <- mat_ref -m <- matrix(1:9, 3, 3) -expect_equal(fx(m), 9)#, msg = "Reference Matrix function signature" ) - -#test.armadillo.mat.const.ref <- function() { -fx <- mat_const_ref -m <- matrix(1:9, 3, 3) -expect_equal(fx(m), 9)#, msg = "Const Reference Matrix function signature" ) - -#test.armadillo.vec.plain <- function() { -fx <- vec_plain -m <- 1:9 -expect_equal(fx(m), 9)#, msg = "Plain Vector function signature" ) - -#test.armadillo.vec.const <- function() { -fx <- vec_const -m <- 1:9 -expect_equal(fx(m), 9)#, msg = "Const Vector function signature" ) - -#test.armadillo.vec.ref <- function() { -fx <- vec_ref -m <- 1:9 -expect_equal(fx(m), 9)#, msg = "Reference Vector function signature" ) - -#test.armadillo.vec.const.ref <- function() { -fx <- vec_const_ref -m <- 1:9 -expect_equal(fx(m), 9)#, msg = "Const Reference Vector function signature" ) - -#test.armadillo.mat.plain <- function() { -fx <- cx_mat_plain -m <- matrix(1:9, 3, 3) -expect_equal(fx(m), 9)#, msg = "Plain Matrix function signature" ) - -#test.armadillo.mat.const <- function() { -fx <- cx_mat_const -m <- matrix(1:9, 3, 3) -expect_equal(fx(m), 9)#, msg = "Const Matrix function signature" ) - -#test.armadillo.mat.ref <- function() { -fx <- cx_mat_ref -m <- matrix(1:9, 3, 3) -expect_equal(fx(m), 9)#, msg = "Reference Matrix function signature" ) - -#test.armadillo.mat.const.ref <- function() { -fx <- cx_mat_const_ref -m <- matrix(1:9, 3, 3) -expect_equal(fx(m), 9)#, msg = "Const Reference Matrix function signature" ) - - -Rcpp::sourceCpp("cpp/colrow_as_vec.cpp") - -vec <- as.matrix(1:3) -expect_equal(vec, uvec_test(vec)) -expect_equal(vec, c_uvec_test(vec)) -expect_equal(vec, r_uvec_test(vec)) -expect_equal(vec, cr_uvec_test(vec)) - -mat <- matrix(1:4, nrow=2) -expect_equal(mat, umat_test(mat)) -expect_equal(mat, c_umat_test(mat)) -expect_equal(mat, r_umat_test(mat)) -expect_equal(mat, cr_umat_test(mat)) - - -Rcpp::sourceCpp("cpp/any_as_vec.cpp") - -vec <- 1:3 -vecc <- as.matrix(1:3) -vecr <- t(vecc) - -expect_equal(vecc, vecc_test(vec))#, msg="legacy vec") -expect_equal(vecr, vecr_test(vecr))#, msg="legacy rowvec") - -expect_equal(vec, vecc_as_v_test(vec))#, msg="vec as vector") -expect_equal(vec, vecr_as_v_test(vec))#, msg="rowvec as vector") - -expect_equal(vec, veccany_as_v_test(vec))#, msg="vec (by any) as vector") -expect_equal(vec, vecrany_as_v_test(vec))#, msg="rowvec (by any) as vector") diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_rmultinom.R b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_rmultinom.R deleted file mode 100644 index c4c075fcf..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_rmultinom.R +++ /dev/null @@ -1,67 +0,0 @@ -#!/usr/bin/r -t -## -## Copyright (C) 2013 Romain Francois -## Copyright (C) 2014 - 2019 Christian Gunning and Dirk Eddelbuettel -## Copyright (C) 2019 Dirk Eddelbuettel -## -## This file is part of RcppArmadillo. -## -## RcppArmadillo is free software: you can redistribute it and/or modify it -## under the terms of the GNU General Public License as published by -## the Free Software Foundation, either version 2 of the License, or -## (at your option) any later version. -## -## RcppArmadillo is distributed in the hope that it will be useful, but -## WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with RcppArmadillo. If not, see . - -.runThisTest <- isTRUE(capabilities("long.double")) - -if (!.runThisTest) exit_file("No long double support") - -library(RcppArmadillo) - -Rcpp::sourceCpp("cpp/rmultinom.cpp") - -## Seed needs to be reset to compare R to C++ -.seed=39 - -## test cases -## should be indentical between R and C++ -tests <- list( - vanilla=list( n=5, size=100, prob=rep(1/10,10)), - big=list( n=5, size=1e6, prob=rep(1/1e3,1e3)), - fixup.prob=list( n=10, size=1e5, prob=1:10), - n0=list( n=0, size=5, prob=1:10), - size0=list( n=10, size=0, prob=1:10) -) - -fail.tests <- list( - na.prob=list( n=7, size=100, prob=c(1:10,NA)), - prob0=list( n=10, size=100, prob=0) -) - -## these give errors -lapply(names(fail.tests), function(.name) { - with(fail.tests[[.name]], { - expect_error(rmultinom(n, size, prob)) #msg=sprintf("rmultinom.R.error.%s",.name) - }) - with(fail.tests[[.name]], { - expect_error(rmultinomC(n, size, prob)) #msg=sprintf("rmultinom.cpp.error.%s",.name) - }) -}) - -## for each test, check that results match -lapply(names(tests), function(.name) { - with(tests[[.name]], { - set.seed(.seed) - r.multinom <- rmultinom(n, size, prob) - set.seed(.seed) - c.multinom <- rmultinomC(n, size, prob) - expect_equal(r.multinom, c.multinom)# , msg=sprintf("rmultinom.%s",.name)) - }) -}) diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_rng.R b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_rng.R deleted file mode 100644 index d00d3c152..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_rng.R +++ /dev/null @@ -1,62 +0,0 @@ -#!/usr/bin/r -t -# -# Copyright (C) 2014 - 2019 Dirk Eddelbuettel -# -# This file is part of RcppArmadillo. -# -# RcppArmadillo is free software: you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 2 of the License, or -# (at your option) any later version. -# -# RcppArmadillo is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with RcppArmadillo. If not, see . - -library(RcppArmadillo) - -Rcpp::sourceCpp("cpp/rng.cpp") - -#test.randu.seed <- function() { -set.seed(123) -a <- randu(10) -set.seed(123) -b <- randu(10) -expect_equal(a, b)#, msg="randu seeding") - -#test.randi.seed <- function() { -set.seed(123) -a <- randi(10) -set.seed(123) -b <- randi(10) -expect_equal(a, b)#, msg="randi seeding") - -#test.randn.seed <- function() { -set.seed(123) -a <- randn(10) -set.seed(123) -b <- randn(10) -expect_equal(a, b)#, msg="randn seeding") - -#test.randu <- function() { -set.seed(123) -a <- randu(10) -expect_true(min(a) > 0)#, msg="randu min") -expect_true(max(a) < 1)#, msg="randu max") - -#test.randi <- function() { -set.seed(123) -a <- randi(10) -expect_true(min(a) > 0)#, msg="randi min") -expect_true(typeof(a) == "integer")#, msg="randi type") - -#test.randn <- function() { -set.seed(123) -a <- randn(10) -expect_true(min(a) > -4)#, msg="randn min") -expect_true(max(a) < 4)#, msg="randn max") -expect_true(typeof(a) == "double")#, msg="randi type") diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_sample.R b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_sample.R deleted file mode 100644 index a3b8efc40..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_sample.R +++ /dev/null @@ -1,111 +0,0 @@ -#!/usr/bin/r -t -# -## Copyright (C) 2012 - 2019 Christian Gunning -## Copyright (C) 2013 - 2019 Romain Francois -## Copyright (C) 2019 Dirk Eddelbuettel -## -## -## This file is part of RcppArmadillo. -## -## RcppArmadillo is free software: you can redistribute it and/or modify it -## under the terms of the GNU General Public License as published by -## the Free Software Foundation, either version 2 of the License, or -## (at your option) any later version. -## -## RcppArmadillo is distributed in the hope that it will be useful, but -## WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with RcppArmadillo. If not, see . - -library(RcppArmadillo) - -Rcpp::sourceCpp("cpp/sample.cpp") - -#test.sample <- function() { -## set up S3 dispatching, -## simplifies lapply(tests, ...) below -csample <- function(x, ...) UseMethod("csample") -csample.numeric <- csample_numeric -csample.integer <- csample_integer -csample.complex <- csample_complex -csample.character <- csample_character -csample.logical <- csample_logical - -## Seed needs to be reset to compare R to C++ -seed <- 441 -## Input vectors to sample -N <- 100 -## Number of samples -## works for size == N?! -size <- N%/%2 - -## all atomic vector classes except raw -## for each list element, check that sampling works -## with and without replacement, with and without prob -tests <- list() -tests <- within(tests, { - int <- 1:N - num <- (1:N)/10 - cpx <- (1:N)/10 + 1i - char <-rep(letters, 4)[1:N] - bool <- rep(c(T,F), times=N/2) -}) - -## Un-normalized probs -probs <- seq(from=0, to=1, length.out=N) -##probs <- probs/sum(probs) - -## Needed for a change in R 3.6.0 reducing a bias in very large samples -suppressWarnings(RNGversion("3.5.0")) - -## Run the S3 generic function csample -## and associated R function on each data type -## ReplaceYN.ProbsYN -lapply(tests, function(dat) { - .class <- class(dat) - set.seed(seed) - ## R - r.no.no <- sample(dat, size, replace=F) - set.seed(seed) - r.yes.no <- sample(dat, size, replace=T) - set.seed(seed) - r.no.yes <- sample(dat, size, replace=F, prob=probs) - set.seed(seed) - r.yes.yes <- sample(dat, size, replace=T, prob=probs) - ## C - set.seed(seed) - c.no.no <- csample(dat, size, replace=F) - set.seed(seed) - c.yes.no <- csample(dat, size, replace=T) - set.seed(seed) - c.no.yes <- csample(dat, size, replace=F, prob=probs) - set.seed(seed) - c.yes.yes <- csample(dat, size, replace=T, prob=probs) - ## comparisons - expect_equal(r.no.no, c.no.no)#, msg=sprintf("sample.%s.no_replace.no_prob",.class)) - expect_equal(r.yes.no, c.yes.no)#, msg=sprintf("sample.%s.replace.no_prob",.class)) - ## the following don't pass - expect_equal(r.no.yes, c.no.yes)#, msg=sprintf("sample.%s.no_replace.prob",.class)) - expect_equal(r.yes.yes, c.yes.yes)#, msg=sprintf("sample.%s.replace.prob",.class)) -}) - -## Walker Alias method test -## With replacement, >200 "nonzero" probabilities -## Not implemented, see below -walker.N <- 1e3 -walker.sample <- (1:walker.N)/10 -walker.probs <- rep(0.1, walker.N) -## uncomment following 5 lines if/when walker alias method is implemented -set.seed(seed) -r.walker <- sample( walker.sample, walker.N, replace=T, prob=walker.probs) -set.seed(seed) -c.walker <- csample( walker.sample, walker.N, replace=T, prob=walker.probs) -expect_equal(r.walker, c.walker)#, msg=sprintf("Walker Alias method test")) -## Walker Alias method is not implemented. -## For this problem (replace, >200 non-zero probs) R is much faster -## So throw an error and refuse to proceed -##walker.error <- try( csample( walker.sample, walker.N, replace=T, prob=walker.probs), TRUE) -##expect_equal(inherits(walker.error, "try-error"), TRUE, msg=sprintf("Walker Alias method test")) diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_scipy2r.R b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_scipy2r.R deleted file mode 100644 index 0128b11d8..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_scipy2r.R +++ /dev/null @@ -1,78 +0,0 @@ -## py2r.R: Conversion of SciPy sparse matrix to R -## -## Copyright (C) 2017 - 2022 Binxiang Ni and Dirk Eddelbuettel -## -## This file is part of RcppArmadillo. -## -## RcppArmadillo is free software: you can redistribute it and/or modify it -## under the terms of the GNU General Public License as published by -## the Free Software Foundation, either version 2 of the License, or -## (at your option) any later version. -## -## RcppArmadillo is distributed in the hope that it will be useful, but -## WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with RcppArmadillo. If not, see . - -## Reference: https://docs.scipy.org/doc/scipy-0.19.1/reference/sparse.html - -#exit_file("Skip this test for now.") - -## It now (Apr 2020) appears to fail on 32-bit Windows -.onWindows <- .Platform$OS.type == "windows" -.is32bit <- .Platform$r_arch == "i386" - -#if (.onWindows && .is32bit) exit_file("Do not bother on 32-bit Windows") -if (.onWindows) exit_file("Do not bother on Windows") - -if (!requireNamespace("Matrix", quietly=TRUE)) exit_file("Package Matrix missing") -if (!requireNamespace("reticulate", quietly=TRUE)) exit_file("Package reticulate missing") -if (!packageVersion("reticulate") >= package_version("1.14")) exit_file("SciPy not needed on newer reticulate") - -suppressMessages({ - library(Matrix) - library(reticulate) -}) - -## SciPy implies NumPy too -if (! py_module_available("scipy")) exit_file("Module scipy missing") - -np <- import("numpy") -mat <- np$array(list(list(1, 0, 4), list(0, 0, 5), list(2, 3, 6))) -sp <- import("scipy.sparse") - -mtxt <- c("1 0 4", - "0 0 5", - "2 3 6") -M <- as.matrix(read.table(text=mtxt)) -dimnames(M) <- NULL - -## Since 'reticulate' automatically converts CSC matrix to dgCMatrix, -## no need to convert it in RcppArmadillo - -#test.csc2dgc <- function() { -csc <- sp$csc_matrix(mat) -dgC <- methods::as(M, "CsparseMatrix") -expect_equal(dgC, csc, info="csc2dgc") - -#test.coo2dgt <- function() { -coo <- sp$coo_matrix(mat) -dgT <- new("dgTMatrix", - i = c(0L, 0L, 1L, 2L, 2L, 2L), - j = c(0L, 2L, 2L, 0L, 1L, 2L), - x = c(1, 4, 5, 2, 3, 6), - Dim = c(3L, 3L)) -expect_equal(dgT, coo, info="coo2dgt") #RcppArmadillo:::.SciPy2R(coo)) - -#test.csr2dgr <- function() { -csr <- sp$csr_matrix(mat) -dgR <- methods::as(M, "RsparseMatrix") -expect_equal(dgR, csr, info="csr2dgr") #RcppArmadillo:::.SciPy2R(csr)) - -#test.other <- function() { -#bsr <- sp$bsr_matrix(list(3, 4)) -#expect_error(RcppArmadillo:::.SciPy2R(bsr)) -#expect_error(sp$bsr_matrix(list(3, 4))) diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_sparse.R b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_sparse.R deleted file mode 100644 index 326b7815c..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_sparse.R +++ /dev/null @@ -1,97 +0,0 @@ -#!/usr/bin/r -t -## -## Copyright (C) 2014 - 2022 Dirk Eddelbuettel -## -## This file is part of RcppArmadillo. -## -## RcppArmadillo is free software: you can redistribute it and/or modify it -## under the terms of the GNU General Public License as published by -## the Free Software Foundation, either version 2 of the License, or -## (at your option) any later version. -## -## RcppArmadillo is distributed in the hope that it will be useful, but -## WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with RcppArmadillo. If not, see . - -if (!requireNamespace("Matrix", quietly=TRUE)) exit_file("No Matrix package") - -suppressMessages(require(Matrix)) - -library(RcppArmadillo) - -Rcpp::sourceCpp("cpp/sparse.cpp") - -## setting up an example matrix -- using the fact that the as -## converter prefers sparse matrix objects create by the Matrix package -suppressMessages(require(Matrix)) -## cf http://people.sc.fsu.edu/~jburkardt/data/st/st.html -mtxt <- c("11 0 0 14 0 16", - " 0 22 0 0 25 26", - " 0 0 33 34 0 36", - "41 0 43 44 0 46") -M <- as.matrix(read.table(text=mtxt)) -dimnames(M) <- NULL -SM <- Matrix(M, sparse=TRUE) - -#test.as.sparse <- function() { -expect_equal(SM, asSpMat(SM))#, msg="as") - -#test.sparse.addition <- function() { -expect_equal(SM + SM, sparseAddition(SM))#, msg="addSparse") - -#test.sparse.multiplication <- function() { -k <- 3 -expect_equal(k*SM, sparseMultiplication(SM, k))#, msg="multSparse") - -#test.sparse.fromTriplet <- function() { -mtxt <- c("0 0 1", - "0 2 0", - "3 0 0") -M <- as.matrix(read.table(text=mtxt)) -dimnames(M) <- NULL -SM <- Matrix(M, sparse=TRUE) - -spM <- fromTriplet(0:2, # rows - 2:0, # cols - 1:3) # values -expect_equal(SM, spM)#, msg="fromTriplet") - -#test.sparse.transpose <- function() { -expect_equal(t(SM), sparseTranspose(SM))#, msg="transposeSparse") - -#test.sparse.sqrt <- function() { -expect_equal(sqrt(SM), sparseSqrt(SM))#, msg="sqrtSparse") - -#test.sparse.square <- function() { -expect_equal(SM^2, sparseSquare(SM))#, msg="squareSparse") - -if (utils::packageVersion("Matrix") < "1.4-2") exit_file("Remainder needs Matrix 1.4-2 or later") -#test.sparse.iterators <- function() { -SM <- matrix(0, 5, 5) -diag(SM) <- 1:5 -SM <- methods::as(methods::as(SM, "generalMatrix"), "CsparseMatrix") -spM <- sparseIterators(SM, -1.5) -diag(SM) <- diag(SM) - 1.5 -expect_equal(SM, spM)#, msg="sparseIterators") - -#test.sparse.list <- function() { -SM <- matrix(0, 5, 5) -diag(SM) <- 1:5 -SM <- methods::as(methods::as(SM, "generalMatrix"), "CsparseMatrix") -l <- list(SM, SM) -expect_equal(l, sparseList(l))#, msg="sparseList") - -#test.speye <- function() { -SM <- speye(4, 4) -SM2 <- sparseMatrix(i = c(1:4), j = c(1:4), x = 1) -expect_equal(SM, SM2)#, msg="speye") -SM <- speye(3, 5) -SM2 <- sparseMatrix(i = c(1:3), j = c(1:3), x = 1, dims = c(3, 5)) -expect_equal(SM, SM2)#, msg="speye") -SM <- speye(5, 3) -SM2 <- sparseMatrix(i = c(1:3), j = c(1:3), x = 1, dims = c(5, 3)) -expect_equal(SM, SM2)#, msg="speye") diff --git a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_sparseConversion.R b/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_sparseConversion.R deleted file mode 100644 index 2eb82f63a..000000000 --- a/Luminescence.BuildResults/Library/RcppArmadillo/tinytest/test_sparseConversion.R +++ /dev/null @@ -1,822 +0,0 @@ -#!/usr/bin/r -t -## -## Copyright (C) 2017 - 2022 Binxiang Ni and Dirk Eddelbuettel -## -## This file is part of RcppArmadillo. It is based on the documentation -## of package Matrix, slam, SparseM, spam and SciPy, which are -## respectively created by developers of the packages: Douglas Bates, -## Martin Maechler; Kurt Hornik, David Meyer, Christian Buchta; Roger -## Koenker, Pin Ng; Reinhard Furrer, Florian Gerber, Daniel Gerber, -## Kaspar Moesinger, Youcef Saad, Esmond G. Ng, Barry W. Peyton, Joseph -## W.H. Liu, Alan D. George; the developers of SciPy. It is also -## modified by Binxiang Ni. -## -## RcppArmadillo is free software: you can redistribute it and/or modify it -## under the terms of the GNU General Public License as published by -## the Free Software Foundation, either version 2 of the License, or -## (at your option) any later version. -## -## RcppArmadillo is distributed in the hope that it will be useful, but -## WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with RcppArmadillo. If not, see . - -## Reference: -## [Matrix]: https://cran.r-project.org/web/packages/Matrix/Matrix.pdf -## [slam]: https://cran.r-project.org/web/packages/slam/slam.pdf -## [SparseM]: https://cran.r-project.org/web/packages/SparseM/SparseM.pdf -## [spam]: https://cran.r-project.org/web/packages/spam/spam.pdf -## [SciPy]: https://docs.scipy.org/doc/scipy/reference/sparse.html - -if (!requireNamespace("Matrix", quietly=TRUE)) exit_file("No Matrix package") -if (utils::packageVersion("Matrix") < "1.4-2") exit_file("Need Matrix 1.4-2 or later") - -## It now (Nov 2020) appears to fail on Windows starting around line 115 -.onWindows <- .Platform$OS.type == "windows" - -library(RcppArmadillo) - -Rcpp::sourceCpp("cpp/sparse.cpp") - -## setting up an example matrix -- using the fact that the as -## converter prefers sparse matrix objects create by the Matrix package -suppressMessages({ - library(Matrix) - library(stats) - ## Per email with Martin Maechler, hard to suppress such messages on - ## first (and only) use of particular dispatches. So simply running - ## twice: once silent, and again to test and possibly fail visibly. - kronecker(Diagonal(3), Matrix(0+0:5, 3, 2)) - ## - n1 <- 10 - p <- 5 - a <- rnorm(n1*p) - a[abs(a)<0.5] <- 0 - A <- matrix(a,n1,p) - RA <- as(A, "RsparseMatrix") - - dgt <- RA %x% matrix(1:4,2,2) -}) - -#test.as.dgc2dgc <- function() { -## [Matrix] p10 (dgCMatrix) -set.seed(7) -m <- matrix(0, 5, 5) -m[sample(length(m), size = 14)] <- rep(1:9, length=14) -mm <- as(m, "CsparseMatrix") -expect_equal(mm, asSpMat(mm))#, msg="dgC2dgC_1") - -## [Matrix] p36 (dgCMatrix) -m <- Matrix(c(0,0,2:0), 3,5) -expect_equal(m, asSpMat(m))#, msg="dgC2dgC_2") - -## [Matrix] p74 (dgCMatrix) -set.seed(27) -IM1 <- as(sample(1:20, 100, replace=TRUE), "indMatrix") -set.seed(27) -IM2 <- as(sample(1:18, 100, replace=TRUE), "indMatrix") -c12 <- as(crossprod(IM1,IM2), "CsparseMatrix") -expect_equal(c12, asSpMat(c12))#, msg="dgC2dgC_3") - -## [Matrix] p87 (dgCMatrix) -m <- Matrix(c(0,0,2:0), 3,5, dimnames=list(LETTERS[1:3],NULL)) -m <- unname(m) -expect_equal(m, asSpMat(m))#, msg="dgC2dgC_4") - -## [Matrix] p118 (dgCMatrix) -f1 <- gl(5, 3, labels = LETTERS[1:5]) -X <- as(f1, "sparseMatrix") -X <- unname(X) -expect_equal(X, asSpMat(X))#, msg="dgC2dgC_5") - -## [Matrix] p142 (dgCMatrix) -i <- c(1,3:8); j <- c(2,9,6:10); x <- 7 * (1:7) -A <- sparseMatrix(i, j, x = x) -expect_equal(A, asSpMat(A))#, msg="dgC2dgC_6") - -## [slam] p4 (dgCMatrix) -x <- matrix(c(1, 0, 0, 2, 1, 0), nrow = 3) -SM <- Matrix(x, sparse = TRUE) -expect_equal(SM, asSpMat(SM))#, msg="dgC2dgC_7") - -## [slam] p9 (dgCMatrix) -x <- matrix(c(1, 0, 0, 2, 1, NA), nrow = 2) -SM <- Matrix(x, sparse = TRUE) -expect_equal(SM, asSpMat(SM))#, msg="dgC2dgC_8") - -if (.onWindows) exit_file("Skipping remainder on Windows") - -## [slam] p12 (dgCMatrix) -if (utils::packageVersion("Matrix") >= "1.3.0") { - x <- matrix(c(1, 0, 0, 2), nrow = 2) - SM <- Matrix(x, sparse = TRUE, doDiag=FALSE) - dgc <- as(SM, "generalMatrix") - expect_equal(dgc, asSpMat(SM))#, msg="dgC2dgC_9") -} - -## [SparseM] p21 (dgCMatrix) -set.seed(21) -a <- rnorm(20*5) -A <- matrix(a,20,5) -A[row(A)>col(A)+4|row(A)col(A)+2|row(A)= "1.3.0") { - set.seed(129) - T2 <- rsparsematrix(40, 12, nnz = 99, repr="T") - dgc <- as(T2, "CsparseMatrix") - expect_equal(dgc, asSpMat(T2))#, msg="dgT2dgC_8") -} - -## [Matrix] p152 (dgTMatrix) -A <- spMatrix(10,20, i = c(1,3:8), - j = c(2,9,6:10), - x = 7 * (1:7)) -dgc <- as(A, "CsparseMatrix") -expect_equal(dgc, asSpMat(A))#, msg="dgT2dgC_9") - -## [SparseM] p21 (dgTMatrix) -set.seed(21) -a <- rnorm(20*5) -A <- matrix(a,20,5) -A[row(A)>col(A)+4|row(A)col(A)+2|row(A) 1) -## checkException(asSpMat(lm)) - -## # [Matrix] p152 (lgTMatrix) -## L <- spMatrix(9, 30, i = rep(1:9, 3), 1:27, -## (1:27) %% 4 != 1) -## checkException(asSpMat(L)) - -## ## [Matrix] p111 (ngCMatrix) -## m <- Matrix(c(0,0,2:0), 3,5, dimnames=list(LETTERS[1:3],NULL)) -## dimnames(m) <- NULL -## nm <- as(m, "nsparseMatrix") -## checkException(asSpMat(nm)) - -## ## [Matrix] p74 (ngTMatrix) -## sm1 <- as(rep(c(2,3,1), e=3), "indMatrix") -## ngt <- as(sm1, "ngTMatrix") -## checkException(asSpMat(ngt)) - -## ## [Matrix] p85 (ntTMatrix) -## lM <- Diagonal(x = c(TRUE,FALSE,FALSE)) -## nM <- as(lM, "nMatrix") -## checkException(asSpMat(nM)) - -## ## [Matrix] p85 (nsCMatrix) -## nsc <- crossprod(nM) -## checkException(asSpMat(nsc)) - -## ## [Matrix] p42 (ldiMatrix) -## ldi <- Diagonal(x = (1:4) >= 2) -## checkException(asSpMat(ldi)) -## } - -## test.as.lgc2dgc <- function() { -## ## [Matrix] p87 (lgCMatrix) (To be continued) -## lm <- (m > 1) -## -## ## [Matrix] p111 (lgCMatrix) (To be continued) -## m <- Matrix(c(0,0,2:0), 3,5, dimnames=list(LETTERS[1:3],NULL)) -## dimnames(m) <- NULL -## nm <- as(m, "nsparseMatrix") -## nnm <- !nm # no longer sparse -## nnm <- as(nnm, "sparseMatrix") -## } -## -## test.as.lgt2dgc <- function() { -## ## [Matrix] p152 (lgTMatrix) (To be continued) -## L <- spMatrix(9, 30, i = rep(1:9, 3), 1:27, -## (1:27) %% 4 != 1) -## } -## -## test.as.ngc2dgc <- function() { -## ## [Matrix] p111 (ngCMatrix) (To be continued) -## m <- Matrix(c(0,0,2:0), 3,5, dimnames=list(LETTERS[1:3],NULL)) -## dimnames(m) <- NULL -## nm <- as(m, "nsparseMatrix") -## -## ## [Matrix] p129 (ngCMatrix) (To be continued) -## n7 <- rsparsematrix(5, 12, nnz = 10, rand.x = NULL) -## } -## -## test.as.ngt2dgc <- function() { -## # [Matrix] p74 (ngTMatrix) (To be continued) -## sm1 <- as(rep(c(2,3,1), e=3), "indMatrix") -## ngt <- as(sm1, "ngTMatrix") -## mtxt <- c("0 1 0", -## "0 1 0", -## "0 1 0", -## "0 0 1", -## "0 0 1", -## "0 0 1", -## "1 0 0", -## "1 0 0", -## "1 0 0") -## M <- as.matrix(read.table(text=mtxt)) -## dimnames(M) <- NULL -## dgc <- as(M, "dgCMatrix") -## expect_equal(dgc, asSpMat(ngt))#, msg="ngT2dgC") -## -## set.seed(27) -## s10 <- as(sample(10, 30, replace=TRUE),"indMatrix") -## ngt <- s10[1:7, 1:4] -## mtxt <- c("0 0 0 0", -## "1 0 0 0", -## "0 0 0 0", -## "0 0 0 1", -## "0 0 1 0", -## "0 0 0 0", -## "1 0 0 0") -## M <- as.matrix(read.table(text=mtxt)) -## dimnames(M) <- NULL -## dgc <- as(M, "dgCMatrix") -## expect_equal(dgc, asSpMat(ngt))#, msg="ngT2dgC") -## -## ## [Matrix] p116 (ngTMatrix) (To be continued) -## pm1 <- as(as.integer(c(2,3,1)), "pMatrix") -## as(pm1, "ngTMatrix") -## set.seed(11) -## p10 <- as(sample(10),"pMatrix") -## p10[1:7, 1:4] -## } -## -## test.as.ntt2dgc <- function() { -## ## [Matrix] p85 (ntTMatrix) (To be continued) -## lM <- Diagonal(x = c(TRUE,FALSE,FALSE)) -## nM <- as(lM, "nMatrix") -## expect_equal(dgc, asSpMat(nM))#, msg="ntT2dgC") -## } -## -## test.as.nsc2dgc <- function() { -## ## [Matrix] p85 (nsCMatrix) (To be continued) -## lM <- Diagonal(x = c(TRUE,FALSE,FALSE)) -## nM <- as(lM, "nMatrix") -## nsc <- crossprod(nM) -## expect_equal(dgc, asSpMat(nsc))#, msg="nsC2dgC") -## } -## -## test.as.ldi2dgc <- function() { -## ## [Matrix] p42 (ldiMatrix) (To be continued) -## Diagonal(x = (1:4) >= 2) -## -## ## [Matrix] p85 (ldiMatrix) (To be continued) -## lM <- Diagonal(x = c(TRUE,FALSE,FALSE)) -## } diff --git a/Luminescence.BuildResults/Luminescence-Ex.timings.0.9.24.WARNING b/Luminescence.BuildResults/Luminescence-Ex.timings.0.9.24.WARNING deleted file mode 100644 index e69de29bb..000000000 diff --git a/Luminescence.BuildResults/Luminescence-TimingExamples.0.9.25.pdf b/Luminescence.BuildResults/Luminescence-TimingExamples.0.9.25.pdf index b5895a4c4..ef4eb3a23 100644 Binary files a/Luminescence.BuildResults/Luminescence-TimingExamples.0.9.25.pdf and b/Luminescence.BuildResults/Luminescence-TimingExamples.0.9.25.pdf differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/DESCRIPTION b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/DESCRIPTION deleted file mode 100644 index 72f3c136b..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/DESCRIPTION +++ /dev/null @@ -1,137 +0,0 @@ -Package: Luminescence -Type: Package -Title: Comprehensive Luminescence Dating Data Analysis -Version: 0.9.25 -Date: 2024-09-12 -Authors@R: c( - person("Sebastian", "Kreutzer", role = c("aut", "trl", "cre", "dtc"), email = "maintainer_luminescence@r-luminescence.org", comment = c(ORCID = "0000-0002-0734-2199")), - person("Christoph", "Burow", role = c("aut", "trl", "dtc"), comment = c(ORCID = "0000-0002-5023-4046")), - person("Michael", "Dietze", role = c("aut"), comment = c(ORCID = "0000-0001-6063-1726")), - person("Margret C.", "Fuchs", role = c("aut"), comment = c(ORCID = "0000-0001-7210-1132")), - person("Christoph", "Schmidt", role = c("aut"), comment = c(ORCID = "0000-0002-2309-3209")), - person("Manfred", "Fischer", role = c("aut", "trl")), - person("Johannes", "Friedrich", role = c("aut"), comment = c(ORCID = "0000-0002-0805-9547")), - person("Norbert", "Mercier", role = c("aut"), comment = c(ORCID = "0000-0002-6375-9108")), - person("Rachel K.", "Smedley", role = c("ctb"), comment = c(ORCID = "0000-0001-7773-5193")), - person("Claire", "Christophe", role = c("ctb")), - person("Antoine", "Zink", role = c("ctb"), comment = c(ORCID = "0000-0001-7146-1101")), - person("Julie", "Durcan", role = c("ctb"), comment = c(ORCID = "0000-0001-8724-8022")), - person("Georgina E.", "King", role = c("ctb", "dtc"), comment = c(ORCID = "0000-0003-1059-8192")), - person("Anne", "Philippe", role = c("aut"), comment = c(ORCID = "0000-0002-5331-5087")), - person("Guillaume", "Guerin", role = c("ctb"), comment = c(ORCID = "0000-0001-6298-5579")), - person("Svenja", "Riedesel", role = c("aut"), comment = c(ORCID = "0000-0003-2936-8776")), - person("Martin", "Autzen", role = c("aut"), comment = c(ORCID = "0000-0001-6249-426X")), - person("Pierre", "Guibert", role = c("ctb"), comment = c(ORCID = "0000-0001-8969-8684")), - person("Dirk", "Mittelstrass", role = c("aut"), comment = c(ORCID = "0000-0002-9567-8791")), - person("Harrison J.", "Gray", role = c("aut"), comment = c(ORCID = "0000-0002-4555-7473")), - person("Jean-Michel", "Galharret", role = c("aut"), comment = c(ORCID = "0000-0003-2219-8727")), - person("Marco", "Colombo", role = c("aut"), comment = c(ORCID = "0000-0001-6672-0623")), - person("Markus", "Fuchs", role = c("ths"), comment = c(ORCID = "0000-0003-4669-6528"))) -Maintainer: Sebastian Kreutzer -Description: A collection of various R functions for the purpose of Luminescence - dating data analysis. This includes, amongst others, data import, export, - application of age models, curve deconvolution, sequence analysis and - plotting of equivalent dose distributions. -Contact: Package Developers -License: GPL-3 -URL: https://r-lum.github.io/Luminescence/ -BugReports: https://github.com/R-Lum/Luminescence/issues -Depends: R (>= 4.3), utils -LinkingTo: Rcpp (>= 1.0.12), RcppArmadillo (>= 0.12.8.4.0) -Imports: bbmle (>= 1.0.25.1), data.table (>= 1.15.4), DEoptim (>= - 2.2-8), httr (>= 1.4.7), interp (>= 1.1-6), lamW (>= 2.2.3), - matrixStats (>= 1.3.0), methods, minpack.lm (>= 1.2-4), mclust - (>= 6.1), readxl (>= 1.4.3), Rcpp (>= 1.0.12), shape (>= - 1.4.6), parallel, XML (>= 3.99-0.16), zoo (>= 1.8-12) -Suggests: spelling (>= 2.3.0), plotly (>= 4.10.4), rmarkdown (>= 2.27), - rstudioapi (>= 0.16.0), rjags (>= 4-15), coda (>= 0.19-4), - pander (>= 0.6.5), testthat (>= 3.2.1), tiff (>= 0.1-12), - devtools (>= 2.4.5), R.rsp (>= 0.46.0) -VignetteBuilder: R.rsp -Encoding: UTF-8 -Language: en-US -Collate: 'Analyse_SAR.OSLdata.R' 'CW2pHMi.R' 'CW2pLM.R' 'CW2pLMi.R' - 'CW2pPMi.R' 'Luminescence-package.R' 'PSL2Risoe.BINfileData.R' - 'RcppExports.R' 'replicate_RLum.R' 'RLum-class.R' - 'smooth_RLum.R' 'names_RLum.R' 'structure_RLum.R' - 'length_RLum.R' 'set_RLum.R' 'get_RLum.R' - 'RLum.Analysis-class.R' 'RLum.Data-class.R' 'bin_RLum.Data.R' - 'RLum.Data.Curve-class.R' 'RLum.Data.Image-class.R' - 'RLum.Data.Spectrum-class.R' 'RLum.Results-class.R' - 'set_Risoe.BINfileData.R' 'get_Risoe.BINfileData.R' - 'Risoe.BINfileData-class.R' 'Risoe.BINfileData2RLum.Analysis.R' - 'Risoe.BINfileData2RLum.Data.Curve.R' 'Second2Gray.R' - 'addins_RLum.R' 'analyse_Al2O3C_CrossTalk.R' - 'analyse_Al2O3C_ITC.R' 'analyse_Al2O3C_Measurement.R' - 'analyse_FadingMeasurement.R' 'analyse_IRSAR.RF.R' - 'analyse_SAR.CWOSL.R' 'analyse_SAR.TL.R' 'analyse_baSAR.R' - 'analyse_pIRIRSequence.R' 'analyse_portableOSL.R' - 'apply_CosmicRayRemoval.R' 'apply_EfficiencyCorrection.R' - 'calc_AliquotSize.R' 'calc_AverageDose.R' 'calc_CentralDose.R' - 'calc_CobbleDoseRate.R' 'calc_CommonDose.R' - 'calc_CosmicDoseRate.R' 'calc_FadingCorr.R' 'calc_FastRatio.R' - 'calc_FiniteMixture.R' 'calc_FuchsLang2001.R' - 'calc_HomogeneityTest.R' 'calc_Huntley2006.R' 'calc_IEU.R' - 'calc_Kars2008.R' 'calc_Lamothe2003.R' 'calc_MaxDose.R' - 'calc_MinDose.R' 'calc_OSLLxTxDecomposed.R' - 'calc_OSLLxTxRatio.R' 'calc_SourceDoseRate.R' - 'calc_Statistics.R' 'calc_TLLxTxRatio.R' - 'calc_ThermalLifetime.R' 'calc_WodaFuchs2008.R' 'calc_gSGC.R' - 'calc_gSGC_feldspar.R' 'combine_De_Dr.R' - 'convert_Activity2Concentration.R' 'convert_BIN2CSV.R' - 'convert_Concentration2DoseRate.R' 'convert_Daybreak2CSV.R' - 'convert_PSL2CSV.R' 'convert_RLum2Risoe.BINfileData.R' - 'convert_SG2MG.R' 'convert_Wavelength2Energy.R' - 'convert_XSYG2CSV.R' 'extract_IrradiationTimes.R' - 'extract_ROI.R' 'fit_CWCurve.R' 'fit_EmissionSpectra.R' - 'fit_LMCurve.R' 'fit_OSLLifeTimes.R' 'fit_SurfaceExposure.R' - 'fit_ThermalQuenching.R' 'get_Layout.R' 'get_Quote.R' - 'get_rightAnswer.R' 'github.R' 'import_Data.R' - 'install_DevelopmentVersion.R' 'internal_as.latex.table.R' - 'internals_RLum.R' 'internals_Thermochronometry.R' - 'merge_RLum.Analysis.R' 'merge_RLum.Data.Curve.R' - 'merge_RLum.R' 'merge_RLum.Results.R' - 'merge_Risoe.BINfileData.R' 'methods_DRAC.R' 'methods_RLum.R' - 'plot_AbanicoPlot.R' 'plot_DRCSummary.R' 'plot_DRTResults.R' - 'plot_DetPlot.R' 'plot_FilterCombinations.R' - 'plot_GrowthCurve.R' 'plot_Histogram.R' 'plot_KDE.R' - 'plot_NRt.R' 'plot_OSLAgeSummary.R' 'plot_RLum.Analysis.R' - 'plot_RLum.Data.Curve.R' 'plot_RLum.Data.Image.R' - 'plot_RLum.Data.Spectrum.R' 'plot_RLum.R' 'plot_RLum.Results.R' - 'plot_ROI.R' 'plot_RadialPlot.R' 'plot_Risoe.BINfileData.R' - 'plot_ViolinPlot.R' 'read_BIN2R.R' 'read_Daybreak2R.R' - 'read_HeliosOSL2R.R' 'read_PSL2R.R' 'read_RF2R.R' - 'read_SPE2R.R' 'read_TIFF2R.R' 'read_XSYG2R.R' 'report_RLum.R' - 'scale_GammaDose.R' 'subset_SingleGrainData.R' - 'template_DRAC.R' 'trim_RLum.Data.R' 'tune_Data.R' 'use_DRAC.R' - 'utils_DRAC.R' 'verify_SingleGrainData.R' 'write_R2BIN.R' - 'write_R2TIFF.R' 'write_RLum2CSV.R' 'zzz.R' -RoxygenNote: 7.3.2 -Config/testthat/edition: 3 -NeedsCompilation: yes -Packaged: 2024-09-12 11:13:47 UTC; kreutzer -Author: Sebastian Kreutzer [aut, trl, cre, dtc] - (), - Christoph Burow [aut, trl, dtc] - (), - Michael Dietze [aut] (), - Margret C. Fuchs [aut] (), - Christoph Schmidt [aut] (), - Manfred Fischer [aut, trl], - Johannes Friedrich [aut] (), - Norbert Mercier [aut] (), - Rachel K. Smedley [ctb] (), - Claire Christophe [ctb], - Antoine Zink [ctb] (), - Julie Durcan [ctb] (), - Georgina E. King [ctb, dtc] (), - Anne Philippe [aut] (), - Guillaume Guerin [ctb] (), - Svenja Riedesel [aut] (), - Martin Autzen [aut] (), - Pierre Guibert [ctb] (), - Dirk Mittelstrass [aut] (), - Harrison J. Gray [aut] (), - Jean-Michel Galharret [aut] (), - Marco Colombo [aut] (), - Markus Fuchs [ths] () diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/NAMESPACE b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/NAMESPACE deleted file mode 100644 index caad06f11..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/NAMESPACE +++ /dev/null @@ -1,307 +0,0 @@ -# Generated by roxygen2: do not edit by hand - -S3method("$",RLum.Analysis) -S3method("$",RLum.Data.Curve) -S3method("$",RLum.Results) -S3method("$<-",DRAC.list) -S3method("*",RLum.Data.Curve) -S3method("+",RLum.Data.Curve) -S3method("-",RLum.Data.Curve) -S3method("/",RLum.Data.Curve) -S3method("[",RLum.Analysis) -S3method("[",RLum.Data.Curve) -S3method("[",RLum.Data.Image) -S3method("[",RLum.Data.Spectrum) -S3method("[",RLum.Results) -S3method("[<-",DRAC.list) -S3method("[<-",RLum.Data.Curve) -S3method("[[",RLum.Analysis) -S3method("[[",RLum.Results) -S3method("[[<-",DRAC.list) -S3method(as.data.frame,DRAC.list) -S3method(as.data.frame,RLum.Data.Curve) -S3method(as.data.frame,RLum.Data.Spectrum) -S3method(as.data.frame,Risoe.BINfileData) -S3method(as.list,RLum.Analysis) -S3method(as.list,RLum.Data.Curve) -S3method(as.list,RLum.Data.Image) -S3method(as.list,RLum.Results) -S3method(as.matrix,RLum.Data.Curve) -S3method(as.matrix,RLum.Data.Image) -S3method(as.matrix,RLum.Data.Spectrum) -S3method(bin,RLum.Data.Curve) -S3method(bin,RLum.Data.Spectrum) -S3method(dim,RLum.Data.Curve) -S3method(dim,RLum.Data.Spectrum) -S3method(hist,RLum.Analysis) -S3method(hist,RLum.Data.Curve) -S3method(hist,RLum.Data.Image) -S3method(hist,RLum.Results) -S3method(length,RLum.Analysis) -S3method(length,RLum.Data.Curve) -S3method(length,RLum.Results) -S3method(length,Risoe.BINfileData) -S3method(merge,RLum) -S3method(names,RLum.Analysis) -S3method(names,RLum.Data.Curve) -S3method(names,RLum.Data.Image) -S3method(names,RLum.Data.Spectrum) -S3method(names,RLum.Results) -S3method(names,Risoe.BINfileData) -S3method(plot,RLum.Analysis) -S3method(plot,RLum.Data.Curve) -S3method(plot,RLum.Data.Image) -S3method(plot,RLum.Data.Spectrum) -S3method(plot,RLum.Results) -S3method(plot,Risoe.BINfileData) -S3method(plot,list) -S3method(print,DRAC.highlights) -S3method(print,DRAC.list) -S3method(rep,RLum) -S3method(row.names,RLum.Data.Spectrum) -S3method(subset,RLum.Analysis) -S3method(subset,Risoe.BINfileData) -S3method(summary,RLum.Analysis) -S3method(summary,RLum.Data.Curve) -S3method(summary,RLum.Data.Image) -S3method(summary,RLum.Results) -S3method(unlist,RLum.Analysis) -export(Analyse_SAR.OSLdata) -export(CW2pHMi) -export(CW2pLM) -export(CW2pLMi) -export(CW2pPMi) -export(PSL2Risoe.BINfileData) -export(Risoe.BINfileData2RLum.Analysis) -export(Second2Gray) -export(analyse_Al2O3C_CrossTalk) -export(analyse_Al2O3C_ITC) -export(analyse_Al2O3C_Measurement) -export(analyse_FadingMeasurement) -export(analyse_IRSAR.RF) -export(analyse_SAR.CWOSL) -export(analyse_SAR.TL) -export(analyse_baSAR) -export(analyse_pIRIRSequence) -export(analyse_portableOSL) -export(apply_CosmicRayRemoval) -export(apply_EfficiencyCorrection) -export(bin) -export(bin_RLum.Data) -export(calc_AliquotSize) -export(calc_AverageDose) -export(calc_CentralDose) -export(calc_CobbleDoseRate) -export(calc_CommonDose) -export(calc_CosmicDoseRate) -export(calc_FadingCorr) -export(calc_FastRatio) -export(calc_FiniteMixture) -export(calc_FuchsLang2001) -export(calc_HomogeneityTest) -export(calc_Huntley2006) -export(calc_IEU) -export(calc_Kars2008) -export(calc_Lamothe2003) -export(calc_MaxDose) -export(calc_MinDose) -export(calc_OSLLxTxDecomposed) -export(calc_OSLLxTxRatio) -export(calc_SourceDoseRate) -export(calc_Statistics) -export(calc_TLLxTxRatio) -export(calc_ThermalLifetime) -export(calc_WodaFuchs2008) -export(calc_gSGC) -export(calc_gSGC_feldspar) -export(combine_De_Dr) -export(convert_Activity2Concentration) -export(convert_BIN2CSV) -export(convert_Concentration2DoseRate) -export(convert_Daybreak2CSV) -export(convert_PSL2CSV) -export(convert_RLum2Risoe.BINfileData) -export(convert_SG2MG) -export(convert_Wavelength2Energy) -export(convert_XSYG2CSV) -export(extract_IrradiationTimes) -export(extract_ROI) -export(fit_CWCurve) -export(fit_EmissionSpectra) -export(fit_LMCurve) -export(fit_OSLLifeTimes) -export(fit_SurfaceExposure) -export(fit_ThermalQuenching) -export(get_Layout) -export(get_Quote) -export(get_RLum) -export(get_Risoe.BINfileData) -export(get_rightAnswer) -export(github_branches) -export(github_commits) -export(github_issues) -export(import_Data) -export(install_DevelopmentVersion) -export(is.RLum) -export(is.RLum.Analysis) -export(is.RLum.Data) -export(is.RLum.Data.Curve) -export(is.RLum.Data.Image) -export(is.RLum.Data.Spectrum) -export(is.RLum.Results) -export(length_RLum) -export(merge_RLum) -export(merge_RLum.Analysis) -export(merge_RLum.Data.Curve) -export(merge_RLum.Results) -export(merge_Risoe.BINfileData) -export(names_RLum) -export(plot_AbanicoPlot) -export(plot_DRCSummary) -export(plot_DRTResults) -export(plot_DetPlot) -export(plot_FilterCombinations) -export(plot_GrowthCurve) -export(plot_Histogram) -export(plot_KDE) -export(plot_NRt) -export(plot_OSLAgeSummary) -export(plot_RLum) -export(plot_RLum.Analysis) -export(plot_RLum.Data.Curve) -export(plot_RLum.Data.Image) -export(plot_RLum.Data.Spectrum) -export(plot_RLum.Results) -export(plot_ROI) -export(plot_RadialPlot) -export(plot_Risoe.BINfileData) -export(plot_ViolinPlot) -export(read_BIN2R) -export(read_Daybreak2R) -export(read_HeliosOSL2R) -export(read_PSL2R) -export(read_RF2R) -export(read_SPE2R) -export(read_TIFF2R) -export(read_XSYG2R) -export(replicate_RLum) -export(report_RLum) -export(sTeve) -export(scale_GammaDose) -export(set_RLum) -export(set_Risoe.BINfileData) -export(smooth_RLum) -export(structure_RLum) -export(subset_SingleGrainData) -export(template_DRAC) -export(trim_RLum.Data) -export(tune_Data) -export(use_DRAC) -export(verify_SingleGrainData) -export(write_R2BIN) -export(write_R2TIFF) -export(write_RLum2CSV) -exportClasses(RLum) -exportClasses(RLum.Analysis) -exportClasses(RLum.Data) -exportClasses(RLum.Data.Curve) -exportClasses(RLum.Data.Image) -exportClasses(RLum.Data.Spectrum) -exportClasses(RLum.Results) -exportClasses(Risoe.BINfileData) -exportMethods(bin_RLum.Data) -exportMethods(get_RLum) -exportMethods(get_Risoe.BINfileData) -exportMethods(length_RLum) -exportMethods(names_RLum) -exportMethods(replicate_RLum) -exportMethods(set_RLum) -exportMethods(set_Risoe.BINfileData) -exportMethods(show) -exportMethods(smooth_RLum) -exportMethods(structure_RLum) -import(data.table) -import(methods) -import(utils) -importFrom(Rcpp,evalCpp) -importFrom(grDevices,adjustcolor) -importFrom(grDevices,axisTicks) -importFrom(grDevices,colorRampPalette) -importFrom(grDevices,dev.off) -importFrom(grDevices,gray.colors) -importFrom(grDevices,rgb) -importFrom(grDevices,topo.colors) -importFrom(grDevices,xy.coords) -importFrom(graphics,abline) -importFrom(graphics,arrows) -importFrom(graphics,axTicks) -importFrom(graphics,axis) -importFrom(graphics,barplot) -importFrom(graphics,box) -importFrom(graphics,boxplot) -importFrom(graphics,close.screen) -importFrom(graphics,contour) -importFrom(graphics,curve) -importFrom(graphics,frame) -importFrom(graphics,grconvertX) -importFrom(graphics,grconvertY) -importFrom(graphics,grid) -importFrom(graphics,hist) -importFrom(graphics,layout) -importFrom(graphics,legend) -importFrom(graphics,lines) -importFrom(graphics,mtext) -importFrom(graphics,par) -importFrom(graphics,persp) -importFrom(graphics,plot) -importFrom(graphics,plot.default) -importFrom(graphics,points) -importFrom(graphics,polygon) -importFrom(graphics,rug) -importFrom(graphics,screen) -importFrom(graphics,segments) -importFrom(graphics,split.screen) -importFrom(graphics,text) -importFrom(graphics,title) -importFrom(httr,GET) -importFrom(httr,accept_json) -importFrom(httr,content) -importFrom(httr,status_code) -importFrom(parallel,makeCluster) -importFrom(parallel,parLapply) -importFrom(parallel,stopCluster) -importFrom(stats,approx) -importFrom(stats,as.formula) -importFrom(stats,coef) -importFrom(stats,complete.cases) -importFrom(stats,confint) -importFrom(stats,density) -importFrom(stats,dnorm) -importFrom(stats,fitted) -importFrom(stats,formula) -importFrom(stats,glm) -importFrom(stats,lm) -importFrom(stats,median) -importFrom(stats,na.exclude) -importFrom(stats,na.omit) -importFrom(stats,nls) -importFrom(stats,nls.control) -importFrom(stats,pchisq) -importFrom(stats,pnorm) -importFrom(stats,predict) -importFrom(stats,qf) -importFrom(stats,quantile) -importFrom(stats,residuals) -importFrom(stats,rnorm) -importFrom(stats,runif) -importFrom(stats,sd) -importFrom(stats,setNames) -importFrom(stats,smooth) -importFrom(stats,smooth.spline) -importFrom(stats,spline) -importFrom(stats,t.test) -importFrom(stats,uniroot) -importFrom(stats,update) -importFrom(stats,var) -importFrom(stats,weighted.mean) -useDynLib(Luminescence, .registration = TRUE) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/NEWS.md b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/NEWS.md deleted file mode 100644 index 6c15c363f..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/NEWS.md +++ /dev/null @@ -1,190 +0,0 @@ - - - - - - - -# Changes in version 0.9.25 (2024-09-12) - -**This package version requires R \>= 4.3** - -## New functions - -- `read_HeliosOSL2R()`: New import function to support the new zero rad - Helios luminescence reader and its `.osl` file format. The output is - an `RLum.Analysis-class` object. - -## Bugfixes - -### `analyse_baSAR()` - -- Fix \#183 addressing an edge-case crash when the function was called - on an object containing no records of the appropriate type (#184, - @mcol). - -### `analyse_FadingMeasurements()` - -- Add `...` support to disable the blue trend line via - `plot.trend = FALSE` -- Fix \#175 to deal gracefully with the case when the size of Lx and Tx - doesn’t match (#192, @mcol). - -### `analyse_portableOSL()` - -- Function did not respect argument `main`; fixed. - -### `convert_Wavelength2Energy()` - -- Fix \#133 addressing cases where R throws an uncontained error when R - drops the object structure in very rare cases (#134; thanks @mcol) - -### `calc_Huntley2006()` - -- Improve success rate of GOK fitting of the unfaded data using a two - step approach: first an exponential fit is applied then this values - are used as start parameters. - -### `calc_Statistics()` - -- The skewness and kurtosis depended on number of MC samples (#122); - fixed with \#123 (thanks to @mcol) - -### `calc_TLLxTxRatio()` - -- Function crashed for `Tx.data.background = NULL` (#129); fixed with - \#130 thanks to @mcol - -### `calc_WodaFuchs2008()` - -- The function now officially supports numeric vectors and single-column - data frames as input (#200). -- The function computed the number of breaks for the histogram - incorrectly (#197, fixed with \#198). -- The function now supports more types of `RLum.Results` objects without - crashing, although if the object contains only one data point it will - stop immediately to avoid problems with `nls()` (#199, fixed in - \#219). - -### `extract_IrradiationTimes()` - -- If a BIN/BINX-file is provided, the function will now check that it - contains the same amount of data as the corresponding XSYG file a bit - earlier than before, thus avoiding a possible crash (#228, fixed in - \#229). - -### `fit_CWCurve()` - -- Argument `output.path` has been removed, and a warning is raised when - attempting to use it (#207, fixed in \#209). - -### `fit_EmissionSpectra()` - -- Parameter `input_scale` was not correctly propagated when the function - would self-call (#160, @mcol). - -### `fit_OSLLifeTimes()` - -- The validation of the minimum dataset size didn’t account for the use - of the `signal.range` argument (#182, fixed by \#195, @mcol). - -### `fit_SurfaceExposure()` - -- Fix \#162 to remove a dimension mismatch if the input data contained - `NA`s, which would generate unexpected warnings (#163, @mcol). -- The function doesn’t stop anymore with an error if called on an - `RLum.Results` object (#165, @mcol). - -### `plot_AbanicoPlot()` - -- Argument `plot.ratio` will now throw an error on non-positive - numerical values (#221, fixed in \#222). -- The function doesn’t crash anymore when setting `interactive = TRUE` - (#220, fixed in \#233). - -### `plot_DetPlot()` - -- Argument `signal.integral.max` is now enforced to be greater than - `signal.integral.min`, as otherwise the computation of the number of - channels would produce `Inf` (#203, fixed in \#206). -- Fix a crash when using option - `analyse_function = "analyse_pIRIRSequence"` (#210, fixed in \#211). - -### `plot_GrowthCurve()` - -- The function now calculates the relative saturation (`n/N`) using the - ratio of the two integrates. The value is part of the output table. -- Argument `na.rm` has been removed: as of version 0.9.23, it was - defunct and only accepted `TRUE` as valid value and produced an error - otherwise, so there is no effective change in behaviour (#137, fixed - in \#214). - -### `plot_Histogram()` - -- The function doesn’t crash anymore when setting `interactive = TRUE` - (#186, fixed in \#231). - -### `plot_KDE()` - -- It now officially supports numeric vectors and single-column data - frames, for which it assumes that the De error at each measurement is - 10^-9 (#189, fixed in \#194, @mcol). - -### `plot_NRt()` - -- The function reports an helpful message rather than crashing when - applied to an object of unexpected type or when there is a mismatch in - time values (#177, fixed with \#179 by @mcol). - -### `plot_RadialPlot()` - -- The function doesn’t crash anymore when a single-column data frame is - provided (#191, fixed in \#212). - -### `plot_RLum.Data.Analysis()` - -- The function now supports all arguments from - `plot_RLum.Data.Spectrum()`; before it had only basic functionality - for `RLum.Data.Spectrum-class` data. - -### `plot_RLum.Data.Spectrum()` - -- The plot function can now handle non-increasing column values for - plotting (with a warning). - -### `read_BIN2R()` - -- `ignore.RECTYPE` now supports numeric values, e.g., 128. Records for - this type will be ignored during import. -- BINX-files with `RECTYPE = 128` will not crash anymore, thanks for - asking Anna-Maartje Boer and replying Karsten Bracht. -- The function now stops graciously when attempting to read an empty - file (#225, fixed in \#226). - -### `read_PSL2R()` - -- The function is out of the beta status, hence the flag was removed. -- The `RLum.Analysis-class` object returned by the function gained a new - element `Sequence`, which is a data frame. with the measured sequence. - This way, if the original sequence was lost, it can still be extracted - from the `.psl` data. -- If no `.psl` file was found the function got trapped in an infinite - loop (#127); fixed with \#128 (thanks to @mcol) - -### `read_XSYG2R()` - -- Fix spectrometer data import for basically broken files. - -### `read_Daybreak2R()` - -- Fix \#135 to improve detection of non-ASCII files (#140, @mcol). - -### `Risoe.BINfileData2RLum.Analysis()` - -- Fix a crash when reading an empty Risoe.BINfileData input (#215, fixed - in \#224). - -## Internals - -- New internal function + tests added `.get_named_list_element()`. It - just does what the names says. diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/Analyse_SAR.OSLdata.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/Analyse_SAR.OSLdata.R deleted file mode 100644 index 74fb65950..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/Analyse_SAR.OSLdata.R +++ /dev/null @@ -1,657 +0,0 @@ -#' Analyse SAR CW-OSL measurements. -#' -#' The function analyses SAR CW-OSL curve data and provides a summary of the -#' measured data for every position. The output of the function is optimised -#' for SAR OSL measurements on quartz. -#' -#' The function works only for standard SAR protocol measurements introduced by -#' Murray and Wintle (2000) with CW-OSL curves. For the calculation of the -#' Lx/Tx value the function [calc_OSLLxTxRatio] is used. -#' -#' **Provided rejection criteria** -#' -#' `[recyling ratio]`: calculated for every repeated regeneration dose point. -#' -#' `[recuperation]`: recuperation rate calculated by comparing the `Lx/Tx` values of the zero -#' regeneration point with the `Ln/Tn` value (the `Lx/Tx` ratio of the natural -#' signal). For methodological background see Aitken and Smith (1988) -#' -#' `[IRSL/BOSL]`: the integrated counts (`signal.integral`) of an -#' IRSL curve are compared to the integrated counts of the first regenerated -#' dose point. It is assumed that IRSL curves got the same dose as the first -#' regenerated dose point. **Note:** This is not the IR depletion ratio -#' described by Duller (2003). -#' -#' @param input.data [Risoe.BINfileData-class] (**required**): -#' input data from a Risø BIN file, produced by the function [read_BIN2R]. -#' -#' @param signal.integral [vector] (**required**): -#' channels used for the signal integral, e.g. `signal.integral=c(1:2)` -#' -#' @param background.integral [vector] (**required**): -#' channels used for the background integral, e.g. `background.integral=c(85:100)` -#' -#' @param position [vector] (*optional*): -#' reader positions that want to be analysed (e.g. `position=c(1:48)`. -#' Empty positions are automatically omitted. If no value is given all -#' positions are analysed by default. -#' -#' @param run [vector] (*optional*): -#' range of runs used for the analysis. If no value is given the range of the -#' runs in the sequence is deduced from the `Risoe.BINfileData` object. -#' -#' @param set [vector] (*optional*): -#' range of sets used for the analysis. If no value is given the range of the -#' sets in the sequence is deduced from the `Risoe.BINfileData` object. -#' -#' @param dtype [character] (*optional*): -#' allows to further limit the curves by their data type (`DTYPE`), -#' e.g., `dtype = c("Natural", "Dose")` limits the curves to this two data types. -#' By default all values are allowed. -#' See [Risoe.BINfileData-class] for allowed data types. -#' -#' @param keep.SEL [logical] (default): -#' option allowing to use the `SEL` element of the [Risoe.BINfileData-class] manually. -#' **NOTE:** In this case any limitation provided by `run`, `set` and `dtype` -#' are ignored! -#' -#' @param info.measurement [character] (*with default*): -#' option to provide information about the measurement on the plot -#' output (e.g. name of the BIN or BINX file). -#' -#' @param output.plot [logical] (*with default*): -#' plot output (`TRUE/FALSE`) -#' -#' @param output.plot.single [logical] (*with default*): -#' single plot output (`TRUE/FALSE`) to allow for plotting the results in -#' single plot windows. Requires `output.plot = TRUE`. -#' -#' @param cex.global [numeric] (*with default*): -#' global scaling factor. -#' -#' @param ... further arguments that will be passed to the function -#' [calc_OSLLxTxRatio] (supported: `background.count.distribution`, `sigmab`, -#' `sig0`; e.g., for instrumental error) and can be used to adjust the plot. -#' Supported" `mtext`, `log` -#' -#' @return -#' A plot (*optional*) and [list] is returned containing the -#' following elements: -#' -#' \item{LnLxTnTx}{[data.frame] of all calculated Lx/Tx values including signal, background counts and the dose points.} -#' \item{RejectionCriteria}{[data.frame] with values that might by used as rejection criteria. NA is produced if no R0 dose point exists.} -#' \item{SARParameters}{[data.frame] of additional measurement parameters obtained from the BIN file, e.g. preheat or read temperature -#' (not valid for all types of measurements).} -#' -#' -#' @note -#' Rejection criteria are calculated but not considered during the -#' analysis to discard values. -#' -#' **The analysis of IRSL data is not directly supported**. You may want to -#' consider using the functions [analyse_SAR.CWOSL] or -#' [analyse_pIRIRSequence] instead. -#' -#' **The development of this function will not be continued. We recommend to use the function [analyse_SAR.CWOSL] or instead.** -#' -#' -#' @section Function version: 0.2.17 -#' -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -#' Margret C. Fuchs, HZDR, Freiberg (Germany) -#' -#' @seealso [calc_OSLLxTxRatio], [Risoe.BINfileData-class], [read_BIN2R], [plot_GrowthCurve] -#' -#' @references -#' Aitken, M.J. and Smith, B.W., 1988. Optical dating: recuperation -#' after bleaching. Quaternary Science Reviews 7, 387-393. -#' -#' Duller, G., 2003. Distinguishing quartz and feldspar in single grain -#' luminescence measurements. Radiation Measurements, 37 (2), 161-165. -#' -#' Murray, A.S. and Wintle, A.G., 2000. Luminescence dating of quartz using an -#' improved single-aliquot regenerative-dose protocol. Radiation Measurements -#' 32, 57-73. -#' -#' @keywords datagen dplot -#' -#' @examples -#' ##load data -#' data(ExampleData.BINfileData, envir = environment()) -#' -#' ##analyse data -#' output <- Analyse_SAR.OSLdata(input.data = CWOSL.SAR.Data, -#' signal.integral = c(1:5), -#' background.integral = c(900:1000), -#' position = c(1:1), -#' output.plot = TRUE) -#' -#' ##combine results relevant for further analysis -#' output.SAR <- data.frame(Dose = output$LnLxTnTx[[1]]$Dose, -#' LxTx = output$LnLxTnTx[[1]]$LxTx, -#' LxTx.Error = output$LnLxTnTx[[1]]$LxTx.Error) -#' output.SAR -#' -#' @md -#' @export -Analyse_SAR.OSLdata <- function( - input.data, - signal.integral, - background.integral, - position, - run, - set, - dtype, - keep.SEL = FALSE, - info.measurement = "unknown measurement", - output.plot = FALSE, - output.plot.single = FALSE, - cex.global = 1, - ... -){ - - ##============================================================================## - ##CONFIG - ##============================================================================## - - ##set colors gallery to provide more colors - - col <- get("col", pos = .LuminescenceEnv) - - ##============================================================================## - ##ERROR HANDLING - ##============================================================================## - - if(missing(input.data)==TRUE){stop("[Analyse_SAR.OSLdata] No input data given!") - }else{sample.data<-input.data} - - if(missing(signal.integral)==TRUE){stop("[Analyse_SAR.OSLdata] No signal integral is given!")} - if(missing(background.integral)==TRUE){stop("[Analyse_SAR.OSLdata] No background integral is given!")} - - ##set values for run and set if they are not defined by the user - if(missing(position)==TRUE){position<-min(sample.data@METADATA[,"POSITION"]):max(sample.data@METADATA[,"POSITION"])} - - if(missing(run)==TRUE){run<-min(sample.data@METADATA[,"RUN"]):max(sample.data@METADATA[,"RUN"])} - - if(missing(set)==TRUE){set<-min(sample.data@METADATA[,"SET"]):max(sample.data@METADATA[,"SET"])} - - if(missing(dtype)){dtype <- c("Natural", - "N+dose", - "Bleach", - "Bleach+dose", - "Natural (Bleach)", - "N+dose (Bleach)", - "Dose", - "Background")} - - - # Deal with extra arguments ---------------------------------------------------- - - ##deal with addition arguments - extraArgs <- list(...) - - background.count.distribution <- - if ("background.count.distribution" %in% names(extraArgs)) { - extraArgs$background.count.distribution - } else - { - "non-poisson" - } - - sigmab <- if("sigmab" %in% names(extraArgs)) {extraArgs$sigmab} else - {NULL} - - ##============================================================================## - ##CALCULATIONS - ##============================================================================## - - - ##loop over all positions - for (i in position){ - - ##checking if position is valid - if(length(which(sample.data@METADATA["POSITION"]==i))>0){ - - ##check if OSL curves are part of the data set - if(nrow(sample.data@METADATA[sample.data@METADATA[,"LTYPE"]=="OSL",]) == 0){ - - stop("[Analyse_SAR.OSLdata()] No 'OSL' curves found!") - - } - - if(!keep.SEL){ - ##select all OSL data depending on the run and set - sample.data@METADATA[,"SEL"]<-FALSE - sample.data@METADATA[sample.data@METADATA[,"LTYPE"]=="OSL" & - sample.data@METADATA[,"RUN"]%in%run==TRUE & - sample.data@METADATA[,"SET"]%in%set==TRUE & - sample.data@METADATA[,"DTYPE"]%in%dtype==TRUE, "SEL"] <- TRUE - } - - ##grep all OSL curve IDs - OSL.curveID<-sample.data@METADATA[sample.data@METADATA["SEL"]==TRUE & - sample.data@METADATA["POSITION"]==i,"ID"] - - ##estimate LnLx.curveID and TnTx.curveID from records - LnLx.curveID<-OSL.curveID[seq(1,length(OSL.curveID),by=2)] - TnTx.curveID<-OSL.curveID[seq(2,length(OSL.curveID),by=2)] - - - ##Provide Values For Growth Curve Fitting - - ##(1) get dose information - Dose<-sapply(1:length(LnLx.curveID),function(x){ - Dose<-sample.data@METADATA[sample.data@METADATA["ID"]==LnLx.curveID[x],"IRR_TIME"] - }) - - ##(2) set LxTx curves - LnLxTnTx.curves<-(sapply(1:length(LnLx.curveID),function(x){ - - ##produce data.frames for Lx/Tx calculations - Lx.HIGH<-sample.data@METADATA[sample.data@METADATA[,"ID"]==LnLx.curveID[x],"HIGH"] - Lx.NPOINTS<-sample.data@METADATA[sample.data@METADATA[,"ID"]==LnLx.curveID[x],"NPOINTS"] - Tx.HIGH<-sample.data@METADATA[sample.data@METADATA[,"ID"]==TnTx.curveID[x],"HIGH"] - Tx.NPOINTS<-sample.data@METADATA[sample.data@METADATA[,"ID"]==TnTx.curveID[x],"NPOINTS"] - - Lx.curve<-data.frame(x=seq(Lx.HIGH/Lx.NPOINTS,Lx.HIGH,by=Lx.HIGH/Lx.NPOINTS), - y=unlist(sample.data@DATA[LnLx.curveID[x]])) - Tx.curve<-data.frame(x=seq(Tx.HIGH/Tx.NPOINTS,Tx.HIGH,by=Tx.HIGH/Tx.NPOINTS), - y=unlist(sample.data@DATA[TnTx.curveID[x]])) - - return(list(Lx.curve,Tx.curve)) - })) - - ##(3) calculate Lx/Tx ratio - LnLxTnTx <- get_RLum( - merge_RLum(lapply(1:length(LnLxTnTx.curves[1, ]), function(k) { - calc_OSLLxTxRatio( - Lx.data = as.data.frame(LnLxTnTx.curves[1, k]), - Tx.data = as.data.frame(LnLxTnTx.curves[2, k]), - signal.integral = signal.integral, - background.integral = background.integral, - background.count.distribution = background.count.distribution, - sigmab = sigmab - ) - }))) - - - ##finally combine to data.frame including the record ID for further analysis - LnLxTnTx <- cbind(LnLxTnTx,LnLx.curveID,TnTx.curveID) - - ##(4.1) set info concerning the kind of regeneration points - - ##generate unique dose id - this are also the # for the generated points - temp.DoseID<-c(0:(length(Dose)-1)) - temp.DoseName<-paste("R",temp.DoseID,sep="") - temp.DoseName<-cbind(Name=temp.DoseName,Dose) - - ##set natural - temp.DoseName[temp.DoseName[,"Name"]=="R0","Name"]<-"Natural" - - ##set R0 - temp.DoseName[temp.DoseName[,"Name"]!="Natural" & temp.DoseName[,"Dose"]==0,"Name"]<-"R0" - - ##find duplicated doses (including 0 dose - which means the Natural) - temp.DoseDuplicated<-duplicated(temp.DoseName[,"Dose"]) - - ##combine temp.DoseName - temp.DoseName<-cbind(temp.DoseName,Repeated=temp.DoseDuplicated) - - ##correct value for R0 (it is not really repeated) - temp.DoseName[temp.DoseName[,"Dose"]==0,"Repeated"]<-FALSE - - - ##(5) Combine all values in a data.frame - temp.LnLxTnTx<-data.frame(Name=temp.DoseName[,"Name"], - Dose=Dose, - Repeated=as.logical(temp.DoseName[,"Repeated"])) - LnLxTnTx<-cbind(temp.LnLxTnTx,LnLxTnTx) - LnLxTnTx[,"Name"]<-as.character(LnLxTnTx[,"Name"]) - - ##(6) Calculate Recyling Ratio and Recuperation Rate - - ##(6.1) - ##Calculate Recycling Ratio - - if(length(LnLxTnTx[LnLxTnTx[,"Repeated"]==TRUE,"Repeated"])>0){ - - ##identify repeated doses - temp.Repeated<-LnLxTnTx[LnLxTnTx[,"Repeated"]==TRUE,c("Name","Dose","LxTx")] - - ##find corresponding previous dose for the repeated dose - temp.Previous<-t(sapply(1:length(temp.Repeated[,1]),function(x){ - LnLxTnTx[LnLxTnTx[,"Dose"]==temp.Repeated[x,"Dose"] & - LnLxTnTx[,"Repeated"]==FALSE,c("Name","Dose","LxTx")] - })) - - ##convert to data.frame - temp.Previous<-as.data.frame(temp.Previous) - - ##set column names - temp.ColNames<-sapply(1:length(temp.Repeated[,1]),function(x){ - paste(temp.Repeated[x,"Name"],"/", - temp.Previous[temp.Previous[,"Dose"]==temp.Repeated[x,"Dose"],"Name"] - ,sep="") - }) - - ##Calculate Recycling Ratio - RecyclingRatio<-as.numeric(temp.Repeated[,"LxTx"])/as.numeric(temp.Previous[,"LxTx"]) - - ##Just transform the matrix and add column names - RecyclingRatio<-t(RecyclingRatio) - colnames(RecyclingRatio) <- unique(temp.ColNames) - - }else{RecyclingRatio<-NA} - - ##(6.2) - ##Recuperation Rate - - if("R0" %in% LnLxTnTx[,"Name"]==TRUE){ - Recuperation<-round(LnLxTnTx[LnLxTnTx[,"Name"]=="R0","LxTx"]/LnLxTnTx[LnLxTnTx[,"Name"]=="Natural","LxTx"],digits=4) - }else{Recuperation<-NA} - - - ##(6.3) IRSL - ##Print IRSL Curves if IRSL curve is set - sample.data@METADATA[,"SEL"]<-FALSE - sample.data@METADATA[sample.data@METADATA["LTYPE"]=="IRSL" & - sample.data@METADATA[,"RUN"]%in%run==TRUE & - sample.data@METADATA[,"SET"]%in%set==TRUE,"SEL"]<-TRUE - - - ##get IRSL curve ID & ID for Reg1 again - IRSL.curveID<-sample.data@METADATA[sample.data@METADATA["SEL"]==TRUE & sample.data@METADATA["POSITION"]==i,"ID"] - - ##if no IRSL curve the length of the object is 0 - if(length(IRSL.curveID)>0){ - - ##chose an IRSL curve with a dose of the first regeneration point - Reg1again.curveID<-LnLxTnTx[LnLxTnTx[,"Repeated"]==TRUE & LnLxTnTx[,"Dose"]==LnLxTnTx[2,"Dose"],"LnLx.curveID"] - - if(length(Reg1again.curveID)>0){ - - ##BOSL/IRSL - IRSL_BOSL<-round(sum(unlist(sample.data@DATA[IRSL.curveID])[signal.integral]) - /sum(unlist(sample.data@DATA[Reg1again.curveID])[signal.integral]),digits=4) - }else{IRSL_BOSL<-NA} - }else{IRSL_BOSL<-NA} - - ##Combine the two values - if(exists("RejectionCriteria")==FALSE){ - RejectionCriteria<-cbind(RecyclingRatio,Recuperation,IRSL_BOSL) - }else{ - RejectionCriteria.temp<-cbind(RecyclingRatio,Recuperation,IRSL_BOSL) - RejectionCriteria<-rbind(RejectionCriteria,RejectionCriteria.temp) - } - - ##============================================================================## - ##PLOTTING - ##============================================================================## - - if(output.plot){ - - ##set plot settings - plot.settings <- list( - mtext = sample.data@METADATA[sample.data@METADATA[,"ID"]==LnLx.curveID[1],"SAMPLE"], - log = "" - - ) - - ##modify arguments - plot.settings <- modifyList(plot.settings, list(...)) - - - - if(output.plot.single==FALSE){ - layout(matrix(c(1,2,1,2,3,4,3,5),4,2,byrow=TRUE)) - } - ##warning if number of curves exceed colour values - if(length(col)0){ - - - ##to ensure that the right TL curves are used the run and set number of the LnLx and TnTx curves are used - LnLx.SET<-sapply(LnLx.curveID,function(x){sample.data@METADATA[sample.data@METADATA["ID"]==x,"SET"]}) - LnLx.RUN<-sapply(LnLx.curveID,function(x){sample.data@METADATA[sample.data@METADATA["ID"]==x,"RUN"]}) - TnTx.SET<-sapply(TnTx.curveID,function(x){sample.data@METADATA[sample.data@METADATA["ID"]==x,"SET"]}) - TnTx.RUN<-sapply(TnTx.curveID,function(x){sample.data@METADATA[sample.data@METADATA["ID"]==x,"RUN"]}) - - ##get TL curve IDs in general considering the constraints - TL.curveID<-sapply(1:length(TnTx.curveID),function(x){results<- - sample.data@METADATA[sample.data@METADATA["SEL"]==TRUE & sample.data@METADATA["POSITION"]==i & - sample.data@METADATA["SET"]>=LnLx.SET[x] & sample.data@METADATA["RUN"]>=LnLx.RUN[x] & - sample.data@METADATA["SET"]<=TnTx.SET[x] & sample.data@METADATA["RUN"]<=TnTx.RUN[x],"ID"]}) - - ##get maximum value of TL curves - TL.curveMax<-max(unlist(sample.data@DATA[TL.curveID])) - - ##get channel resolution (it should be the same for all values) - HIGH<-unique(sample.data@METADATA[sample.data@METADATA["ID"]==TL.curveID[1],"HIGH"]) - NPOINTS<-unique(sample.data@METADATA[sample.data@METADATA["ID"]==TL.curveID[1],"NPOINTS"]) - xaxt.values<-seq(HIGH/NPOINTS,HIGH,by=HIGH/NPOINTS) - - ##get heating rate - RATE<-unique(sample.data@METADATA[sample.data@METADATA["ID"]==TL.curveID[1],"RATE"]) - - ##open plot area for TL curves - plot(NA,NA, - xlab="T [\u00B0C]", - ylab=paste("TL [cts/",HIGH/NPOINTS," \u00B0C]",sep=""), - xlim=c(HIGH/NPOINTS,HIGH), - ylim=c(1,TL.curveMax), - main="Cutheat - TL curves", - sub=paste("(",RATE," K/s)",sep=""), - log=if(plot.settings$log=="y" | plot.settings$log=="xy"){"y"}else{""} - ) - - ##plot curves and get legend values - sapply(1:length(TL.curveID),function(x){ - yaxt.values<-unlist(sample.data@DATA[TL.curveID[x]]) - lines(xaxt.values,yaxt.values,col=col[x]) - }) - - ##plot legend - legend("topleft",as.character(LnLxTnTx$Name),lty=c(rep(1,length(TL.curveID))), - cex=0.8*cex.global,col=col, bg="white", bty="n") - - ##sample name - mtext(side=3,plot.settings$mtext,cex=0.7*cex.global) - - - }else{ - plot(NA,NA,xlim=c(0,100),ylim=c(0,100), main="Cutheat - TL curves") - text(50,50,"no cutheat as TL curve detected") - } - - ##======================================================================## - ##Print IRSL Curves if IRSL curve is set - - if(is.na(IRSL_BOSL) == FALSE){ - ##get channel resolution (it should be the same for all values) - HIGH<-unique(sample.data@METADATA[sample.data@METADATA["ID"]==IRSL.curveID ,"HIGH"]) - NPOINTS<-unique(sample.data@METADATA[sample.data@METADATA["ID"]==IRSL.curveID ,"NPOINTS"]) - xaxt.values<-seq(HIGH/NPOINTS,HIGH,by=HIGH/NPOINTS) - - ##open plot IRSL curve - plot(NA,NA, - xlab="Time [s]", - ylab=paste("OSL and IRSL [cts/",HIGH/NPOINTS," s]",sep=""), - xlim=c(0,HIGH), - ylim=c(0,max(unlist(sample.data@DATA[Reg1again.curveID]))), - main="IRSLT" - ) - - ##show integral limits - abline(v=xaxt.values[min(signal.integral)], lty=2, col="gray") - abline(v=xaxt.values[max(signal.integral)], lty=2, col="gray") - - ##print(length(sample.data@DATA[IRSL.curveID])) - lines(xaxt.values,unlist(sample.data@DATA[IRSL.curveID]),col="red") - lines(xaxt.values,unlist(sample.data@DATA[Reg1again.curveID[1]]),col="blue") - - ##legend - legend("topright",c("R1 again","IRSL"),lty=c(1,1),col=c("blue","red"), bty="n") - - - mtext(side=3,paste("IRSL/BOSL = ",IRSL_BOSL*100,"%",sep=""), - cex=.8*cex.global - ) - } - - if(((is.na(IRSL_BOSL)==TRUE) & length(IRSL.curveID)>0) | - ((is.na(IRSL_BOSL)==FALSE) & length(IRSL.curveID)>0)){ - - ##plot only IRSL curve - plot(xaxt.values,unlist(sample.data@DATA[IRSL.curveID]), - xlab="Time [s]", - ylab=paste("IRSL [cts/",HIGH/NPOINTS," s]",sep=""), - xlim=c(0,10), - ylim=c(0,max(unlist(sample.data@DATA[IRSL.curveID]))), - main="IRSL curve (10 s)", - col="red", - type="l" - ) - }else{ - plot(NA,NA,xlim=c(0,10), ylim=c(0,10), main="IRSL curve") - text(5,5,"no IRSL curve detected") - } - ##========================================================================= - ##Plot header - if(output.plot.single==TRUE){ - mtext(side=3,paste("ALQ Pos. ",i,sep="")) - }else{ - mtext(side=3,paste("ALQ Pos. ",i,sep=""),outer=TRUE,line=-2.5) - } - - ##Plot footer - mtext(side=4,info.measurement,outer=TRUE,line=-1.5,cex=0.6*cex.global, col="blue") - - ##output on terminal for plot - writeLines(paste("\n[Analyse_SAR.OSLdata()] >> Figure for position ",i," produced.",sep="")) - - ##reset mfrow - par(mfrow=c(1,1)) - - - - }#endif for output.plot - ##preprate output of values - ##============================================================================== - - ##Add LnLxTnTx values to the list - if(exists("LnLxTnTx_List")==FALSE){LnLxTnTx_List<-list()} - LnLxTnTx_List[[i]]<-LnLxTnTx - rm(LnLxTnTx) - - - }else{writeLines(paste("[Analyse_SAR.OSLdata()] >> Position ",i," is not valid and has been omitted!",sep=""))} #end if position checking - - }#end for loop - - ##============================================================================## - ##OUTPUT OF FUNCTION - ##============================================================================## - - ##get further information from the position used - - ##this is what you get from the Risoe file - readTemp<-unique(sample.data@METADATA[sample.data@METADATA[,"POSITION"]==min(position) & sample.data@METADATA[,"LTYPE"]!="TL","TEMPERATURE"]) - - cutheat<-unique(sample.data@METADATA[sample.data@METADATA[,"POSITION"]==min(position) & - sample.data@METADATA[,"LTYPE"]=="TL","HIGH"]) - if(length(cutheat)==0){cutheat=NA} - - systemID<-unique(sample.data@METADATA[sample.data@METADATA[,"POSITION"]==min(position),"SYSTEMID"]) - - SARParameters<-data.frame(readTemp=readTemp,cutheat=cutheat,systemID=systemID) - - return(list(LnLxTnTx=LnLxTnTx_List, - RejectionCriteria=RejectionCriteria, - SARParameters=SARParameters)) - - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/CW2pHMi.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/CW2pHMi.R deleted file mode 100644 index 2b4a1ab41..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/CW2pHMi.R +++ /dev/null @@ -1,362 +0,0 @@ -#' Transform a CW-OSL curve into a pHM-OSL curve via interpolation under -#' hyperbolic modulation conditions -#' -#' This function transforms a conventionally measured continuous-wave (CW) -#' OSL-curve to a pseudo hyperbolic modulated (pHM) curve under hyperbolic -#' modulation conditions using the interpolation procedure described by Bos & -#' Wallinga (2012). -#' -#' The complete procedure of the transformation is described in Bos & Wallinga -#' (2012). The input `data.frame` consists of two columns: time (t) and -#' count values (CW(t)) -#' -#' **Internal transformation steps** -#' -#' (1) log(CW-OSL) values -#' -#' (2) -#' Calculate t' which is the transformed time: -#' \deqn{t' = t-(1/\delta)*log(1+\delta*t)} -#' -#' (3) -#' Interpolate CW(t'), i.e. use the log(CW(t)) to obtain the count values -#' for the transformed time (t'). Values beyond `min(t)` and `max(t)` -#' produce `NA` values. -#' -#' (4) -#' Select all values for t' < `min(t)`, i.e. values beyond the time -#' resolution of t. Select the first two values of the transformed data set -#' which contain no `NA` values and use these values for a linear fit -#' using [lm]. -#' -#' (5) -#' Extrapolate values for t' < `min(t)` based on the previously -#' obtained fit parameters. -#' -#' (6) -#' Transform values using -#' \deqn{pHM(t) = (\delta*t/(1+\delta*t))*c*CW(t')} -#' \deqn{c = (1+\delta*P)/\delta*P} -#' \deqn{P = length(stimulation~period)} -#' -#' (7) Combine all values and truncate all values for t' > `max(t)` -#' -#' -#' **NOTE:** -#' The number of values for t' < `min(t)` depends on the stimulation rate -#' parameter `delta`. To avoid the production of too many artificial data -#' at the raising tail of the determined pHM curve, it is recommended to use -#' the automatic estimation routine for `delta`, i.e. provide no value for -#' `delta`. -#' -#' @param values [RLum.Data.Curve-class] or [data.frame] (**required**): -#' [RLum.Data.Curve-class] or [data.frame] with measured curve data of type -#' stimulation time (t) (`values[,1]`) and measured counts (cts) (`values[,2]`). -#' -#' @param delta [vector] (*optional*): -#' stimulation rate parameter, if no value is given, the optimal value is -#' estimated automatically (see details). Smaller values of delta produce more -#' points in the rising tail of -#' the curve. -#' -#' @return -#' The function returns the same data type as the input data type with -#' the transformed curve values. -#' -#' -#' **`RLum.Data.Curve`** -#' -#' \tabular{ll}{ -#' `$CW2pHMi.x.t` \tab: transformed time values \cr -#' `$CW2pHMi.method` \tab: used method for the production of the new data points -#' } -#' -#' **`data.frame`** -#' -#' \tabular{ll}{ -#' `$x` \tab: time\cr -#' `$y.t` \tab: transformed count values\cr -#' `$x.t` \tab: transformed time values \cr -#' `$method` \tab: used method for the production of the new data points -#' } -#' -#' @note -#' According to Bos & Wallinga (2012), the number of extrapolated points -#' should be limited to avoid artificial intensity data. If `delta` is -#' provided manually and more than two points are extrapolated, a warning -#' message is returned. -#' -#' The function [approx] may produce some `Inf` and `NaN` data. -#' The function tries to manually interpolate these values by calculating -#' the `mean` using the adjacent channels. If two invalid values are succeeding, -#' the values are removed and no further interpolation is attempted. -#' In every case a warning message is shown. -#' -#' @section Function version: 0.2.2 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -#' Based on comments and suggestions from:\cr -#' Adrie J.J. Bos, Delft University of Technology, The Netherlands -#' -#' @seealso [CW2pLM], [CW2pLMi], [CW2pPMi], [fit_LMCurve], [lm], -#' [RLum.Data.Curve-class] -#' -#' @references -#' Bos, A.J.J. & Wallinga, J., 2012. How to visualize quartz OSL -#' signal components. Radiation Measurements, 47, 752-758.\cr -#' -#' **Further Reading** -#' -#' Bulur, E., 1996. An Alternative Technique For -#' Optically Stimulated Luminescence (OSL) Experiment. Radiation Measurements, -#' 26, 701-709. -#' -#' Bulur, E., 2000. A simple transformation for converting CW-OSL curves to -#' LM-OSL curves. Radiation Measurements, 32, 141-145. -#' -#' @keywords manip -#' -#' @examples -#' -#' ##(1) - simple transformation -#' -#' ##load CW-OSL curve data -#' data(ExampleData.CW_OSL_Curve, envir = environment()) -#' -#' ##transform values -#' values.transformed<-CW2pHMi(ExampleData.CW_OSL_Curve) -#' -#' ##plot -#' plot(values.transformed$x, values.transformed$y.t, log = "x") -#' -#' ##(2) - load CW-OSL curve from BIN-file and plot transformed values -#' -#' ##load BINfile -#' #BINfileData<-readBIN2R("[path to BIN-file]") -#' data(ExampleData.BINfileData, envir = environment()) -#' -#' ##grep first CW-OSL curve from ALQ 1 -#' curve.ID<-CWOSL.SAR.Data@@METADATA[CWOSL.SAR.Data@@METADATA[,"LTYPE"]=="OSL" & -#' CWOSL.SAR.Data@@METADATA[,"POSITION"]==1 -#' ,"ID"] -#' -#' curve.HIGH<-CWOSL.SAR.Data@@METADATA[CWOSL.SAR.Data@@METADATA[,"ID"]==curve.ID[1] -#' ,"HIGH"] -#' -#' curve.NPOINTS<-CWOSL.SAR.Data@@METADATA[CWOSL.SAR.Data@@METADATA[,"ID"]==curve.ID[1] -#' ,"NPOINTS"] -#' -#' ##combine curve to data set -#' -#' curve<-data.frame(x = seq(curve.HIGH/curve.NPOINTS,curve.HIGH, -#' by = curve.HIGH/curve.NPOINTS), -#' y=unlist(CWOSL.SAR.Data@@DATA[curve.ID[1]])) -#' -#' -#' ##transform values -#' -#' curve.transformed <- CW2pHMi(curve) -#' -#' ##plot curve -#' plot(curve.transformed$x, curve.transformed$y.t, log = "x") -#' -#' -#' ##(3) - produce Fig. 4 from Bos & Wallinga (2012) -#' -#' ##load data -#' data(ExampleData.CW_OSL_Curve, envir = environment()) -#' values <- CW_Curve.BosWallinga2012 -#' -#' ##open plot area -#' plot(NA, NA, -#' xlim=c(0.001,10), -#' ylim=c(0,8000), -#' ylab="pseudo OSL (cts/0.01 s)", -#' xlab="t [s]", -#' log="x", -#' main="Fig. 4 - Bos & Wallinga (2012)") -#' -#' values.t<-CW2pLMi(values, P=1/20) -#' lines(values[1:length(values.t[,1]),1],CW2pLMi(values, P=1/20)[,2], -#' col="red" ,lwd=1.3) -#' text(0.03,4500,"LM", col="red" ,cex=.8) -#' -#' values.t<-CW2pHMi(values, delta=40) -#' lines(values[1:length(values.t[,1]),1],CW2pHMi(values, delta=40)[,2], -#' col="black", lwd=1.3) -#' text(0.005,3000,"HM", cex=.8) -#' -#' values.t<-CW2pPMi(values, P=1/10) -#' lines(values[1:length(values.t[,1]),1],CW2pPMi(values, P=1/10)[,2], -#' col="blue", lwd=1.3) -#' text(0.5,6500,"PM", col="blue" ,cex=.8) -#' -#' @md -#' @export -CW2pHMi<- function( - values, - delta -){ - - - ##(1) data.frame or RLum.Data.Curve object? - if(is(values, "data.frame") == FALSE & is(values, "RLum.Data.Curve") == FALSE){ - - stop("[CW2pHMi()] 'values' object has to be of type 'data.frame' or 'RLum.Data.Curve'!", call. = FALSE) - - } - - ##(2) if the input object is an 'RLum.Data.Curve' object check for allowed curves - if(is(values, "RLum.Data.Curve") == TRUE){ - - if(!grepl("OSL", values@recordType) & !grepl("IRSL", values@recordType)){ - - stop(paste("[CW2pHMi()] recordType ",values@recordType, " is not allowed for the transformation!", - sep=""), call. = FALSE) - - }else{ - - temp.values <- as(values, "data.frame") - - } - - }else{ - - temp.values <- values - - } - - - # (1) Transform values ------------------------------------------------------ - - ##log transformation of the CW-OSL count values - CW_OSL.log<-log(temp.values[,2]) - - ##time transformation t >> t' - t<-temp.values[,1] - - ##set delta - ##if no values for delta is set selected a delta value for a maximum of - ##two extrapolation points - if(missing(delta)==TRUE){ - - i<-10 - delta<-i - t.transformed<-t-(1/delta)*log(1+delta*t) - - while(length(t.transformed[t.transformed2){ - - delta<-i - t.transformed<-t-(1/delta)*log(1+delta*t) - i<-i+10 - - } - }else{ - - t.transformed<-t-(1/delta)*log(1+delta*t) - - } - - # (2) Interpolation --------------------------------------------------------- - - ##interpolate values, values beyond the range return NA values - CW_OSL.interpolated <- approx(t,CW_OSL.log, xout=t.transformed, rule=1) - - - ##combine t.transformed and CW_OSL.interpolated in a data.frame - temp <- data.frame(x=t.transformed, y=unlist(CW_OSL.interpolated$y)) - - ##Problem: In some cases the interpolation algorithm is not working properly - ##and Inf or NaN values are returned - - ##fetch row number of the invalid values - invalid_values.id <- c(which(is.infinite(temp[,2]) | is.nan(temp[,2]))) - - if(length(invalid_values.id) > 0){ - .throw_warning(length(invalid_values.id), " values have been found ", - "and replaced by the mean of the nearest values") - } - - ##interpolate between the lower and the upper value - invalid_values.interpolated<-sapply(1:length(invalid_values.id), - function(x) { - - mean(c(temp[invalid_values.id[x]-1,2], - temp[invalid_values.id[x]+1,2])) - - } - ) - - ##replace invalid values in data.frame with newly interpolated values - if(length(invalid_values.id)>0){ - temp[invalid_values.id,2]<-invalid_values.interpolated - } - - # (3) Extrapolate first values of the curve --------------------------------- - - ##(a) - find index of first rows which contain NA values (needed for extrapolation) - temp.sel.id<-min(which(is.na(temp[,2])==FALSE)) - - ##(b) - fit linear function - fit.lm<-lm(y ~ x,data.frame(x=t[1:2],y=CW_OSL.log[1:2])) - - ##select values to extrapolate and predict (extrapolate) values based on the fitted function - x.i<-data.frame(x=temp[1:(min(temp.sel.id)-1),1]) - y.i<-predict(fit.lm,x.i) - - ##replace NA values by extrapolated values - temp[1:length(y.i),2]<-y.i - - ##set method values - temp.method<-c(rep("extrapolation",length(y.i)),rep("interpolation",(length(temp[,2])-length(y.i)))) - - ##print a warning message for more than two extrapolation points - if(length(y.i)>2){warning("t' is beyond the time resolution and more than two data points have been extrapolated!")} - - # (4) Convert, transform and combine values --------------------------------- - - ##unlog CW-OSL count values, i.e. log(CW) >> CW - CW_OSL<-exp(temp$y) - - ##set values for c and P - - ##P is the stimulation period - P<-max(temp.values[,1]) - - ##c is a dimensionless constant - c<-(1+(delta*P))/(delta*P) - - ##transform CW-OSL values to pLM-OSL values - pHM<-((delta*t)/(1+(delta*t)))*c*CW_OSL - - ##combine all values and exclude NA values - temp.values <- data.frame(x=t,y.t=pHM,x.t=t.transformed,method=temp.method) - temp.values <- na.exclude(temp.values) - - # (5) Return values --------------------------------------------------------- - - ##returns the same data type as the input - if(is(values, "data.frame") == TRUE){ - - values <- temp.values - return(values) - - }else{ - - - ##add old info elements to new info elements - temp.info <- c(values@info, - CW2pHMi.x.t = list(temp.values$x.t), - CW2pHMi.method = list(temp.values$method)) - - newRLumDataCurves.CW2pHMi <- set_RLum( - class = "RLum.Data.Curve", - recordType = values@recordType, - data = as.matrix(temp.values[,1:2]), - info = temp.info) - return(newRLumDataCurves.CW2pHMi) - - } - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/CW2pLM.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/CW2pLM.R deleted file mode 100644 index 3cb601377..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/CW2pLM.R +++ /dev/null @@ -1,141 +0,0 @@ -#' Transform a CW-OSL curve into a pLM-OSL curve -#' -#' Transforms a conventionally measured continuous-wave (CW) curve into a -#' pseudo linearly modulated (pLM) curve using the equations given in Bulur -#' (2000). -#' -#' According to Bulur (2000) the curve data are transformed by introducing two -#' new parameters `P` (stimulation period) and `u` (transformed time): -#' -#' \deqn{P=2*max(t)} \deqn{u=\sqrt{(2*t*P)}} -#' -#' The new count values are then calculated by -#' \deqn{ctsNEW = cts(u/P)} -#' -#' and the returned `data.frame` is produced by: `data.frame(u,ctsNEW)` -#' -#' The output of the function can be further used for LM-OSL fitting. -#' -#' @param values [RLum.Data.Curve-class] or [data.frame] (**required**): -#' `RLum.Data.Curve` data object. Alternatively, a `data.frame` of the measured -#' curve data of type stimulation time (t) (`values[,1]`) and measured counts (cts) -#' (`values[,2]`) can be provided. -#' -#' @return -#' The function returns the same data type as the input data type with -#' the transformed curve values ([data.frame] or [RLum.Data.Curve-class]). -#' -#' @note -#' The transformation is recommended for curves recorded with a channel -#' resolution of at least 0.05 s/channel. -#' -#' @section Function version: 0.4.1 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [CW2pHMi], [CW2pLMi], [CW2pPMi], [fit_LMCurve], [lm], -#' [RLum.Data.Curve-class] -#' -#' -#' @references -#' Bulur, E., 2000. A simple transformation for converting CW-OSL -#' curves to LM-OSL curves. Radiation Measurements, 32, 141-145. -#' -#' **Further Reading** -#' -#' Bulur, E., 1996. An Alternative Technique For Optically Stimulated -#' Luminescence (OSL) Experiment. Radiation Measurements, 26, 701-709. -#' -#' @keywords manip -#' -#' @examples -#' -#' ##read curve from CWOSL.SAR.Data transform curve and plot values -#' data(ExampleData.BINfileData, envir = environment()) -#' -#' ##read id for the 1st OSL curve -#' id.OSL <- CWOSL.SAR.Data@@METADATA[CWOSL.SAR.Data@@METADATA[,"LTYPE"] == "OSL","ID"] -#' -#' ##produce x and y (time and count data for the data set) -#' x<-seq(CWOSL.SAR.Data@@METADATA[id.OSL[1],"HIGH"]/CWOSL.SAR.Data@@METADATA[id.OSL[1],"NPOINTS"], -#' CWOSL.SAR.Data@@METADATA[id.OSL[1],"HIGH"], -#' by = CWOSL.SAR.Data@@METADATA[id.OSL[1],"HIGH"]/CWOSL.SAR.Data@@METADATA[id.OSL[1],"NPOINTS"]) -#' y <- unlist(CWOSL.SAR.Data@@DATA[id.OSL[1]]) -#' values <- data.frame(x,y) -#' -#' ##transform values -#' values.transformed <- CW2pLM(values) -#' -#' ##plot -#' plot(values.transformed) -#' -#' @md -#' @export -CW2pLM <- function( - values -){ - - # Integrity Checks -------------------------------------------------------- - - ##(1) data.frame or RLum.Data.Curve object? - if(is(values, "data.frame") == FALSE & is(values, "RLum.Data.Curve") == FALSE){ - stop("[CW2pLM()] 'values' object has to be of type 'data.frame' or 'RLum.Data.Curve'!", call. = FALSE) - - } - - ##(2) if the input object is an 'RLum.Data.Curve' object check for allowed curves - if(is(values, "RLum.Data.Curve") == TRUE){ - - if(!grepl("OSL", values@recordType) & !grepl("IRSL", values@recordType)){ - - stop(paste("[CW2pLM()] recordType ",values@recordType, " is not allowed for the transformation!", - sep=""), call. = FALSE) - - }else{ - - temp.values <- as(values, "data.frame") - - } - - }else{ - - temp.values <- values - - - } - - - # Calculation ------------------------------------------------------------- - - - ##curve transformation - P<-2*max(temp.values[,1]) - u<-((2*temp.values[,1]*P)^0.5) - - ##cw >> plm conversion, according Bulur, 2000 - temp.values[,2]<-temp.values[,2]*(u/P) - temp.values<-data.frame(u,temp.values[,2]) - - - # Return values ----------------------------------------------------------- - - ##returns the same data type as the input - - if(is(values, "data.frame") == TRUE){ - - values <- temp.values - return(values) - - }else{ - - newRLumDataCurves.CW2pLM <- set_RLum( - class = "RLum.Data.Curve", - recordType = values@recordType, - data = as.matrix(temp.values), - info = values@info) - return(newRLumDataCurves.CW2pLM) - - } - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/CW2pLMi.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/CW2pLMi.R deleted file mode 100644 index 4bad139c2..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/CW2pLMi.R +++ /dev/null @@ -1,302 +0,0 @@ -#' Transform a CW-OSL curve into a pLM-OSL curve via interpolation under linear -#' modulation conditions -#' -#' Transforms a conventionally measured continuous-wave (CW) OSL-curve into a -#' pseudo linearly modulated (pLM) curve under linear modulation conditions -#' using the interpolation procedure described by Bos & Wallinga (2012). -#' -#' The complete procedure of the transformation is given in Bos & Wallinga -#' (2012). The input `data.frame` consists of two columns: time (t) and -#' count values (CW(t)) -#' -#' **Nomenclature** -#' -#' - P = stimulation time (s) -#' - 1/P = stimulation rate (1/s) -#' -#' **Internal transformation steps** -#' -#' (1) -#' log(CW-OSL) values -#' -#' (2) -#' Calculate t' which is the transformed time: -#' \deqn{t' = 1/2*1/P*t^2} -#' -#' (3) -#' Interpolate CW(t'), i.e. use the log(CW(t)) to obtain the count values -#' for the transformed time (t'). Values beyond `min(t)` and `max(t)` -#' produce `NA` values. -#' -#' (4) -#' Select all values for t' < `min(t)`, i.e. values beyond the time resolution -#' of t. Select the first two values of the transformed data set which contain -#' no `NA` values and use these values for a linear fit using [lm]. -#' -#' (5) -#' Extrapolate values for t' < `min(t)` based on the previously obtained -#' fit parameters. -#' -#' (6) -#' Transform values using -#' \deqn{pLM(t) = t/P*CW(t')} -#' -#' (7) -#' Combine values and truncate all values for t' > `max(t)` -#' -#' -#' **NOTE:** -#' The number of values for t' < `min(t)` depends on the stimulation -#' period (P) and therefore on the stimulation rate 1/P. To avoid the -#' production of too many artificial data at the raising tail of the determined -#' pLM curves it is recommended to use the automatic estimation routine for -#' `P`, i.e. provide no own value for `P`. -#' -#' @param values [RLum.Data.Curve-class] or [data.frame] (**required**): -#' [RLum.Data.Curve-class] or `data.frame` with measured curve data of type -#' stimulation time (t) (`values[,1]`) and measured counts (cts) (`values[,2]`) -#' -#' @param P [vector] (*optional*): -#' stimulation time in seconds. If no value is given the optimal value is -#' estimated automatically (see details). Greater values of P produce more -#' points in the rising tail of the curve. -#' -#' @return -#' The function returns the same data type as the input data type with -#' the transformed curve values. -#' -#' **`RLum.Data.Curve`** -#' -#' \tabular{rl}{ -#' `$CW2pLMi.x.t` \tab: transformed time values \cr -#' `$CW2pLMi.method` \tab: used method for the production of the new data points -#' } -#' -#' @note -#' According to Bos & Wallinga (2012) the number of extrapolated points -#' should be limited to avoid artificial intensity data. If `P` is -#' provided manually and more than two points are extrapolated, a warning -#' message is returned. -#' -#' @section Function version: 0.3.1 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' Based on comments and suggestions from:\cr -#' Adrie J.J. Bos, Delft University of Technology, The Netherlands -#' -#' @seealso [CW2pLM], [CW2pHMi], [CW2pPMi], [fit_LMCurve], -#' [RLum.Data.Curve-class] -#' -#' @references -#' Bos, A.J.J. & Wallinga, J., 2012. How to visualize quartz OSL -#' signal components. Radiation Measurements, 47, 752-758. -#' -#' **Further Reading** -#' -#' Bulur, E., 1996. An Alternative Technique For -#' Optically Stimulated Luminescence (OSL) Experiment. Radiation Measurements, -#' 26, 701-709. -#' -#' Bulur, E., 2000. A simple transformation for converting CW-OSL curves to -#' LM-OSL curves. Radiation Measurements, 32, 141-145. -#' -#' @keywords manip -#' -#' @examples -#' -#' ##(1) -#' ##load CW-OSL curve data -#' data(ExampleData.CW_OSL_Curve, envir = environment()) -#' -#' ##transform values -#' values.transformed <- CW2pLMi(ExampleData.CW_OSL_Curve) -#' -#' ##plot -#' plot(values.transformed$x, values.transformed$y.t, log = "x") -#' -#' ##(2) - produce Fig. 4 from Bos & Wallinga (2012) -#' ##load data -#' data(ExampleData.CW_OSL_Curve, envir = environment()) -#' values <- CW_Curve.BosWallinga2012 -#' -#' ##open plot area -#' plot(NA, NA, -#' xlim = c(0.001,10), -#' ylim = c(0,8000), -#' ylab = "pseudo OSL (cts/0.01 s)", -#' xlab = "t [s]", -#' log = "x", -#' main = "Fig. 4 - Bos & Wallinga (2012)") -#' -#' -#' values.t <- CW2pLMi(values, P = 1/20) -#' lines(values[1:length(values.t[,1]),1],CW2pLMi(values, P = 1/20)[,2], -#' col = "red", lwd = 1.3) -#' text(0.03,4500,"LM", col = "red", cex = .8) -#' -#' values.t <- CW2pHMi(values, delta = 40) -#' lines(values[1:length(values.t[,1]),1],CW2pHMi(values, delta = 40)[,2], -#' col = "black", lwd = 1.3) -#' text(0.005,3000,"HM", cex =.8) -#' -#' values.t <- CW2pPMi(values, P = 1/10) -#' lines(values[1:length(values.t[,1]),1], CW2pPMi(values, P = 1/10)[,2], -#' col = "blue", lwd = 1.3) -#' text(0.5,6500,"PM", col = "blue", cex = .8) -#' -#' @md -#' @export -CW2pLMi<- function( - values, - P -){ - - # (0) Integrity checks ------------------------------------------------------- - - ##(1) data.frame or RLum.Data.Curve object? - if(is(values, "data.frame") == FALSE & is(values, "RLum.Data.Curve") == FALSE){ - stop("[CW2pLMi()] 'values' object has to be of type 'data.frame' or 'RLum.Data.Curve'!", call. = FALSE) - - } - - ##(2) if the input object is an 'RLum.Data.Curve' object check for allowed curves - if(is(values, "RLum.Data.Curve") == TRUE){ - - if(!grepl("OSL", values@recordType) & !grepl("IRSL", values@recordType)){ - - stop(paste("[CW2pLMi()] recordType ",values@recordType, " is not allowed for the transformation!", - sep=""), call. = FALSE) - - }else{ - - temp.values <- as(values, "data.frame") - - } - - }else{ - - temp.values <- values - - } - - - # (1) Transform values ------------------------------------------------------------------------ - - - ##(a) log transformation of the CW-OSL count values - CW_OSL.log<-log(temp.values[,2]) - - ##(b) time transformation t >> t' - t<-temp.values[,1] - - ##set P - ##if no values for P is set selected a P value for a maximum of - ##two extrapolation points - if(missing(P)==TRUE){ - - i<-10 - P<-1/i - t.transformed<-0.5*1/P*t^2 - - while(length(t.transformed[t.transformed2){ - - P<-1/i - t.transformed<-0.5*1/P*t^2 - i<-i+10 - - }#end::while - }else{ - - if(P==0){stop("[CW2pLMi] P has to be > 0!", call. = FALSE)} - t.transformed<-0.5*1/P*t^2 - - } - #endif - - # (2) Interpolation --------------------------------------------------------------------------- - - ##interpolate values, values beyond the range return NA values - CW_OSL.interpolated<-approx(t,CW_OSL.log, xout=t.transformed, rule=1 ) - - ##combine t.transformed and CW_OSL.interpolated in a data.frame - temp<-data.frame(x=t.transformed, y=unlist(CW_OSL.interpolated$y)) - - ##Problem: I rare cases the interpolation is not working properely and Inf or NaN values are returned - - ##Fetch row number of the invalid values - invalid_values.id<-c(which(is.infinite(temp[,2]) | is.nan(temp[,2]))) - - ##interpolate between the lower and the upper value - invalid_values.interpolated<-sapply(1:length(invalid_values.id), - function(x) { - mean(c(temp[invalid_values.id[x]-1,2],temp[invalid_values.id[x]+1,2])) - } - ) - - ##replace invalid values in data.frame with newly interpolated values - if(length(invalid_values.id)>0){ - temp[invalid_values.id,2]<-invalid_values.interpolated - } - - # (3) Extrapolate first values of the curve --------------------------------------------------- - - - ##(a) - find index of first rows which contain NA values (needed for extrapolation) - temp.sel.id<-min(which(is.na(temp[,2])==FALSE)) - - ##(b) - fit linear function - fit.lm<-lm(y ~ x,data.frame(x=t[1:2],y=CW_OSL.log[1:2])) - - ##select values to extrapolate and predict (extrapolate) values based on the fitted function - x.i<-data.frame(x=temp[1:(min(temp.sel.id)-1),1]) - y.i<-predict(fit.lm,x.i) - - ##replace NA values by extrapolated values - temp[1:length(y.i),2]<-y.i - - ##set method values - temp.method<-c(rep("extrapolation",length(y.i)),rep("interpolation",(length(temp[,2])-length(y.i)))) - - ##print a warning message for more than two extrapolation points - if(length(y.i)>2){warning("t' is beyond the time resolution and more than two data points have been extrapolated!")} - - # (4) Convert, transform and combine values --------------------------------------------------- - - ##unlog CW-OSL count values, i.e. log(CW) >> CW - CW_OSL<-exp(temp$y) - - ##transform CW-OSL values to pLM-OSL values - pLM<-1/P*t*CW_OSL - - ##combine all values and exclude NA values - temp.values <- data.frame(x=t,y.t=pLM,x.t=t.transformed, method=temp.method) - temp.values <- na.exclude(temp.values) - - # (5) Return values --------------------------------------------------------------------------- - - ##returns the same data type as the input - if(is(values, "data.frame") == TRUE){ - - values <- temp.values - return(values) - - }else{ - - - ##add old info elements to new info elements - temp.info <- c(values@info, - CW2pLMi.x.t = list(temp.values$x.t), - CW2pLMi.method = list(temp.values$method)) - - newRLumDataCurves.CW2pLMi <- set_RLum( - class = "RLum.Data.Curve", - recordType = values@recordType, - data = as.matrix(temp.values[,1:2]), - info = temp.info) - return(newRLumDataCurves.CW2pLMi) - - } - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/CW2pPMi.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/CW2pPMi.R deleted file mode 100644 index d7679140c..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/CW2pPMi.R +++ /dev/null @@ -1,292 +0,0 @@ -#' Transform a CW-OSL curve into a pPM-OSL curve via interpolation under -#' parabolic modulation conditions -#' -#' Transforms a conventionally measured continuous-wave (CW) OSL-curve into a -#' pseudo parabolic modulated (pPM) curve under parabolic modulation conditions -#' using the interpolation procedure described by Bos & Wallinga (2012). -#' -#' The complete procedure of the transformation is given in Bos & Wallinga -#' (2012). The input `data.frame` consists of two columns: time (t) and -#' count values (CW(t)) -#' -#' **Nomenclature** -#' -#' - P = stimulation time (s) -#' - 1/P = stimulation rate (1/s) -#' -#' **Internal transformation steps** -#' -#' (1) -#' log(CW-OSL) values -#' -#' (2) -#' Calculate t' which is the transformed time: -#' \deqn{t' = (1/3)*(1/P^2)t^3} -#' -#' (3) -#' Interpolate CW(t'), i.e. use the log(CW(t)) to obtain the count values for -#' the transformed time (t'). Values beyond `min(t)` and `max(t)` -#' produce `NA` values. -#' -#' (4) -#' Select all values for t' < `min(t)`, i.e. values beyond the time resolution -#' of t. Select the first two values of the transformed data set which contain -#' no `NA` values and use these values for a linear fit using [lm]. -#' -#' (5) -#' Extrapolate values for t' < `min(t)` based on the previously obtained -#' fit parameters. The extrapolation is limited to two values. Other values at -#' the beginning of the transformed curve are set to 0. -#' -#' (6) -#' Transform values using -#' \deqn{pLM(t) = t^2/P^2*CW(t')} -#' -#' (7) -#' Combine all values and truncate all values for t' > `max(t)` -#' -#' **NOTE:** -#' The number of values for t' < `min(t)` depends on the stimulation -#' period `P`. To avoid the production of too many artificial data at the -#' raising tail of the determined pPM curve, it is recommended to use the -#' automatic estimation routine for `P`, i.e. provide no value for -#' `P`. -#' -#' @param values [RLum.Data.Curve-class] or [data.frame] (**required**): -#' [RLum.Data.Curve-class] or `data.frame` with measured curve data of type -#' stimulation time (t) (`values[,1]`) and measured counts (cts) (`values[,2]`) -#' -#' @param P [vector] (*optional*): -#' stimulation period in seconds. If no value is given, the optimal value is -#' estimated automatically (see details). Greater values of P produce more -#' points in the rising tail of the curve. -#' -#' @return -#' The function returns the same data type as the input data type with -#' the transformed curve values. -#' -#' `RLum.Data.Curve` -#' -#' \tabular{rl}{ -#' `$CW2pPMi.x.t` \tab: transformed time values \cr -#' `$CW2pPMi.method` \tab: used method for the production of the new data points -#' } -#' -#' `data.frame` -#' -#' \tabular{rl}{ -#' `$x` \tab: time\cr -#' `$y.t` \tab: transformed count values\cr -#' `$x.t` \tab: transformed time values \cr -#' `$method` \tab: used method for the production of the new data points -#' } -#' -#' @note -#' According to Bos & Wallinga (2012), the number of extrapolated points -#' should be limited to avoid artificial intensity data. If `P` is -#' provided manually, not more than two points are extrapolated. -#' -#' @section Function version: 0.2.1 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' Based on comments and suggestions from:\cr -#' Adrie J.J. Bos, Delft University of Technology, The Netherlands -#' -#' @seealso [CW2pLM], [CW2pLMi], [CW2pHMi], [fit_LMCurve], [RLum.Data.Curve-class] -#' -#' @references -#' Bos, A.J.J. & Wallinga, J., 2012. How to visualize quartz OSL -#' signal components. Radiation Measurements, 47, 752-758. -#' -#' **Further Reading** -#' -#' Bulur, E., 1996. An Alternative Technique For -#' Optically Stimulated Luminescence (OSL) Experiment. Radiation Measurements, -#' 26, 701-709. -#' -#' Bulur, E., 2000. A simple transformation for converting CW-OSL curves to -#' LM-OSL curves. Radiation Measurements, 32, 141-145. -#' -#' @keywords manip -#' -#' @examples -#' -#' -#' ##(1) -#' ##load CW-OSL curve data -#' data(ExampleData.CW_OSL_Curve, envir = environment()) -#' -#' ##transform values -#' values.transformed <- CW2pPMi(ExampleData.CW_OSL_Curve) -#' -#' ##plot -#' plot(values.transformed$x,values.transformed$y.t, log = "x") -#' -#' ##(2) - produce Fig. 4 from Bos & Wallinga (2012) -#' -#' ##load data -#' data(ExampleData.CW_OSL_Curve, envir = environment()) -#' values <- CW_Curve.BosWallinga2012 -#' -#' ##open plot area -#' plot(NA, NA, -#' xlim = c(0.001,10), -#' ylim = c(0,8000), -#' ylab = "pseudo OSL (cts/0.01 s)", -#' xlab = "t [s]", -#' log = "x", -#' main = "Fig. 4 - Bos & Wallinga (2012)") -#' -#' values.t <- CW2pLMi(values, P = 1/20) -#' lines(values[1:length(values.t[,1]),1],CW2pLMi(values, P = 1/20)[,2], -#' col = "red",lwd = 1.3) -#' text(0.03,4500,"LM", col = "red", cex = .8) -#' -#' values.t <- CW2pHMi(values, delta = 40) -#' lines(values[1:length(values.t[,1]),1], CW2pHMi(values, delta = 40)[,2], -#' col = "black", lwd = 1.3) -#' text(0.005,3000,"HM", cex = .8) -#' -#' values.t <- CW2pPMi(values, P = 1/10) -#' lines(values[1:length(values.t[,1]),1], CW2pPMi(values, P = 1/10)[,2], -#' col = "blue", lwd = 1.3) -#' text(0.5,6500,"PM", col = "blue", cex = .8) -#' -#' @md -#' @export -CW2pPMi<- function( - values, - P -){ - - # (0) Integrity checks ------------------------------------------------------ - - ##(1) data.frame or RLum.Data.Curve object? - if(is(values, "data.frame") == FALSE & is(values, "RLum.Data.Curve") == FALSE){ - stop("[CW2pPMi()] 'values' object has to be of type 'data.frame' or 'RLum.Data.Curve'!", call. = FALSE) - - } - - ##(2) if the input object is an 'RLum.Data.Curve' object check for allowed curves - if(is(values, "RLum.Data.Curve") == TRUE){ - - if(!grepl("OSL", values@recordType) & !grepl("IRSL", values@recordType)){ - stop(paste("[CW2pPMi()] recordType ",values@recordType, " is not allowed for the transformation!", - sep=""), call. = FALSE) - - }else{ - - temp.values <- as(values, "data.frame") - - } - - }else{ - - temp.values <- values - - } - - - # (3) Transform values ------------------------------------------------------ - - ##log transformation of the CW-OSL count values - CW_OSL.log<-log(temp.values[,2]) - - ##time transformation t >> t' - t<-temp.values[,1] - - ##set P - ##if no values for P is set selected a P value for a maximum of - ##two extrapolation points - if(missing(P)==TRUE){ - - i<-1 - P<-1/i - t.transformed<-(1/3)*(1/P^2)*t^3 - - while(length(t.transformed[t.transformed2){ - - P<-1/i - t.transformed<-(1/3)*(1/P^2)*t^3 - i<-i+1 - - } - }else{ - - t.transformed<-(1/3)*(1/P^2)*t^3 - - } - - # (4) Interpolation --------------------------------------------------------- - - - ##interpolate values, values beyond the range return NA values - CW_OSL.interpolated <- approx(t, CW_OSL.log, xout=t.transformed, rule=1 ) - - ##combine t.transformed and CW_OSL.interpolated in a data.frame - temp<-data.frame(x=t.transformed, y = unlist(CW_OSL.interpolated$y)) - - - # (5) Extrapolate first values of the curve --------------------------------- - - ##(a) - find index of first rows which contain NA values (needed for extrapolation) - temp.sel.id<-min(which(is.na(temp[,2])==FALSE)) - - ##(b) - fit linear function - fit.lm<-lm(y ~ x,data.frame(x=t[1:2],y=CW_OSL.log[1:2])) - - ##select values to extrapolate and predict (extrapolate) values based on the fitted function - x.i<-data.frame(x=temp[1:(min(temp.sel.id)-1),1]) - y.i<-predict(fit.lm,x.i) - - ##replace NA values by extrapolated values - temp[1:length(y.i),2]<-y.i - - ##set method values - temp.method<-c(rep("extrapolation",length(y.i)),rep("interpolation",(length(temp[,2])-length(y.i)))) - - - ##print a warning message for more than two extrapolation points - if(temp.sel.id>2){warning("t' is beyond the time resolution. Only two data points have been extrapolated, the first ",temp.sel.id-3, " points have been set to 0!")} - - # (6) Convert, transform and combine values --------------------------------- - - ##unlog CW-OSL count values, i.e. log(CW) >> CW - CW_OSL<-exp(temp$y) - - ##transform CW-OSL values to pPM-OSL values - - pPM<-(t^2/P^2)*CW_OSL - - ##combine all values and exclude NA values - temp.values <- data.frame(x=t, y.t=pPM, x.t=t.transformed, method=temp.method) - temp.values <- na.exclude(temp.values) - - # (7) Return values --------------------------------------------------------- - - ##returns the same data type as the input - if(is(values, "data.frame") == TRUE){ - - values <- temp.values - return(values) - - }else{ - - - ##add old info elements to new info elements - temp.info <- c(values@info, - CW2pPMi.x.t = list(temp.values$x.t), - CW2pPMi.method = list(temp.values$method)) - - newRLumDataCurves.CW2pPMi <- set_RLum( - class = "RLum.Data.Curve", - recordType = values@recordType, - data = as.matrix(temp.values[,1:2]), - info = temp.info) - return(newRLumDataCurves.CW2pPMi) - - } - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/Luminescence-package.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/Luminescence-package.R deleted file mode 100644 index 583f82f89..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/Luminescence-package.R +++ /dev/null @@ -1,1342 +0,0 @@ -#' @title Comprehensive Luminescence Dating Data Analysis\cr -#' -#' -#' \if{html}{ -#' \figure{Luminescence_logo.png}{options: width="75" alt="r-luminescence.org"} -#' } -#' -#' @description A collection of various R functions for the purpose of luminescence dating -#' data analysis. This includes, amongst others, data import, export, -#' application of age models, curve deconvolution, sequence analysis and -#' plotting of equivalent dose distributions. -#' -#' @name Luminescence-package -#' -#' @aliases Luminescence-package Luminescence -#' -#' @details -#' -#' **Supervisor of the initial version in 2012** -#' -#' Markus Fuchs, Justus-Liebig-University Giessen, Germany -#' -#' **Support contact** -#' -#' * \email{developers@@r-luminescence.org} -#' * [https://github.com/R-Lum/Luminescence/discussions]() -#' -#' **Bug reporting** -#' -#' * \email{developers@@r-luminescence.org} or -#' * [https://github.com/R-Lum/Luminescence/issues]() -#' -#' **Project website** -#' -#' * [https://r-luminescence.org]() -#' -#' **Project source code repository** -#' -#' * [https://github.com/R-Lum/Luminescence]() -#' -#' **Related package projects** -#' -#' * [https://cran.r-project.org/package=RLumShiny]() -#' * [https://cran.r-project.org/package=RLumModel]() -#' * [https://cran.r-project.org/package=RLumCarlo]() -#' * [https://cran.r-project.org/package=RCarb]() -#' -#' **Funding** -#' -#' * 2011-2013: The initial version of the package was developed, while Sebastian Kreutzer -#' was funded through the DFG programme "Rekonstruktion der Umweltbedingungen -#' des Spätpleistozäns in Mittelsachsen anhand von Löss-Paläobodensequenzen" -#' (DFG id: 46526743) -#' -#' * 2014-2018: Cooperation and personal exchange between the developers is gratefully -#' funded by the DFG (SCHM 3051/3-1) in the framework of the program -#' "Scientific Networks". Project title: "RLum.Network: Ein -#' Wissenschaftsnetzwerk zur Analyse von Lumineszenzdaten mit R" (2014-2018) -#' -#' * 05/2014-12/2019: The work of Sebastian Kreutzer as maintainer of the package was supported -#' by LabEx LaScArBx (ANR - n. ANR-10-LABX-52). -#' -#' * 01/2020-04/2022: Sebastian Kreutzer as maintainer of the package has received funding -#' from the European Union’s Horizon 2020 research and innovation programme under -#' the Marie Skłodowska-Curie grant agreement No 844457 (CREDit), and could continue -#' maintaining the package. -#' -#' * since 03/2023: Sebastian Kreutzer as maintainer of the package receives funding from the -#' DFG Heisenberg programme No 505822867. -#' -#' * All other authors gratefully received additional funding from various public funding bodies. -#' -#' @references -#' Dietze, M., Kreutzer, S., Fuchs, M.C., Burow, C., Fischer, M., -#' Schmidt, C., 2013. A practical guide to the R package Luminescence. -#' Ancient TL, 31 (1), 11-18. -#' -#' Dietze, M., Kreutzer, S., Burow, C., Fuchs, M.C., Fischer, M., Schmidt, C., 2016. The abanico plot: -#' visualising chronometric data with individual standard errors. Quaternary Geochronology 31, 1-7. -#' https://doi.org/10.1016/j.quageo.2015.09.003 -#' -#' Fuchs, M.C., Kreutzer, S., Burow, C., Dietze, M., Fischer, M., Schmidt, C., -#' Fuchs, M., 2015. Data processing in luminescence dating analysis: An -#' exemplary workflow using the R package 'Luminescence'. Quaternary -#' International, 362,8-13. https://doi.org/10.1016/j.quaint.2014.06.034 -#' -#' Kreutzer, S., Schmidt, C., Fuchs, M.C., Dietze, M., Fischer, M., Fuchs, M., -#' 2012. Introducing an R package for luminescence dating analysis. Ancient TL, -#' 30 (1), 1-8. -#' -#' Mercier, N., Kreutzer, S., Christophe, C., Guérin, G., Guibert, P., Lahaye, C., Lanos, P., Philippe, A., -#' Tribolo, C., 2016. Bayesian statistics in luminescence dating: The 'baSAR'-model and its -#' implementation in the R package ’Luminescence’. Ancient TL 34 (2), 14-21. -#' -#' Mercier, N., Galharret, J.-M., Tribolo, C., Kreutzer, S., Philippe, A., 2022. -#' Luminescence age calculation through Bayesian convolution of equivalent dose -#' and dose-rate distributions: the De_Dr model. -#' Geochronology 4, 297–310. https://doi.org/10.5194/gchron-4-297-2022 -#' -#' Smedley, R.K., 2015. A new R function for the Internal External Uncertainty (IEU) model. -#' Ancient TL, 33 (1), 16-21. -#' -#' King, E.G., Burow, C., Roberts, H., Pearce, N.J.G., 2018. Age determination -#' using feldspar: evaluating fading-correction model performance. Radiation Measurements 119, 58-73. -#' https://doi.org/10.1016/j.radmeas.2018.07.013 -#' -#' @keywords package -#' -#' @import utils methods data.table -#' -#' @importFrom Rcpp evalCpp -#' -#' @importFrom graphics plot plot.default frame abline mtext text lines par layout lines arrows axTicks axis barplot box boxplot contour curve grconvertX grconvertY hist legend persp points polygon rug segments title grid close.screen screen split.screen -#' @importFrom grDevices adjustcolor axisTicks colorRampPalette gray.colors rgb topo.colors xy.coords dev.off -#' @importFrom stats formula approx as.formula complete.cases density dnorm glm lm median na.exclude na.omit nls nls.control pchisq pnorm quantile rnorm runif sd smooth smooth.spline spline t.test uniroot var weighted.mean setNames coef confint predict update residuals fitted qf -#' @importFrom parallel parLapply makeCluster stopCluster -#' @importFrom httr GET accept_json status_code content -#' -#' @useDynLib Luminescence, .registration = TRUE -#' -#' @md -"_PACKAGE" - -#' Base data set of dose-rate conversion factors -#' -#' Collection of published dose-rate conversion factors to convert concentrations -#' of radioactive isotopes to dose rate values. -#' -#' @format -#' -#' A [`list`] with three elements with dose-rate conversion factors -#' sorted by article and radiation type (alpha, beta, gamma): -#' -#' \tabular{ll}{ -#' -#' `AdamiecAitken1998`: \tab -#' Conversion factors from Tables 5 and 6 \cr -#' -#' `Cresswelletal2018`: \tab -#' Conversion factors from Tables 5 and 6 \cr -#' -#' `Guerinetal2011`: \tab -#' Conversion factors from Tables 1, 2 and 3 \cr -#' -#' `Liritzisetal2013`: \tab -#' Conversion factors from Tables 1, 2 and 3 \cr -#' } -#' -#' @section Version: 0.2.0 -#' -#' @references -#' -#' Adamiec, G., Aitken, M.J., 1998. Dose-rate conversion factors: update. -#' Ancient TL 16, 37-46. -#' -#' Cresswell., A.J., Carter, J., Sanderson, D.C.W., 2018. -#' Dose rate conversion parameters: Assessment of nuclear data. -#' Radiation Measurements 120, 195-201. -#' -#' Guerin, G., Mercier, N., Adamiec, G., 2011. Dose-rate conversion -#' factors: update. Ancient TL, 29, 5-8. -#' -#' Liritzis, I., Stamoulis, K., Papachristodoulou, C., Ioannides, K., 2013. -#' A re-evaluation of radiation dose-rate conversion factors. Mediterranean -#' Archaeology and Archaeometry 13, 1-15. -#' -#' -#' @source -#' All gamma conversion factors were carefully read from the tables given in the -#' references above. -#' -#' @keywords datasets -#' -#' @examples -#' -#' ## Load data -#' data("BaseDataSet.ConversionFactors", envir = environment()) -#' -#' @name BaseDataSet.ConversionFactors -#' @md -NULL - -#' @title Base dataset for grain size attenuation data by Guérin et al. (2012) -#' -#' @description Grain size correction data for beta-dose rates -#' published by Guérin et al. (2012). -#' -#'#' @format -#' -#' A [`data.frame`] seven columns and sixteen rows. Column headers -#' are `GrainSize`, `Q_K`, `FS_K`, `Q_Th`, `FS_Th`, `Q_U`, `FS_U`. -#' Grain sizes are quoted in µm (e.g., 20, 40, 60 etc.) -#' -#' @section Version: 0.1.0 -#' -#' @source Guérin, G., Mercier, N., Nathan, R., Adamiec, G., Lefrais, Y., 2012. -#' On the use of the infinite matrix assumption and associated concepts: -#' A critical review. Radiation Measurements, 47, 778-785. -#' -#' @keywords datasets -#' -#' @examples -#' -#' ## load data -#' data("BaseDataSet.GrainSizeAttenuation", envir = environment()) -#' -#' @name BaseDataSet.GrainSizeAttenuation -#' @md -NULL - -#' Base data set of fractional gamma-dose values -#' -#' Collection of (un-)published fractional gamma dose-rate values to scale the -#' gamma-dose rate considering layer-to-layer variations in soil radioactivity. -#' -#' @format -#' -#' A [`list`] with fractional gamma dose-rate values -#' sorted by article: -#' -#' \tabular{ll}{ -#' -#' `Aitken1985`: \tab -#' Fractional gamma-dose values from table H.1 -#' } -#' -#' -#' @section Version: 0.1 -#' -#' @references -#' Aitken, M.J., 1985. Thermoluminescence Dating. Academic Press, London. -#' -#' @source -#' Fractional gamma dose values were carefully read from the tables given in the -#' references above. -#' -#' @keywords datasets -#' -#' @examples -#' -#' ## Load data -#' data("BaseDataSet.FractionalGammaDose", envir = environment()) -#' -#' @name BaseDataSet.FractionalGammaDose -#' @md -NULL - -#' Example data for scale_GammaDose() -#' -#' An example data set for the function `scale_GammaDose()` containing layer -#' specific information to scale the gamma dose rate considering variations in -#' soil radioactivity. -#' -#' @format -#' -#' A [`data.frame`]. Please see `?scale_GammaDose()` for a detailed description -#' of its structure. -#' -#' -#' @section Version: 0.1 -#' -#' @keywords datasets -#' -#' @examples -#' -#' ## Load data -#' data("ExampleData.ScaleGammaDose", envir = environment()) -#' -#' @name ExampleData.ScaleGammaDose -#' @md -NULL - -#' Example data for calc_CobbleDoseRate() -#' -#' An example data set for the function [calc_CobbleDoseRate] containing layer -#' specific information for the cobble to be used in the function. -#' -#' @format -#' -#' A [`data.frame`]. Please see [calc_CobbleDoseRate] for detailed information -#' on the structure of the [data.frame]. -#' -#' @section Version: 0.1.0 -#' -#' @keywords datasets -#' -#' @examples -#' -#' ## Load data -#' data("ExampleData.CobbleData", envir = environment()) -#' -#' @name ExampleData.CobbleData -#' @md -NULL - -#' Base data set for cosmic dose rate calculation -#' -#' Collection of data from various sources needed for cosmic dose rate -#' calculation -#' -#' -#' @format -#' -#' \tabular{ll}{ -#' -#' `values.cosmic.Softcomp`: \tab -#' data frame containing cosmic dose rates -#' for shallow depths (< 167 g cm^-2) obtained using the "AGE" program by -#' Rainer Gruen (cf. Gruen 2009). These data essentially reproduce the graph -#' shown in Fig. 1 of Prescott & Hutton (1988). \cr -#' -#' `values.factor.Altitude`: \tab -#' data frame containing altitude factors -#' for adjusting geomagnetic field-change factors. Values were read from Fig. 1 -#' in Prescott & Hutton (1994). \cr -#' -#' `values.par.FJH`: \tab -#' data frame containing values for parameters F, J -#' and H (read from Fig. 2 in Prescott & Hutton 1994) used in the expression \cr -#' } -#' -#' \deqn{Dc = D0*(F+J*exp((altitude/1000)/H))} -#' -#' @section Version: 0.1 -#' -#' @references -#' Gruen, R., 2009. The "AGE" program for the calculation of luminescence age estimates. -#' Ancient TL, 27, pp. 45-46. -#' -#' Prescott, J.R., Hutton, J.T., 1988. Cosmic ray and gamma ray dosimetry for -#' TL and ESR. Nuclear Tracks and Radiation Measurements, 14, pp. 223-227. -#' -#' Prescott, J.R., Hutton, J.T., 1994. Cosmic ray contributions to dose rates -#' for luminescence and ESR dating: large depths and long-term time variations. -#' Radiation Measurements, 23, pp. 497-500. -#' -#' @source -#' The following data were carefully read from figures in mentioned -#' sources and used for fitting procedures. The derived expressions are used in -#' the function `calc_CosmicDoseRate`. -#' -#' **values.cosmic.Softcomp** -#' -#' \tabular{ll}{ -#' Program: \tab "AGE"\cr -#' Reference: \tab Gruen (2009) \cr -#' Fit: \tab Polynomials in the form of -#' } -#' -#' For depths between 40-167 g cm^-2: -#' -#' \deqn{y = 2*10^-6*x^2-0.0008*x+0.2535} -#' -#' (For depths <40 g cm^-2) -#' -#' \deqn{y = -6*10^-8*x^3+2*10^-5*x^2-0.0025*x+0.2969} -#' -#' **`values.factor.Altitude`** -#' -#' \tabular{ll}{ -#' Reference: \tab Prescott & Hutton (1994) \cr -#' Page: \tab 499 \cr -#' Figure: \tab 1 \cr -#' Fit: \tab 2-degree polynomial in the form of -#' } -#' -#' \deqn{y = -0.026*x^2 + 0.6628*x + 1.0435} -#' -#' -#' **`values.par.FJH`** -#' -#' \tabular{ll}{ -#' Reference: \tab Prescott & Hutton (1994) \cr -#' Page: \tab 500 \cr -#' Figure: \tab 2 \cr -#' Fits: \tab 3-degree polynomials and linear fits -#' } -#' -#' F (non-linear part, \eqn{\lambda} < 36.5 deg.): -#' -#' \deqn{y = -7*10^-7*x^3-8*10^-5*x^2-0.0009*x+0.3988} -#' -#' F (linear part, \eqn{\lambda} > 36.5 deg.): -#' -#' \deqn{y = -0.0001*x + 0.2347} -#' -#' J (non-linear part, \eqn{\lambda} < 34 deg.): -#' -#' \deqn{y = 5*10^-6*x^3-5*10^-5*x^2+0.0026*x+0.5177} -#' -#' J (linear part, \eqn{\lambda} > 34 deg.): -#' -#' \deqn{y = 0.0005*x + 0.7388} -#' -#' H (non-linear part, \eqn{\lambda} < 36 deg.): -#' -#' \deqn{y = -3*10^-6*x^3-5*10^-5*x^2-0.0031*x+4.398} -#' -#' H (linear part, \eqn{\lambda} > 36 deg.): -#' -#' \deqn{y = 0.0002*x + 4.0914} -#' -#' @keywords datasets -#' -#' @examples -#' -#' ##load data -#' data(BaseDataSet.CosmicDoseRate) -#' -#' @name BaseDataSet.CosmicDoseRate -#' @aliases values.cosmic.Softcomp values.factor.Altitude values.par.FJH -#' -#' @md -NULL - - -#' @title Example data from a SAR OSL and SAR TL measurement for the package -#' Luminescence -#' -#' @description Example data from a SAR OSL and TL measurement for package Luminescence -#' directly extracted from a Risoe BIN-file and provided in an object of type -#' [Risoe.BINfileData-class] - -#' @format -#' -#' `CWOSL.SAR.Data`: SAR OSL measurement data -#' -#' `TL.SAR.Data`: SAR TL measurement data -#' -#' Each class object contains two slots: (a) `METADATA` is a [data.frame] with -#' all metadata stored in the BIN file of the measurements and (b) `DATA` -#' contains a list of vectors of the measured data (usually count values). -#' -#' @section Version: 0.1 -#' -#' @references -#' **CWOSL.SAR.Data**: unpublished data -#' -#' **TL.SAR.Data**: unpublished data -#' -#' @source **CWOSL.SAR.Data** -#' -#' \tabular{ll}{ -#' Lab: \tab Luminescence Laboratory Bayreuth \cr -#' Lab-Code: \tab BT607 \cr -#' Location: \tab Saxony/Germany \cr -#' Material: \tab Middle grain quartz measured on aluminium cups on a Risø TL/OSL DA-15 reader\cr -#' Reference: \tab unpublished -#' } -#' -#' **TL.SAR.Data** -#' -#' \tabular{ll}{ -#' Lab: \tab Luminescence Laboratory of Cologne\cr -#' Lab-Code: \tab LP1_5\cr -#' Location: \tab Spain\cr -#' Material: \tab Flint \cr -#' Setup: \tab Risoe TL/OSL DA-20 reader (Filter: Semrock Brightline, HC475/50, N2, unpolished steel discs) \cr -#' Reference: \tab unpublished \cr -#' Remarks: \tab dataset limited to one position -#' } -#' -#' @note -#' Please note that this example data cannot be exported to a BIN-file using the function -#' `writeR2BIN` as it was generated and implemented in the package long time ago. In the meantime -#' the BIN-file format changed. -#' -#' @docType data -#' -#' @keywords datasets -#' -#' @examples -#' -#' ## show first 5 elements of the METADATA and DATA elements in the terminal -#' data(ExampleData.BINfileData, envir = environment()) -#' CWOSL.SAR.Data@@METADATA[1:5,] -#' CWOSL.SAR.Data@@DATA[1:5] -#' -#' @name ExampleData.BINfileData -#' @aliases CWOSL.SAR.Data TL.SAR.Data -#' @md -NULL - - -#' Example CW-OSL curve data for the package Luminescence -#' -#' `data.frame` containing CW-OSL curve data (time, counts) -#' -#' @name ExampleData.CW_OSL_Curve -#' -#' @docType data -#' -#' @format Data frame with 1000 observations on the following 2 variables: -#' -#' -#' - `list("x")`: a numeric vector, time -#' - `list("y")`: a numeric vector, counts -#' -#' -#' @references -#' Baartman, J.E.M., Veldkamp, A., Schoorl, J.M., Wallinga, J., -#' Cammeraat, L.H., 2011. Unravelling Late Pleistocene and Holocene landscape -#' dynamics: The Upper Guadalentin Basin, SE Spain. Geomorphology, 125, -#' 172-185. -#' -#' Bos, A.J.J. & Wallinga, J., 2012. How to visualize quartz OSL signal -#' components. Radiation Measurements, 47, 752-758. -#' -#' @source **ExampleData.CW_OSL_Curve** -#' -#' \tabular{ll}{ -#' Lab: \tab Luminescence Laboratory Bayreuth\cr -#' Lab-Code: \tab BT607\cr -#' Location: \tab Saxony/Germany\cr -#' Material: \tab Middle grain quartz measured on aluminium cups on a Risø TL/OSL DA-15 reader.\cr -#' Reference: \tab unpublished data } -#' -#' **CW_Curve.BosWallinga2012** -#' -#' \tabular{ll}{ -#' Lab: \tab Netherlands Centre for Luminescence Dating (NCL)\cr -#' Lab-Code: \tab NCL-2108077\cr -#' Location: \tab Guadalentin Basin, Spain\cr -#' Material: \tab Coarse grain quartz\cr -#' Reference: \tab Bos & Wallinga (2012) and Baartman et al. (2011) -#' } -#' -#' @keywords datasets -#' -#' @examples -#' -#' data(ExampleData.CW_OSL_Curve, envir = environment()) -#' plot(ExampleData.CW_OSL_Curve) -#' -#' @aliases CW_Curve.BosWallinga2012 ExampleData.CW_OSL_Curve -#' @md -NULL - - - -#' Example portable OSL curve data for the package Luminescence -#' -#' A `list` of [RLum.Analysis-class] objects, each containing -#' the same number of [RLum.Data.Curve-class] objects representing -#' individual OSL, IRSL and dark count measurements of a sample. -#' -#' @name ExampleData.portableOSL -#' -#' @docType data -#' -#' @source -#' -#' **ExampleData.portableOSL** -#' -#' \tabular{ll}{ -#' Lab: \tab Cologne Luminescence Laboratory\cr -#' Lab-Code: \tab `none` \cr -#' Location: \tab Nievenheim/Germany\cr -#' Material: \tab Fine grain quartz \cr -#' Reference: \tab unpublished data -#' } -#' -#' @keywords datasets -#' -#' @examples -#' -#' data(ExampleData.portableOSL, envir = environment()) -#' plot_RLum(ExampleData.portableOSL) -#' -#' @md -NULL - - - -#' Example data for fit_LMCurve() in the package Luminescence -#' -#' Linearly modulated (LM) measurement data from a quartz sample from Norway -#' including background measurement. Measurements carried out in the -#' luminescence laboratory at the University of Bayreuth. -#' -#' @format Two objects (data.frames) with two columns (time and counts). -#' -#' @references -#' Fuchs, M., Kreutzer, S., Fischer, M., Sauer, D., Soerensen, R., 2012. OSL and IRSL -#' dating of raised beach sand deposits along the south-eastern coast of Norway. -#' Quaternary Geochronology, 10, 195-200. -#' -#' @source -#' -#' \tabular{ll}{ -#' Lab: \tab Luminescence Laboratory Bayreuth\cr -#' Lab-Code: \tab BT900\cr -#' Location: \tab Norway\cr -#' Material: \tab Beach deposit, coarse grain quartz measured on aluminium discs on a Risø TL/OSL DA-15 reader\cr -#' } -#' -#' @examples -#' -#' ##show LM data -#' data(ExampleData.FittingLM, envir = environment()) -#' plot(values.curve,log="x") -#' -#' @name ExampleData.FittingLM -#' @aliases values.curve values.curveBG -#' @md -NULL - - -#' Example Lx/Tx data from CW-OSL SAR measurement -#' -#' LxTx data from a SAR measurement for the package Luminescence. -#' -#' @format A [`data.frame`] with 4 columns (Dose, LxTx, LxTx.Error, TnTx). -#' -#' @references unpublished data -#' -#' @source -#' -#' \tabular{ll}{ -#' Lab: \tab Luminescence Laboratory Bayreuth\cr -#' Lab-Code: \tab BT607\cr -#' Location: \tab Ostrau (Saxony-Anhalt/Germany)\cr -#' Material: \tab Middle grain (38-63 \eqn{\mu}m) quartz measured on a Risoe TL/OSL DA-15 reader. -#' } -#' -#' @examples -#' -#' ## plot Lx/Tx data vs dose [s] -#' data(ExampleData.LxTxData, envir = environment()) -#' plot(LxTxData$Dose,LxTxData$LxTx) -#' -#' @name ExampleData.LxTxData -#' @aliases LxTxData -#' @md -NULL - - -#' Example Lx and Tx curve data from an artificial OSL measurement -#' -#' `Lx` and `Tx` data of continuous wave (CW-) OSL signal curves. -#' -#' @format Two [`data.frame`]s containing time and count values. -#' -#' @references unpublished data -#' -#' @source -#' Arbitrary OSL measurement. -#' -#' @examples -#' -#' ##load data -#' data(ExampleData.LxTxOSLData, envir = environment()) -#' -#' ##plot data -#' plot(Lx.data) -#' plot(Tx.data) -#' -#' @name ExampleData.LxTxOSLData -#' @aliases Lx.data Tx.data -#' @md -NULL - -#' Example equivalent dose data from mortar samples -#' -#' Arbitrary data to test the function `calc_EED_Model` -#' -#' @format Two [`data.frame`]s containing De and De error -#' -#' @references unpublished data -#' -#' @source -#' Arbitrary measurements. -#' -#' @examples -#' -#' ##load data -#' data(ExampleData.MortarData, envir = environment()) -#' -#' ##plot data -#' plot(MortarData) -#' -#' @name ExampleData.MortarData -#' @aliases MortarData -#' @md -NULL - -#' Example data as [RLum.Analysis-class] objects -#' -#' Collection of different [RLum.Analysis-class] objects for -#' protocol analysis. -#' -#' @format -#' -#' `IRSAR.RF.Data`: IRSAR.RF.Data on coarse grain feldspar -#' -#' Each object contains data needed for the given protocol analysis. -#' -#' @section Version: 0.1 -#' -#' @references -#' **IRSAR.RF.Data** -#' -#' Kreutzer, S., Lauer, T., Meszner, S., Krbetschek, M.R., Faust, D., Fuchs, -#' M., 2014. Chronology of the Quaternary profile Zeuchfeld in Saxony-Anhalt / -#' Germany - a preliminary luminescence dating study. Zeitschrift fuer -#' Geomorphologie 58, 5-26. doi: 10.1127/0372-8854/2012/S-00112 -#' -#' @source **IRSAR.RF.Data** -#' -#' These data were kindly provided by Tobias Lauer and Matthias Krbetschek. -#' -#' \tabular{ll}{ -#' Lab: \tab Luminescence Laboratory TU Bergakademie Freiberg\cr -#' Lab-Code: \tab ZEU/SA1\cr -#' Location: \tab Zeuchfeld (Zeuchfeld Sandur; Saxony-Anhalt/Germany)\cr -#' Material: \tab K-feldspar (130-200 \eqn{\mu}m)\cr -#' Reference: \tab Kreutzer et al. (2014) -#' } -#' -#' @keywords datasets -#' -#' @examples -#' -#' ##load data -#' data(ExampleData.RLum.Analysis, envir = environment()) -#' -#' ##plot data -#' plot_RLum(IRSAR.RF.Data) -#' -#' @name ExampleData.RLum.Analysis -#' @aliases IRSAR.RF.Data -#' @md -NULL - - -#' Example data as [RLum.Data.Image-class] objects -#' -#' Measurement of Princton Instruments camera imported with the function -#' [read_SPE2R] to R to produce an -#' [RLum.Data.Image-class] object. -#' -#' -#' @format Object of class [RLum.Data.Image-class] -#' -#' @section Version: 0.1 -#' -#' @source -#' **ExampleData.RLum.Data.Image** -#' -#' These data were kindly provided by Regina DeWitt. -#' -#' \tabular{ll}{ -#' Lab.: \tab Department of Physics, East-Carolina University, NC, USA\cr -#' Lab-Code: \tab - \cr -#' Location: \tab - \cr -#' Material: \tab - \cr -#' Reference: \tab - \cr -#' } -#' -#' Image data is a measurement of fluorescent ceiling lights with a cooled -#' Princeton Instruments (TM) camera fitted on Risø DA-20 TL/OSL reader. -#' -#' @keywords datasets -#' -#' @examples -#' -#' ##load data -#' data(ExampleData.RLum.Data.Image, envir = environment()) -#' -#' ##plot data -#' plot_RLum(ExampleData.RLum.Data.Image) -#' -#' @name ExampleData.RLum.Data.Image -#' @md -NULL - - -#' Example data for a SAR OSL measurement and a TL spectrum using a lexsyg -#' reader -#' -#' Example data from a SAR OSL measurement and a TL spectrum for package -#' Luminescence imported from a Freiberg Instruments XSYG file using the -#' function [read_XSYG2R]. -#' -#' @format -#' -#' `OSL.SARMeasurement`: SAR OSL measurement data -#' -#' The data contain two elements: (a) `$Sequence.Header` is a -#' [data.frame] with metadata from the measurement,(b) -#' `Sequence.Object` contains an [RLum.Analysis-class] object -#' for further analysis. -#' -#' `TL.Spectrum`: TL spectrum data -#' -#' [RLum.Data.Spectrum-class] object for further analysis. The -#' spectrum was cleaned from cosmic-rays using the function -#' -#' `apply_CosmicRayRemoval`. Note that no quantum efficiency calibration -#' was performed. -#' -#' @section Version: 0.1 -#' -#' @seealso [read_XSYG2R], [RLum.Analysis-class], [RLum.Data.Spectrum-class], -#' [plot_RLum], [plot_RLum.Analysis], [plot_RLum.Data.Spectrum] -#' -#' @references -#' Unpublished data measured to serve as example data for that -#' package. Location origin of sample BT753 is given here: -#' -#' Fuchs, M., Kreutzer, S., Rousseau, D.D., Antoine, P., Hatte, C., Lagroix, -#' F., Moine, O., Gauthier, C., Svoboda, J., Lisa, L., 2013. The loess sequence -#' of Dolni Vestonice, Czech Republic: A new OSL-based chronology of the Last -#' Climatic Cycle. Boreas, 42, 664--677. -#' -#' @source -#' **OSL.SARMeasurement** -#' -#' \tabular{ll}{ -#' Lab: \tab Luminescence Laboratory Giessen\cr -#' Lab-Code: \tab no code\cr -#' Location: \tab not specified\cr -#' Material: \tab Coarse grain quartz on steel cups on lexsyg research reader\cr -#' Reference: \tab unpublished -#' } -#' -#' **TL.Spectrum** -#' -#' \tabular{ll}{ -#' Lab: \tab Luminescence Laboratory Giessen\cr -#' Lab-Code: \tab BT753\cr -#' Location: \tab Dolni Vestonice/Czech Republic\cr -#' Material: \tab Fine grain polymineral on steel cups on lexsyg research reader\cr -#' Reference: \tab Fuchs et al., 2013 \cr -#' Spectrum: \tab Integration time 19 s, channel time 20 s\cr -#' Heating: \tab 1 K/s, up to 500 deg. C -#' } -#' -#' @keywords datasets -#' -#' @examples -#' ##show data -#' data(ExampleData.XSYG, envir = environment()) -#' -#' ## ========================================= -#' ##(1) OSL.SARMeasurement -#' OSL.SARMeasurement -#' -#' ##show $Sequence.Object -#' OSL.SARMeasurement$Sequence.Object -#' -#' ##grep OSL curves and plot the first curve -#' OSLcurve <- get_RLum(OSL.SARMeasurement$Sequence.Object, -#' recordType="OSL")[[1]] -#' plot_RLum(OSLcurve) -#' -#' ## ========================================= -#' ##(2) TL.Spectrum -#' TL.Spectrum -#' -#' ##plot simple spectrum (2D) -#' plot_RLum.Data.Spectrum(TL.Spectrum, -#' plot.type="contour", -#' xlim = c(310,750), -#' ylim = c(0,300), -#' bin.rows=10, -#' bin.cols = 1) -#' -#' ##plot 3d spectrum (uncomment for usage) -#' # plot_RLum.Data.Spectrum(TL.Spectrum, plot.type="persp", -#' # xlim = c(310,750), ylim = c(0,300), bin.rows=10, -#' # bin.cols = 1) -#' -#' @name ExampleData.XSYG -#' @aliases OSL.SARMeasurement TL.Spectrum -#' @md -NULL - - -#' Example De data sets for the package Luminescence -#' -#' Equivalent dose (De) values measured for a fine grain quartz sample from a -#' loess section in Rottewitz (Saxony/Germany) and for a coarse grain quartz -#' sample from a fluvial deposit in the rock shelter of Cueva Anton -#' (Murcia/Spain). -#' -#' -#' @format A [list] with two elements, each containing a two column [data.frame]: -#' -#' \describe{ -#' `$BT998`: De and De error values for a fine grain quartz -#' sample from a loess section in Rottewitz. -#' -#' `$CA1`: Single grain De -#' and De error values for a coarse grain quartz sample from a fluvial deposit -#' in the rock shelter of Cueva Anton -#' } -#' -#' @references -#' **BT998** -#' -#' Unpublished data -#' -#' **CA1** -#' -#' Burow, C., Kehl, M., Hilgers, A., Weniger, G.-C., Angelucci, D., Villaverde, -#' V., Zapata, J. and Zilhao, J. (2015). Luminescence dating of fluvial -#' deposits in the rock shelter of Cueva Anton, Spain. Geochronometria 52, 107-125. -#' -#' **BT998** -#' -#' \tabular{ll}{ -#' Lab: \tab Luminescence Laboratory Bayreuth\cr -#' Lab-Code: \tab BT998\cr -#' Location: \tab Rottewitz (Saxony/Germany)\cr -#' Material: \tab Fine grain quartz measured on aluminium discs on a Risø TL/OSL DA-15 reader\cr -#' Units: \tab Values are given in seconds \cr -#' Dose Rate: \tab Dose rate of the beta-source at measurement ca. 0.0438 Gy/s +/- 0.0019 Gy/s\cr -#' Measurement Date: \tab 2012-01-27 -#' } -#' -#' **CA1** -#' -#' \tabular{ll}{ -#' Lab: \tab Cologne Luminescence Laboratory (CLL)\cr -#' Lab-Code: \tab C-L2941\cr -#' Location: \tab Cueva Anton (Murcia/Spain)\cr -#' Material: \tab Coarse grain quartz (200-250 microns) measured on single grain discs on a Risoe TL/OSL DA-20 reader\cr -#' Units: \tab Values are given in Gray \cr -#' Measurement Date: \tab 2012 -#' } -#' -#' @keywords datasets -#' -#' @examples -#' -#' ##(1) plot values as histogram -#' data(ExampleData.DeValues, envir = environment()) -#' plot_Histogram(ExampleData.DeValues$BT998, xlab = "De [s]") -#' -#' ##(2) plot values as histogram (with second to gray conversion) -#' data(ExampleData.DeValues, envir = environment()) -#' -#' De.values <- Second2Gray(ExampleData.DeValues$BT998, -#' dose.rate = c(0.0438, 0.0019)) -#' -#' -#' plot_Histogram(De.values, xlab = "De [Gy]") -#' -#' @name ExampleData.DeValues -#' @md -NULL - - -#' Example data for feldspar fading measurements -#' -#' Example data set for fading measurements of the IR50, IR100, IR150 and -#' IR225 feldspar signals of sample UNIL/NB123. It further contains regular equivalent dose -#' measurement data of the same sample, which can be used to apply a -#' fading correction to. -#' -#' -#' @format A [list] with two elements, each containing a further [list] of -#' [data.frame]s containing the data on the fading and equivalent dose measurements: -#' -#' \describe{ -#' `$fading.data`: A named [list] of [data.frame]s, -#' each having three named columns (`LxTx, LxTx.error, timeSinceIrradiation`).\cr -#' `..$IR50`: Fading data of the IR50 signal.\cr -#' `..$IR100`: Fading data of the IR100 signal.\cr -#' `..$IR150`: Fading data of the IR150 signal.\cr -#' `..$IR225`: Fading data of the IR225 signal.\cr -#' -#' -#' `$equivalentDose.data`: A named of [data.frame]s, -#' each having three named columns (`dose, LxTx, LxTx.error`).\cr -#' `..$IR50`: Equivalent dose measurement data of the IR50 signal.\cr -#' `..$IR100`: Equivalent dose measurement data of the IR100 signal.\cr -#' `..$IR150`: Equivalent dose measurement data of the IR150 signal.\cr -#' `..$IR225`: Equivalent dose measurement data of the IR225 signal.\cr -#' } -#' -#' @source -#' -#' These data were kindly provided by Georgina E. King. Detailed information -#' on the sample UNIL/NB123 can be found in the reference given below. The raw -#' data can be found in the accompanying supplementary information. -#' -#' @references -#' -#' King, G.E., Herman, F., Lambert, R., Valla, P.G., Guralnik, B., 2016. -#' Multi-OSL-thermochronometry of feldspar. Quaternary Geochronology 33, 76-87. -#' doi:10.1016/j.quageo.2016.01.004 -#' -#' **Details** -#' -#' \tabular{ll}{ -#' Lab: \tab University of Lausanne \cr -#' Lab-Code: \tab UNIL/NB123 \cr -#' Location: \tab Namche Barwa (eastern Himalayas)\cr -#' Material: \tab Coarse grained (180-212 microns) potassium feldspar \cr -#' Units: \tab Values are given in seconds \cr -#' Lab Dose Rate: \tab Dose rate of the beta-source at measurement ca. 0.1335 +/- 0.004 Gy/s \cr -#' Environmental Dose Rate: \tab 7.00 +/- 0.92 Gy/ka (includes internal dose rate) -#' } -#' -#' -#' @keywords datasets -#' -#' @examples -#' -#' ## Load example data -#' data("ExampleData.Fading", envir = environment()) -#' -#' ## Get fading measurement data of the IR50 signal -#' IR50_fading <- ExampleData.Fading$fading.data$IR50 -#' head(IR50_fading) -#' -#' ## Determine g-value and rho' for the IR50 signal -#' IR50_fading.res <- analyse_FadingMeasurement(IR50_fading) -#' -#' ## Show g-value and rho' results -#' gval <- get_RLum(IR50_fading.res) -#' rhop <- get_RLum(IR50_fading.res, "rho_prime") -#' -#' gval -#' rhop -#' -#' ## Get LxTx values of the IR50 DE measurement -#' IR50_De.LxTx <- ExampleData.Fading$equivalentDose.data$IR50 -#' -#' ## Calculate the De of the IR50 signal -#' IR50_De <- plot_GrowthCurve(IR50_De.LxTx, -#' mode = "interpolation", -#' fit.method = "EXP") -#' -#' ## Extract the calculated De and its error -#' IR50_De.res <- get_RLum(IR50_De) -#' De <- c(IR50_De.res$De, IR50_De.res$De.Error) -#' -#' ## Apply fading correction (age conversion greatly simplified) -#' IR50_Age <- De / 7.00 -#' IR50_Age.corr <- calc_FadingCorr(IR50_Age, g_value = IR50_fading.res) -#' -#' -#' @name ExampleData.Fading -#' @md -NULL - - -#' Example OSL surface exposure dating data -#' -#' A set of synthetic OSL surface exposure dating data to demonstrate the -#' [fit_SurfaceExposure] functionality. See examples to reproduce the data -#' interactively. -#' -#' @details -#' -#' **`$sample_1`** -#' -#' \tabular{ccc}{ -#' **mu** \tab **`sigmaphi`** \tab **age** \cr -#' 0.9 \tab 5e-10 \tab 10000 \cr -#' } -#' -#' **`$sample_2`** -#' -#' \tabular{ccccc}{ -#' **mu** \tab **`sigmaphi`** \tab **age** \tab **Dose rate** \tab **D0** \cr -#' 0.9 \tab 5e-10 \tab 10000 \tab 2.5 \tab 40 \cr -#' } -#' -#' **`$set_1`** -#' -#' \tabular{ccc}{ -#' **mu** \tab **`sigmaphi`** \tab **ages** \cr -#' 0.9 \tab 5e-10 \tab 1e3, 1e4, 1e5, 1e6 \cr -#' } -#' -#' **`$set_2`** -#' -#' \tabular{ccccc}{ -#' **mu** \tab **`sigmaphi`** \tab **ages** \tab **Dose rate** \tab **D0** \cr -#' 0.9 \tab 5e-10 \tab 1e2, 1e3, 1e4, 1e5, 1e6 \tab 1.0 \tab 40 \cr -#' } -#' -#' @format A [list] with 4 elements: -#' -#' \tabular{ll}{ -#' **Element** \tab **Content** \cr -#' `$sample_1` \tab A [data.frame] with 3 columns (depth, intensity, error) \cr -#' `$sample_2` \tab A [data.frame] with 3 columns (depth, intensity, error) \cr -#' `$set_1` \tab A [list] of 4 [data.frame]s, each representing a sample with different ages \cr -#' `$set_2` \tab A [list] of 5 [data.frame]s, each representing a sample with different ages \cr -#' } -#' -#' @references Unpublished synthetic data -#' -#' @source -#' -#' See examples for the code used to create the data sets. -#' -#' @examples -#' -#' ## ExampleData.SurfaceExposure$sample_1 -#' sigmaphi <- 5e-10 -#' age <- 10000 -#' mu <- 0.9 -#' x <- seq(0, 10, 0.1) -#' fun <- exp(-sigmaphi * age * 365.25*24*3600 * exp(-mu * x)) -#' -#' set.seed(666) -#' synth_1 <- data.frame(depth = x, -#' intensity = jitter(fun, 1, 0.1), -#' error = runif(length(x), 0.01, 0.2)) -#' -#' ## VALIDATE sample_1 -#' fit_SurfaceExposure(synth_1, mu = mu, sigmaphi = sigmaphi) -#' -#' -#' -#' -#' ## ExampleData.SurfaceExposure$sample_2 -#' sigmaphi <- 5e-10 -#' age <- 10000 -#' mu <- 0.9 -#' x <- seq(0, 10, 0.1) -#' Ddot <- 2.5 / 1000 / 365.25 / 24 / 60 / 60 # 2.5 Gy/ka in Seconds -#' D0 <- 40 -#' fun <- (sigmaphi * exp(-mu * x) * -#' exp(-(age * 365.25*24*3600) * -#' (sigmaphi * exp(-mu * x) + Ddot/D0)) + Ddot/D0) / -#' (sigmaphi * exp(-mu * x) + Ddot/D0) -#' -#' set.seed(666) -#' synth_2 <- data.frame(depth = x, -#' intensity = jitter(fun, 1, 0.1), -#' error = runif(length(x), 0.01, 0.2)) -#' -#' ## VALIDATE sample_2 -#' fit_SurfaceExposure(synth_2, mu = mu, sigmaphi = sigmaphi, Ddot = 2.5, D0 = D0) -#' -#' -#' -#' ## ExampleData.SurfaceExposure$set_1 -#' sigmaphi <- 5e-10 -#' mu <- 0.9 -#' x <- seq(0, 15, 0.2) -#' age <- c(1e3, 1e4, 1e5, 1e6) -#' set.seed(666) -#' -#' synth_3 <- vector("list", length = length(age)) -#' -#' for (i in 1:length(age)) { -#' fun <- exp(-sigmaphi * age[i] * 365.25*24*3600 * exp(-mu * x)) -#' synth_3[[i]] <- data.frame(depth = x, -#' intensity = jitter(fun, 1, 0.05)) -#' } -#' -#' -#' ## VALIDATE set_1 -#' fit_SurfaceExposure(synth_3, age = age, sigmaphi = sigmaphi) -#' -#' -#' -#' ## ExampleData.SurfaceExposure$set_2 -#' sigmaphi <- 5e-10 -#' mu <- 0.9 -#' x <- seq(0, 15, 0.2) -#' age <- c(1e2, 1e3, 1e4, 1e5, 1e6) -#' Ddot <- 1.0 / 1000 / 365.25 / 24 / 60 / 60 # 2.0 Gy/ka in Seconds -#' D0 <- 40 -#' set.seed(666) -#' -#' synth_4 <- vector("list", length = length(age)) -#' -#' for (i in 1:length(age)) { -#' fun <- (sigmaphi * exp(-mu * x) * -#' exp(-(age[i] * 365.25*24*3600) * -#' (sigmaphi * exp(-mu * x) + Ddot/D0)) + Ddot/D0) / -#' (sigmaphi * exp(-mu * x) + Ddot/D0) -#' -#' synth_4[[i]] <- data.frame(depth = x, -#' intensity = jitter(fun, 1, 0.05)) -#' } -#' -#' -#' ## VALIDATE set_2 -#' fit_SurfaceExposure(synth_4, age = age, sigmaphi = sigmaphi, D0 = D0, Ddot = 1.0) -#' -#' \dontrun{ -#' ExampleData.SurfaceExposure <- list( -#' sample_1 = synth_1, -#' sample_2 = synth_2, -#' set_1 = synth_3, -#' set_2 = synth_4 -#' ) -#' } -#' -#' @keywords datasets -#' @name ExampleData.SurfaceExposure -#' @md -NULL - -#' Example Al2O3:C Measurement Data -#' -#' Measurement data obtained from measuring Al2O3:C chips at the IRAMAT-CRP2A, Université Bordeaux -#' Montaigne in 2017 on a Freiberg Instruments lexsyg SMART reader. -#' The example data used in particular to allow test of the functions -#' developed in framework of the work by Kreutzer et al., 2018. -#' -#' @format Two datasets comprising [RLum.Analysis-class] data imported using the function [read_XSYG2R] -#' -#' \describe{ -#' `data_ITC`: Measurement data to determine the irradiation time correction, the data can -#' be analysed with the function [analyse_Al2O3C_ITC] -#' -#' `data_CrossTalk`: Measurement data obtained while estimating the irradiation cross-talk of the -#' reader used for the experiments. The data can be analysed either with the function -#' [analyse_Al2O3C_CrossTalk] or [analyse_Al2O3C_Measurement] -#' } -#' -#' @note From both datasets unneeded curves have been removed and -#' the number of aliquots have been reduced to a required minimum to keep the file size small, but -#' still being able to run the corresponding functions. -#' -#' @seealso [analyse_Al2O3C_ITC], [analyse_Al2O3C_CrossTalk], [analyse_Al2O3C_Measurement] -#' -#' @references Kreutzer, S., Martin, L., Guérin, G., Tribolo, C., Selva, P., Mercier, N., 2018. -#' Environmental Dose Rate Determination Using a Passive Dosimeter: Techniques and Workflow for alpha-Al2O3:C Chips. -#' Geochronometria 45, 56–67. -#' -#' @keywords datasets -#' -#' @examples -#' -#' ##(1) curves -#' data(ExampleData.Al2O3C, envir = environment()) -#' plot_RLum(data_ITC[1:2]) -#' -#' @name ExampleData.Al2O3C -#' @aliases data_CrossTalk data_ITC -#' @md -NULL - -#' Example TR-OSL data -#' -#' Single TR-OSL curve obtained by Schmidt et al. (under review) for quartz sample BT729 -#' (origin: Trebgast Valley, Germany, quartz, 90-200 µm, unpublished data). -#' -#' @format One [RLum.Data.Curve-class] dataset imported using the function [read_XSYG2R] -#' -#' \describe{ -#' `ExampleData.TR_OSL`: A single [RLum.Data.Curve-class] object with the TR-OSL data -#' -#' } -#' -#' -#' @seealso [fit_OSLLifeTimes] -#' -#' @references Schmidt, C., Simmank, O., Kreutzer, S., under review. -#' Time-Resolved Optically Stimulated Luminescence of Quartz in the Nanosecond Time Domain. Journal -#' of Luminescence, 1-90 -#' -#' @keywords datasets -#' -#' @examples -#' -#' ##(1) curves -#' data(ExampleData.TR_OSL, envir = environment()) -#' plot_RLum(ExampleData.TR_OSL) -#' -#' @name ExampleData.TR_OSL -#' @md -NULL - -#' Collection of External Data -#' -#' @description Description and listing of data provided in the folder `data/extdata` -#' -#' @details -#' The **R** package `Luminescence` includes a number of raw data files, which are mostly used in -#' the example sections of appropriate functions. They are also used internally for testing corresponding -#' functions using the `testthat` package (see files in `tests/testthat/`) to ensure their operational -#' reliability. -#' -#' **Accessibility** -#' -#' If the **R** package `Luminescence` is installed correctly the preferred way to access and use these -#' data from within **R** is as follows: -#' -#' `system.file("extdata/", package = "Luminescence")` -#' -#' **Individual file descriptions** -#' -#' *>>Daybreak_TestFile.DAT/.txt<<* -#' -#' **Type:** raw measurement data \cr -#' **Device:** Daybreak OSL/TL reader\cr -#' **Measurement date:** unknown\cr -#' **Location:** unknown\cr -#' **Provided by:** unknown\cr -#' **Related R function(s):** `read_Daybreak2R()`\cr -#' **Reference:** unknown -#' -#' *>>DorNie_0016.psl<<* -#' -#' **Type:** raw measurement data \cr -#' **Device:** SUERC portable OSL reader \cr -#' **Measurement date:** 19/05/2016 \cr -#' **Location:** Dormagen-Nievenheim, Germany \cr -#' **Provided by:** Christoph Burow (University of Cologne) \cr -#' **Related R function(s):** `read_PSL2R()` \cr -#' **Reference:** unpublished \cr -#' **Additional information:** Sample measured at an archaeological site near \cr -#' Dormagen-Nievenheim (Germany) during a practical course on Luminescence dating in 2016. \cr -#' -#' *>>QNL84_2_bleached.txt*, *QNL84_2_unbleached.txt<<* -#' -#' **Type:** Test data for exponential fits \cr -#' **Reference:** Berger, G.W., Huntley, D.J., 1989. Test data for exponential fits. Ancient TL 7, 43-46. \cr -#' -#' -#' *>>STRB87_1_bleached.txt*, *STRB87_1_unbleached.txt<<* -#' -#' **Type:** Test data for exponential fits \cr -#' **Reference:** Berger, G.W., Huntley, D.J., 1989. Test data for exponential fits. Ancient TL 7, 43-46. -#' -#' *>>XSYG_file.xsyg* -#' -#' **Type:** XSYG-file stump \cr -#' **Info: ** XSYG-file with some basic curves to test functions \cr -#' **Reference:** no reference available -#' -#' -#' @keywords datasets -#' @name extdata -#' @md -NULL - - - diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/PSL2Risoe.BINfileData.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/PSL2Risoe.BINfileData.R deleted file mode 100644 index e570d62ec..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/PSL2Risoe.BINfileData.R +++ /dev/null @@ -1,186 +0,0 @@ -#' Convert portable OSL data to a Risoe.BINfileData object -#' -#' Converts an `RLum.Analysis` object produced by the function `read_PSL2R()` to -#' a `Risoe.BINfileData` object **(BETA)**. -#' -#' This function converts an [RLum.Analysis-class] object that was produced -#' by the [read_PSL2R] function to a [Risoe.BINfileData-class]. -#' The `Risoe.BINfileData` can be used to write a Risoe BIN file via -#' [write_R2BIN]. -#' -#' @param object [RLum.Analysis-class] (**required**): -#' `RLum.Analysis` object produced by [read_PSL2R] -#' -#' @param ... currently not used. -#' -#' @return -#' Returns an S4 [Risoe.BINfileData-class] object that can be used to write a -#' BIN file using [write_R2BIN]. -#' -#' @seealso [RLum.Analysis-class], [RLum.Data.Curve-class], -#' [Risoe.BINfileData-class] -#' -#' @author -#' Christoph Burow, University of Cologne (Germany) -#' -#' @section Function version: 0.0.1 -#' -#' @keywords IO -#' -#' @examples -#' -#' # (1) load and plot example data set -#' data("ExampleData.portableOSL", envir = environment()) -#' plot_RLum(ExampleData.portableOSL) -#' -#' # (2) merge all RLum.Analysis objects into one -#' merged <- merge_RLum(ExampleData.portableOSL) -#' merged -#' -#' # (3) convert to RisoeBINfile object -#' bin <- PSL2Risoe.BINfileData(merged) -#' bin -#' -#' # (4) write Risoe BIN file -#' \dontrun{ -#' write_R2BIN(bin, "~/portableOSL.binx") -#' } -#' -#' @md -#' @export -PSL2Risoe.BINfileData <- function(object, ...) { - - ## INTEGRITY CHECKS ---- - if (!inherits(object, "RLum.Analysis")) - stop("Only objects of class 'RLum.Analysis' are allowed.", call. = FALSE) - if (!all(sapply(object, class) == "RLum.Data.Curve")) - stop("The 'RLum.Analysis' object must only contain objects of class 'RLum.Data.Curve'.", call. = FALSE) - if (!all(sapply(object, function(x) x@originator) == "read_PSL2R")) - stop("Only objects originating from 'read_PSL2R()' are allowed.", call. = FALSE) - - ## EXTRACT CURVE INFORMATION ---- - curves <- get_RLum(object) - - ## COLLECT META INFORMATION ---- - META <- do.call(rbind, lapply(curves, function(x) { - - NPOINTS <- as.integer(x@info$settings$stimulation_time) - LTYPE <- x@info$settings$stimulation_unit - COMMENT <- x@info$settings$measurement - HIGH <- x@info$settings$stimulation_time - DATE <- format(x@info$settings$Date, format = "%d%m%y") - TIME <- x@info$settings$Time - if (nchar(TIME) < 8) - TIME <- paste0("0", TIME) - SAMPLE <- x@info$settings$Sample - FNAME <- x@info$settings$Filename - SEQUENCE <- strtrim(paste(x@info$settings$Run_Name, x@info$settings$Sample_no), 8) - - - return(data.frame(NPOINTS = NPOINTS, - LTYPE = LTYPE, - COMMENT = COMMENT, - HIGH = HIGH, - DATE = DATE, - TIME = TIME, - SAMPLE = SAMPLE, - FNAME = FNAME, - SEQUENCE = SEQUENCE)) - })) - - ## SAVE DATA ---- - DATA <- lapply(curves, function(x) { - as.integer(x@data[ ,2]) - }) - - # SAVE METADATA ---- - METADATA <- data.frame(ID = seq(1, length(curves), 1), - SEL = rep(TRUE, length(curves)), - VERSION = rep(7, length(curves)), - LENGTH = 447 + 4 * META$NPOINTS, - PREVIOUS = 447 + 4 * META$NPOINTS, - NPOINTS = META$NPOINTS, - RUN = seq(1, length(curves), 1), - SET = rep(1, length(curves)), - POSITION = rep(1, length(curves)), - GRAIN = rep(0, length(curves)), - GRAINNUMBER = rep(0, length(curves)), - CURVENO = rep(0, length(curves)), - XCOORD = rep(0, length(curves)), - YCOORD = rep(0, length(curves)), - SAMPLE = META$SAMPLE, - COMMENT = META$COMMENT, - SYSTEMID = rep(0, length(curves)), - FNAME = META$FNAME, - USER = rep("RLum", length(curves)), - TIME = META$TIME, - DATE = META$DATE, - DTYPE = rep("Natural", length(curves)), - BL_TIME = rep(0, length(curves)), - BL_UNIT = rep(0, length(curves)), - NORM1 = rep(0, length(curves)), - NORM2 = rep(0, length(curves)), - NORM3 = rep(0, length(curves)), - BG = rep(0, length(curves)), - SHIFT = rep(0, length(curves)), - TAG = rep(1, length(curves)), - LTYPE = META$LTYPE, - LIGHTSOURCE = rep("None", length(curves)), - LPOWER = rep(100, length(curves)), - LIGHTPOWER = rep(100, length(curves)), - LOW = rep(0, length(curves)), - HIGH = META$HIGH, - RATE = rep(0, length(curves)), - TEMPERATURE = rep(0, length(curves)), - MEASTEMP = rep(0, length(curves)), - AN_TEMP = rep(0, length(curves)), - AN_TIME = rep(0, length(curves)), - TOLDELAY = rep(0, length(curves)), - TOLON = rep(0, length(curves)), - TOLOFF = rep(0, length(curves)), - IRR_TIME = rep(0, length(curves)), - IRR_TYPE = rep(0L, length(curves)), - IRR_UNIT = rep(0, length(curves)), - IRR_DOSERATE = rep(0, length(curves)), - IRR_DOSERATEERR = rep(0, length(curves)), - TIMESINCEIRR = rep(-1, length(curves)), - TIMETICK = rep(1e-07, length(curves)), - ONTIME = rep(0, length(curves)), - OFFTIME = rep(NA, length(curves)), - STIMPERIOD = rep(0, length(curves)), - GATE_ENABLED = rep(0, length(curves)), - ENABLE_FLAGS = rep(0, length(curves)), - GATE_START = rep(0, length(curves)), - GATE_STOP = rep(0, length(curves)), - PTENABLED = rep(0, length(curves)), - DTENABLED = rep(0, length(curves)), - DEADTIME = rep(0, length(curves)), - MAXLPOWER = rep(0, length(curves)), - XRF_ACQTIME = rep(0, length(curves)), - XRF_HV = rep(0, length(curves)), - XRF_CURR = rep(0, length(curves)), - XRF_DEADTIMEF = rep(0, length(curves)), - SEQUENCE = META$SEQUENCE, - DETECTOR_ID = rep(NA, length(curves)), - LOWERFILTER_ID = rep(NA, length(curves)), - UPPERFILTER_ID = rep(NA, length(curves)), - ENOISEFACTOR = rep(NA, length(curves)), - MARKPOS_X1 = rep(0, length(curves)), - MARKPOS_Y1 = rep(0, length(curves)), - MARKPOS_X2 = rep(0, length(curves)), - MARKPOS_Y2 = rep(0, length(curves)), - MARKPOS_X3 = rep(0, length(curves)), - MARKPOS_Y3 = rep(0, length(curves)), - EXTR_START = rep(0, length(curves)), - EXTR_END = rep(0, length(curves)), - RECTYPE = rep(0, length(curves))) - - ## CREATE Risoe.BINfileData OBJECT ---- - bin <- set_Risoe.BINfileData(METADATA = METADATA, - DATA = DATA, - .RESERVED = list()) - - - ## RETURN VALUE ---- - return(bin) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RLum-class.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RLum-class.R deleted file mode 100644 index 4c5d7c608..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RLum-class.R +++ /dev/null @@ -1,104 +0,0 @@ -#' @include replicate_RLum.R RcppExports.R -NULL - -#' Class `"RLum"` -#' -#' Abstract class for data in the package Luminescence -#' Subclasses are: -#' -#' **RLum-class**\cr -#' |\cr -#' |----[RLum.Data-class]\cr -#' |----|-- [RLum.Data.Curve-class]\cr -#' |----|-- [RLum.Data.Spectrum-class]\cr -#' |----|-- [RLum.Data.Image-class]\cr -#' |----[RLum.Analysis-class]\cr -#' |----[RLum.Results-class] -#' -#' @name RLum-class -#' -#' @docType class -#' -#' @slot originator -#' Object of class [character] containing the name of the producing -#' function for the object. Set automatically by using the function [set_RLum]. -#' -#' @slot info -#' Object of class [list] for additional information on the object itself -#' -#' @slot .uid -#' Object of class [character] for a unique object identifier. This id is -#' usually calculated using the internal function `create_UID()` if the function [set_RLum] -#' is called. -#' -#' @slot .pid -#' Object of class [character] for a parent id. This allows nesting RLum-objects -#' at will. The parent id can be the uid of another object. -#' -#' @note `RLum` is a virtual class. -#' -#' @section Objects from the Class: -#' A virtual Class: No objects can be created from it. -#' -#' @section Class version: 0.4.0 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum.Data-class], [RLum.Data.Curve-class], [RLum.Data.Spectrum-class], [RLum.Data.Image-class], -#' [RLum.Analysis-class], [RLum.Results-class], [methods_RLum] -#' -#' @keywords classes -#' -#' @examples -#' -#' showClass("RLum") -#' -#' @md -#' @export -setClass("RLum", - slots = list( - originator = "character", - info = "list", - .uid = "character", - .pid = "character" - ), - contains = "VIRTUAL", - prototype = prototype( - originator = NA_character_, - info = list(), - .uid = NA_character_, - .pid = NA_character_ - ) - ) - - -# replication method for object class ------------------------------------------ - -#' @describeIn RLum -#' Replication method RLum-objects -#' -#' @param object [RLum-class] (**required**): -#' an object of class [RLum-class] -#' -#' @param times [integer] (*optional*): -#' number for times each element is repeated element -#' -#' @md -#' @export -setMethod( - "replicate_RLum", - "RLum", - definition = function(object, times = NULL) { - - ##The case this is NULL - if (is.null(times)) { - times <- 1 - } - - lapply(1:times, function(x) { - object - - }) - - } -) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RLum.Analysis-class.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RLum.Analysis-class.R deleted file mode 100644 index bb3baae22..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RLum.Analysis-class.R +++ /dev/null @@ -1,800 +0,0 @@ -#' @include get_RLum.R set_RLum.R length_RLum.R structure_RLum.R names_RLum.R smooth_RLum.R -NULL - -#' Class `"RLum.Analysis"` -#' -#' Object class to represent analysis data for protocol analysis, i.e. all curves, -#' spectra etc. from one measurements. Objects from this class are produced, -#' by e.g. [read_XSYG2R], [read_Daybreak2R] -#' -#' -#' @name RLum.Analysis-class -#' -#' @docType class -#' -#' @slot protocol -#' Object of class [character] describing the applied measurement protocol -#' -#' @slot records -#' Object of class [list] containing objects of class [RLum.Data-class] -#' -#' @note -#' The method [structure_RLum] is currently just available for objects -#' containing [RLum.Data.Curve-class]. -#' -#' @section Objects from the Class: -#' Objects can be created by calls of the form `set_RLum("RLum.Analysis", ...)`. -#' -#' @section Class version: 0.4.16 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [Risoe.BINfileData2RLum.Analysis], -#' [Risoe.BINfileData-class], [RLum-class] -#' -#' @keywords classes methods -#' -#' @examples -#' -#' showClass("RLum.Analysis") -#' -#' ##set empty object -#' set_RLum(class = "RLum.Analysis") -#' -#' ###use example data -#' ##load data -#' data(ExampleData.RLum.Analysis, envir = environment()) -#' -#' ##show curves in object -#' get_RLum(IRSAR.RF.Data) -#' -#' ##show only the first object, but by keeping the object -#' get_RLum(IRSAR.RF.Data, record.id = 1, drop = FALSE) -#' -#' @keywords internal -#' -#' @md -#' @export -setClass("RLum.Analysis", - slots = list( - protocol = "character", - records = "list" - ), - contains = "RLum", - prototype = list ( - protocol = NA_character_, - records = list() - ) -) - - -# as() ----------------------------------------------------------------------------------------- -##LIST -##COERCE RLum.Analyse >> list AND list >> RLum.Analysis -#' as() - RLum-object coercion -#' -#' for `[RLum.Analysis-class]` -#' -#' **[RLum.Analysis-class]** -#' -#' \tabular{ll}{ -#' **from** \tab **to**\cr -#' `list` \tab `list`\cr -#' } -#' -#' Given that the [list] consists of [RLum.Analysis-class] objects. -#' -#' @md -#' @name as -setAs("list", "RLum.Analysis", - function(from,to){ - new(to, - protocol = NA_character_, - records = from) - }) - -setAs("RLum.Analysis", "list", - function(from){ - lapply(1:length(from@records), function(x){ - from@records[[x]] - - }) - }) - - -# show() -------------------------------------------------------------------------------------- -#' @describeIn RLum.Analysis -#' Show structure of `RLum.Analysis` object -#' -#' @md -#' @export -setMethod("show", - signature(object = "RLum.Analysis"), - function(object){ - - ##print - cat("\n [RLum.Analysis-class]") - - ##show slot originator, for compatibly reasons with old example data, here - ##a check - if(.hasSlot(object, "originator")){cat("\n\t originator:", paste0(object@originator,"()"))} - - cat("\n\t protocol:", object@protocol) - cat("\n\t additional info elements: ", if(.hasSlot(object, "info")){length(object@info)}else{0}) - cat("\n\t number of records:", length(object@records)) - - #skip this part if nothing is included in the object - if(length(object@records) > 0){ - ##get object class types - temp <- vapply(object@records, function(x){ - class(x)[1] - - }, FUN.VALUE = vector(mode = "character", length = 1)) - - ##print object class types - lapply(1:length(table(temp)), function(x){ - - ##show RLum class type - cat("\n\t .. :", names(table(temp)[x]),":",table(temp)[x]) - - ##show structure - ##set width option ... just an implementation for the tutorial output - if(getOption("width")<=50) temp.width <- 4 else temp.width <- 7 - - ##set line break variable - linebreak <- FALSE - env <- environment() - - ##create terminal output - terminal_output <- - vapply(1:length(object@records), function(i) { - if (names(table(temp)[x]) == is(object@records[[i]])[1]) { - if (i %% temp.width == 0 & i != length(object@records)) { - assign(x = "linebreak", value = TRUE, envir = env) - } - - ##FIRST - first <- paste0("#", i, " ", object@records[[i]]@recordType) - - ##LAST - if (i < length(object@records) && - !is.null(object@records[[i]]@info[["parentID"]]) && - !is.null(object@records[[i + 1]]@info[["parentID"]]) && - (object@records[[i]]@info[["parentID"]] == - object@records[[i+1]]@info[["parentID"]])) { - last <- " <> " - - }else { - last <- " | " - if (i == length(object@records)) { - last <- "" - - } else if (linebreak) { - last <- "\n\t .. .. : " - assign(x = "linebreak", value = FALSE, envir = env) - - } - - } - return(paste0(first,last)) - - }else{ - return("") - - } - - }, FUN.VALUE = vector(mode = "character", length = 1)) - - ##print on screen, differentiate between records with many - ##curves or just one - if(any(grepl(terminal_output, pattern = "<>", fixed = TRUE))){ - cat("\n\t .. .. : ", - gsub(pattern = "|", replacement = "\n\t .. .. :", - x = terminal_output, fixed = TRUE), sep = "") - - } else{ - cat("\n\t .. .. : ", terminal_output, sep = "") - - } - - }) - - }else{ - cat("\n\t >> This is an empty object, which cannot be used for further analysis! <<") - - } - } -)##end show method - -# set_RLum() ---------------------------------------------------------------------------------- -#' @describeIn RLum.Analysis -#' Construction method for [RLum.Analysis-class] objects. -#' -#' @param class [`set_RLum`] [character] (**required**): -#' name of the `RLum` class to be created -#' -#' @param originator [`set_RLum`] [character] (*automatic*): -#' contains the name of the calling function (the function that produces this object); -#' can be set manually. -#' -#' @param .uid [`set_RLum`] [character] (*automatic*): -#' sets an unique ID for this object using the internal C++ function `create_UID`. -#' -#' @param .pid [`set_RLum`] [character] (*with default*): -#' option to provide a parent id for nesting at will. -#' -#' @param protocol [`set_RLum`] [character] (*optional*): -#' sets protocol type for analysis object. Value may be used by subsequent analysis functions. -#' -#' @param records [`set_RLum`] [list] (**required**): -#' list of [RLum.Analysis-class] objects -#' -#' @param info [`set_RLum`] [list] (*optional*): -#' a list containing additional info data for the object -#' -#' **`set_RLum`**: -#' -#' Returns an [RLum.Analysis-class] object. -#' -#' @md -#' @export -setMethod( - "set_RLum", - signature = "RLum.Analysis", - definition = function( - class, - originator, - .uid, - .pid, - protocol = NA_character_, - records = list(), - info = list()) { - - ##produce empty class object - newRLumAnalysis <- new(Class = "RLum.Analysis") - - ##allow self set to reset an RLum.Analysis object - if(inherits(records, "RLum.Analysis")){ - #fill slots (this is much faster than the old code!) - newRLumAnalysis@protocol <- if(missing(protocol)){records@protocol}else{protocol} - newRLumAnalysis@originator <- originator - newRLumAnalysis@records <- records@records - newRLumAnalysis@info <- if(missing(info)){records@info}else{c(records@info, info)} - newRLumAnalysis@.uid <- .uid - newRLumAnalysis@.pid <- if(missing(.pid)){records@.uid}else{.pid} - - }else{ - #fill slots (this is much faster than the old code!) - newRLumAnalysis@protocol <- protocol - newRLumAnalysis@originator <- originator - newRLumAnalysis@records <- records - newRLumAnalysis@info <- info - newRLumAnalysis@.uid <- .uid - newRLumAnalysis@.pid <- .pid - - } - - return(newRLumAnalysis) - - } -) - -# get_RLum() ---------------------------------------------------------------------------------- -#' @describeIn RLum.Analysis -#' Accessor method for RLum.Analysis object. -#' -#' The slots record.id, `@recordType`, `@curveType` and `@RLum.type` are optional to allow for records -#' limited by their id (list index number), their record type (e.g. `recordType = "OSL"`) -#' or object type. -#' -#' Example: curve type (e.g. `curveType = "predefined"` or `curveType ="measured"`) -#' -#' The selection of a specific RLum.type object superimposes the default selection. -#' Currently supported objects are: RLum.Data.Curve and RLum.Data.Spectrum -#' -#' @param object [`get_RLum`]: [`names_RLum`], [`length_RLum`], [`structure_RLum`] (**required**): -#' an object of class [RLum.Analysis-class] -#' -#' @param record.id [`get_RLum`]: [numeric] or [logical] (*optional*): -#' IDs of specific records. If of type `logical` the entire id range is assumed -#' and `TRUE` and `FALSE` indicates the selection. -#' -#' @param recordType [`get_RLum`]: [character] (*optional*): -#' record type (e.g., "OSL"). Can be also a vector, for multiple matching, -#' e.g., `recordType = c("OSL", "IRSL")` -#' -#' @param curveType [`get_RLum`]: [character] (*optional*): -#' curve type (e.g. "predefined" or "measured") -#' -#' @param RLum.type [`get_RLum`]: [character] (*optional*): -#' RLum object type. Defaults to "RLum.Data.Curve" and "RLum.Data.Spectrum". -#' -#' @param get.index [`get_RLum`]: [logical] (*optional*): -#' return a numeric vector with the index of each element in the RLum.Analysis object. -#' -#' @param recursive [`get_RLum`]: [logical] (*with default*): -#' if `TRUE` (the default) and the result of the `get_RLum()` request is a single -#' object this object will be unlisted, means only the object itself and no -#' list containing exactly one object is returned. Mostly this makes things -#' easier, however, if this method is used within a loop this might be undesired. -#' -#' @param drop [`get_RLum`]: [logical] (*with default*): -#' coerce to the next possible layer (which are `RLum.Data`-objects), -#' `drop = FALSE` keeps the original `RLum.Analysis` -#' -#' @param info.object [`get_RLum`]: [character] (*optional*): -#' name of the wanted info element -#' -#' @param subset [`get_RLum`]: [expression] (*optional*): -#' logical expression indicating elements or rows to keep: missing values are -#' taken as false. This argument takes precedence over all other arguments, -#' meaning they are not considered when subsetting the object. -#' -#' @param env [`get_RLum`]: [environment] (*with default*): -#' An environment passed to [eval] as the enclosure. This argument is only -#' relevant when subsetting the object and should not be used manually. -#' -#' @return -#' -#' **`get_RLum`**: -#' -#' Returns: -#' -#' 1. [list] of [RLum.Data-class] objects or -#' 2. Single [RLum.Data-class] object, if only one object is contained and `recursive = FALSE` or -#' 3. [RLum.Analysis-class] objects for `drop = FALSE` -#' -#' @md -#' @export -setMethod("get_RLum", - signature = ("RLum.Analysis"), - - function(object, record.id = NULL, recordType = NULL, curveType = NULL, RLum.type = NULL, - protocol = "UNKNOWN", get.index = NULL, drop = TRUE, recursive = TRUE, info.object = NULL, subset = NULL, env = parent.frame(2)) { - - if (!is.null(substitute(subset))) { - - # To account for different lengths and elements in the @info slot we first - # check all unique elements (in all records) - info_el <- unique(unlist(lapply(object@records, function(el) names(el@info)))) - - envir <- as.data.frame(do.call(rbind, - lapply(object@records, function(el) { - val <- c(curveType = el@curveType, recordType = el@recordType, unlist(el@info)) - - # add missing info elements and set NA - if (any(!info_el %in% names(val))) { - val_new <- setNames(rep(NA, length(info_el[!info_el %in% names(val)])), info_el[!info_el %in% names(val)]) - val <- c(val, val_new) - - } - - # order the named char vector by its names so we don't mix up the columns - val <- val[order(names(val))] - return(val) - }) - ), stringsAsFactors = FALSE) - - ##select relevant rows - sel <- tryCatch(eval( - expr = substitute(subset), - envir = envir, - enclos = env - ), - error = function(e) { - .throw_error("Invalid subset expression, valid terms are: ", - paste(names(envir), collapse = ", "), nframe = 6) - }) - - if (!is.logical(sel)) { - .throw_error("'subset' must contain a logical expression", - nframe = 2) - } - - if (all(is.na(sel))) - sel <- FALSE - - if (any(sel)) { - object@records <- object@records[sel] - return(object) - } else { - tmp <- mapply(function(name, op) { message(" ",name, ": ", paste(unique(op), collapse = ", ")) }, - names(envir), envir) - message("\n [get_RLum()] 'subset' expression produced an ", - "empty selection, NULL returned") - return(NULL) - } - - } - - ##if info.object is set, only the info objects are returned - else if(!is.null(info.object)) { - if(info.object %in% names(object@info)){ - unlist(object@info[info.object]) - - }else{ - ##check for entries - if(length(object@info) == 0){ - .throw_warning("This 'RLum.Analysis' object has no info ", - "objects, NULL returned", - nframe = 3) - }else{ - .throw_warning("Invalid 'info.object' name, valid names are: ", - paste(names(object@info), collapse = ", "), - nframe = 3) - } - return(NULL) - } - - } else { - - ##check for records - if (length(object@records) == 0) { - - .throw_warning("This 'RLum.Analysis' object has no records, ", - "NULL returned", nframe = 3) - return(NULL) - } - - ##record.id - if (is.null(record.id)) { - record.id <- c(1:length(object@records)) - - } else if (!is.numeric(record.id) & - !is.logical(record.id)) { - .throw_error("'record.id' has to be of type 'numeric' or ", - "'logical'", nframe = 3) - } - ##logical needs a slightly different treatment - ##Why do we need this? Because a lot of standard R functions work with logical - ##values instead of numerical indices - if (is.logical(record.id)) { - record.id <- c(1:length(object@records))[record.id] - - } - - ##check if record.id exists - if (FALSE %in% (abs(record.id) %in% (1:length(object@records)))) { - message("[get_RLum()] Error: At least one 'record.id' ", - "is invalid, NULL returned") - return(NULL) - } - - ##recordType - if (is.null(recordType)) { - recordType <- - unique(vapply(object@records, function(x) - x@recordType, character(1))) - - } else if (!inherits(recordType, "character")){ - .throw_error("'recordType' has to be of type 'character'", - nframe = 3) - } - - ##curveType - if (is.null(curveType)) { - curveType <- unique(unlist(lapply(1:length(object@records), - function(x) { - object@records[[x]]@curveType - }))) - - } else if (!is(curveType, "character")) { - .throw_error("'curveType' has to be of type 'character'", - nframe = 3) - } - - ##RLum.type - if (is.null(RLum.type)) { - RLum.type <- c("RLum.Data.Curve", "RLum.Data.Spectrum", "RLum.Data.Image") - - } else if (!is(RLum.type, "character")) { - .throw_error("'RLum.type' has to be of type 'character'", - nframe = 3) - } - - ##get.index - if (is.null(get.index)) { - get.index <- FALSE - - } else if (!is(get.index, "logical")) { - .throw_error("'get.index' has to be of type 'logical'", - nframe = 3) - } - - ##get originator - if (.hasSlot(object, "originator")) { - originator <- object@originator - - } else{ - originator <- NA_character_ - } - - ##-----------------------------------------------------------------## - ##a pre-selection is necessary to support negative index selection - object@records <- object@records[record.id] - record.id <- 1:length(object@records) - - ##select curves according to the chosen parameter - if (length(record.id) > 1) { - temp <- lapply(record.id, function(x) { - if (is(object@records[[x]])[1] %in% RLum.type == TRUE) { - ##as input a vector is allowed - temp <- lapply(1:length(recordType), function(k) { - ##translate input to regular expression - recordType[k] <- glob2rx(recordType[k]) - recordType[k] <- substr(recordType[k], start = 2, stop = nchar(recordType[k]) - 1) - - if (grepl(recordType[k], object@records[[x]]@recordType) == TRUE & - object@records[[x]]@curveType %in% curveType) { - if (!get.index) { - object@records[[x]] - - } else{ - x - } - } - - }) - - ##remove empty entries and select just one to unlist - temp <- temp[!sapply(temp, is.null)] - - ##if list has length 0 skip entry - if (length(temp) != 0) { - temp[[1]] - } else{ - temp <- NULL - } - } - }) - - - ##remove empty list element - temp <- temp[!sapply(temp, is.null)] - - ##check if the produced object is empty and show warning message - if (length(temp) == 0) - .throw_warning("This request produced an empty list of records", - nframe = 3) - - ##remove list for get.index - if (get.index) { - return(unlist(temp)) - - } else{ - - if (!drop) { - temp <- set_RLum( - class = "RLum.Analysis", - originator = originator, - records = temp, - protocol = object@protocol, - .pid = object@.pid - ) - return(temp) - - } else{ - if (length(temp) == 1 & recursive == TRUE) { - return(temp[[1]]) - - } else{ - return(temp) - - } - } - } - - } else{ - if (get.index == FALSE) { - if (drop == FALSE) { - ##needed to keep the argument drop == TRUE - temp <- set_RLum( - class = "RLum.Analysis", - originator = originator, - records = list(object@records[[record.id]]), - protocol = object@protocol, - .pid = object@.pid - ) - return(temp) - - } else{ - return(object@records[[record.id]]) - } - - } else{ - return(record.id) - - } - } - } - - }) - -# structure_RLum() ---------------------------------------------------------------------------- -### -#' @describeIn RLum.Analysis -#' Method to show the structure of an [RLum.Analysis-class] object. -#' -#' @param fullExtent [structure_RLum]; [logical] (*with default*): -#' extents the returned `data.frame` to its full extent, i.e. all info elements -#' are part of the return as well. The default value is `FALSE` as the data -#' frame might become rather big. -#' -#' @return -#' -#' **`structure_RLum`**: -#' -#' Returns [data.frame-class] showing the structure. -#' -#' @md -#' @export -setMethod("structure_RLum", - signature= "RLum.Analysis", - definition = function(object, fullExtent = FALSE) { - - ##check if the object containing other elements than allowed - if(!all(vapply(object@records, FUN = class, character(1)) == "RLum.Data.Curve")) - .throw_error("Only 'RLum.Data.Curve' objects are allowed") - - ##get length object - temp.object.length <- length(object@records) - - ##ID - temp.id <- 1:temp.object.length - - ##recordType - temp.recordType <- - vapply(object@records, function(x) { - x@recordType - }, character(1)) - - ##PROTOCOL STEP - temp.protocol.step <- c(NA) - length(temp.protocol.step) <- temp.object.length - - ##n.channels - temp.n.channels <- vapply(object@records, function(x){length(x@data[,1])}, numeric(1)) - - ##X.MIN - temp.x.min <- vapply(object@records, function(x){min(x@data[,1])}, numeric(1)) - - ##X.MAX - temp.x.max <- vapply(object@records, function(x){max(x@data[,1])}, numeric(1)) - - ##y.MIN - temp.y.min <- vapply(object@records, function(x){min(x@data[,2])}, numeric(1)) - - ##X.MAX - temp.y.max <- vapply(object@records, function(x){max(x@data[,2])}, numeric(1)) - - ##.uid - temp.uid <- unlist(lapply(object@records, function(x){x@.uid})) - - ##.pid - temp.pid <- paste( - unlist(lapply(object@records, function(x){x@.pid})), collapse = ", ") - - ##originator - temp.originator <- unlist(lapply(object@records, function(x){x@originator})) - - ##curveType - temp.curveType <- unlist(lapply(object@records, function(x){x@curveType})) - - ##info elements as character value - if (fullExtent) { - temp.info.elements <- as.data.frame(data.table::rbindlist(lapply(object@records, function(x) { - x@info - }), fill = TRUE)) - - if (nrow(temp.info.elements) == 0) { - ## if we are here temp.info.elements 0 rows and 0 columns: - ## to avoid crashing further down in the data.frame() call, - ## we create a data frame with the expected number of rows - temp.info.elements <- data.frame(info = rep(NA, temp.object.length)) - } - } else{ - temp.info.elements <- - unlist(sapply(1:temp.object.length, function(x) { - if (length(object@records[[x]]@info) != 0) { - paste(names(object@records[[x]]@info), collapse = " ") - } else{ - NA - } - - })) - - } - - ##combine output to a data.frame - return( - data.frame( - id = temp.id, - recordType = temp.recordType, - curveType = temp.curveType, - protocol.step = temp.protocol.step, - n.channels = temp.n.channels, - x.min = temp.x.min, - x.max = temp.x.max, - y.min = temp.y.min, - y.max = temp.y.max, - originator = temp.originator, - .uid = temp.uid, - .pid = temp.pid, - info = temp.info.elements, - stringsAsFactors = FALSE - ) - ) - - }) - - -# length_RLum() ------------------------------------------------------------------------------- -#' @describeIn RLum.Analysis -#' Returns the length of the object, i.e., number of stored records. -#' -#' @return -#' -#' **`length_RLum`** -#' -#' Returns the number records in this object. -#' -#' @md -#' @export -setMethod("length_RLum", - "RLum.Analysis", - function(object){ - length(object@records) - - }) - -# names_RLum() -------------------------------------------------------------------------------- -#' @describeIn RLum.Analysis -#' Returns the names of the [RLum.Data-class] objects objects (same as shown with the show method) -#' -#' @return -#' -#' **`names_RLum`** -#' -#' Returns the names of the record types (`recordType`) in this object. -#' -#' @md -#' @export -setMethod("names_RLum", - "RLum.Analysis", - function(object){ - sapply(1:length(object@records), function(x){ - object@records[[x]]@recordType}) - - }) - - -# smooth_RLum() ------------------------------------------------------------------------------- -#' @describeIn RLum.Analysis -#' -#' Smoothing of `RLum.Data` objects contained in this `RLum.Analysis` object -#' [zoo::rollmean] or [zoo::rollmedian][zoo::rollmean]. In particular the internal -#' function `.smoothing` is used. -#' -#' @param ... further arguments passed to underlying methods -#' -#' @return -#' -#' **`smooth_RLum`** -#' -#' Same object as input, after smoothing -#' -#' @md -#' @export -setMethod( - f = "smooth_RLum", - signature = "RLum.Analysis", - function(object, ...) { - object@records <- lapply(object@records, function(x){ - smooth_RLum(x, ...) - - }) - - return(object) - } -) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RLum.Data-class.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RLum.Data-class.R deleted file mode 100644 index e43b4931d..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RLum.Data-class.R +++ /dev/null @@ -1,34 +0,0 @@ -#' @title Class `"RLum.Data"` -#' -#' @description Generalized virtual data class for luminescence data. -#' -#' -#' @name RLum.Data-class -#' -#' @docType class -#' -#' @note Just a virtual class. -#' -#' @section Objects from the Class: -#' A virtual Class: No objects can be created from it. -#' -#' @section Class version: 0.2.1 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum-class], [RLum.Data.Curve-class], -#' [RLum.Data.Spectrum-class], [RLum.Data.Image-class] -#' -#' @keywords classes internal -#' -#' @examples -#' -#' showClass("RLum.Data") -#' -#' @md -#' @export -setClass("RLum.Data", - contains = c("RLum", "VIRTUAL") -) - diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RLum.Data.Curve-class.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RLum.Data.Curve-class.R deleted file mode 100644 index f3bfc0498..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RLum.Data.Curve-class.R +++ /dev/null @@ -1,494 +0,0 @@ -#' @include get_RLum.R set_RLum.R names_RLum.R length_RLum.R bin_RLum.Data.R smooth_RLum.R -NULL - -#' Class `"RLum.Data.Curve"` -#' -#' Class for representing luminescence curve data. -#' -#' @name RLum.Data.Curve-class -#' -#' @docType class -#' -#' @slot recordType -#' Object of class "character" containing the type of the curve (e.g. "TL" or "OSL") -#' -#' @slot curveType -#' Object of class "character" containing curve type, allowed values are measured or predefined -#' -#' @slot data -#' Object of class [matrix] containing curve x and y data. -#' 'data' can also be of type `RLum.Data.Curve` to change object values without -#' de-constructing the object. For example: -#' ``` -#' set_RLum(class = 'RLum.Data.Curve', -#' data = Your.RLum.Data.Curve, -#' recordType = 'never seen before') -#' ``` -#' would just change the `recordType`. Missing arguments the value is taken -#' from the input object in 'data' (which is already an RLum.Data.Curve object -#' in this example) -#' -#' -#' @note -#' The class should only contain data for a single curve. For additional -#' elements the slot `info` can be used (e.g. providing additional heating -#' ramp curve). Objects from the class `RLum.Data.Curve` are produced by other -#' functions (partly within [RLum.Analysis-class] objects), -#' namely: [Risoe.BINfileData2RLum.Analysis], [read_XSYG2R] -#' -#' @section Create objects from this Class: -#' Objects can be created by calls of the form -#' `set_RLum(class = "RLum.Data.Curve", ...)`. -#' -#' @section Class version: 0.5.1 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum-class], [RLum.Data-class], [plot_RLum], [merge_RLum] -#' -#' @keywords classes -#' -#' @examples -#' -#' showClass("RLum.Data.Curve") -#' -#' ##set empty curve object -#' set_RLum(class = "RLum.Data.Curve") -#' -#' @md -#' @export -setClass("RLum.Data.Curve", - slots = list( - recordType = "character", - curveType = "character", - data = "matrix" - ), - contains = "RLum.Data", - prototype = list ( - recordType = NA_character_, - curveType = NA_character_, - data = matrix(data = 0, ncol = 2) - ) - ) - -# as() ---------------------------------------------------------------------------------------- -##LIST -##COERCE RLum.Data.Curve >> list AND list >> RLum.Data.Curve -#' as() - RLum-object coercion -#' -#' for `[RLum.Data.Curve-class]` -#' -#' **[RLum.Data.Curve-class]** -#' -#' \tabular{ll}{ -#' **from** \tab **to**\cr -#' `list` \tab `list` \cr -#' `data.frame` \tab `data.frame`\cr -#' `matrix` \tab `matrix` -#' } -#' -#' @param from [RLum-class], [list], [data.frame], [matrix] (**required**): -#' object to be coerced from -#' -#' @param to [character] (**required**): -#' class name to be coerced to -#' -#' @seealso [methods::as] -#' -#' @note -#' Due to the complex structure of the `RLum` objects itself a coercing to standard -#' R data structures will be always loosely! -#' -#' @md -#' @name as -setAs("list", "RLum.Data.Curve", - function(from,to){ - - new(to, - recordType = "unknown curve type", - curveType = NA_character_, - data = matrix(unlist(from), ncol = 2), - info = list()) - }) - - -setAs("RLum.Data.Curve", "list", - function(from){ - list(x = from@data[,1], y = from@data[,2]) - - }) - -##DATA.FRAME -##COERCE RLum.Data.Curve >> data.frame AND data.frame >> RLum.Data.Curve -setAs("data.frame", "RLum.Data.Curve", - function(from,to){ - - new(to, - recordType = "unknown curve type", - curveType = NA_character_, - data = as.matrix(from), - info = list()) - }) - -setAs("RLum.Data.Curve", "data.frame", - function(from){ - - data.frame(x = from@data[,1], - y = from@data[,2]) - - }) - - -##MATRIX -##COERCE RLum.Data.Curve >> matrix AND matrix >> RLum.Data.Curve -setAs("matrix", "RLum.Data.Curve", - function(from,to){ - new(to, - recordType = "unknown curve type", - curveType = NA_character_, - data = from, - info = list()) - - }) - -setAs("RLum.Data.Curve", "matrix", - function(from){ - from@data - - }) - -# show() -------------------------------------------------------------------------------------- -#' @describeIn RLum.Data.Curve -#' Show structure of `RLum.Data.Curve` object -#' -#' @keywords internal -#' -#' @md -#' @export -setMethod("show", - signature(object = "RLum.Data.Curve"), - function(object){ - - ##print information - cat("\n [RLum.Data.Curve-class]") - cat("\n\t recordType:", object@recordType) - cat("\n\t curveType:", object@curveType) - cat("\n\t measured values:", length(object@data[,1])) - cat("\n\t .. range of x-values:", suppressWarnings(range(object@data[,1]))) - cat("\n\t .. range of y-values:", - suppressWarnings(min(object@data[,2], na.rm = TRUE)), - suppressWarnings(max(object@data[,2], na.rm = TRUE)), - if(anyNA(object@data[,2])){"(contains NA values)"}else{""} - ) - cat("\n\t additional info elements:", length(object@info), "\n") - #cat("\n\t\t >> names:", names(object@info)) - } -) - -# set_RLum() ---------------------------------------------------------------------------------- -#' @describeIn RLum.Data.Curve -#' Construction method for RLum.Data.Curve object. The slot info is optional -#' and predefined as empty list by default. -#' -#' @param class [`set_RLum`]; [character] (**required**): -#' name of the `RLum` class to create -#' -#' @param originator [`set_RLum`]; [character] (*automatic*): -#' contains the name of the calling function (the function that produces this object); -#' can be set manually. -#' -#' @param .uid [`set_RLum`]; [character] (*automatic*): -#' sets an unique ID for this object using the internal C++ function `create_UID`. -#' -#' @param .pid [`set_RLum`]; [character] (*with default*): -#' option to provide a parent id for nesting at will. -#' -#' @param recordType [`set_RLum`]; [character] (*optional*): -#' record type (e.g., "OSL") -#' -#' @param curveType [`set_RLum`]; [character] (*optional*): -#' curve type (e.g., "predefined" or "measured") -#' -#' @param data [`set_RLum`]; [matrix] (**required**): -#' raw curve data. If `data` itself is a `RLum.Data.Curve`-object this can be -#' used to re-construct the object (s. details), i.e. modified parameters except -#' `.uid`, `.pid` and `originator`. The rest will be subject to copy and paste unless provided. -#' -#' @param info [`set_RLum`]; [list] (*optional*): -#' info elements -#' -#' @return -#' -#' **`set_RLum`** -#' -#' Returns an [RLum.Data.Curve-class] object. -#' -#' @md -#' @export -setMethod( - "set_RLum", - signature = signature("RLum.Data.Curve"), - definition = function( - class, - originator, - .uid, - .pid, - recordType = NA_character_, - curveType = NA_character_, - data = matrix(0, ncol = 2), - info = list()) { - - ##The case where an RLum.Data.Curve object can be provided - ##with this RLum.Data.Curve objects can be provided to be reconstructed - if (is(data, "RLum.Data.Curve")) { - ##check for missing curveType - if (missing(curveType)) - curveType <- data@curveType - - ##check for missing recordType - if(missing(recordType)) - recordType <- data@recordType - - ##check for missing data ... not possible as data is the object itself - - ##check for missing info - if(missing(info)) - info <- data@info - - ##check for missing .uid and .pid and originator - ##>> no this is always taken from the old object here - - ##set empty class from object - newRLumDataCurve <- new("RLum.Data.Curve") - - ##fill - this is the faster way, filling in new() costs ... - newRLumDataCurve@recordType <- recordType - newRLumDataCurve@curveType <- curveType - newRLumDataCurve@data <- data@data - newRLumDataCurve@info <- info - newRLumDataCurve@originator <- data@originator - newRLumDataCurve@.uid <- data@.uid - newRLumDataCurve@.pid <- data@.pid - - } else { - - ##set empty class form object - newRLumDataCurve <- new("RLum.Data.Curve") - - ##fill - this is the faster way, filling in new() costs ... - newRLumDataCurve@originator <- originator - newRLumDataCurve@recordType <- recordType - newRLumDataCurve@curveType <- curveType - newRLumDataCurve@data <- data - newRLumDataCurve@info <- info - newRLumDataCurve@.uid <- .uid - newRLumDataCurve@.pid <- .pid - - } - return(newRLumDataCurve) - } -) - -# get_RLum() ---------------------------------------------------------------------------------- -#' @describeIn RLum.Data.Curve -#' Accessor method for RLum.Data.Curve object. The argument info.object is -#' optional to directly access the info elements. If no info element name is -#' provided, the raw curve data (matrix) will be returned. -#' -#' @param object [`get_RLum`], [`length_RLum`], [`names_RLum`] (**required**): -#' an object of class [RLum.Data.Curve-class] -#' -#' @param info.object [`get_RLum`] [character] (*optional*): -#' name of the wanted info element -#' -#' @return -#' -#' **`get_RLum`** -#' -#' 1. A [matrix] with the curve values or -#' 2. only the info object if `info.object` was set. -#' -#' @md -#' @export -setMethod("get_RLum", - signature("RLum.Data.Curve"), - definition = function(object, info.object = NULL) { - - ##if info.object == NULL just show the curve values - if(!is.null(info.object)) { - if(info.object %in% names(object@info)){ - unlist(object@info[info.object]) - - }else{ - ##check for entries - if(length(object@info) == 0){ - warning("[get_RLum()] This RLum.Data.Curve object has no info objects! NULL returned!)") - return(NULL) - - }else{ - ##grep names - temp.element.names <- paste(names(object@info), collapse = ", ") - - warning.text <- paste("[get_RLum()] Invalid info.object name. Valid names are:", temp.element.names) - - warning(warning.text, call. = FALSE) - return(NULL) - - } - - } - - }else{ - object@data - - } - }) - - -# length_RLum() ------------------------------------------------------------------------------- -#' @describeIn RLum.Data.Curve -#' Returns the length of the curve object, which is the maximum of the -#' value time/temperature of the curve (corresponding to the stimulation length) -#' -#' @return -#' -#' **`length_RLum`** -#' -#' Number of channels in the curve (row number of the matrix) -#' -#' @md -#' @export -setMethod("length_RLum", - "RLum.Data.Curve", - function(object){ - max(object@data[,1]) - - }) - - -# names_RLum() -------------------------------------------------------------------------------- -#' @describeIn RLum.Data.Curve -#' Returns the names info elements coming along with this curve object -#' -#' @return -#' -#' **`names_RLum`** -#' -#' Names of the info elements (slot `info`) -#' -#' @md -#' @export -setMethod("names_RLum", - "RLum.Data.Curve", - function(object){ - names(object@info) - - }) - - -# bin_RLum.Data() ----------------------------------------------------------------------------- -#' @describeIn RLum.Data.Curve -#' Allows binning of specific objects -#' -#' @param bin_size [integer] (*with default*): -#' set number of channels used for each bin, e.g. `bin_size = 2` means that -#' two channels are binned. -#' -#' @return -#' -#' **`bin_RLum.Data`** -#' -#' Same object as input, after applying the binning. -#' -#' @md -#' @export -setMethod(f = "bin_RLum.Data", - signature = "RLum.Data.Curve", - function(object, bin_size = 2) { - - ##check for invalid bin_size values - if (!is.null(bin_size) && bin_size > 0) { - ##set stepping vector - stepping <- seq(1, nrow(object@data), by = bin_size) - - ##get bin vector - bin_vector <- object@data[, 2] - - ##set desired length of the vector - ##to avoid add effects later - length(bin_vector) <- - suppressWarnings(prod(dim(matrix( - bin_vector, ncol = length(stepping) - )))) - - ##define new matrix for binning - bin_matrix <- - matrix(bin_vector, ncol = length(stepping)) - - ##calcuate column sums and replace matrix - ##this is much faster than anly apply loop - object@data <- - matrix(c(object@data[stepping], colSums(bin_matrix, na.rm = TRUE)), ncol = 2) - - ##set matrix - return(set_RLum(class = "RLum.Data.Curve", - data = object)) - } else{ - warning("Argument 'bin_size' invalid, nothing was done!") - - ##just return the object - return(object) - - } - - }) - - -# smooth_RLum() ------------------------------------------------------------------------------- -#' @describeIn RLum.Data.Curve -#' Smoothing of RLum.Data.Curve objects using the function [zoo::rollmean] or [zoo::rollmedian][zoo::rollmean]. -#' In particular the internal function `.smoothing` is used. -#' -#' @param k [`smooth_RLum`]; [integer] (*with default*): -#' window for the rolling mean; must be odd for `rollmedian`. -#' If nothing is set k is set automatically -#' -#' @param fill [`smooth_RLum`]; [numeric] (*with default*): -#' a vector defining the left and the right hand data -#' -#' @param align [`smooth_RLum`]; [character] (*with default*): -#' specifying whether the index of the result should be left- or right-aligned -#' or centred (default) compared to the rolling window of observations, allowed -#' `"right"`, `"center"` and `"left"` -#' -#' @param method [`smooth_RLum`]; [character] (*with default*): -#' defines which method should be applied for the smoothing: `"mean"` or `"median"` -#' -#' @return -#' -#' **`smooth_RLum`** -#' -#' Same object as input, after smoothing -#' -#' @md -#' @export -setMethod( - f = "smooth_RLum", - signature = "RLum.Data.Curve", - function(object, k = NULL, fill = NA, align = "right", method = "mean") { - - object@data[,2] <- .smoothing( - x = object@data[,2], - k = k, - fill = fill, - align = align, - method = method) - - ##return via set function to get a new id - set_RLum(class = "RLum.Data.Curve", - originator = "smooth_RLum", - data = object) - - } - ) - diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RLum.Data.Image-class.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RLum.Data.Image-class.R deleted file mode 100644 index 435692122..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RLum.Data.Image-class.R +++ /dev/null @@ -1,363 +0,0 @@ -#' @include get_RLum.R set_RLum.R names_RLum.R -NULL - -#' Class `"RLum.Data.Image"` -#' -#' Class for representing luminescence image data (TL/OSL/RF). Such data are for example produced -#' by the function [read_SPE2R] -#' -#' @name RLum.Data.Image-class -#' -#' @docType class -#' -#' @slot recordType -#' Object of class [character] containing the type of the curve (e.g. "OSL image", "TL image") -#' -#' @slot curveType -#' Object of class [character] containing curve type, allowed values -#' are measured or predefined -#' -#' @slot data -#' Object of class [array] containing image data. -#' -#' @slot info -#' Object of class [list] containing further meta information objects -#' -#' @note -#' The class should only contain data for a set of images. For additional -#' elements the slot `info` can be used. -#' -#' @section Objects from the class: -#' Objects can be created by calls of the form `set_RLum("RLum.Data.Image", ...)`. -#' -#' @section Class version: 0.5.1 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum-class], [RLum.Data-class], [plot_RLum], [read_SPE2R], [read_TIFF2R] -#' -#' @keywords classes -#' -#' @examples -#' -#' showClass("RLum.Data.Image") -#' -#' ##create empty RLum.Data.Image object -#' set_RLum(class = "RLum.Data.Image") -#' -#' @md -#' @export -setClass( - "RLum.Data.Image", - slots = list( - recordType = "character", - curveType = "character", - data = "array", - info = "list" - ), - contains = "RLum.Data", - prototype = list ( - recordType = character(), - curveType = character(), - data = array(), - info = list() - ) -) - -# as() ---------------------------------------------------------------------------------------- -##DATA.FRAME -##COERCE RLum.Data.Image >> data.frame AND data.frame >> RLum.Data.Image -#' as() -#' -#' for `[RLum.Data.Image-class]` -#' -#' **[RLum.Data.Image-class]** -#' -#' \tabular{ll}{ -#' **from** \tab **to**\cr -#' `data.frame` \tab `data.frame`\cr -#' `matrix` \tab `matrix` -#' } -#' -#' @md -#' @name as -## from data.frame ---- -setAs("data.frame", "RLum.Data.Image", - function(from,to){ - new(to, - recordType = "unknown curve type", - curveType = "NA", - data = array(unlist(from), dim = c(nrow(from),ncol(from),1)), - info = list()) - }) - -## to data.frame ---- -setAs("RLum.Data.Image", "data.frame", - function(from){ - if(dim(from@data)[3] == 1) { - as.data.frame(from@data[,,1]) - - } else { - stop("No viable coercion to data.frame, object contains multiple frames.", - call. = FALSE) - - } - }) - - -## from matrix ---- -setAs("matrix", "RLum.Data.Image", - function(from,to){ - new(to, - recordType = "unknown curve type", - curveType = "NA", - data = array(from, c(nrow(from), ncol(from), 1)), - info = list()) - }) - -## to matrix ---- -setAs("RLum.Data.Image", "matrix", - function(from){ - if(dim(from@data)[3] == 1) { - from@data[,,1, drop = TRUE] - } else { - stop("No viable coercion to matrix, object contains multiple frames. Please convert to array instead.", call. = FALSE) - - } - }) - -## from array ---- -setAs("array", "RLum.Data.Image", - function(from, to){ - new(to, - recordType = "unknown curve type", - curveType = "NA", - data = from, - info = list()) - - }) - -## to array ---- -setAs("RLum.Data.Image", "array", - function(from) from@data) - - -## from list ---- -setAs("list", "RLum.Data.Image", - function(from, to){ - array_list <- lapply(from, function(x) array(unlist(as.vector(x)), c(nrow(x), ncol(x), 1))) - - new(to, - recordType = "unknown curve type", - curveType = "NA", - data = array(unlist(array_list), - c(nrow(array_list[[1]]), ncol(array_list[[1]]), length(array_list))), - info = list()) - - }) - -## to list ---- -setAs("RLum.Data.Image", "list", - function(from){ - lapply(1:dim(from@data)[3], function(x) from@data[,,x]) - - }) - -# show() -------------------------------------------------------------------------------------- -#' @describeIn RLum.Data.Image -#' Show structure of `RLum.Data.Image` object -#' -#' @keywords internal -#' -#' @md -#' @export -setMethod("show", - signature(object = "RLum.Data.Image"), - function(object){ - - ## get dimension - dim <- dim(object@data) - - ##print information - cat("\n [RLum.Data.Image-class]") - cat("\n\t recordType:", object@recordType) - cat("\n\t curveType:", object@curveType) - cat("\n\t .. recorded frames:", max(1,dim[3], na.rm = TRUE)) - cat("\n\t .. .. pixel per frame:", dim[1]*dim[2]) - cat("\n\t .. .. x dimension [px]:", dim[1]) - cat("\n\t .. .. y dimension [px]:", dim[2]) - cat("\n\t .. .. full pixel value range:", paste(format(range(object@data), scientific = TRUE, digits = 2), collapse=" : ")) - cat("\n\t additional info elements:", length(object@info)) - #cat("\n\t\t >> names:", names(object@info)) - } -) - - - -# set_RLum() ---------------------------------------------------------------------------------- -#' @describeIn RLum.Data.Image -#' Construction method for RLum.Data.Image object. The slot info is optional -#' and predefined as empty list by default. -#' -#' @param class [`set_RLum`]; [character]: name of the `RLum` class to create -#' -#' @param originator [`set_RLum`]; [character] (*automatic*): -#' contains the name of the calling function (the function that produces this object); -#' can be set manually. -#' -#' @param .uid [`set_RLum`]; [character] (*automatic*): -#' sets an unique ID for this object using the internal C++ function `create_UID`. -#' -#' @param .pid [`set_RLum`]; [character] (*with default*): -#' option to provide a parent id for nesting at will. -#' -#' @param recordType [`set_RLum`]; [character]: -#' record type (e.g. "OSL") -#' -#' @param curveType [`set_RLum`]; [character]: -#' curve type (e.g. "predefined" or "measured") -#' -#' @param data [`set_RLum`]; [matrix]: -#' raw curve data. If data is of type `RLum.Data.Image` this can be used to -#' re-construct the object, i.e. modified parameters except `.uid` and `.pid`. The rest -#' will be subject to copy and paste unless provided. -#' -#' @param info [`set_RLum`]; [list]: -#' info elements -#' -#' @return -#' -#' **`set_RLum`** -#' -#' Returns an object from class `RLum.Data.Image` -#' -#' @md -#' @export -setMethod( - "set_RLum", - signature = signature("RLum.Data.Image"), - definition = function( - class, - originator, - .uid, - .pid, - recordType = "Image", - curveType = NA_character_, - data = array(), - info = list()) { - - ##The case where an RLum.Data.Image object can be provided - ##with this RLum.Data.Image objects can be provided to be reconstructed - if (is(data, "RLum.Data.Image")) { - ##check for missing curveType - if (missing(curveType)) - curveType <- data@curveType - - ##check for missing recordType - if (missing(recordType)) - recordType <- data@recordType - - ##check for missing data ... not possible as data is the object itself - - ##check for missing info - if (missing(info)) - info <- data@info - - ##check for modified .uid & .pid - ## >> this cannot be changed here, since both would be reset, by - ## the arguments passed down from set_RLum() ... the generic function - - ##set empty class form object - newRLumDataImage <- new("RLum.Data.Image") - - ##fill - this is the faster way, filling in new() costs ... - newRLumDataImage@originator <- data@originator - newRLumDataImage@recordType <- recordType - newRLumDataImage@curveType <- curveType - newRLumDataImage@data <- data@data - newRLumDataImage@info <- info - newRLumDataImage@.uid <- data@.uid - newRLumDataImage@.pid <- data@.pid - - } else { - ##set empty class from object - newRLumDataImage <- new("RLum.Data.Image") - - ##fill - this is the faster way, filling in new() costs ... - newRLumDataImage@originator <- originator - newRLumDataImage@recordType <- recordType - newRLumDataImage@curveType <- curveType - newRLumDataImage@data <- data - newRLumDataImage@info <- info - newRLumDataImage@.uid <- .uid - newRLumDataImage@.pid <- .pid - } - return(newRLumDataImage) - } -) - -# get_RLum() ---------------------------------------------------------------------------------- -#' @describeIn RLum.Data.Image -#' Accessor method for `RLum.Data.Image` object. The argument `info.object` is -#' optional to directly access the info elements. If no info element name is -#' provided, the raw image data (`array`) will be returned. -#' -#' @param object [`get_RLum`], [`names_RLum`] (**required**): -#' an object of class [RLum.Data.Image-class] -#' -#' @param info.object [`get_RLum`]; [character]: -#' name of the info object to returned -#' -#' @return -#' -#' **`get_RLum`** -#' -#' 1. Returns the data object ([array]) -#' 2. only the info object if `info.object` was set. -#' -#' @md -#' @export -setMethod("get_RLum", - signature("RLum.Data.Image"), - definition = function(object, info.object) { - - ##if missing info.object just show the curve values - if(!missing(info.object)){ - if(!inherits(info.object, "character")) - stop("[get_RLum] 'info.object' has to be a character!", call. = FALSE) - - if(info.object %in% names(object@info)){ - unlist(object@info[info.object]) - - } else { - stop(paste0( - "[get_RLum] Invalid element name. Valid names are: ", - paste(names(object@info), collapse = ", ") - ), - call. = FALSE) - } - } else { - object@data - } - }) - - - -# names_RLum() -------------------------------------------------------------------------------- -#' @describeIn RLum.Data.Image -#' Returns the names info elements coming along with this curve object -#' -#' @return -#' -#' **`names_RLum`** -#' -#' Returns the names of the info elements -#' -#' @md -#' @export -setMethod( - "names_RLum", - "RLum.Data.Image", - function(object) names(object@info)) - diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RLum.Data.Spectrum-class.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RLum.Data.Spectrum-class.R deleted file mode 100644 index 5c83f3567..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RLum.Data.Spectrum-class.R +++ /dev/null @@ -1,405 +0,0 @@ -#' @include get_RLum.R set_RLum.R names_RLum.R bin_RLum.Data.R -NULL - -#' Class `"RLum.Data.Spectrum"` -#' -#' Class for representing luminescence spectra data (TL/OSL/RF). -#' -#' @name RLum.Data.Spectrum-class -#' -#' @docType class -#' -#' @slot recordType -#' Object of class [character] containing the type of the curve (e.g. "TL" or "OSL") -#' -#' @slot curveType -#' Object of class [character] containing curve type, allowed values are measured or predefined -#' -#' @slot data -#' Object of class [matrix] containing spectrum (count) values. -#' Row labels indicate wavelength/pixel values, column labels are temperature or time values. -#' -#' @slot info -#' Object of class [list] containing further meta information objects -#' -#' @note -#' The class should only contain data for a single spectra data set. For -#' additional elements the slot `info` can be used. Objects from this class are automatically -#' created by, e.g., [read_XSYG2R] -#' -#' @section Objects from the Class: -#' Objects can be created by calls of the form `set_RLum("RLum.Data.Spectrum", ...)`. -#' -#' @section Class version: 0.5.2 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum-class], [RLum.Data-class], [plot_RLum] -#' -#' @keywords classes -#' -#' @examples -#' -#' showClass("RLum.Data.Spectrum") -#' -#' ##show example data -#' data(ExampleData.XSYG, envir = environment()) -#' TL.Spectrum -#' -#' ##show data matrix -#' get_RLum(TL.Spectrum) -#' -#' ##plot spectrum -#' \dontrun{ -#' plot_RLum(TL.Spectrum) -#' } -#' -#' @md -#' @export -setClass( - "RLum.Data.Spectrum", - slots = list( - recordType = "character", - curveType = "character", - data = "matrix", - info = "list" - ), - contains = "RLum.Data", - prototype = list ( - recordType = NA_character_, - curveType = NA_character_, - data = matrix(), - info = list() - ) -) - - - -# as() ----------------------------------------------------------------------------------------- -##data.frame -##COERCE RLum.Data.Spectrum >> data.frame AND data.frame >> RLum.Data.Spectrum -#' as() -#' -#' for `[RLum.Data.Spectrum-class]` -#' -#' -#' **[RLum.Data.Spectrum-class]** -#' -#' \tabular{ll}{ -#' **from** \tab **to**\cr -#' `data.frame` \tab `data.frame`\cr -#' `matrix` \tab `matrix` -#' } -#' -#' -#' @md -#' @name as -setAs("data.frame", "RLum.Data.Spectrum", - function(from,to){ - - new(to, - recordType = NA_character_, - curveType = NA_character_, - data = as.matrix(from), - info = list()) - }) - -setAs("RLum.Data.Spectrum", "data.frame", - function(from){ - as.data.frame(from@data) - - }) - - -##MATRIX -##COERCE RLum.Data.Spectrum >> matrix AND matrix >> RLum.Data.Spectrum -setAs("matrix", "RLum.Data.Spectrum", - function(from,to){ - new(to, - recordType = NA_character_, - curveType = NA_character_, - data = from, - info = list()) - }) - -setAs("RLum.Data.Spectrum", "matrix", - function(from){ - from@data - - }) - -# show() ------------------------------------------------------------------------------------- -#' @describeIn RLum.Data.Spectrum -#' Show structure of `RLum.Data.Spectrum` object -#' -#' @keywords internal -#' -#' @md -#' @export -setMethod("show", - signature(object = "RLum.Data.Spectrum"), - function(object){ - - x.range <- suppressWarnings(range(as.numeric(rownames(object@data)))) - y.range <- suppressWarnings(range(as.numeric(colnames(object@data)))) - z.range <- range(object@data) - - ##print information - - cat("\n [RLum.Data.Spectrum-class]") - cat("\n\t recordType:", object@recordType) - cat("\n\t curveType:", object@curveType) - cat("\n\t .. recorded frames:", length(object@data[1,])) - cat("\n\t .. .. measured values per frame:", length(object@data[,1])) - cat("\n\t .. .. range wavelength/pixel:", x.range) - cat("\n\t .. .. range time/temp.:", y.range) - cat("\n\t .. .. range count values:", z.range) - cat("\n\t additional info elements:", length(object@info)) - #cat("\n\t\t >> names:", names(object@info)) - } -) - - - -# set_RLum() ---------------------------------------------------------------------------------- -#' @describeIn RLum.Data.Spectrum -#' Construction method for RLum.Data.Spectrum object. The slot info is optional -#' and predefined as empty list by default -#' -#' @param class [`set_RLum`]; [character] (*automatic*): -#' name of the `RLum` class to create. -#' -#' @param originator [character] (*automatic*): -#' contains the name of the calling function (the function that produces this object); -#' can be set manually. -#' -#' @param .uid [`set_RLum`]; [character] (*automatic*): -#' sets an unique ID for this object using the internal C++ function `create_UID`. -#' -#' @param .pid [`set_RLum`]; [character] (*with default*): -#' option to provide a parent id for nesting at will. -#' -#' @param recordType [`set_RLum`]; [character]: -#' record type (e.g. "OSL") -#' -#' @param curveType [`set_RLum`]; [character]: -#' curve type (e.g. "predefined" or "measured") -#' -#' @param data [`set_RLum`]; [matrix]: -#' raw curve data. If data is of type `RLum.Data.Spectrum`, this can be used -#' to re-construct the object. If the object is reconstructed, `.uid`, `.pid` and `orginator` -#' are always taken from the input object -#' -#' @param info [`set_RLum`] [list]: -#' info elements -#' -#' @return -#' -#' **`[set_RLum]`** -#' -#' An object from the class `RLum.Data.Spectrum` -#' -#' @md -#' @export -setMethod( - "set_RLum", - signature = signature("RLum.Data.Spectrum"), - definition = function( - class, - originator, - .uid, - .pid, - recordType = "Spectrum", - curveType = NA_character_, - data = matrix(), - info = list()) { - - ##The case where an RLum.Data.Spectrum object can be provided - ##with this RLum.Data.Spectrum objects can be provided to be reconstructed - - if (is(data, "RLum.Data.Spectrum")) { - ##check for missing curveType - if (missing(curveType)) - curveType <- data@curveType - - ##check for missing recordType - if (missing(recordType)) - recordType <- data@recordType - - - ##check for missing data ... not possible as data is the object itself - - ##check for missing info - if (missing(info)) - info <- data@info - - - ##check for missing .uid and .pid >> this are always taken from the - ##original dataset - - ##set empty clas form object - newRLumDataSpectrum <- new("RLum.Data.Spectrum") - - ##fill - this is the faster way, filling in new() costs ... - newRLumDataSpectrum@originator = data@originator - newRLumDataSpectrum@recordType = recordType - newRLumDataSpectrum@curveType = curveType - newRLumDataSpectrum@data = data@data - newRLumDataSpectrum@info = info - newRLumDataSpectrum@.uid = data@.uid - newRLumDataSpectrum@.pid = data@.pid - - - } else { - ##set empty class from object - newRLumDataSpectrum <- new("RLum.Data.Spectrum") - - ##fill - this is the faster way, filling in new() costs ... - newRLumDataSpectrum@originator = originator - newRLumDataSpectrum@recordType = recordType - newRLumDataSpectrum@curveType = curveType - newRLumDataSpectrum@data = data - newRLumDataSpectrum@info = info - newRLumDataSpectrum@.uid = .uid - newRLumDataSpectrum@.pid = .pid - - } - - return(newRLumDataSpectrum) - - } -) - - - -# get_RLum() ---------------------------------------------------------------------------------- -#' @describeIn RLum.Data.Spectrum -#' Accessor method for RLum.Data.Spectrum object. The argument info.object -#' is optional to directly access the info elements. If no info element name -#' is provided, the raw curve data (matrix) will be returned -#' -#' @param object [`get_RLum`], [`names_RLum`] (**required**): -#' an object of class [RLum.Data.Spectrum-class] -#' -#' @param info.object [`get_RLum`]; [character] (*optional*): -#' the name of the info object to be called -#' -#' @return -#' -#' **`[get_RLum]`** -#' -#' 1. A [matrix] with the spectrum values or -#' 2. only the info object if `info.object` was set. -#' -#' @md -#' @export -setMethod("get_RLum", - signature("RLum.Data.Spectrum"), - definition = function(object, info.object) { - ##if missing info.object just show the curve values - - if (missing(info.object) == FALSE){ - if(is(info.object, "character") == FALSE) - stop("[get_RLum] 'info.object' has to be a character!", call. = FALSE) - - - if (info.object %in% names(object@info) == TRUE){ - unlist(object@info[info.object]) - - } else { - stop(paste0( - "[get_RLum] Invalid element name. Valid names are: ", - paste(names(object@info), collapse = ", ") - ), - call. = FALSE) - - } - } else { - object@data - - } - }) - - - -# names() ------------------------------------------------------------------------------------- -#' @describeIn RLum.Data.Spectrum -#' Returns the names info elements coming along with this curve object -#' -#' @return -#' -#' **`[names_RLum]`** -#' -#' The names of the info objects -#' -#' @md -#' @export -setMethod("names_RLum", - "RLum.Data.Spectrum", - function(object){ - names(object@info) - - }) - - - -# bin_RLum() ----------------------------------------------------------------------------------# -#' @describeIn RLum.Data.Spectrum -#' Allows binning of RLum.Data.Spectrum data. Count values and values on the x-axis are summed-up; -#' for wavelength/energy values the mean is calculated. -#' -#' @param bin_size.col [integer] (*with default*): -#' set number of channels used for each bin, e.g. `bin_size.col = 2` means that -#' two channels are binned. Note: The function does not check the input, very large values -#' mean a full column binning (a single sum) -#' -#' @param bin_size.row [integer] (*with default*): -#' set number of channels used for each bin, e.g. `bin_size.row = 2` means that -#' two channels are binned. Note: The function does not check the input, very large values -#' mean a full row binning (a single sum) -#' -#' @return -#' -#' **`[bin_RLum.Data]`** -#' -#' Same object as input, after applying the binning. -#' -#' @md -#' @export -setMethod(f = "bin_RLum.Data", - signature = "RLum.Data.Spectrum", - function(object, bin_size.col = 1, bin_size.row = 1) { - - ##make sure that we have no input problems - if (!inherits(bin_size.col, "numeric") || !inherits(bin_size.row, "numeric")){ - stop("[bin_RLum.Data()] 'bin_size.row' and 'bin_size.col' must be of class 'numeric'!", - call. = FALSE) - } - - ##make sure that we do not get in trouble with negative values - bin_size.col <- abs(bin_size.col) - bin_size.row <- abs(bin_size.row) - - ##perform binning - ##we want to be efficient, so we start - ##with the larger object - if(bin_size.row > bin_size.col){ - ##row binning first - m <- .matrix_binning(object@data, bin_size = bin_size.row, bin_col = FALSE, names = "mean") - m <- .matrix_binning(m, bin_size = bin_size.col, bin_col = TRUE, names = "groups") - - } else { - ##column binning first - m <- .matrix_binning(object@data, bin_size = bin_size.col, bin_col = TRUE, names = "groups") - m <- .matrix_binning(m, bin_size = bin_size.row, bin_col = FALSE, names = "mean") - - } - - ##write back to object - object@data <- m - - ##return object - return(object) - }) - diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RLum.Results-class.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RLum.Results-class.R deleted file mode 100644 index 5fa9d44f2..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RLum.Results-class.R +++ /dev/null @@ -1,365 +0,0 @@ -#' @include get_RLum.R set_RLum.R length_RLum.R names_RLum.R -NULL - -#' Class `"RLum.Results"` -#' -#' Object class contains results data from functions (e.g., [analyse_SAR.CWOSL]). -#' -#' @name RLum.Results-class -#' -#' @docType class -#' -#' @slot data -#' Object of class [list] containing output data -#' -#' @note -#' The class is intended to store results from functions to be used by -#' other functions. The data in the object should always be accessed by the -#' method `get_RLum`. -#' -#' @section Objects from the Class: -#' Objects can be created by calls of the form `new("RLum.Results", ...)`. -#' -#' @section Class version: 0.5.2 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum-class], [plot_RLum], [merge_RLum] -#' -#' @keywords classes methods -#' -#' @examples -#' -#' showClass("RLum.Results") -#' -#' ##create an empty object from this class -#' set_RLum(class = "RLum.Results") -#' -#' ##use another function to show how it works -#' -#' ##Basic calculation of the dose rate for a specific date -#' dose.rate <- calc_SourceDoseRate( -#' measurement.date = "2012-01-27", -#' calib.date = "2014-12-19", -#' calib.dose.rate = 0.0438, -#' calib.error = 0.0019) -#' -#' ##show object -#' dose.rate -#' -#' ##get results -#' get_RLum(dose.rate) -#' -#' ##get parameters used for the calcualtion from the same object -#' get_RLum(dose.rate, data.object = "parameters") -#' -#' ##alternatively objects can be accessed using S3 generics, such as -#' dose.rate$parameters -#' -#' @md -#' @export -setClass( - Class = "RLum.Results", - slots = list(data = "list"), - contains = "RLum", - prototype = list (data = list()) -) - - -# as() ---------------------------------------------------------------------------------------- -##LIST -##COERCE RLum.Results >> list AND list >> RLum.Results -#' as() - RLum-object coercion -#' -#' for `[RLum.Results-class]` -#' -#' **[RLum.Results-class]** -#' -#' \tabular{ll}{ -#' **from** \tab **to**\cr -#' `list` \tab `list`\cr -#' } -#' -#' Given that the [list] consists of [RLum.Results-class] objects. -#' -#' @md -#' @name as -setAs("list", "RLum.Results", - function(from,to){ - new(to, - originator = "coercion", - data = from) - }) - -setAs("RLum.Results", "list", - function(from){ - from@data - }) - -# show() -------------------------------------------------------------------------------------- -#' @describeIn RLum.Results -#' Show structure of `RLum.Results` object -#' -#' @keywords internal -#' -#' @md -#' @export -setMethod("show", - signature(object = "RLum.Results"), - function(object) { - ##data elements - temp.names <- names(object@data) - - if (length(object) > 0) { - temp.type <- sapply(1:length(object@data), - function(x) { - paste("\t .. $", temp.names[x], - " : ", - is(object@data[[x]])[1], - sep = "") - }) - } else{ - temp.type <- paste0("\t .. $", temp.names, " : ", is(object@data)[1]) - } - - temp.type <- paste(temp.type, collapse = "\n") - - ##print information - cat("\n [RLum.Results-class]") - cat("\n\t originator: ", object@originator, "()", sep = "") - cat("\n\t data:", length(object@data)) - cat("\n", temp.type) - cat("\n\t additional info elements: ", length(object@info),"\n") - - }) - - -# set_RLum() ---------------------------------------------------------------------------------- -#' @describeIn RLum.Results -#' Construction method for an RLum.Results object. -#' -#' @param class [`set_RLum`]; [character] **(required)**: -#' name of the `RLum` class to create -#' -#' @param originator [`set_RLum`]; [character] (*automatic*): -#' contains the name of the calling function (the function that produces this object); -#' can be set manually. -#' -#' @param .uid [`set_RLum`]; [character] (*automatic*): -#' sets an unique ID for this object using the internal C++ function `create_UID`. -#' -#' @param .pid [`set_RLum`]; [character] (*with default*): -#' option to provide a parent id for nesting at will. -#' -#' @param data [`set_RLum`]; [list] (*optional*): -#' a list containing the data to -#' be stored in the object -#' -#' @param info [`set_RLum`]; [list] (*optional*): -#' a list containing additional info data for the object -#' -#' @return -#' -#' **`set_RLum`**: -#' -#' Returns an object from the class [RLum.Results-class] -#' -#' @md -#' @export -setMethod("set_RLum", - signature = signature("RLum.Results"), - - function(class, - originator, - .uid, - .pid, - data = list(), - info = list()) { - - ##create new class - newRLumReuslts <- new("RLum.Results") - - ##fill object - newRLumReuslts@originator <- originator - newRLumReuslts@data <- data - newRLumReuslts@info <- info - newRLumReuslts@.uid <- .uid - newRLumReuslts@.pid <- .pid - - return(newRLumReuslts) - }) - - -# get_RLum() ---------------------------------------------------------------------------------- -#' @describeIn RLum.Results -#' Accessor method for RLum.Results object. The argument data.object allows -#' directly accessing objects delivered within the slot data. The default -#' return object depends on the object originator (e.g., `fit_LMCurve`). -#' If nothing is specified always the first `data.object` will be returned. -#' -#' Note: Detailed specification should be made in combination with the originator slot in the -#' receiving function if results are pipped. -#' -#' @param object [`get_RLum`]; [RLum.Results-class] (**required**): -#' an object of class [RLum.Results-class] to be evaluated -#' -#' @param data.object [`get_RLum`]; [character] or [numeric]: -#' name or index of the data slot to be returned -#' -#' @param info.object [`get_RLum`]; [character] (*optional*): -#' name of the wanted info element -#' -#' @param drop [`get_RLum`]; [logical] (*with default*): -#' coerce to the next possible layer (which are data objects, `drop = FALSE` -#' keeps the original `RLum.Results` -#' -#' @return -#' -#' **`get_RLum`**: -#' -#' Returns: -#' -#' 1. Data object from the specified slot -#' 2. [list] of data objects from the slots if 'data.object' is vector or -#' 3. an [RLum.Results-class] for `drop = FALSE`. -#' -#' -#' @md -#' @export -setMethod( - "get_RLum", - signature = signature("RLum.Results"), - definition = function(object, data.object, info.object = NULL, drop = TRUE) { - ##if info.object is set, only the info objects are returned - if (!is.null(info.object)) { - if (info.object %in% names(object@info)) { - unlist(object@info[info.object]) - - } else { - ##check for entries - if (length(object@info) == 0) { - warning("[get_RLum()] This 'RLum.Results' object has no info ", - "objects, NULL returned)", call. = FALSE) - } else { - warning("[get_RLum()] Invalid 'info.object' name, valid names are: ", - paste(names(object@info), collapse = ", "), - call. = FALSE) - } - return(NULL) - } - - } else{ - if (!missing(data.object)) { - ##++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ##CASE1: data.object is of type 'character' - if (is(data.object, "character")) { - #check if the provided names are available - if (all(data.object %in% names(object@data))) { - ##account for multiple inputs - if (length(data.object) > 1) { - temp.return <- sapply(data.object, function(x) { - object@data[[x]] - }) - - } else{ - temp.return <- list(data.object = object@data[[data.object]]) - - } - } else { - stop("[get_RLum()] unknown 'data.object', valid names are: ", - paste(names(object@data), collapse = ", "), call. = FALSE) - } - } - - ##++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ##CASE2: data.object is of type 'numeric' - else if (is(data.object, "numeric")) { - ##check if index is valid - if (max(data.object) > length(object@data)) { - stop("[get_RLum] 'data.object' index out of bounds!") - - } else if (length(data.object) > 1) { - temp.return <- lapply(data.object, function(x) { - object@data[[x]] - - }) - } else { - temp.return <- list(object@data[[data.object]]) - - } - - ##restore names as that get los with this method - names(temp.return) <- - names(object@data)[data.object] - - } - ##++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ##CASE3: data.object is of an unsupported type - else{ - stop("[get_RLum] 'data.object' has to be of type character or numeric!", call. = FALSE) - } - - ##the CASE data.object is missing - } else{ - ##return always the first object if nothing is specified - temp.return <- object@data[1] - - } - - ##CHECK whether an RLum.Results object needs to be produced ... - ##This will just be the case if the funtion havn't returned something before - if (drop) { - ##we need to access the list here, otherwise we get unexpected behaviour as drop = TRUE - ##should always return the lowest possible element here - return(temp.return[[1]]) - - } else{ - return(set_RLum( - "RLum.Results", - originator = object@originator, - data = temp.return - )) - } - } - } -) - - - -# length_RLum() ------------------------------------------------------------------------------- -#' @describeIn RLum.Results -#' Returns the length of the object, i.e., number of stored data.objects -#' -#' @return -#' -#' **`length_RLum`** -#' -#' Returns the number of data elements in the `RLum.Results` object. -#' -#' @md -#' @export -setMethod("length_RLum", - "RLum.Results", - function(object){ - - length(object@data) - }) - -# names_RLum() -------------------------------------------------------------------------------- -#' @describeIn RLum.Results -#' Returns the names data.objects -#' -#' @return -#' -#' **`names_RLum`** -#' -#' Returns the names of the data elements in the object. -#' -#' @md -#' @export -setMethod("names_RLum", - "RLum.Results", - function(object){ - names(object@data) - }) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RcppExports.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RcppExports.R deleted file mode 100644 index 1b1bc742e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/RcppExports.R +++ /dev/null @@ -1,19 +0,0 @@ -# Generated by using Rcpp::compileAttributes() -> do not edit by hand -# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 - -create_UID <- function() { - .Call(`_Luminescence_create_UID`) -} - -src_analyse_IRSARRF_SRS <- function(values_regenerated_limited, values_natural_limited, vslide_range, n_MC, trace = FALSE) { - .Call(`_Luminescence_analyse_IRSARRF_SRS`, values_regenerated_limited, values_natural_limited, vslide_range, n_MC, trace) -} - -src_create_RLumDataCurve_matrix <- function(DATA, VERSION, NPOINTS, LTYPE, LOW, HIGH, AN_TEMP, TOLDELAY, TOLON, TOLOFF) { - .Call(`_Luminescence_create_RLumDataCurve_matrix`, DATA, VERSION, NPOINTS, LTYPE, LOW, HIGH, AN_TEMP, TOLDELAY, TOLON, TOLOFF) -} - -src_get_XSYG_curve_values <- function(s) { - .Call(`_Luminescence_src_get_XSYG_curve_values`, s) -} - diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/Risoe.BINfileData-class.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/Risoe.BINfileData-class.R deleted file mode 100644 index fa850906c..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/Risoe.BINfileData-class.R +++ /dev/null @@ -1,442 +0,0 @@ -#' @include get_Risoe.BINfileData.R set_Risoe.BINfileData.R -NULL - -#' Class `"Risoe.BINfileData"` -#' -#' S4 class object for luminescence data in R. The object is produced as output -#' of the function [read_BIN2R]. -#' -#' -#' -#' @name Risoe.BINfileData-class -#' -#' @docType class -#' -#' @slot METADATA Object of class "data.frame" containing the meta information for each curve. -#' -#' @slot DATA Object of class "list" containing numeric vector with count data. -#' -#' @slot .RESERVED Object of class "list" containing list of undocumented raw values for internal use only. -#' -#' @keywords internal -#' -#' @note -#' -#' **Internal METADATA - object structure** -#' -#' This structure is compatible with BIN/BINX-files version 03-08, however, it does not follow (in its -#' sequential arrangement) the manual provided by the manufacturer, -#' but an own structure accounting for the different versions. -#' -#' \tabular{rllll}{ -#' **#** \tab **Name** \tab **Data Type** \tab **V** \tab **Description** \cr -#' `[,1]` \tab `ID` \tab `numeric` \tab RLum \tab Unique record ID (same ID as in slot `DATA`)\cr -#' `[,2]` \tab `SEL` \tab `logic` \tab RLum \tab Record selection, not part official BIN-format, triggered by TAG\cr -#' `[,3]` \tab `VERSION` \tab `raw` \tab 03-08 \tab BIN-file version number \cr -#' `[,4]` \tab `LENGTH` \tab `integer` \tab 03-08 \tab Length of this record\cr -#' `[,5]` \tab `PREVIOUS` \tab `integer` \tab 03-08 \tab Length of previous record\cr -#' `[,6]` \tab `NPOINTS` \tab `integer` \tab 03-08 \tab Number of data points in the record\cr -#' `[,7]` \tab `RECTYPE` \tab `integer` \tab 08 \tab Record type \cr -#' `[,8]` \tab `RUN` \tab `integer` \tab 03-08 \tab Run number\cr -#' `[,9]` \tab `SET` \tab `integer` \tab 03-08 \tab Set number\cr -#' `[,10]` \tab `POSITION` \tab `integer` \tab 03-08 \tab Position number\cr -#' `[,11]` \tab `GRAIN` \tab `integer` \tab 03-04 \tab Grain number\cr -#' `[,12]` \tab `GRAINNUMBER` \tab `integer` \tab 05-08 \tab Grain number\cr -#' `[,13]` \tab `CURVENO` \tab `integer` \tab 05-08 \tab Curve number\cr -#' `[,14]` \tab `XCOORD` \tab `integer` \tab 03-08 \tab X position of a single grain\cr -#' `[,15]` \tab `YCOORD` \tab `integer` \tab 03-08 \tab Y position of a single grain\cr -#' `[,16]` \tab `SAMPLE` \tab `factor` \tab 03-08 \tab Sample name\cr -#' `[,17]` \tab `COMMENT` \tab `factor` \tab 03-08 \tab Comment name\cr -#' `[,18]` \tab `SYSTEMID` \tab `integer` \tab 03-08 \tab Risø system id\cr -#' `[,19]` \tab `FNAME` \tab `factor` \tab 05-08 \tab File name (*.bin/*.binx)\cr -#' `[,20]` \tab `USER` \tab `factor` \tab 03-08 \tab User name\cr -#' `[,21]` \tab `TIME` \tab `character` \tab 03-08 \tab Data collection time (`hh-mm-ss`)\cr -#' `[,22]` \tab `DATE` \tab `factor` \tab 03-08 \tab Data collection date (`ddmmyy`)\cr -#' `[,23]` \tab `DTYPE` \tab `character` \tab 03-08 \tab Data type\cr -#' `[,24]` \tab `BL_TIME` \tab `numeric` \tab 03-08 \tab Bleaching time\cr -#' `[,25]` \tab `BL_UNIT` \tab `integer` \tab 03-08 \tab Bleaching unit (mJ, J, s, min, h)\cr -#' `[,26]` \tab `NORM1` \tab `numeric` \tab 03-08 \tab Normalisation factor (1)\cr -#' `[,27]` \tab `NORM2` \tab `numeric` \tab 03-08 \tab Normalisation factor (2)\cr -#' `[,28]` \tab `NORM3` \tab `numeric` \tab 03-08 \tab Normalisation factor (3)\cr -#' `[,29]` \tab `BG` \tab `numeric` \tab 03-08 \tab Background level\cr -#' `[,30]` \tab `SHIFT` \tab `integer` \tab 03-08 \tab Number of channels to shift data\cr -#' `[,31]` \tab `TAG` \tab `integer` \tab 03-08 \tab Tag, triggers `SEL`\cr -#' `[,32]` \tab `LTYPE` \tab `character` \tab 03-08 \tab Luminescence type\cr -#' `[,33]` \tab `LIGHTSOURCE` \tab `character` \tab 03-08 \tab Light source\cr -#' `[,34]` \tab `LPOWER` \tab `numeric` \tab 03-08 \tab Optical stimulation power\cr -#' `[,35]` \tab `LIGHTPOWER` \tab `numeric` \tab 05-08 \tab Optical stimulation power\cr -#' `[,36]` \tab `LOW` \tab `numeric` \tab 03-08 \tab Low (temperature, time, wavelength)\cr -#' `[,37]` \tab `HIGH` \tab `numeric` \tab 03-08 \tab High (temperature, time, wavelength)\cr -#' `[,38]` \tab `RATE` \tab `numeric` \tab 03-08 \tab Rate (heating rate, scan rate)\cr -#' `[,39]` \tab `TEMPERATURE` \tab `integer` \tab 03-08 \tab Sample temperature\cr -#' `[,40]` \tab `MEASTEMP` \tab `integer` \tab 05-08 \tab Measured temperature\cr -#' `[,41]` \tab `AN_TEMP` \tab `numeric` \tab 03-08 \tab Annealing temperature\cr -#' `[,42]` \tab `AN_TIME` \tab `numeric` \tab 03-08 \tab Annealing time\cr -#' `[,43]` \tab `TOLDELAY` \tab `integer` \tab 03-08 \tab TOL 'delay' channels\cr -#' `[,44]` \tab `TOLON` \tab `integer` \tab 03-08 \tab TOL 'on' channels\cr -#' `[,45]` \tab `TOLOFF` \tab `integer` \tab 03-08 \tab TOL 'off' channels\cr -#' `[,46]` \tab `IRR_TIME` \tab `numeric` \tab 03-08 \tab Irradiation time\cr -#' `[,47]` \tab `IRR_TYPE` \tab `integer` \tab 03-08 \tab Irradiation type (alpha, beta or gamma)\cr -#' `[,48]` \tab `IRR_UNIT` \tab `integer` \tab 03-04 \tab Irradiation unit (Gy, rad, s, min, h)\cr -#' `[,49]` \tab `IRR_DOSERATE` \tab `numeric` \tab 05-08 \tab Irradiation dose rate (Gy/s)\cr -#' `[,50]` \tab `IRR_DOSERATEERR` \tab `numeric` \tab 06-08 \tab Irradiation dose rate error (Gy/s)\cr -#' `[,51]` \tab `TIMESINCEIRR` \tab `integer` \tab 05-08 \tab Time since irradiation (s)\cr -#' `[,52]` \tab `TIMETICK` \tab `numeric` \tab 05-08 \tab Time tick for pulsing (s)\cr -#' `[,53]` \tab `ONTIME` \tab `integer` \tab 05-08 \tab On-time for pulsing (in time ticks)\cr -#' `[,54]` \tab `OFFTIME` \tab `integer` \tab 03 \tab Off-time for pulsed stimulation (in s) \cr -#' `[,55]` \tab `STIMPERIOD` \tab `integer` \tab 05-08 \tab Stimulation period (on+off in time ticks)\cr -#' `[,56]` \tab `GATE_ENABLED` \tab `raw` \tab 05-08 \tab PMT signal gating enabled\cr -#' `[,57]` \tab `ENABLE_FLAGS` \tab `raw` \tab 05-08 \tab PMT signal gating enabled\cr -#' `[,58]` \tab `GATE_START` \tab `integer` \tab 05-08 \tab Start gating (in time ticks)\cr -#' `[,59]` \tab `GATE_STOP` \tab `integer` \tab 05-08 \tab Stop gating (in time ticks), `'Gateend'` for version 04, here only GATE_STOP is used\cr -#' `[,60]` \tab `PTENABLED` \tab `raw` \tab 05-08 \tab Photon time enabled\cr -#' `[,61]` \tab `DTENABLED` \tab `raw` \tab 05-08 \tab PMT dead time correction enabled\cr -#' `[,62]` \tab `DEADTIME` \tab `numeric` \tab 05-08 \tab PMT dead time (s)\cr -#' `[,63]` \tab `MAXLPOWER` \tab `numeric` \tab 05-08 \tab Stimulation power to 100 percent (mW/cm^2)\cr -#' `[,64]` \tab `XRF_ACQTIME` \tab `numeric` \tab 05-08 \tab XRF acquisition time (s)\cr -#' `[,65]` \tab `XRF_HV` \tab `numeric` \tab 05-08 \tab XRF X-ray high voltage (V)\cr -#' `[,66]` \tab `XRF_CURR` \tab `integer` \tab 05-08 \tab XRF X-ray current (µA)\cr -#' `[,67]` \tab `XRF_DEADTIMEF` \tab `numeric` \tab 05-08 \tab XRF dead time fraction\cr -#' `[,68]` \tab `DETECTOR_ID` \tab `raw` \tab 07-08 \tab Detector ID\cr -#' `[,69]` \tab `LOWERFILTER_ID` \tab `integer` \tab 07-08 \tab Lower filter ID in reader\cr -#' `[,70]` \tab `UPPERFILTER_ID` \tab `integer` \tab 07-08 \tab Upper filter ID in reader\cr -#' `[,71]` \tab `ENOISEFACTOR` \tab `numeric` \tab 07-08 \tab Excess noise filter, usage unknown \cr -#' `[,72]` \tab `MARKPOS_X1` \tab `numeric` \tab 08 \tab Coordinates marker position 1 \cr -#' `[,73]` \tab `MARKPOS_Y1` \tab `numeric` \tab 08 \tab Coordinates marker position 1 \cr -#' `[,74]` \tab `MARKPOS_X2` \tab `numeric` \tab 08 \tab Coordinates marker position 2 \cr -#' `[,75]` \tab `MARKPOS_Y2` \tab `numeric` \tab 08 \tab Coordinates marker position 2 \cr -#' `[,76]` \tab `MARKPOS_X3` \tab `numeric` \tab 08 \tab Coordinates marker position 3 \cr -#' `[,77]` \tab `MARKPOS_Y3` \tab `numeric` \tab 08 \tab Coordinates marker position 3 \cr -#' `[,78]` \tab `EXTR_START` \tab `numeric` \tab 08 \tab usage unknown \cr -#' `[,79]` \tab `EXTR_END` \tab `numeric` \tab 08 \tab usage unknown\cr -#' `[,80]` \tab `SEQUENCE` \tab `character` \tab 03-04 \tab Sequence name -#' } -#' V = BIN-file version (RLum means that it does not depend on a specific BIN version) -#' -#' Note that the `Risoe.BINfileData` object combines all values from -#' different versions from the BIN-file, reserved bits are skipped, however, -#' the function [write_R2BIN] reset arbitrary reserved bits. Invalid -#' values for a specific version are set to `NA`. Furthermore, the -#' internal R data types do not necessarily match the required data types for -#' the BIN-file data import! Data types are converted during data import.\cr -#' -#' **LTYPE** values -#' -#' \tabular{rll}{ -#' VALUE \tab TYPE \tab DESCRIPTION \cr -#' `[0]` \tab `TL` \tab: Thermoluminescence \cr -#' `[1]` \tab `OSL` \tab: Optically stimulated luminescence \cr -#' `[2]` \tab `IRSL` \tab: Infrared stimulated luminescence \cr -#' `[3]` \tab `M-IR` \tab: Infrared monochromator scan\cr -#' `[4]` \tab `M-VIS` \tab: Visible monochromator scan\cr -#' `[5]` \tab `TOL` \tab: Thermo-optical luminescence \cr -#' `[6]` \tab `TRPOSL` \tab: Time Resolved Pulsed OSL\cr -#' `[7]` \tab `RIR` \tab: Ramped IRSL\cr -#' `[8]` \tab `RBR` \tab: Ramped (Blue) LEDs\cr -#' `[9]` \tab `USER` \tab: User defined\cr -#' `[10]` \tab `POSL` \tab: Pulsed OSL \cr -#' `[11]` \tab `SGOSL` \tab: Single Grain OSL\cr -#' `[12]` \tab `RL` \tab: Radio Luminescence \cr -#' `[13]` \tab `XRF` \tab: X-ray Fluorescence -#' } -#' -#' **DTYPE** values -#' -#' \tabular{rl}{ -#' VALUE \tab DESCRIPTION \cr -#' `[0]` \tab Natural \cr -#' `[1]` \tab N+dose \cr -#' `[2]` \tab Bleach \cr -#' `[3]` \tab Bleach+dose \cr -#' `[4]` \tab Natural (Bleach) \cr -#' `[5]` \tab N+dose (Bleach) \cr -#' `[6]` \tab Dose \cr -#' `[7]` \tab Background -#' } -#' -#' **LIGHTSOURCE** values -#' -#' \tabular{rl}{ -#' VALUE \tab DESCRIPTION \cr -#' `[0]` \tab None \cr -#' `[1]` \tab Lamp \cr -#' `[2]` \tab IR diodes/IR Laser \cr -#' `[3]` \tab Calibration LED \cr -#' `[4]` \tab Blue Diodes \cr -#' `[5]` \tab White light \cr -#' `[6]` \tab Green laser (single grain) \cr -#' `[7]` \tab IR laser (single grain) } -#' -#' **Internal DATA - object structure** -#' -#' With version 8 of the BIN/BINX file format, slot `@DATA` (byte array `DPOINTS`) can -#' contain two different values: -#' -#' 1. `DPOINTS` (standard for `RECTYPE` := (0,1)): is a vector with the length defined -#' through `NPOINTS`. This is the standard for xy-curves since version 03. -#' -#' 2. `DPOINTS` (`RECTYPE` := 128) is contains no count values but information about -#' the definition of the regions of interest (ROI). Each definition is 504 bytes long. -#' The number of definitions is defined by `NPOINTS` in `@METADATA`. The record -#' describes basically the geometric features of the regions of interest. -#' The representation in R is a nested [list]. -#' -#' \tabular{rllll}{ -#' **#** \tab **Name** \tab **Data Type** \tab **V** \tab **Description** \cr -#'`[,1]` \tab `NOFPOINTS` \tab `numeric` \tab 08 \tab number of points in the definition (e.g., if the ROI is a rectangle: 4)\cr -#'`[,2]` \tab `USEDFOR` \tab `logical` \tab 08 \tab samples for which the ROI is used for; a maximum of 48 samples are allowed.\cr -#'`[,3]` \tab `SHOWNFOR` \tab `logical` \tab 08 \tab samples for which the ROI is shown for; a maximum of 48 samples are allowed.\cr -#'`[,4]` \tab `COLOR` \tab `numeric` \tab 08 \tab The colour values of the ROI.\cr -#'`[,5]` \tab `X` \tab `numeric` \tab 08 \tab The x coordinates used to draw the ROI geometry (up to 50 points are allowed).\cr -#'`[,6]` \tab `Y` \tab `numeric` \tab 08 \tab The y coordinates used to draw the ROI geometry (up to 50 points are allowed).\cr -#' } -#' -#' (information on the BIN/BINX file format are kindly provided by Risø, DTU Nutech) -#' -#' @section Objects from the Class: Objects can be created by calls of the form -#' `new("Risoe.BINfileData", ...)`. -#' -#' @section Function version: 0.4.1 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -#' based on information provided by Torben Lapp and Karsten Bracht Nielsen (Risø DTU, Denmark) -#' -#' @seealso [plot_Risoe.BINfileData], [read_BIN2R], [write_R2BIN], -#' [merge_Risoe.BINfileData], [Risoe.BINfileData2RLum.Analysis] -#' -#' @references -#' Risø DTU, 2013. The Sequence Editor User Manual - Feb 2013 and Risø DTU, 2016. -#' -#' The Sequence Editor User Manual - February 2016 -#' -#' [https://www.fysik.dtu.dk]() -#' -#' @keywords classes -#' -#' @examples -#' -#' showClass("Risoe.BINfileData") -#' -#' @md -#' @export -setClass("Risoe.BINfileData", - slots = list( - METADATA = "data.frame", - DATA = "list", - .RESERVED = "list" - ), - prototype = prototype( - METADATA = data.frame( - ID = integer(), - SEL = logical(), - VERSION = integer(), - LENGTH = integer(), - PREVIOUS = integer(), - NPOINTS = integer(), - RECTYPE = integer(), - RUN = integer(), - SET = integer(), - POSITION = integer(), - GRAIN = integer(), - GRAINNUMBER = integer(), - CURVENO = integer(), - XCOORD = integer(), - YCOORD = integer(), - SAMPLE = character(), - COMMENT = character(), - SYSTEMID = integer(), - FNAME = character(), - USER = character(), - TIME = character(), - DATE = character(), - DTYPE = character(), - BL_TIME = numeric(), - BL_UNIT = integer(), - NORM1 = numeric(), - NORM2 = numeric(), - NORM3 = numeric(), - BG = numeric(), - SHIFT = integer(), - TAG = integer(), - LTYPE = character(), - LIGHTSOURCE = character(), - LPOWER = numeric(), - LIGHTPOWER = numeric(), - LOW = numeric(), - HIGH = numeric(), - RATE = numeric(), - TEMPERATURE = numeric(), - MEASTEMP = numeric(), - AN_TEMP = numeric(), - AN_TIME = numeric(), - TOLDELAY = integer(), - TOLON = integer(), - TOLOFF = integer(), - IRR_TIME = numeric(), - IRR_TYPE = integer(), - IRR_UNIT = integer(), - IRR_DOSERATE = numeric(), - IRR_DOSERATEERR = numeric(), - TIMESINCEIRR = numeric(), - TIMETICK = numeric(), - ONTIME = numeric(), - OFFTIME = numeric(), - STIMPERIOD = integer(), - GATE_ENABLED = numeric(), - ENABLE_FLAGS = numeric(), - GATE_START = numeric(), - GATE_STOP = numeric(), - PTENABLED = numeric(), - DTENABLED = numeric(), - DEADTIME = numeric(), - MAXLPOWER = numeric(), - XRF_ACQTIME = numeric(), - XRF_HV = numeric(), - XRF_CURR = numeric(), - XRF_DEADTIMEF = numeric(), - DETECTOR_ID = integer(), - LOWERFILTER_ID = integer(), - UPPERFILTER_ID = integer(), - ENOISEFACTOR = numeric(), - MARKPOS_X1 = numeric(), - MARKPOS_Y1 = numeric(), - MARKPOS_X2 = numeric(), - MARKPOS_Y2 = numeric(), - MARKPOS_X3 = numeric(), - MARKPOS_Y3 = numeric(), - EXTR_START = numeric(), - EXTR_END = numeric(), - SEQUENCE = character(), - stringsAsFactors=FALSE - ), - DATA = list(), - .RESERVED = list() - ) - ) - - -# show method -------- -#' @describeIn Risoe.BINfileData -#' Show structure of RLum and Risoe.BINfile class objects -#' -#' @md -#' @export -setMethod(f = "show", - signature = signature(object = "Risoe.BINfileData"), - definition = function(object){ - - if(nrow(object@METADATA) != 0){ - ## check if image/ROI data are present; get ID and remove information - if(!is.null(object@METADATA[["RECTYPE"]])) - id_128 <- object@METADATA[["RECTYPE"]] != 128 - else - id_128 <- rep(TRUE, nrow(object@METADATA)) - - version <- suppressWarnings(paste(unique(object@METADATA[id_128,"VERSION"]), collapse = ", ")) - systemID <- suppressWarnings(paste(unique(object@METADATA[id_128,"SYSTEMID"]), collapse = ", ")) - filename <- as.character(object@METADATA[1,"FNAME"]) - records.overall <- length(object@DATA) - records.type <- table(object@METADATA[id_128,"LTYPE"]) - user <- paste(unique(as.character(object@METADATA[id_128,"USER"])), collapse = ", ") - date <- paste(unique(as.character(object@METADATA[id_128,"DATE"])), collapse = ", ") - run.range <- suppressWarnings(range(object@METADATA[id_128,"RUN"])) - set.range <- suppressWarnings(range(object@METADATA[id_128,"SET"])) - grain.range <- suppressWarnings(range(object@METADATA[id_128,"GRAIN"])) - - pos.range <- suppressWarnings(range(object@METADATA[id_128,"POSITION"])) - - records.type.count <- vapply(seq_along(records.type), function(x){ - paste0(names(records.type[x]),"\t(n = ", records.type[x],")") - }, character(1)) - - records.type.count <- paste(records.type.count, - collapse="\n\t ") - - ##print - cat("\n[Risoe.BINfileData object]") - cat("\n\n\tBIN/BINX version: ", version) - if(version >= 6){ - cat("\n\tFile name: ", filename) - } - cat("\n\tObject date: ", date) - cat("\n\tUser: ", user) - cat("\n\tSystem ID: ", ifelse(systemID == 0,"0 (unknown)", systemID)) - cat("\n\tOverall records: ", records.overall) - cat("\n\tRecords type: ", records.type.count) - cat("\n\tPosition range: ", pos.range[1],":",pos.range[2]) - if(max(grain.range) > 0) - cat("\n\tGrain range: ", grain.range[1],":",grain.range[2]) - - cat("\n\tRun range: ", run.range[1],":",run.range[2]) - - ## if id_128 - if(any(!id_128)) - cat("\n\t + additional ROI data found in record(s):", paste(which(!id_128), collapse = ", "), "\n") - - }else{ - cat("\n[Risoe.BINfileData object]") - cat("\n\n >> This object is empty!<<") - - } - }#end function - )#end setMethod - - -# set method for object class ----------------------------------- - -#' @describeIn Risoe.BINfileData -#' The Risoe.BINfileData is normally produced as output of the function read_BIN2R. -#' This construction method is intended for internal usage only. -#' -#' @param METADATA Object of class "data.frame" containing the meta information -#' for each curve. -#' -#' @param DATA Object of class "list" containing numeric vector with count data. -#' -#' @param .RESERVED Object of class "list" containing list of undocumented raw -#' values for internal use only. -#' -#' @md -#' @export -setMethod(f = "set_Risoe.BINfileData", - signature = signature("ANY"), - definition = function(METADATA, DATA, .RESERVED) { - - if(length(METADATA) == 0){ - new("Risoe.BINfileData") - - }else{ - new( - "Risoe.BINfileData", - METADATA = METADATA, - DATA = DATA, - .RESERVED = .RESERVED - ) - - } - - }) - - -# get method for object class ----------------------------------- - -#' @describeIn Risoe.BINfileData -#' Formal get-method for Risoe.BINfileData object. It does not allow accessing -#' the object directly, it is just showing a terminal message. -#' -#' @param object an object of class [Risoe.BINfileData-class] -#' -#' @param ... other arguments that might be passed -#' -#' @md -#' @export -setMethod("get_Risoe.BINfileData", - signature= "Risoe.BINfileData", - definition = function(object, ...) { - - cat("[get_Risoe.BINfileData()] No direct access is provided for this object type. Use the function 'Risoe.BINfileData2RLum.Analysis' for object coercing.") - - })##end setMethod - -##-------------------------------------------------------------------------------------------------## -##=================================================================================================## diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/Risoe.BINfileData2RLum.Analysis.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/Risoe.BINfileData2RLum.Analysis.R deleted file mode 100644 index 321e618da..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/Risoe.BINfileData2RLum.Analysis.R +++ /dev/null @@ -1,285 +0,0 @@ -#' Convert Risoe.BINfileData object to an RLum.Analysis object -#' -#' Converts values from one specific position of a Risoe.BINfileData S4-class -#' object to an RLum.Analysis object. -#' -#' The [RLum.Analysis-class] object requires a set of curves for -#' specific further protocol analyses. However, the [Risoe.BINfileData-class] -#' usually contains a set of curves for different aliquots and different -#' protocol types that may be mixed up. Therefore, a conversion is needed. -#' -#' @param object [Risoe.BINfileData-class] (**required**): -#' `Risoe.BINfileData` object -#' -#' @param pos [numeric] (*optional*): position number of the `Risoe.BINfileData` -#' object for which the curves are stored in the `RLum.Analysis` object. -#' If `length(position)>1` a list of `RLum.Analysis` objects is returned. -#' If nothing is provided every position will be converted. -#' If the position is not valid `NULL` is returned. -#' -#' @param grain [vector], [numeric] (*optional*): -#' grain number from the measurement to limit the converted data set -#' (e.g., `grain = c(1:48)`). Please be aware that this option may lead to -#' unwanted effects, as the output is strictly limited to the chosen grain -#' number for all position numbers -#' -#' @param run [vector], [numeric] (*optional*): -#' run number from the measurement to limit the converted data set -#' (e.g., `run = c(1:48)`). -#' -#' @param set [vector], [numeric] (*optional*): -#' set number from the measurement to limit the converted data set -#' (e.g., `set = c(1:48)`). -#' -#' @param ltype [vector], [character] (*optional*): -#' curve type to limit the converted data. Commonly allowed values are: -#' `IRSL`, `OSL`, `TL`, `RIR`, `RBR` and `USER` -#' (see also [Risoe.BINfileData-class]) -#' -#' @param dtype [vector], [character] (*optional*): -#' data type to limit the converted data. Commonly allowed values are -#' listed in [Risoe.BINfileData-class] -#' -#' @param protocol [character] (*optional*): -#' sets protocol type for analysis object. Value may be used by subsequent -#' analysis functions. -#' -#' @param keep.empty [logical] (*with default*): -#' If `TRUE` (default) an `RLum.Analysis` object is returned even if it does -#' not contain any records. Set to `FALSE` to discard all empty objects. -#' -#' @param txtProgressBar [logical] (*with default*): -#' enables or disables [txtProgressBar]. -#' -#' @return Returns an [RLum.Analysis-class] object. -#' -#' @note -#' The `protocol` argument of the [RLum.Analysis-class] -#' object is set to 'unknown' if not stated otherwise. -#' -#' @section Function version: 0.4.3 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [Risoe.BINfileData-class], [RLum.Analysis-class], [read_BIN2R] -#' -#' @keywords manip -#' -#' @examples -#' -#' ##load data -#' data(ExampleData.BINfileData, envir = environment()) -#' -#' ##convert values for position 1 -#' Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = 1) -#' -#' @md -#' @export -Risoe.BINfileData2RLum.Analysis<- function( - object, - pos = NULL, - grain = NULL, - run = NULL, - set = NULL, - ltype = NULL, - dtype = NULL, - protocol = "unknown", - keep.empty = TRUE, - txtProgressBar = FALSE -){ - - - # Integrity Check --------------------------------------------------------- - - if (!is(object,"Risoe.BINfileData")){ - .throw_error("Input object is not of type 'Risoe.BINfileData'.") - } - - if (!is.null(pos) && !is(pos,"numeric")){ - .throw_error("Argument 'pos' has to be of type numeric.") - } - - if (is.null(pos)) { - pos <- unique(object@METADATA[["POSITION"]]) - - } else{ - ##get and check valid positions and remove invalid numbers from the input - positions.valid <- unique(object@METADATA[, "POSITION"]) - - if (length(setdiff(pos, positions.valid)) > 0) { - .throw_warning("Invalid position number skipped: ", - paste(setdiff(pos, positions.valid), collapse = ", ")) - pos <- intersect(pos, positions.valid) - } - } - - # Grep run and set data --------------------------------------------------- - - ##grain - if (is.null(grain)) { - grain <- unique(object@METADATA[["GRAIN"]]) - - }else{ - grain.valid <- unique(object@METADATA[["GRAIN"]]) - if(length(setdiff(grain, grain.valid)) > 0){ - .throw_warning("Invalid grain number skipped: ", - paste(setdiff(grain, grain.valid), collapse = ", ")) - - grain <- intersect(grain, grain.valid) - } - } - - ##run - if (is.null(run)) { - run <- unique(object@METADATA[["RUN"]]) - } else{ - if (TRUE %in% unique(unique(object@METADATA[["RUN"]]) %in% run) != TRUE) { - ##get and check valid positions - run.valid <- - paste(as.character(unique(object@METADATA[, "RUN"])), collapse = ", ") - - .throw_error("run = ", paste(run, collapse = ","), - " contains invalid runs. Valid runs are: ", run.valid) - } - } - - #set - if(is.null(set)){set <- unique(object@METADATA[["SET"]]) - } else{ - - if(TRUE %in% unique(unique(object@METADATA[["SET"]]) %in% set) != TRUE){ - - ##get and check valid positions - set.valid <- paste(as.character(unique(object@METADATA[,"SET"])), collapse=", ") - - .throw_error("set = ", paste(set, collapse = ","), - " contains invalid sets. Valid sets are: ", set.valid) - } - } - - ##ltype - if (is.null(ltype)) { - ltype <- unique(object@METADATA[["LTYPE"]]) - } else{ - if (TRUE %in% unique(unique(object@METADATA[, "LTYPE"]) %in% ltype) != TRUE) { - ##get and check valid positions - ltype.valid <- - paste(as.character(unique(object@METADATA[, "LTYPE"])), collapse = ", ") - - .throw_error("ltype = ", paste(ltype, collapse = ","), - " contains invalid ltypes. Valid ltypes are: ", ltype.valid) - } - } - - ##dtype - if (is.null(dtype)) { - dtype <- unique(object@METADATA[["DTYPE"]]) - } else{ - if (TRUE %in% unique(unique(object@METADATA[, "DTYPE"]) %in% dtype) != TRUE) { - ##get and check valid positions - dtype.valid <- - paste(as.character(unique(object@METADATA[, "DTYPE"])), collapse = ", ") - - .throw_error("dtype = ", paste(dtype, collapse = ","), - " contains invalid dtypes. Valid dtypes are: ", dtype.valid) - } - } - - # Select values and convert them----------------------------------------------------------- - ##set progressbar to false if only one position is provided - if(txtProgressBar & length(pos)<2){ - txtProgressBar <- FALSE - } - - ##This loop does: - ## (a) iterating over all possible positions - ## (b) consider grains in all possible positions - ## (c) consider other selections - ## (d) create the RLum.Analysis objects - - ##set progress bar - if(txtProgressBar){ - pb <- txtProgressBar(min=min(pos),max=max(pos), char="=", style=3) - } - - object <- lapply(pos, function(pos){ - - ##update progress bar - if(txtProgressBar){ - setTxtProgressBar(pb, value = pos) - } - - ##if no grain information is given, we select all grains in the particular position - if(is.null(grain)){ - grain <- unique(object@METADATA[object@METADATA[["POSITION"]] == pos, "GRAIN"]) - } - - ##loop over the grains and produce RLum.Analysis objects - object <- lapply(grain, function(grain){ - - ## select data - ## the NA check for grain is necessary as FI readers like to report - ## NA instead of 0 in that column, and this causes some trouble - temp_id <- object@METADATA[ - object@METADATA[["POSITION"]] == pos & - (is.na(object@METADATA[["GRAIN"]]) | - object@METADATA[["GRAIN"]] == grain) & - object@METADATA[["RUN"]] %in% run & - object@METADATA[["SET"]] %in% set & - object@METADATA[["LTYPE"]] %in% ltype & - object@METADATA[["DTYPE"]] %in% dtype - , "ID"] - - ## if the input object is empty, bypass the creation of curve objects - if (length(object@DATA) == 0) { - message("Empty Risoe.BINfileData object detected") - records <- list() - } else { - ## create curve object - records <- lapply(temp_id, function(x) { - ## skip ROI information - if (!is.null(object@METADATA[["RECTYPE"]]) && - object@METADATA[["RECTYPE"]][x] == 128) - set_RLum(class = "RLum.Data.Curve") - else - .Risoe.BINfileData2RLum.Data.Curve(object, id = x) - }) - } - - ## create the RLum.Analysis object - object <- set_RLum( - class = "RLum.Analysis", - records = records, - protocol = protocol, - originator = "Risoe.BINfileData2RLum.Analysis" - ) - - if (!keep.empty && length(object@records) == 0) - return(NULL) - - ##add unique id of RLum.Analysis object to each curve object as .pid using internal function - .set_pid(object) - - return(object) - }) - - return(object) - }) - - ##this is necessary to not break with previous code, i.e. if only one element is included - ##the output is RLum.Analysis and not a list of it - if(length(object) == 1){ - - # special case: single grain data with only 1 position produces a nested list - # the outer one is of length 1, the nested list has length 100 (100 grains) - if (is.list(object[[1]]) && length(object[[1]]) > 1) - invisible(unlist(object)) - else - invisible(object[[1]][[1]]) - - }else{ - - invisible(unlist(object)) - } -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/Risoe.BINfileData2RLum.Data.Curve.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/Risoe.BINfileData2RLum.Data.Curve.R deleted file mode 100644 index b2d1770e6..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/Risoe.BINfileData2RLum.Data.Curve.R +++ /dev/null @@ -1,108 +0,0 @@ -#' Convert an element from a Risoe.BINfileData object to an RLum.Data.Curve -#' object -#' -#' The function converts one specified single record from a Risoe.BINfileData -#' object to an RLum.Data.Curve object. -#' -#' The function extracts all `METADATA` from the `Risoe.BINfileData` -#' object and stores them in the `RLum.Data.Curve` object. This function -#' can be used stand-alone, but is the base function for [Risoe.BINfileData2RLum.Analysis]. -#' -#' @param object [Risoe.BINfileData-class] (**required**): -#' `Risoe.BINfileData` object -#' -#' @param id [integer] (**required**): -#' record id in the `Risoe.BINfileData` object of the curve that is to be -#' stored in the `RLum.Data.Curve` object. If no value for id is provided, -#' the record has to be specified by `pos`, `set` and `run`. -#' -#' @param pos [integer] (*optional*): -#' record position number in the `Risoe.BINfileData` object of the curve that -#' is to be stored in the `RLum.Data.Curve` object. If a value for `id` is -#' provided, this argument is ignored. -#' -#' @param run [integer] (*optional*): -#' record run number in the `Risoe.BINfileData` object of the curve that is -#' to be stored in the `RLum.Data.Curve` object. If a value for `id` is -#' provided, this argument is ignored. -#' -#' @param set [integer] (*optional*): -#' record set number in the `Risoe.BINfileData` object of the curve that is -#' to be stored in the `RLum.Data.Curve` object. If a value for `id` is -#' provided, this argument is ignored. -#' -#' @return Returns an [RLum.Data.Curve-class] object. -#' -#' @note -#' Due to changes in the BIN-file (version 3 to version 4) format the recalculation of TL-curves might be not -#' overall correct for cases where the TL measurement is combined with a preheat. -#' -#' @section Function version: 0.5.0 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -#' Christoph Burow, Universtiy of Cologne (Germany) -#' -#' @seealso [Risoe.BINfileData2RLum.Analysis], [set_RLum], -#' [RLum.Data.Curve-class], [RLum.Analysis-class], [Risoe.BINfileData-class], -#' [plot_RLum] -#' -#' @keywords manip -#' -#' @examples -#' -#' ##get package example data -#' data(ExampleData.BINfileData, envir = environment()) -#' -#' ##convert one record -#' Risoe.BINfileData2RLum.Data.Curve(CWOSL.SAR.Data, id = 1) -#' -#' @md -#' @noRd -.Risoe.BINfileData2RLum.Data.Curve <- function( - object, - id, - pos, - run, - set -){ - - ##disaggregate object ... this makes it much faster below - ##we could also access via index, not number, but this is far to risky, as - ##every update in the BIN-file version will break the code here - METADATA <- as.list(object@METADATA) - DATA <- object@DATA - - # grep id of record ------------------------------------------------------- - ##if id is set, no input for pos and run is necessary - if (missing(id)) { - id <- METADATA$ID[METADATA[["POSITION"]] == pos & - METADATA[["SET"]] == set & - METADATA[["RUN"]] == run] - } - - ##grep info elements - info <- lapply(1:length(names(METADATA)), function(x){METADATA[[x]][id]}) - names(info) <- names(METADATA) - - # Build object ------------------------------------------------------------ - set_RLum( - class = "RLum.Data.Curve", - recordType = METADATA[["LTYPE"]][id], - data = src_create_RLumDataCurve_matrix( - DATA = DATA[[id]], - NPOINTS = METADATA[["NPOINTS"]][id], - VERSION = METADATA[["VERSION"]][id], - LTYPE = METADATA[["LTYPE"]][id], - LOW = METADATA[["LOW"]][id], - HIGH = METADATA[["HIGH"]][id], - AN_TEMP = METADATA[["AN_TEMP"]][id], - TOLDELAY = METADATA[["TOLDELAY"]][id], - TOLON = METADATA[["TOLON"]][id], - TOLOFF = METADATA[["TOLOFF"]][id] - - ), - info = info - ) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/Second2Gray.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/Second2Gray.R deleted file mode 100644 index ddb24d156..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/Second2Gray.R +++ /dev/null @@ -1,221 +0,0 @@ -#' Converting equivalent dose values from seconds (s) to Gray (Gy) -#' -#' Conversion of absorbed radiation dose in seconds (s) to the SI unit Gray -#' (Gy) including error propagation. Normally used for equivalent dose data. -#' -#' Calculation of De values from seconds (s) to Gray (Gy) -#' -#' \deqn{De [Gy] = De [s] * Dose Rate [Gy/s])} -#' -#' Provided calculation error propagation methods for error calculation -#' (with `'se'` as the standard error and `'DR'` of the dose rate of the beta-source): -#' -#' **(1) `omit`** (default) -#' -#' \deqn{se(De) [Gy] = se(De) [s] * DR [Gy/s]} -#' -#' In this case the standard error of the dose rate of the beta-source is -#' treated as systematic (i.e. non-random), it error propagation is omitted. -#' However, the error must be considered during calculation of the final age. -#' (cf. Aitken, 1985, pp. 242). This approach can be seen as method (2) (gaussian) -#' for the case the (random) standard error of the beta-source calibration is -#' 0. Which particular method is requested depends on the situation and cannot -#' be prescriptive. -#' -#' **(2) `gaussian`** error propagation -#' -#' \deqn{se(De) [Gy] = \sqrt((DR [Gy/s] * se(De) [s])^2 + (De [s] * se(DR) [Gy/s])^2)} -#' -#' Applicable under the assumption that errors of `De` and `se` are uncorrelated. -#' -#' **(3) `absolute`** error propagation -#' -#' \deqn{se(De) [Gy]= abs(DR [Gy/s] * se(De) [s]) + abs(De [s] * se(DR) [Gy/s])} -#' -#' Applicable under the assumption that errors of `De` and `se` are correlated. -#' -#' -#' @param data [data.frame] (**required**): -#' input values, structure: data (`values[,1]`) and data error (`values [,2]`) -#' are required -#' -#' @param dose.rate [RLum.Results-class], [data.frame] or [numeric] (**required**): -#' `RLum.Results` needs to be originated from the function [calc_SourceDoseRate], -#' for `vector` dose rate in Gy/s and dose rate error in Gy/s -#' -#' @param error.propagation [character] (*with default*): -#' error propagation method used for error calculation (`omit`, `gaussian` or -#' `absolute`), see details for further information -#' -#' @return -#' Returns a [data.frame] with converted values. -#' -#' @note -#' If no or a wrong error propagation method is given, the execution of the function is -#' stopped. Furthermore, if a `data.frame` is provided for the dose rate values is has to -#' be of the same length as the data frame provided with the argument `data` -#' -#' @section Function version: 0.6.0 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -#' Michael Dietze, GFZ Potsdam (Germany)\cr -#' Margret C. Fuchs, HZDR, Helmholtz-Institute Freiberg for Resource Technology (Germany) -#' -#' @seealso [calc_SourceDoseRate] -#' -#' @references -#' Aitken, M.J., 1985. Thermoluminescence dating. Academic Press. -#' -#' @keywords manip -#' -#' @examples -#' -#' ##(A) for known source dose rate at date of measurement -#' ## - load De data from the example data help file -#' data(ExampleData.DeValues, envir = environment()) -#' ## - convert De(s) to De(Gy) -#' Second2Gray(ExampleData.DeValues$BT998, c(0.0438,0.0019)) -#' -#' -#' -#' -#' -#' ##(B) for source dose rate calibration data -#' ## - calculate source dose rate first -#' dose.rate <- calc_SourceDoseRate(measurement.date = "2012-01-27", -#' calib.date = "2014-12-19", -#' calib.dose.rate = 0.0438, -#' calib.error = 0.0019) -#' # read example data -#' data(ExampleData.DeValues, envir = environment()) -#' -#' # apply dose.rate to convert De(s) to De(Gy) -#' Second2Gray(ExampleData.DeValues$BT998, dose.rate) -#' -#' @md -#' @export -Second2Gray <- function( - data, - dose.rate, - error.propagation = "omit" -){ - - # Integrity tests ----------------------------------------------------------------------------- - - ##(1) data.frame or RLum.Data.Curve object? - if(!is(data, "data.frame")){ - - stop("[Second2Gray()] 'data' object has to be of type 'data.frame'!") - - } - - ##(2) numeric, data.frame or RLum.Data.Curve object? - if(!is(dose.rate, "numeric") & !is(dose.rate, "RLum.Results") & !is(dose.rate, "data.frame")){ - - stop("[Second2Gray()] 'dose.rate' object has to be of type 'numeric', 'data.frame' or 'RLum.Results'!") - - } - - - ##(3) last check to avoid problems - if(is(dose.rate, "data.frame")){ - - if(nrow(dose.rate)!=nrow(data)){ - - stop("[Second2Gray()] the data frames in 'data' and 'dose.rate' need to be of similar length!") - - } - - } - - - ##(4) check for right orginator - if(is(dose.rate, "RLum.Results")){ - - if(dose.rate@originator != "calc_SourceDoseRate"){ - - stop("[Second2Gray()] Wrong originator for dose.rate 'RLum.Results' object.") - - }else{ - - ##check what is what - if(!is(get_RLum(dose.rate, data.object = "dose.rate"), "data.frame")){ - - dose.rate <- data.frame( - dose.rate <- as.numeric(get_RLum(dose.rate, data.object = "dose.rate")[1]), - dose.rate.error <- as.numeric(get_RLum(dose.rate, data.object = "dose.rate")[2]) - ) - - }else{ - - dose.rate <- get_RLum(dose.rate, data.object = "dose.rate") - - } - - } - - } - - - # Calculation --------------------------------------------------------------------------------- - - - De.seconds <- data[,1] - De.error.seconds <- data[,2] - - De.gray <- NA - De.error.gray <- NA - - if(is(dose.rate,"data.frame")){ - De.gray <- round(De.seconds*dose.rate[,1], digits=2) - - }else{ - De.gray <- round(De.seconds*dose.rate[1], digits=2) - - } - - if(error.propagation == "omit"){ - - if(is(dose.rate,"data.frame")){ - De.error.gray <- round(dose.rate[,1]*De.error.seconds, digits=3) - - }else{ - De.error.gray <- round(dose.rate[1]*De.error.seconds, digits=3) - - } - - }else if(error.propagation == "gaussian"){ - - if(is(dose.rate,"data.frame")){ - De.error.gray <- round(sqrt((De.seconds*dose.rate[,2])^2+(dose.rate[,1]*De.error.seconds)^2), digits=3) - - }else{ - De.error.gray <- round(sqrt((De.seconds*dose.rate[2])^2+(dose.rate[1]*De.error.seconds)^2), digits=3) - - } - - }else if (error.propagation == "absolute"){ - - if(is(dose.rate,"data.frame")){ - De.error.gray <- round(abs(dose.rate[,1] * De.error.seconds) + abs(De.seconds * dose.rate[,2]), digits=3) - - }else{ - De.error.gray <- round(abs(dose.rate[1] * De.error.seconds) + abs(De.seconds * dose.rate[2]), digits=3) - - } - - }else{ - - stop("[Second2Gray()] unsupported error propagation method!" ) - - } - - # Return -------------------------------------------------------------------------------------- - - data <- data.frame(De=De.gray, De.error=De.error.gray) - - - return(data) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/addins_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/addins_RLum.R deleted file mode 100644 index 0c3bef40b..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/addins_RLum.R +++ /dev/null @@ -1,74 +0,0 @@ -################################################################################## -## Luminescence - RStudio Add Ins ## -################################################################################## -##<> -## -## - Add-ins should support more experienced users. For all others we have the package 'RLumShiny' -## -## - Add-ins should be provided as non-exported function only, having the a name with a leading dot, e.g., .addin. -## This prevents further chaos in the manuel. -## -## - Interactive add-ins are not desired, except they are implemented in the package 'RLumShiny' or they -## are only available if the package 'RLumShiny' is available. -## -## -##<> -## -## Q. Why are the add-ins non-interactive ... had you been too lazy? -## A. No, but interactivity would require the installation of 'shiny" by default, which is not -## desired. -## -## Q. The add-ins are not shown in the 'Addin' menu? -## A. Well, if you read this information you are an advanced used, so please install the -## package 'rstudioapi', 'devtools' and get happy. - - -#'Install package development version -#' -#'The function uses the GitHub APconnection provided by Christoph Burow -#' -#'@author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#'@noRd -.installDevelopmentVersion <- function(){ - install_DevelopmentVersion(force_install = TRUE) # nocov -} - -#'Search for TODOs in the source code and list them in the terminal -#' -#'This add-in is a tool developers may want to use to briefly list all open -#'issues in the terminal, instead of using search and stepping through the results. -#' -#'@author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#'@noRd -.listTODO <- function(){ - # nocov start - ##check if package is installed - if(!requireNamespace("rstudioapi", quietly = TRUE)){ - message("Package 'rstudioapi' is not installed but needed to search for TODOs, do you want to install it?\n\n", - " [n/N]: No (default)\n", - " [y/Y]: Yes\n") - - ##parse answer - answer <- readline() - - if(tolower(answer) == "y"){ - utils::install.packages("rstudioapi", dependencies = TRUE) - } - }else{ - - ##parse code - code <- rstudioapi::getActiveDocumentContext()$contents - - ##get lines with ##TODO - id <- grep(pattern = "#\\s*TODO", x = code, fixed = FALSE) - - ##list lines - cat("\n", "[", length(id), " issue(s)]\n", sep = "") - for(i in id){ - cat(" line ", i, ": ->", code[i], "\n", sep = "") - } - } - # nocov end -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_Al2O3C_CrossTalk.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_Al2O3C_CrossTalk.R deleted file mode 100644 index a3665ba65..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_Al2O3C_CrossTalk.R +++ /dev/null @@ -1,412 +0,0 @@ -#' @title Al2O3:C Reader Cross Talk Analysis -#' -#' @description The function provides the analysis of cross-talk measurements on a -#' FI lexsyg SMART reader using Al2O3:C chips -#' -#' @param object [RLum.Analysis-class] **(required)**: -#' measurement input -#' -#' @param signal_integral [numeric] (*optional*): -#' signal integral, used for the signal and the background. -#' If nothing is provided the full range is used -#' -#' @param dose_points [numeric] (*with default*): -#' vector with dose points, if dose points are repeated, only the general -#' pattern needs to be provided. Default values follow the suggestions -#' made by Kreutzer et al., 2018 -#' -#' @param recordType [character] (*with default*): input curve selection, which is passed to -#' function [get_RLum]. To deactivate the automatic selection set the argument to `NULL` -#' -#' @param irradiation_time_correction [numeric] or [RLum.Results-class] (*optional*): -#' information on the used irradiation time correction obtained by another experiments. -#' -#' @param method_control [list] (*optional*): -#' optional parameters to control the calculation. -#' See details for further explanations -#' -#' @param plot [logical] (*with default*): -#' enable/disable plot output -#' -#' @param ... further arguments that can be passed to the plot output -#' -#' @return -#' Function returns results numerically and graphically: -#' -#' -----------------------------------\cr -#' `[ NUMERICAL OUTPUT ]`\cr -#' -----------------------------------\cr -#' -#' **`RLum.Results`**-object -#' -#' **slot:** **`@data`** -#' -#' \tabular{lll}{ -#' **Element** \tab **Type** \tab **Description**\cr -#' `$data` \tab `data.frame` \tab summed apparent dose table \cr -#' `$data_full` \tab `data.frame` \tab full apparent dose table \cr -#' `$fit` \tab `lm` \tab the linear model obtained from fitting \cr -#' `$col.seq` \tab `numeric` \tab the used colour vector \cr -#' } -#' -#' **slot:** **`@info`** -#' -#' The original function call -#' -#' ------------------------\cr -#' `[ PLOT OUTPUT ]`\cr -#' ------------------------\cr -#' -#' - An overview of the obtained apparent dose values -#' -#' @section Function version: 0.1.3 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [analyse_Al2O3C_ITC] -#' -#' @references -#' -#' Kreutzer, S., Martin, L., Guérin, G., Tribolo, C., Selva, P., Mercier, N., 2018. Environmental Dose Rate -#' Determination Using a Passive Dosimeter: Techniques and Workflow for alpha-Al2O3:C Chips. -#' Geochronometria 45, 56-67. doi: 10.1515/geochr-2015-0086 -#' -#' @keywords datagen -#' -#' @examples -#' -#' ##load data -#' data(ExampleData.Al2O3C, envir = environment()) -#' -#' ##run analysis -#' analyse_Al2O3C_CrossTalk(data_CrossTalk) -#' -#' @md -#' @export -analyse_Al2O3C_CrossTalk <- function( - object, - signal_integral = NULL, - dose_points = c(0,4), - recordType = c("OSL (UVVIS)"), - irradiation_time_correction = NULL, - method_control = NULL, - plot = TRUE, - ... -){ - - # Integrity check --------------------------------------------------------------------------- - - ##check input object - if(!all(unlist(lapply(object, function(x){is(x, "RLum.Analysis")})))){ - stop("[analyse_Al2O3C_CrossTalk()] The elements in 'object' are not all of type 'RLum.Analysis'", call. = FALSE) - - } - - ##TODO ... do more, push harder - ##Accept the entire sequence ... including TL and extract - ##Add sufficient unit tests - - # Preparation --------------------------------------------------------------------------------- - ##select curves based on the recordType selection; if not NULL - if(!is.null(recordType)){ - object <- get_RLum(object, recordType = recordType, drop = FALSE) - - } - - #set method control - method_control_settings <- list( - fit.method = "EXP" - - ) - - ##modify on request - if(!is.null(method_control)){ - if (!is.list(method_control)) { - stop("[analyse_Al2O3C_CrossTalk()] 'method_control' is expected ", - "to be a list", call. = FALSE) - } - method_control_settings <- modifyList(x = method_control_settings, val = method_control) - - } - - - ##set signal integral - if(is.null(signal_integral)){ - signal_integral <- c(1:nrow(object[[1]][[1]][])) - - }else{ - ##check whether the input is valid, otherwise make it valid - if(min(signal_integral) < 1 | max(signal_integral) > nrow(object[[1]][[1]][])){ - signal_integral <- c(1:nrow(object[[1]][[1]][])) - warning( - paste0( - "[analyse_Al2O3C_ITC()] Input for 'signal_integral' corrected to 1:", nrow(object[[1]][[1]][]) - ), - call. = FALSE - ) - } - - } - - ##check irradiation time correction - if (!is.null(irradiation_time_correction)) { - - if (!is.numeric(irradiation_time_correction) && - !is(irradiation_time_correction, "RLum.Results")) { - stop("[analyse_Al2O3C_CrossTalk()] 'irradiation_time_correction' ", - "is expected to be a numeric value or an RLum.Results object", - call. = FALSE) - } - - if (is(irradiation_time_correction, "RLum.Results")) { - if (irradiation_time_correction@originator == "analyse_Al2O3C_ITC") { - irradiation_time_correction <- get_RLum(irradiation_time_correction) - - ##insert case for more than one observation ... - if(nrow(irradiation_time_correction)>1){ - irradiation_time_correction <- c(mean(irradiation_time_correction[[1]]), sd(irradiation_time_correction[[1]])) - - }else{ - irradiation_time_correction <- c(irradiation_time_correction[[1]], irradiation_time_correction[[2]]) - - } - - } else{ - stop( - "[analyse_Al2O3C_CrossTalk()] The object provided for the argument 'irradiation_time_correction' was created by an unsupported function!", - call. = FALSE - ) - } - } - } - - # Calculation --------------------------------------------------------------------------------- - ##we have two dose points, and one background curve, we do know only the 2nd dose - - ##create signal table list - signal_table_list <- lapply(1:length(object), function(i) { - ##calculate all the three signals needed - BACKGROUND <- sum(object[[i]][[3]][, 2]) - NATURAL <- sum(object[[i]][[1]][, 2]) - REGENERATED <- sum(object[[i]][[2]][, 2]) - - temp_df <- data.frame( - POSITION = get_RLum(object[[i]][[1]], info.object = "position"), - DOSE = if(!is.null(irradiation_time_correction)){ - dose_points + irradiation_time_correction[1] - }else{ - dose_points - }, - DOSE_ERROR = if(!is.null(irradiation_time_correction)){ - dose_points * irradiation_time_correction[2]/irradiation_time_correction[1] - }else{ - 0 - }, - STEP = c("NATURAL", "REGENERATED"), - INTEGRAL = c(NATURAL, REGENERATED), - BACKGROUND = c(BACKGROUND, BACKGROUND), - NET_INTEGRAL = c(NATURAL - BACKGROUND, REGENERATED - BACKGROUND), - row.names = NULL - ) - - ##0 dose points should not be biased by the correction .. - id_zero <- which(dose_points == 0) - temp_df$DOSE[id_zero] <- 0 - temp_df$DOSE_ERROR[id_zero] <- 0 - - return(temp_df) - - }) - - APPARENT_DOSE <- as.data.frame(data.table::rbindlist(lapply(1:length(object), function(x){ - - ##run in MC run - if(!is.null(irradiation_time_correction)){ - DOSE <- rnorm(1000, mean = signal_table_list[[x]]$DOSE[2], sd = signal_table_list[[x]]$DOSE_ERROR[2]) - - }else{ - DOSE <- signal_table_list[[x]]$DOSE[2] - - } - - - ##calculation - temp <- (DOSE * signal_table_list[[x]]$NET_INTEGRAL[1])/signal_table_list[[x]]$NET_INTEGRAL[2] - - data.frame( - POSITION = signal_table_list[[x]]$POSITION[1], - AD = mean(temp), - AD_ERROR = sd(temp)) - - }))) - - ##add apparent dose to the information - signal_table_list <- lapply(1:length(signal_table_list), function(x){ - cbind(signal_table_list[[x]], rep(APPARENT_DOSE[x,2:3], 2)) - - }) - - ##combine - data_full <- as.data.frame(data.table::rbindlist(signal_table_list), stringsAsFactors = FALSE) - - # Plotting ------------------------------------------------------------------------------------ - ## set colours - col_pal <- grDevices::hcl.colors(100, palette = "RdYlGn", rev = TRUE) - - ##get plot settings - par.default <- par(no.readonly = TRUE) - on.exit(par(par.default)) - - ##settings - plot_settings <- list( - main = "Sample Carousel Crosstalk", - mtext = "" - ) - - ##modify on request - plot_settings <- modifyList(x = plot_settings, list(...)) - - - ##pre-calculations for graphical parameters - n.positions <- length(unique(APPARENT_DOSE$POSITION)) - arc.step <- (2 * pi) / n.positions - step <- 0 - - ##condense data.frame, by calculating the mean for similar positions - AD_matrix <- t(vapply(sort(unique(APPARENT_DOSE$POSITION)), function(x){ - c(x,mean(APPARENT_DOSE[["AD"]][APPARENT_DOSE[["POSITION"]] == x]), - sd(APPARENT_DOSE[["AD"]][APPARENT_DOSE[["POSITION"]] == x])) - - }, FUN.VALUE = vector(mode = "numeric", length = 3))) - - ##create colour ramp - col.seq <- data.frame( - POSITION = AD_matrix[order(AD_matrix[,2]),1], - COLOUR = col_pal[seq(1,100, length.out = nrow(AD_matrix))], - stringsAsFactors = FALSE) - - col.seq <- col.seq[["COLOUR"]][order(col.seq[["POSITION"]])] - - ##calculate model - fit <- lm( - formula = y ~ poly(x, 2, raw=TRUE), - data = data.frame(y = APPARENT_DOSE$AD[order(APPARENT_DOSE$POSITION)], x = sort(APPARENT_DOSE$POSITION))) - - ##enable or disable plot ... we cannot put the condition higher, because we here - ##calculate something we are going to need later - if (plot) { - - ##set layout matrix - layout(mat = matrix( - c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 3, 1, 1, 1, 1, 3), - 5, - 5, - byrow = TRUE - )) - - ##create empty plot - par( - mar = c(1, 1, 1, 1), - omi = c(1, 1, 1, 1), - oma = c(0.2, 0.2, 0.2, 0.2), - cex = 1.1 - ) - shape::emptyplot(c(-1.15, 1.15), main = plot_settings$main, frame.plot = FALSE) - - ##add outher circle - shape::plotcircle(r = 1.1, col = rgb(0.9, 0.9, 0.9, 1)) - - ##add inner octagon - shape::filledcircle( - r1 = 0.6, - mid = c(0, 0), - lwd = 1, - lcol = "black", - col = "white" - ) - - ##add circles - for (i in 1:n.positions) { - shape::plotcircle( - r = 0.05, - mid = c(cos(step), sin(step)), - cex = 6, - pch = 20, - col = col.seq[i] - ) - text(x = cos(step) * 0.85, - y = sin(step) * .85, - labels = i) - step <- step + arc.step - - } - - ##add center plot with position - plot(NA, NA, - xlim = range(AD_matrix[,1]), - ylim = range(APPARENT_DOSE[,2]), - frame.plot = FALSE, - type = "l") - - ##add points - points(x = APPARENT_DOSE, pch = 20, col = rgb(0,0,0,0.3)) - - ##add linear model - lines(sort(APPARENT_DOSE$POSITION), predict(fit), col = "red") - - ##add colour legend - shape::emptyplot(c(-1.2, 1.2), frame.plot = FALSE) - graphics::rect( - xleft = rep(-0.6, 100), - ybottom = seq(-1.2,1.1,length.out = 100), - xright = rep(0, 100), - ytop = seq(-1.1,1.2,length.out = 100), - col = col_pal, - lwd = 0, - border = FALSE - ) - - ##add scale text - text( - x = -0.3, - y = 1.2, - label = "[s]", - pos = 3, - cex = 1.1 - ) - text( - x = 0.4, - y = 1, - label = round(max(AD_matrix[, 2]),2), - pos = 3, - cex = 1.1 - ) - text( - x = 0.4, - y = -1.5, - label = 0, - pos = 3, - cex = 1.1 - ) - - } - - # Output -------------------------------------------------------------------------------------- - output <- set_RLum( - class = "RLum.Results", - data = list( - data = data.frame( - POSITION = AD_matrix[,1], - AD = AD_matrix[,2], - AD_ERROR = AD_matrix[,3] - ), - data_full = data_full, - fit = fit, - col.seq = col.seq - ), - info = list( - call = sys.call() - ) - ) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_Al2O3C_ITC.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_Al2O3C_ITC.R deleted file mode 100644 index c1c9f8440..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_Al2O3C_ITC.R +++ /dev/null @@ -1,379 +0,0 @@ -#' @title Al2O3 Irradiation Time Correction Analysis -#' -#' @description The function provides a very particular analysis to correct the irradiation -#' time while irradiating Al2O3:C chips in a luminescence reader. -#' -#' @details Background: Due to their high dose sensitivity Al2O3:C chips are usually -#' irradiated for only a very short duration or under the closed beta-source -#' within a luminescence reader. However, due to its high dose sensitivity, during -#' the movement towards the beta-source, the pellet already receives and non-negligible -#' dose. Based on measurements following a protocol suggested by Kreutzer et al., 2018, -#' a dose response curve is constructed and the intersection (absolute value) with the time axis -#' is taken as real irradiation time. -#' -#' **`method_control`** -#' -#' To keep the generic argument list as clear as possible, arguments to allow a -#' deeper control of the method are all preset with meaningful default parameters and can be -#' handled using the argument `method_control` only, e.g., -#' `method_control = list(fit.method = "LIN")`. Supported arguments are: -#' -#' \tabular{lll}{ -#' **ARGUMENT** \tab **FUNCTION** \tab **DESCRIPTION**\cr -#' `mode` \tab `plot_GrowthCurve` \tab as in [plot_GrowthCurve]; sets the mode used for fitting\cr -#' `fit.method` \tab `plot_GrowthCurve` \tab as in [plot_GrowthCurve]; sets the function applied for fitting\cr -#' } -#' -#' @param object [RLum.Analysis-class] or [list] **(required)**: -#' results obtained from the measurement. -#' Alternatively a list of [RLum.Analysis-class] objects can be provided to allow an automatic analysis -#' -#' @param signal_integral [numeric] (*optional*): -#' signal integral, used for the signal and the background. -#' If nothing is provided the full range is used. Argument can be provided as [list]. -#' -#' @param dose_points [numeric] (*with default*): -#' vector with dose points, if dose points are repeated, only the general -#' pattern needs to be provided. Default values follow the suggestions -#' made by Kreutzer et al., 2018. Argument can be provided as [list]. -#' -#' @param recordType [character] (*with default*): input curve selection, which is passed to -#' function [get_RLum]. To deactivate the automatic selection set the argument to `NULL` -#' -#' @param method_control [list] (*optional*): -#' optional parameters to control the calculation. -#' See details for further explanations -#' -#' @param verbose [logical] (*with default*): -#' enable/disable verbose mode -#' -#' @param plot [logical] (*with default*): -#' enable/disable plot output -#' -#' @param ... further arguments that can be passed to the plot output -#' -#' @return -#' Function returns results numerically and graphically: -#' -#' -----------------------------------\cr -#' `[ NUMERICAL OUTPUT ]`\cr -#' -----------------------------------\cr -#' -#' **`RLum.Results`**-object -#' -#' **slot:** **`@data`** -#' -#' \tabular{lll}{ -#' **Element** \tab **Type** \tab **Description**\cr -#' `$data` \tab `data.frame` \tab correction value and error \cr -#' `$table` \tab `data.frame` \tab table used for plotting \cr -#' `$table_mean` \tab `data.frame` \tab table used for fitting \cr -#' `$fit` \tab `lm` or `nls` \tab the fitting as returned by the function [plot_GrowthCurve] -#' } -#' -#'**slot:** **`@info`** -#' -#' The original function call -#' -#' ------------------------\cr -#' `[ PLOT OUTPUT ]`\cr -#' ------------------------\cr -#' -#' - A dose response curve with the marked correction values -#' -#' @section Function version: 0.1.1 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [plot_GrowthCurve] -#' -#' @references -#' -#' Kreutzer, S., Martin, L., Guérin, G., Tribolo, C., Selva, P., Mercier, N., 2018. Environmental Dose Rate -#' Determination Using a Passive Dosimeter: Techniques and Workflow for alpha-Al2O3:C Chips. -#' Geochronometria 45, 56-67. doi: 10.1515/geochr-2015-0086 -#' -#' @keywords datagen -#' -#' @examples -#' -#' ##load data -#' data(ExampleData.Al2O3C, envir = environment()) -#' -#' ##run analysis -#' analyse_Al2O3C_ITC(data_ITC) -#' -#' @md -#' @export -analyse_Al2O3C_ITC <- function( - object, - signal_integral = NULL, - dose_points = c(2,4,8,12,16), - recordType = c("OSL (UVVIS)"), - method_control = NULL, - verbose = TRUE, - plot = TRUE, - ... -){ - - - # SELF CALL ----------------------------------------------------------------------------------- - if(is.list(object)){ - ##check whether the list contains only RLum.Analysis objects - if(!all(unique(sapply(object, class)) == "RLum.Analysis")){ - .throw_error("All elements in the 'object' list must be of type 'RLum.Analysis'") - } - - ##expand input arguments - if(!is.null(signal_integral)){ - signal_integral <- rep(list(signal_integral, length = length(object))) - } - - ##dose points - if(is(dose_points, "list")){ - dose.points <- rep(dose_points, length = length(object)) - - }else{ - dose_points <- rep(list(dose_points), length = length(object)) - - } - - ##method_control - ##verbose - ##plot - - ##run analysis - results_full <- lapply(1:length(object), function(x){ - ##run analysis - results <- try(analyse_Al2O3C_ITC( - object = object[[x]], - signal_integral = signal_integral[[x]], - dose_points = dose_points[[x]], - method_control = method_control, - verbose = verbose, - plot = plot, - main = ifelse("main"%in% names(list(...)), list(...)$main, paste0("ALQ #",x)), - ... - ), outFile = stdout()) # redirect error messages so they can be silenced - - ##catch error - if(inherits(results, "try-error")){ - return(NULL) - - }else{ - return(results) - - } - - }) - - ##return - return(merge_RLum(results_full)) - - } - - # Integrity check --------------------------------------------------------------------------- - ##check input object - if(!inherits(object, "RLum.Analysis")){ - .throw_error("'object' must be of type 'RLum.Analysis'") - } - - ##TODO - ##implement more checks ... if you find some time, somehow, somewhere - - # Preparation --------------------------------------------------------------------------------- - ##select curves based on the recordType selection; if not NULL - if(!is.null(recordType[1])) - object <- get_RLum(object, recordType = recordType, drop = FALSE) - - #set method control - method_control_settings <- list( - mode = "extrapolation", - fit.method = "EXP" - - ) - - ## modify on request - if (!is.null(method_control)) { - if (!is.list(method_control)) { - .throw_error("'method_control' is expected to be a list") - } - method_control_settings <- modifyList(x = method_control_settings, val = method_control) - - } - - - ##dose points enhancement - ##make sure that the dose_point is enhanced - dose_points <- rep(dose_points, times = length(object)/2) - - # Calculation --------------------------------------------------------------------------------- - ##set signal integral - if(is.null(signal_integral)){ - signal_integral <- c(1:nrow(object[[1]][])) - - }else{ - ##check whether the input is valid, otherwise make it valid - if(min(signal_integral) < 1 | max(signal_integral) > nrow(object[[1]][])){ - signal_integral <- c(1:nrow(object[[1]][])) - .throw_warning("Input for 'signal_integral' corrected to 1:", - max(signal_integral)) - } - - } - - ##calculate curve sums, assuming the background - net_SIGNAL <- vapply(1:length(object[seq(1,length(object), by = 2)]), function(x){ - temp_signal <- sum(object[seq(1,length(object), by = 2)][[x]][,2]) - temp_background <- sum(object[seq(2,length(object), by = 2)][[x]][,2]) - return(temp_signal - temp_background) - - }, FUN.VALUE = vector(mode = "numeric", length = 1)) - - ##create data.frames - ##single points - df <- data.frame( - DOSE = dose_points, - net_SIGNAL = net_SIGNAL, - net_SIGNAL.ERROR = 0, - net_SIGNAL_NORM = net_SIGNAL/max(net_SIGNAL), - net_SIGNAL_NORM.ERROR = 0 - ) - - ##take mean - ##make data frame for all curves for MC runs - df_mean <- as.data.frame(data.table::rbindlist(lapply(unique(df$DOSE), function(x){ - data.frame( - DOSE = x, - net_SIGNAL = mean(df[df$DOSE == x, "net_SIGNAL"]), - net_SIGNAL.ERROR = sd(df[df$DOSE == x, "net_SIGNAL"]), - net_SIGNAL_NORM = mean(df[df$DOSE == x, "net_SIGNAL_NORM"]), - net_SIGNAL_NORM.ERROR = sd(df[df$DOSE == x, "net_SIGNAL_NORM"]) - ) - }))) - - - ##calculate GC - GC <- plot_GrowthCurve( - sample = df_mean, - mode = method_control_settings$mode, - output.plotExtended = FALSE, - output.plot = FALSE, - fit.method = method_control_settings$fit.method, - verbose = FALSE - ) - - - ##output - if(verbose){ - cat("\n[analyse_Al2O3C_ITC()]\n") - cat(paste0("\n Used fit:\t\t",method_control_settings$fit.method)) - cat(paste0("\n Time correction value:\t", round(GC$De$De,3), " \u00B1 ", round(GC$De$De.Error, 3))) - cat("\n\n") - - } - - - # Plotting ------------------------------------------------------------------------------------ - if(plot){ - ##set plot settings - plot_settings <- list( - xlab = "Dose [s]", - ylab = "Integrated net GSL [a.u.]", - main = "Irradiation Time Correction", - xlim = c(-5, max(df$DOSE)), - ylim = c(0,max(df$net_SIGNAL)), - legend.pos = "right", - legend.text = "dose points", - mtext = "" - - ) - - ##modify list on request - plot_settings <- modifyList(x = plot_settings, val = list(...)) - - ##make plot area - plot(NA, NA, - xlim = plot_settings$xlim, - ylim = plot_settings$ylim, - xlab = plot_settings$xlab, - ylab = plot_settings$ylab, - main = plot_settings$main) - - ##add zero lines - abline(v = 0) - abline(h = 0) - - ##add dose points - points(x = df$DOSE, y = df$net_SIGNAL) - - ##add dose response curve - x <- seq(min(plot_settings$xlim), max(plot_settings$xlim), length.out = 100) - lines( - x = x, - y = eval(GC$Formula) - ) - - ##show offset - x <- 0 - lines(x = c(-GC$De[1], -GC$De[1]), y = c(eval(GC$Formula), 0), lty = 2, col = "red") - shape::Arrows( - x0 = 0, - y0 = eval(GC$Formula), - x1 = as.numeric(-GC$De[1]), - y1 = eval(GC$Formula), - arr.type = "triangle", - arr.adj = -0.5, - col = 'red', - cex = par()$cex) - - ##add text - text( - x = -GC$De[1] / 2, - y = eval(GC$Formula), - pos = 3, - labels = paste(round(GC$De[1],3), "\u00B1", round(GC$De[2], 3)), - col = 'red', - cex = 0.8) - - ##add 2nd x-axis - axis( - side = 1, - at = axTicks(side = 1), - labels = paste0("(",(axTicks(side = 1) + round(as.numeric(GC$De[1]),2)), ")"), - line = 1, - col.axis = "red", - lwd.ticks = 0, - lwd = 0, - cex.axis = 0.9 - ) - - ##add legend - legend( - plot_settings$legend.pos, - bty = "n", - pch = 1, - legend = plot_settings$legend.text - ) - - ##add mtext - mtext(side = 3, text = plot_settings$mtext) - - } - - # Output -------------------------------------------------------------------------------------- - return(set_RLum( - class = "RLum.Results", - data = list( - data = data.frame( - VALUE = as.numeric(GC$De$De), - VALUE_ERROR = as.numeric(sd(GC$De.MC)) - ), - table = df, - table_mean = df_mean, - fit = GC$Fit - ), - info = list(call = sys.call()) - )) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_Al2O3C_Measurement.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_Al2O3C_Measurement.R deleted file mode 100644 index f40c2a234..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_Al2O3C_Measurement.R +++ /dev/null @@ -1,663 +0,0 @@ -#' @title Al2O3:C Passive Dosimeter Measurement Analysis -#' -#' @description The function provides the analysis routines for measurements on a -#' FI lexsyg SMART reader using Al2O3:C chips according to Kreutzer et al., 2018 -#' -#' @details -#' -#' **Working with a travel dosimeter** -#' -#' The function allows to define particular aliquots as travel dosimeters. For example: -#' `travel_dosimeter = c(1,3,5)` sets aliquots 1, 3 and 5 as travel dosimeters. These dose values -#' of this dosimeters are combined and automatically subtracted from the obtained dose values -#' of the other dosimeters. -#' -#' **Calculate TL dose** -#' -#' The argument `calculate_TL_dose` provides the possibility to experimentally calculate a TL-dose, -#' i.e. an apparent dose value derived from the TL curve ratio. However, it should be noted that -#' this value is only a fall back in case something went wrong during the measurement of the optical -#' stimulation. The TL derived dose value is corrected for cross-talk and for the irradiation time, -#' but not considered if a travel dosimeter is defined. -#' -#' Calculating the palaeodose is possible without **any TL** curve in the sequence! -#' -#' **Test parameters** -#' -#' `TL_peak_shift` [numeric] (default: `15`): -#' -#' Checks whether the TL peak shift is bigger > 15 K, indicating a problem with the -#' thermal contact of the chip. -#' -#' `stimulation_power` [numeric] (default: `0.05`): -#' -#' So far available, information on the delivered optical stimulation are compared. Compared are -#' the information from the first curves with all others. If the ratio differs more from -#' unity than the defined by the threshold, a warning is returned. -#' -#' @param object [RLum.Analysis-class] (**required**): measurement input -#' -#' @param signal_integral [numeric] (*optional*): signal integral, used for the signal -#' and the background. Example: `c(1:10)` for the first 10 channels. -#' If nothing is provided the full range is used -#' -#' @param dose_points [numeric] (*with default*): -#' vector with dose points, if dose points are repeated, only the general -#' pattern needs to be provided. Default values follow the suggestions -#' made by Kreutzer et al., 2018 -#' -#' @param recordType [character] (*with default*): input curve selection, which is passed to -#' function [get_RLum]. To deactivate the automatic selection set the argument to `NULL` -#' -#' @param irradiation_time_correction [numeric] or [RLum.Results-class] (*optional*): -#' information on the used irradiation time correction obtained by another experiments. -#' If a `numeric` is provided it has to be of length two: mean, standard error -#' -#' @param calculate_TL_dose [logical] (*with default*): Enables/disables experimental dose estimation -#' based on the TL curves. Taken is the ratio of the peak sums of each curves +/- 5 channels. -#' -#' @param cross_talk_correction [numeric] or [RLum.Results-class] (*optional*): -#' information on the used irradiation time correction obtained by another experiments. -#' If a `numeric` vector is provided it has to be of length three: -#' mean, 2.5 % quantile, 97.5 % quantile. -#' -#' @param travel_dosimeter [numeric] (*optional*): specify the position of the travel dosimeter -#' (so far measured at the same time). The dose of travel dosimeter will be subtracted from all -#' other values. -#' -#' @param test_parameters [list] (*with default*): -#' set test parameters. Supported parameters are: `TL_peak_shift` All input: [numeric] -#' values, `NA` and `NULL` (s. Details) -#' -#' @param verbose [logical] (*with default*): -#' enable/disable verbose mode -#' -#' @param plot [logical] (*with default*): enable/disable plot output, if `object` is of type [list], -#' a [numeric] vector can be provided to limit the plot output to certain aliquots -#' -#' @param ... further arguments that can be passed to the plot output, supported are `norm`, `main`, `mtext`, -#' `title` (for self-call mode to specify, e.g., sample names) -#' -#' @return Function returns results numerically and graphically: -#' -#' -----------------------------------\cr -#' `[ NUMERICAL OUTPUT ]`\cr -#' -----------------------------------\cr -#' -#' **`RLum.Results`**-object -#' -#' **slot:** **`@data`** -#' -#' \tabular{lll}{ -#' **Element** \tab **Type** \tab **Description**\cr -#' `$data` \tab `data.frame` \tab the estimated equivalent dose \cr -#' `$data_table` \tab `data.frame` \tab full dose and signal table \cr -#' `test_parameters` \tab `data.frame` \tab results with test parameters \cr -#' `data_TDcorrected` \tab `data.frame` \tab travel dosimeter corrected results (only if TD was provided)\cr -#' } -#' -#' *Note: If correction the irradiation time and the cross-talk correction method is used, the De -#' values in the table `data` table are already corrected, i.e. if you want to get an uncorrected value, -#' you can use the column `CT_CORRECTION` remove the correction* -#' -#'**slot:** **`@info`** -#' -#' The original function call -#' -#' ------------------------\cr -#' `[ PLOT OUTPUT ]`\cr -#' ------------------------\cr -#' -#' - OSL and TL curves, combined on two plots. -#' -#' -#' @section Function version: 0.2.6 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [analyse_Al2O3C_ITC] -#' -#' @references -#' -#' Kreutzer, S., Martin, L., Guérin, G., Tribolo, C., Selva, P., Mercier, N., 2018. Environmental Dose Rate -#' Determination Using a Passive Dosimeter: Techniques and Workflow for alpha-Al2O3:C Chips. -#' Geochronometria 45, 56-67. -#' -#' @keywords datagen -#' -#' @examples -#' ##load data -#' data(ExampleData.Al2O3C, envir = environment()) -#' -#' ##run analysis -#' analyse_Al2O3C_Measurement(data_CrossTalk) -#' -#' @md -#' @export -analyse_Al2O3C_Measurement <- function( - object, - signal_integral = NULL, - dose_points = c(0,4), - recordType = c("OSL (UVVIS)", "TL (UVVIS)"), - calculate_TL_dose = FALSE, - irradiation_time_correction = NULL, - cross_talk_correction = NULL, - travel_dosimeter = NULL, - test_parameters = NULL, - verbose = TRUE, - plot = TRUE, - ... -){ - - # Self call ----------------------------------------------------------------------------------- - if(is(object, "list")){ - if(!all(unlist(lapply(object, function(x){is(x, "RLum.Analysis")})))){ - .throw_error("Elements in 'object' are not all of type 'RLum.Analysis'") - } - - ##expand input arguments - if(!is.null(signal_integral)){ - signal_integral <- rep(list(signal_integral), length = length(object)) - } - - ##dose points - if(is(dose_points, "list")){ - dose_points <- rep(dose_points, length = length(object)) - - }else{ - dose_points <- rep(list(dose_points), length = length(object)) - } - - ##irradiation time correction - if(is(irradiation_time_correction, "list")){ - irradiation_time_correction <- rep(irradiation_time_correction, length = length(object)) - - }else{ - irradiation_time_correction <- rep(list(irradiation_time_correction), length = length(object)) - } - - ##cross talk correction - if(is( cross_talk_correction, "list")){ - cross_talk_correction <- rep( cross_talk_correction, length = length(object)) - - }else{ - cross_talk_correction <- rep(list( cross_talk_correction), length = length(object)) - } - - ##test_parameters - if(is(test_parameters[[1]], "list")){ - test_parameters <- rep(test_parameters, length = length(object)) - - }else{ - test_parameters <- rep(list(test_parameters), length = length(object)) - } - - ##verbose - - ##plot - if(is(plot, "logical")){ - plot <- rep(x = plot, length(object)) - - }else{ - plot <- 1:length(object)%in%plot - } - - ##run analyis - results <- lapply(1:length(object), function(x) { - temp <- analyse_Al2O3C_Measurement( - object = object[[x]], - signal_integral = signal_integral[[x]], - dose_points = dose_points[[x]], - irradiation_time_correction = irradiation_time_correction[[x]], - cross_talk_correction = cross_talk_correction[[x]], - test_parameters = test_parameters[[x]], - calculate_TL_dose = calculate_TL_dose, - verbose = verbose, - plot = plot[x], - ... - ) - - ##adjusting the terminal output, to avoid confusions - if(verbose) - cat(" ... (#",x, " | ALQ POS: ", temp$data$POSITION,")\n", sep = "") - - ##add running number to the plot, but only of we had a plot here... - if(plot[x]){ - title(main = paste0(list(...)$title[x], " ","#", x), adj = 1, line = 3) - } - - return(temp) - }) - - ##merge results - results <- merge_RLum(results) - - ##correct sys.call, otherwise it gets a little bit strange - ##why this is not implemented in the merge_RLum() method ... because here it would be wrong! - results@info[names(results@info) == "call"] <- NULL - results@info$call <- sys.call() - - ##travel dosimeter - ##check for travel dosimeter and subtract the values so far this is meaningful at all - if(!is.null(travel_dosimeter)){ - ##check data type - if(!is(travel_dosimeter, "numeric")) - .throw_error("Input for 'travel_dosimeter' is not numeric") - - ##check whether everything is subtracted from everything ... you never know, users do weird stuff - if(length(travel_dosimeter) == nrow(results$data)) - message("[analyse_Al2O3C_Measurement()] Error: 'travel_dosimeter' specifies every position, nothing corrected") - - ##check if the position is valid - if(any(!travel_dosimeter%in%results$data$POSITION)) - message("[analyse_Al2O3C_Measurement()] Error: Invalid position in 'travel_dosimeter', nothing corrected") - - ##correct for the travel dosimeter calculating the weighted mean and the sd (as new error) - ##if only one value is given just take it - if(length(travel_dosimeter) == 1 && nrow(results$data[travel_dosimeter==results$data$POSITION,c(1,2)]) == 1){ - correction <- as.numeric(results$data[travel_dosimeter==results$data$POSITION,c(1,2)]) - - }else{ - temp.correction <- results$data[results$data$POSITION%in%travel_dosimeter,c(1,2)] - correction <- c( - stats::weighted.mean( - x = temp.correction[[1]], - w = if(all(temp.correction[[2]]==0)){rep(1, length(temp.correction[[2]]))} else {temp.correction[[2]]}), - sd(temp.correction[,1])) - rm(temp.correction) - } - - ##subtract all the values, in a new data frame, we do not touch the original data - data_TDcorrected <- data.frame( - DE = results@data$data[!results$data$POSITION%in%travel_dosimeter,1] - correction[1], - DE_ERROR = sqrt(results@data$data[!results$data$POSITION%in%travel_dosimeter,2]^2 + correction[2]^2), - POSITION = results@data$data[!results$data$POSITION%in%travel_dosimeter, "POSITION"] - ) - - ##however, we set information on the travel dosimeter in the corresponding column - results@data$data$TRAVEL_DOSIMETER <- results$data$POSITION%in%travel_dosimeter - - ##attach the new element to the results output - results@data <- c(results@data, list(data_TDcorrected = data_TDcorrected)) - - ##return message - if(verbose) - cat("\n ...+ travel dosimeter correction applied.\n ...+ results stored in object $data_TDcorrected.\n\n") - - } ##end travel dosimeter - - ##return results - return(results) - - } else if (!is(object, "RLum.Analysis")) { - .throw_error("'object' must be an 'RLum.Analysis' object or ", - "a list of such objects") - } - - # Integrity check --------------------------------------------------------------------------- - - ##TODO ... do more, push harder - ##Add sufficient unit tests - - # Preparation --------------------------------------------------------------------------------- - - ##select curves based on the recordType selection; if not NULL - if(!is.null(recordType)){ - object_raw <- object - object <- get_RLum(object, recordType = recordType, drop = FALSE) - - } - - ##set signal integral - if(is.null(signal_integral)){ - signal_integral <- c(1:nrow(object[[1]][])) - - }else{ - ##check whether the input is valid, otherwise make it valid - if(min(signal_integral) < 1 | max(signal_integral) > nrow(object[[1]][])){ - signal_integral <- c(1:nrow(object[[1]][])) - .throw_warning("Input for 'signal_integral' corrected to 1:", - nrow(object[[1]][])) - } - } - - ## Set Irradiation Time Correction --------------- - if (!is.null(irradiation_time_correction)) { - if (is(irradiation_time_correction, "RLum.Results")) { - if (irradiation_time_correction@originator == "analyse_Al2O3C_ITC") { - irradiation_time_correction <- get_RLum(irradiation_time_correction) - - ##consider the case for more than one observation ... - if(nrow(irradiation_time_correction)>1){ - irradiation_time_correction <- c(mean(irradiation_time_correction[[1]]), sd(irradiation_time_correction[[1]])) - - }else{ - irradiation_time_correction <- c(irradiation_time_correction[[1]], irradiation_time_correction[[2]]) - } - - } else{ - .throw_error("The object provided for 'irradiation_time_correction' ", - "was created by an unsupported function") - } - } else if (is.numeric(irradiation_time_correction)) { - if (length(irradiation_time_correction) != 2) - .throw_error("'irradiation_time_correction' must have length 2") - } else { - .throw_error("'irradiation_time_correction' must be a numeric vector or an 'RLum.Results' object") - } - } - - - ## Set Cross Talk Correction --------------- - ##check wehther the information on the position was stored in the input - ##object - if(!is.null(get_RLum(object = object[[1]], info.object = "position"))){ - POSITION <- get_RLum(object = object[[1]], info.object = "position") - - }else{ - message("[analyse_Al2O3_Measurement()] Aliquot position number was not found. No cross talk correction was applied!") - cross_talk_correction <- c(0,0,0) - POSITION <- NA - } - - if(is.null(cross_talk_correction)){ - cross_talk_correction <- c(0,0,0) - - }else{ - - ##check whether the input is of type RLum.Results and check orignator - if (is(cross_talk_correction, "RLum.Results") && - cross_talk_correction@originator == "analyse_Al2O3C_CrossTalk") { - - ##grep cross talk correction and calculate values for - ##this particular carousel position - cross_talk_correction <- - as.numeric(predict(cross_talk_correction$fit, - newdata = data.frame(x = POSITION), - interval = "confidence")) - - }else{ - .throw_error("The object provided for 'cross_talk_correction' was ", - "created by an unsupported function or has a wrong originator") - } - } - - # Calculation --------------------------------------------------------------------------------- - ##we have two dose points, and one background curve, we do know only the 2nd dose - - ##set test parameters - test_parameters.default <- list( - TL_peak_shift = 15, - stimulation_power = 0.05 - ) - - ##modify default values by given input - if(!is.null(test_parameters)){ - test_parameters <- modifyList(test_parameters.default, test_parameters) - - ##remove NULL elements from list - test_parameters <- test_parameters[!sapply(test_parameters, is.null)] - - }else{ - test_parameters <- test_parameters.default - } - - ##calculate integrated light values - NATURAL <- sum(get_RLum(object, recordType = "OSL")[[1]]@data[signal_integral, 2]) - REGENERATED <- sum(get_RLum(object, recordType = "OSL")[[2]]@data[signal_integral, 2]) - BACKGROUND <- sum(get_RLum(object, recordType = "OSL")[[3]]@data[signal_integral, 2]) - - ##do the same for the TL - if (calculate_TL_dose[1] && any(grepl("TL", names(object)))){ - NATURAL_TL <- try(sum( - object@records[[2]]@data[ - (which.max(object@records[[2]]@data[,2])-5):(which.max(object@records[[2]]@data[,2])+5),2]), silent = TRUE) - REGENERATED_TL <- try(sum( - object@records[[4]]@data[ - (which.max(object@records[[4]]@data[,2])-5):(which.max(object@records[[4]]@data[,2])+5),2]), silent = TRUE) - - ##catch errors if the integration fails - if(inherits(NATURAL_TL, "try-error")){ - NATURAL_TL <- NA - .throw_warning("Natural TL signal out of bounds, NA returned") - } - - if(inherits(REGENERATED_TL, "try-error")){ - REGENERATED_TL <- NA - .throw_warning("Regenerated TL signal out of bounds, NA returned") - } - - }else{ - NATURAL_TL <- NA - REGENERATED_TL <- NA - } - - ##combine into data.frame - temp_df <- data.frame( - POSITION = POSITION, - DOSE = if(!is.null(irradiation_time_correction)){ - dose_points + irradiation_time_correction[1] - }else{ - dose_points - }, - DOSE_ERROR = if(!is.null(irradiation_time_correction)){ - dose_points * irradiation_time_correction[2]/irradiation_time_correction[1] - }else{ - 0 - }, - STEP = c("NATURAL", "REGENERATED"), - INTEGRAL = c(NATURAL, REGENERATED), - BACKGROUND = c(BACKGROUND, BACKGROUND), - NET_INTEGRAL = c(NATURAL - BACKGROUND, REGENERATED - BACKGROUND), - NATURAL_TL = NATURAL_TL, - REGENERATED_TL = REGENERATED_TL, - row.names = NULL - ) - - ##0 dose points should not be biased by the correction .. - ##Note: it does not mean that 0 s beneath the source has a dose of 0, however, in the certain - ##case aliquot was never moved under the source - id_zero <- which(dose_points == 0) - temp_df$DOSE[id_zero] <- 0 - temp_df$DOSE_ERROR[id_zero] <- 0 - - - ##calculate DE by using the irradiation time correction AND the cross talk correction - - ##(1) sample dose point values with irradiation time corrections (random) - if(!is.null(irradiation_time_correction)){ - DOSE_MC <- rnorm(1000, mean = temp_df$DOSE[2], sd = temp_df$DOSE_ERROR[2]) - - }else{ - DOSE_MC <- temp_df$DOSE[2] - - } - - ##(2) random sampling from cross-irradiation - CT <- runif(1000, min = cross_talk_correction[2], max = cross_talk_correction[3]) - - ##(3) signal ratio - INTEGRAL_RATIO <- temp_df$NET_INTEGRAL[1]/temp_df$NET_INTEGRAL[2] - - ##(4) calculate DE - temp_DE <- (DOSE_MC * INTEGRAL_RATIO) - - ##(5) substract cross-talk value from DE - temp_DE <- temp_DE - CT - - ##(5.1) calculate TL based DE - ##calculate a dose based on TL - ##Note: we use irradiation time correction and CT correction based on GSL measurements - if(calculate_TL_dose){ - TL_Ratio <- NATURAL_TL/REGENERATED_TL - temp_TL_DE <- (DOSE_MC * TL_Ratio) - CT - TL_DE <- mean(temp_TL_DE) - TL_DE.ERROR <- sd(temp_TL_DE) - - }else{ - TL_DE <- NA - TL_DE.ERROR <- NA - } - - ##(6) create final data.frame - data <- data.frame( - DE = mean(temp_DE), - DE_ERROR = sd(temp_DE), - POSITION, - INTEGRAL_RATIO, - TRAVEL_DOSIMETER = NA, - CT_CORRECTION = cross_talk_correction[1], - CT_CORRECTION_Q2.5 = cross_talk_correction[2], - CT_CORRECTION_Q97.5 = cross_talk_correction[3], - TL_DE = TL_DE, - TL_DE.ERROR = TL_DE.ERROR, - row.names = NULL - ) - - ##calculate test parameters - ##TL_peak_shift - ##check TL peak positions, if it differers more than the threshold, return a message - ##can be done better, but should be enough here. - if (any("TL_peak_shift"%in%names(test_parameters)) && any(grepl("TL", names(object)))){ - ##calculate value - TP_TL_peak_shift.value <- abs((object[[2]][which.max(object[[2]][,2]),1] - - object[[4]][which.max(object[[4]][,2]),1])) - - - ##compare - TP_TL_peak_shift.status <- TP_TL_peak_shift.value > test_parameters$TL_peak_shift - - ##return warning - if(TP_TL_peak_shift.status) - .throw_warning("TL peak shift detected for aliquot position ", POSITION, - ", check the curves") - - ##set data.frame - TP_TL_peak_shift <- data.frame( - CRITERIA = "TL_peak_shift", - THRESHOLD = test_parameters$TL_peak_shift, - VALUE = TP_TL_peak_shift.value, - STATUS = TP_TL_peak_shift.status, - stringsAsFactors = FALSE) - - }else{ - TP_TL_peak_shift <- data.frame(stringsAsFactors = FALSE) - } - - ##stimulation_power - if(any("stimulation_power"%in%names(test_parameters))){ - ##get curves ids holding the information on the stimulation power - temp_curves_OSL <- get_RLum(object_raw, recordType = "OSL", curveType = "measured") - temp_curves_OSL <- lapply(temp_curves_OSL, function(o){ - if("stimulator"%in%names(o@info)){ - if(grepl(o@info$stimulator, pattern = "LED", fixed = TRUE)){ - return(o) - } - } - return(NULL) - }) - - ##remove NULL - temp_curves_OSL <- temp_curves_OSL[!sapply(temp_curves_OSL, is.null)] - - ##check whether something is left - if(length(temp_curves_OSL) < 2){ - TP_stimulation_power.value <- NA - TP_stimulation_power.status <- FALSE - - }else{ - ##calculate sum of the power - TP_stimulation_power.value <- vapply(temp_curves_OSL, function(x){ - sum(x@data[,2]) - - }, numeric(1)) - - ##estimate a theoretical value based on the first value ... it does not - ##matter which value is correct or not - TP_stimulation_power.value <- abs(1 - - sum(TP_stimulation_power.value)/(TP_stimulation_power.value[1] * length(TP_stimulation_power.value))) - - TP_stimulation_power.status <- TP_stimulation_power.value > test_parameters$stimulation_power - - if(TP_stimulation_power.status) - .throw_warning("Stimulation power was not stable for ALQ ", - POSITION, ", results are likely to be wrong") - } - - ##remove object - rm(temp_curves_OSL) - - ##set data.frame - TP_stimulation_power <- data.frame( - CRITERIA = "stimulation_power", - THRESHOLD = test_parameters$stimulation_power, - VALUE = TP_stimulation_power.value, - STATUS = TP_stimulation_power.status, - stringsAsFactors = FALSE) - - }else{ - TP_stimulation_power <- data.frame(stringsAsFactors = FALSE) - } - - ##compile all test parameter df - df_test_parameters <- rbind( - TP_TL_peak_shift, - TP_stimulation_power) - - - # Terminal output ----------------------------------------------------------------------------- - if(verbose){ - cat(" [analyse_Al2O3_Measurement()] #",POSITION, " ", "DE: ", - round(data$DE, 2), " \u00B1 ", round(data$DE_ERROR,2), "\n", sep = "") - } - - # Plotting ------------------------------------------------------------------------------------ - ##enable or disable plot ... we cannot put the condition higher, because we here - ##calculate something we are going to need later - if (plot) { - ##get plot settings - par.default <- par()$mfrow - on.exit(par(mfrow = par.default)) - - ##settings - plot_settings <- list( - main = c(paste("ALQ POS:", POSITION, "| OSL"), paste("ALQ POS:", POSITION, "| TL")), - norm = TRUE, - mtext = "" - ) - - ##modify on request - plot_settings <- modifyList(x = plot_settings, val = list(...),) - - ##plot curves - if(any(grepl("TL", names(object)))) - par(mfrow = c(1,2)) - - plot_RLum( - object, - plot.single = TRUE, - combine = TRUE, - mtext = list(paste0("DE: ", round(data$DE,2), " \u00b1 ", round(data$DE_ERROR,2)), ""), - xlab = list("Simulation [s]", "Temperature [\u00B0C]"), - legend.text = list(list("#1 NAT", "#3 REG", "#5 BG"), list("#2 NAT", "#4 REG")), - legend.pos = list("topright", "topleft"), - main = as.list(plot_settings$main), - norm = plot_settings$norm - ) - } - - # Output -------------------------------------------------------------------------------------- - UID <- create_UID() - - output <- set_RLum( - class = "RLum.Results", - data = list( - data = cbind(data, UID), - data_table = cbind(temp_df, UID), - test_parameters = cbind(df_test_parameters, UID) - ), - info = list( - call = sys.call() - ) - ) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_FadingMeasurement.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_FadingMeasurement.R deleted file mode 100644 index ed2c26f95..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_FadingMeasurement.R +++ /dev/null @@ -1,1062 +0,0 @@ -#' @title Analyse fading measurements and returns the fading rate per decade (g-value) -#' -#' @description -#' The function analysis fading measurements and returns a fading rate including an error estimation. -#' The function is not limited to standard fading measurements, as can be seen, e.g., Huntley and -#' Lamothe (2001). Additionally, the density of recombination centres (rho') is estimated after -#' Kars et al. (2008). -#' -#' @details -#' All provided output corresponds to the \eqn{tc} value obtained by this analysis. Additionally -#' in the output object the g-value normalised to 2-days is provided. The output of this function -#' can be passed to the function [calc_FadingCorr]. -#' -#' **Fitting and error estimation** -#' -#' For the fitting the function [stats::lm] is used without applying weights. For the -#' error estimation all input values, except `tc`, as the precision can be considered as sufficiently -#' high enough with regard to the underlying problem, are sampled assuming a normal distribution -#' for each value with the value as the mean and the provided uncertainty as standard deviation. -#' -#' **The options for `t_star`** -#' -#' \itemize{ -#' \item `t_star = "half"` (the default) The calculation follows the simplified -#' version in Auclair et al. (2003), which reads -#' \deqn{t_{star} := t_1 + (t_2 - t_1)/2} -#' \item `t_star = "half_complex"` This option applies the complex function shown in Auclair et al. (2003), -#' which is derived from Aitken (1985) appendix F, equations 9 and 11. -#' It reads \deqn{t_{star} = t0 * 10^[(t_2 log(t_2/t_0) - t_1 log(t_1/t_0) - 0.43(t_2 - t_1))/(t_2 - t_1)]} -#' where 0.43 = \eqn{1/ln(10)}. t0, which is an arbitrary constant, is set to 1. -#' Please note that the equation in Auclair et al. (2003) is incorrect -#' insofar that it reads \eqn{10exp(...)}, where the base should be 10 and not the Euler's number. -#' Here we use the correct version (base 10). -#' \item `t_star = "end"` This option uses the simplest possible form for `t_star` which is the time since -#' irradiation without taking into account any addition parameter and it equals t1 in Auclair et al. (2003) -#' \item `t_star = ` This last option allows you to provide an R function object that works on t1 and -#' gives you all possible freedom. For instance, you may want to define the following -#' function `fun <- function(x) {x^2}`, this would square all values of t1, because internally -#' it calls `fun(t1)`. The name of the function does not matter. -#' } -#' -#' **Density of recombination centres** -#' -#' The density of recombination centres, expressed by the dimensionless variable rho', is estimated -#' by fitting equation 5 in Kars et al. 2008 to the data. For the fitting the function -#' [stats::nls] is used without applying weights. For the error estimation the same -#' procedure as for the g-value is applied (see above). -#' -#' **Multiple aliquots & Lx/Tx normalisation** -#' -#' Be aware that this function will always normalise all `Lx/Tx` values by the `Lx/Tx` value of the -#' prompt measurement of the first aliquot. This implicitly assumes that there are no systematic -#' inter-aliquot variations in the `Lx/Tx` values. If deemed necessary to normalise the `Lx/Tx` values -#' of each aliquot by its individual prompt measurement please do so **before** running -#' [analyse_FadingMeasurement] and provide the already normalised values for `object` instead. -#' -#' **Shine-down curve plots** -#' Please note that the shine-down curve plots are for information only. As such -#' not all pause steps are plotted to avoid graphically overloaded plots. -#' However, *all* pause times are taken into consideration for the analysis. -#' -#' @param object [RLum.Analysis-class] (**required**): -#' input object with the measurement data. Alternatively, a [list] containing [RLum.Analysis-class] -#' objects or a [data.frame] with three columns -#' (x = LxTx, y = LxTx error, z = time since irradiation) can be provided. -#' Can also be a wide table, i.e. a [data.frame] with a number of columns divisible by 3 -#' and where each triplet has the before mentioned column structure. -#' -#' **Please note: The input object should solely consists of the curve needed for the data analysis, i.e. -#' only IRSL curves representing Lx (and Tx)** -#' -#' If data from multiple aliquots are provided please **see the details below** with regard to -#' Lx/Tx normalisation. **The function assumes that all your measurements are related to -#' one (comparable) sample. If you to treat independent samples, you have use this function -#' in a loop.** -#' -#' @param structure [character] (*with default*): -#' sets the structure of the measurement data. Allowed are `'Lx'` or `c('Lx','Tx')`. -#' Other input is ignored -#' -#' @param signal.integral [vector] (**required**): vector with channels for the signal integral -#' (e.g., `c(1:10)`). Not required if a `data.frame` with `LxTx` values is provided. -#' -#' @param background.integral [vector] (**required**): vector with channels for the background integral -#' (e.g., `c(90:100)`). Not required if a `data.frame` with `LxTx` values is provided. -#' -#' @param t_star [character] (*with default*): -#' method for calculating the time elapsed since irradiation if input is **not** a `data.frame`. -#' Options are: `'half'` (the default), `'half_complex`, which uses the long equation in Auclair et al. 2003, and -#' and `'end'`, which takes the time between irradiation and the measurement step. -#' Alternatively, `t_star` can be a function with one parameter which works on `t1`. -#' For more information see details. \cr -#' -#' *`t_star` has no effect if the input is a [data.frame], because this input comes -#' without irradiation times.* -#' -#' @param n.MC [integer] (*with default*): -#' number for Monte Carlo runs for the error estimation -#' -#' @param verbose [logical] (*with default*): -#' enables/disables verbose mode -#' -#' @param plot [logical] (*with default*): -#' enables/disables plot output -#' -#' @param plot.single [logical] (*with default*): -#' enables/disables single plot mode, i.e. one plot window per plot. -#' Alternatively a vector specifying the plot to be drawn, e.g., -#' `plot.single = c(3,4)` draws only the last two plots -#' -#' @param ... (*optional*) further arguments that can be passed to internally used functions. Supported arguments: -#' `xlab`, `log`, `mtext`, `plot.trend` (enable/disable trend blue line), and `xlim` for the -#' two first curve plots, and `ylim` for the fading -#' curve plot. For further plot customization please use the numerical output of the functions for -#' own plots. -#' -#' @return -#' An [RLum.Results-class] object is returned: -#' -#' Slot: **@data** -#' -#' \tabular{lll}{ -#' **OBJECT** \tab **TYPE** \tab **COMMENT**\cr -#' `fading_results` \tab `data.frame` \tab results of the fading measurement in a table \cr -#' `fit` \tab `lm` \tab object returned by the used linear fitting function [stats::lm]\cr -#' `rho_prime` \tab `data.frame` \tab results of rho' estimation after Kars et al. (2008) \cr -#' `LxTx_table` \tab `data.frame` \tab Lx/Tx table, if curve data had been provided \cr -#' `irr.times` \tab `integer` \tab vector with the irradiation times in seconds \cr -#' } -#' -#' Slot: **@info** -#' -#' \tabular{lll}{ -#' **OBJECT** \tab `TYPE` \tab `COMMENT`\cr -#' `call` \tab `call` \tab the original function call\cr -#' } -#' -#' @section Function version: 0.1.22 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) \cr -#' Christoph Burow, University of Cologne (Germany) -#' -#' @keywords datagen -#' -#' @references -#' -#' Aitken, M.J., 1985. Thermoluminescence dating, Studies in archaeological science. -#' Academic Press, London, Orlando. -#' -#' Auclair, M., Lamothe, M., Huot, S., 2003. Measurement of anomalous fading for feldspar IRSL using -#' SAR. Radiation Measurements 37, 487-492. \doi{10.1016/S1350-4487(03)00018-0} -#' -#' Huntley, D.J., Lamothe, M., 2001. Ubiquity of anomalous fading in K-feldspars and the measurement -#' and correction for it in optical dating. Canadian Journal of Earth Sciences 38, -#' 1093-1106. doi: `10.1139/cjes-38-7-1093` -#' -#' Kars, R.H., Wallinga, J., Cohen, K.M., 2008. A new approach towards anomalous -#' fading correction for feldspar IRSL dating-tests on samples in field saturation. -#' Radiation Measurements 43, 786-790. \doi{10.1016/j.radmeas.2008.01.021} -#' -#' @seealso [calc_OSLLxTxRatio], [read_BIN2R], [read_XSYG2R], -#' [extract_IrradiationTimes], [calc_FadingCorr] -#' -#' @examples -#' -#' ## load example data (sample UNIL/NB123, see ?ExampleData.Fading) -#' data("ExampleData.Fading", envir = environment()) -#' -#' ##(1) get fading measurement data (here a three column data.frame) -#' fading_data <- ExampleData.Fading$fading.data$IR50 -#' -#' ##(2) run analysis -#' g_value <- analyse_FadingMeasurement( -#' fading_data, -#' plot = TRUE, -#' verbose = TRUE, -#' n.MC = 10) -#' -#' ##(3) this can be further used in the function -#' ## to correct the age according to Huntley & Lamothe, 2001 -#' results <- calc_FadingCorr( -#' age.faded = c(100,2), -#' g_value = g_value, -#' n.MC = 10) -#' -#' @md -#' @export -analyse_FadingMeasurement <- function( - object, - structure = c("Lx", "Tx"), - signal.integral, - background.integral, - t_star = 'half', - n.MC = 100, - verbose = TRUE, - plot = TRUE, - plot.single = FALSE, - ... -){ - - # Integrity Tests ----------------------------------------------------------------------------- - if (is(object, "list")) { - if (any(sapply(object, class) != "RLum.Analysis")) { - ##warning - warning(paste("[analyse_FadingMeasurement()]", - length(which(sapply(object, class) != "RLum.Analysis")), "non-supported records removed!"), call. = FALSE) - - ##remove unwanted stuff - object[sapply(object, class) != "RLum.Analysis"] <- NULL - - ##check whether this is empty now - if(length(object) == 0) - .throw_error("'object' must be an 'RLum.Analysis' object ", - "or a 'list' of such objects") - } - - } else if (inherits(object, "RLum.Analysis")) { - object <- list(object) - - } else if(inherits(object,"data.frame")){ - if (ncol(object) %% 3 != 0) { - .throw_error("'object': if you provide a data.frame as input, ", - "the number of columns must be a multiple of 3.") - } else { - object <- do.call(rbind, - lapply(seq(1, ncol(object), 3), function(col) { - setNames(object[ , col:c(col+2)], c("LxTx", "LxTxError", "timeSinceIrr")) - }) - ) - object <- object[complete.cases(object), ] - } - - ##set table and object - LxTx_table <- data.frame(LxTx = object[[1]], LxTx.Error = object[[2]]) - TIMESINCEIRR <- object[[3]] - irradiation_times <- TIMESINCEIRR - object <- NULL - - - }else{ - .throw_error("'object' must be an 'RLum.Analysis' object ", - "or a 'list' of such objects") - } - - - # Prepare data -------------------------------------------------------------------------------- - if(!is.null(object)){ - originators <- unique(unlist(lapply(object, slot, name = "originator"))) - - ## support read_XSYG2R() - if (length(originators) == 1 && originators == "read_XSYG2R") { - - ## extract irradiation times - irradiation_times <- extract_IrradiationTimes(object) - - ## get TIMESINCEIRR - TIMESINCEIRR <- unlist(lapply(irradiation_times, function(x) { - x@data$irr.times[["TIMESINCEIRR"]][!grepl(pattern = "irradiation", - x = x@data$irr.times[["STEP"]], - fixed = TRUE)] - })) - - ## get irradiation times - irradiation_times <- unlist(lapply(irradiation_times, function(x) { - x@data$irr.times[["IRR_TIME"]][!grepl(pattern = "irradiation", - x = x@data$irr.times[["STEP"]], - fixed = TRUE)] - })) - - - ##clean object by removing the irradiation step ... and yes, we drop! - object_clean <- unlist(get_RLum(object, curveType = "measured")) - - ##support read_BIN2R() - } else if (length(originators) == 1 && - originators %in% c("read_BIN2R", "Risoe.BINfileData2RLum.Analysis")) { - - ##assign object, unlist and drop it - object_clean <- unlist(get_RLum(object)) - - ##set TIMESINCEIRR vector - TIMESINCEIRR <- vapply(object_clean, function(o){ - o@info$TIMESINCEIRR - - }, numeric(1)) - - - ##check whether we have negative irradiation times, sort out such values - if(any(TIMESINCEIRR < 0)){ - #count affected records - rm_records <- length(which(TIMESINCEIRR < 0)) - - ##now we have a problem and we first have to make sure that we understand - ##the data structure and remove also the corresponding values - if(all(structure == c("Lx", "Tx"))){ - rm_id <- matrix(TIMESINCEIRR, ncol = 2, byrow = TRUE) - rm_id[apply(rm_id < 0, MARGIN = 1, any),] <- NA - rm_id <- which(is.na(as.numeric(t(rm_id)))) - object_clean[rm_id] <- NULL - TIMESINCEIRR <- TIMESINCEIRR[-rm_id] - rm_records <- length(rm_id) - rm(rm_id) - - }else{ - object_clean[TIMESINCEIRR < 0] <- NULL - TIMESINCEIRR <- TIMESINCEIRR[!TIMESINCEIRR < 0] - - } - - ##return warning - .throw_warning(rm_records, " records 'time since irradiation' value removed from the dataset") - rm(rm_records) - - } - - ##set irradiation times - irradiation_times <- vapply(object_clean, function(o){ - o@info$IRR_TIME - - }, numeric(1)) - - ##not support - }else{ - message("[analyse_FadingMeasurement()] Error: Unknown or unsupported originator") - return(NULL) - } - - ##correct irradiation time for t_star - ##in accordance with Auclair et al., 2003, p. 488 - ##but here we have no t1 ... this needs to be calculated - ##set variables - t1 <- TIMESINCEIRR - t2 <- TIMESINCEIRR + irradiation_times - - ## set t_star ---- - if(is(t_star, "function")){ - t_star <- t_star(t1) - - } else { - if(t_star == "half"){ - ##calculate t_star using the simplified equation in Auclair et al. (2003) - t_star <- t1 + (t2 - t1)/2 - - } else if(t_star == "half_complex"){ - # calculate t_star after the full equation Auclair et al. (2003) - # t0 is an arbitrary constant, we are setting that to 1 - t0 <- 1 - t_star <- t0 * 10^((t2 * log10(t2/t0) - t1 * log10(t1/t0) - (t2 - t1) * log10(exp(1))) / - (t2 - t1)) - - - }else if (t_star == "end"){ - ##set t_start as t_1 (so after the end of irradiation) - t_star <- t1 - - }else{ - .throw_error("Invalid input for t_star.") - } - } - - ##overwrite TIMESINCEIRR - TIMESINCEIRR <- t_star - rm(t_star) - - # Calculation --------------------------------------------------------------------------------- - ##calculate Lx/Tx or ... just Lx, it depends on the pattern ... set IRR_TIME - if(length(structure) == 2){ - Lx_data <- object_clean[seq(1,length(object_clean), by = 2)] - Tx_data <- object_clean[seq(2,length(object_clean), by = 2)] - - ##we need only every 2nd irradiation time, the one from the Tx should be the same ... all the time - TIMESINCEIRR <- TIMESINCEIRR[seq(1,length(TIMESINCEIRR), by = 2)] - - - }else if(length(structure) == 1){ - Lx_data <- object_clean - Tx_data <- NULL - - }else{ - message("[analyse_FadingMeasurement()] Error: I have no idea what your structure means") - return(NULL) - } - - ##calculate Lx/Tx table - len.Tx <- length(Tx_data) - LxTx_table <- merge_RLum(.warningCatcher(lapply(1:length(Lx_data), function(x) { - ## we operate only up to the shortest common length to avoid indexing - ## into Tx_data with an invalid index - if (len.Tx > 0 && x > len.Tx) { - .throw_warning("Lx and Tx have different sizes: skipped sample ", x, - ", NULL returned") - return(NULL) - } - calc_OSLLxTxRatio( - Lx.data = Lx_data[[x]], - Tx.data = Tx_data[[x]], - signal.integral = signal.integral, - background.integral = background.integral, - signal.integral.Tx = list(...)$signal.integral.Tx, - background.integral.Tx = list(...)$background.integral.Tx, - sigmab = list(...)$sigmab, - sig0 = if( - is.null(list(...)$sig0)){ - formals(calc_OSLLxTxRatio)$sig0 - }else{ - list(...)$sig0 - }, - background.count.distribution = if( - is.null(list(...)$background.count.distribution)){ - formals(calc_OSLLxTxRatio)$background.count.distribution - }else{ - list(...)$background.count.distribution - } - ) - })))$LxTx.table - - } - - ##create unique identifier - uid <- create_UID() - - ##normalise data to prompt measurement - tc <- min(TIMESINCEIRR)[1] - - ##remove NA values in LxTx table - if(any(is.infinite(LxTx_table[["LxTx"]]))){ - rm_id <- which(is.infinite(LxTx_table[["LxTx"]])) - LxTx_table <- LxTx_table[-rm_id,] - TIMESINCEIRR <- TIMESINCEIRR[-rm_id] - rm(rm_id) - - } - - - ##normalise - if(length(structure) == 2 | is.null(object)){ - LxTx_NORM <- - LxTx_table[["LxTx"]] / LxTx_table[["LxTx"]][which(TIMESINCEIRR== tc)[1]] - LxTx_NORM.ERROR <- - LxTx_table[["LxTx.Error"]] / LxTx_table[["LxTx"]][which(TIMESINCEIRR == tc)[1]] - - - }else{ - LxTx_NORM <- - LxTx_table[["Net_LnLx"]] / LxTx_table[["Net_LnLx"]][which(TIMESINCEIRR== tc)[1]] - LxTx_NORM.ERROR <- - LxTx_table[["Net_LnLx.Error"]] / LxTx_table[["Net_LnLx"]][which(TIMESINCEIRR == tc)[1]] - - } - - ##normalise time since irradtion - TIMESINCEIRR_NORM <- TIMESINCEIRR/tc - - ##add dose and time since irradiation - LxTx_table <- - cbind( - LxTx_table, - TIMESINCEIRR = TIMESINCEIRR, - TIMESINCEIRR_NORM = TIMESINCEIRR_NORM, - TIMESINCEIRR_NORM.LOG = log10(TIMESINCEIRR_NORM), - LxTx_NORM = LxTx_NORM, - LxTx_NORM.ERROR = LxTx_NORM.ERROR, - UID = uid - ) - - - # Fitting ------------------------------------------------------------------------------------- - ## prevent that n.MC can become smaller than 2 - n.MC <- max(c(n.MC[1],2)) - - ##we need to fit the data to get the g_value - - ##sample for monte carlo runs - MC_matrix <- suppressWarnings(cbind(LxTx_table[["TIMESINCEIRR_NORM.LOG"]], - matrix(rnorm( - n = n.MC * nrow(LxTx_table), - mean = LxTx_table[["LxTx_NORM"]], - sd = abs(LxTx_table[["LxTx_NORM.ERROR"]]) - ), - ncol = n.MC))) - - ##apply the fit - fit_matrix <- vapply(X = 2:(n.MC+1), FUN = function(x){ - ##fit - fit <- try(stats::lm(y~x, data = data.frame( - x = MC_matrix[,1], - y = MC_matrix[,x]))$coefficients, silent = TRUE) - - if(inherits(fit, "try-error")){ - return(c(NA_real_, NA_real_)) - - }else{ - return(fit) - - } - - }, FUN.VALUE = vector("numeric", length = 2)) - - ##calculate g-values from matrix - g_value.MC <- -fit_matrix[2, ] * 1 / fit_matrix[1, ] * 100 - - ##calculate rho prime (Kars et al. 2008; proposed by Georgina E. King) - - ##s value after Huntley (2006) J. Phys. D. - Hs <- 3e15 - - ##sample for monte carlo runs - MC_matrix_rhop <- suppressWarnings(matrix(rnorm( - n = n.MC * nrow(LxTx_table), - mean = LxTx_table[["LxTx_NORM"]], - sd = abs(LxTx_table[["LxTx_NORM.ERROR"]]) - ), ncol = n.MC)) - - - ## calculate rho prime for all MC samples - fit_vector_rhop <- suppressWarnings(apply(MC_matrix_rhop, MARGIN = 2, FUN = function(x) { - tryCatch({ - coef(minpack.lm::nlsLM(x ~ c * exp(-rhop * (log(1.8 * Hs * LxTx_table$TIMESINCEIRR))^3), - start = list(c = x[1], rhop = 10^-5.5)))[["rhop"]] - }, - error = function(e) { - return(NA) - }) - })) - - ## discard all NA values produced in MC runs - fit_vector_rhop <- fit_vector_rhop[!is.na(fit_vector_rhop)] - - ## calculate mean and standard deviation of rho prime (in log10 space) - rhoPrime <- data.frame( - MEAN = mean(fit_vector_rhop), - SD = sd(fit_vector_rhop), - Q_0.025 = quantile(x = fit_vector_rhop, probs = 0.025, na.rm = TRUE), - Q_0.16 = quantile(x = fit_vector_rhop, probs = 0.16, na.rm = TRUE), - Q_0.84 = quantile(x = fit_vector_rhop, probs = 0.84, na.rm = TRUE), - Q_0.975 = quantile(x = fit_vector_rhop, probs = 0.975, na.rm = TRUE), - row.names = NULL - ) - - - ## calc g-value ----- - fit <- - try(stats::lm(y ~ x, - data = data.frame(x = LxTx_table[["TIMESINCEIRR_NORM.LOG"]], - y = LxTx_table[["LxTx_NORM"]])), silent = TRUE) - - - fit_power <- try(stats::lm(y ~ I(x^3) + I(x^2) + I(x) , - data = data.frame(x = LxTx_table[["TIMESINCEIRR_NORM.LOG"]], - y = LxTx_table[["LxTx_NORM"]])), silent = TRUE) - - - ##for predicting - fit_predict <- - try(stats::lm(y ~ x, data = data.frame(y = LxTx_table[["TIMESINCEIRR_NORM.LOG"]], - x = LxTx_table[["LxTx_NORM"]])), silent = TRUE) - - ##calculate final g_value - ##the 2nd term corrects for the (potential) offset from one - g_value_fit <- NA - if (!inherits(fit, "try-error")) { - g_value_fit <- -fit$coefficient[2] * 1 / fit$coefficient[1] * 100 - } - - ##construct output data.frame - g_value <- data.frame( - FIT = g_value_fit, - MEAN = mean(g_value.MC), - SD = sd(g_value.MC), - Q_0.025 = quantile(x = g_value.MC, probs = 0.025, na.rm = TRUE), - Q_0.16 = quantile(x = g_value.MC, probs = 0.16, na.rm = TRUE), - Q_0.84 = quantile(x = g_value.MC, probs = 0.84, na.rm = TRUE), - Q_0.975 = quantile(x = g_value.MC, probs = 0.975, na.rm = TRUE) - ) - - ##normalise the g-value to 2-days using the equation provided by Sébastien Huot via e-mail - ##this means the data is extended - ## calc g2-value days ---- - k0 <- g_value[,c("FIT", "SD")] / 100 / log(10) - k1 <- k0 / (1 - k0 * log(172800/tc)) - g_value_2days <- 100 * k1 * log(10) - names(g_value_2days) <- c("G_VALUE_2DAYS", "G_VALUE_2DAYS.ERROR") - - # Approximation ------------------------------------------------------------------------------- - T_0.5.interpolated <- try(approx(x = LxTx_table[["LxTx_NORM"]], - y = LxTx_table[["TIMESINCEIRR_NORM"]], - ties = mean, - xout = 0.5), silent = TRUE) - - if(inherits(T_0.5.interpolated, 'try-error')){ - T_0.5 <- data.frame( - T_0.5_INTERPOLATED = NA, - T_0.5_PREDICTED = NA, - T_0.5_PREDICTED.LOWER = NA, - T_0.5_PREDICTED.UPPER = NA - ) - }else{ - T_0.5.predict <- stats::predict.lm(fit_predict,newdata = data.frame(x = 0.5), - interval = "predict") - T_0.5 <- data.frame( - T_0.5_INTERPOLATED = T_0.5.interpolated$y, - T_0.5_PREDICTED = (10 ^ T_0.5.predict[, 1]) * tc, - T_0.5_PREDICTED.LOWER = (10 ^ T_0.5.predict[, 2]) * tc, - T_0.5_PREDICTED.UPPER = (10 ^ T_0.5.predict[, 2]) * tc - ) - } - - - # Plotting ------------------------------------------------------------------------------------ - if(plot) { - if (!plot.single[1]) { - par.default <- par()$mfrow - on.exit(par(mfrow = par.default)) - par(mfrow = c(2, 2)) - - } - - ##get package - col <- get("col", pos = .LuminescenceEnv) - - ##set some plot settings - plot_settings <- list( - xlab = "Stimulation time [s]", - ylim = NULL, - xlim = NULL, - log = "", - mtext = "", - plot.trend = TRUE - - ) - - ##modify on request - plot_settings <- modifyList(x = plot_settings, val = list(...)) - - ##get unique irradiation times ... for plotting - irradiation_times.unique <- unique(TIMESINCEIRR) - - ##limit to max 5 - if(length(irradiation_times.unique) >= 5){ - irradiation_times.unique <- - irradiation_times.unique[seq(1, length(irradiation_times.unique), - length.out = 5)] - - } - - ## plot Lx-curves ----- - if (!is.null(object)) { - if (length(structure) == 2) { - - if (is(plot.single, "logical") || - (is(plot.single, "numeric") & 1 %in% plot.single)) { - plot_RLum( - set_RLum(class = "RLum.Analysis", - records = object_clean[seq(1, length(object_clean), by = 2)]), - combine = TRUE, - col = c(col[1:5], rep( - rgb(0, 0, 0, 0.3), abs(length(TIMESINCEIRR) - 5) - )), - records_max = 10, - plot.single = TRUE, - legend.text = c(paste(round(irradiation_times.unique, 1), "s")), - xlab = plot_settings$xlab, - xlim = plot_settings$xlim, - log = plot_settings$log, - legend.pos = "outside", - main = expression(paste(L[x], " - curves")), - mtext = plot_settings$mtext - ) - - ##add integration limits - abline(v = c( - object_clean[[1]][range(signal.integral), 1], - object_clean[[1]][range(background.integral), 1]), - lty = c(2,2,2,2), - col = c("green", "green", "red", "red")) - - } - - # plot Tx-curves ---- - if (is(plot.single, "logical") || - (is(plot.single, "numeric") & 2 %in% plot.single)) { - plot_RLum( - set_RLum(class = "RLum.Analysis", - records = object_clean[seq(2, length(object_clean), by = 2)]), - combine = TRUE, - records_max = 10, - plot.single = TRUE, - legend.text = paste(round(irradiation_times.unique, 1), "s"), - xlab = plot_settings$xlab, - log = plot_settings$log, - legend.pos = "outside", - main = bquote(expression(paste(T[x], " - curves"))), - mtext = plot_settings$mtext - ) - - if (is.null(list(...)$signal.integral.Tx)) { - ##add integration limits - abline(v = c( - object_clean[[1]][range(signal.integral), 1], - object_clean[[1]][range(background.integral), 1]), - lty = c(2,2,2,2), - col = c("green", "green", "red", "red")) - - } else{ - ##add integration limits - abline( - v = range(list(...)$signal.integral.Tx) * - max(as.matrix(object_clean[[1]][, 1])) / - nrow(as.matrix(object_clean[[1]])), - lty = 2, - col = "green" - ) - abline( - v = range(list(...)$background.integral.Tx) * - max(as.matrix(object_clean[[1]][, 1])) / - nrow(as.matrix(object_clean[[1]])), - lty = 2, - col = "red" - ) - } - } - - } else{ - if (is(plot.single, "logical") || - (is(plot.single, "numeric") & 1 %in% plot.single)) { - plot_RLum( - set_RLum(class = "RLum.Analysis", records = object_clean), - combine = TRUE, - records_max = 10, - plot.single = TRUE, - legend.text = c(paste(round(irradiation_times.unique, 1), "s")), - legend.pos = "outside", - xlab = plot_settings$xlab, - log = plot_settings$log, - main = expression(paste(L[x], " - curves")), - mtext = plot_settings$mtext - ) - - ##add integration limits - abline( - v = range(signal.integral) * max(as.matrix(object_clean[[1]][, 1])) / - nrow(as.matrix(object_clean[[1]])), - lty = 2, - col = "green" - ) - abline( - v = range(background.integral) * max(as.matrix(object_clean[[1]][, 1])) / - nrow(as.matrix(object_clean[[1]])), - lty = 2, - col = "red" - ) - - } - - ##empty Tx plot - if (is(plot.single, "logical") || - (is(plot.single, "numeric") & 2 %in% plot.single)) { - plot( - NA, - NA, - xlim = c(0, 1), - ylim = c(0, 1), - xlab = "", - ylab = "", - axes = FALSE - ) - text(x = 0.5, - y = 0.5, - labels = expression(paste("No ", T[x], " curves detected"))) - - } - - } - - }else{ - if (is(plot.single, "logical") || - (is(plot.single, "numeric") & 1 %in% plot.single)) { - ##empty Lx plot - plot( - NA, - NA, - xlim = c(0, 1), - ylim = c(0, 1), - xlab = "", - ylab = "", - axes = FALSE - ) - text(x = 0.5, - y = 0.5, - labels = expression(paste("No ", L[x], " curves detected"))) - - } - - if (is(plot.single, "logical") || - (is(plot.single, "numeric") & 2 %in% plot.single)) { - ##empty Tx plot - plot( - NA, - NA, - xlim = c(0, 1), - ylim = c(0, 1), - xlab = "", - ylab = "", - axes = FALSE - ) - text(x = 0.5, - y = 0.5, - labels = expression(paste("No ", T[x], " curves detected"))) - - - } - } - - ## plot fading ---- - if (is(plot.single, "logical") || - (is(plot.single, "numeric") & 3 %in% plot.single)) { - - if(all(is.na(LxTx_table[["LxTx_NORM"]]))){ - shape::emptyplot() - text(x = .5, y = .5, labels = "All NA values!") - - }else{ - plot( - NA, - NA, - ylab = "Norm. intensity", - xaxt = "n", - xlab = "Time since irradition [s]", - sub = expression(paste("[", log[10](t / t[c]), "]")), - ylim = if(is.null(plot_settings$ylim)){ - if (max(LxTx_table[["LxTx_NORM"]]) > 1.1) { - c(0.1, max(LxTx_table[["LxTx_NORM"]]) + max(LxTx_table[["LxTx_NORM.ERROR"]])) - } else { - c(0.1, 1.1) - } - } else { - plot_settings$ylim - - }, - xlim = range(LxTx_table[["TIMESINCEIRR_NORM.LOG"]], na.rm = TRUE), - main = "Signal Fading" - ) - - ##add axis (with an additional formatting to provide a nice log10-axis) - ##https://stackoverflow.com/questions/6897243/labelling-logarithmic-scale-display-in-r - x_axis_lab <- seq(0:nchar(floor(max(LxTx_table[["TIMESINCEIRR"]])))) - x_axis_ticks <- log10((10^x_axis_lab)/tc) - - ## if we have less then two values to show, we fall back to the - ## old data representation. - if (length(x_axis_ticks[x_axis_ticks > 0]) > 2) { - axis( - side = 1, - at = x_axis_ticks, - labels = sapply(x_axis_lab, function(i) - as.expression(bquote(10 ^ .(i)))) - ) - ##lower axis - axis( - side = 1, - at = x_axis_ticks, - labels = paste0("[",round(x_axis_ticks,1),"]"), - cex.axis = 0.7, - tick = FALSE, - line = 0.75) - - } else { - axis( - side = 1, - at = axTicks(side = 1), - labels = suppressWarnings(format((10 ^ (axTicks(side = 1)) * tc), - digits = 1, - decimal.mark = "", - scientific = TRUE))) - - ##lower axis - axis( - side = 1, - at = axTicks(1), - labels = axTicks(1), - cex.axis = 0.7, - tick = FALSE, - line = 0.75) - - } - - mtext( - side = 3, - paste0( - "g-value: ", - round(g_value$FIT, digits = 2), - " \u00b1 ", - round(g_value$SD, digits = 2), - " (%/decade) | tc = ", - format(tc, digits = 4, scientific = TRUE) - ), - cex = par()$cex * 0.9 - ) - - ##add MC error polygon - x_range <- range(LxTx_table[["TIMESINCEIRR_NORM.LOG"]], na.rm = TRUE) - x <- seq(x_range[1], x_range[2], length.out = 50) - m <- matrixStats::rowRanges(vapply(1:n.MC, function(i){ - fit_matrix[2, i] * x + fit_matrix[1, i] - - }, numeric(length(x)))) - polygon( - x = c(x, rev(x)), - y = c(m[, 2], rev(m[, 1])), - col = rgb(0, 0, 0, 0.2), - border = NA - ) - - ##add master curve in red - curve( - fit$coefficient[2] * x + fit$coefficient[1], - col = "red", - add = TRUE, - lwd = 1.5 - ) - - ##add power law curve - if(plot_settings$plot.trend) { - curve( - x ^ 3 * fit_power$coefficient[2] + x ^ 2 * fit_power$coefficient[3] + x - * fit_power$coefficient[4] + fit_power$coefficient[1], - add = TRUE, - col = "blue", - lty = 2 - ) - } - - ##add points - points(x = LxTx_table[["TIMESINCEIRR_NORM.LOG"]], - y = LxTx_table[["LxTx_NORM"]], - pch = 21, - bg = "grey") - - ##error bars - segments( - x0 = LxTx_table[["TIMESINCEIRR_NORM.LOG"]], - x1 = LxTx_table[["TIMESINCEIRR_NORM.LOG"]], - y0 = LxTx_table[["LxTx_NORM"]] + LxTx_table[["LxTx_NORM.ERROR"]], - y1 = LxTx_table[["LxTx_NORM"]] - LxTx_table[["LxTx_NORM.ERROR"]], - col = "grey" - - ) - - ##add legend - legend( - "bottom", - legend = c("fit", "fit MC", if(plot_settings$plot.trend) "trend" else NULL), - col = c("red", "grey", if(plot_settings$plot.trend) "blue" else NULL), - lty = c(1, 1, if(plot_settings$plot.trend) 2 else NULL), - bty = "n", - horiz = TRUE - ) - }#end if a - }# - - if (is(plot.single, "logical") || - (is(plot.single, "numeric") & 4 %in% plot.single)) { - - if(all(is.na(g_value.MC))){ - shape::emptyplot() - text(x = .5, y = .5, labels = "All NA values!") - - }else{ - plot(density(g_value.MC), - main = "Density: g-values (%/decade)") - rug(x = g_value.MC) - abline(v = c(g_value[["Q_0.16"]], g_value[["Q_0.84"]]), - lty = 2, - col = "darkgreen") - abline(v = c(g_value[["Q_0.025"]], g_value[["Q_0.975"]]), - lty = 2, - col = "red") - legend( - "topleft", - legend = c("HPD - 68 %", "HPD - 95 %"), - lty = 2, - col = c("darkgreen", "red"), - bty = "n" - ) - - - } - - } - - } - - # Terminal ------------------------------------------------------------------------------------ - if (verbose){ - - cat("\n[analyse_FadingMeasurement()]\n") - cat(paste0("\n n.MC:\t",n.MC)) - cat(paste0("\n tc:\t",format(tc, digits = 4, scientific = TRUE), " s")) - cat("\n---------------------------------------------------") - cat(paste0("\nT_0.5 interpolated:\t",T_0.5$T_0.5_INTERPOLATED)) - cat(paste0("\nT_0.5 predicted:\t",format(T_0.5$T_0.5_PREDICTED, digits = 2, scientific = TRUE))) - cat(paste0("\ng-value:\t\t", round(g_value$FIT, digits = 2), " \u00b1 ", round(g_value$SD, digits = 2), - " (%/decade)")) - cat(paste0("\ng-value (norm. 2 days):\t", round(g_value_2days[1], digits = 2), " \u00b1 ", round(g_value_2days[2], digits = 2), - " (%/decade)")) - cat("\n---------------------------------------------------") - cat(paste0("\nrho':\t\t\t", format(rhoPrime$MEAN, digits = 3), " \u00b1 ", format(rhoPrime$SD, digits = 3))) - cat(paste0("\nlog10(rho'):\t\t", suppressWarnings(round(log10(rhoPrime$MEAN), 2)), " \u00b1 ", round(rhoPrime$SD / (rhoPrime$MEAN * log(10, base = exp(1))), 2))) - cat("\n---------------------------------------------------\n") - - } - - # Return -------------------------------------------------------------------------------------- - - ##set data.frame - if(all(is.na(g_value))){ - fading_results <- data.frame( - FIT = NA, - MEAN = NA, - SD = NA, - Q_0.025 = NA, - Q_0.16 = NA, - Q_0.84 = NA, - Q_0.975 = NA, - TC = NA, - G_VALUE_2DAYS = NA, - G_VALUE_2DAYS.ERROR = NA, - T_0.5_INTERPOLATED = NA, - T_0.5_PREDICTED = NA, - T_0.5_PREDICTED.LOWER = NA, - T_0.5_PREDICTED.UPPER = NA, - UID = uid, - stringsAsFactors = FALSE - ) - - }else{ - fading_results <- data.frame( - g_value, - TC = tc, - G_VALUE_2DAYS = g_value_2days[1], - G_VALUE_2DAYS.ERROR = g_value_2days[2], - T_0.5, - UID = uid, - stringsAsFactors = FALSE - ) - - } - - ##return - return(set_RLum( - class = "RLum.Results", - data = list( - fading_results = fading_results, - fit = fit, - rho_prime = rhoPrime, - LxTx_table = LxTx_table, - irr.times = irradiation_times - ), - info = list(call = sys.call()) - )) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_IRSAR.RF.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_IRSAR.RF.R deleted file mode 100644 index 48160d25e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_IRSAR.RF.R +++ /dev/null @@ -1,2161 +0,0 @@ -#' @title Analyse IRSAR RF measurements -#' -#' @description Function to analyse IRSAR RF measurements on K-feldspar samples, performed -#' using the protocol according to Erfurt et al. (2003) and beyond. -#' -#' @details The function performs an IRSAR analysis described for K-feldspar samples by -#' Erfurt et al. (2003) assuming a negligible sensitivity change of the RF -#' signal. -#' -#' **General Sequence Structure** (according to Erfurt et al., 2003) -#' -#' -#' 1. Measuring IR-RF intensity of the natural dose for a few seconds (\eqn{RF_{nat}}) -#' 2. Bleach the samples under solar conditions for at least 30 min without changing the geometry -#' 3. Waiting for at least one hour -#' 4. Regeneration of the IR-RF signal to at least the natural level (measuring (\eqn{RF_{reg}}) -#' 5. Fitting data with a stretched exponential function -#' 6. Calculate the the palaeodose \eqn{D_{e}} using the parameters from the fitting -#' -#' -#' Actually two methods are supported to obtain the \eqn{D_{e}}: -#' `method = "FIT"` and `method = "SLIDE"`: -#' -#' **`method = "FIT"`** -#' -#' The principle is described above and follows the original suggestions by -#' Erfurt et al., 2003. For the fitting the mean count value of the `RF_nat` curve is used. -#' -#' Function used for the fitting (according to Erfurt et al. (2003)): -#' -#' \deqn{\phi(D) = \phi_{0}-\Delta\phi(1-exp(-\lambda*D))^\beta} -#' -#' with -#' \eqn{\phi(D)} the dose dependent IR-RF flux, -#' \eqn{\phi_{0}} the initial IR-RF flux, -#' \eqn{\Delta\phi} the dose dependent change of the IR-RF flux, -#' \eqn{\lambda} the exponential parameter, \eqn{D} the dose and -#' \eqn{\beta} the dispersive factor. -#' -#' To obtain the palaeodose -#' \eqn{D_{e}} the function is changed to: -#' -#' \deqn{D_{e} = ln(-(\phi(D) - \phi_{0})/(-\lambda*\phi)^{1/\beta}+1)/-\lambda} -#' -#' The fitting is done using the `port` algorithm of the [nls] function. -#' -#' -#' **`method = "SLIDE"`** -#' -#' For this method, the natural curve is slid along the x-axis until -#' congruence with the regenerated curve is reached. Instead of fitting this -#' allows working with the original data without the need for any physical -#' model. This approach was introduced for RF curves by Buylaert et al., 2012 -#' and Lapp et al., 2012. -#' -#' Here the sliding is done by searching for the minimum of the squared residuals. -#' For the mathematical details of the implementation see Frouin et al., 2017 -#' -#' **`method = "VSLIDE"`** -#' -#' Same as `"SLIDE"` but searching also vertically for the best match (i.e. in xy-direction.) -#' See Kreutzer et al. (2017) and Murari et al. (2021). By default the vertical sliding -#' range will is set to `"auto"` (see `method.control`). This setting can be still -#' changed with `method.control`. -#' -#' **`method.control`** -#' -#' To keep the generic argument list as clear as possible, arguments to control the methods -#' for De estimation are all preset with meaningful default parameters and can be -#' handled using the argument `method.control` only, e.g., -#' `method.control = list(trace = TRUE)`. Supported arguments are: -#' -#' \tabular{lll}{ -#' **ARGUMENT** \tab **METHOD** \tab **DESCRIPTION**\cr -#' `trace` \tab `FIT`, `SLIDE` or `VSLIDE` \tab as in [nls]; shows sum of squared residuals\cr -#' `trace_vslide` \tab `SLIDE` or `VSLIDE` \tab [logical] argument to enable or disable the tracing of the vertical sliding\cr -#' `maxiter` \tab `FIT` \tab as in [nls]\cr -#' `warnOnly` \tab `FIT` \tab as in [nls]\cr -#' `minFactor` \tab `FIT` \tab as in [nls]\cr -#' `correct_onset` \tab `SLIDE` or `VSLIDE` \tab The logical argument shifts the curves along the x-axis by the first channel, -#' as light is expected in the first channel. The default value is `TRUE`.\cr -#' `show_density` \tab `SLIDE` or `VSLIDE` \tab [logical] (*with default*) -#' enables or disables KDE plots for MC run results. If the distribution is too narrow nothing is shown.\cr -#' `show_fit` \tab `SLIDE` or `VSLIDE` \tab [logical] (*with default*) -#' enables or disables the plot of the fitted curve routinely obtained during the evaluation.\cr -#' `n.MC` \tab `SLIDE` or `VSLIDE` \tab [integer] (*with default*): -#' This controls the number of MC runs within the sliding (assessing the possible minimum values). -#' The default `n.MC = 1000`. Note: This parameter is not the same as controlled by the -#' function argument `n.MC`. \cr -#' `vslide_range` \tab `SLIDE` or `VSLIDE` \tab [logical] or [numeric] or [character] (*with default*): -#' This argument sets the boundaries for a vertical curve -#' sliding. The argument expects a vector with an absolute minimum and a maximum (e.g., `c(-1000,1000)`). -#' Alternatively the values `NULL` and `'auto'` are allowed. The automatic mode detects the -#' reasonable vertical sliding range (**recommended**). `NULL` applies no vertical sliding. -#' The default is `NULL`.\cr -#' `cores` \tab `SLIDE` or `VSLIDE` \tab `number` or `character` (*with default*): set number of cores to be allocated -#' for a parallel processing of the Monte-Carlo runs. The default value is `NULL` (single thread), -#' the recommended values is `'auto'`. An optional number (e.g., `cores` = 8) assigns a value manually. -#' } -#' -#' -#' **Error estimation** -#' -#' For **`method = "FIT"`** the asymmetric error range is obtained by using the 2.5 % (lower) and -#' the 97.5 % (upper) quantiles of the \eqn{RF_{nat}} curve for calculating the \eqn{D_{e}} error range. -#' -#' For **`method = "SLIDE"`** the error is obtained by bootstrapping the residuals of the slid -#' curve to construct new natural curves for a Monte Carlo simulation. The error is returned in two -#' ways: (a) the standard deviation of the herewith obtained \eqn{D_{e}} from the MC runs and (b) the confidence -#' interval using the 2.5 % (lower) and the 97.5 % (upper) quantiles. The results of the MC runs -#' are returned with the function output. -#' -#' **Test parameters** -#' -#' The argument `test_parameters` allows to pass some thresholds for several test parameters, -#' which will be evaluated during the function run. If a threshold is set and it will be exceeded the -#' test parameter status will be set to `"FAILED"`. Intentionally this parameter is not termed -#' `'rejection criteria'` as not all test parameters are evaluated for both methods and some parameters -#' are calculated by not evaluated by default. Common for all parameters are the allowed argument options -#' `NA` and `NULL`. If the parameter is set to `NA` the value is calculated but the -#' result will not be evaluated, means it has no effect on the status (`"OK"` or `"FAILED"`) -#' of the parameter. -#' Setting the parameter to `NULL` disables the parameter entirely and the parameter will be -#' also removed from the function output. This might be useful in cases where a particular parameter -#' asks for long computation times. Currently supported parameters are: -#' -#' `curves_ratio` [numeric] (default: `1.001`): -#' -#' The ratio of \eqn{RF_{nat}} over \eqn{RF_{reg}} in the range of\eqn{RF_{nat}} of is calculated -#' and should not exceed the threshold value. -#' -#' `intersection_ratio` [numeric] (default: `NA`): -#' -#' Calculated as absolute difference from 1 of the ratio of the integral of the normalised RF-curves, -#' This value indicates intersection of the RF-curves and should be close to 0 if the curves -#' have a similar shape. For this calculation first the corresponding time-count pair value on the RF_reg -#' curve is obtained using the maximum count value of the `RF_nat` curve and only this segment (fitting to -#' the `RF_nat` curve) on the RF_reg curve is taken for further calculating this ratio. If nothing is -#' found at all, `Inf` is returned. -#' -#' `residuals_slope` [numeric] (default: `NA`; only for `method = "SLIDE"`): -#' -#' A linear function is fitted on the residuals after sliding. -#' The corresponding slope can be used to discard values as a high (positive, negative) slope -#' may indicate that both curves are fundamentally different and the method cannot be applied at all. -#' Per default the value of this parameter is calculated but not evaluated. -#' -#' `curves_bounds` [numeric] (default: \eqn{max(RF_{reg_counts})}: -#' -#' This measure uses the maximum time (x) value of the regenerated curve. -#' The maximum time (x) value of the natural curve cannot be larger than this value. However, although -#' this is not recommended the value can be changed or disabled. -#' -#' `dynamic_ratio` [numeric] (default: `NA`): -#' -#' The dynamic ratio of the regenerated curve is calculated as ratio of the minimum and maximum count values. -#' -#' `lambda`, `beta` and `delta.phi` -#' [numeric] (default: `NA`; `method = "SLIDE"`): -#' -#' The stretched exponential function suggested by Erfurt et al. (2003) describing the decay of -#' the RF signal, comprises several parameters that might be useful to evaluate the shape of the curves. -#' For `method = "FIT"` this parameter is obtained during the fitting, for `method = "SLIDE"` a -#' rather rough estimation is made using the function [minpack.lm::nlsLM] and the equation -#' given above. Note: As this procedure requests more computation time, setting of one of these three parameters -#' to `NULL` also prevents a calculation of the remaining two. -#' -#' -#' @param object [RLum.Analysis-class] or a [list] of [RLum.Analysis-class]-objects (**required**): -#' input object containing data for protocol analysis. The function expects to -#' find at least two curves in the [RLum.Analysis-class] object: (1) `RF_nat`, (2) `RF_reg`. -#' If a `list` is provided as input all other parameters can be provided as -#' `list` as well to gain full control. -#' -#' @param sequence_structure [vector] [character] (*with default*): -#' specifies the general sequence structure. Allowed steps are `NATURAL`, `REGENERATED`. -#' In addition any other character is allowed in the sequence structure; -#' such curves will be ignored during the analysis. -#' -#' @param RF_nat.lim [vector] (*with default*): -#' set minimum and maximum channel range for natural signal fitting and sliding. -#' If only one value is provided this will be treated as minimum value and the -#' maximum limit will be added automatically. -#' -#' @param RF_reg.lim [vector] (*with default*): -#' set minimum and maximum channel range for regenerated signal fitting and sliding. -#' If only one value is provided this will be treated as minimum value and the -#' maximum limit will be added automatically. -#' -#' @param method [character] (*with default*): select method applied for the data analysis. -#' Possible options are `"FIT"`, `"SLIDE"`, `"VSLIDE"`. -#' -#' @param method.control [list] (*optional*): -#' parameters to control the method, that can be passed to the chosen method. -#' These are for (1) `method = "FIT"`: `'trace'`, `'maxiter'`, `'warnOnly'`, `'minFactor'` and for -#' (2) `method = "SLIDE"`: `'correct_onset'`, `'show_density'`, `'show_fit'`, `'trace'`. -#' See details. -#' -#' @param test_parameters [list] (*with default*): -#' set test parameters. Supported parameters are: `curves_ratio`, `residuals_slope` (only for -#' `method = "SLIDE"`), `curves_bounds`, `dynamic_ratio`, -#' `lambda`, `beta` and `delta.phi`. All input: [numeric] -#' values, `NA` and `NULL` (s. Details) -#' -#' (see Details for further information) -#' -#' @param n.MC [numeric] (*with default*): -#' set number of Monte Carlo runs for start parameter estimation (`method = "FIT"`) or -#' error estimation (`method = "SLIDE"`). This value can be set to `NULL` to skip the -#' MC runs. Note: Large values will significantly increase the computation time -#' -#' @param txtProgressBar [logical] (*with default*): -#' enables `TRUE` or disables `FALSE` the progress bar during MC runs -#' -#' @param plot [logical] (*with default*): -#' plot output (`TRUE` or `FALSE`) -#' -#' @param plot_reduced [logical] (*optional*): -#' provides a reduced plot output if enabled to allow common R plot combinations, -#' e.g., `par(mfrow(...))`. If `TRUE` no residual plot -#' is returned; it has no effect if `plot = FALSE` -#' -#' @param ... further arguments that will be passed to the plot output. -#' Currently supported arguments are `main`, `xlab`, `ylab`, -#' `xlim`, `ylim`, `log`, `legend` (`TRUE/FALSE`), -#' `legend.pos`, `legend.text` (passes argument to x,y in -#' [graphics::legend]), `xaxt` -#' -#' -#' @return -#' The function returns numerical output and an (*optional*) plot. -#' -#' -----------------------------------\cr -#' `[ NUMERICAL OUTPUT ]`\cr -#' -----------------------------------\cr -#' -#' **`RLum.Results`**-object -#' -#' **slot:** **`@data`** -#' -#' `[.. $data : data.frame]` -#' -#' \tabular{lll}{ -#' **Column** \tab **Type** \tab **Description**\cr -#' `DE` \tab `numeric` \tab the obtained equivalent dose\cr -#' `DE.ERROR` \tab `numeric` \tab (only `method = "SLIDE"`) standard deviation obtained from MC runs \cr -#' `DE.LOWER` \tab `numeric`\tab 2.5% quantile for De values obtained by MC runs \cr -#' `DE.UPPER` \tab `numeric`\tab 97.5% quantile for De values obtained by MC runs \cr -#' `DE.STATUS` \tab `character`\tab test parameter status\cr -#' `RF_NAT.LIM` \tab `character`\tab used `RF_nat` curve limits \cr -#' `RF_REG.LIM` \tab `character`\tab used `RF_reg` curve limits\cr -#' `POSITION` \tab `integer`\tab (*optional*) position of the curves\cr -#' `DATE` \tab `character`\tab (*optional*) measurement date\cr -#' `SEQUENCE_NAME` \tab `character`\tab (*optional*) sequence name\cr -#' `UID` \tab `character`\tab unique data set ID -#' } -#' -#' `[.. $De.MC : numeric]` -#' -#' A `numeric` vector with all the De values obtained by the MC runs. -#' -#' `[.. $test_parameters : data.frame]` -#' -#' \tabular{lll}{ -#' **Column** \tab **Type** \tab **Description**\cr -#' `POSITION` \tab `numeric` \tab aliquot position \cr -#' `PARAMETER` \tab `character` \tab test parameter name \cr -#' `THRESHOLD` \tab `numeric` \tab set test parameter threshold value \cr -#' `VALUE` \tab `numeric` \tab the calculated test parameter value (to be compared with the threshold)\cr -#' `STATUS` \tab `character` \tab test parameter status either `"OK"` or `"FAILED"` \cr -#' `SEQUENCE_NAME` \tab `character` \tab name of the sequence, so far available \cr -#' `UID` \tab `character`\tab unique data set ID -#' } -#' -#' `[.. $fit : data.frame]` -#' -#' An [nls] object produced by the fitting. -#' -#' `[.. $slide : list]` -#' -#' A [list] with data produced during the sliding. Some elements are previously -#' reported with the summary object data. List elements are: -#' -#' \tabular{lll}{ -#' **Element** \tab **Type** \tab **Description**\cr -#' `De` \tab `numeric` \tab the final De obtained with the sliding approach \cr -#' `De.MC` \tab `numeric` \tab all De values obtained by the MC runs \cr -#' `residuals` \tab `numeric` \tab the obtained residuals for each channel of the curve \cr -#' `trend.fit` \tab `lm` \tab fitting results produced by the fitting of the residuals \cr -#' `RF_nat.slid` \tab `matrix` \tab the slid `RF_nat` curve \cr -#' `t_n.id` \tab `numeric` \tab the index of the t_n offset \cr -#' `I_n` \tab `numeric` \tab the vertical intensity offset if a vertical slide was applied \cr -#' `algorithm_error` \tab `numeric` \tab the vertical sliding suffers from a systematic effect induced by the used -#' algorithm. The returned value is the standard deviation of all obtained De values while expanding the -#' vertical sliding range. I can be added as systematic error to the final De error; so far wanted.\cr -#' `vslide_range` \tab `numeric` \tab the range used for the vertical sliding \cr -#' `squared_residuals` \tab `numeric` \tab the squared residuals (horizontal sliding) -#' } -#' -#' -#' **slot:** **`@info`** -#' -#' The original function call ([methods::language-class]-object) -#' -#' The output (`data`) should be accessed using the function [get_RLum] -#' -#' ------------------------\cr -#' `[ PLOT OUTPUT ]`\cr -#' ------------------------\cr -#' -#' The slid IR-RF curves with the finally obtained De -#' -#' @note -#' This function assumes that there is no sensitivity change during the -#' measurements (natural vs. regenerated signal), which is in contrast to the -#' findings by Buylaert et al. (2012). -#' -#' @section Function version: 0.7.10 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum.Analysis-class], [RLum.Results-class], [get_RLum], -#' [nls], [minpack.lm::nlsLM], `parallel::mclapply` -#' -#' -#' @references -#' Buylaert, J.P., Jain, M., Murray, A.S., Thomsen, K.J., Lapp, T., -#' 2012. IR-RF dating of sand-sized K-feldspar extracts: A test of accuracy. -#' Radiation Measurements 44 (5-6), 560-565. doi: 10.1016/j.radmeas.2012.06.021 -#' -#' Erfurt, G., Krbetschek, M.R., 2003. IRSAR - A single-aliquot -#' regenerative-dose dating protocol applied to the infrared radiofluorescence -#' (IR-RF) of coarse- grain K-feldspar. Ancient TL 21, 35-42. -#' -#' Erfurt, G., 2003. Infrared luminescence of Pb+ centres in potassium-rich -#' feldspars. physica status solidi (a) 200, 429-438. -#' -#' Erfurt, G., Krbetschek, M.R., 2003. Studies on the physics of the infrared -#' radioluminescence of potassium feldspar and on the methodology of its -#' application to sediment dating. Radiation Measurements 37, 505-510. -#' -#' Erfurt, G., Krbetschek, M.R., Bortolot, V.J., Preusser, F., 2003. A fully -#' automated multi-spectral radioluminescence reading system for geochronometry -#' and dosimetry. Nuclear Instruments and Methods in Physics Research Section -#' B: Beam Interactions with Materials and Atoms 207, 487-499. -#' -#' Frouin, M., Huot, S., Kreutzer, S., Lahaye, C., Lamothe, M., Philippe, A., Mercier, N., 2017. -#' An improved radiofluorescence single-aliquot regenerative dose protocol for K-feldspars. -#' Quaternary Geochronology 38, 13-24. doi:10.1016/j.quageo.2016.11.004 -#' -#' Kreutzer, S., Murari, M.K., Frouin, M., Fuchs, M., Mercier, N., 2017. -#' Always remain suspicious: a case study on tracking down a technical artefact while measuring IR-RF. -#' Ancient TL 35, 20–30. -#' -#' Murari, M.K., Kreutzer, S., Fuchs, M., 2018. Further investigations on IR-RF: -#' Dose recovery and correction. Radiation Measurements 120, 110–119. -#' doi: 10.1016/j.radmeas.2018.04.017 -#' -#' Lapp, T., Jain, M., Thomsen, K.J., Murray, A.S., Buylaert, J.P., 2012. New -#' luminescence measurement facilities in retrospective dosimetry. Radiation -#' Measurements 47, 803-808. doi:10.1016/j.radmeas.2012.02.006 -#' -#' Trautmann, T., 2000. A study of radioluminescence kinetics of natural -#' feldspar dosimeters: experiments and simulations. Journal of Physics D: -#' Applied Physics 33, 2304-2310. -#' -#' Trautmann, T., Krbetschek, M.R., Dietrich, A., Stolz, W., 1998. -#' Investigations of feldspar radioluminescence: potential for a new dating -#' technique. Radiation Measurements 29, 421-425. -#' -#' Trautmann, T., Krbetschek, M.R., Dietrich, A., Stolz, W., 1999. Feldspar -#' radioluminescence: a new dating method and its physical background. Journal -#' of Luminescence 85, 45-58. -#' -#' Trautmann, T., Krbetschek, M.R., Stolz, W., 2000. A systematic study of the -#' radioluminescence properties of single feldspar grains. Radiation -#' Measurements 32, 685-690. -#' -#' ** Further reading** -#' -#' Murari, M.K., Kreutzer, S., King, G.E., Frouin, M., Tsukamoto, S., Schmidt, C., Lauer, T., -#' Klasen, N., Richter, D., Friedrich, J., Mercier, N., Fuchs, M., 2021. -#' Infrared radiofluorescence (IR-RF) dating: A review. Quaternary Geochronology 64, -#' 101155. doi: 10.1016/j.quageo.2021.101155 -#' -#' @keywords datagen -#' -#' @examples -#' -#' ##load data -#' data(ExampleData.RLum.Analysis, envir = environment()) -#' -#' ##(1) perform analysis using the method 'FIT' -#' results <- analyse_IRSAR.RF(object = IRSAR.RF.Data) -#' -#' ##show De results and test paramter results -#' get_RLum(results, data.object = "data") -#' get_RLum(results, data.object = "test_parameters") -#' -#' ##(2) perform analysis using the method 'SLIDE' -#' results <- analyse_IRSAR.RF(object = IRSAR.RF.Data, method = "SLIDE", n.MC = 1) -#' -#' \dontrun{ -#' ##(3) perform analysis using the method 'SLIDE' and method control option -#' ## 'trace -#' results <- analyse_IRSAR.RF( -#' object = IRSAR.RF.Data, -#' method = "SLIDE", -#' method.control = list(trace = TRUE)) -#' } -#' -#' @md -#' @export -analyse_IRSAR.RF<- function( - object, - sequence_structure = c("NATURAL", "REGENERATED"), - RF_nat.lim = NULL, - RF_reg.lim = NULL, - method = "FIT", - method.control = NULL, - test_parameters = NULL, - n.MC = 10, - txtProgressBar = TRUE, - plot = TRUE, - plot_reduced = FALSE, - ... -){ - - ##TODO - ## - if a file path is given, the function should try to find out whether an XSYG-file or - ## a BIN-file is provided - ## - add NEWS for vslide_range - ## - update documentary ... if it works as expected. - - # SELF CALL ----------------------------------------------------------------------------------- - if(is.list(object)){ - ##extent the list of arguments if set - - ##sequence_structure - sequence_structure <- rep(list(sequence_structure), length = length(object)) - - ##RF_nat.lim - RF_nat.lim <- rep(list(RF_nat.lim), length = length(object)) - - ##RF_reg.lim - RF_reg.lim <- rep(list(RF_reg.lim), length = length(object)) - - ##method - method <- rep(list(method), length = length(object)) - - ##method.control - method.control <- rep(list(method.control), length = length(object)) - - ##test_parameters - if(is(test_parameters[[1]], "list")){ - test_parameters <- rep(test_parameters, length = length(object)) - - }else{ - test_parameters <- rep(list(test_parameters), length = length(object)) - - } - - ##n.MC - n.MC <- rep(list(n.MC), length = length(object)) - - ##main - if("main"%in% names(list(...))){ - - if(is(list(...)$main, "list")){ - temp_main <- rep(list(...)$main, length = length(object)) - - }else{ - temp_main <- rep(list(list(...)$main), length = length(object)) - - } - - }else{ - if(object[[1]]@originator == "read_RF2R"){ - temp_main <- lapply(object, function(x) x@info$ROI) - } else { - temp_main <- as.list(paste0("ALQ #",1:length(object))) - } - - } - - - ##run analysis - temp <- lapply(1:length(object), function(x){ - analyse_IRSAR.RF( - object = object[[x]], - sequence_structure = sequence_structure[[x]], - RF_nat.lim = RF_nat.lim[[x]], - RF_reg.lim = RF_reg.lim[[x]], - method = method[[x]], - method.control = method.control[[x]], - test_parameters = test_parameters[[x]], - n.MC = n.MC[[x]], - txtProgressBar = txtProgressBar, - plot = plot, - plot_reduced = plot_reduced, - main = temp_main[[x]], - ...) - }) - - ##combine everything to one RLum.Results object as this as what was written ... only - ##one object - - ##merge results and check if the output became NULL - results <- merge_RLum(temp) - - ##DO NOT use invisible here, this will stop the function from stopping - if(length(results) == 0){ - return(NULL) - - }else{ - return(results) - - } - - } - - - ##===============================================================================================# - ## INTEGRITY TESTS AND SEQUENCE STRUCTURE TESTS - ##===============================================================================================# - - ##INPUT OBJECTS - if(!is(object, "RLum.Analysis")){ - .throw_error("Input object must be of type 'RLum.Analysis'") - } - - ##CHECK OTHER ARGUMENTS - if (!is.character(sequence_structure)) { - .throw_error("'sequence_structure' must be of type 'character'") - } - - ## n.MC - .validate_positive_scalar(n.MC, int = TRUE, null.ok = TRUE) - - ##SELECT ONLY MEASURED CURVES - ## (this is not really necessary but rather user friendly) - if(!length(suppressWarnings(get_RLum(object, curveType= "measured"))) == 0){ - object <- get_RLum(object, curveType= "measured", drop = FALSE) - - } - - ##INVESTIGATE SEQUENCE OBJECT STRUCTURE - - ##grep object structure - temp.sequence_structure <- structure_RLum(object) - - ##check whether both curve have the same length, in this case we cannot proceed (sliding - ##is not allowed) - if(length(unique(temp.sequence_structure[["x.max"]])) == 1 && - method == "SLIDE" && - (is.null(RF_nat.lim) & is.null(RF_reg.lim))) { - stop("[analyse_IRSAR.RF()] There is no further sliding space left. All curves have the same length and no limitation was set!", call. = FALSE) - } - - ##grep name of the sequence and the position this will be useful later on - ##name - aliquot.sequence_name <- suppressWarnings(get_RLum(get_RLum(object, - record.id = 1), - info.object = "name")) - if (is.null(aliquot.sequence_name)) { - aliquot.sequence_name <- NA - } - - ##position - aliquot.position <- suppressWarnings(get_RLum(get_RLum(object, - record.id = 1), - info.object = "position")) - if (is.null(aliquot.position)) { - aliquot.position <- NA - } - - ##date - aliquot.date <- suppressWarnings(get_RLum(get_RLum(object, - record.id = 1), - info.object = "startDate")) - if (!is.null(aliquot.date)) { - ##transform so far the format can be identified - if (nchar(aliquot.date) == 14) { - aliquot.date <- paste(c(substr(aliquot.date, 1, 4), - substr(aliquot.date, 5, 6), - substr(aliquot.date, 7, 8)), collapse = "-") - } - }else{ - aliquot.date <- NA - } - - ##set structure values - temp.sequence_structure$protocol.step <- - rep(sequence_structure, length_RLum(object))[1:length_RLum(object)] - - ##check if the first curve is shorter than the first curve - if (temp.sequence_structure[which(temp.sequence_structure[["protocol.step"]] == "NATURAL"),"n.channels"] > - temp.sequence_structure[which(temp.sequence_structure[["protocol.step"]] == "REGENERATED"),"n.channels"]) { - stop("[analyse_IRSAR.RF()] Number of data channels in RF_nat > RF_reg. This is not supported!", call. = FALSE) - - } - - ##===============================================================================================# - ## SET CURVE LIMITS - ##===============================================================================================# - ##the setting here will be valid for all subsequent operations - - ##01 - ##first get allowed curve limits, this makes the subsequent checkings easier and the code - ##more easier to read - RF_nat.lim.default <- c(1,max( - subset( - temp.sequence_structure, - temp.sequence_structure$protocol.step == "NATURAL" - )$n.channels - )) - - RF_reg.lim.default <- c(1,max( - subset( - temp.sequence_structure, - temp.sequence_structure$protocol.step == "REGENERATED" - )$n.channels - )) - - - ## 02 - check boundaries - ##RF_nat.lim - if (is.null(RF_nat.lim) || any(is.na(RF_nat.lim))) { - RF_nat.lim <- RF_nat.lim.default - - }else { - ##this allows to provide only one boundary and the 2nd will be added automatically - if (length(RF_nat.lim) == 1) { - RF_nat.lim <- c(RF_nat.lim, RF_nat.lim.default[2]) - - } - - if (min(RF_nat.lim) < RF_nat.lim.default[1] | - max(RF_nat.lim) > RF_nat.lim.default[2]) { - RF_nat.lim <- RF_nat.lim.default - - .throw_warning("RF_nat.lim out of bounds, reset to: RF_nat.lim = c(", - paste(range(RF_nat.lim), collapse = ":"),")") - } - - } - - ##RF_reg.lim - ## - if (is.null(RF_reg.lim)) { - RF_reg.lim <- RF_reg.lim.default - - }else { - ##this allows to provide only one boundary and the 2nd will be added automatically - if (length(RF_reg.lim) == 1) { - RF_reg.lim <- c(RF_reg.lim, RF_reg.lim.default[2]) - - } - - if (min(RF_reg.lim) < RF_reg.lim.default[1] | - max(RF_reg.lim) > RF_reg.lim.default[2]) { - RF_reg.lim <- RF_reg.lim.default - - .throw_warning("RF_reg.lim out of bounds, reset to: RF_reg.lim = c(", - paste(range(RF_reg.lim), collapse = ":"), ")") - } - } - - ## check if intervals make sense at all - if(length(RF_reg.lim[1]:RF_reg.lim[2]) < RF_nat.lim[2]){ - RF_reg.lim[2] <- RF_reg.lim[2] + abs(length(RF_reg.lim[1]:RF_reg.lim[2]) - RF_nat.lim[2]) + 1 - - .throw_warning("Length interval RF_reg.lim < length RF_nat. Reset to RF_reg.lim = c(", - paste(range(RF_reg.lim), collapse=":"), ")") - } - - # Method Control Settings --------------------------------------------------------------------- - ##===============================================================================================# - ## SET METHOD CONTROL PARAMETER - FOR BOTH METHODS - ##===============================================================================================# - ## - ##set supported values with default - method.control.settings <- list( - trace = FALSE, - trace_vslide = FALSE, - maxiter = 500, - warnOnly = FALSE, - minFactor = 1 / 4096, - correct_onset = TRUE, - show_density = TRUE, - show_fit = FALSE, - n.MC = if(is.null(n.MC)) NULL else 1000, - vslide_range = if(method[1] == "VSLIDE") "auto" else NULL, - cores = NULL - ) - - ##modify list if necessary - if(!is.null(method.control)){ - if(!is(method.control, "list")){ - .throw_error("'method.control' has to be of type 'list'!") - } - - ##check whether this arguments are supported at all - unsupported.idx <- which(!names(method.control) %in% - names(method.control.settings)) - if (length(unsupported.idx) > 0) { - .throw_warning("'", paste(names(method.control)[unsupported.idx], - collapse = ", "), - "' not supported for 'method.control'. Supported arguments are: ", - paste(names(method.control.settings), collapse = ", ")) - } - - ##modify list - method.control.settings <- modifyList( - x = method.control.settings, - val = method.control, - keep.null = TRUE) - - } - - - ##===============================================================================================# - ## SET PLOT PARAMETERS - ##===============================================================================================# - - ##get channel resolution (should be equal for all curves, but if not the mean is taken) - resolution.RF <- round(mean((temp.sequence_structure$x.max/temp.sequence_structure$n.channels)),digits=1) - - plot.settings <- list( - main = "IR-RF", - xlab = "Time [s]", - ylab = paste0("IR-RF [cts/", resolution.RF," s]"), - log = "", - cex = 1, - legend = TRUE, - legend.text = c("RF_nat","RF_reg"), - legend.pos = "top", - xaxt = "s" - ##xlim and ylim see below as they has to be modified differently - ) - - ##modify list if something was set - plot.settings <- modifyList(plot.settings, list(...)) - - ##=============================================================================# - ## ANALYSIS - ##=============================================================================# - - ##grep first regenerated curve - RF_reg <- as.data.frame(object@records[[ - temp.sequence_structure[temp.sequence_structure$protocol.step=="REGENERATED","id"]]]@data) - - ##correct of the onset of detection by using the first time value - if (method == "SLIDE" & - method.control.settings$correct_onset == TRUE) { - RF_reg[,1] <- RF_reg[,1] - RF_reg[1,1] - - } - - - RF_reg.x <- RF_reg[RF_reg.lim[1]:RF_reg.lim[2],1] - RF_reg.y <- RF_reg[RF_reg.lim[1]:RF_reg.lim[2],2] - - - ##grep values from natural signal - RF_nat <- as.data.frame(object@records[[ - temp.sequence_structure[temp.sequence_structure$protocol.step=="NATURAL","id"]]]@data) - - ##correct of the onset of detection by using the first time value - if (method == "SLIDE" & - method.control.settings$correct_onset == TRUE) { - RF_nat[,1] <- RF_nat[,1] - RF_nat[1,1] - } - - - ##limit values to fit range (at least to the minimum) - RF_nat.limited<- RF_nat[min(RF_nat.lim):max(RF_nat.lim),] - - ##calculate some useful parameters - RF_nat.mean <- mean(RF_nat.limited[,2]) - RF_nat.sd <- sd(RF_nat.limited[,2]) - - RF_nat.error.lower <- quantile(RF_nat.limited[,2], 0.975, na.rm = TRUE) - RF_nat.error.upper <- quantile(RF_nat.limited[,2], 0.025, na.rm = TRUE) - - - ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++# - ##METHOD FIT - ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++# - ## REGENERATED SIGNAL - # set function for fitting ------------------------------------------------ - - fit.function <- - as.formula(y ~ phi.0 - (delta.phi * ((1 - exp( - -lambda * x - )) ^ beta))) - - ##stretched expontial function according to Erfurt et al. (2003) - ## + phi.0 >> initial IR-RF flux - ## + delta.phi >> dose dependent change of the IR-RF flux - ## + lambda >> exponential parameter - ## + beta >> dispersive factor - - # set start parameter estimation ------------------------------------------ - - fit.parameters.start <- c( - phi.0 = max(RF_reg.y), - lambda = 0.0001, - beta = 1, - delta.phi = 1.5 * (max(RF_reg.y) - min(RF_reg.y)) - ) - - if(method == "FIT"){ - - # start nls fitting ------------------------------------------------------- - - ##Monte Carlo approach for fitting - fit.parameters.results.MC.results <- data.frame() - - ##produce set of start paramters - phi.0.MC <- rep(fit.parameters.start["phi.0"], n.MC) - lambda.MC <- seq(0.0001, 0.001, by=(0.001-0.0001)/n.MC) - beta.MC <- rep(fit.parameters.start["beta"], n.MC) - delta.phi.MC <- rep(fit.parameters.start["delta.phi"], n.MC) - - ##start fitting loop for MC runs - for(i in 1:n.MC){ - - fit.MC <- try(nls( - fit.function, - trace = FALSE, - data = list(x = RF_reg.x, y = RF_reg.y), - algorithm = "port", - start = list( - phi.0 = phi.0.MC[i], - delta.phi = delta.phi.MC[i], - lambda = lambda.MC[i], - beta = beta.MC[i] - ), - nls.control( - maxiter = 100, - warnOnly = FALSE, - minFactor = 1 / 1024 - ), - lower = c( - phi.0 = .Machine$double.xmin, - delta.phi = .Machine$double.xmin, - lambda = .Machine$double.xmin, - beta = .Machine$double.xmin - ), - upper = c( - phi.0 = max(RF_reg.y), - delta.phi = max(RF_reg.y), - lambda = 1, - beta = 100 - ) - ), - silent = TRUE - ) - - if(inherits(fit.MC,"try-error") == FALSE) { - temp.fit.parameters.results.MC.results <- coef(fit.MC) - - fit.parameters.results.MC.results[i,"phi.0"] <- - temp.fit.parameters.results.MC.results["phi.0"] - fit.parameters.results.MC.results[i,"lambda"] <- - temp.fit.parameters.results.MC.results["lambda"] - fit.parameters.results.MC.results[i,"delta.phi"] <- - temp.fit.parameters.results.MC.results["delta.phi"] - fit.parameters.results.MC.results[i,"beta"] <- - temp.fit.parameters.results.MC.results["beta"] - - } - } - - ##FINAL fitting after successful MC - if(length(na.omit(fit.parameters.results.MC.results)) != 0){ - - ##choose median as final fit version - fit.parameters.results.MC.results <- sapply(na.omit(fit.parameters.results.MC.results), median) - - ##try final fitting - fit <- try(nls( - fit.function, - trace = method.control.settings$trace, - data = data.frame(x = RF_reg.x, y = RF_reg.y), - algorithm = "port", - start = list( - phi.0 = fit.parameters.results.MC.results["phi.0"], - delta.phi = fit.parameters.results.MC.results["delta.phi"], - lambda = fit.parameters.results.MC.results["lambda"], - beta = fit.parameters.results.MC.results["beta"] - ), - nls.control( - maxiter = method.control.settings$maxiter, - warnOnly = method.control.settings$warnOnly, - minFactor = method.control.settings$minFactor - ), - lower = c( - phi.0 = .Machine$double.xmin, - delta.phi = .Machine$double.xmin, - lambda = .Machine$double.xmin, - beta = .Machine$double.xmin - ), - upper = c( - phi.0 = max(RF_reg.y), - delta.phi = max(RF_reg.y), - lambda = 1, beta = 100 - ) - ), - silent = FALSE - ) - }else{ - - fit <- NA - class(fit) <- "try-error" - - } - - # get parameters ---------------------------------------------------------- - # and with that the final De - fit.parameters.results <- NA - if (!inherits(fit,"try-error")) { - fit.parameters.results <- coef(fit) - } - - ##calculate De value - De <- NA - De.error <- NA - De.lower <- NA - De.upper <- NA - if (!is.na(fit.parameters.results[1])) { - De <- suppressWarnings(round(log( - -((RF_nat.mean - fit.parameters.results["phi.0"]) / - -fit.parameters.results["delta.phi"] - ) ^ (1 / fit.parameters.results["beta"]) + 1 - ) / - -fit.parameters.results["lambda"], digits = - 2)) - - ##This could be solved with a MC simulation, but for this the code has to be adjusted - ##The question is: Where the parameters are coming from? - ##TODO - De.error <- NA - - De.lower <- suppressWarnings(round(log( - -((RF_nat.error.lower - fit.parameters.results["phi.0"]) / - -fit.parameters.results["delta.phi"] - ) ^ (1 / fit.parameters.results["beta"]) + 1 - ) / - -fit.parameters.results["lambda"],digits = 2)) - - De.upper <- suppressWarnings(round(log( - -((RF_nat.error.upper - fit.parameters.results["phi.0"]) / - -fit.parameters.results["delta.phi"] - ) ^ (1 / fit.parameters.results["beta"]) + 1 - ) / - -fit.parameters.results["lambda"],digits = 2)) - } - } - - ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++# - ##METHOD SLIDE - ANALYSIS - ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++# - else if(method == "SLIDE" || method == "VSLIDE"){ - ##convert to matrix (in fact above the matrix data were first transferred to - ##data.frames ... here - ##we correct this ... again) - RF_nat.limited <- as.matrix(RF_nat.limited) - RF_reg.limited <- matrix(c(RF_reg.x, RF_reg.y), ncol = 2) - RF_nat <- as.matrix(RF_nat) - - ##DEFINE FUNCTION FOR SLIDING - ##FIND MINIMUM - this is done in a function so that it can be further used for MC simulations - # sliding() ----------------------------------------------------------------------------------- - sliding <- function(RF_nat, - RF_nat.limited, - RF_reg.limited, - n.MC = method.control.settings$n.MC, - vslide_range = method.control.settings$vslide_range, - trace = method.control.settings$trace_vslide, - numerical.only = FALSE){ - - ##check for odd user input - if(length(vslide_range) > 2){ - vslide_range <- vslide_range[1:2] - .throw_warning("'vslide_range' in 'method.control' has more ", - "than 2 elements. Only the first two were used") - } - - ##(0) set objects ... nomenclature as used in Frouin et al., please note that here the index - ##is used instead the real time values - t_max.id <- nrow(RF_reg.limited) - t_max_nat.id <- nrow(RF_nat.limited) - t_min.id <- 1 - t_min <- RF_nat.limited[1,1] - - ##(1) calculate sum of residual squares using internal Rcpp function - - #pre-allocate object - temp.sum.residuals <- vector("numeric", length = t_max.id - t_max_nat.id) - - ##initialise slide range for specific conditions, namely NULL and "auto" - if (is.null(vslide_range)) { - vslide_range <- 0 - - } else if (vslide_range[1] == "auto") { - vslide_range <- -(max(RF_reg.limited[, 2]) - min(RF_reg.limited[, 2])):(max(RF_reg.limited[, 2]) - min(RF_reg.limited[, 2])) - algorithm_error <- NA - - } else{ - vslide_range <- vslide_range[1]:vslide_range[2] - algorithm_error <- NULL - - } - - ##problem: the optimisation routine slightly depends on the chosen input sliding vector - ##and it might get trapped in a local minimum - ##therefore we run the algorithm by expanding the sliding vector - if(!is.null(vslide_range) && any(vslide_range != 0)){ - - ##even numbers makes it complicated, so let's make it odd if not already the case - if(length(vslide_range) %% 2 == 0){ - vslide_range <- c(vslide_range[1], vslide_range, vslide_range) - - } - - ##construct list of vector ranges we want to check for, this should avoid that we - ##got trapped in a local minimum - median_vslide_range.index <- median(1:length(vslide_range)) - vslide_range.list <- lapply(seq(1, median_vslide_range.index, length.out = 10), function(x){ - c(median_vslide_range.index - as.integer(x), median_vslide_range.index + as.integer(x)) - }) - - ##correct for out of bounds problem; it might occur - vslide_range.list[[10]] <- c(0, length(vslide_range)) - - ##TODO ... this is not really optimal, but ok for the moment, better would be - ##the algorithm finds sufficiently the global minimum. - ##now run it in a loop and expand the range from the inner to the outer part - ##at least this is considered for the final error range ... - temp_minium_list <- lapply(1:10, function(x){ - src_analyse_IRSARRF_SRS( - values_regenerated_limited = RF_reg.limited[,2], - values_natural_limited = RF_nat.limited[,2], - vslide_range = vslide_range[vslide_range.list[[x]][1]:vslide_range.list[[x]][2]], - n_MC = 0, #we don't need MC runs here, so make it quick - trace = trace)[c("sliding_vector_min_index","vslide_minimum", "vslide_index")] - - }) - - ##get all horizontal index value for the local minimum (corresponding to the vslide) - temp_hslide_indices <- vapply(temp_minium_list, function(x){ - x$sliding_vector_min_index}, FUN.VALUE = numeric(length = 1)) - - ##get also the vertical slide indices - temp_vslide_indices <- vapply(temp_minium_list, function(x){ - x$vslide_index}, FUN.VALUE = numeric(length = 1)) - - ##get all the minimum values - temp_minium <- vapply(temp_minium_list, function(x){x$vslide_minimum}, FUN.VALUE = numeric(length = 1)) - - ##get minimum and set it to the final range - vslide_range <- vslide_range[ - vslide_range.list[[which.min(temp_minium)]][1]:vslide_range.list[[which.min(temp_minium)]][2]] - - - ##get all possible t_n values for the range expansion ... this can be considered - ##as somehow systematic uncertainty, but it will be only calculated of the full range - ##is considered, otherwise it is too biased by the user's choice - ##ToDo: So far the algorithm error is not sufficiently documented - if(!is.null(algorithm_error)){ - algorithm_error <- sd(vapply(1:length(temp_vslide_indices), function(k){ - temp.sliding.step <- RF_reg.limited[temp_hslide_indices[k]] - t_min - matrix(data = c(RF_nat[,1] + temp.sliding.step, RF_nat[,2] + temp_vslide_indices[k]), ncol = 2)[1,1] - - }, FUN.VALUE = numeric(length = 1))) - - }else{ - algorithm_error <- NA - - } - - }else{ - algorithm_error <- NA - - } - - ##now run the final sliding with the identified range that corresponds to the minimum value - temp.sum.residuals <- - src_analyse_IRSARRF_SRS( - values_regenerated_limited = RF_reg.limited[,2], - values_natural_limited = RF_nat.limited[,2], - vslide_range = vslide_range, - n_MC = if(is.null(n.MC)) 0 else n.MC, - trace = trace - ) - - #(2) get minimum value (index and time value) - index_min <- which.min(temp.sum.residuals$sliding_vector) - if(length(index_min) == 0) t_n.id <- 1 else t_n.id <- index_min - - I_n <- 0 - if (!is.null(vslide_range)) { - I_n <- vslide_range[temp.sum.residuals$vslide_index] - } - - temp.sliding.step <- RF_reg.limited[t_n.id] - t_min - - ##(3) slide curve graphically ... full data set we need this for the plotting later - RF_nat.slid <- matrix(data = c(RF_nat[,1] + temp.sliding.step, RF_nat[,2] + I_n), ncol = 2) - t_n <- RF_nat.slid[1,1] - - ##the same for the MC runs of the minimum values - if(!is.null(n.MC)) { - t_n.MC <- - vapply( - X = 1:length(temp.sum.residuals$sliding_vector_min_MC), - FUN = function(x) { - ##get minimum for MC - t_n.id.MC <- - which( - temp.sum.residuals$sliding_vector == temp.sum.residuals$sliding_vector_min_MC[x] - ) - - ## there is low change to get two indices, in - ## such cases we should take the mean - temp.sliding.step.MC <- - RF_reg.limited[t_n.id.MC] - t_min - - if(length(temp.sliding.step.MC)>1){ - t_n.MC <- (RF_nat[, 1] + mean(temp.sliding.step.MC))[1] - - }else{ - t_n.MC <- (RF_nat[, 1] + temp.sliding.step.MC)[1] - - } - - return(t_n.MC) - - }, - FUN.VALUE = vector(mode = "numeric", length = 1) - ) - - } else{ - t_n.MC <- NA_integer_ - - } - - ##(4) get residuals (needed to be plotted later) - ## they cannot be longer than the RF_reg.limited curve - if((t_n.id+length(RF_nat.limited[,2])-1) >= nrow(RF_reg.limited)){ - residuals <- (RF_nat.limited[1:length(t_n.id:nrow(RF_reg.limited)),2] + I_n) - - RF_reg.limited[t_n.id:nrow(RF_reg.limited), 2] - - }else{ - residuals <- (RF_nat.limited[,2] + I_n) - RF_reg.limited[t_n.id:(t_n.id+length(RF_nat.limited[,2])-1), 2] - - } - - ##(4.1) calculate De from the first channel ... which is t_n here - De <- round(t_n, digits = 2) - De.MC <- round(t_n.MC, digits = 2) - - temp.trend.fit <- NA - - ##(5) calculate trend fit - if(length(RF_nat.limited[,1]) > length(residuals)){ - temp.trend.fit <- coef(lm(y~x, - data.frame(x = RF_nat.limited[1:length(residuals),1], y = residuals))) - - }else{ - temp.trend.fit <- coef(lm(y~x, data.frame(x = RF_nat.limited[,1], y = residuals))) - - } - - ##return values and limited if they are not needed - if (numerical.only == FALSE) { - return( - list( - De = De, - De.MC = De.MC, - residuals = residuals, - trend.fit = temp.trend.fit, - RF_nat.slid = RF_nat.slid, - t_n.id = t_n.id, - I_n = I_n, - algorithm_error = algorithm_error, - vslide_range = if(is.null(vslide_range)){NA}else{range(vslide_range)}, - squared_residuals = temp.sum.residuals$sliding_vector - ) - ) - }else{ - return(list(De = De, De.MC = De.MC)) - } - - }##end of function sliding() - - - ##PERFORM sliding and overwrite values - slide <- sliding( - RF_nat = RF_nat, - RF_nat.limited = RF_nat.limited, - RF_reg.limited = RF_reg.limited - ) - - ##write results in variables - De <- slide$De - residuals <- slide$residuals - RF_nat.slid <- slide$RF_nat.slid - I_n <- slide$I_n - - # ERROR ESTIMATION - # MC runs for error calculation --------------------------------------------------------------- - - ##set residual matrix for MC runs, i.e. set up list of pseudo RF_nat curves as function - ##(i.e., bootstrap from the natural curve distribution) - - De.diff <- De.error <- De.lower <- De.upper <- De.MC <- NA_integer_ - if(!is.null(n.MC)){ - slide.MC.list <- lapply(1:n.MC,function(x) { - - ##also here we have to account for the case that user do not understand - ##what they are doing ... - if(slide$t_n.id + nrow(RF_nat.limited)-1 > nrow(RF_reg.limited)){ - cbind( - RF_nat.limited[1:length(slide$t_n.id:nrow(RF_reg.limited)),1], - (RF_reg.limited[slide$t_n.id:nrow(RF_reg.limited) ,2] - + sample(residuals, - size = length(slide$t_n.id:nrow(RF_reg.limited)), - replace = TRUE) - ) - ) - - }else{ - cbind( - RF_nat.limited[,1], - (RF_reg.limited[slide$t_n.id:(slide$t_n.id + nrow(RF_nat.limited)-1) ,2] - + sample(residuals, size = nrow(RF_nat.limited), replace = TRUE) - ) - ) - } - - }) - - ##set parallel calculation if wanted - if(is.null(method.control.settings$cores)){ - cores <- 1 - - } else { - available.cores <- parallel::detectCores() - - ##case 'auto' - if(method.control.settings$cores == 'auto'){ - cores <- available.cores - 2 - if (cores <= 0) { - # nocov start - .throw_warning("Multicore 'auto' mode needs at least 4 cores") - cores <- 1 - # nocov end - } - - }else if(is.numeric(method.control.settings$cores[1])){ - if (method.control.settings$cores > available.cores) { - .throw_warning("What do you want? Your machine has only ", - available.cores, " cores") - - ##assign all they have, it is not our problem - cores <- available.cores - - } else if (method.control.settings$cores >= 1 && - method.control.settings$cores <= available.cores) { - cores <- method.control.settings$cores - - } else { # Negative values - cores <- 1 - - } - - }else{ - message("[analyse_IRSAR.RF()] Invalid value for control argument 'cores'. Value set to 1") - cores <- 1 - - } - - ##return message - if (cores[1] == 1) - message("[analyse_IRSAR.RF()] Singlecore mode") - else - message("[analyse_IRSAR.RF()] Multicore mode using ", cores, " cores...") - } - - ## SINGLE CORE ----- - if (cores[1] == 1) { - if(txtProgressBar){ - ##progress bar - cat("\n\t Run Monte Carlo loops for error estimation\n") - pb <- txtProgressBar(min = 0, max = n.MC, initial = 0, char = "=", style = 3) - } - - De.MC <- sapply(1:n.MC, function(i) { - # update progress bar - if (txtProgressBar) setTxtProgressBar(pb, i) - - sliding( - RF_nat = RF_nat, - RF_reg.limited = RF_reg.limited, - RF_nat.limited = slide.MC.list[[i]], - numerical.only = TRUE - )[[2]] - }) - - ## close progress bar - if (txtProgressBar) close(pb) - - ## MULTICORE ----- - } else { - ## Create the determined number of R copies - cl <- parallel::makeCluster(cores) - - ##run MC runs - De.MC <- parallel::parSapply(cl, X = slide.MC.list, - FUN = function(x){ - sliding( - RF_nat = RF_nat, - RF_reg.limited = RF_reg.limited, - RF_nat.limited = x, - numerical.only = TRUE - )[[2]] - }) - ##destroy multicore cluster - parallel::stopCluster(cl) - } - ##calculate absolute deviation between De and the here newly calculated De.MC - ##this is, e.g. ^t_n.1* - ^t_n in Frouin et al. - De.diff <- diff(x = c(De, De.MC)) - De.error <- round(sd(De.MC), digits = 2) - De.lower <- De - quantile(De.diff, 0.975, na.rm = TRUE) - De.upper <- De - quantile(De.diff, 0.025, na.rm = TRUE) - } - - }else{ - .throw_warning("Analysis skipped: Unknown method or threshold of test parameter exceeded.") - } - - ##===============================================================================================# - ## TEST PARAMETER - ##===============================================================================================# - ## Test parameter are evaluated after all the calculations have been done as - ## it should be up to the user to decide whether a value should be taken into account or not. - - ##(0) - ##set default values and overwrite them if there was something new - ##set defaults - TP <- list( - curves_ratio = 1.001, - intersection_ratio = NA, - residuals_slope = NA, - curves_bounds = ceiling(max(RF_reg.x)), - dynamic_ratio = NA, - lambda = NA, - beta = NA, - delta.phi = NA - ) - - ##modify default values by given input - if(!is.null(test_parameters)){TP <- modifyList(TP, test_parameters)} - - ##remove NULL elements from list - TP <- TP[!sapply(TP, is.null)] - - ##set list with values we want to evaluate - TP <- lapply(TP, function(x){ - data.frame(THRESHOLD = as.numeric(x), VALUE = NA, STATUS = "OK", stringsAsFactors = TRUE) - - }) - - - ##(1) check if RF_nat > RF_reg, considering the fit range - ##TP$curves_ratio - if ("curves_ratio" %in% names(TP)) { - TP$curves_ratio$VALUE <- - sum(RF_nat.limited[,2]) / sum(RF_reg[RF_nat.lim[1]:RF_nat.lim[2], 2]) - - if (!is.na(TP$curves_ratio$THRESHOLD)) { - TP$curves_ratio$STATUS <- - ifelse(TP$curves_ratio$VALUE > TP$curves_ratio$THRESHOLD, "FAILED", "OK") - } - } - - ##(1.1) check if RF_nat > RF_reg, considering the fit range - ##TP$intersection_ratio - if ("intersection_ratio" %in% names(TP)) { - - ##It is, as always, a little bit more complicated ... - ##We cannot just normalise both curves and compare ratios. With increasing De the curve - ##shape of the RF_nat curve cannot be the same as the RF_reg curve at t = 0. Therefore we - ##have to find the segment in the RF_reg curve that fits to the RF_nat curve - ## - ##(1) get maximum count value for RF_nat - IR_RF_nat.max <- max(RF_nat.limited[,2]) - - ##(2) find corresponding time value for RF_reg (here no limited) - IR_RF_reg.corresponding_id <- which.min(abs(RF_reg[,2] - IR_RF_nat.max)) - - ##(3) calculate ratio, but just starting from the point where both curves correspond - ##in terms of intensiy, otherwise the ratio cannot be correct - - ##the boundary check is necessary to avoid errors - if((IR_RF_reg.corresponding_id + length(RF_nat.lim[1]:RF_nat.lim[2])) > length(RF_reg[,2])){ - TP$intersection_ratio$VALUE <- Inf - - }else{ - - TP$intersection_ratio$VALUE <- - abs(1 - sum((RF_nat.limited[, 2] / max(RF_nat.limited[, 2]))) / - sum(RF_reg[IR_RF_reg.corresponding_id:(IR_RF_reg.corresponding_id + length(RF_nat.lim[1]:RF_nat.lim[2]) - 1), 2] / - max(RF_reg[IR_RF_reg.corresponding_id:(IR_RF_reg.corresponding_id + length(RF_nat.lim[1]:RF_nat.lim[2]) - 1), 2]))) - - if (!is.na(TP$intersection_ratio$THRESHOLD)) { - TP$intersection_ratio$STATUS <- - ifelse(TP$intersection_ratio$VALUE > TP$intersection_ratio$THRESHOLD, "FAILED", "OK") - } - - rm(IR_RF_nat.max, IR_RF_reg.corresponding_id) - - } - } - - ##(2) check slop of the residuals using a linear fit - ##TP$residuals_slope - if ("residuals_slope" %in% names(TP)) { - if (exists("slide")) { - TP$residuals_slope$VALUE <- abs(slide$trend.fit[2]) - - if (!is.na(TP$residuals_slope$THRESHOLD)) { - TP$residuals_slope$STATUS <- ifelse( - TP$residuals_slope$VALUE > TP$residuals_slope$THRESHOLD, "FAILED", "OK") - - } - } - } - - ##(3) calculate dynamic range of regenrated curve - ##TP$dynamic_ratio - if ("dynamic_ratio"%in%names(TP)){ - TP.dynamic_ratio <- subset(temp.sequence_structure, - temp.sequence_structure$protocol.step == "REGENERATED") - TP$dynamic_ratio$VALUE <- TP.dynamic_ratio$y.max/TP.dynamic_ratio$y.min - - if (!is.na(TP$dynamic_ratio$THRESHOLD)){ - TP$dynamic_ratio$STATUS <- ifelse( - TP$dynamic_ratio$VALUE < TP$dynamic_ratio$THRESHOLD , "FAILED", "OK") - } - } - - - ##(4) decay parameter - ##TP$lambda - if ("lambda"%in%names(TP) & "beta"%in%names(TP) & "delta.phi"%in%names(TP)){ - - fit.lambda <- try(minpack.lm::nlsLM( - fit.function, - data = data.frame(x = RF_reg.x, y = RF_reg.y), - algorithm = "LM", - start = list( - phi.0 = fit.parameters.start["phi.0"], - delta.phi = fit.parameters.start["delta.phi"], - lambda = fit.parameters.start["lambda"], - beta = fit.parameters.start["beta"] - ), - lower = c( - phi.0 = .Machine$double.xmin, - delta.phi = .Machine$double.xmin, - lambda = .Machine$double.xmin, - beta = .Machine$double.xmin - ), - upper = c( - phi.0 = max(RF_reg.y), - delta.phi = max(RF_reg.y), - lambda = 1, beta = 100 - ) - ), - silent = TRUE - ) - - if(!inherits(fit.lambda, "try-error")){ - temp.coef <- coef(fit.lambda) - - TP$lambda$VALUE <- temp.coef["lambda.lambda"] - TP$beta$VALUE <- temp.coef["beta.beta"] - TP$delta.phi$VALUE <- temp.coef["delta.phi.delta.phi"] - - if (!is.na( TP$lambda$THRESHOLD)){ - TP$lambda$STATUS <- ifelse(TP$lambda$VALUE <= TP$lambda$THRESHOLD, "FAILED", "OK") - } - - if (!is.na( TP$beta$THRESHOLD)){ - TP$beta$STATUS <- ifelse(TP$beta$VALUE <= TP$beta$THRESHOLD, "FAILED", "OK") - } - - if (!is.na( TP$delta.phi$THRESHOLD)){ - TP$delta.phi$STATUS <- ifelse(TP$delta.phi$VALUE <= TP$delta.phi$THRESHOLD, "FAILED", "OK") - } - - } - } - - ##(99) check whether after sliding the - ##TP$curves_bounds - if (!is.null(TP$curves_bounds)) { - if(exists("slide")){ - ## add one channel on the top to make sure that it works - TP$curves_bounds$VALUE <- max(RF_nat.slid[RF_nat.lim,1]) + (RF_nat[2,1] - RF_nat[1,1]) - - if (!is.na(TP$curves_bounds$THRESHOLD)){ - TP$curves_bounds$STATUS <- ifelse(TP$curves_bounds$VALUE >= floor(max(RF_reg.x)), "FAILED", "OK") - } - - - }else if(exists("fit")){ - TP$curves_bounds$VALUE <- De.upper - - if (!is.na(TP$curves_bounds$THRESHOLD)){ - TP$curves_bounds$STATUS <- ifelse(TP$curves_bounds$VALUE >= max(RF_reg.x), "FAILED", "OK") - } - } - } - - - ##Combine everything in a data.frame - De.status <- "OK" - TP.data.frame <- NULL - if (length(TP) != 0) { - TP.data.frame <- as.data.frame( - cbind( - POSITION = as.integer(aliquot.position), - PARAMETER = c(names(TP)), - do.call(data.table::rbindlist, args = list(l = TP)), - SEQUENCE_NAME = aliquot.sequence_name, - UID = NA - ) - ) - - ##set De.status to indicate whether there is any problem with the De according to the test parameter - if ("FAILED" %in% TP.data.frame$STATUS) { - De.status <- "FAILED" - } - } - - ##===============================================================================================# - # Plotting ------------------------------------------------------------------------------------ - ##===============================================================================================# - if (plot) { - - ##get internal colour definition - col <- get("col", pos = .LuminescenceEnv) - - if (!plot_reduced) { - - ##grep par default and define reset - def.par <- par(no.readonly = TRUE) - on.exit(par(def.par)) - - ##set plot frame, if a method was chosen - if (any(method %in% c("SLIDE", "FIT", "VSLIDE"))) { - layout(matrix(c(1, 2), 2, 1, byrow = TRUE), c(2), c(1.3, 0.4), TRUE) - par( - oma = c(1, 1, 1, 1), - mar = c(0, 4, 3, 0), - cex = plot.settings$cex - ) - - } - }else{ - if(plot.settings[["cex"]] != 1){ - def.par <- par()[["cex"]] - on.exit(par(def.par)) - - par(cex = plot.settings[["cex"]]) - - } - - } - - ##here control xlim and ylim behaviour - ##xlim - xlim <- if ("xlim" %in% names(list(...))) { - list(...)$xlim - } else - { - if (plot.settings$log == "x" | plot.settings$log == "xy") { - c(min(temp.sequence_structure$x.min),max(temp.sequence_structure$x.max)) - - }else{ - c(0,max(temp.sequence_structure$x.max)) - - } - - } - - ##ylim - ylim <- if("ylim" %in% names(list(...))) {list(...)$ylim} else - {c(min(temp.sequence_structure$y.min), max(temp.sequence_structure$y.max))} - - ##open plot area - plot( - NA,NA, - xlim = xlim, - ylim = ylim, - xlab = ifelse((!any(method %in% c("SLIDE", "FIT", "VSLIDE"))) | plot_reduced, plot.settings$xlab," "), - xaxt = ifelse((!any(method %in% c("SLIDE", "FIT", "VSLIDE"))) | plot_reduced, plot.settings$xaxt,"n"), - yaxt = "n", - ylab = plot.settings$ylab, - main = plot.settings$main, - log = plot.settings$log, - - ) - - if(De.status == "FAILED"){ - - ##build list of failed TP - mtext.message <- paste0( - "Threshold exceeded for: ", - paste(subset(TP.data.frame, TP.data.frame$STATUS == "FAILED")$PARAMETER, collapse = ", "),". For details see manual.") - - ##print mtext - mtext(text = mtext.message, - side = 3, outer = TRUE, col = "red", - cex = 0.8 * par()[["cex"]]) - warning(mtext.message, call. = FALSE) - - } - - ##use scientific format for y-axis - labels <- axis(2, labels = FALSE) - axis(side = 2, at = labels, labels = format(labels, scientific = TRUE)) - - ##(1) plot points that have been not selected - points(RF_reg[-(min(RF_reg.lim):max(RF_reg.lim)),1:2], pch=3, col=col[19]) - - ##(2) plot points that has been used for the fitting - points(RF_reg.x,RF_reg.y, pch=3, col=col[10]) - - ##show natural points if no analysis was done - if(!any(method %in% c("SLIDE", "FIT", "VSLIDE"))){ - ##add points - points(RF_nat, pch = 20, col = "grey") - points(RF_nat.limited, pch = 20, col = "red") - - ##legend - if (plot.settings$legend) { - legend( - plot.settings$legend.pos, - legend = plot.settings$legend.text, - pch = c(19, 3), - col = c("red", col[10]), - horiz = TRUE, - bty = "n", - cex = .9 * par()[["cex"]] - ) - } - - - } - - - ##Add fitted curve, if possible. This is a graphical control that might be considered - ##as useful before further analysis will be applied - if (method.control.settings$show_fit) { - - if(!is(fit.lambda, "try-error")){ - fit.lambda_coef <- coef(fit.lambda) - - curve(fit.lambda_coef[[1]]- - (fit.lambda_coef[[2]]* - ((1-exp(-fit.lambda_coef[[3]]*x))^fit.lambda_coef[[4]])), - add=TRUE, - lty = 2, - col="red") - - rm(fit.lambda_coef) - }else{ - .throw_warning("No fit possible, no fit shown.") - } - } - - ## ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++# - ## PLOT - METHOD FIT - ## ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++# - if(method == "FIT"){ - - ##dummy to cheat R CMD check - x<-NULL; rm(x) - - ##plot fitted curve - curve(fit.parameters.results["phi.0"]- - (fit.parameters.results["delta.phi"]* - ((1-exp(-fit.parameters.results["lambda"]*x))^fit.parameters.results["beta"])), - add=TRUE, - from = RF_reg[min(RF_reg.lim), 1], - to = RF_reg[max(RF_reg.lim), 1], - col="red") - - ##plotting to show the limitations if RF_reg.lim was chosen - ##show fitted curve GREY (previous red curve) - curve(fit.parameters.results["phi.0"]- - (fit.parameters.results["delta.phi"]* - ((1-exp(-fit.parameters.results["lambda"]*x))^fit.parameters.results["beta"])), - add=TRUE, - from = min(RF_reg[, 1]), - to = RF_reg[min(RF_reg.lim), 1], - col="grey") - - ##show fitted curve GREY (after red curve) - curve(fit.parameters.results["phi.0"]- - (fit.parameters.results["delta.phi"]* - ((1-exp(-fit.parameters.results["lambda"]*x))^fit.parameters.results["beta"])), - add=TRUE, - from = RF_reg[max(RF_reg.lim), 1], - to = max(RF_reg[, 1]), - col="grey") - - ##add points - points(RF_nat, pch = 20, col = col[19]) - points(RF_nat.limited, pch = 20, col = col[2]) - - ##legend - if (plot.settings$legend) { - legend( - plot.settings$legend.pos, - legend = plot.settings$legend.text, - pch = c(19, 3), - col = c("red", col[10]), - horiz = TRUE, - bty = "n", - cex = .9 * par()[["cex"]] - ) - } - - ##plot range choosen for fitting - abline(v=RF_reg[min(RF_reg.lim), 1], lty=2) - abline(v=RF_reg[max(RF_reg.lim), 1], lty=2) - - ##plot De if De was calculated - if(is.na(De) == FALSE & is.nan(De) == FALSE){ - - lines(c(0,De.lower), c(RF_nat.error.lower,RF_nat.error.lower), lty=2, col="grey") - lines(c(0,De), c(RF_nat.mean,RF_nat.mean), lty=2, col="red") - lines(c(0,De.upper), c(RF_nat.error.upper,RF_nat.error.upper), lty=2, col="grey") - - lines(c(De.lower, De.lower), - c(0,RF_nat.error.lower), lty=2, col="grey") - lines(c(De,De), c(0, RF_nat.mean), lty=2, col="red") - lines(c(De.upper, De.upper), - c(0,RF_nat.error.upper), lty=2, col="grey") - - } - - ##Insert fit and result - if(is.na(De) != TRUE & (is.nan(De) == TRUE | - De > max(RF_reg.x) | - De.upper > max(RF_reg.x))){ - - try(mtext(side=3, substitute(D[e] == De, - list(De=paste0( - De," (", De.lower," ", De.upper,")"))), - line=0, cex=0.8 * par()[["cex"]], col="red"), silent=TRUE) - - De.status <- "VALUE OUT OF BOUNDS" - - } else{ - - if ("mtext" %in% names(list(...))) { - mtext(side = 3, list(...)$mtext) - }else{ - try(mtext( - side = 3, - substitute(D[e] == De, - list( - De = paste0(De," [",De.lower," ; ", De.upper,"]") - )), - line = 0, - cex = 0.7 * par()[["cex"]] - ), - silent = TRUE) - } - - De.status <- "OK" - } - - - if (!plot_reduced) { - - ##==lower plot==## - par(mar = c(4.2, 4, 0, 0)) - - ##plot residuals - if (is.na(fit.parameters.results[1]) == FALSE) { - plot( - RF_reg.x, - residuals(fit), - xlim = c(0, max(temp.sequence_structure$x.max)), - xlab = plot.settings$xlab, - yaxt = "n", - xaxt = plot.settings$xaxt, - type = "p", - pch = 20, - col = "grey", - ylab = "E", - log = "" - ) - - ##add 0 line - abline(h = 0) - } else{ - plot( - NA, - NA, - xlim = c(0, max(temp.sequence_structure$x.max)), - ylab = "E", - xlab = plot.settings$xlab, - xaxt = plot.settings$xaxt, - ylim = c(-1, 1) - ) - text(x = max(temp.sequence_structure$x.max) / 2, - y = 0, - "Fitting Error!") - } - - } - } - - ## ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++# - ## PLOT - METHOD SLIDE - ## ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++# - else if(method == "SLIDE" || method == "VSLIDE"){ - ##(0) density plot - if (method.control.settings$show_density) { - ##showing the density makes only sense when we see at least 10 data points - if (!any(is.na(De.MC)) && length(unique(De.MC)) >= 15) { - - ##calculate density De.MC - density.De.MC <- density(De.MC) - - ##calculate transformation function - x.1 <- max(density.De.MC$y) - x.2 <- min(density.De.MC$y) - - ##with have to limit the scaling a little bit - if (RF_nat.limited[1,2] > - max(RF_reg.limited[,2]) - (max(RF_reg.limited[,2]) - min(RF_reg.limited[,2]))*.5) { - - y.1 <- max(RF_reg.limited[,2]) - (max(RF_reg.limited[,2]) - min(RF_reg.limited[,2]))*.5 - - }else{ - y.1 <- RF_nat.limited[1,2] - - } - - y.2 <- par("usr")[3] - - m <- (y.1 - y.2) / (x.1 + x.2) - n <- y.1 - m * x.1 - - density.De.MC$y <- m * density.De.MC$y + n - rm(x.1,x.2,y.1,y.2,m,n) - - polygon(density.De.MC$x, - density.De.MC$y, - col = rgb(0,0.4,0.8,0.5)) - - }else{ - .throw_warning("Narrow density distribution, ", - "no density distribution plotted") - } - } - - ##(1) plot unused points in grey ... unused points are points outside of the set limit - points( - matrix(RF_nat.slid[-(min(RF_nat.lim):max(RF_nat.lim)),1:2], ncol = 2), - pch = 21, col = col[19] - ) - - ##(2) add used points - points(RF_nat.slid[min(RF_nat.lim):max(RF_nat.lim),], pch = 21, col = col[2], - bg = col[2]) - - ##(3) add line to show the connection between the first point and the De - lines(x = c(RF_nat.slid[1,1], RF_nat.slid[1,1]), - y = c(.Machine$double.xmin,RF_nat.slid[1,2]), - lty = 2, - col = col[2] - ) - - ##(4) add arrow at the lowest y-coordinate possible to show the sliding - if (plot.settings$log != "y" & plot.settings$log != "xy") { - shape::Arrows( - x0 = 0, - y0 = ylim[1], - y1 = ylim[1], - x1 = RF_nat.slid[1,1], - arr.type = "triangle", - arr.length = 0.3 * par()[["cex"]], - code = 2, - col = col[2], - arr.adj = 1, - arr.lwd = 1 - ) - } - - ##(5) add vertical shift as arrow; show nothing if nothing was shifted - if (plot.settings$log != "y" & plot.settings$log != "xy" & I_n != 0) { - shape::Arrows( - x0 = (0 + par()$usr[1])/2, - y0 = RF_nat[1,2], - y1 = RF_nat[1,2] + I_n, - x1 = (0 + par()$usr[1])/2, - arr.type = "triangle", - arr.length = 0.3 * par()[["cex"]], - code = 2, - col = col[2], - arr.adj = 1, - arr.lwd = 1 - ) - } - - - ##TODO - ##uncomment here to see all the RF_nat curves produced by the MC runs - ##could become a polygone for future versions - #lapply(1:n.MC, function(x){lines(slide.MC.list[[x]], col = rgb(0,0,0, alpha = 0.2))}) - - ##plot range choosen for fitting - abline(v=RF_reg[min(RF_reg.lim), 1], lty=2) - abline(v=RF_reg[max(RF_reg.lim), 1], lty=2) - - if (plot.settings$legend) { - legend( - plot.settings$legend.pos, - legend = plot.settings$legend.text, - pch = c(19, 3), - col = c("red", col[10]), - horiz = TRUE, - bty = "n", - cex = .9 * par()[["cex"]] - ) - - } - - - ##write information on the De in the plot - if("mtext" %in% names(list(...))) { - - mtext(side = 3, list(...)$mtext) - - }else{ - - try(mtext(side=3, - substitute(D[e] == De, list(De=paste0(De," [", De.lower, " ; ", De.upper, "]"))), - line=0, - cex=0.7 * par()[["cex"]]), - silent=TRUE) - - } - - if (!plot_reduced) { - ##==lower plot==## - ##RESIDUAL PLOT - par(mar = c(4, 4, 0, 0)) - - plot( - NA, - NA, - ylim = range(residuals), - xlim = xlim, - xlab = plot.settings$xlab, - type = "p", - pch = 1, - col = "grey", - xaxt = plot.settings$xaxt, - ylab = "E", - yaxt = "n", - log = ifelse( - plot.settings$log == "y" | - plot.settings$log == "xy", - "", - plot.settings$log - ) - ) - - ##add axis for 0 ... means if the 0 is not visible there is labelling - axis(side = 4, - at = 0, - labels = 0) - - ##add residual indicator (should circle around 0) - col.ramp <- colorRampPalette(c(col[19], "white", col[19])) - col.polygon <- col.ramp(100) - - if (plot.settings$log != "x") { - shape::filledrectangle( - mid = c((xlim[2]) + (par("usr")[2] - xlim[2]) / 2, - max(residuals) - diff(range(residuals)) / 2), - wx = par("usr")[2] - xlim[2], - wy = diff(range(residuals)), - col = col.polygon - ) - - } - ##add 0 line - abline(h = 0, lty = 3) - - ##0-line indicator and arrows if this is not visible - ##red colouring here only if the 0 point is not visible to avoid too much colouring - if (max(residuals) < 0 & - min(residuals) < 0) { - shape::Arrowhead( - x0 = xlim[2] + (par("usr")[2] - xlim[2]) / 2, - y0 = max(residuals), - angle = 270, - lcol = col[2], - arr.length = 0.4, - arr.type = "triangle", - arr.col = col[2] - ) - - } else if (max(residuals) > 0 & min(residuals) > 0) { - shape::Arrowhead( - x0 = xlim[2] + (par("usr")[2] - xlim[2]) / 2, - y0 = min(residuals), - angle = 90, - lcol = col[2], - arr.length = 0.4, - arr.type = "triangle", - arr.col = col[2] - ) - - - } else{ - points(xlim[2], 0, pch = 3) - - } - - - ##add residual points - if (length(RF_nat.slid[c(min(RF_nat.lim):max(RF_nat.lim)), 1]) > length(residuals)) { - temp.points.diff <- - length(RF_nat.slid[c(min(RF_nat.lim):max(RF_nat.lim)), 1]) - - length(residuals) - - points(RF_nat.slid[c(min(RF_nat.lim):(max(RF_nat.lim) - temp.points.diff)), 1], - residuals, - pch = 20, - col = rgb(0, 0, 0, 0.4)) - - } else{ - points(RF_nat.slid[c(min(RF_nat.lim):max(RF_nat.lim)), 1], - residuals, - pch = 20, - col = rgb(0, 0, 0, 0.4)) - - } - - ##add vertical line to mark De (t_n) - abline(v = De, lty = 2, col = col[2]) - - ##add numeric value of De ... t_n - axis( - side = 1, - at = De, - labels = De, - cex.axis = 0.8 * plot.settings$cex, - col = "blue", - padj = -1.55, - ) - - - ##TODO- CONTROL PLOT! ... can be implemented in appropriate form in a later version - if (method.control.settings$trace) { - par(new = TRUE) - plot( - RF_reg.limited[1:length(slide$squared_residuals),1], - slide$squared_residuals, - ylab = "", - type = "l", - xlab = "", - xaxt = plot.settings$xaxt, - axes = FALSE, - xlim = xlim, - ylim = ylim, - log = "y" - ) - } - } - - } - - }#endif::plot - - # Return -------------------------------------------------------------------------------------- - ##catch up worst case scenarios ... means something went wrong - if(!exists("De")){De <- NA} - if(!exists("De.error")){De.error <- NA} - if(!exists("De.MC")){De.MC <- NA} - if(!exists("De.lower")){De.lower <- NA} - if(!exists("De.upper")){De.upper <- NA} - if(!exists("De.status")){De.status <- NA} - if (!exists("fit")) { - fit <- list() - if (exists("fit.lambda")) { - fit <- fit.lambda - } - } - if(!exists("slide")){slide <- list()} - - ##combine values for De into a data frame - De.values <- data.frame( - DE = De, - DE.ERROR = De.error, - DE.LOWER = De.lower, - DE.UPPER = De.upper, - DE.STATUS = De.status, - RF_NAT.LIM = paste(RF_nat.lim, collapse = ":"), - RF_REG.LIM = paste(RF_reg.lim, collapse = ":"), - POSITION = as.integer(aliquot.position), - DATE = aliquot.date, - SEQUENCE_NAME = aliquot.sequence_name, - UID = NA, - row.names = NULL, - stringsAsFactors = FALSE - ) - - ##generate unique identifier - UID <- create_UID() - - ##update data.frames accordingly - De.values$UID <- UID - - if(!is.null(TP.data.frame)){ - TP.data.frame$UID <- UID - - } - - - ##produce results object - newRLumResults.analyse_IRSAR.RF <- set_RLum( - class = "RLum.Results", - data = list( - data = De.values, - De.MC = De.MC, - test_parameters = TP.data.frame, - fit = fit, - slide = slide - ), - info = list(call = sys.call()) - ) - - invisible(newRLumResults.analyse_IRSAR.RF) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_SAR.CWOSL.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_SAR.CWOSL.R deleted file mode 100644 index cc008c810..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_SAR.CWOSL.R +++ /dev/null @@ -1,1656 +0,0 @@ -#' @title Analyse SAR CW-OSL measurements -#' -#' @description The function performs a SAR CW-OSL analysis on an -#' [RLum.Analysis-class] object including growth curve fitting. -#' -#' @details -#' The function performs an analysis for a standard SAR protocol measurements -#' introduced by Murray and Wintle (2000) with CW-OSL curves. For the -#' calculation of the `Lx/Tx` value the function [calc_OSLLxTxRatio] is -#' used. For **changing the way the Lx/Tx error is calculated** use the argument -#' `background.count.distribution` and `sigmab`, which will be passed to the function -#' [calc_OSLLxTxRatio]. -#' -#' **What is part of a SAR sequence?** -#' -#' The function is rather picky when it comes down to accepted curve input (OSL,IRSL,...) and structure. -#' A SAR sequence is basically a set of \eqn{L_{x}/T_{x}} curves. Hence, every 2nd curve -#' is considered a shine-down curve related to the test dose. It also means that the number of -#' curves for \eqn{L_{x}} has to be equal to the number of \eqn{T_{x}} curves, and that -#' hot-bleach curves **do not** belong into a SAR sequence; at least not for the analysis. -#' Other curves allowed and processed are preheat curves, or preheat curves measured as TL, and -#' irradiation curves. The later one indicates the duration of the irradiation, the -#' dose and test dose points, e.g., as part of XSYG files. -#' -#' **Argument `object` is of type `list`** -#' -#' If the argument `object` is of type [list] containing **only** -#' [RLum.Analysis-class] objects, the function re-calls itself as often as elements -#' are in the list. This is useful if an entire measurement wanted to be analysed without -#' writing separate for-loops. To gain in full control of the parameters (e.g., `dose.points`) for -#' every aliquot (corresponding to one [RLum.Analysis-class] object in the list), in -#' this case the arguments can be provided as [list]. This `list` should -#' be of similar length as the `list` provided with the argument `object`, -#' otherwise the function will create an own list of the requested length. -#' Function output will be just one single [RLum.Results-class] object. -#' -#' Please be careful when using this option. It may allow a fast an efficient data analysis, but -#' the function may also break with an unclear error message, due to wrong input data. -#' -#' **Working with IRSL data** -#' -#' The function was originally designed to work just for 'OSL' curves, -#' following the principles of the SAR protocol. An IRSL measurement protocol -#' may follow this procedure, e.g., post-IR IRSL protocol (Thomsen et al., -#' 2008). Therefore this functions has been enhanced to work with IRSL data, -#' however, the function is only capable of analysing curves that follow the -#' SAR protocol structure, i.e., to analyse a post-IR IRSL protocol, curve data -#' have to be pre-selected by the user to fit the standards of the SAR -#' protocol, i.e., Lx,Tx,Lx,Tx and so on. -#' -#' Example: Imagine the measurement contains `pIRIR50` and `pIRIR225` IRSL curves. -#' Only one curve type can be analysed at the same time: The `pIRIR50` curves or -#' the `pIRIR225` curves. -#' -#' **Supported rejection criteria** -#' -#' `[recycling.ratio]`: calculated for every repeated regeneration dose point. -#' -#' `[recuperation.rate]`: recuperation rate calculated by comparing the -#' `Lx/Tx` values of the zero regeneration point with the `Ln/Tn` value (the `Lx/Tx` -#' ratio of the natural signal). For methodological background see Aitken and -#' Smith (1988). As a variant with the argument `recuperation_reference` another dose point can be -#' selected as reference instead of `Ln/Tn`. -#' -#' `[testdose.error]`: set the allowed error for the test dose, which per -#' default should not exceed 10%. The test dose error is calculated as `Tx_net.error/Tx_net`. -#' The calculation of the \eqn{T_{n}} error is detailed in [calc_OSLLxTxRatio]. -#' -#' `[palaeodose.error]`: set the allowed error for the De value, which per -#' default should not exceed 10%. -#' -#' **Irradiation times** -#' -#' The function makes two attempts to extra irradiation data (dose points) -#' automatically from the input object, if the argument `dose.points` was not -#' set (aka set to `NULL`). -#' -#' 1. It searches in every curve for an info object called `IRR_TIME`. If this was set, any value -#' set here is taken as dose point. -#' -#' 2. If the object contains curves of type `irradiation`, the function tries to -#' use this information to assign these values to the curves. However, the function -#' does **not** overwrite values preset in `IRR_TIME`. -#' -#' @param object [RLum.Analysis-class] (**required**): -#' input object containing data for analysis, alternatively a [list] of -#' [RLum.Analysis-class] objects can be provided. The object should contain **only** curves -#' considered part of the SAR protocol (see Details.) -#' -#' @param signal.integral.min [integer] (**required**): -#' lower bound of the signal integral. Can be a [list] of [integer]s, if `object` is -#' of type [list]. If the input is vector (e.g., `c(1,2)`) the 2nd value will be interpreted -#' as the minimum signal integral for the `Tx` curve. Can be set to `NA`, in this -#' case no integrals are taken into account. -#' -#' @param signal.integral.max [integer] (**required**): -#' upper bound of the signal integral. Can be a [list] of [integer]s, if `object` is -#' of type [list]. If the input is vector (e.g., `c(1,2)`) the 2nd value will be interpreted -#' as the maximum signal integral for the `Tx` curve. Can be set to `NA`, in this -#' case no integrals are taken into account. -#' -#' @param background.integral.min [integer] (**required**): -#' lower bound of the background integral. Can be a [list] of [integer]s, if `object` is -#' of type [list]. If the input is vector (e.g., `c(1,2)`) the 2nd value will be interpreted -#' as the minimum background integral for the `Tx` curve. Can be set to `NA`, in this -#' case no integrals are taken into account. -#' -#' @param background.integral.max [integer] (**required**): -#' upper bound of the background integral. Can be a [list] of [integer]s, if `object` is -#' of type [list]. If the input is vector (e.g., `c(1,2)`) the 2nd value will be interpreted -#' as the maximum background integral for the `Tx` curve. Can be set to `NA`, in this -#' case no integrals are taken into account. -#' -#' @param OSL.component [character] or [integer] (*optional*): s single index -#' or a [character] defining the signal component to be evaluated. -#' It requires that the object was processed by `[OSLdecomposition::RLum.OSL_decomposition]`. -#' This argument can either be the name of the OSL component assigned by -#' `[OSLdecomposition::RLum.OSL_global_fitting]` or the index in the descending -#' order of decay rates. Then `"1"` selects the fastest decaying component, `"2"` -#' the second fastest and so on. Can be a [list] of [integer]s or strings (or mixed) -#' If object is a [list] and this parameter is provided as [list] it alternates over -#' the elements (aliquots) of the object list, e.g., `list(1,2)` processes the first -#' aliquot with component `1` and the second aliquot with component `2`. -#' `NULL` does not process any component. -#' -#' @param rejection.criteria [list] (*with default*): -#' provide a *named* list and set rejection criteria in **percentage** -#' for further calculation. Can be a [list] in a [list], if `object` is of type [list]. -#' Note: If an *unnamed* [list] is provided the new settings are ignored! -#' -#' Allowed arguments are `recycling.ratio`, `recuperation.rate`, -#' `palaeodose.error`, `testdose.error`, `exceed.max.regpoint = TRUE/FALSE`, -#' `recuperation_reference = "Natural"` (or any other dose point, e.g., `"R1"`). -#' Example: `rejection.criteria = list(recycling.ratio = 10)`. -#' Per default all numerical values are set to 10, `exceed.max.regpoint = TRUE`. -#' Every criterion can be set to `NA`. In this value are calculated, but not considered, i.e. -#' the RC.Status becomes always `'OK'` -#' -#' @param dose.points [numeric] (*optional*): -#' a numeric vector containing the dose points values. Using this argument -#' overwrites dose point values extracted from other data. Can be a [list] of -#' [numeric] vectors, if `object` is of type [list] -#' -#' @param trim_channels [logical] (*with default*): trim channels per record category -#' to the lowest number of channels in the category by using [trim_RLum.Data]. -#' Applies only to `OSL` and `IRSL` curves. For a more granular control use [trim_RLum.Data] -#' before passing the input object. -#' -#' @param mtext.outer [character] (*optional*): -#' option to provide an outer margin `mtext`. Can be a [list] of [character]s, -#' if `object` is of type [list] -#' -#' @param plot [logical] (*with default*): enables or disables plot output. -#' -#' @param plot_onePage [logical] (*with default*): enables or disables on page plot output -#' -#' @param plot.single [logical] (*with default*) or [numeric] (*optional*): -#' single plot output (`TRUE/FALSE`) to allow for plotting the results in single plot windows. -#' If a [numeric] vector is provided the plots can be selected individually, i.e. -#' `plot.single = c(1,2,3,4)` will plot the TL and Lx, Tx curves but not the legend (5) or the -#' growth curve (6), (7) and (8) belong to rejection criteria plots. Requires -#' `plot = TRUE`. -#' -#' @param onlyLxTxTable [logical] (with default): If `TRUE` the dose response -#' curve fitting and plotting is skipped. -#' This allows to get hands on the `Lx/Tx` table for large datasets -#' without the need for a curve fitting. -#' -#' @param ... further arguments that will be passed to the function -#' [plot_GrowthCurve] or [calc_OSLLxTxRatio] -#' (supported: `background.count.distribution`, `sigmab`, `sig0`). -#' **Please note** that if you consider to use the early light subtraction -#' method you should provide your own `sigmab` value! -# -#' @return -#' A plot (*optional*) and an [RLum.Results-class] object is -#' returned containing the following elements: -#' -#' \item{data}{[data.frame] containing De-values, De-error and further parameters} -#' \item{LnLxTnTx.values}{[data.frame] of all calculated Lx/Tx values including signal, -#' background counts and the dose points} -#' \item{rejection.criteria}{[data.frame] with values that might by used as rejection criteria. -#' `NA` is produced if no R0 dose point exists.} -#' \item{Formula}{[formula] formula that have been used for the growth curve fitting} -#' -#' The output should be accessed using the function [get_RLum]. -#' -#' @note -#' This function must not be mixed up with the function -#' [Analyse_SAR.OSLdata], which works with -#' [Risoe.BINfileData-class] objects. -#' -#' **The function currently does support only 'OSL', 'IRSL' and 'POSL' data!** -#' -#' @section Function version: 0.10.3 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [calc_OSLLxTxRatio], [plot_GrowthCurve], [RLum.Analysis-class], -#' [RLum.Results-class], [get_RLum] -#' -#' @references -#' Aitken, M.J. and Smith, B.W., 1988. Optical dating: recuperation -#' after bleaching. Quaternary Science Reviews 7, 387-393. -#' -#' Duller, G., 2003. Distinguishing quartz and feldspar in single grain -#' luminescence measurements. Radiation Measurements, 37 (2), 161-165. -#' -#' Murray, A.S. and Wintle, A.G., 2000. Luminescence dating of quartz using an -#' improved single-aliquot regenerative-dose protocol. Radiation Measurements -#' 32, 57-73. -#' -#' Thomsen, K.J., Murray, A.S., Jain, M., Boetter-Jensen, L., 2008. Laboratory -#' fading rates of various luminescence signals from feldspar-rich sediment -#' extracts. Radiation Measurements 43, 1474-1486. -#' doi:10.1016/j.radmeas.2008.06.002 -#' -#' @keywords datagen plot -#' -#' @examples -#' -#' ##load data -#' ##ExampleData.BINfileData contains two BINfileData objects -#' ##CWOSL.SAR.Data and TL.SAR.Data -#' data(ExampleData.BINfileData, envir = environment()) -#' -#' ##transform the values from the first position in a RLum.Analysis object -#' object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) -#' -#' ##perform SAR analysis and set rejection criteria -#' results <- analyse_SAR.CWOSL( -#' object = object, -#' signal.integral.min = 1, -#' signal.integral.max = 2, -#' background.integral.min = 900, -#' background.integral.max = 1000, -#' log = "x", -#' fit.method = "EXP", -#' rejection.criteria = list( -#' recycling.ratio = 10, -#' recuperation.rate = 10, -#' testdose.error = 10, -#' palaeodose.error = 10, -#' recuperation_reference = "Natural", -#' exceed.max.regpoint = TRUE) -#') -#' -#' ##show De results -#' get_RLum(results) -#' -#' ##show LnTnLxTx table -#' get_RLum(results, data.object = "LnLxTnTx.table") -#' -#' @md -#' @export -analyse_SAR.CWOSL<- function( - object, - signal.integral.min = NA, - signal.integral.max = NA, - background.integral.min = NA, - background.integral.max = NA, - OSL.component = NULL, - rejection.criteria = list(), - dose.points = NULL, - trim_channels = FALSE, - mtext.outer = "", - plot = TRUE, - plot_onePage = FALSE, - plot.single = FALSE, - onlyLxTxTable = FALSE, - ... -) { - -# SELF CALL ----------------------------------------------------------------------------------- -if(is.list(object)){ - ##clean object input and expand parameters - object <- .rm_nonRLum(object) - parm <- .expand_parameters(length(object)) - - ##handle main separately - if("main"%in% names(list(...))){ - if(inherits(list(...)$main, "list")){ - main <- rep(list(...)$main,length = length(object)) - - }else{ - main <- rep(as.list(list(...)$main),length = length(object)) - } - - }else{ - main <- as.list(paste0("ALQ #",1:length(object))) - - } - - results <- merge_RLum(lapply(1:length(object), function(x){ - analyse_SAR.CWOSL( - object = object[[x]], - signal.integral.min = parm$signal.integral.min[[x]], - signal.integral.max = parm$signal.integral.max[[x]], - background.integral.min = parm$background.integral.min[[x]], - background.integral.max = parm$background.integral.max[[x]], - OSL.component = parm$OSL.component[[x]], - dose.points = parm$dose.points[[x]], - trim_channels = parm$trim_channels[[x]], - mtext.outer = parm$mtext.outer[[x]], - plot = parm$plot[[x]], - rejection.criteria = parm$rejection.criteria[[x]], - plot.single = parm$plot.single[[x]], - plot_onePage = parm$plot_onePage[[x]], - onlyLxTxTable = parm$onlyLxTxTable[[x]], - main = main[[x]], - ...) - })) - - ## add aliquot number - results@data$data$ALQ <- seq_along(object) - - ##return - ##DO NOT use invisible here, this will prevent the function from stopping - if(length(results) == 0) return(NULL) - - return(results) -} - -# CONFIG ----------------------------------------------------------------- -##set error list, this allows to set error messages without breaking the function -error.list <- list() - -# General Integrity Checks --------------------------------------------------- - ##MISSING INPUT - if(!inherits(object, "RLum.Analysis")) - .throw_error("Input object is not of type 'RLum.Analysis'") - - ## trim OSL or IRSL channels - if(trim_channels[1]) { - ## fetch names with OSL and IRSL - tmp_names <- unique(vapply(object@records, function(x) x@recordType, character(1))) - - ## grep only the one with OSL and IRSL in it - tmp_names <- tmp_names[grepl(pattern = "(?:OSL|IRSL)", x = tmp_names, perl = TRUE)] - - ## trim - object <- trim_RLum.Data(object, recordType = tmp_names) - - } - - ##skip all those tests if signal integral is NA - if(any(is.na(c(signal.integral.min, signal.integral.max, background.integral.min, background.integral.max)))){ - signal.integral <- background.integral <- NA - signal.integral.Tx <- background.integral.Tx <- NULL - warning("[analyse_SAR.CWOSL()] No signal or background integral applied, because they were set to NA!", call. = FALSE) - - } else { - ##build signal and background integrals - signal.integral <- c(signal.integral.min[1]:signal.integral.max[1]) - background.integral <- c(background.integral.min[1]:background.integral.max[1]) - - ##account for the case that Lx and Tx integral differ - if (length(signal.integral.min) == 2 & - length(signal.integral.max) == 2) { - signal.integral.Tx <- - c(signal.integral.min[2]:signal.integral.max[2]) - - }else{ - signal.integral.Tx <- NULL - - } - - if (length(background.integral.min) == 2 & - length(background.integral.max) == 2) { - background.integral.Tx <- - c(background.integral.min[2]:background.integral.max[2]) - - }else{ - background.integral.Tx <- NULL - - } - - ##Account for the case that the use did not provide everything ... - if(is.null(signal.integral.Tx) & !is.null(background.integral.Tx)){ - signal.integral.Tx <- signal.integral - - .throw_warning("Background integral for Tx curves set, but not for ", - "the signal integral; signal integral for Tx automatically set") - } - - if(!is.null(signal.integral.Tx) & is.null(background.integral.Tx)){ - background.integral.Tx <- background.integral - .throw_warning("Signal integral for Tx curves set, but not for the ", - "background integral; background integral for Tx automatically set") - } - - ##INTEGRAL LIMITS - if(!is(signal.integral, "integer") | !is(background.integral, "integer")){ - .throw_error("'signal.integral' or 'background.integral' is not of type integer") - } - } - - ## try to extract the correct curves for the sequence based on allowed curve types and - ## the curve type used most frequently - ## now remove all non-allowed curves - CWcurve.type <- regmatches( - x = names(object), - m = regexpr("(OSL[a-zA-Z]*|IRSL[a-zA-Z]*|POSL[a-zA-Z]*)", names(object), perl = TRUE)) - - if(length(CWcurve.type) == 0) { - message("[analyse_SAR.CWOSL()] No record of type 'OSL', 'IRSL', 'POSL' ", - "detected! NULL returned.") - return(NULL) - } - - ## now get the type which is used most - CWcurve.type <- names(which.max(table(CWcurve.type))) - -# Rejection criteria ------------------------------------------------------ - if(is.null(rejection.criteria) || class(rejection.criteria)[1] != "list") - rejection.criteria <- list() - - ##set list - rejection.criteria <- modifyList(x = list( - recycling.ratio = 10, - recuperation.rate = 10, - palaeodose.error = 10, - testdose.error = 10, - exceed.max.regpoint = TRUE, - recuperation_reference = "Natural" - ), - val = rejection.criteria, - keep.null = TRUE) - - -# Deal with extra arguments ---------------------------------------------------- - ##deal with addition arguments - extraArgs <- list(...) - - main <- if("main" %in% names(extraArgs)) extraArgs$main else "" - log <- if("log" %in% names(extraArgs)) extraArgs$log else "" - cex <- if("cex" %in% names(extraArgs)) extraArgs$cex else 1 - - background.count.distribution <- - if ("background.count.distribution" %in% names(extraArgs)) { - extraArgs$background.count.distribution - } else { - "non-poisson" - } - - sigmab <- if("sigmab" %in% names(extraArgs)) extraArgs$sigmab else NULL - sig0 <- if("sig0" %in% names(extraArgs)) extraArgs$sig0 else 0 - -# Protocol Integrity Checks -------------------------------------------------- - ##check overall structure of the object - ##every SAR protocol has to have equal number of curves - - ##grep curve types from analysis value and remove unwanted information - temp.ltype <- sapply(1:length(object@records), function(x) { - ##export as global variable - object@records[[x]]@recordType <<- gsub(" .*", "", object@records[[x]]@recordType) - object@records[[x]]@recordType - - }) - - ##FI lexsyg devices provide irradiation information in a separate curve - if(any("irradiation" %in% temp.ltype)){ - ##grep irradiation times - temp.irradiation <- extract_IrradiationTimes(object)@data$irr.times[["IRR_TIME"]] - - ##write this into the records - for(i in 1:length(object@records)){ - if(is.null(object@records[[i]]@info$IRR_TIME)) - object@records[[i]]@info <- c(object@records[[i]]@info, IRR_TIME = temp.irradiation[i]) - - - } - - ## remove irradiation curves - object <- get_RLum(object, record.id = c(!temp.ltype %in% "irradiation"), drop = FALSE) - - } - - ##check if the wanted curves are a multiple of two - ##gsub removes unwanted information from the curves - if(table(temp.ltype)[CWcurve.type]%%2!=0){ - error.list[[1]] <- "[analyse_SAR.CWOSL()] Input OSL/IRSL curves are not a multiple of two." - } - - ##check if the curve lengths differ - temp.matrix.length <- unlist(sapply(1:length(object@records), function(x) { - if(object@records[[x]]@recordType==CWcurve.type){ - length(object@records[[x]]@data[,1]) - } - })) - - if(length(unique(temp.matrix.length))!=1){ - error.list[[2]] <- "[analyse_SAR.CWOSL()] Input curves lengths differ." - - } - - ##just proceed if error list is empty - if (length(error.list) == 0) { - - ##check background integral - if (!all(is.na(signal.integral)) && - max(signal.integral) == min(signal.integral)) { - signal.integral <- - c(min(signal.integral) : (max(signal.integral) + 1)) - - .throw_warning("Integral signal limits cannot be equal, reset automatically") - } - - ##background integral should not be longer than curve channel length - if (!all(is.na(background.integral)) && - max(background.integral) == min(background.integral)) { - background.integral <- - c((min(background.integral) - 1) : max(background.integral)) - - } - - if (!all(is.na(background.integral)) && - max(background.integral) > temp.matrix.length[1]) { - background.integral <- - c((temp.matrix.length[1] - length(background.integral)):temp.matrix.length[1]) - - ##prevent that the background integral becomes negative - if(min(background.integral) < max(signal.integral)){ - background.integral <- c((max(signal.integral) + 1):max(background.integral)) - - } - - .throw_warning("Background integral out of bounds. Set to: c(", - min(background.integral), ":", max(background.integral), - ")") - } - - ##Do the same for the Tx-if set - if (!is.null(background.integral.Tx)) { - if (max(background.integral.Tx) == min(background.integral.Tx)) { - background.integral.Tx <- - c((min(background.integral.Tx) - 1) : max(background.integral.Tx)) - - } - - if (max(background.integral.Tx) > temp.matrix.length[2]) { - background.integral.Tx <- - c((temp.matrix.length[2] - length(background.integral.Tx)):temp.matrix.length[2]) - - - ##prevent that the background integral becomes negative - if (min(background.integral.Tx) < max(signal.integral.Tx)) { - background.integral.Tx <- - c((max(signal.integral.Tx) + 1):max(background.integral.Tx)) - - - } - - .throw_warning( - "Background integral for Tx out of bounds. Set to: c(", - min(background.integral.Tx), - ":", - max(background.integral.Tx), - ")" - ) - - } - } - - - # Grep Curves ------------------------------------------------------------- - ##grep relevant curves from RLum.Analyis object - OSL.Curves.ID <- - get_RLum(object, recordType = CWcurve.type, get.index = TRUE) - - ##separate curves by Lx and Tx (it makes it much easier) - OSL.Curves.ID.Lx <- - OSL.Curves.ID[seq(1,length(OSL.Curves.ID),by = 2)] - OSL.Curves.ID.Tx <- - OSL.Curves.ID[seq(2,length(OSL.Curves.ID),by = 2)] - - ##get index of TL curves - TL.Curves.ID <- - suppressWarnings(get_RLum(object, recordType = "TL$", get.index = TRUE)) - - ##separate TL curves which is always coming before the OSL curve - ##Note: we do not check anymore whether the sequence makes sense. - TL.Curves.ID.Lx <- TL.Curves.ID[TL.Curves.ID%in%(OSL.Curves.ID.Lx - 1)] - TL.Curves.ID.Tx <- TL.Curves.ID[TL.Curves.ID%in%(OSL.Curves.ID.Tx - 1)] - -# Calculate LnLxTnTx values -------------------------------------------------- - ##calculate LxTx values using external function - LnLxTnTx <- try(lapply(seq(1,length(OSL.Curves.ID),by = 2), function(x){ - if(!is.null(OSL.component) && length(OSL.component) > 0){ - temp.LnLxTnTx <- get_RLum( - calc_OSLLxTxDecomposed( - Lx.data = object@records[[OSL.Curves.ID[x]]]@info$COMPONENTS, - Tx.data = object@records[[OSL.Curves.ID[x + 1]]]@info$COMPONENTS, - OSL.component = OSL.component, - digits = 4, - sig0 = sig0)) - - } else { - temp.LnLxTnTx <- get_RLum( - calc_OSLLxTxRatio( - Lx.data = object@records[[OSL.Curves.ID[x]]]@data, - Tx.data = object@records[[OSL.Curves.ID[x + 1]]]@data, - signal.integral = signal.integral, - signal.integral.Tx = signal.integral.Tx, - background.integral = background.integral, - background.integral.Tx = background.integral.Tx, - background.count.distribution = background.count.distribution, - sigmab = sigmab, - sig0 = sig0)) - - } - - ##grep dose - temp.Dose <- object@records[[OSL.Curves.ID[x]]]@info$IRR_TIME - - ##for the case that no information on the dose can be found - if (is.null(temp.Dose)) temp.Dose <- NA - - temp.LnLxTnTx <- cbind(Dose = temp.Dose, temp.LnLxTnTx) - - }), silent = TRUE) - - ##this is basically for the OSL.component case to avoid that everything - ##fails if something goes wrong therein - if(inherits(LnLxTnTx, "try-error")){ - message("[analyse_SAR.CWOSL()] Something went wrong while generating ", - "the LxTx table. Return NULL.") - return(NULL) - } - - ##combine - LnLxTnTx <- data.table::rbindlist(LnLxTnTx) - - # Set regeneration points ------------------------------------------------- - ##overwrite dose point manually - if (!is.null(dose.points) & length(dose.points) > 0) { - if (length(dose.points) != length(LnLxTnTx$Dose)) { - .throw_error("Length of 'dose.points' differs from number of curves") - } - - LnLxTnTx$Dose <- dose.points - } - - ##check whether we have dose points at all - if (is.null(dose.points) & anyNA(LnLxTnTx$Dose)) { - .throw_error("'dose.points' contains NA values or have not been set") - } - - ##check whether the first OSL/IRSL curve (i.e., the Natural) has 0 dose. If not - ##not, it is probably a Dose Recovery Test with the given dose that is treated as the - ##unknown dose. We overwrite this value and warn the user. - if (LnLxTnTx$Dose[1] != 0) { - .throw_warning("The natural signal has a dose of ", LnLxTnTx$Dose[1], - " s, which is indicative of a dose recovery test. ", - "The natural dose was set to 0.") - LnLxTnTx$Dose[1] <- 0 - } - - #generate unique dose id - this are also the # for the generated points - temp.DoseID <- c(0:(length(LnLxTnTx$Dose) - 1)) - temp.DoseName <- paste0("R",temp.DoseID) - temp.DoseName <- - cbind(Name = temp.DoseName,Dose = LnLxTnTx$Dose) - - - ##set natural - temp.DoseName[temp.DoseName[,"Name"] == "R0","Name"] <- - "Natural" - - ##set R0 - temp.DoseName[temp.DoseName[,"Name"] != "Natural" & - temp.DoseName[,"Dose"] == 0,"Name"] <- "R0" - - ##correct numeration numeration of other dose points - - ##how many dose points do we have with 0? - non.temp.zero.dose.number <- nrow(temp.DoseName[temp.DoseName[, "Dose"] != 0,]) - - if(length(non.temp.zero.dose.number) > 0){ - temp.DoseName[temp.DoseName[,"Name"] != "Natural" & temp.DoseName[,"Name"] != "R0","Name"] <- - paste0("R",c(1:non.temp.zero.dose.number)) - } - - ##find duplicated doses (including 0 dose - which means the Natural) - temp.DoseDuplicated <- duplicated(temp.DoseName[,"Dose"]) - - ##combine temp.DoseName - temp.DoseName <- - cbind(temp.DoseName,Repeated = temp.DoseDuplicated) - - ##correct value for R0 (it is not really repeated) - temp.DoseName[temp.DoseName[,"Dose"] == 0,"Repeated"] <- FALSE - - ##combine in the data frame - temp.LnLxTnTx <- data.frame( - Name = factor(x = temp.DoseName[, "Name"], - levels = unique(temp.DoseName[, "Name"])), - Repeated = as.logical(temp.DoseName[, "Repeated"])) - - LnLxTnTx <- cbind(temp.LnLxTnTx,LnLxTnTx) - LnLxTnTx[,"Name"] <- as.character(LnLxTnTx[,"Name"]) - - # Calculate Recycling Ratio ----------------------------------------------- - ##Calculate Recycling Ratio - RecyclingRatio <- NA - if (length(LnLxTnTx[LnLxTnTx[,"Repeated"] == TRUE,"Repeated"]) > 0) { - ##identify repeated doses - temp.Repeated <- - LnLxTnTx[LnLxTnTx[,"Repeated"] == TRUE,c("Name","Dose","LxTx")] - - ##find concerning previous dose for the repeated dose - temp.Previous <- - t(sapply(1:length(temp.Repeated[,1]),function(x) { - LnLxTnTx[LnLxTnTx[,"Dose"] == temp.Repeated[x,"Dose"] & - LnLxTnTx[,"Repeated"] == FALSE,c("Name","Dose","LxTx")] - })) - - - ##convert to data.frame - temp.Previous <- as.data.frame(temp.Previous) - - ##set column names - temp.ColNames <- - unlist(lapply(1:length(temp.Repeated[,1]),function(x) { - temp <- paste("Recycling ratio (", temp.Repeated[x,"Name"],"/", - temp.Previous[temp.Previous[,"Dose"] == temp.Repeated[x,"Dose"],"Name"], - ")", - sep = "") - return(temp[1]) - })) - - - ##Calculate Recycling Ratio - RecyclingRatio <- - round(as.numeric(temp.Repeated[,"LxTx"]) / as.numeric(temp.Previous[,"LxTx"]), - digits = 4) - - ##Just transform the matrix and add column names - RecyclingRatio <- t(RecyclingRatio) - colnames(RecyclingRatio) <- temp.ColNames - } - - # Calculate Recuperation Rate --------------------------------------------- - ## check for incorrect key words - if(any(!rejection.criteria$recuperation_reference[1] %in% LnLxTnTx[,"Name"])) - .throw_error("Recuperation reference invalid, valid are: ", - paste(LnLxTnTx[,"Name"], collapse = ", ")) - - - ##Recuperation Rate (capable of handling multiple type of recuperation values) - Recuperation <- NA - if (length(LnLxTnTx[LnLxTnTx[,"Name"] == "R0","Name"]) > 0) { - Recuperation <- - vapply(1:length(LnLxTnTx[LnLxTnTx[,"Name"] == "R0","Name"]), - function(x) { - round(LnLxTnTx[LnLxTnTx[,"Name"] == "R0","LxTx"][x] / - LnLxTnTx[LnLxTnTx[,"Name"] == rejection.criteria$recuperation_reference[1],"LxTx"], - digits = 4) - }, numeric(1)) - ##Just transform the matrix and add column names - Recuperation <- t(Recuperation) - colnames(Recuperation) <- - unlist(strsplit(paste( - paste0("Recuperation rate (", rejection.criteria$recuperation_reference[1], ")"), - 1:length(LnLxTnTx[LnLxTnTx[,"Name"] == "R0","Name"]), collapse = ";" - ), ";")) - } - - # Evaluate and Combine Rejection Criteria --------------------------------- - temp.criteria <- c( - if(!is.null(colnames(RecyclingRatio))){ - colnames(RecyclingRatio)}else{NA}, - if(!is.null(colnames(Recuperation))){ - colnames(Recuperation)}else{NA}) - - temp.value <- c(RecyclingRatio,Recuperation) - - temp.threshold <- - c(rep( - rejection.criteria$recycling.ratio / 100, length(RecyclingRatio) - ), - rep( - rejection.criteria$recuperation.rate / 100, - length(Recuperation) - )) - - ##RecyclingRatio - temp.status.RecyclingRatio <- rep("OK", length(RecyclingRatio)) - if (!any(is.na(RecyclingRatio)) & !is.na(rejection.criteria$recycling.ratio)) - temp.status.RecyclingRatio[abs(1 - RecyclingRatio) > (rejection.criteria$recycling.ratio / 100)] <- "FAILED" - - ##Recuperation - temp.status.Recuperation <- "OK" - if (!is.na(Recuperation)[1] & - !is.na(rejection.criteria$recuperation.rate)) { - temp.status.Recuperation <- - sapply(1:length(Recuperation), function(x) { - if (Recuperation[x] > rejection.criteria$recuperation.rate / 100) { - "FAILED" - } else{ - "OK" - } - }) - } - - - # Provide Rejection Criteria for Testdose error -------------------------- - testdose.error.calculated <- (LnLxTnTx$Net_TnTx.Error/LnLxTnTx$Net_TnTx)[1] - - testdose.error.threshold <- - rejection.criteria$testdose.error / 100 - - if (is.na(testdose.error.calculated)) { - testdose.error.status <- "FAILED" - - }else{ - testdose.error.status <- "OK" - if(!is.na(testdose.error.threshold)){ - testdose.error.status <- ifelse( - testdose.error.calculated <= testdose.error.threshold, - "OK", "FAILED" - ) - } - } - - testdose.error.data.frame <- data.frame( - Criteria = "Testdose error", - Value = testdose.error.calculated, - Threshold = testdose.error.threshold, - Status = testdose.error.status, - stringsAsFactors = FALSE - ) - - - RejectionCriteria <- data.frame( - Criteria = temp.criteria, - Value = temp.value, - Threshold = temp.threshold, - Status = c(temp.status.RecyclingRatio,temp.status.Recuperation), - stringsAsFactors = FALSE - ) - - RejectionCriteria <- rbind(RejectionCriteria, testdose.error.data.frame) - - ##========================================================================## - ##PLOTTING - ##========================================================================## - if (plot) { - ##make sure the par settings are good after the functions stops - ##Why this is so complicated? Good question, if par() is called in the - ##single mode, it starts a new plot and then subsequent functions like - ##analyse_pIRIRSequence() produce an odd plot output. - par.default <- par()[c("oma","mar","cex", "mfrow", "mfcol")] - on_exit <- function(x = par.default){ - par( - oma = x$oma, - mar = x$mar, - cex = x$cex, - mfrow = x$mfrow, - mfcol = x$mfcol - ) - } - - ##colours and double for plotting - col <- get("col", pos = .LuminescenceEnv) - - # plot everyting on one page ... doing it here is much cleaner than - # Plotting - one Page config ------------------------------------------------------- - if(plot_onePage){ - on.exit(on_exit()) - - plot.single <- TRUE - layout(matrix( - c(1, 1, 3, 3, 6, 6, 7, - 1, 1, 3, 3, 6, 6, 8, - 2, 2, 4, 4, 9, 9, 10, - 2, 2, 4, 4, 9, 9, 10, - 5, 5, 5, 5, 5, 5, 5), 5, 7, byrow = TRUE - )) - par(oma = c(0, 0, 0, 0), - mar = c(4, 4, 3, 1), - cex = cex * 0.6) - - } - - - # Plotting - old way config ------------------------------------------------------- - if (!is(plot.single, "logical") && !is(plot.single, "numeric")) { - .throw_error("Invalid data type for 'plot.single'.") - } - - if (plot.single[1] == FALSE) { - on.exit(on_exit()) - layout(matrix( - c(1, 1, 3, 3, - 1, 1, 3, 3, - 2, 2, 4, 4, - 2, 2, 4, 4, - 5, 5, 5, 5), 5, 4, byrow = TRUE - )) - - par( - oma = c(0,0,0,0), mar = c(4,4,3,3), cex = cex * 0.6 - ) - - ## 1 -> TL previous LnLx - ## 2 -> LnLx - ## 3 -> TL previous TnTx - ## 4 -> TnTx - ## 5 -> Legend - - ## set selected curves to allow plotting of all curves - plot.single.sel <- c(1,2,3,4,5,6,7,8) - - }else{ - ##check for values in the single output of the function and convert - if (!is(plot.single, "logical")) { - plot.single.sel <- plot.single - - }else{ - plot.single.sel <- c(1,2,3,4,5,6,7,8) - - } - } - - ##warning if number of curves exceed colour values - if (length(col) < length(OSL.Curves.ID) / 2) { - .throw_warning("Too many curves! Only the first ", length(col), - " curves are plotted!") - } - - ##legend text - legend.text <- - paste(LnLxTnTx$Name,"\n(",LnLxTnTx$Dose,")", sep = "") - - - ##get channel resolution (should be equal for all curves) - resolution.OSLCurves <- round(object@records[[OSL.Curves.ID[1]]]@data[2,1] - - object@records[[OSL.Curves.ID[1]]]@data[1,1], - digits = 2) - - - # Plotting TL Curves previous LnLx ---------------------------------------- - - ##overall plot option selection for plot.single.sel - if (1 %in% plot.single.sel) { - ##check if TL curves are available - if (length(TL.Curves.ID.Lx) > 0) { - ##It is just an approximation taken from the data - resolution.TLCurves <- round(mean(diff( - round(object@records[[TL.Curves.ID.Lx[[1]]]]@data[,1], digits = 1) - )), digits = 1) - - ylim.range <- vapply(TL.Curves.ID.Lx, function(x) { - range(object@records[[x]]@data[,2]) - - }, numeric(2)) - - plot( - NA,NA, - xlab = "T [\u00B0C]", - ylab = paste("TL [cts/",resolution.TLCurves," \u00B0C]",sep = - ""), - xlim = c(object@records[[TL.Curves.ID.Lx[[1]]]]@data[1,1], - max(object@records[[TL.Curves.ID.Lx[[1]]]]@data[,1])), - ylim = c(1,max(ylim.range)), - main = main, - log = if (log == "y" | log == "xy") { - "y" - }else{ - "" - } - ) - - #provide curve information as mtext, to keep the space for the header - mtext(side = 3, - expression(paste( - "TL previous ", L[n],",",L[x]," curves",sep = "" - )), - cex = cex * 0.7) - - ##plot TL curves - sapply(1:length(TL.Curves.ID.Lx) ,function(x) { - lines(object@records[[TL.Curves.ID.Lx[[x]]]]@data,col = col[x]) - - }) - - - }else{ - plot( - NA,NA,xlim = c(0,1), ylim = c(0,1), main = "", - axes = FALSE, - ylab = "", - xlab = "" - ) - text(0.5,0.5, "No TL curve detected") - - } - }#plot.single.sel - - # Plotting LnLx Curves ---------------------------------------------------- - ##overall plot option selection for plot.single.sel - if (2 %in% plot.single.sel) { - ylim.range <- vapply(OSL.Curves.ID.Lx, function(x) { - range(object@records[[x]]@data[,2]) - }, numeric(2)) - - if((log == "x" | log == "xy") & object@records[[OSL.Curves.ID.Lx[[1]]]]@data[1,1] == 0){ - xlim <- c(object@records[[OSL.Curves.ID.Lx[1]]]@data[2,1], - max(object@records[[OSL.Curves.ID.Lx[1]]]@data[,1]) + - object@records[[OSL.Curves.ID.Lx[1]]]@data[2,1]) - - }else{ - xlim <- c(object@records[[OSL.Curves.ID.Lx[1]]]@data[1,1], - max(object@records[[OSL.Curves.ID.Lx[1]]]@data[,1])) - - } - #open plot area LnLx - plot( - NA,NA, - xlab = "Time [s]", - ylab = paste(CWcurve.type," [cts/",resolution.OSLCurves," s]",sep = - ""), - xlim = xlim, - ylim = range(ylim.range), - main = main, - log = log - ) - - #provide curve information as mtext, to keep the space for the header - mtext(side = 3, expression(paste(L[n],",",L[x]," curves",sep = "")), - cex = cex * 0.7) - - ##plot curves - sapply(1:length(OSL.Curves.ID.Lx), function(x) { - if((log == "x" | log == "xy") & object@records[[OSL.Curves.ID.Lx[[x]]]]@data[1,1] == 0){ - object@records[[OSL.Curves.ID.Lx[[x]]]]@data[1,] <- - object@records[[OSL.Curves.ID.Lx[[x]]]]@data[1,] + - diff(c(object@records[[OSL.Curves.ID.Lx[[x]]]]@data[1,1], - object@records[[OSL.Curves.ID.Lx[[x]]]]@data[2,1])) - .throw_warning("Curves shifted by one chanel for log-plot") - } - lines(object@records[[OSL.Curves.ID.Lx[[x]]]]@data,col = col[x]) - - }) - - ##mark integration limit Lx curves - abline(v = c( - object@records[[OSL.Curves.ID.Lx[1]]]@data[min(signal.integral),1], - object@records[[OSL.Curves.ID.Lx[1]]]@data[max(signal.integral),1], - object@records[[OSL.Curves.ID.Lx[1]]]@data[min(background.integral),1], - object@records[[OSL.Curves.ID.Lx[1]]]@data[max(background.integral),1]), - lty = 2, - col = "gray") - - ##mtext, implemented here, as a plot window has to be called first - mtext( - mtext.outer, - side = 4, - outer = TRUE, - line = -1.7, - cex = cex, - col = "blue" - ) - - }# plot.single.sel - - # Plotting TL Curves previous TnTx ---------------------------------------- - - ##overall plot option selection for plot.single.sel - if (3 %in% plot.single.sel) { - ##check if TL curves are available - if (length(TL.Curves.ID.Tx) > 0) { - ##It is just an approximation taken from the data - resolution.TLCurves <- round(mean(diff( - round(object@records[[TL.Curves.ID.Tx[[1]]]]@data[,1], digits = 1) - )), digits = 1) - - ylim.range <- vapply(TL.Curves.ID.Tx, function(x) { - range(object@records[[x]]@data[,2]) - }, numeric(2)) - - plot( - NA,NA, - xlab = "T [\u00B0C]", - ylab = paste("TL [cts/",resolution.TLCurves," \u00B0C]",sep = ""), - xlim = c(object@records[[TL.Curves.ID.Tx[[1]]]]@data[1,1], - max(object@records[[TL.Curves.ID.Tx[[1]]]]@data[,1])), - ylim = c(1,max(ylim.range)), - main = main, - log = if (log == "y" | log == "xy") { - "y" - }else{ - "" - } - ) - - #provide curve information as mtext, to keep the space for the header - mtext(side = 3, - expression(paste( - "TL previous ", T[n],",",T[x]," curves",sep = "" - )), - cex = cex * 0.7) - - ##plot TL curves - sapply(1:length(TL.Curves.ID.Tx) ,function(x) { - lines(object@records[[TL.Curves.ID.Tx[[x]]]]@data,col = col[x]) - - }) - - - }else{ - plot( - NA,NA,xlim = c(0,1), ylim = c(0,1), main = "", - axes = FALSE, - ylab = "", - xlab = "" - ) - text(0.5,0.5, "No TL curve detected") - - } - - }#plot.single.sel - - # Plotting TnTx Curves ---------------------------------------------------- - ##overall plot option selection for plot.single.sel - if (4 %in% plot.single.sel) { - ylim.range <- vapply(OSL.Curves.ID.Tx, function(x) { - range(object@records[[x]]@data[,2]) - }, numeric(2)) - - if((log == "x" | log == "xy") & object@records[[OSL.Curves.ID.Tx[[1]]]]@data[1,1] == 0){ - xlim <- c(object@records[[OSL.Curves.ID.Tx[1]]]@data[2,1], - max(object@records[[OSL.Curves.ID.Tx[1]]]@data[,1]) + - object@records[[OSL.Curves.ID.Tx[1]]]@data[2,1]) - - - }else{ - xlim <- c(object@records[[OSL.Curves.ID.Tx[1]]]@data[1,1], - max(object@records[[OSL.Curves.ID.Tx[1]]]@data[,1])) - } - - #open plot area LnLx - plot( - NA,NA, - xlab = "Time [s]", - ylab = paste0(CWcurve.type ," [cts/",resolution.OSLCurves," s]"), - xlim = xlim, - ylim = range(ylim.range), - main = main, - log = log - ) - - #provide curve information as mtext, to keep the space for the header - mtext(side = 3, - expression(paste(T[n],",",T[x]," curves",sep = "")), - cex = cex * 0.7) - - ##plot curves and get legend values - sapply(1:length(OSL.Curves.ID.Tx) ,function(x) { - - ##account for log-scale and 0 values - if((log == "x" | log == "xy") & object@records[[OSL.Curves.ID.Tx[[x]]]]@data[1,1] == 0){ - object@records[[OSL.Curves.ID.Tx[[x]]]]@data[1,] <- - object@records[[OSL.Curves.ID.Tx[[x]]]]@data[1,] + - diff(c(object@records[[OSL.Curves.ID.Tx[[x]]]]@data[1,1], - object@records[[OSL.Curves.ID.Tx[[x]]]]@data[2,1])) - - .throw_warning("Curves shifted by one channel for log-plot") - } - - lines(object@records[[OSL.Curves.ID.Tx[[x]]]]@data,col = col[x]) - - }) - - ##mark integration limit Tx curves - abline(v = c( - object@records[[OSL.Curves.ID.Tx[1]]]@data[min(signal.integral),1], - object@records[[OSL.Curves.ID.Tx[1]]]@data[max(signal.integral),1], - object@records[[OSL.Curves.ID.Tx[1]]]@data[min(background.integral),1], - object@records[[OSL.Curves.ID.Tx[1]]]@data[max(background.integral),1]), - lty = 2, - col = "gray") - - - }# plot.single.sel - - # Plotting Legend ---------------------------------------- - ##overall plot option selection for plot.single.sel - if (5 %in% plot.single.sel) { - par.margin <- par()$mar - par.mai <- par()$mai - par(mar = c(1,1,1,1), mai = c(0,0,0,0)) - - plot( - c(1:(length( - OSL.Curves.ID - ) / 2)), - rep(7,length(OSL.Curves.ID) / 2), - type = "p", - axes = FALSE, - xlab = "", - ylab = "", - pch = 20, - col = unique(col[1:length(OSL.Curves.ID)]), - cex = 4 * cex, - ylim = c(0,10) - ) - - ##add text - text(c(1:(length( - OSL.Curves.ID - ) / 2)), - rep(7,length(OSL.Curves.ID) / 2), - legend.text, - offset = 1, - pos = 1) - - - ##add line - abline(h = 10,lwd = 0.5) - - #reset margin - par(mar = par.margin, mai = par.mai) - - }#plot.single.sel - - - }##end plot - - - # Plotting GC ---------------------------------------- - - ##create data.frame - temp.sample <- data.frame( - Dose = LnLxTnTx$Dose, - LxTx = LnLxTnTx$LxTx, - LxTx.Error = LnLxTnTx$LxTx.Error, - TnTx = LnLxTnTx$Net_TnTx - ) - - ##overall plot option selection for plot.single.sel - if (plot == TRUE && 6 %in% plot.single.sel) { - plot <- TRUE - - }else { - plot <- FALSE - } - - temp.GC.all.na <- data.frame( - De = NA, - De.Error = NA, - D01 = NA, - D01.ERROR = NA, - D02 = NA, - D02.ERROR = NA, - Dc = NA, - De.MC = NA, - Fit = NA, - HPDI68_L = NA, - HPDI68_U = NA, - HPDI95_L = NA, - HPDI95_U = NA, - RC.Status = NA, - stringsAsFactors = FALSE) - - ##Fit and plot growth curve - if(!onlyLxTxTable){ - temp.GC <- do.call(plot_GrowthCurve, args = modifyList( - list( - sample = temp.sample, - output.plot = plot, - output.plotExtended.single = plot_onePage, - cex.global = if(plot_onePage) .6 else 1 - ), - list(...) - )) - - ##if null - if(is.null(temp.GC)){ - temp.GC <- temp.GC.all.na - temp.GC.fit.Formula <- NA - - ##create empty plots if needed, otherwise subsequent functions may crash - if(plot){ - if("output.plotExtended" %in% list(...) && list(...)$output.plotExtended == FALSE){ - shape::emptyplot() - - }else{ - shape::emptyplot() - shape::emptyplot() - shape::emptyplot() - - } - } - - }else{ - ##grep information on the fit object - temp.GC.fit.Formula <- get_RLum(temp.GC, "Formula") - - ##grep results - temp.GC <- get_RLum(temp.GC) - - # Provide Rejection Criteria for Palaeodose error -------------------------- - if(is.na(temp.GC[,1])){ - palaeodose.error.calculated <- NA - - }else{ - palaeodose.error.calculated <- round(temp.GC[,2] / temp.GC[,1], digits = 5) - - } - - palaeodose.error.threshold <- - rejection.criteria$palaeodose.error / 100 - - if (is.na(palaeodose.error.calculated)) { - palaeodose.error.status <- "FAILED" - - }else{ - if(!is.na(palaeodose.error.threshold)){ - palaeodose.error.status <- ifelse( - palaeodose.error.calculated <= palaeodose.error.threshold, - "OK", "FAILED" - ) - - }else{ - palaeodose.error.status <- "OK" - - } - } - - palaeodose.error.data.frame <- data.frame( - Criteria = "Palaeodose error", - Value = palaeodose.error.calculated, - Threshold = palaeodose.error.threshold, - Status = palaeodose.error.status, - stringsAsFactors = FALSE - ) - - ##add exceed.max.regpoint - if (!is.na(temp.GC[,1]) & !is.na(rejection.criteria$exceed.max.regpoint) && rejection.criteria$exceed.max.regpoint) { - status.exceed.max.regpoint <- - ifelse(max(LnLxTnTx$Dose) < temp.GC[,1], "FAILED", "OK") - - }else{ - status.exceed.max.regpoint <- "OK" - - } - - exceed.max.regpoint.data.frame <- data.frame( - Criteria = "De > max. dose point", - Value = as.numeric(temp.GC[,1]), - Threshold = if(is.na(rejection.criteria$exceed.max.regpoint)){ - NA - }else if(!rejection.criteria$exceed.max.regpoint){ - Inf - }else{ - as.numeric(max(LnLxTnTx$Dose)) - }, - Status = status.exceed.max.regpoint - ) - - ##add to RejectionCriteria data.frame - RejectionCriteria <- rbind(RejectionCriteria, - palaeodose.error.data.frame, - exceed.max.regpoint.data.frame) - - - ##add rejection status - if (length(grep("FAILED",RejectionCriteria$Status)) > 0) { - temp.GC <- data.frame(temp.GC, RC.Status = "FAILED", stringsAsFactors = FALSE) - - }else{ - temp.GC <- data.frame(temp.GC, RC.Status = "OK", stringsAsFactors = FALSE) - - } - }#endif for is.null - - ##end onlyLxTxTable - }else{ - temp.GC <- temp.GC.all.na - temp.GC.fit.Formula <- NULL - } - - ##add information on the integration limits - temp.GC.extended <- - data.frame( - signal.range = paste(min(signal.integral),":", - max(signal.integral)), - background.range = paste(min(background.integral),":", - max(background.integral)), - signal.range.Tx = paste(min(ifelse(is.null(signal.integral.Tx),NA,signal.integral.Tx)),":", - max(ifelse(is.null(signal.integral.Tx),NA,signal.integral.Tx))), - background.range.Tx = paste(min(ifelse(is.null(background.integral.Tx), NA,background.integral.Tx)) ,":", - max(ifelse(is.null(background.integral.Tx), NA,background.integral.Tx))), - stringsAsFactors = FALSE - ) - - -# Set return Values ----------------------------------------------------------- - ##generate unique identifier - UID <- create_UID() - - ## get position numbers - POSITION <- unique(unlist(lapply(object@records, function(x){ - chk <- grepl(pattern = "position", tolower(names(x@info)), fixed = TRUE) - if (any(chk)) - return(x@info[chk]) - else - return(NA) - })))[1] - - temp.results.final <- set_RLum( - class = "RLum.Results", - data = list( - data = as.data.frame( - c(temp.GC, temp.GC.extended, ALQ = 1, POS = POSITION, UID = UID), - stringsAsFactors = FALSE), - LnLxTnTx.table = cbind(LnLxTnTx, UID = UID, stringsAsFactors = FALSE), - rejection.criteria = cbind(RejectionCriteria, UID, stringsAsFactors = FALSE), - Formula = temp.GC.fit.Formula - ), - info = list(call = sys.call()) - ) - - # Plot graphical interpretation of rejection criteria ----------------------------------------- - - if (plot && 7 %in% plot.single.sel) { - ##set graphical parameter - if (!plot.single[1]) par(mfrow = c(1,2)) - - ##Rejection criteria - temp.rejection.criteria <- get_RLum(temp.results.final, - data.object = "rejection.criteria") - - temp.rc.reycling.ratio <- temp.rejection.criteria[ - grep("Recycling ratio",temp.rejection.criteria[,"Criteria"]),] - - temp.rc.recuperation.rate <- temp.rejection.criteria[ - grep("Recuperation rate",temp.rejection.criteria[,"Criteria"]),] - - temp.rc.palaedose.error <- temp.rejection.criteria[ - grep("Palaeodose error",temp.rejection.criteria[,"Criteria"]),] - - temp.rc.testdose.error <- temp.rejection.criteria[ - grep("Testdose error",temp.rejection.criteria[,"Criteria"]),] - - plot( - NA,NA, - xlim = c(-0.5,0.5), - ylim = c(0,40), - yaxt = "n", ylab = "", - xaxt = "n", xlab = "", - bty = "n", - main = "Rejection criteria" - ) - - axis( - side = 1, at = c(-0.2,-0.1,0,0.1,0.2), labels = c("- 0.2", "- 0.1","0/1","+ 0.1", "+ 0.2") - ) - - ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++## - ##polygon for recycling ratio - text(x = -0.35, y = 35, "Recycling R.", pos = 3, srt = 90, cex = 0.8*cex, offset = 0) - polygon(x = c( - -as.numeric(as.character(temp.rc.reycling.ratio$Threshold))[1],-as.numeric(as.character(temp.rc.reycling.ratio$Threshold))[1], - as.numeric(as.character(temp.rc.reycling.ratio$Threshold))[1], - as.numeric(as.character(temp.rc.reycling.ratio$Threshold))[1] - ), - y = c(31,39,39,31), - col = "gray", - border = NA) - - polygon( - x = c(-0.3, -0.3, 0.3, 0.3) , - y = c(31, 39, 39, 31), - border = ifelse(any( - grepl(pattern = "FAILED", temp.rc.reycling.ratio$Status) - ), "red", "black")) - - - ##consider possibility of multiple pIRIR signals and multiple recycling ratios - if (nrow(temp.rc.recuperation.rate) > 0) { - col.id <- 1 - for (i in seq(1,nrow(temp.rc.recuperation.rate), - length(unique(temp.rc.recuperation.rate[,"Criteria"])))) { - for (j in 0:length(unique(temp.rc.recuperation.rate[,"Criteria"]))) { - points( - temp.rc.reycling.ratio[i + j, "Value"] - 1, - y = 35, - pch = col.id, - col = col.id, - cex = 1.3 * cex - ) - - } - col.id <- col.id + 1 - } - rm(col.id) - - ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++## - ##polygon for recuperation rate - text( - x = -0.35, y = 25, "Recuperation", pos = 3, srt = 90, cex = 0.8*cex, offset = 0, - ) - polygon( - x = c( - 0, - 0, - as.numeric(as.character( - temp.rc.recuperation.rate$Threshold - ))[1], - as.numeric(as.character( - temp.rc.recuperation.rate$Threshold - ))[1] - ), - y = c(21,29,29,21), - col = "gray", - border = NA - ) - - polygon( - x = c(-0.3, -0.3, 0.3, 0.3) , - y = c(21, 29, 29, 21), - border = ifelse(any( - grepl(pattern = "FAILED", temp.rc.recuperation.rate$Status) - ), "red", "black") - ) - polygon( - x = c(-0.3,-0.3,0,0) , y = c(21,29,29,21), border = NA, density = 10, angle = 45 - ) - - for (i in 1:nrow(temp.rc.recuperation.rate)) { - points( - temp.rc.recuperation.rate[i, "Value"], - y = 25, - pch = i, - col = i, - cex = 1.3 * cex - ) - - } - } - - ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++## - ##polygon for testdose error - text( - x = -0.35, y = 15, "Testdose Err.", pos = 3, srt = 90, cex = 0.8*cex, offset = 0, - ) - - polygon( - x = c( - 0, - 0, - as.numeric(as.character(temp.rc.testdose.error$Threshold))[1], - as.numeric(as.character(temp.rc.testdose.error$Threshold))[1] - ), - y = c(11,19,19,11), - col = "gray", - border = NA - ) - polygon( - x = c(-0.3, -0.3, 0.3, 0.3) , - y = c(11, 19, 19, 11), - border = ifelse(any( - grepl(pattern = "FAILED", temp.rc.testdose.error$Status) - ), "red", "black") - ) - polygon( - x = c(-0.3,-0.3,0,0) , y = c(11,19,19,11), border = NA, density = 10, angle = 45 - ) - - - for (i in 1:nrow(temp.rc.testdose.error)) { - points( - temp.rc.testdose.error[i, "Value"], - y = 15, - pch = i, - col = i, - cex = 1.3 * cex - ) - } - - ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++## - ##polygon for palaeodose error - text( - x = -0.35, y = 5, "Palaeodose Err.", pos = 3, srt = 90, cex = 0.8*cex, offset = 0, - ) - polygon( - x = c( - 0, - 0, - as.numeric(as.character(temp.rc.palaedose.error$Threshold))[1], - as.numeric(as.character(temp.rc.palaedose.error$Threshold))[1] - ), - y = c(1,9,9,1), - col = "gray", - border = NA - ) - polygon( - x = c(-0.3, -0.3, 0.3, 0.3) , - y = c(1, 9, 9, 1), - border = ifelse(any( - grepl(pattern = "FAILED", temp.rc.palaedose.error$Status) - ), "red", "black") - ) - polygon( - x = c(-0.3,-0.3,0,0) , y = c(1,9,9,1), border = NA, density = 10, angle = 45 - ) - - if(nrow(temp.rc.palaedose.error) != 0){ - for (i in 1:nrow(temp.rc.palaedose.error)) { - if(!is.na(temp.rc.palaedose.error[i, "Value"])){ - points( - temp.rc.palaedose.error[i, "Value"], - y = 5, - pch = i, - col = i, - cex = 1.3 * cex - ) - } - } - } - } - - if (plot == TRUE && 8 %in% plot.single.sel) { - ##graphical representation of IR-curve - temp.IRSL <- suppressWarnings(get_RLum(object, recordType = "IRSL")) - if(length(temp.IRSL) != 0){ - if(inherits(temp.IRSL, "RLum.Data.Curve")){ - plot_RLum.Data.Curve(temp.IRSL, par.local = FALSE) - - }else if(inherits(temp.IRSL, "list")){ - plot_RLum.Data.Curve(temp.IRSL[[length(temp.IRSL)]], par.local = FALSE) - .throw_warning("Multiple IRSL curves detected (IRSL test), only the last one shown") - }else{ - shape::emptyplot() - - } - - }else{ - plot(1, type="n", axes=F, xlab="", ylab="") - text(x = c(1,1), y = c(1, 1), labels = "No IRSL curve detected!") - } - } - - - # Return -------------------------------------------------------------------------------------- - invisible(temp.results.final) - - }else{ - .throw_warning("\n", paste(unlist(error.list), collapse = "\n"), - "\n... >> nothing was done here!") - invisible(NULL) - } -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_SAR.TL.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_SAR.TL.R deleted file mode 100644 index 736c2bea5..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_SAR.TL.R +++ /dev/null @@ -1,684 +0,0 @@ -#' @title Analyse SAR TL measurements -#' -#' @description The function performs a SAR TL analysis on a -#' [RLum.Analysis-class] object including growth curve fitting. -#' -#' @details This function performs a SAR TL analysis on a set of curves. The SAR -#' procedure in general is given by Murray and Wintle (2000). For the -#' calculation of the `Lx/Tx` value the function [calc_TLLxTxRatio] is -#' used. -#' -#' **Provided rejection criteria** -#' -#' `[recyling.ratio]`: calculated for every repeated regeneration dose point. -#' -#' `[recuperation.rate]`: recuperation rate calculated by -#' comparing the `Lx/Tx` values of the zero regeneration point with the `Ln/Tn` -#' value (the `Lx/Tx` ratio of the natural signal). For methodological -#' background see Aitken and Smith (1988) -#' -#' @param object [RLum.Analysis-class] or a [list] of such objects (**required**) : -#' input object containing data for analysis -#' -#' @param object.background currently not used -#' -#' @param signal.integral.min [integer] (**required**): -#' requires the channel number for the lower signal integral bound -#' (e.g. `signal.integral.min = 100`) -#' -#' @param signal.integral.max [integer] (**required**): -#' requires the channel number for the upper signal integral bound -#' (e.g. `signal.integral.max = 200`) -#' -#' @param integral_input [character] (*with default*): -#' defines the input for the the arguments `signal.integral.min` and -#' `signal.integral.max`. These limits can be either provided `'channel'` -#' number (the default) or `'temperature'`. If `'temperature'` is chosen the -#' best matching channel is selected. -#' -#' @param sequence.structure [vector] [character] (*with default*): -#' specifies the general sequence structure. Three steps are allowed -#' (`"PREHEAT"`, `"SIGNAL"`, `"BACKGROUND"`), in addition a -#' parameter `"EXCLUDE"`. This allows excluding TL curves which are not -#' relevant for the protocol analysis. (**Note:** None TL are removed by default) -#' -#' @param rejection.criteria [list] (*with default*): -#' list containing rejection criteria in percentage for the calculation. -#' -#' @param dose.points [numeric] (*optional*): -#' option set dose points manually -#' -#' @param log [character] (*with default*): -#' a character string which contains `"x"` if the x-axis is to be logarithmic, -#' `"y"` if the y axis is to be logarithmic and `"xy"` or `"yx"` if both axes -#' are to be logarithmic. See -#' [plot.default]). -#' -#' @param ... further arguments that will be passed to the function [plot_GrowthCurve] -#' -#' @return -#' A plot (*optional*) and an [RLum.Results-class] object is -#' returned containing the following elements: -#' -#' \item{De.values}{[data.frame] containing De-values and further parameters} -#' \item{LnLxTnTx.values}{[data.frame] of all calculated `Lx/Tx` values including signal, background counts and the dose points.} -#' \item{rejection.criteria}{[data.frame] with values that might by used as rejection criteria. NA is produced if no R0 dose point exists.} -#' -#' **note:** the output should be accessed using the function [get_RLum] -#' -#' @note -#' **THIS IS A BETA VERSION** -#' -#' None TL curves will be removed -#' from the input object without further warning. -#' -#' @section Function version: 0.3.0 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [calc_TLLxTxRatio], [plot_GrowthCurve], [RLum.Analysis-class], -#' [RLum.Results-class], [get_RLum] -#' -#' @references -#' Aitken, M.J. and Smith, B.W., 1988. Optical dating: recuperation -#' after bleaching. Quaternary Science Reviews 7, 387-393. -#' -#' Murray, A.S. and Wintle, A.G., 2000. Luminescence dating of quartz using an -#' improved single-aliquot regenerative-dose protocol. Radiation Measurements -#' 32, 57-73. -#' -#' @keywords datagen plot -#' -#' @examples -#' -#' ##load data -#' data(ExampleData.BINfileData, envir = environment()) -#' -#' ##transform the values from the first position in a RLum.Analysis object -#' object <- Risoe.BINfileData2RLum.Analysis(TL.SAR.Data, pos=3) -#' -#' ##perform analysis -#' analyse_SAR.TL( -#' object = object, -#' signal.integral.min = 210, -#' signal.integral.max = 220, -#' fit.method = "EXP OR LIN", -#' sequence.structure = c("SIGNAL", "BACKGROUND")) -#' -#' @md -#' @export -analyse_SAR.TL <- function( - object, - object.background, - signal.integral.min, - signal.integral.max, - integral_input = "channel", - sequence.structure = c("PREHEAT", "SIGNAL", "BACKGROUND"), - rejection.criteria = list(recycling.ratio = 10, recuperation.rate = 10), - dose.points, - log = "", - ... -){ - - if (missing("object")) { - stop("[analyse_SAR.TL()] No value set for 'object'!", call. = FALSE) - } - - # Self-call ----------------------------------------------------------------------------------- - if(inherits(object, "list")){ - if(!all(sapply(object, class) == "RLum.Analysis")) - stop("[analyse_SAR.TL()] All elements in the input list must be of class 'RLum.Analysis'!", - call. = FALSE) - - ##run sequence - results <- lapply(object, function(o){ - analyse_SAR.TL( - object = o, - object.background = object.background, - signal.integral.min = signal.integral.min, - signal.integral.max = signal.integral.max, - integral_input = integral_input, - sequence.structure = sequence.structure, - rejection.criteria = rejection.criteria, - dose.points = dose.points, - log = log, - ... - ) - }) - - ##combine results - results <- merge_RLum(results) - - ##return - return(results) - - } - - # CONFIG ----------------------------------------------------------------- - - ##set allowed curve types - type.curves <- c("TL") - - ##=============================================================================# - # General Integrity Checks --------------------------------------------------- - - if (!is(object, "RLum.Analysis")) { - .throw_error("Input object is not of type 'RLum.Analyis'") - } - if (missing("signal.integral.min")) { - .throw_error("No value set for 'signal.integral.min'") - } - if (missing("signal.integral.max")) { - .throw_error("No value set for 'signal.integral.max'") - } - - - # Protocol Integrity Checks -------------------------------------------------- - - ##Remove non TL-curves from object by selecting TL curves - object@records <- get_RLum(object, recordType = type.curves) - - ##ANALYSE SEQUENCE OBJECT STRUCTURE - - ##set vector for sequence structure - temp.protocol.step <- rep(sequence.structure,length(object@records))[1:length(object@records)] - - ## grep object structure - temp.sequence.structure <- structure_RLum(object) - - ##set values for step - temp.sequence.structure[,"protocol.step"] <- temp.protocol.step - - ##remove TL curves which are excluded - temp.sequence.structure <- temp.sequence.structure[which( - temp.sequence.structure[,"protocol.step"]!="EXCLUDE"),] - ##check integrity; signal and bg range should be equal - if(length( - unique( - temp.sequence.structure[temp.sequence.structure[,"protocol.step"]=="SIGNAL","n.channels"]))>1){ - - .throw_error("Signal range differs, check sequence structure.\n", - temp.sequence.structure) - } - - ##check if the wanted curves are a multiple of the structure - if(length(temp.sequence.structure[,"id"])%%length(sequence.structure)!=0) - .throw_error("Input TL curves are not a multiple of the sequence structure") - - # # Calculate LnLxTnTx values -------------------------------------------------- - ##grep IDs for signal and background curves - TL.preheat.ID <- temp.sequence.structure[ - temp.sequence.structure[,"protocol.step"] == "PREHEAT","id"] - - TL.signal.ID <- temp.sequence.structure[ - temp.sequence.structure[,"protocol.step"] == "SIGNAL","id"] - - TL.background.ID <- temp.sequence.structure[ - temp.sequence.structure[,"protocol.step"] == "BACKGROUND","id"] - - ##comfort ... translate integral limits from temperature to channel - if(integral_input == "temperature"){ - signal.integral.min <- - which.min(abs( - signal.integral.min - get_RLum(object, record.id = TL.signal.ID[1])[, 1] - )) - signal.integral.max <- - which.min(abs( - signal.integral.max - get_RLum(object, record.id = TL.signal.ID[1])[, 1] - )) - } - - ##calculate LxTx values using external function - for(i in seq(1,length(TL.signal.ID),by=2)){ - temp.LnLxTnTx <- get_RLum( - calc_TLLxTxRatio( - Lx.data.signal = get_RLum(object, record.id = TL.signal.ID[i]), - Lx.data.background = if (length(TL.background.ID) == 0) { - NULL - } else{ - get_RLum(object, record.id = TL.background.ID[i]) - }, - Tx.data.signal = get_RLum(object, record.id = TL.signal.ID[i + 1]), - Tx.data.background = if (length(TL.background.ID) == 0){ - NULL - - }else{ - get_RLum(object, record.id = TL.background.ID[i + 1]) - - }, - signal.integral.min, - signal.integral.max - ) - ) - - ##grep dose - temp.Dose <- object@records[[TL.signal.ID[i]]]@info$IRR_TIME - - ##take about NULL values - if(is.null(temp.Dose)){ - temp.Dose <- NA - - } - - ##bind data.frame - temp.LnLxTnTx <- cbind(Dose=temp.Dose, temp.LnLxTnTx) - - if(exists("LnLxTnTx")==FALSE){ - LnLxTnTx <- data.frame(temp.LnLxTnTx) - - }else{ - LnLxTnTx <- rbind(LnLxTnTx,temp.LnLxTnTx) - - } - } - - ##set dose.points manually if argument was set - if(!missing(dose.points)){ - temp.Dose <- dose.points - LnLxTnTx$Dose <- dose.points - - } - - # Set regeneration points ------------------------------------------------- - #generate unique dose id - this are also the # for the generated points - temp.DoseID <- c(0:(length(LnLxTnTx[["Dose"]]) - 1)) - temp.DoseName <- paste0("R", temp.DoseID) - temp.DoseName <- cbind(Name = temp.DoseName, Dose = LnLxTnTx[["Dose"]]) - - ##set natural - temp.DoseName[temp.DoseName[, "Name"] == "R0", "Name"] <- "Natural" - - ##set R0 - temp.DoseName[temp.DoseName[,"Name"]!="Natural" & temp.DoseName[,"Dose"]==0,"Name"]<-"R0" - - ##find duplicated doses (including 0 dose - which means the Natural) - temp.DoseDuplicated<-duplicated(temp.DoseName[,"Dose"]) - - ##combine temp.DoseName - temp.DoseName<-cbind(temp.DoseName,Repeated=temp.DoseDuplicated) - - ##correct value for R0 (it is not really repeated) - temp.DoseName[temp.DoseName[,"Dose"]==0,"Repeated"]<-FALSE - - ##combine in the data frame - temp.LnLxTnTx <- data.frame(Name = temp.DoseName[, "Name"], - Repeated = as.logical(temp.DoseName[, "Repeated"])) - - - LnLxTnTx<-cbind(temp.LnLxTnTx,LnLxTnTx) - LnLxTnTx[,"Name"]<-as.character(LnLxTnTx[,"Name"]) - - # Calculate Recycling Ratio ----------------------------------------------- - RecyclingRatio <- NA - if(length(LnLxTnTx[LnLxTnTx[,"Repeated"]==TRUE,"Repeated"])>0){ - - ##identify repeated doses - temp.Repeated<-LnLxTnTx[LnLxTnTx[,"Repeated"]==TRUE,c("Name","Dose","LxTx")] - - ##find concering previous dose for the repeated dose - temp.Previous<-t(sapply(1:length(temp.Repeated[,1]),function(x){ - LnLxTnTx[LnLxTnTx[,"Dose"]==temp.Repeated[x,"Dose"] & - LnLxTnTx[,"Repeated"]==FALSE,c("Name","Dose","LxTx")] - })) - - ##convert to data.frame - temp.Previous<-as.data.frame(temp.Previous) - - ##set column names - temp.ColNames<-sapply(1:length(temp.Repeated[,1]),function(x){ - paste(temp.Repeated[x,"Name"],"/", - temp.Previous[temp.Previous[,"Dose"]==temp.Repeated[x,"Dose"],"Name"], - sep="") - }) - - ##Calculate Recycling Ratio - RecyclingRatio<-as.numeric(temp.Repeated[,"LxTx"])/as.numeric(temp.Previous[,"LxTx"]) - - ##Just transform the matrix and add column names - RecyclingRatio<-t(RecyclingRatio) - colnames(RecyclingRatio)<-temp.ColNames - } - - # Calculate Recuperation Rate --------------------------------------------- - Recuperation <- NA - if("R0" %in% LnLxTnTx[,"Name"]==TRUE){ - Recuperation<-round(LnLxTnTx[LnLxTnTx[,"Name"]=="R0","LxTx"]/ - LnLxTnTx[LnLxTnTx[,"Name"]=="Natural","LxTx"],digits=4) - } - - # Combine and Evaluate Rejection Criteria --------------------------------- - - RejectionCriteria <- data.frame( - citeria = c(colnames(RecyclingRatio), "recuperation rate"), - value = c(RecyclingRatio,Recuperation), - threshold = c( - rep(paste("+/-", rejection.criteria$recycling.ratio/100) - ,length(RecyclingRatio)), - paste("", rejection.criteria$recuperation.rate/100) - ), - status = c( - - if(is.na(RecyclingRatio)==FALSE){ - - sapply(1:length(RecyclingRatio), function(x){ - if(abs(1-RecyclingRatio[x])>(rejection.criteria$recycling.ratio/100)){ - "FAILED" - }else{"OK"}})}else{NA}, - - if(is.na(Recuperation)==FALSE & - Recuperation>rejection.criteria$recuperation.rate){"FAILED"}else{"OK"} - - )) - - ##============================================================================## - ##PLOTTING - ##============================================================================## - - # Plotting - Config ------------------------------------------------------- - ##grep plot parameter - par.default <- par(no.readonly = TRUE) - on.exit(par(par.default)) - - ##grep colours - col <- get("col", pos = .LuminescenceEnv) - - ##set layout matrix - layout(matrix(c( - 1, 1, 2, 2, - 1, 1, 2, 2, - 3, 3, 4, 4, - 3, 3, 4, 4, - 5, 5, 5, 5 - ), 5, 4, byrow = TRUE)) - - par(oma = c(0, 0, 0, 0), mar = c(4, 4, 3, 3)) - - ## 1 -> TL Lx - ## 2 -> TL Tx - ## 3 -> TL Lx Plateau - ## 4 -> TL Tx Plateau - ## 5 -> Legend - - ##recalculate signal.integral from channels to temperature - signal.integral.temperature <- c(object@records[[TL.signal.ID[1]]]@data[signal.integral.min,1] : - object@records[[TL.signal.ID[1]]]@data[signal.integral.max,1]) - - - ## warning if number of curves exceeds colour values - if(length(col) 0) { - mtext("[FAILED]", col = "red") - } - } - - # Plotting GC ---------------------------------------- - #reset par - par(par.default) - - ##create data.frame - temp.sample <- data.frame( - Dose = LnLxTnTx$Dose, - LxTx = LnLxTnTx$LxTx, - LxTx.Error = LnLxTnTx$LxTx.Error, - TnTx = LnLxTnTx$TnTx - ) - - ##set NA values to 0 - temp.sample[is.na(temp.sample$LxTx.Error),"LxTx.Error"] <- 0 - - ##run curve fitting - temp.GC <- try(plot_GrowthCurve( - sample = temp.sample, - ... - )) - - ##check for error - if(inherits(temp.GC, "try-error")){ - return(NULL) - - }else{ - temp.GC <- get_RLum(temp.GC)[, c("De", "De.Error")] - - } - - ##add rejection status - if(length(grep("FAILED",RejectionCriteria$status))>0){ - temp.GC <- data.frame(temp.GC, RC.Status="FAILED") - - }else{ - temp.GC <- data.frame(temp.GC, RC.Status="OK") - - } - - # Return Values ----------------------------------------------------------- - newRLumResults.analyse_SAR.TL <- set_RLum( - class = "RLum.Results", - data = list( - data = temp.GC, - LnLxTnTx.table = LnLxTnTx, - rejection.criteria = RejectionCriteria - ), - info = list(info = sys.call()) - ) - - return(newRLumResults.analyse_SAR.TL) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_baSAR.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_baSAR.R deleted file mode 100644 index 2834250c8..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_baSAR.R +++ /dev/null @@ -1,2508 +0,0 @@ -#' Bayesian models (baSAR) applied on luminescence data -#' -#' This function allows the application of Bayesian models on luminescence data, measured -#' with the single-aliquot regenerative-dose (SAR, Murray and Wintle, 2000) protocol. In particular, -#' it follows the idea proposed by Combès et al., 2015 of using an hierarchical model for estimating -#' a central equivalent dose from a set of luminescence measurements. This function is (I) the adoption -#' of this approach for the R environment and (II) an extension and a technical refinement of the -#' published code. -#' -#' Internally the function consists of two parts: (I) The Bayesian core for the Bayesian calculations -#' and applying the hierarchical model and (II) a data pre-processing part. The Bayesian core can be run -#' independently, if the input data are sufficient (see below). The data pre-processing part was -#' implemented to simplify the analysis for the user as all needed data pre-processing is done -#' by the function, i.e. in theory it is enough to provide a BIN/BINX-file with the SAR measurement -#' data. For the Bayesian analysis for each aliquot the following information are needed from the SAR analysis. -#' `LxTx`, the `LxTx` error and the dose values for all regeneration points. -#' -#' **How is the systematic error contribution calculated?** -#' -#' Standard errors (so far) provided with the source dose rate are considered as systematic uncertainties -#' and added to final central dose by: -#' -#' \deqn{systematic.error = 1/n \sum SE(source.doserate)} -#' -#' \deqn{SE(central.dose.final) = \sqrt{SE(central.dose)^2 + systematic.error^2}} -#' -#' Please note that this approach is rather rough and can only be valid if the source dose rate -#' errors, in case different readers had been used, are similar. In cases where more than -#' one source dose rate is provided a warning is given. -#' -#' **Input / output scenarios** -#' -#' Various inputs are allowed for this function. Unfortunately this makes the function handling rather -#' complex, but at the same time very powerful. Available scenarios: -#' -#' **(1) - `object` is BIN-file or link to a BIN-file** -#' -#' Finally it does not matter how the information of the BIN/BINX file are provided. The function -#' supports **(a)** either a path to a file or directory or a `list` of file names or paths or -#' **(b)** a [Risoe.BINfileData-class] object or a list of these objects. The latter one can -#' be produced by using the function [read_BIN2R], but this function is called automatically -#' if only a file name and/or a path is provided. In both cases it will become the data that can be -#' used for the analysis. -#' -#' `[XLS_file = NULL]` -#' -#' If no XLS file (or data frame with the same format) is provided the functions runs an automatic process that -#' consists of the following steps: -#' -#' 1. Select all valid aliquots using the function [verify_SingleGrainData] -#' 2. Calculate `Lx/Tx` values using the function [calc_OSLLxTxRatio] -#' 3. Calculate De values using the function [plot_GrowthCurve] -#' -#' These proceeded data are subsequently used in for the Bayesian analysis -#' -#' `[XLS_file != NULL]` -#' -#' If an XLS-file is provided or a `data.frame` providing similar information the pre-processing -#' steps consists of the following steps: -#' -#' 1. Calculate `Lx/Tx` values using the function [calc_OSLLxTxRatio] -#' 2. Calculate De values using the function [plot_GrowthCurve] -#' -#' Means, the XLS file should contain a selection of the BIN-file names and the aliquots selected -#' for the further analysis. This allows a manual selection of input data, as the automatic selection -#' by [verify_SingleGrainData] might be not totally sufficient. -#' -#' -#' **(2) - `object` `RLum.Results object`** -#' -#' If an [RLum.Results-class] object is provided as input and(!) this object was -#' previously created by the function `analyse_baSAR()` itself, the pre-processing part -#' is skipped and the function starts directly with the Bayesian analysis. This option is very powerful -#' as it allows to change parameters for the Bayesian analysis without the need to repeat -#' the data pre-processing. If furthermore the argument `aliquot_range` is set, aliquots -#' can be manually excluded based on previous runs. -#' -#' **`method_control`** -#' -#' These are arguments that can be passed directly to the Bayesian calculation core, supported arguments -#' are: -#' -#' \tabular{lll}{ -#' **Parameter** \tab **Type** \tab **Description**\cr -#' `lower_centralD` \tab [numeric] \tab sets the lower bound for the expected De range. Change it only if you know what you are doing!\cr -#' `upper_centralD` \tab [numeric] \tab sets the upper bound for the expected De range. Change it only if you know what you are doing!\cr -#' `n.chains` \tab [integer] \tab sets number of parallel chains for the model (default = 3) (cf. [rjags::jags.model])\cr -#' `inits` \tab [list] \tab option to set initialisation values (cf. [rjags::jags.model]) \cr -#' `thin` \tab [numeric] \tab thinning interval for monitoring the Bayesian process (cf. [rjags::jags.model])\cr -#' `variable.names` \tab [character] \tab set the variables to be monitored during the MCMC run, default: -#' `'central_D'`, `'sigma_D'`, `'D'`, `'Q'`, `'a'`, `'b'`, `'c'`, `'g'`. -#' Note: only variables present in the model can be monitored. -#' } -#' -#' **User defined models**\cr -#' -#' The function provides the option to modify and to define own models that can be used for -#' the Bayesian calculation. In the case the user wants to modify a model, a new model -#' can be piped into the function via the argument `baSAR_model` as `character`. -#' The model has to be provided in the JAGS dialect of the BUGS language (cf. [rjags::jags.model]) -#' and parameter names given with the pre-defined names have to be respected, otherwise the function -#' will break. -#' -#' **FAQ** -#' -#' Q: How can I set the seed for the random number generator (RNG)? -#' -#' A: Use the argument `method_control`, e.g., for three MCMC chains -#' (as it is the default): -#' -#' ``` -#' method_control = list( -#' inits = list( -#' list(.RNG.name = "base::Wichmann-Hill", .RNG.seed = 1), -#' list(.RNG.name = "base::Wichmann-Hill", .RNG.seed = 2), -#' list(.RNG.name = "base::Wichmann-Hill", .RNG.seed = 3) -#' )) -#' ``` -#' -#' This sets a reproducible set for every chain separately.\cr -#' -#' Q: How can I modify the output plots? -#' -#' A: You can't, but you can use the function output to create own, modified plots. -#' -#' -#' Q: Can I change the boundaries for the central_D? -#' -#' A: Yes, we made it possible, but we DO NOT recommend it, except you know what you are doing!\cr -#' Example: `method_control = list(lower_centralD = 10))` -#' -#' Q: The lines in the baSAR-model appear to be in a wrong logical order?\cr -#' -#' A: This is correct and allowed (cf. JAGS manual) -#' -#' -#' **Additional arguments support via the `...` argument** -#' -#' This list summarizes the additional arguments that can be passed to the internally used -#' functions. -#' -#' \tabular{llll}{ -#' **Supported argument** \tab **Corresponding function** \tab **Default** \tab **Short description **\cr -#' `threshold` \tab [verify_SingleGrainData] \tab `30` \tab change rejection threshold for curve selection \cr -#' `sheet` \tab [readxl::read_excel] \tab `1` \tab select XLS-sheet for import\cr -#' `col_names` \tab [readxl::read_excel] \tab `TRUE` \tab first row in XLS-file is header\cr -#' `col_types` \tab [readxl::read_excel] \tab `NULL` \tab limit import to specific columns\cr -#' `skip` \tab [readxl::read_excel] \tab `0` \tab number of rows to be skipped during import\cr -#' `n.records` \tab [read_BIN2R] \tab `NULL` \tab limit records during BIN-file import\cr -#' `duplicated.rm` \tab [read_BIN2R] \tab `TRUE` \tab remove duplicated records in the BIN-file\cr -#' `pattern` \tab [read_BIN2R] \tab `TRUE` \tab select BIN-file by name pattern\cr -#' `position` \tab [read_BIN2R] \tab `NULL` \tab limit import to a specific position\cr -#' `background.count.distribution` \tab [calc_OSLLxTxRatio] \tab `"non-poisson"` \tab set assumed count distribution\cr -#' `fit.weights` \tab [plot_GrowthCurve] \tab `TRUE` \tab enables / disables fit weights\cr -#' `fit.bounds` \tab [plot_GrowthCurve] \tab `TRUE` \tab enables / disables fit bounds\cr -#' `NumberIterations.MC` \tab [plot_GrowthCurve] \tab `100` \tab number of MC runs for error calculation\cr -#' `output.plot` \tab [plot_GrowthCurve] \tab `TRUE` \tab enables / disables dose response curve plot\cr -#' `output.plotExtended` \tab [plot_GrowthCurve] \tab `TRUE` \tab enables / disables extended dose response curve plot\cr -#' } -#' -#' -#' @param object [Risoe.BINfileData-class], [RLum.Results-class], [list] of [RLum.Analysis-class], -#' [character] or [list] (**required**): -#' input object used for the Bayesian analysis. If a `character` is provided the function -#' assumes a file connection and tries to import a BIN/BINX-file using the provided path. If a `list` is -#' provided the list can only contain either `Risoe.BINfileData` objects or `character`s -#' providing a file connection. Mixing of both types is not allowed. If an [RLum.Results-class] -#' is provided the function directly starts with the Bayesian Analysis (see details) -#' -#' @param XLS_file [character] (*optional*): -#' XLS_file with data for the analysis. This file must contain 3 columns: -#' the name of the file, the disc position and the grain position -#' (the last being 0 for multi-grain measurements).\cr -#' Alternatively a `data.frame` of similar structure can be provided. -#' -#' @param aliquot_range [numeric] (*optional*): -#' allows to limit the range of the aliquots used for the analysis. -#' This argument has only an effect if the argument `XLS_file` is used or -#' the input is the previous output (i.e. is [RLum.Results-class]). In this case the -#' new selection will add the aliquots to the removed aliquots table. -#' -#' @param source_doserate [numeric] **(required)**: -#' source dose rate of beta-source used for the measurement and its uncertainty -#' in Gy/s, e.g., `source_doserate = c(0.12, 0.04)`. Parameter can be provided -#' as `list`, for the case that more than one BIN-file is provided, e.g., -#' `source_doserate = list(c(0.04, 0.004), c(0.05, 0.004))`. -#' -#' @param signal.integral [vector] (**required**): -#' vector with the limits for the signal integral used for the calculation, -#' e.g., `signal.integral = c(1:5)`. Ignored if `object` is an [RLum.Results-class] object. -#' The parameter can be provided as `list`, see `source_doserate`. -#' -#' @param signal.integral.Tx [vector] (*optional*): -#' vector with the limits for the signal integral for the Tx curve. I -#' f nothing is provided the value from `signal.integral` is used and it is ignored -#' if `object` is an [RLum.Results-class] object. -#' The parameter can be provided as `list`, see `source_doserate`. -#' -#' @param background.integral [vector] (**required**): -#' vector with the bounds for the background integral. -#' Ignored if `object` is an [RLum.Results-class] object. -#' The parameter can be provided as `list`, see `source_doserate`. -#' -#' @param background.integral.Tx [vector] (*optional*): -#' vector with the limits for the background integral for the Tx curve. -#' If nothing is provided the value from `background.integral` is used. -#' Ignored if `object` is an [RLum.Results-class] object. -#' The parameter can be provided as `list`, see `source_doserate`. -#' -#' @param irradiation_times [numeric] (*optional*): if set this vector replaces all irradiation -#' times for one aliquot and one cycle (Lx and Tx curves) and recycles it for all others cycles and aliquots. -#' Please note that if this argument is used, for every(!) single curve -#' in the dataset an irradiation time needs to be set. -#' -#' @param sigmab [numeric] (*with default*): -#' option to set a manual value for the overdispersion (for `LnTx` and `TnTx`), -#' used for the `Lx`/`Tx` error calculation. The value should be provided as -#' absolute squared count values, cf. [calc_OSLLxTxRatio]. -#' The parameter can be provided as `list`, see `source_doserate`. -#' -#' @param sig0 [numeric] (*with default*): -#' allow adding an extra component of error to the final Lx/Tx error value -#' (e.g., instrumental error, see details is [calc_OSLLxTxRatio]). -#' The parameter can be provided as `list`, see `source_doserate`. -#' -#' @param distribution [character] (*with default*): -#' type of distribution that is used during Bayesian calculations for -#' determining the Central dose and overdispersion values. -#' Allowed inputs are `"cauchy"`, `"normal"` and `"log_normal"`. -#' -#' @param baSAR_model [character] (*optional*): -#' option to provide an own modified or new model for the Bayesian calculation -#' (see details). If an own model is provided the argument `distribution` is -#' ignored and set to `'user_defined'` -#' -#' @param n.MCMC [integer] (*with default*): -#' number of iterations for the Markov chain Monte Carlo (MCMC) simulations -#' -#' @param fit.method [character] (*with default*): -#' equation used for the fitting of the dose-response curve using the function -#' [plot_GrowthCurve] and then for the Bayesian modelling. Here supported methods: `EXP`, `EXP+LIN` and `LIN` -#' -#' @param fit.force_through_origin [logical] (*with default*): -#' force fitting through origin -#' -#' @param fit.includingRepeatedRegPoints [logical] (*with default*): -#' includes the recycling point (assumed to be measured during the last cycle) -#' -#' @param method_control [list] (*optional*): -#' named list of control parameters that can be directly -#' passed to the Bayesian analysis, e.g., `method_control = list(n.chains = 4)`. -#' See details for further information -#' -#' @param digits [integer] (*with default*): -#' round output to the number of given digits -#' -#' @param distribution_plot [character] (*with default*): sets the final distribution plot that -#' shows equivalent doses obtained using the frequentist approach and sets in the central dose -#' as comparison obtained using baSAR. Allowed input is `'abanico'` or `'kde'`. If set to `NULL` nothing is plotted. -#' -#' @param plot [logical] (*with default*): -#' enables or disables plot output -#' -#' @param plot_reduced [logical] (*with default*): -#' enables or disables the advanced plot output -#' -#' @param plot.single [logical] (*with default*): -#' enables or disables single plots or plots arranged by `analyse_baSAR` -#' -#' @param verbose [logical] (*with default*): -#' enables or disables verbose mode -#' -#' @param ... parameters that can be passed to the function [calc_OSLLxTxRatio] -#' (almost full support), [readxl::read_excel] (full support), [read_BIN2R] (`n.records`, -#' `position`, `duplicated.rm`), see details. -#' -#' -#' @return Function returns results numerically and graphically: -#' -#' -----------------------------------\cr -#' `[ NUMERICAL OUTPUT ]`\cr -#' -----------------------------------\cr -#' -#' **`RLum.Results`**-object -#' -#' **slot:** **`@data`** -#' -#' \tabular{lll}{ -#' **Element** \tab **Type** \tab **Description**\cr -#' `$summary` \tab `data.frame` \tab statistical summary, including the central dose \cr -#' `$mcmc` \tab `mcmc` \tab [coda::mcmc.list] object including raw output \cr -#' `$models` \tab `character` \tab implemented models used in the baSAR-model core \cr -#' `$input_object` \tab `data.frame` \tab summarising table (same format as the XLS-file) including, e.g., Lx/Tx values\cr -#' `$removed_aliquots` \tab `data.frame` \tab table with removed aliquots (e.g., `NaN`, or `Inf` `Lx`/`Tx` values). If nothing was removed `NULL` is returned -#' } -#' -#'**slot:** **`@info`** -#' -#' The original function call -#' -#' ------------------------\cr -#' `[ PLOT OUTPUT ]`\cr -#' ------------------------\cr -#' -#' - (A) Ln/Tn curves with set integration limits, -#' - (B) trace plots are returned by the baSAR-model, showing the convergence of the parameters (trace) -#' and the resulting kernel density plots. If `plot_reduced = FALSE` for every(!) dose a trace and -#' a density plot is returned (this may take a long time), -#' - (C) dose plots showing the dose for every aliquot as boxplots and the marked -#' HPD in within. If boxes are coloured 'orange' or 'red' the aliquot itself should be checked, -#' - (D) the dose response curve resulting from the monitoring of the Bayesian modelling are -#' provided along with the Lx/Tx values and the HPD. Note: The amount for curves displayed -#' is limited to 1000 (random choice) for performance reasons, -#' - (E) the final plot is the De distribution as calculated using the conventional (frequentist) approach -#' and the central dose with the HPDs marked within. This figure is only provided for a comparison, -#' no further statistical conclusion should be drawn from it. -#' -#' -#' **Please note: If distribution was set to `log_normal` the central dose is given as geometric mean!** -#' -#' -#' @section Function version: 0.1.33 -#' -#' @author -#' Norbert Mercier, IRAMAT-CRP2A, Université Bordeaux Montaigne (France) \cr -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) \cr -#' The underlying Bayesian model based on a contribution by Combès et al., 2015. -#' -#' @seealso [read_BIN2R], [calc_OSLLxTxRatio], [plot_GrowthCurve], -#' [readxl::read_excel], [verify_SingleGrainData], -#' [rjags::jags.model], [rjags::coda.samples], [boxplot.default] -#' -#' -#' @references -#' -#' Combès, B., Philippe, A., Lanos, P., Mercier, N., Tribolo, C., Guerin, G., Guibert, P., Lahaye, C., 2015. -#' A Bayesian central equivalent dose model for optically stimulated luminescence dating. -#' Quaternary Geochronology 28, 62-70. doi:10.1016/j.quageo.2015.04.001 -#' -#' Mercier, N., Kreutzer, S., Christophe, C., Guerin, G., Guibert, P., Lahaye, C., Lanos, P., Philippe, A., -#' Tribolo, C., 2016. Bayesian statistics in luminescence dating: The 'baSAR'-model and its implementation -#' in the R package 'Luminescence'. Ancient TL 34, 14-21. -#' -#' **Further reading** -#' -#' Gelman, A., Carlin, J.B., Stern, H.S., Dunson, D.B., Vehtari, A., Rubin, D.B., 2013. -#' Bayesian Data Analysis, Third Edition. CRC Press. -#' -#' Murray, A.S., Wintle, A.G., 2000. Luminescence dating of quartz using an improved single-aliquot -#' regenerative-dose protocol. Radiation Measurements 32, 57-73. doi:10.1016/S1350-4487(99)00253-X -#' -#' Plummer, M., 2017. JAGS Version 4.3.0 user manual. `https://sourceforge.net/projects/mcmc-jags/files/Manuals/4.x/jags_user_manual.pdf/download` -#' -#' @note -#' **If you provide more than one BIN-file**, it is **strongly** recommended to provide -#' a `list` with the same number of elements for the following parameters: -#' -#' `source_doserate`, `signal.integral`, `signal.integral.Tx`, `background.integral`, -#' `background.integral.Tx`, `sigmab`, `sig0`. -#' -#' Example for two BIN-files: `source_doserate = list(c(0.04, 0.006), c(0.05, 0.006))` -#' -#' **The function is currently limited to work with standard Risoe BIN-files only!** -#' -#' @keywords datagen -#' -#' @examples -#' -#' ##(1) load package test data set -#' data(ExampleData.BINfileData, envir = environment()) -#' -#' ##(2) selecting relevant curves, and limit dataset -#' CWOSL.SAR.Data <- subset( -#' CWOSL.SAR.Data, -#' subset = POSITION%in%c(1:3) & LTYPE == "OSL") -#' -#' \dontrun{ -#' ##(3) run analysis -#' ##please not that the here selected parameters are -#' ##choosen for performance, not for reliability -#' results <- analyse_baSAR( -#' object = CWOSL.SAR.Data, -#' source_doserate = c(0.04, 0.001), -#' signal.integral = c(1:2), -#' background.integral = c(80:100), -#' fit.method = "LIN", -#' plot = FALSE, -#' n.MCMC = 200 -#' -#' ) -#' -#' print(results) -#' -#' -#' ##XLS_file template -#' ##copy and paste this the code below in the terminal -#' ##you can further use the function write.csv() to export the example -#' -#' XLS_file <- -#' structure( -#' list( -#' BIN_FILE = NA_character_, -#' DISC = NA_real_, -#' GRAIN = NA_real_), -#' .Names = c("BIN_FILE", "DISC", "GRAIN"), -#' class = "data.frame", -#' row.names = 1L -#' ) -#' -#' } -#' -#' @md -#' @export -analyse_baSAR <- function( - object, - XLS_file = NULL, - aliquot_range = NULL, - source_doserate = NULL, - signal.integral, - signal.integral.Tx = NULL, - background.integral, - background.integral.Tx = NULL, - irradiation_times = NULL, - sigmab = 0, - sig0 = 0.025, - distribution = "cauchy", - baSAR_model = NULL, - n.MCMC = 100000, - fit.method = "EXP", - fit.force_through_origin = TRUE, - fit.includingRepeatedRegPoints = TRUE, - method_control = list(), - digits = 3L, - distribution_plot = "kde", - plot = TRUE, - plot_reduced = TRUE, - plot.single = FALSE, - verbose = TRUE, - ... -){ - - ##//////////////////////////////////////////////////////////////////////////////////////////////// - ##FUNCTION TO BE CALLED to RUN the Bayesian Model - ##//////////////////////////////////////////////////////////////////////////////////////////////// - ##START - .baSAR_function <- - function(Nb_aliquots, - distribution, - data.Dose, - data.Lum, - data.sLum, - fit.method, - n.MCMC, - fit.force_through_origin, - fit.includingRepeatedRegPoints, - method_control, - baSAR_model, - verbose) - { - - ##lower and uppder De, grep from method_control ... for sure we find it here, - ##as it was set before the function call - lower_centralD <- method_control[["lower_centralD"]] - upper_centralD <- method_control[["upper_centralD"]] - - ##number of MCMC - n.chains <- if (is.null(method_control[["n.chains"]])) { - 3 - } else{ - method_control[["n.chains"]] - } - - ##inits - inits <- if (is.null(method_control[["inits"]])) { - NULL - } else{ - method_control[["inits"]] - } - - ##thin - thin <- if (is.null(method_control[["thin"]])) { - if(n.MCMC >= 1e+05){ - thin <- n.MCMC/1e+05 * 250 - - }else{ - thin <- 10 - - } - } else{ - method_control[["thin"]] - } - - ##variable.names - variable.names <- if (is.null(method_control[["variable.names"]])) { - c('central_D', 'sigma_D', 'D', 'Q', 'a', 'b', 'c', 'g') - } else{ - method_control[["variable.names"]] - } - - - #check whether this makes sense at all, just a direty and quick test - stopifnot(lower_centralD >= 0) - - Limited_cycles <- vector() - - if (fit.method == "EXP") {ExpoGC <- 1 ; LinGC <- 0 } - if (fit.method == "LIN") {ExpoGC <- 0 ; LinGC <- 1 } - if (fit.method == "EXP+LIN") {ExpoGC <- 1 ; LinGC <- 1 } - if (fit.force_through_origin == TRUE) {GC_Origin <- 1} else {GC_Origin <- 0} - - ##Include or exclude repeated dose points - if (fit.includingRepeatedRegPoints) { - for (i in 1:Nb_aliquots) { - Limited_cycles[i] <- length(stats::na.exclude(data.Dose[,i])) - } - - }else{ - - for (i in 1:Nb_aliquots) { - - temp.logic <- !duplicated(data.Dose[,i], incomparables=c(0)) # logical excluding 0 - - m <- length(which(!temp.logic)) - - data.Dose[,i] <- c(data.Dose[,i][temp.logic], rep(NA, m)) - data.Lum[,i] <- c(data.Lum[,i][temp.logic], rep(NA, m)) - data.sLum[,i] <- c(data.sLum[,i][temp.logic], rep(NA, m)) - - rm(m, temp.logic) - } - - for (i in 1:Nb_aliquots) { - Limited_cycles[i] <- length(data.Dose[, i]) - length(which(is.na(data.Dose[, i]))) - - } - } - - ##check and correct for distribution name - if (!is.null(baSAR_model) && distribution != "user_defined") { - distribution <- "user_defined" - message("[analyse_basAR()] 'baSAR_model' provided, setting ", - "distribution to 'user_defined'") - } - - # Bayesian Models ---------------------------------------------------------------------------- - # INFO: > - # > sometimes lines apear to be in a wrong logical order, however, this is allowed in the - # > model definition since: - # > "The data block is not limited to logical relations, but may also include stochastic relations." - # > (Plummer, 2017. JAGS Version 4.3.0 user manual, p. 9) - baSAR_models <- list( - cauchy = "model { - - central_D ~ dunif(lower_centralD,upper_centralD) - - precision_D ~ dt(0, pow(0.16*central_D, -2), 1)T(0, ) - sigma_D <- 1/sqrt(precision_D) - - for (i in 1:Nb_aliquots) { - a[i] ~ dnorm(6.5 , 1/(9.2^2) ) T(0, ) - b[i] ~ dnorm(50 , 1/(1000^2) ) T(0, ) - c[i] ~ dnorm(1.002 , 1/(0.9^2) ) T(0, ) - g[i] ~ dnorm(0.5 , 1/(2.5^2) ) I(-a[i], ) - sigma_f[i] ~ dexp (20) - - D[i] ~ dt ( central_D , precision_D, 1) # Cauchy distribution - - S_y[1,i] <- 1/(sLum[1,i]^2 + sigma_f[i]^2) - Lum[1,i] ~ dnorm ( Q[1,i] , S_y[1,i]) - Q[1,i] <- GC_Origin * g[i] + LinGC * (c[i] * D[i] ) + ExpoGC * (a[i] * (1 - exp (-D[i] /b[i])) ) - - for (m in 2:Limited_cycles[i]) { - S_y[m,i] <- 1/(sLum[m,i]^2 + sigma_f[i]^2) - Lum[m,i] ~ dnorm( Q[m,i] , S_y[m,i] ) - Q[m,i] <- GC_Origin * g[i] + LinGC * (c[i] * Dose[m,i]) + ExpoGC * (a[i] * (1 - exp (-Dose[m,i]/b[i])) ) - } - } - }", - - normal = "model { - central_D ~ dunif(lower_centralD,upper_centralD) - - sigma_D ~ dunif(0.01, 1 * central_D) - - for (i in 1:Nb_aliquots) { - a[i] ~ dnorm(6.5 , 1/(9.2^2) ) T(0, ) - b[i] ~ dnorm(50 , 1/(1000^2) ) T(0, ) - c[i] ~ dnorm(1.002 , 1/(0.9^2) ) T(0, ) - g[i] ~ dnorm(0.5 , 1/(2.5^2) ) I(-a[i], ) - sigma_f[i] ~ dexp (20) - - D[i] ~ dnorm ( central_D , 1/(sigma_D^2) ) # Normal distribution - - S_y[1,i] <- 1/(sLum[1,i]^2 + sigma_f[i]^2) - Lum[1,i] ~ dnorm ( Q[1,i] , S_y[1,i]) - Q[1,i] <- GC_Origin * g[i] + LinGC * (c[i] * D[i] ) + ExpoGC * (a[i] * (1 - exp (-D[i] /b[i])) ) - - - for (m in 2:Limited_cycles[i]) { - S_y[m,i] <- 1/(sLum[m,i]^2 + sigma_f[i]^2) - Lum[m,i] ~ dnorm( Q[m,i] , S_y[m,i] ) - Q[m,i] <- GC_Origin * g[i] + LinGC * (c[i] * Dose[m,i]) + ExpoGC * (a[i] * (1 - exp (-Dose[m,i]/b[i])) ) - } - } - }", - - log_normal = "model { - central_D ~ dunif(lower_centralD,upper_centralD) - - log_central_D <- log(central_D) - 0.5 * l_sigma_D^2 - l_sigma_D ~ dunif(0.01, 1 * log(central_D)) - sigma_D <- sqrt((exp(l_sigma_D^2) -1) * exp( 2*log_central_D + l_sigma_D^2) ) - - for (i in 1:Nb_aliquots) { - a[i] ~ dnorm(6.5 , 1/(9.2^2) ) T(0, ) - b[i] ~ dnorm(50 , 1/(1000^2) ) T(0, ) - c[i] ~ dnorm(1.002 , 1/(0.9^2) ) T(0, ) - g[i] ~ dnorm(0.5 , 1/(2.5^2) ) I(-a[i], ) - sigma_f[i] ~ dexp (20) - - log_D[i] ~ dnorm ( log_central_D , 1/(l_sigma_D^2) ) # Log-Normal distribution - D[i] <- exp(log_D[i]) - - S_y[1,i] <- 1/(sLum[1,i]^2 + sigma_f[i]^2) - Lum[1,i] ~ dnorm ( Q[1,i] , S_y[1,i]) - Q[1,i] <- GC_Origin * g[i] + LinGC * (c[i] * D[i] ) + ExpoGC * (a[i] * (1 - exp (-D[i] /b[i])) ) - - for (m in 2:Limited_cycles[i]) { - S_y[m,i] <- 1/(sLum[m,i]^2 + sigma_f[i]^2) - Lum[m,i] ~ dnorm( Q[m,i] , S_y[m,i] ) - Q[m,i] <- GC_Origin * g[i] + LinGC * (c[i] * Dose[m,i]) + ExpoGC * (a[i] * (1 - exp (-Dose[m,i]/b[i])) ) - } - } - }", - - user_defined = baSAR_model - ) - - ##check whether the input for distribution was sufficient - if (!distribution %in% names(baSAR_models)) { - .throw_error("No pre-defined model for the requested distribution. ", - "Please select one of '", - paste(rev(names(baSAR_models))[-1], collapse = "', '"), - "', or define an own model using argument 'baSAR_model'", - nframe = 7) - } - - if (distribution == "user_defined" && is.null(baSAR_model)) { - .throw_error("You specified a 'user_defined' distribution, ", - "but did not provide a model via 'baSAR_model'", - nframe = 7) - } - - ### Bayesian inputs - data_Liste <- list( - 'Dose' = data.Dose, - 'Lum' = data.Lum, - 'sLum' = data.sLum, - 'LinGC' = LinGC, - 'ExpoGC' = ExpoGC, - 'GC_Origin' = GC_Origin, - 'Limited_cycles' = Limited_cycles, - 'lower_centralD' = lower_centralD, - 'upper_centralD' = upper_centralD, - 'Nb_aliquots' = Nb_aliquots - ) - - if(verbose){ - cat("\n[analyse_baSAR()] ---- baSAR-model ---- \n") - cat("\n++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n") - cat("[analyse_baSAR()] Bayesian analysis in progress ...\n") - message(".. >> bounds set to: lower_centralD =", lower_centralD, - "| upper_centralD =", upper_centralD) - } - - Nb_Iterations <- n.MCMC - - if (verbose) { - message( - ".. >> calculation will be done assuming a '", - distribution, - "' distribution\n" - ) - } - - ##set model - jagsfit <- rjags::jags.model( - file = textConnection(baSAR_models[[distribution]]), - data = data_Liste, - inits = inits, - n.chains = n.chains, - n.adapt = Nb_Iterations, - quiet = !verbose - ) - - ##update jags model (it is a S3-method) - update( - object = jagsfit, - n.iter = Nb_Iterations, - progress.bar = if(verbose){"text"}else{NULL} - ) - - ##get data ... full and reduced, the reduced one to limit the plot output - sampling <- rjags::coda.samples( - model = jagsfit, - variable.names = variable.names, - n.iter = Nb_Iterations, - thin = thin - ) - - ##this we need for the output of the terminal - ##Why sampling reduced? Because the summary() method produces a considerable overhead while - ##running over all the variables - sampling_reduced <- rjags::coda.samples( - model = jagsfit, - variable.names = c('central_D', 'sigma_D'), - n.iter = Nb_Iterations, - thin = thin - ) - - - pt_zero <- 0 - nb_decal <- 2 - pt_zero <- Nb_aliquots - - ##standard error and mean - output.mean <- - round(summary(sampling_reduced)[[1]][c("central_D", "sigma_D"), 1:2], digits) - - ##calculate geometric mean for the case that the distribution is log-normal - if(distribution == "log_normal"){ - temp.vector <- unlist(lapply(sampling_reduced, function(x){as.vector(x[,1])})) - gm <- round(exp(sum(log(temp.vector))/length(temp.vector)),digits) - rm(temp.vector) - }else{ - gm <- NULL - - } - - ##quantiles - ##68% + 95% - output.quantiles <- - round(summary(sampling_reduced, quantiles = c(0.025, 0.16, 0.84, 0.975))[[2]][c("central_D", "sigma_D"), 1:4], digits) - - #### output data.frame with results - baSAR.output <- data.frame( - DISTRIBUTION = distribution, - NB_ALIQUOTS = Nb_aliquots, - N.CHAINS = n.chains, - N.MCMC = n.MCMC, - FIT_METHOD = fit.method, - CENTRAL = if(is.null(gm)){output.mean[1,1]}else{gm}, - CENTRAL.SD = output.mean[1,2], - SIGMA = output.mean[2,1], - SIGMA.SD = output.mean[2,2], - CENTRAL_Q_.16 = output.quantiles[1,2], - CENTRAL_Q_.84 = output.quantiles[1,3], - SIGMA_Q_.16 = output.quantiles[2,2], - SIGMA_Q_.84 = output.quantiles[2,3], - CENTRAL_Q_.025 = output.quantiles[1,1], - CENTRAL_Q_.975 = output.quantiles[1,4], - SIGMA_Q_.025 = output.quantiles[2,1], - SIGMA_Q_.975 = output.quantiles[2,4] - ) - - return( - baSAR.output = list( - baSAR.output_summary = baSAR.output, - baSAR.output_mcmc = sampling, - models = list( - cauchy = baSAR_models[["cauchy"]], - normal = baSAR_models[["normal"]], - log_normal = baSAR_models[["log_normal"]], - user_defined = baSAR_models[["user_defined"]] - ) - ) - ) - - } - ##END - ##//////////////////////////////////////////////////////////////////////////////////////////////// - - # Integrity tests ----------------------------------------------------------------------------- - - ##check whether rjags is available - ##code snippet taken from - ##http://r-pkgs.had.co.nz/description.html - # nocov start - if (!requireNamespace("rjags", quietly = TRUE)) { - .throw_error("To use this function you have to first install package 'rjags'") - } - - if (!requireNamespace("coda", quietly = TRUE)) { - .throw_error("To use this function you have to first install package 'coda'.") - } - # nocov end - - ## fit.method - if (!fit.method %in% c("EXP", "EXP+LIN", "LIN")) { - .throw_error("'fit.method' not recognised, supported methods are: ", - "'EXP', 'EXP+LIN' and 'LIN'") - } - - .validate_positive_scalar(n.MCMC, int = TRUE) - - #capture additional piped arguments - additional_arguments <- list( - - ##verify_SingleGrainData - threshold = 30, - - ##calc_OSLLxTxRatio() - background.count.distribution = "non-poisson", - - ##readxl::read_excel() - sheet = 1, - col_names = TRUE, - col_types = NULL, - skip = 0, - - ##read_BIN2R() - n.records = NULL, - duplicated.rm = TRUE, - position = NULL, - pattern = NULL, - - ##plot_GrowthCurve() - fit.weights = TRUE, - fit.bounds = TRUE, - NumberIterations.MC = 100, - output.plot = plot, - output.plotExtended = plot - ) - - #modify this list on purpose - additional_arguments <- modifyList(x = additional_arguments, - val = list(...)) - - ##set function arguments - function_arguments <- NULL - - - # Set input ----------------------------------------------------------------------------------- - - ##if the input is alreayd of type RLum.Results, use the input and do not run - ##all pre-calculations again - if(is(object, "RLum.Results")){ - - if(object@originator == "analyse_baSAR"){ - - ##We want to use previous function arguments and recycle them - - ##(1) get information you need as input from the RLum.Results object - function_arguments <- as.list(object@info$call) - - ##(2) overwrite by current provided arguments - ##by using a new argument we have the choise which argument is allowed for - ##changes - function_arguments.new <- modifyList(x = function_arguments, val = as.list(match.call())) - - ##get maximum cycles - max_cycles <- max(object$input_object[["CYCLES_NB"]]) - - ##set Nb_aliquots - Nb_aliquots <- nrow(object$input_object) - - ## return NULL if not at least three aliquots are used for the calculation - if(Nb_aliquots < 2){ - message("[analyse_baSAR()] Error: number of aliquots < 3, ", - "this makes no sense, NULL returned") - return(NULL) - } - - ##set variables - ##Why is.null() ... it prevents that in case of a function crash is nothing is provided ... - - ##set changeable function arguments - - ##distribution - if(!is.null(function_arguments.new$distribution)){ - distribution <- function_arguments.new$distribution - } - - ##n.MCMC - if(!is.null(function_arguments.new$n.MCMC)){ - n.MCMC <- function_arguments.new$n.MCMC - } - - ##fit.method - if(!is.null(function_arguments.new$fit.method)){ - fit.method <- function_arguments.new$fit.method - } - - ## fit.force_through_origin - if(!is.null(function_arguments.new$fit.force_through_origin)){ - fit.force_through_origin <- function_arguments.new$fit.force_through_origin - } - - ##fit.includingRepeatedRegPoints - if(!is.null(function_arguments.new$fit.includingRepeatedRegPoints)){ - fit.includingRepeatedRegPoints <- function_arguments.new$fit.includingRepeatedRegPoints - } - - ##source_doserate - if(length(as.list(match.call())$source_doserate) > 0){ - .throw_warning("'source_doserate' is ignored in this mode as ", - "it was already set") - } - - ##aliquot_range - if(!is.null(function_arguments.new$aliquot_range)){ - aliquot_range <- eval(function_arguments.new$aliquot_range) - } - - ##method_control - if(!is.null(function_arguments.new$method_control)){ - method_control <- eval(function_arguments.new$method_control) - } - - ##baSAR_model - if(!is.null(function_arguments.new$baSAR_model)){ - baSAR_model <- eval(function_arguments.new$baSAR_model) - } - - ##plot - if(!is.null(function_arguments.new$plot)){ - plot <- function_arguments.new$plot - } - - ##verbose - if(!is.null(function_arguments.new$verbose)){ - verbose <- function_arguments.new$verbose - } - - - ##limit according to aliquot_range - ##TODO Take care of the case that this was provided, otherwise more and more is removed! - if (!is.null(aliquot_range)) { - if (max(aliquot_range) <= nrow(object$input_object)) { - input_object <- object$input_object[aliquot_range, ] - - ##update list of removed aliquots - removed_aliquots <-rbind(object$removed_aliquots, object$input_object[-aliquot_range,]) - - ##correct Nb_aliquots - Nb_aliquots <- nrow(input_object) - - } else{ - message("[analyse_basAR()] Error: 'aliquot_range' out of bounds, ", - "input ignored") - - ##reset aliquot range - aliquot_range <- NULL - - ##take entire object - input_object <- object$input_object - - ##set removed aliquots - removed_aliquots <- object$removed_aliquots - - } - - - } else{ - ##set the normal case - input_object <- object$input_object - - ##set removed aliquots - removed_aliquots <- object$removed_aliquots - } - - ##set non function arguments - Doses <- t(input_object[,9:(8 + max_cycles)]) - LxTx <- t(input_object[,(9 + max_cycles):(8 + 2 * max_cycles)]) - LxTx.error <- t(input_object[,(9 + 2 * max_cycles):(8 + 3 * max_cycles)]) - - rm(max_cycles) - - }else{ - .throw_error("'object' is of type 'RLum.Results', ", - "but was not produced by analyse_baSAR()") - } - - }else{ - - if(verbose){ - cat("\n[analyse_baSAR()] ---- PRE-PROCESSING ----\n") - } - - - ##Supported input types are: - ## (1) BIN-file - ## .. list - ## .. character - ## (2) RisoeBINfileData object - ## .. list - ## .. S4 - ## (3) RLum.Analyis objects - ## .. list - ## .. S4 - - ##In case an RLum.Analysis object is provided we try an ugly conversion only - if(inherits(object, "list") && all(vapply(object, function(x){inherits(x, "RLum.Analysis")}, logical(1)))){ - if(verbose) - cat("[analyse_baSAR()] List of RLum.Analysis-objects detected ..\n") - - ## set number of objects - n_objects <- length(object) - - ##stop for only one element - if (n_objects < 2) - .throw_error("At least two aliquots are needed for the calculation") - - ##extract wanted curves - if(verbose) - cat("\t\t .. extract 'OSL (UVVIS)' and 'irradiation (NA)'\n") - object <- get_RLum(object, recordType = c("OSL (UVVIS)", "irradiation (NA)"), drop = FALSE) - - ## check that we are not left with empty records - if (length(object[[1]]@records) == 0) { - .throw_error("No records of the appropriate type were found") - } - - ##extract irradiation times - if(is.null(irradiation_times)){ - if(verbose) - cat("\t\t .. extract irradiation times\n") - irradiation_times <- extract_IrradiationTimes(object[[1]])$irr.times$IRR_TIME - } - - ##run conversion - if(verbose) - cat("\t\t .. run conversion\n") - object <- try(convert_RLum2Risoe.BINfileData(object), silent = TRUE) - - ##create fallback - if(inherits(object, "try-error")){ - message("[analyse_baSAR()] Error: Object conversion failed, ", - "NULL returned") - return(NULL) - } - - ##assign irradiation times - if(is.null(irradiation_times)){ - if(verbose) - cat("\t\t .. set irradiation times\n") - object@METADATA[["IRR_TIME"]] <- rep(irradiation_times,n_objects) - } - - ##remove none-OSL curves - if(verbose && !all("OSL" %in% object@METADATA[["LTYPE"]])){ - cat("\t\t .. remove non-OSL curves\n") - rm_id <- which(object@METADATA[["LTYPE"]] != "OSL") - object@METADATA <- object@METADATA[-rm_id,] - object@DATA[rm_id] <- NULL - - ##reset index - object@METADATA[["ID"]] <- 1:length(object@METADATA[["ID"]]) - - ##delete objects - rm(rm_id) - } - - } - - if (is(object, "Risoe.BINfileData")) { - fileBIN.list <- list(object) - - } else if (is(object, "list")) { - ##check what the list containes ... - object_type <- - unique(unlist(lapply( - 1:length(object), - FUN = function(x) { - is(object[[x]])[1] - } - ))) - - if (length(object_type) == 1) { - if (object_type == "Risoe.BINfileData") { - fileBIN.list <- object - - } else if (object_type == "character") { - fileBIN.list <- read_BIN2R( - file = object, - position = additional_arguments$position, - duplicated.rm = additional_arguments$duplicated.rm, - n.records = additional_arguments$n.records, - pattern = additional_arguments$pattern, - verbose = verbose - ) - } else{ - .throw_error("Unsupported data type in the input list ", - "provided for 'object'") - } - - } else{ - .throw_error("'object' only accepts a list with objects of similar type") - } - - } else if (is(object, "character")) { - fileBIN.list <- list( - read_BIN2R( - file = object, - position = additional_arguments$position, - duplicated.rm = additional_arguments$duplicated.rm, - n.records = additional_arguments$n.records, - verbose = verbose - ) - ) - - } else{ - .throw_error("'", is(object)[1], "' as input is not supported. ", - "Check manual for allowed input objects.") - } - - ##Problem ... the user might have made a pre-selection in the Analyst software, if this the - ##we respect this selection - record.selected <- unlist(lapply(fileBIN.list, - FUN = function(x) x@METADATA[["SEL"]] )) - if (!all(record.selected)) { - - fileBIN.list <- lapply(fileBIN.list, function(x){ - - ##reduce data - x@DATA <- x@DATA[x@METADATA[["SEL"]]] - x@METADATA <- x@METADATA[x@METADATA[["SEL"]], ] - - ##reset index - x@METADATA[["ID"]] <- 1:nrow(x@METADATA) - return(x) - - }) - - if(verbose){ - cat("\n[analyse_baSAR()] Record pre-selection in BIN-file detected >> record reduced to selection") - - } - } - - # Declare variables --------------------------------------------------------------------------- - Dose <- list() - LxTx <- list() - sLxTx <- list() - - Disc <- list() - Grain <- list() - Disc_Grain.list <- list() - - Nb_aliquots <- 0 - previous.Nb_aliquots <- 0 - object.file_name <- list() - - Mono_grain <- TRUE - - Limited_cycles <- vector() - - ##set information - for (i in 1 : length(fileBIN.list)) { - Disc[[i]] <- list() - Grain[[i]] <- list() - - ##get BIN-file name - object.file_name[[i]] <- unique(fileBIN.list[[i]]@METADATA[["FNAME"]]) - - } - - ##check for duplicated entries; remove them as they would cause a function crash - if(any(duplicated(unlist(object.file_name)))){ - msg <- paste0("'", paste( - object.file_name[which(duplicated(unlist(object.file_name)))], - collapse = ", "), - "' is a duplicate and therefore removed from the input") - ##provide messages - if(verbose){ - message("[analyse_baSAR()] ", msg) - } - - .throw_warning(msg) - - ##remove entry - Disc[which(duplicated(unlist(object.file_name)))] <- NULL - Grain[which(duplicated(unlist(object.file_name)))] <- NULL - fileBIN.list[which(duplicated(unlist(object.file_name)))] <- NULL - object.file_name[which(duplicated(unlist(object.file_name)))] <- NULL - } - - # Expand parameter list ----------------------------------------------------------------------- - - ##test_parameter = source_doserate - if(!is.null(source_doserate)){ - if(is(source_doserate, "list")){ - source_doserate <- rep(source_doserate, length = length(fileBIN.list)) - }else{ - source_doserate <- rep(list(source_doserate), length = length(fileBIN.list)) - } - }else{ - .throw_error("'source_doserate' is missing, but the current ", - "implementation expects dose values in Gy") - } - - ##sigmab - if(is(sigmab, "list")){ - sigmab <- rep(sigmab, length = length(fileBIN.list)) - }else{ - sigmab <- rep(list(sigmab), length = length(fileBIN.list)) - } - - ##sig0 - if(is(sig0, "list")){ - sig0 <- rep(sig0, length = length(fileBIN.list)) - }else{ - sig0 <- rep(list(sig0), length = length(fileBIN.list)) - } - - ##test_parameter = signal.integral - if(is(signal.integral, "list")){ - signal.integral <- rep(signal.integral, length = length(fileBIN.list)) - }else{ - signal.integral <- rep(list(signal.integral), length = length(fileBIN.list)) - } - - ##test_parameter = signal.integral.Tx - if (!is.null(signal.integral.Tx)) { - if (is(signal.integral.Tx, "list")) { - signal.integral.Tx <- rep(signal.integral.Tx, length = length(fileBIN.list)) - } else{ - signal.integral.Tx <- rep(list(signal.integral.Tx), length = length(fileBIN.list)) - } - } - - ##test_parameter = background.integral - if(is(background.integral, "list")){ - background.integral <- rep(background.integral, length = length(fileBIN.list)) - }else{ - background.integral <- rep(list(background.integral), length = length(fileBIN.list)) - } - - ##test_parameter = background.integral - if(is(background.integral, "list")){ - background.integral <- rep(background.integral, length = length(fileBIN.list)) - }else{ - background.integral <- rep(list(background.integral), length = length(fileBIN.list)) - } - - ##test_parameter = background.integral.Tx - if (!is.null(background.integral.Tx)) { - if (is(background.integral.Tx, "list")) { - background.integral.Tx <- - rep(background.integral.Tx, length = length(fileBIN.list)) - } else{ - background.integral.Tx <- - rep(list(background.integral.Tx), length = length(fileBIN.list)) - } - } - - # Read EXCEL sheet ---------------------------------------------------------------------------- - if(is.null(XLS_file)){ - ##select aliquots giving light only, this function accepts also a list as input - if(verbose){ - cat("\n[analyse_baSAR()] No XLS-file provided, running automatic grain selection ...\n") - - } - - for (k in 1:length(fileBIN.list)) { - ##if the uses provides only multiple grain data (GRAIN == 0), the verification - ##here makes not really sense and should be skipped - if(length(unique(fileBIN.list[[k]]@METADATA[["GRAIN"]])) > 1){ - aliquot_selection <- - verify_SingleGrainData( - object = fileBIN.list[[k]], - cleanup_level = "aliquot", - threshold = additional_arguments$threshold, - cleanup = FALSE - ) - - ## remove grain position 0 (this are usually TL measurements - ## on the cup or we are talking about multiple aliquot) - num.grain.pos0 <- sum(aliquot_selection$unique_pairs[["GRAIN"]] == 0, - na.rm = TRUE) - if (sum(num.grain.pos0) > 0) { - .throw_warning("Automatic grain selection: ", num.grain.pos0, - "curve(s) with grain index 0 had been removed ", - "from the dataset") - } - - datalu <- - aliquot_selection$unique_pairs[!aliquot_selection$unique_pairs[["GRAIN"]] == 0,] - - if(nrow(datalu) == 0){ - message("[analyse_baSAR()] Error: nothing was left after ", - "the automatic grain selection, NULL returned") - return(NULL) - } - - }else{ - .throw_warning("Only multiple grain data provided, ", - "automatic selection skipped") - datalu <- unique(fileBIN.list[[k]]@METADATA[, c("POSITION", "GRAIN")]) - - ##set mono grain to FALSE - Mono_grain <- FALSE - aliquot_selection <- NA - } - - ##get number of aliquots (one aliquot has a position and a grain number) - Nb_aliquots <- nrow(datalu) - - ##write information in variables - Disc[[k]] <- datalu[["POSITION"]] - Grain[[k]] <- datalu[["GRAIN"]] - - ##free memory - rm(datalu, aliquot_selection) - } - rm(k) - - } else if (is(XLS_file, "data.frame") || is(XLS_file, "character")) { - ##load file if we have an XLS file - if (is(XLS_file, "character")) { - ##test for valid file - if(!file.exists(XLS_file)){ - .throw_error("XLS_file does not exist") - } - - ##import Excel sheet - datalu <- as.data.frame(readxl::read_excel( - path = XLS_file, - sheet = additional_arguments$sheet, - col_names = additional_arguments$col_names, - col_types = additional_arguments$col_types, - skip = additional_arguments$skip, - progress = FALSE, - ), stringsAsFactors = FALSE) - - ###check whether data format is somehow odd, check only the first three columns - if (ncol(datalu) < 3) { - .throw_error("The XLS_file requires at least 3 columns for ", - "'BIN_file', 'DISC' and 'GRAIN'") - } - if(!all(grepl(colnames(datalu), pattern = " ")[1:3])){ - .throw_error("One of the first 3 columns in your XLS_file has no ", - "header. Your XLS_file requires at least 3 columns for ", - "'BIN_file', 'DISC' and 'GRAIN'") - } - - ##get rid of empty rows if the BIN_FILE name column is empty - datalu <- datalu[!is.na(datalu[[1]]), ] - - } else{ - - datalu <- XLS_file - - ##check number of number of columns in data.frame - if(ncol(datalu) < 3){ - .throw_error("The data.frame provided via 'XLS_file' must have ", - "at least 3 columns (see manual)") - } - - ##problem: the first column should be of type character, the others are - ##of type numeric, unfortunately it is too risky to rely on the user, we do the - ##proper conversion by ourself ... - datalu[[1]] <- as.character(datalu[[1]]) - datalu[[2]] <- as.numeric(datalu[[2]]) - datalu[[3]] <- as.numeric(datalu[[3]]) - } - - ##limit aliquot range - if (!is.null(aliquot_range)) { - datalu <- datalu[aliquot_range,] - - } - - Nb_ali <- 0 - k <- NULL - - for (nn in 1:length((datalu[, 1]))) { - if (!is.na(datalu[nn, 1])) { - - ##check whether one file fits - file.basename <- strsplit(basename(datalu[nn, 1]), - split = ".", fixed = TRUE)[[1]][1] - matches <- grep(pattern = file.basename, x = unlist(object.file_name)) - if (length(matches) > 0) { - k <- matches[1] - nj <- length(Disc[[k]]) + 1 - - Disc[[k]][nj] <- as.numeric(datalu[nn, 2]) - Grain[[k]][nj] <- as.numeric(datalu[nn, 3]) - Nb_ali <- Nb_ali + 1 - if (is.na(Grain[[k]][nj]) || Grain[[k]][nj] == 0) { - Mono_grain <- FALSE - } - - }else{ - .throw_warning("'", datalu[nn, 1], "' not recognised ", - "or not loaded, skipped") - } - - } else{ - - if (Nb_ali == 0) { - .throw_error("Number of discs/grains = 0") - } - - break() - } - } - - ##if k is NULL it means it was not set so far, so there was - ##no corresponding BIN-file found - if(is.null(k)){ - .throw_error("BIN-file names in XLS_file do not match the loaded ", - "BIN-files") - } - - } else{ - .throw_error("Input type for 'XLS_file' not supported") - } - - - ###################################### loops on files_number - for (k in 1:length(fileBIN.list)) { - Disc_Grain.list[[k]] <- list() # data.file number - n_aliquots_k <- length(Disc[[k]]) - - if(n_aliquots_k == 0){ - fileBIN.list[[k]] <- NULL - if(verbose){ - message("[analyse_baSAR()] No data has been selected from BIN-file ", - k, " >> BIN-file removed from input!") - } - .throw_warning("No data has been selected from BIN-file ", k, - " >> BIN-file removed from input") - next() - } - - for (d in 1:n_aliquots_k) { - dd <- as.integer(unlist(Disc[[k]][d])) - Disc_Grain.list[[k]][[dd]] <- list() # data.file number , disc_number - } - - for (d in 1:n_aliquots_k) { - dd <- as.integer(unlist(Disc[[k]][d])) - if (Mono_grain == FALSE) { - gg <- 1 - } - if (Mono_grain == TRUE) { - gg <- as.integer(unlist(Grain[[k]][d]))} - - Disc_Grain.list[[k]][[dd]][[gg]] <- list() # data.file number , disc_number, grain_number - for (z in 1:6) { - Disc_Grain.list[[k]][[dd]][[gg]][[z]] <- list() - # 1 = index numbers, 2 = irradiation doses, 3 = LxTx , 4 = sLxTx, 5 = N d'aliquot, 6 = De +- D0 +- (4 values) - } - } - } - - if(verbose){ - cat("\n[analyse_baSAR()] Preliminary analysis in progress ... ") - cat("\n[analyse_baSAR()] Hang on, this may take a while ... \n") - } - - - for (k in 1:length(fileBIN.list)) { - n_index.vector <- vector("numeric") - - measured_discs.vector <- vector("numeric") - measured_grains.vector <- vector("numeric") - measured_grains.vector_list <- vector("numeric") - irrad_time.vector <- vector("numeric") - - disc_pos <- vector("numeric") - grain_pos <- vector("numeric") - - ### METADATA - length_BIN <- length(fileBIN.list[[k]]) - n_index.vector <- fileBIN.list[[k]]@METADATA[["ID"]][1:length_BIN] # curves indexes vector - - measured_discs.vector <- fileBIN.list[[k]]@METADATA[["POSITION"]][1:length_BIN] # measured discs vector - measured_grains.vector <- fileBIN.list[[k]]@METADATA[["GRAIN"]][1:length_BIN] # measured grains vector - - if(is.null(irradiation_times)){ - irrad_time.vector <- fileBIN.list[[k]]@METADATA[["IRR_TIME"]][1:length_BIN] # irradiation durations vector - - }else{ - irrad_time.vector <- rep(irradiation_times,n_objects) - } - - ##if all irradiation times are 0 we should stop here - if (length(unique(irrad_time.vector)) == 1) { - message("[analyse_baSAR()] Error: all irradiation times are identical, ", - "NULL returned") - return(NULL) - } - - disc_pos <- as.integer(unlist(Disc[[k]])) - grain_pos <- as.integer(unlist(Grain[[k]])) - - ### Automatic Filling - Disc_Grain.list - for (i in 1: length(Disc[[k]])) { - - disc_selected <- as.integer(Disc[[k]][i]) - - if (Mono_grain == TRUE) {grain_selected <- as.integer(Grain[[k]][i])} else { grain_selected <-0} - - ##hard break if the disc number or grain number does not fit - - ##disc (position) - disc_logic <- (disc_selected == measured_discs.vector) - if (!any(disc_logic)) { - message("[analyse_baSAR()] In BIN-file '", - unique(fileBIN.list[[k]]@METADATA[["FNAME"]]), - "' position number ", disc_selected, - " does not exist, NULL returned") - return(NULL) - } - - ##grain - grain_logic <- (grain_selected == measured_grains.vector) - - if (!any(grain_logic)) { - message("[analyse_baSAR()] In BIN-file '", - unique(fileBIN.list[[k]]@METADATA[["FNAME"]]), - "' grain number ", grain_selected, - " does not exist, NULL returned") - return(NULL) - } - - ##if the test passed, compile index list - index_liste <- n_index.vector[disc_logic & grain_logic] - - if (Mono_grain == FALSE) {grain_selected <-1} - - for (kn in 1: length(index_liste)) { - - t <- index_liste[kn] - - ##check if the source_doserate is NULL or not - if(!is.null(unlist(source_doserate))){ - dose.value <- irrad_time.vector[t] * unlist(source_doserate[[k]][1]) - - }else{ - dose.value <- irrad_time.vector[t] - - } - - s <- 1 + length( Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[1]] ) - Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[1]][s] <- n_index.vector[t] # indexes - if ( s%%2 == 1) { Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[2]][as.integer(1+s/2)] <- dose.value } # irradiation doses - - } - } - } - - - ###################### Data associated with a single Disc/Grain - max_cycles <- 0 - count <- 1 - calc_OSLLxTxRatio_warning <- list() - - for (k in 1:length(fileBIN.list)) { - - if (Mono_grain == TRUE) (max.grains <- 100) else (max.grains <- 1) - - - ##plot Ln and Tn curves if wanted - ##we want to plot the Ln and Tn curves to get a better feeling - ##The approach here is rather rough coded, but it works - if (plot) { - curve_index <- vapply(1:length(Disc[[k]]), function(i) { - disc_selected <- as.integer(Disc[[k]][i]) - if (Mono_grain == TRUE) { - grain_selected <- as.integer(Grain[[k]][i]) - } else { - grain_selected <- 1 - } - - Ln_index <- - as.numeric(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[1]][1]) - Tn_index <- - as.numeric(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[1]][2]) - - return(c(Ln_index, Tn_index)) - }, FUN.VALUE = vector(mode = "numeric", length = 2)) - - - ##set matrix for Ln values - Ln_matrix <- cbind(1:length(fileBIN.list[[k]]@DATA[[curve_index[1, 1]]]), - matrix(unlist(fileBIN.list[[k]]@DATA[curve_index[1, ]]), ncol = ncol(curve_index))) - - Tn_matrix <- cbind(1:length(fileBIN.list[[k]]@DATA[[curve_index[2, 1]]]), - matrix(unlist(fileBIN.list[[k]]@DATA[curve_index[2, ]]), ncol = ncol(curve_index))) - - ##open plot are - if(!plot.single){ - par.default <- par()$mfrow - par(mfrow = c(1, 2)) - - } - - ##get natural curve and combine them in matrix - graphics::matplot( - x = Ln_matrix[, 1], - y = Ln_matrix[, -1], - col = rgb(0, 0, 0, 0.3), - ylab = "Luminescence [a.u.]", - xlab = "Channel", - main = expression(paste(L[n], " - curves")), - type = "l" - - ) - - ##add integration limits - abline(v = range(signal.integral[[k]]), lty = 2, col = "green") - abline(v = range(background.integral[[k]]), lty = 2, col = "red") - mtext(paste0("ALQ: ",count, ":", count + ncol(curve_index))) - - graphics::matplot( - x = Tn_matrix[, 1], - y = Tn_matrix[, -1], - col = rgb(0, 0, 0, 0.3), - ylab = "Luminescence [a.u.]", - xlab = "Channel", - main = expression(paste(T[n], " - curves")), - type = "l" - - ) - - ##add integration limits depending on the choosen value - if(is.null(signal.integral.Tx[[k]])){ - abline(v = range(signal.integral[[k]]), lty = 2, col = "green") - - }else{ - abline(v = range(signal.integral.Tx[[k]]), lty = 2, col = "green") - - } - - if(is.null(background.integral.Tx[[k]])){ - abline(v = range(background.integral[[k]]), lty = 2, col = "red") - - }else{ - abline(v = range(background.integral.Tx[[k]]), lty = 2, col = "red") - - } - - mtext(paste0("ALQ: ",count, ":", count + ncol(curve_index))) - - - ##reset par - if(!plot.single){ - par(mfrow = par.default) - - } - - ##remove some variables - rm(curve_index, Ln_matrix, Tn_matrix) - - } - - - for (i in 1:length(Disc[[k]])) { - - disc_selected <- as.integer(Disc[[k]][i]) - if (Mono_grain == TRUE) { - grain_selected <- as.integer(Grain[[k]][i]) - } else { - grain_selected <- 1 - } - - # Data for the selected Disc-Grain - for (nb_index in 1:((length(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[1]]))/2 )) { - - index1 <- as.numeric(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[1]][2*nb_index-1]) - index2 <- as.numeric(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[1]][2*nb_index]) - Lx.data <- data.frame(seq(1:length( fileBIN.list[[k]]@DATA[[index1]])), fileBIN.list[[k]]@DATA[[index1]]) - Tx.data <- data.frame(seq(1:length( fileBIN.list[[k]]@DATA[[index2]])), fileBIN.list[[k]]@DATA[[index2]]) - - ## call calc_OSLLxTxRatio() - ## we run this function with a warnings catcher to reduce the load of warnings for the user - temp_LxTx <- withCallingHandlers( - calc_OSLLxTxRatio( - Lx.data = Lx.data, - Tx.data = Tx.data, - signal.integral = signal.integral[[k]], - signal.integral.Tx = signal.integral.Tx[[k]], - background.integral = background.integral[[k]], - background.integral.Tx = background.integral.Tx[[k]], - background.count.distribution = additional_arguments$background.count.distribution, - sigmab = sigmab[[k]], - sig0 = sig0[[k]] - ), - warning = function(c) { - calc_OSLLxTxRatio_warning[[i]] <<- c - invokeRestart("muffleWarning") - } - ) - - ##get LxTx table - LxTx.table <- temp_LxTx$LxTx.table - - Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[3]][nb_index] <- LxTx.table[[9]] - Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[4]][nb_index] <- LxTx.table[[10]] - Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[5]][nb_index] <- LxTx.table[[7]] - - ##free memory - rm(LxTx.table) - rm(temp_LxTx) - } - - # Fitting Growth curve and Plot - sample_dose <- unlist(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[2]]) - sample_LxTx <- unlist(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[3]]) - sample_sLxTx <- unlist(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[4]]) - - TnTx <- unlist(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[5]]) - - ##create needed data.frame (this way to make sure that rows are doubled if something is missing) - selected_sample <- as.data.frame(cbind(sample_dose, sample_LxTx, sample_sLxTx, TnTx)) - - ##call plot_GrowthCurve() to get De and De value - fitcurve <- - suppressWarnings(plot_GrowthCurve( - sample = selected_sample, - na.rm = TRUE, - fit.method = fit.method, - fit.force_through_origin = fit.force_through_origin, - fit.weights = additional_arguments$fit.weights, - fit.includingRepeatedRegPoints = fit.includingRepeatedRegPoints, - fit.bounds = additional_arguments$fit.bounds, - NumberIterations.MC = additional_arguments$NumberIterations.MC, - output.plot = additional_arguments$output.plot, - output.plotExtended = additional_arguments$output.plotExtended, - txtProgressBar = FALSE, - verbose = verbose, - main = paste0("ALQ: ", count," | POS: ", Disc[[k]][i], " | GRAIN: ", Grain[[k]][i]) - )) - - - ##get data.frame with De values - if(!is.null(fitcurve)){ - fitcurve_De <- get_RLum(fitcurve, data.object = "De") - - Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[6]][1] <- - fitcurve_De[["De"]] - Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[6]][2] <- - fitcurve_De[["De.Error"]] - Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[6]][3] <- - fitcurve_De[["D01"]] - Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[6]][4] <- - fitcurve_De[["D01.ERROR"]] - - }else{ - ##we have to do this, otherwise the grains will be sorted out - Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[6]][1:4] <- NA - - } - - Limited_cycles[previous.Nb_aliquots + i] <- - length(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[2]]) - - if (length(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[2]]) > max_cycles) { - max_cycles <- - length(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[2]]) - - } - - previous.Nb_aliquots <- - length(stats::na.exclude(Limited_cycles)) # Total count of aliquots - - - count <- count + 1 - } - - } ## END of loop on BIN files - rm(count) - - ##evaluate warnings from calc_OSLLxTxRatio() - if(length(calc_OSLLxTxRatio_warning)>0){ - w_table <- table(unlist(calc_OSLLxTxRatio_warning)) - w_table_names <- names(w_table) - - for(w in 1:length(w_table)){ - .throw_warning(w_table_names[w], " This warning occurred ", - w_table[w], " times") - } - rm(w_table, w_table_names) - } - rm(calc_OSLLxTxRatio_warning) - - Nb_aliquots <- previous.Nb_aliquots - - ##create results matrix - OUTPUT_results <- - matrix(nrow = Nb_aliquots, - ncol = (8 + 3 * max_cycles), - byrow = TRUE) - - ## set column name (this makes it much easier to debug) - colnames(OUTPUT_results) <- c( - "INDEX_BINfile", - "DISC", - "GRAIN", - "DE", - "DE.SD", - "D0", - "D0.SD", - "CYCLES_NB", - paste0("DOSE_", 1:max_cycles), - paste0("LxTx_", 1:max_cycles), - paste0("LxTx_", 1:max_cycles, ".SD") - - ) - - comptage <- 0 - for (k in 1:length(fileBIN.list)) { - - for (i in 1:length(Disc[[k]])) { - - disc_selected <- as.numeric(Disc[[k]][i]) - - if (Mono_grain == TRUE) { - grain_selected <- as.numeric(Grain[[k]][i]) - } else { - grain_selected <- 1 - } - comptage <- comptage + 1 - - OUTPUT_results[comptage, 1] <- k - - OUTPUT_results[comptage, 2] <- as.numeric(disc_selected) - if (Mono_grain == TRUE) { - OUTPUT_results[comptage, 3] <- grain_selected - } - else { - OUTPUT_results[comptage, 3] <- 0 - } - - if (length(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[6]]) != 0) { - - ##DE - OUTPUT_results[comptage, 4] <- - as.numeric(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[6]][1]) - - ##DE.SD - OUTPUT_results[comptage, 5] <- - as.numeric(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[6]][2]) - - ##D0 - OUTPUT_results[comptage, 6] <- - as.numeric(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[6]][3]) - - ##D0.SD - OUTPUT_results[comptage, 7] <- - as.numeric(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[6]][4]) - - ##CYCLES_NB - OUTPUT_results[comptage, 8] <- - length(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[2]]) - - ##auxillary variable - llong <- - length(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[2]]) - - ##Dose - OUTPUT_results[comptage, 9:(8 + llong)] <- - as.numeric(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[2]]) - - ##LxTx values - OUTPUT_results[comptage, (9 + max_cycles):(8 + max_cycles + llong)] <- - as.numeric(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[3]]) - - ##LxTx SD values - OUTPUT_results[comptage, (9 + 2*max_cycles):(8 + 2*max_cycles + llong)] <- - as.numeric(Disc_Grain.list[[k]][[disc_selected]][[grain_selected]][[4]]) - - } - - } - } - - - ##Clean matrix and remove all unwanted entries - - ##remove all NA columns, means all NA columns in POSITION and DISC - ##this NA values are no calculation artefacts, but coming from the data processing and have - ##no further value - OUTPUT_results <- OUTPUT_results[!is.na(OUTPUT_results[,2]),] - - ##clean up NaN values in the LxTx and corresponding error values - ##the transposition of the matrix may increase the performance for very large matrices - OUTPUT_results_reduced <- t(OUTPUT_results) - selection <- vapply(X = 1:ncol(OUTPUT_results_reduced), FUN = function(x){ - !any(is.nan(OUTPUT_results_reduced[9:(8+3*max_cycles), x]) | is.infinite(OUTPUT_results_reduced[9:(8+3*max_cycles), x])) - - }, FUN.VALUE = vector(mode = "logical", length = 1)) - - removed_aliquots <- t(OUTPUT_results_reduced[,!selection]) - OUTPUT_results_reduced <- t(OUTPUT_results_reduced[,selection]) - - ##finally, check for difference in the number of dose points ... they should be the same - if(length(unique(OUTPUT_results_reduced[,"CYCLES_NB"])) > 1){ - .throw_warning("The number of dose points differs across ", - "your data set. Check your data!") - } - - ##correct number of aliquots if necessary - if(Nb_aliquots > nrow(OUTPUT_results_reduced)) { - Nb_aliquots <- nrow(OUTPUT_results_reduced) - .throw_warning("'Nb_aliquots' corrected due to NaN or Inf values ", - "in Lx and/or Tx to ", Nb_aliquots, ". You might want ", - "to check 'removed_aliquots' in the function output.") - } - - ##Prepare for Bayesian analysis - Doses <- t(OUTPUT_results_reduced[,9:(8 + max_cycles)]) - LxTx <- t(OUTPUT_results_reduced[, (9 + max_cycles):(8 + 2 * max_cycles)]) - LxTx.error <- t(OUTPUT_results_reduced[, (9 + 2 * max_cycles):(8 + 3 * max_cycles)]) - - ##prepare data frame for output that can used as input - input_object <- data.frame( - BIN_FILE = unlist(object.file_name)[OUTPUT_results_reduced[[1]]], - OUTPUT_results_reduced[, -1], - stringsAsFactors = FALSE - ) - - - ##prepare data frame for output that shows rejected aliquots - if (length(removed_aliquots) > 0) { - removed_aliquots <- - as.data.frame(removed_aliquots, stringsAsFactors = FALSE) - removed_aliquots <- cbind(BIN_FILE = unlist(object.file_name)[removed_aliquots[[1]]], - removed_aliquots[, -1]) - - }else{ - removed_aliquots <- NULL - } - -} - - # Call baSAR-function ------------------------------------------------------------------------- - - ##check for the central_D bound settings - ##Why do we use 0 and 1000: Combes et al., 2015 wrote - ## that "We set the bounds for the prior on the central dose D, Dmin = 0 Gy and - ## Dmax = 1000 Gy, to cover the likely range of possible values for D. - - - ##check if something is set in method control, if not, set it - if (is.null(method_control[["upper_centralD"]])) { - method_control <- c(method_control, upper_centralD = 1000) - - }else{ - if(distribution == "normal" | distribution == "cauchy" | distribution == "log_normal"){ - .throw_warning("You have modified the upper central_D boundary ", - "while applying a predefined model. This is ", - "possible but not recommended!") - } - } - - ##we do the same for the lower_centralD, just to have everthing in one place - if (is.null(method_control[["lower_centralD"]])) { - method_control <- c(method_control, lower_centralD = 0) - - }else{ - if(distribution == "normal" | distribution == "cauchy" | distribution == "log_normal"){ - .throw_warning("You have modified the lower central_D boundary ", - "while applying a predefined model. This is ", - "possible but not recommended!") - } - } - - if(min(input_object[["DE"]][input_object[["DE"]] > 0], na.rm = TRUE) < method_control$lower_centralD | - max(input_object[["DE"]], na.rm = TRUE) > method_control$upper_centralD){ - .throw_warning("Your lower_centralD and/or upper_centralD values ", - "seem not to fit to your input data. This may indicate ", - "a wronlgy set 'source_doserate'.") - } - - ##>> try here is much better, as the user might run a very long preprocessing and do not - ##want to fail here - results <- - try(.baSAR_function( - Nb_aliquots = Nb_aliquots, - distribution = distribution, - data.Dose = Doses, - data.Lum = LxTx, - data.sLum = LxTx.error, - fit.method = fit.method, - n.MCMC = n.MCMC, - fit.force_through_origin = fit.force_through_origin, - fit.includingRepeatedRegPoints = fit.includingRepeatedRegPoints, - method_control = method_control, - baSAR_model = baSAR_model, - verbose = verbose - ), outFile = stdout()) # redirect error messages so they can be silenced - - ##check whether this became NULL - if(!is(results, "try-error")){ - - ##how do we add the systematic error? - ##(1) source_doserate is a list, not a vector, but the user can - ##provide many source dose rates and he can provide only a single vector (no error) - - if(!is.null(unlist(source_doserate)) || !is.null(function_arguments$source_doserate)){ - - ##if it comes from the previous call, it is, unfortunately not that simple - if(!is.null(function_arguments$source_doserate)){ - source_doserate <- eval(function_arguments$source_doserate) - - if(!is(source_doserate, "list")){ - source_doserate <- list(source_doserate) - - } - } - - systematic_error <- unlist(lapply(source_doserate, function(x){ - if(length(x) == 2) { - x[2] - } else{ - NULL - } - - })) - - }else{ - systematic_error <- 0 - } - - ##state are warning for very different errors - if(mean(systematic_error) != systematic_error[1]){ - .throw_warning("Provided source dose rate errors differ. The mean ", - "was taken, but the calculated systematic error ", - "might not be valid") - } - - ##add to the final de - DE_FINAL.ERROR <- sqrt(results[[1]][["CENTRAL.SD"]]^2 + mean(systematic_error)^2) - - ##consider the case that we get NA and this might be confusing - if(is.na(DE_FINAL.ERROR)){ - DE_FINAL.ERROR <- results[[1]][["CENTRAL.SD"]] - } - - ##combine - results[[1]] <- cbind(results[[1]], DE_FINAL = results[[1]][["CENTRAL"]], DE_FINAL.ERROR = DE_FINAL.ERROR) - - }else{ - results <- NULL - verbose <- FALSE - plot <- FALSE - } - - # Terminal output ----------------------------------------------------------------------------- - if(verbose){ - cat("++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n\n") - cat("\n[analyse_baSAR()] ---- RESULTS ---- \n") - cat("------------------------------------------------------------------\n") - cat(paste0("Used distribution:\t\t", results[[1]][["DISTRIBUTION"]],"\n")) - if(!is.null(removed_aliquots)){ - if(!is.null(aliquot_range)){ - cat(paste0("Number of aliquots used:\t", results[[1]][["NB_ALIQUOTS"]],"/", - results[[1]][["NB_ALIQUOTS"]] + nrow(removed_aliquots), - " (manually removed: " ,length(aliquot_range),")\n")) - - }else{ - cat(paste0("Number of aliquots used:\t", results[[1]][["NB_ALIQUOTS"]],"/", - results[[1]][["NB_ALIQUOTS"]] + nrow(removed_aliquots),"\n")) - } - - }else{ - cat(paste0("Number of aliquots used:\t", results[[1]][["NB_ALIQUOTS"]],"/", results[[1]][["NB_ALIQUOTS"]],"\n")) - - } - - if(!is.null(baSAR_model)){ - cat(paste0("Considered fitting method:\t", results[[1]][["FIT_METHOD"]]," (user defined)\n")) - }else{ - cat(paste0("Considered fitting method:\t", results[[1]][["FIT_METHOD"]],"\n")) - } - cat(paste0("Number of independent chains:\t", results[[1]][["N.CHAINS"]],"\n")) - cat(paste0("Number MCMC iterations/chain:\t", results[[1]][["N.MCMC"]],"\n")) - - cat("------------------------------------------------------------------\n") - if(distribution == "log_normal"){ - cat("\t\t\t\tmean*\tsd\tHPD\n") - - }else{ - cat("\t\t\t\tmean\tsd\tHPD\n") - - } - - - cat(paste0(">> Central dose:\t\t", results[[1]][["CENTRAL"]],"\t", - results[[1]][["CENTRAL.SD"]],"\t", - "[", results[[1]][["CENTRAL_Q_.16"]]," ; ", results[[1]][["CENTRAL_Q_.84"]], "]**\t")) - cat(paste0("\n\t\t\t\t\t\t[", results[[1]][["CENTRAL_Q_.025"]]," ; ", results[[1]][["CENTRAL_Q_.975"]],"]***")) - - cat(paste0("\n>> sigma_D:\t\t\t", results[[1]][["SIGMA"]],"\t", results[[1]][["SIGMA.SD"]], "\t", - "[",results[[1]][["SIGMA_Q_.16"]]," ; ", results[[1]][["SIGMA_Q_.84"]], "]**\t")) - cat(paste0("\n\t\t\t\t\t\t[",results[[1]][["SIGMA_Q_.025"]]," ; ", results[[1]][["SIGMA_Q_.975"]], "]***")) - cat(paste0("\n>> Final central De:\t\t", results[[1]][["DE_FINAL"]],"\t", round(results[[1]][["DE_FINAL.ERROR"]], digits = digits), "\t", - " - \t -")) - cat("\n------------------------------------------------------------------\n") - cat( - paste("(systematic error contribution to final De:", - format((1-results[[1]][["CENTRAL.SD"]]/results[[1]][["DE_FINAL.ERROR"]])*100, scientific = TRUE), "%)\n") - ) - if(distribution == "log_normal"){ - cat("* mean of the central dose is the geometric mean\n") - } - cat("** 68 % level | *** 95 % level\n") - - } - - - # Plotting ------------------------------------------------------------------------------------ - if(plot){ - - ##get colours from the package Luminescence - col <- get("col", pos = .LuminescenceEnv) - - ##get list of variable names (we need them later) - varnames <- coda::varnames(results[[2]]) - - ##//////////////////////////////////////////////////////////////////////////////////////////// - ##TRACE AND DENSITY PLOT - ####////////////////////////////////////////////////////////////////////////////////////////// - if(plot_reduced){ - plot_check <- try(plot(results[[2]][,c("central_D","sigma_D"),drop = FALSE]), silent = TRUE) - - ##show error - if(is(plot_check, "try-error")){ - .throw_error("Plots for 'central_D' and 'sigma_D' could not be ", - "produced. You are probably monitoring the wrong variables") - } - - }else{ - try(plot(results[[2]])) - - } - - - - ##//////////////////////////////////////////////////////////////////////////////////////////// - ##TRUE DOSE PLOT AND DECISION MAKER - ####////////////////////////////////////////////////////////////////////////////////////////// - if (!plot.single) { - par(mfrow = c(2, 2)) - } - - ##get list with D values - ##get list out of it - plot_matrix <- as.matrix(results[[2]][,grep(x = varnames, pattern = "D[", fixed = TRUE)]) - - aliquot_quantiles <- t(matrixStats::colQuantiles(x = plot_matrix, probs = c(0.25,0.75))) - - ##define boxplot colours ... we have red and orange - box.col <- vapply(1:ncol(aliquot_quantiles), function(x){ - if(aliquot_quantiles[2,x] < results[[1]][,c("CENTRAL_Q_.025")] | - aliquot_quantiles[1,x] > results[[1]][,c("CENTRAL_Q_.975")] - ){ - col[2] - }else if(aliquot_quantiles[2,x] < results[[1]][,c("CENTRAL_Q_.16")] | - aliquot_quantiles[1,x] > results[[1]][,c("CENTRAL_Q_.84")]){ - - "orange" - }else{ - "white" - } - - }, FUN.VALUE = vector(mode = "character", length = 1)) - - ## to assure a minimum of quality not more then 15 boxes are plotted in each plot - i <- 1 - - while(i < ncol(plot_matrix)){ - - step <- if((i + 14) > ncol(plot_matrix)){ncol(plot_matrix)}else{i + 14} - - plot_check <- try(boxplot( - x = plot_matrix[,i:step], - use.cols = TRUE, - horizontal = TRUE, - outline = TRUE, - col = box.col[i:step], - xlab = if(is.null(unlist(source_doserate))){"Dose [s]"}else{"Dose [Gy]"}, - ylab = "Aliquot index", - yaxt = "n", - xlim = c(1,19), - main = paste0("Individual Doses | ALQ: ", i,":",step) - )) - - if(!is(plot_check, "try-error")){ - if(step == ncol(plot_matrix)){ - axis(side = 2, at = 1:15, labels = as.character(c(i:step, rep(" ", length = 15 - length(i:step)))), - cex.axis = 0.8 - ) - - }else{ - axis(side = 2, at = 1:15, labels = as.character(i:step), cex.axis = 0.8) - } - - ##add HPD with text - ##HPD - 68% - lines( - x = c( - results[[1]][, c("CENTRAL_Q_.16")], results[[1]][, c("CENTRAL_Q_.16")], - results[[1]][, c("CENTRAL_Q_.84")], results[[1]][, c("CENTRAL_Q_.84")]), - y = c(par()$usr[3], 16, 16, par()$usr[3]), - lty = 3, - col = col[3], - lwd = 1.5 - ) - text( - x = results[[1]][, c("CENTRAL")], - y = 16, - labels = "68 %", - pos = 3, - col = col[3], - cex = 0.9 * par()$cex - ) - - ##HPD - 98 %% - lines( - x = c( - results[[1]][, c("CENTRAL_Q_.025")], results[[1]][, c("CENTRAL_Q_.025")], - results[[1]][, c("CENTRAL_Q_.975")], results[[1]][, c("CENTRAL_Q_.975")]), - y = c(par()$usr[3], 17.5, 17.5, par()$usr[3]), - lty = 3, - col = col[2], - lwd = 1.5 - ) - - text( - x = results[[1]][, c("CENTRAL")], - y = 17.5, - labels = "95 %", - pos = 3, - col = col[2], - cex = 0.9 * par()$cex) - - } - ##update counter - i <- i + 15 - - - } - rm(plot_matrix) - - if(!plot.single){ - par(mfrow = c(1,2)) - on.exit(par(mfrow = c(1,1), bg = "white", xpd = FALSE)) - } - ##//////////////////////////////////////////////////////////////////////////////////////////// - ##DOSE RESPONSE CURVES AND Lx/Tx VALUES - ####////////////////////////////////////////////////////////////////////////////////////////// - - ##define selection vector - selection <- c("a[", "b[", "c[", "g[", "Q[1,") - - ##get list out of it - list_selection <- lapply(X = selection, FUN = function(x){ - unlist(results[[2]][,grep(x = varnames, pattern = x, fixed = TRUE)]) - - }) - - ##create matrix - plot_matrix <- t(do.call(what = "cbind", args = list_selection)) - - ##free memory - rm(list_selection) - - - ##make selection according to the model for the curve plotting - if (fit.method == "EXP") {ExpoGC <- 1 ; LinGC <- 0 } - if (fit.method == "LIN") {ExpoGC <- 0 ; LinGC <- 1 } - if (fit.method == "EXP+LIN") {ExpoGC <- 1 ; LinGC <- 1 } - if (fit.force_through_origin) {GC_Origin <- 0} else {GC_Origin <- 1} - - ##add choise for own provided model - if(!is.null(baSAR_model)){ - fit.method_plot <- paste(fit.method, "(user defined)") - - }else{ - fit.method_plot <- fit.method - } - - ##open plot area - ##for the xlim and ylim we have to identify the proper ranges based on the input - xlim <- c(0, max(input_object[,grep(x = colnames(input_object), pattern = "DOSE")], na.rm = TRUE)*1.1) - ylim <- c( - min(input_object[,grep(x = colnames(input_object), pattern = "LxTx")], na.rm = TRUE), - max(input_object[,grep(x = colnames(input_object), pattern = "LxTx")], na.rm = TRUE)*1.1) - - ##check for position of the legend ... we can do better - if(results[[1]][["CENTRAL_Q_.975"]] < max(xlim)/2){ - legend_pos <- "topright" - - }else{ - legend_pos <- "topleft" - - } - - ##set plot area - plot_check <- try(plot( - NA, - NA, - ylim = ylim, - xlim = xlim, - ylab = expression(paste(L[x] / T[x])), - xlab = if(is.null(unlist(source_doserate))){"Dose [s]"}else{"Dose [Gy]"}, - main = "baSAR Dose Response Curves" - )) - - - if (!is(plot_check, "try-error")) { - ##add mtext - mtext(side = 3, text = paste("Fit:", fit.method_plot)) - - ##check whether we have all data we need (might be not the case of the user - ##selects own variables) - if (ncol(plot_matrix) != 0) { - ##plot individual dose response curves - x <- NA - for (i in seq(1, ncol(plot_matrix), length.out = 1000)) { - curve( - GC_Origin * plot_matrix[4, i] + LinGC * (plot_matrix[3, i] * x) + - ExpoGC * (plot_matrix[1, i] * (1 - exp ( - -x / plot_matrix[2, i] - ))), - add = TRUE, - col = rgb(0, 0, 0, .1) - ) - - } - }else{ - message("[analyse_baSAR()] Error: Wrong 'variable.names' ", - "monitored, dose responses curves could not be plotted") - } - - ##add dose points - n.col <- - length(input_object[, grep(x = colnames(input_object), pattern = "DOSE")]) - - ##add rug with natural Lx/Tx - rug(side = 2, x = input_object[[9 + n.col]]) - - ##plot Lx/Tx values .. without errors ... this is enough here - for (i in 2:length(input_object[, grep(x = colnames(input_object), pattern = "DOSE")])) { - ##add error bars - segments( - x0 = input_object[[8 + i]], - x1 = input_object[[8 + i]], - y0 = input_object[[8 + n.col + i]] - input_object[[8 + 2 * n.col + i]], - y1 = input_object[[8 + n.col + i]] + input_object[[8 + 2 * n.col + i]], - col = "grey" - ) - - ##add points in the top of it - points( - x = input_object[[8 + i]], - y = input_object[[8 + n.col + i]], - pch = 21, - col = col[11], - bg = "grey" - ) - } - - ##add ablines - abline( - v = results[[1]][, c("CENTRAL_Q_.16", "CENTRAL_Q_.84")], - lty = 3, - col = col[3], - lwd = 1.2 - ) - abline(v = results[[1]][, c("CENTRAL_Q_.025", "CENTRAL_Q_.975")], lty = 2, col = col[2]) - - ##add legend1 - legend( - legend_pos, - bty = "n", - horiz = FALSE, - lty = c(3, 2), - col = c(col[3], col[2]), - legend = c("HPD - 68 %", "HPD - 95 %") - ) - - ##add legend2 - legend( - "bottomright", - bty = "n", - horiz = FALSE, - pch = 21, - col = col[11], - bg = "grey", - legend = "measured dose points" - ) - - } - ##remove object, it might be rather big - rm(plot_matrix) - - ##03 Abanico Plot - if(distribution_plot == "abanico"){ - plot_check <- plot_AbanicoPlot( - data = input_object[, c("DE", "DE.SD")], - zlab = if(is.null(unlist(source_doserate))){expression(paste(D[e], " [s]"))}else{expression(paste(D[e], " [Gy]"))}, - log.z = if (distribution != "log_normal") { - FALSE - } else{ - TRUE - }, - z.0 = results[[1]]$CENTRAL, - y.axis = FALSE, - polygon.col = FALSE, - line = results[[1]][,c( - "CENTRAL_Q_.16", "CENTRAL_Q_.84", "CENTRAL_Q_.025", "CENTRAL_Q_.975")], - line.col = c(col[3], col[3], col[2], col[2]), - line.lty = c(3,3,2,2), - output = TRUE, - mtext = paste0( - nrow(input_object) - length(which(is.na(input_object[, c("DE", "DE.SD")]))), - "/", - nrow(input_object), - " plotted (removed are NA values)" - ) - ) - - if (!is.null(plot_check)) { - legend( - "topleft", - legend = c("Central dose", "HPD - 68%", "HPD - 95 %"), - lty = c(2, 3, 2), - col = c("black", col[3], col[2]), - bty = "n", - cex = par()$cex * 0.8 - ) - - } - }else{ - plot_check <- NULL - - } - - ##In case the Abanico plot will not work because of negative values - ##provide a KDE - if(is.null(plot_check) && distribution_plot == "kde"){ - plot_check <- try(suppressWarnings(plot_KDE( - data = input_object[, c("DE", "DE.SD")], - xlab = if(is.null(unlist(source_doserate))){expression(paste(D[e], " [s]"))}else{expression(paste(D[e], " [Gy]"))}, - mtext = paste0( - nrow(input_object) - length(which(is.na(input_object[, c("DE", "DE.SD")]))), - "/", - nrow(input_object), - " (removed are NA values)" - ) - ))) - - if(!is(plot_check, "try-error")) { - abline(v = results[[1]]$CENTRAL, lty = 2) - abline( - v = results[[1]][, c("CENTRAL_Q_.16", "CENTRAL_Q_.84")], - lty = 3, - col = col[3], - lwd = 1.2 - ) - abline(v = results[[1]][, c("CENTRAL_Q_.025", "CENTRAL_Q_.975")], lty = 2, col = col[2]) - - ##check for position of the legend - if(results[[1]][["CENTRAL_Q_.975"]] < max(xlim)/2){ - legend_pos <- "right" - - }else{ - legend_pos <- "topleft" - - } - - legend( - legend_pos, - legend = c("Central dose", "HPD - 68%", "HPD - 95 %"), - lty = c(2, 3, 2), - col = c("black", col[3], col[2]), - bty = "n", - cex = par()$cex * 0.8 - - ) - - } - - } - - } - - # Return -------------------------------------------------------------------------------------- - return(set_RLum( - class = "RLum.Results", - data = list( - summary = results[[1]], - mcmc = results[[2]], - models = results[[3]], - input_object = input_object, - removed_aliquots = removed_aliquots - ), - info = list(call = sys.call()) - )) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_pIRIRSequence.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_pIRIRSequence.R deleted file mode 100644 index 9a93a2d4b..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_pIRIRSequence.R +++ /dev/null @@ -1,880 +0,0 @@ -#' @title Analyse post-IR IRSL measurement sequences -#' -#' @description The function performs an analysis of post-IR IRSL sequences -#' including curve -#' fitting on [RLum.Analysis-class] objects. -#' -#' @details To allow post-IR IRSL protocol (Thomsen et al., 2008) measurement analyses -#' this function has been written as extended wrapper function for the function -#' [analyse_SAR.CWOSL], facilitating an entire sequence analysis in -#' one run. With this, its functionality is strictly limited by the -#' functionality of the function [analyse_SAR.CWOSL]. -#' -#' **Defining the sequence structure** -#' -#' The argument `sequence.structure` expects a shortened pattern of your sequence structure and was -#' mainly introduced to ease the use of the function. For example: If your measurement data contains -#' the following curves: `TL`, `IRSL`, `IRSL`, `TL`, `IRSL`, `IRSL`, the sequence pattern in `sequence.structure` -#' becomes `c('TL', 'IRSL', 'IRSL')`. The second part of your sequence for one cycle should be -#' similar and can be discarded. If this is not the case (e.g., additional hotbleach) such curves -#' have to be removed before using the function. -#' -#' **If the input is a `list`** -#' -#' If the input is a list of RLum.Analysis-objects, every argument can be provided as list to allow -#' for different sets of parameters for every single input element. -#' For further information see [analyse_SAR.CWOSL]. -#' -#' @param object [RLum.Analysis-class] or [list] of [RLum.Analysis-class] objects (**required**): -#' input object containing data for analysis. -#' If a [list] is provided the functions tries to iterate over the list. -#' -#' @param signal.integral.min [integer] (**required**): -#' lower bound of the signal integral. Provide this value as vector for different -#' integration limits for the different IRSL curves. -#' -#' @param signal.integral.max [integer] (**required**): -#' upper bound of the signal integral. Provide this value as vector for different -#' integration limits for the different IRSL curves. -#' -#' @param background.integral.min [integer] (**required**): -#' lower bound of the background integral. Provide this value as vector for -#' different integration limits for the different IRSL curves. -#' -#' @param background.integral.max [integer] (**required**): -#' upper bound of the background integral. Provide this value as vector for -#' different integration limits for the different IRSL curves. -#' -#' @param dose.points [numeric] (*optional*): -#' a numeric vector containing the dose points values. Using this argument overwrites dose point -#' values in the signal curves. -#' -#' @param sequence.structure [vector] [character] (*with default*): -#' specifies the general sequence structure. Allowed values are `"TL"` and -#' any `"IR"` combination (e.g., `"IR50"`,`"pIRIR225"`). -#' Additionally a parameter `"EXCLUDE"` is allowed to exclude curves from -#' the analysis (Note: If a preheat without PMT measurement is used, i.e. -#' preheat as none TL, remove the TL step.) -#' -#' @param plot [logical] (*with default*): -#' enables or disables plot output. -#' -#' @param plot.single [logical] (*with default*): -#' single plot output (`TRUE/FALSE`) to allow for plotting the results in single plot -#' windows. Requires `plot = TRUE`. -#' -#' @param ... further arguments that will be passed to the function -#' [analyse_SAR.CWOSL] and [plot_GrowthCurve]. Furthermore, the arguments `main` (headers), `log` (IRSL curves), `cex` (control -#' the size) and `mtext.outer` (additional text on the plot area) can be passed to influence the plotting. If the input -#' is list, `main` can be passed as [vector] or [list]. -#' -#' @return -#' Plots (*optional*) and an [RLum.Results-class] object is -#' returned containing the following elements: -#' -#' \tabular{lll}{ -#' **DATA.OBJECT** \tab **TYPE** \tab **DESCRIPTION** \cr -#' `..$data` : \tab `data.frame` \tab Table with De values \cr -#' `..$LnLxTnTx.table` : \tab `data.frame` \tab with the `LnLxTnTx` values \cr -#' `..$rejection.criteria` : \tab [data.frame] \tab rejection criteria \cr -#' `..$Formula` : \tab [list] \tab Function used for fitting of the dose response curve \cr -#' `..$call` : \tab [call] \tab the original function call -#' } -#' -#' The output should be accessed using the function [get_RLum]. -#' -#' @note -#' Best graphical output can be achieved by using the function `pdf` -#' with the following options: -#' -#' `pdf(file = "", height = 15, width = 15)` -#' -#' @section Function version: 0.2.4 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [analyse_SAR.CWOSL], [calc_OSLLxTxRatio], [plot_GrowthCurve], -#' [RLum.Analysis-class], [RLum.Results-class] [get_RLum] -#' -#' @references -#' Murray, A.S., Wintle, A.G., 2000. Luminescence dating of quartz -#' using an improved single-aliquot regenerative-dose protocol. Radiation -#' Measurements 32, 57-73. \doi{10.1016/S1350-4487(99)00253-X} -#' -#' Thomsen, K.J., Murray, A.S., Jain, M., Boetter-Jensen, L., 2008. Laboratory -#' fading rates of various luminescence signals from feldspar-rich sediment -#' extracts. Radiation Measurements 43, 1474-1486. -#' \doi{10.1016/j.radmeas.2008.06.002} -#' -#' @keywords datagen plot -#' -#' @examples -#' -#' -#' ### NOTE: For this example existing example data are used. These data are non pIRIR data. -#' ### -#' ##(1) Compile example data set based on existing example data (SAR quartz measurement) -#' ##(a) Load example data -#' data(ExampleData.BINfileData, envir = environment()) -#' -#' ##(b) Transform the values from the first position in a RLum.Analysis object -#' object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) -#' -#' ##(c) Grep curves and exclude the last two (one TL and one IRSL) -#' object <- get_RLum(object, record.id = c(-29,-30)) -#' -#' ##(d) Define new sequence structure and set new RLum.Analysis object -#' sequence.structure <- c(1,2,2,3,4,4) -#' sequence.structure <- as.vector(sapply(seq(0,length(object)-1,by = 4), -#' function(x){sequence.structure + x})) -#' -#' object <- sapply(1:length(sequence.structure), function(x){ -#' -#' object[[sequence.structure[x]]] -#' -#' }) -#' -#' object <- set_RLum(class = "RLum.Analysis", records = object, protocol = "pIRIR") -#' -#' ##(2) Perform pIRIR analysis (for this example with quartz OSL data!) -#' ## Note: output as single plots to avoid problems with this example -#' results <- analyse_pIRIRSequence(object, -#' signal.integral.min = 1, -#' signal.integral.max = 2, -#' background.integral.min = 900, -#' background.integral.max = 1000, -#' fit.method = "EXP", -#' sequence.structure = c("TL", "pseudoIRSL1", "pseudoIRSL2"), -#' main = "Pseudo pIRIR data set based on quartz OSL", -#' plot.single = TRUE) -#' -#' -#' ##(3) Perform pIRIR analysis (for this example with quartz OSL data!) -#' ## Alternative for PDF output, uncomment and complete for usage -#' \dontrun{ -#' tempfile <- tempfile(fileext = ".pdf") -#' pdf(file = tempfile, height = 15, width = 15) -#' results <- analyse_pIRIRSequence(object, -#' signal.integral.min = 1, -#' signal.integral.max = 2, -#' background.integral.min = 900, -#' background.integral.max = 1000, -#' fit.method = "EXP", -#' main = "Pseudo pIRIR data set based on quartz OSL") -#' -#' dev.off() -#' } -#' -#' @md -#' @export -analyse_pIRIRSequence <- function( - object, - signal.integral.min, - signal.integral.max, - background.integral.min, - background.integral.max, - dose.points = NULL, - sequence.structure = c("TL", "IR50", "pIRIR225"), - plot = TRUE, - plot.single = FALSE, - ... -){ - - if (missing("object")) { - stop("[analyse_pIRIRSequence()] No value set for 'object'!") - } - -# SELF CALL ----------------------------------------------------------------------------------- - if(is.list(object)){ - - ##make live easy - if(missing("signal.integral.min")){ - signal.integral.min <- 1 - warning("[analyse_pIRIRSequence()] 'signal.integral.min' missing, set to 1", call. = FALSE) - } - - if(missing("signal.integral.max")){ - signal.integral.max <- 2 - warning("[analyse_pIRIRSequence()] 'signal.integral.max' missing, set to 2", call. = FALSE) - } - - - ##now we have to extend everything to allow list of arguments ... this is just consequent - signal.integral.min <- rep(list(signal.integral.min), length = length(object)) - signal.integral.max <- rep(list(signal.integral.max), length = length(object)) - background.integral.min <- rep(list(background.integral.min), length = length(object)) - background.integral.max <- rep(list(background.integral.max), length = length(object)) - sequence.structure <- rep(list(sequence.structure), length = length(object)) - - if(!is.null(dose.points)){ - - if(is(dose.points, "list")){ - dose.points <- rep(dose.points, length = length(object)) - - }else{ - dose.points <- rep(list(dose.points), length = length(object)) - - } - - }else{ - dose.points <- rep(list(NULL), length(object)) - - } - - ##main - if("main" %in% names(list(...))){ - main_list <- rep(list(...)$main, length.out = length(object)) - - if(!inherits(main_list, "list")){ - main_list <- as.list(main_list) - - } - - } - - ##run analysis - temp <- lapply(1:length(object), function(x){ - - analyse_pIRIRSequence(object[[x]], - signal.integral.min = signal.integral.min[[x]], - signal.integral.max = signal.integral.max[[x]], - background.integral.min = background.integral.min[[x]], - background.integral.max = background.integral.max[[x]] , - dose.points = dose.points[[x]], - sequence.structure = sequence.structure[[x]], - plot = plot, - plot.single = plot.single, - main = ifelse("main"%in% names(list(...)), main_list[[x]], paste0("ALQ #",x)), - ...) - - }) - - ##combine everything to one RLum.Results object as this as what was written ... only - ##one object - - ##merge results and check if the output became NULL - results <- merge_RLum(temp) - - ##DO NOT use invisible here, this will stop the function from stopping - if(length(results) == 0){ - return(NULL) - - }else{ - return(results) - - } - - } - - -# General Integrity Checks --------------------------------------------------- - - ##GENERAL - - ##INPUT OBJECTS - if(is(object, "RLum.Analysis")==FALSE){ - stop("[analyse_pIRIRSequence()] Input object is not of type 'RLum.Analyis'!", - call. = FALSE) - } - - ##CHECK ALLOWED VALUES IN SEQUENCE STRUCTURE - temp.collect.invalid.terms <- paste(sequence.structure[ - (!grepl("TL",sequence.structure)) & - (!grepl("IR",sequence.structure)) & - (!grepl("OSL",sequence.structure)) & - (!grepl("EXCLUDE",sequence.structure))], - collapse = ", ") - - if(temp.collect.invalid.terms != ""){ - stop("[analyse_pIRIRSequence()] ", - temp.collect.invalid.terms, " not allowed in 'sequence.structure'!") - } - - -# Deal with extra arguments ------------------------------------------------------------------- - - ## default values - mtext.outer <- "MEASUREMENT INFO" - main <- "" - log <- "" - cex <- 0.7 - - ##deal with addition arguments - extraArgs <- list(...) - mtext.outer <- if ("mtext.outer" %in% names(extraArgs)) extraArgs$mtext.outer - main <- if ("main" %in% names(extraArgs)) extraArgs$main - log <- if ("log" %in% names(extraArgs)) extraArgs$log - cex <- if ("cex" %in% names(extraArgs)) extraArgs$cex - - -# Protocol Integrity Checks -------------------------------------------------- - - ##(1) Check structure and remove curves that fit not the recordType criteria - - ##get sequence structure - temp.sequence.structure <- structure_RLum(object) - - ##remove data types that fit not to the allowed values - temp.sequence.rm.id <- temp.sequence.structure[ - (!grepl("TL",temp.sequence.structure[["recordType"]])) & - (!grepl("OSL", temp.sequence.structure[["recordType"]])) & - (!grepl("IRSL", temp.sequence.structure[["recordType"]])) - ,"id"] - - if(length(temp.sequence.rm.id)>0){ - - ##removed record from data set - object <- get_RLum(object, record.id = -temp.sequence.rm.id, - drop = FALSE - ) - - ##compile warning message - temp.sequence.rm.warning <- paste( - temp.sequence.structure[temp.sequence.rm.id, "recordType"], collapse = ", ") - - temp.sequence.rm.warning <- paste( - "Record types are unrecognised and have been removed:", temp.sequence.rm.warning) - - warning(temp.sequence.rm.warning, call. = FALSE) - } - - ##(2) Apply user sequence structure - - ##get sequence structure - temp.sequence.structure <- structure_RLum(object) - - ##try to account for a very common mistake - if(any(grepl(sequence.structure, pattern = "TL", fixed = TRUE)) && !any(grepl(temp.sequence.structure[["recordType"]], pattern = "TL", fixed = TRUE))){ - warning("[analyse_pIRIRSequence()] Your sequence does not contain 'TL' curves, trying to adapt 'sequence.structure' for you ...", - call. = FALSE, immediate. = TRUE) - sequence.structure <- sequence.structure[!grepl(sequence.structure, pattern = "TL", fixed = TRUE)] - } - - ##set values to structure data.frame - ##but check first - if(2 * length( - rep(sequence.structure, nrow(temp.sequence.structure)/2/length(sequence.structure))) == length(temp.sequence.structure[["protocol.step"]])){ - temp.sequence.structure[["protocol.step"]] <- rep( - sequence.structure, nrow(temp.sequence.structure)/2/length(sequence.structure)) - - }else{ - try(stop("[analyse_pIRIRSequence()] Number of records is not a multiple of the defined sequence structure! NULL returned!", call. = FALSE)) - return(NULL) - - } - - ##remove values that have been excluded - temp.sequence.rm.id <- temp.sequence.structure[ - temp.sequence.structure[,"protocol.step"] == "EXCLUDE" ,"id"] - - if(length(temp.sequence.rm.id)>0){ - - ##remove from object - object <- get_RLum( - object, record.id = -temp.sequence.rm.id, drop = FALSE) - - ##remove from sequence structure - sequence.structure <- sequence.structure[sequence.structure != "EXCLUDE"] - - ##set new structure - temp.sequence.structure <- structure_RLum(object) - - temp.sequence.structure[, "protocol.step"] <- rep( - sequence.structure, nrow(temp.sequence.structure)/2/length(temp.sequence.structure)) - - ##print warning message - warning("[analyse_pIRIRSequence()] ", length(temp.sequence.rm.id), " records have been removed due to EXCLUDE!", call. = FALSE) - - } - -##============================================================================## -# Analyse data and plotting ---------------------------------------------------- -##============================================================================## - - ##(1) find out how many runs are needed for the analysis by checking for "IR" - ## now should by every signal except the TL curves - n.TL<- table(grepl("TL", sequence.structure))["TRUE"] - if(is.na(n.TL)) {n.TL<- 0} - n.loops <- as.numeric(length(grepl("TL", sequence.structure)) - n.TL) - - ##grep ids of TL curves (we need them later on) - TL.curves.id <- temp.sequence.structure[ - temp.sequence.structure[,"protocol.step"] == "TL","id"] - - ##grep ids of all OSL curves (we need them later on) - IRSL.curves.id <- temp.sequence.structure[ - grepl("IR", temp.sequence.structure[,"protocol.step"]),"id"] - - ##grep information on the names of the IR curves, we need them later on - pIRIR.curve.names <- unique(temp.sequence.structure[ - temp.sequence.structure[IRSL.curves.id,"id"],"protocol.step"]) - - ##===========================================================================# - ## set graphic layout using the layout option - ## unfortunately a little bit more complicated then expected previously due - ## the order of the produced plots by the previous functions - - if(plot.single == FALSE & plot == TRUE){ - - ##first (Tx,Tn, Lx,Ln) - temp.IRSL.layout.vector.first <- c(3,5,6,7,3,5,6,8) - - ##middle (any other Lx,Ln) - if(n.loops > 2){ - temp.IRSL.layout.vector.middle <- - vapply( - 2:(n.loops - 1), - FUN = function(x) { - - offset <- 5 * x - 1 - c((offset):(offset + 3), - (offset):(offset + 2), offset + 4) - - }, - FUN.VALUE = vector(mode = "numeric", length = 8) - ) - } - - ##last (Lx,Ln and legend) - temp.IRSL.layout.vector.last <- c( - ifelse(n.loops > 2,max(temp.IRSL.layout.vector.middle) + 1, - max(temp.IRSL.layout.vector.first) + 1), - ifelse(n.loops > 2,max(temp.IRSL.layout.vector.middle) + 2, - max(temp.IRSL.layout.vector.first) + 2), - ifelse(n.loops > 2,max(temp.IRSL.layout.vector.middle) + 4, - max(temp.IRSL.layout.vector.first) + 4), - ifelse(n.loops > 2,max(temp.IRSL.layout.vector.middle) + 5, - max(temp.IRSL.layout.vector.first) + 5), - ifelse(n.loops > 2,max(temp.IRSL.layout.vector.middle) + 1, - max(temp.IRSL.layout.vector.first) + 1), - ifelse(n.loops > 2,max(temp.IRSL.layout.vector.middle) + 2, - max(temp.IRSL.layout.vector.first) + 2), - ifelse(n.loops > 2,max(temp.IRSL.layout.vector.middle) + 4, - max(temp.IRSL.layout.vector.first) + 4), - ifelse(n.loops > 2,max(temp.IRSL.layout.vector.middle) + 6, - max(temp.IRSL.layout.vector.first) + 6)) - - ##options for different sets of curves - if(n.loops > 2){ - - temp.IRSL.layout.vector <- c(temp.IRSL.layout.vector.first, - temp.IRSL.layout.vector.middle, - temp.IRSL.layout.vector.last) - - }else{ - - temp.IRSL.layout.vector <- c(temp.IRSL.layout.vector.first, - temp.IRSL.layout.vector.last) - - } - - ##get layout information - def.par <- par(no.readonly = TRUE) - - ##set up layout matrix linked to the number of plot areas needed - layout.matrix <- c( - rep(c(2,4,1,1),2), #header row with TL curves and info window - temp.IRSL.layout.vector, #IRSL curves, - rep((max(temp.IRSL.layout.vector)-3),8), #legend, - rep((max(temp.IRSL.layout.vector)+1),1), #GC - rep((max(temp.IRSL.layout.vector)+2),1), #TnTc - rep((max(temp.IRSL.layout.vector)+3),2), #Rejection criteria - rep((max(temp.IRSL.layout.vector)+1),1), #GC - rep((max(temp.IRSL.layout.vector)+2),1), #TnTc - rep((max(temp.IRSL.layout.vector)+3),2)) #Rejection criteria - - - ##set layout - nf <- layout( - matrix(layout.matrix,(max(layout.matrix)/2 + - ifelse(n.loops > 2, 0,2)), 4, byrow = TRUE), - widths = c(rep(c(1,1,1,.75),6),c(1,1,1,1)), - heights = c(rep(c(1),(2+2*n.loops)),c(0.20, 0.20))) - - ## show the regions that have been allocated to each plot for debug - #layout.show(nf) - - } - - ##(1) INFO PLOT - if (plot) { - plot(NA,NA, - ylim = c(0,1), xlab = "", - xlim = c(0,1), ylab = "", - axes = FALSE, - main = main) - - text(0.5,0.5, paste(sequence.structure, collapse = "\n"), cex = cex *2) - } - - - ##(2) set loop - for(i in 1:n.loops){ - - ##compile record ids - temp.id.sel <- - sort(c(TL.curves.id, IRSL.curves.id[seq(i,length(IRSL.curves.id),by=n.loops)])) - - ##(a) select data set (TL curves has to be considered for the data set) - temp.curves <- get_RLum(object, record.id = temp.id.sel, drop = FALSE) - - ##(b) grep integral limits as they might be different for different curves - if(length(signal.integral.min)>1){ - - temp.signal.integral.min <- signal.integral.min[i] - temp.signal.integral.max <- signal.integral.max[i] - temp.background.integral.min <- background.integral.min[i] - temp.background.integral.max <- background.integral.max[i] - - }else{ - - temp.signal.integral.min <- signal.integral.min - temp.signal.integral.max <- signal.integral.max - temp.background.integral.min <- background.integral.min - temp.background.integral.max <- background.integral.max - - } - - ##(c) call analysis sequence and plot - - ## call single plots - if(i == 1){ - temp.plot.single <- c(1,2,3,4,6) - - }else if(i == n.loops){ - temp.plot.single <- c(2,4,5,6) - - }else{ - temp.plot.single <- c(2,4,6) - - } - - ##start analysis - temp.results <- analyse_SAR.CWOSL( - temp.curves, - signal.integral.min = temp.signal.integral.min, - signal.integral.max = temp.signal.integral.max, - background.integral.min = temp.background.integral.min, - background.integral.max = temp.background.integral.max, - plot = plot, - dose.points = dose.points, - plot.single = temp.plot.single, - output.plotExtended.single = TRUE, - cex.global = cex, - ... - ) ##TODO should be replaced be useful explicit arguments - - ##check whether NULL was return - if (is.null(temp.results)) { - message("[plot_pIRIRSequence()] An error occurred, analysis skipped. Check your sequence!") - return(NULL) - } - - ##add signal information to the protocol step - temp.results.pIRIR.De <- as.data.frame(c( - get_RLum(temp.results, "data"), - data.frame(Signal = pIRIR.curve.names[i]) - )) - - temp.results.pIRIR.LnLxTnTx <- as.data.frame(c( - get_RLum(temp.results, "LnLxTnTx.table"), - data.frame(Signal = pIRIR.curve.names[i]) - )) - - temp.results.pIRIR.rejection.criteria <- as.data.frame(c( - get_RLum(temp.results, "rejection.criteria"), - data.frame(Signal = pIRIR.curve.names[i]) - )) - - temp.results.pIRIR.formula <- list(get_RLum(temp.results, - "Formula")) - names(temp.results.pIRIR.formula) <- pIRIR.curve.names[i] - - ##create now object - temp.results <- set_RLum( - class = "RLum.Results", - data = list( - data = temp.results.pIRIR.De, - LnLxTnTx.table = temp.results.pIRIR.LnLxTnTx, - rejection.criteria = temp.results.pIRIR.rejection.criteria, - Formula = temp.results.pIRIR.formula - ), - info = list( - call = sys.call() - ) - ) - - - ##merge results - if (exists("temp.results.final")) { - temp.results.final <- merge_RLum(list(temp.results.final, temp.results)) - - } else{ - temp.results.final <- temp.results - - } - - - } - - -##============================================================================## -# Plotting additionals-------------------------------------------------------- -##============================================================================## - -if(plot){ - - ##extract LnLnxTnTx.table - LnLxTnTx.table <- get_RLum(temp.results.final, "LnLxTnTx.table") - - ##remove Inf - if(any(is.infinite(LnLxTnTx.table[["LxTx"]]))) - LnLxTnTx.table[["LxTx"]][is.infinite(LnLxTnTx.table[["LxTx"]])] <- NA - - if(any(is.infinite(LnLxTnTx.table[["LxTx.Error"]]))) - LnLxTnTx.table[["LxTx.Error"]][is.infinite(LnLxTnTx.table[["LxTx.Error"]])] <- NA - - - ##plot growth curves - plot(NA, NA, - xlim = range(get_RLum(temp.results.final, "LnLxTnTx.table")$Dose), - ylim = c( - if(min(LnLxTnTx.table$LxTx, na.rm = TRUE) - - max(LnLxTnTx.table$LxTx.Error, na.rm = TRUE) < 0){ - min(LnLxTnTx.table$LxTx, na.rm = TRUE)- - max(LnLxTnTx.table$LxTx.Error, na.rm = TRUE) - }else{0}, - max(LnLxTnTx.table$LxTx, na.rm = TRUE)+ - max(LnLxTnTx.table$LxTx.Error, na.rm = TRUE)), - xlab = "Dose [s]", - ylab = expression(L[x]/T[x]), - main = "Summarised Dose Response Curves") - - - ##set x for expression evaluation - x <- seq(0,max(LnLxTnTx.table$Dose)*1.05,length = 100) - - for(j in 1:length(pIRIR.curve.names)){ - - ##dose points - temp.curve.points <- LnLxTnTx.table[,c("Dose", "LxTx", "LxTx.Error", "Signal")] - - temp.curve.points <- temp.curve.points[ - temp.curve.points[,"Signal"] == pIRIR.curve.names[j], - c("Dose", "LxTx", "LxTx.Error")] - - points(temp.curve.points[-1,c("Dose", "LxTx")], col = j, pch = j) - segments(x0 = temp.curve.points[-1,c("Dose")], - y0 = temp.curve.points[-1,c("LxTx")] - - temp.curve.points[-1,c("LxTx.Error")], - x1 = temp.curve.points[-1,c("Dose")], - y1 = temp.curve.points[-1,c("LxTx")] + - temp.curve.points[-1,c("LxTx.Error")], - col = j) - - ##De values - lines(c(0, get_RLum(temp.results.final, "data")[j,1]), - c(temp.curve.points[1,c("LxTx")], temp.curve.points[1,c("LxTx")]), - col = j, - lty = 2) - - lines(c(rep(get_RLum(temp.results.final, "data")[j,1], 2)), - c(temp.curve.points[1,c("LxTx")], 0), - col = j, - lty = 2) - - ##curve - temp.curve.formula <- get_RLum( - temp.results.final, "Formula")[[pIRIR.curve.names[j]]] - - try(lines(x, eval(temp.curve.formula), col = j), silent = TRUE) - - } - - rm(x) - - - ##plot legend - legend("bottomright", legend = pIRIR.curve.names, - lty = 1, col = c(1:length(pIRIR.curve.names)), - bty = "n", - pch = c(1:length(pIRIR.curve.names)) - ) - - ##plot Tn/Tx curves - ##select signal - temp.curve.TnTx <- LnLxTnTx.table[, c("TnTx", "Signal")] - - temp.curve.TnTx.matrix <- matrix(NA, - nrow = nrow(temp.curve.TnTx)/ - length(pIRIR.curve.names), - ncol = length(pIRIR.curve.names)) - - ##calculate normalised values - for(j in 1:length(pIRIR.curve.names)){ - - temp.curve.TnTx.sel <- temp.curve.TnTx[ - temp.curve.TnTx[,"Signal"] == pIRIR.curve.names[j] - , "TnTx"] - - temp.curve.TnTx.matrix[,j] <- temp.curve.TnTx.sel/temp.curve.TnTx.sel[1] - - } - - plot(NA, NA, - xlim = c(0,nrow(LnLxTnTx.table)/ - n.loops), - ylim = range(temp.curve.TnTx.matrix), - xlab = "# Cycle", - ylab = expression(T[x]/T[n]), - main = "Sensitivity change") - - ##zero line - abline(h = 1:nrow(temp.curve.TnTx.matrix), col = "gray") - - for(j in 1:length(pIRIR.curve.names)){ - - lines(1:nrow(temp.curve.TnTx.matrix), - temp.curve.TnTx.matrix[,j], - type = "b", - col = j, - pch = j) - } - - ##plot legend - legend("bottomleft", legend = pIRIR.curve.names, - lty = 1, col = c(1:length(pIRIR.curve.names)), - bty = "n", - pch = c(1:length(pIRIR.curve.names)) - ) - - - ##Rejection criteria - temp.rejection.criteria <- get_RLum(temp.results.final, - data.object = "rejection.criteria") - - temp.rc.reycling.ratio <- temp.rejection.criteria[ - grep("Recycling ratio",temp.rejection.criteria[,"Criteria"]),] - - temp.rc.recuperation.rate <- temp.rejection.criteria[ - grep("Recuperation rate",temp.rejection.criteria[,"Criteria"]),] - - temp.rc.palaedose.error <- temp.rejection.criteria[ - grep("Palaeodose error",temp.rejection.criteria[,"Criteria"]),] - - plot(NA,NA, - xlim = c(-0.5,0.5), - ylim = c(0,30), - yaxt = "n", ylab = "", - xaxt = "n", xlab = "", - bty = "n", - main = "Rejection criteria") - - axis(side = 1, at = c(-0.2,-0.1,0,0.1,0.2), labels = c("- 0.2", "- 0.1","0/1","+ 0.1", "+ 0.2")) - ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++## - ##polygon for recycling ratio - text(x = -.4, y = 30, "Recycling ratio", pos = 1, srt = 0) - polygon(x = c(-as.numeric(as.character(temp.rc.reycling.ratio$Threshold))[1], - -as.numeric(as.character(temp.rc.reycling.ratio$Threshold))[1], - as.numeric(as.character(temp.rc.reycling.ratio$Threshold))[1], - as.numeric(as.character(temp.rc.reycling.ratio$Threshold))[1]), - y = c(21,29,29,21), col = "gray", border = NA) - polygon(x = c(-0.3,-0.3,0.3,0.3) , y = c(21,29,29,21)) - - - ##consider possibility of multiple pIRIR signals and multiple recycling ratios - col.id <- 1 - - ##the conditional case might valid if no rejection criteria could be calculated - if(nrow(temp.rc.recuperation.rate)>0){ - - for(i in seq(1,nrow(temp.rc.recuperation.rate), - length(unique(temp.rc.recuperation.rate[,"Criteria"])))){ - - - for(j in 0:length(unique(temp.rc.recuperation.rate[,"Criteria"]))){ - points(temp.rc.reycling.ratio[i+j, "Value"]-1, - y = 25, - pch = col.id, - col = col.id) - - } - col.id <- col.id + 1 - } - }#endif - - rm(col.id) - - - - ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++## - ##polygon for recuperation rate - text(x = -.4, y = 20, "Recuperation rate", pos = 1, srt = 0) - - if(length(as.character(temp.rc.recuperation.rate$Threshold))>0){ - polygon(x = c(0, - 0, - as.numeric(as.character(temp.rc.recuperation.rate$Threshold))[1], - as.numeric(as.character(temp.rc.recuperation.rate$Threshold))[1]), - y = c(11,19,19,11), col = "gray", border = NA) - - polygon(x = c(-0.3,-0.3,0.3,0.3) , y = c(11,19,19,11)) - polygon(x = c(-0.3,-0.3,0,0) , y = c(11,19,19,11), border = NA, density = 10, angle = 45) - - - for(i in 1:nrow(temp.rc.recuperation.rate)){ - - points(temp.rc.palaedose.error[i, "Value"], - y = 15, - pch = i, - col = i) - - } - }#endif - - ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++## - ##polygon for palaeodose error - text(x = -.4, y = 10, "Palaeodose error", pos = 1, srt = 0) - polygon(x = c(0, - 0, - as.numeric(as.character(temp.rc.palaedose.error$Threshold))[1], - as.numeric(as.character(temp.rc.palaedose.error$Threshold))[1]), - y = c(1,9,9,1), col = "gray", border = NA) - polygon(x = c(-0.3,-0.3,0.3,0.3) , y = c(1,9,9,1)) - polygon(x = c(-0.3,-0.3,0,0) , y = c(1,9,9,1), border = NA, density = 10, angle = 45) - - - for(i in 1:nrow(temp.rc.palaedose.error)){ - - points(temp.rc.palaedose.error[i, "Value"], - y = 5, - pch = i, - col = i) - - } - - ##add 0 value - lines(x = c(0,0), y = c(0,19), lwd = 1.5*cex) - lines(x = c(0,0), y = c(20,29), lwd = 1.5*cex) - - ##plot legend - legend("bottomright", legend = pIRIR.curve.names, - col = c(1:length(pIRIR.curve.names)), - bty = "n", - pch = c(1:length(pIRIR.curve.names))) - - - ##reset graphic settings - if(plot.single == FALSE){par(def.par)} - -}##end plot == TRUE - - -##============================================================================## -# Return Values ----------------------------------------------------------- -##============================================================================## - - return(temp.results.final) - - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_portableOSL.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_portableOSL.R deleted file mode 100644 index 52c4ed7ef..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/analyse_portableOSL.R +++ /dev/null @@ -1,722 +0,0 @@ -#' @title Analyse portable CW-OSL measurements -#' -#' @description The function analyses CW-OSL curve data produced by a SUERC portable OSL reader and -#' produces a combined plot of OSL/IRSL signal intensities, OSL/IRSL depletion ratios -#' and the IRSL/OSL ratio. -#' -#' @details This function only works with [RLum.Analysis-class] objects produced by [read_PSL2R]. -#' It further assumes (or rather requires) an equal amount of OSL and IRSL curves that -#' are pairwise combined for calculating the IRSL/OSL ratio. For calculating the depletion ratios -#' the cumulative signal of the last n channels (same number of channels as specified -#' by `signal.integral`) is divided by cumulative signal of the first n channels (`signal.integral`). -#' -#' **Note: The function assumes the following sequence pattern: `DARK COUNT`, `IRSL`, `DARK COUNT`, `BSL`, `DARK COUNT`. If you have written a different sequence, the analysis function will (likely) not work!**. -#' -#' **Signal processing** -#' The function processes the signals as follows: `BSL` and `IRSL` signals are extracted using the -#' chosen signal integral, dark counts are taken in full. -#' -#' **Working with coordinates** -#' Usually samples are taken from a profile with a certain stratigraphy. In the past the function -#' calculated an index. With this newer version, you have two option of passing on xy-coordinates -#' to the function: -#' -#' * (1) Add coordinates to the sample name during measurement. The form is rather -#' strict and has to follow the scheme `_x:|y:`. Example: -#' `sample_x:0.2|y:0.4`. -#' -#' * (2) Alternatively, you can provide a [list] or [matrix] with the sample coordinates. -#' Example: `coord = list(c(0.2, 1), c(0.3,1.2))` -#' -#' Please note that the unit is meter (m) and the function expects always xy-coordinates. -#' The latter one is useful for surface interpolations. If you have measured a profile where -#' the x-coordinates to not measure, x-coordinates should be 0. -#' -#' @param object [RLum.Analysis-class] (**required**): [RLum.Analysis-class] object produced by [read_PSL2R]. -#' The input can be a [list] of such objects, in such case each input is treated as a separate sample -#' and the results are merged. -#' -#' @param signal.integral [numeric] (**required**): A vector of two values specifying the lower and upper channel used to calculate the OSL/IRSL signal. Can be provided in form of `c(1, 5)` or `1:5`. -#' -#' @param invert [logical] (*with default*): `TRUE` flip the plot the data in reverse order. -#' -#' @param normalise [logical] (*with default*): `TRUE` to normalise the OSL/IRSL signals -#' to the *mean* of all corresponding data curves. -#' -#' @param mode [character] (*with default*): defines the analysis mode, allowed -#' are `"profile"` (the default) and `"surface"` for surface interpolation. If you select -#' something else, nothing will be plotted (similar to `plot = FALSE`). -#' -#' @param coord [list] [matrix] (*optional*): a list or matrix of the same length as -#' number of samples measured with coordinates for the sampling positions. Coordinates -#' are expected to be provided in meter (unit: m). -#' Expected are x and y coordinates, e.g., -#' `coord = list(samp1 = c(0.1, 0.2)`. If you have not measured x coordinates, please x should be 0. -#' -#' @param plot [logical] (*with default*): enable/disable plot output -#' -#' @param ... other parameters to be passed to modify the plot output. -#' Supported are `run` to provide the run name , -#' if the input is a `list`, this is set automatically. Further plot parameters are -#' `surface_values` ([character] with value to plot), `legend` (`TRUE`/`FALSE`), `col_ramp` (for -#' surface mode), `contour` (contour lines `TRUE`/`FALSE` in surface mode), `grid` (`TRUE`/`FALSE`), `col`, `pch` (for profile mode), `xlim` (a name [list] for profile mode), `ylim`, -#' `zlim` (surface mode only), `ylab`, `xlab`, `zlab` (here x-axis labelling), `main`, `bg_img` (for -#' profile mode background image, usually a profile photo; should be a raster object), -#' `bg_img_positions` (a vector with the four corner positions, cf. [graphics::rasterImage]) -#' -#' @return -#' Returns an S4 [RLum.Results-class] object with the following elements: -#' -#' `$data`\cr -#' `.. $summary`: [data.frame] with the results\cr -#' `.. $data`: [list] with the [RLum.Analysis-class] objects\cr -#' `.. $args`: [list] the input arguments -#' -#' @seealso [RLum.Analysis-class], [RLum.Data.Curve-class], [read_PSL2R] -#' -#' @author Christoph Burow, University of Cologne (Germany), Sebastian Kreutzer, -#' Institute of Geography, Ruprecht-Karl University of Heidelberg, Germany -#' -#' @section Function version: 0.1.1 -#' -#' @keywords datagen plot -#' -#' @examples -#' -#' ## example profile plot -#' # (1) load example data set -#' data("ExampleData.portableOSL", envir = environment()) -#' -#' # (2) merge and plot all RLum.Analysis objects -#' merged <- merge_RLum(ExampleData.portableOSL) -#' plot_RLum( -#' object = merged, -#' combine = TRUE, -#' records_max = 5, -#' legend.pos = "outside") -#' merged -#' -#' # (3) analyse and plot -#' results <- analyse_portableOSL( -#' merged, -#' signal.integral = 1:5, -#' invert = FALSE, -#' normalise = TRUE) -#' get_RLum(results) -#' -#' @md -#' @export -analyse_portableOSL <- function( - object, - signal.integral = NULL, - invert = FALSE, - normalise = FALSE, - mode = "profile", - coord = NULL, - plot = TRUE, - ...) - { - - ## TODO - ## - add tests for background image option - ## - clear docu - -# Self-call --------------------------------------------------------------- - if (inherits(object, "list")) { - temp <- .warningCatcher(lapply(1:length(object), function(x) { - analyse_portableOSL( - object = object[[x]], - signal.integral = signal.integral, - invert = invert, - normalise = normalise, - plot = plot, - run = paste0("RUN #", x)) - })) - - return(merge_RLum(temp)) - - } - -# Start function ---------------------------------------------------------- - ## INPUT VERIFICATION ---- - ## only RLum.Analysis objects - if (!inherits(object, "RLum.Analysis")) - .throw_error("Only objects of class 'RLum.Analysis' are allowed") - - ## only curve objects - if (!all(sapply(object, class) == "RLum.Data.Curve")) - .throw_error("The 'RLum.Analysis' object must contain only objects ", - "of class 'RLum.Data.Curve'") - - ## check originator - if (!all(sapply(object, function(x) x@originator) == "read_PSL2R")) - .throw_error("Only objects originating from 'read_PSL2R()' are allowed") - - ## check sequence pattern - if(!all(names(object)[1:5] == c("USER", "IRSL", "USER", "OSL", "USER"))) - .throw_error("Sequence pattern not supported, please read manual for details") - - if (is.null(signal.integral)) { - signal.integral <- c(1, 1) - .throw_warning("No value for 'signal.integral' provided. Only the ", - "first data point of each curve was used") - } - - - ## set SAMPLE -------- - if("run" %in% names(list(...))) - run <- list(...)$run - else if (!is.null(object@info$Run_Name)) - run <- object@info$Run_Name - else - run <- "Run #1" - - - ## CALCULATIONS ---- - ## Note: the list ... unlist construction is used make sure that get_RLum() always - ## returns a list - ### get OSL ------- - OSL <- .unlist_RLum(list(get_RLum(object, recordType = "OSL"))) - OSL <- do.call(rbind, lapply(OSL, function(x) { - .posl_get_signal(x, signal.integral) - })) - - ### get IRSL ------- - IRSL <- .unlist_RLum(list(get_RLum(object, recordType = "IRSL"))) - IRSL <- do.call(rbind, lapply(IRSL, function(x) { - .posl_get_signal(x, signal.integral) - })) - - ### get DARK counts ---------- - ### we assume that USER contains the dark count measurements - DARK_COUNT <- .unlist_RLum(list(get_RLum(object, recordType = "USER"))) - DARK_COUNT <- lapply(seq(1,length(DARK_COUNT),3), function(x) DARK_COUNT[x:(x+2)]) - - DARK_COUNT <- do.call(rbind, lapply(DARK_COUNT, function(x) { - .posl_get_dark_count(x) - })) - - ### NORMALISE ---- - if (normalise) { - OSL <- .posl_normalise(OSL) - IRSL <- .posl_normalise(IRSL) - } - - ### OSL/IRSL Ratio ------- - RATIO <- IRSL$sum_signal / OSL$sum_signal - - ### extract coordinates ------- - if(is.null(coord)) { - coord <- .extract_PSL_coord(object) - - } else { - if(!inherits(coord, "matrix") && !inherits(coord, "list")) - .throw_error("'coord' must be a matrix or a list") - - if(inherits(coord, "list")) - coord <- do.call(rbind, coord) - - ## check length - if(nrow(coord) != length(OSL$sum_signal)) - .throw_error("Number of coordinates differ from the number of samples") - } - - ### GENERATE SUMMARY data.frame ----- - summary <- data.frame( - ID = seq_along(OSL$sum_signal), - RUN = run, - BSL = OSL$sum_signal, - BSL_error = OSL$sum_signal_err, - IRSL = IRSL$sum_signal, - IRSL_error = IRSL$sum_signal_err, - BSL_depletion = OSL$sum_signal_depletion, - IRSL_depletion = IRSL$sum_signal_depletion, - IRSL_BSL_RATIO = RATIO, - DARK = DARK_COUNT$mean_dark_count, - DARK_error = DARK_COUNT$sd_dark_count, - COORD_X = coord[,1], - COORD_Y = coord[,2] - ) - - ## if coordinates exist, sort by depth - if(!any(is.na(coord[,2]))) - summary <- summary[order(coord[,2]),] - - ### INVERT ---------- - if(invert) - summary <- summary[nrow(summary):1,] - - # PLOTTING ------------------------------------------------------------------- - ## generate list of plot matrices - ## this done to have consistent settings for all plot types - parm <- c("BSL", "BSL_error", "IRSL", "IRSL_error", - "BSL_depletion", "IRSL_depletion", "IRSL_BSL_RATIO", "DARK", "DARK_error") - m_list <- lapply(parm, function(x){ - cbind(x = summary[["COORD_X"]], y = summary[["COORD_Y"]], value = summary[[x]]) - - }) - - ## correct names of the list - names(m_list) <- parm - - ## add a few attributes to be used later - attr(m_list, "xlim") <- lapply(m_list, function(x) range(x[,1])) - attr(m_list, "ylim") <- if(invert) rev(range(m_list[[1]][,2])) else range(m_list[[1]][,2]) - attr(m_list, "zlim") <- lapply(m_list, function(x) range(x[,3])) - - ## account for surface case - if (!is.null(mode) && mode == "surface") { - attr(m_list, "ylim") <- if (invert) rev(range(summary$COORD_Y)) else range(summary$COORD_Y) - attr(m_list, "xlim") <- range(summary$COORD_X) - } - - if (!is.null(mode) && plot[1]) { - ## account for surface case - ## preset plot settings - ## plot settings ------- - plot_settings <- modifyList( - x = list( - col_ramp = grDevices::heat.colors(30, rev = TRUE, alpha = 0.5), - bg_img = NULL, - bg_img_positions = NULL, - surface_value = c("BSL", "IRSL", "IRSL_BSL_RATIO"), - legend = TRUE, - col = c("blue", "red", "blue", "red", "black", "grey"), - pch = rep(16, length(m_list)), - xlim = attr(m_list, "xlim"), - ylim = attr(m_list, "ylim"), - zlim = if(mode == "surface") NA else attr(m_list, "zlim"), - ylab = if(!any(is.na(summary$COORD_Y))) "Depth [m]" else "Index", - xlab = "x [m]", - grid = TRUE, - contour = FALSE, - zlab = c("BSL", "IRSL", "BSL depl.", "IRSL depl.", "IRSL/BSL", "mean DARK"), - main = summary$RUN[1] - ), - val = list(...), keep.null = TRUE) - - ## mode == "surface" --------- - if(mode[1] == "surface") { - ### check for validity of surface value ------- - if(!all(plot_settings$surface_value %in% names(m_list))) - .throw_error("Unknown value to plot: Valid are: ", - paste(names(m_list), collapse = ", ")) - - ## set par ------- - if(length(plot_settings$surface_value) > 1) { - par.default <- par(mfrow = c(2,2)) - on.exit(par(par.default)) - } - - ## loop over surface values ------- - for(i in plot_settings$surface_value) { - ## set matrix for the plot - m <- m_list[[i]] - - ## respect xlim and ylim range - m <- m[m[,2] >= min(plot_settings$ylim) & m[,2] <= max(plot_settings$ylim), ] - m <- m[m[,1] >= min(plot_settings$xlim) & m[,1] <= max(plot_settings$xlim), ] - - ## respect z_values - if(!all(is.na(plot_settings$zlim))) - m <- m[m[,3] >= min(plot_settings$zlim) & m[,3] <= max(plot_settings$zlim), ] - - ## interpolate ------ - s <- - try(interp::interp( - x = m[, 1], - y = m[, 2], - z = m[, 3], - nx = 200, - ny = 200, - ), silent = TRUE) - - ## show only warning - if(inherits(s, "try-error")) - .throw_warning("Surface interpolation failed: this happens when ", - "all points are arranged in one line. ", - "Nothing plotted!") - - ## show error - if(!inherits(s, "try-error")) { - par.default <- c( - if(exists("par.default")) par.default else NULL, - par(mar = c(4.5,4.5,4,2), xpd = FALSE)) - on.exit(par(par.default)) - - ## open empty plot - plot( - x = NA, - y = NA, - ylim = plot_settings$ylim, - xlim = plot_settings$xlim, - xlab = plot_settings$xlab, - ylab = plot_settings$ylab, - main = plot_settings$main) - - ## add background image if available ------- - if (!is.null(plot_settings$bg_img)) { - ## get corner positions - if(!is.null(plot_settings$bg_img_positions)) - positions <- plot_settings$bg_img_positions[1:4] - else - positions <- par()$usr - - graphics::rasterImage( - image = plot_settings$bg_img, - xleft = positions[1], - ybottom = positions[4], - xright = positions[2], - ytop = positions[3], - interpolate = TRUE) - } - - ## plot image ------- - graphics::image( - s, - col = plot_settings$col_ramp, - add = TRUE - ) - - ## add contour - if (plot_settings$contour) - graphics::contour(m, add = TRUE, col = "grey") - - ## add points - points(m[,1:2], pch = 20) - - ## add what is shown in the plot - mtext(side = 3, text = i, cex = 0.7) - - ## add legend - if(plot_settings$legend) { - par.default <- c(par.default, par(xpd = TRUE)) - on.exit(par(par.default)) - - col_grad <- plot_settings$col_ramp[ - seq(1, length(plot_settings$col_ramp), length.out = 14)] - - slices <- seq(par()$usr[3],par()$usr[4],length.out = 15) - - for(s in 1:(length(slices) - 1)){ - graphics::rect( - xleft = par()$usr[2] * 1.01, - xright = par()$usr[2] * 1.03, - ybottom = slices[s], - ytop = slices[s + 1], - col = col_grad[s], - border = TRUE) - } - - ## add legend text - text( - x = par()$usr[2] * 1.04, - y = par()$usr[4], - labels = if(is.null(plot_settings$zlim_image)) { - format(max(m[,3]), digits = 1, scientific = TRUE) - } else { - format(plot_settings$zlim_image[2], digits = 1, scientific = TRUE) - }, - cex = 0.6, - srt = 270, - pos = 3) - - text( - x = par()$usr[2] * 1.04, - y = par()$usr[3], - labels = if(is.null(plot_settings$zlim_image)) { - format(min(m[,3]), digits = 1, scientific = TRUE) - } else { - format(plot_settings$zlim_image[1], digits = 1, scientific = TRUE) - }, - cex = 0.6, - pos = 3, - srt = 270) - - ## add legend labelling (central) - text( - x = par()$usr[2] * 1.05, - y = (par()$usr[4] - par()$usr[3])/2 + par()$usr[3], - labels = "Intensity [a.u.]", - cex = 0.7, - pos = 3, - srt = 270) - } - } - }# end for loop - } - - ## mode == "profile" --------- - if (!is.null(mode[1]) && mode == "profile") { - par.old.full <- par(no.readonly = TRUE) - on.exit(par(par.old.full)) - - # default: par(mar = c(5, 4, 4, 2) + 0.1) // bottom, left, top, right - par(mfrow = c(1, 7)) - - par(mar = c(5, 4, 4, 1) + 0.1) - - frame() - - mtext(side= 3, plot_settings$main, cex = 0.7, line = 2) - - par(mar = c(5, 0, 4, 1) + 0.1) - - ## make sure that wrong zlim settings do not screw up the function - if(!inherits(plot_settings$zlim, "list")) { - .throw_warning("In profile mode, zlim needs to be provided as a named ", - "list, example: list(BSL = c(0,1)). Reset to default") - plot_settings$zlim <- attr(m_list, "zlim") - } - - #### BSL ------- - plot( - NA, - NA, - ylim = plot_settings$ylim, - xlim = plot_settings$zlim[["BSL"]], - xlab = plot_settings$zlab[1], - bty = "n", - yaxt = "n" - ) - if(plot_settings$grid) grid() - lines( - x = m_list[["BSL"]][,"value"], - y = m_list[["BSL"]][,"y"], - type = "b", - pch = plot_settings$pch[1], - col = plot_settings$col[1] - ) - - ## add error bars - segments( - x0 = m_list[["BSL"]][,"value"] - m_list[["BSL_error"]][,"value"], - x1 = m_list[["BSL"]][,"value"] + m_list[["BSL_error"]][,"value"], - y0 = m_list[["BSL"]][,"y"], - y1 = m_list[["BSL"]][,"y"], - col = plot_settings$col[1]) - - axis(2, line = 3, at = m_list[["BSL"]][,"y"], labels = m_list[["BSL"]][,"y"]) - axis(3) - - ## add general y-axis label - mtext(plot_settings$ylab[1], side = 2, line = 6) - - ### IRSL -------------- - plot( - NA, NA, - ylim = plot_settings$ylim, - xlim = plot_settings$zlim[["IRSL"]], - xlab = plot_settings$zlab[2], - bty = "n", - yaxt = "n" - ) - if(plot_settings$grid) grid() - - lines( - x = m_list[["IRSL"]][,"value"], - y = m_list[["IRSL"]][,"y"], - type = "b", - pch = plot_settings$pch[2], - col = plot_settings$col[2]) - - ## add error bars - segments( - x0 = m_list[["IRSL"]][,"value"] - m_list[["IRSL_error"]][,"value"], - x1 = m_list[["IRSL"]][,"value"] + m_list[["IRSL_error"]][,"value"], - y0 = m_list[["IRSL"]][,"y"], - y1 = m_list[["IRSL"]][,"y"], - col = plot_settings$col[2]) - - axis(3) - - ### OSL DEPLETATION ------- - plot( - NA, NA, - ylim = plot_settings$ylim, - xlim = plot_settings$zlim[["BSL_depletion"]], - xlab = plot_settings$zlab[3], - bty = "n", - yaxt = "n" - ) - - if(plot_settings$grid) grid() - lines( - x = m_list[["BSL_depletion"]][,"value"], - y = m_list[["BSL_depletion"]][,"y"], - type = "b", - lty = 2, - pch = plot_settings$pch[3], - col = plot_settings$col[3] - ) - - axis(3) - - ### IRSL DEPLETION --------------- - plot( - NA, NA, - ylim = plot_settings$ylim, - xlim = plot_settings$zlim[["IRSL_depletion"]], - xlab = plot_settings$zlab[4], - bty = "n", - yaxt = "n" - ) - - if(plot_settings$grid) grid() - - lines( - x = m_list[["IRSL_depletion"]][,"value"], - y = m_list[["IRSL_depletion"]][,"y"], - type = "b", - lty = 2, - pch = plot_settings$pch[4], - col = plot_settings$col[4]) - - axis(3) - - ### RATIO ----------------------------- - plot( - NA, NA, - ylim = plot_settings$ylim, - xlim = plot_settings$zlim[["IRSL_BSL_RATIO"]], - xlab = plot_settings$zlab[5], - ylab = "", - bty = "n", - yaxt = "n" - ) - - if(plot_settings$grid) grid() - - lines( - x = m_list[["IRSL_BSL_RATIO"]][,"value"], - y = m_list[["IRSL_BSL_RATIO"]][,"y"], - type = "b", - pch = plot_settings$pch[5], - col = plot_settings$col[5]) - - axis(3) - - ### DARK ----------------------------- - plot( - x = m_list[["DARK"]][,"value"], - y = m_list[["DARK_error"]][,"y"], - type = "b", - pch = plot_settings$pch, - col = plot_settings$col[6], - ylim = plot_settings$ylim, - xlim = range(c( - plot_settings$zlim[["DARK"]] - plot_settings$zlim[["DARK_error"]], - plot_settings$zlim[["DARK"]] + plot_settings$zlim[["DARK_error"]])), - xlab = plot_settings$zlab[6], - ylab = "", - bty = "n", - yaxt = "n" - ) - - ## add error bars - segments( - x0 = m_list[["DARK"]][,"value"] - m_list[["DARK_error"]][,"value"], - x1 = m_list[["DARK"]][,"value"] + m_list[["DARK_error"]][,"value"], - y0 = m_list[["DARK"]][,"y"], - y1 = m_list[["DARK"]][,"y"], - col = plot_settings$col[6]) - - axis(3) - } ## end mode == "profile" - } - - ## RETURN VALUE ---- - call<- sys.call() - args <- as.list(call)[2:length(call)] - - newRLumResults <- set_RLum( - class = "RLum.Results", - data = list( - summary=summary, - data = object, - args=args - ), - info = list(call = call)) - - return(newRLumResults) - -} - -# HELPER FUNCTIONS ---------- -## This extracts the relevant curve data information of the RLum.Data.Curve -## objects -.posl_get_signal <- function(x, signal.integral) { - raw_signal <- get_RLum(x)[,2] - sigint <- range(signal.integral) - if (sigint[2] > length(raw_signal)) { - sigint[2] <- length(raw_signal) - .throw_warning("'signal.integral' (", - paste(range(signal.integral), collapse = ", "), ") ", - "exceeded the number of available data points (n = ", - length(raw_signal),") and has been automatically ", - "reduced to the maximum number.") - } - sum_signal <- sum(raw_signal[sigint[1]:sigint[2]]) - sum_signal_err <- sqrt(sum(x@info$raw_data$counts_per_cycle_error[sigint[1]:sigint[2]]^2)) - sum_signal_depletion <- sum(raw_signal[(length(raw_signal)-length(sigint[1]:sigint[2])):length(raw_signal)]) / sum_signal - return(data.frame(sum_signal, sum_signal_err, sum_signal_depletion)) -} - -.posl_get_dark_count <- function(x) { - ## we do assume a fixed sequence pattern, hence, we know what to - ## expect that anything that comes in here, can be merged - counts <- unlist(lapply(x, function(x) as.matrix(x)[,2])) - - return(data.frame(mean_dark_count = mean(counts), sd_dark_count = sd(counts))) - -} - -## This function normalises the data curve by the mean signal -.posl_normalise <- function(x) { - rel.error <- x$sum_signal_err / x$sum_signal - x$sum_signal <- x$sum_signal / mean(x$sum_signal) - x$sum_signal_err <- x$sum_signal * rel.error - x$sum_signal_depletion <- x$sum_signal_depletion / mean(x$sum_signal_depletion) - return(x) -} - -## This function extracts the coordinates from the file name -## -.extract_PSL_coord <- function(object){ - ## get settings - settings_sample <- vapply(object, function(x) x@info$settings$Sample, character(1)) |> - unique() - - ## set character vector - tmp_coord <- character(length(settings_sample)) - - ## search for pattern match ... why? - ## because otherwise the dataset becomes inconsistent - pattern_match <- grepl( - pattern = "\\_x\\:[0-9].+\\|y\\:[0-9].+", - x = settings_sample, perl = TRUE) - - ## extract coordinates - tmp_coord[pattern_match] <- regexpr( - pattern = "\\_x\\:[0-9].+\\|y\\:[0-9].+", - text = settings_sample[pattern_match ], perl = TRUE) |> - regmatches(x = settings_sample[pattern_match], m = _) - - ## extract x and y - coord_split <- strsplit(tmp_coord, split = "|y:", fixed = TRUE) - - ## assign values - coord <- vapply(coord_split, function(x) { - if(length(x) == 0) - return(c(x = NA_real_, y = NA_real_)) - - c(x = as.numeric(strsplit(x, "_x:", fixed = TRUE)[[1]][[2]]), - y = as.numeric(x[2]))}, - numeric(2)) |> t() - - ## if NA, assign index - if(any(is.na(coord[,1]))) coord[,1] <- 0 - if(any(is.na(coord[,2]))) coord[,2] <- 1:nrow(coord) - - return(coord) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/apply_CosmicRayRemoval.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/apply_CosmicRayRemoval.R deleted file mode 100644 index 74f9577d5..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/apply_CosmicRayRemoval.R +++ /dev/null @@ -1,384 +0,0 @@ -#' Function to remove cosmic rays from an RLum.Data.Spectrum S4 class object -#' -#' The function provides several methods for cosmic-ray removal and spectrum -#' smoothing [RLum.Data.Spectrum-class] objects and such objects embedded in [list] or -#' [RLum.Analysis-class] objects. -#' -#' **`method = "Pych"`** -#' -#' This method applies the cosmic-ray removal algorithm described by Pych -#' (2003). Some aspects that are different to the publication: -#' -#' - For interpolation between neighbouring values the median and not the mean is used. -#' - The number of breaks to construct the histogram is set to: `length(number.of.input.values)/2` -#' -#' For further details see references below. -#' -#'**`method = "smooth"`** -#' -#' Method uses the function [smooth] to remove cosmic rays. -#' -#' Arguments that can be passed are: `kind`, `twiceit` -#' -#' **`method = "smooth.spline"`** -#' -#' Method uses the function [smooth.spline] to remove cosmic rays. -#' -#' Arguments that can be passed are: `spar` -#' -#' **How to combine methods?** -#' -#' Different methods can be combined by applying the method repeatedly to the -#' dataset (see example). -#' -#' @param object [RLum.Data.Spectrum-class] or [RLum.Analysis-class] (**required**): input -#' object to be treated. This can be also provided as [list]. If an [RLum.Analysis-class] object -#' is provided, only the [RLum.Data.Spectrum-class] objects are treated. Please note: this mixing of -#' objects does not work for a list of `RLum.Data` objects. -#' -#' @param method [character] (*with default*): -#' Defines method that is applied for cosmic ray removal. Allowed methods are -#' `smooth`, the default, ([smooth]), `smooth.spline` ([smooth.spline]) -#' and `Pych`. See details for further information. -#' -#' @param method.Pych.smoothing [integer] (*with default*): -#' Smoothing parameter for cosmic ray removal according to Pych (2003). -#' The value defines how many neighbouring values in each frame are used for smoothing -#' (e.g., `2` means that the two previous and two following values are used). -#' -#' @param method.Pych.threshold_factor [numeric] (*with default*): -#' Threshold for zero-bins in the histogram. Small values mean that more peaks -#' are removed, but signal might be also affected by this removal. -#' -#' @param MARGIN [integer] (*with default*): -#' on which part the function cosmic ray removal should be applied on: -#' -#' - 1 = along the time axis (line by line), -#' - 2 = along the wavelength axis (column by column). -#' -#' **Note:** This argument currently only affects the methods `smooth` and `smooth.spline` -#' -#' @param verbose [logical] (*with default*): -#' Option to suppress terminal output., -#' -#' @param plot [logical] (*with default*): -#' If `TRUE` the histograms used for the cosmic-ray removal are returned as plot -#' including the used threshold. Note: A separate plot is returned for each frame! -#' Currently only for `method = "Pych"` a graphical output is provided. -#' -#' @param ... further arguments and graphical parameters that will be passed -#' to the [smooth] function. -#' -#' @return Returns same object as input. -#' -#' @section Function version: 0.3.0 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum.Data.Spectrum-class], [RLum.Analysis-class], [smooth], [smooth.spline], -#' [apply_CosmicRayRemoval] -#' -#' @references -#' Pych, W., 2004. A Fast Algorithm for Cosmic-Ray Removal from -#' Single Images. The Astronomical Society of the Pacific 116 (816), 148-153. -#' \doi{10.1086/381786} -#' -#' @keywords manip -#' -#' @examples -#' -#' ##(1) - use with your own data and combine (uncomment for usage) -#' ## run two times the default method and smooth with another method -#' ## your.spectrum <- apply_CosmicRayRemoval(your.spectrum, method = "Pych") -#' ## your.spectrum <- apply_CosmicRayRemoval(your.spectrum, method = "Pych") -#' ## your.spectrum <- apply_CosmicRayRemoval(your.spectrum, method = "smooth") -#' -#' @md -#' @export -apply_CosmicRayRemoval <- function( - object, - method = "smooth", - method.Pych.smoothing = 2, - method.Pych.threshold_factor = 3, - MARGIN = 2, - verbose = FALSE, - plot = FALSE, - ... -){ - - # Self-call ---------------------------------------------------------------------------------- - ##Black magic: The function recalls itself until all RLum.Data.Spectrum objects have been treated - ##If you want to test the basics of the function please only use a single RLum.Data.Spectrum-object - ##if it comes in as an RLum.Analysis object ... make a list out of it - if(inherits(object, "RLum.Analysis")){ - object <- list(object) - class_original <- "RLum.Analysis" - - }else{ - class_original <- NULL - - } - - ##handle the list and recall - if(inherits(object, "list")){ - results_list <- lapply(object, function(o){ - - ##preset objects - record_id.spectra <- NULL - - ##RLum.Analysis - if(inherits(o, "RLum.Analysis")){ - ##get id of RLum.Data.Spectrum objects in this object - record_id.spectra <- which( - vapply(o@records, function(x) inherits(x, "RLum.Data.Spectrum"), logical(1))) - - ##rewrite o - temp_o <- o@records[record_id.spectra] - - }else{ - temp_o <- o - - } - - ##call function - results <- apply_CosmicRayRemoval( - object = temp_o, - method = method, - method.Pych.smoothing = method.Pych.smoothing, - method.Pych.threshold_factor = method.Pych.threshold_factor, - MARGIN = MARGIN, - verbose = verbose, - plot = plot, - ... = list(...) - ) - - ##combine in RLum.Analysis object if needed - if(!is.null(record_id.spectra)){ - o@records[record_id.spectra] <- results - return(o) - - }else{ - return(results) - - } - - }) - - ##final return, make sure that we return what we had as input - if(!is.null(class_original)){ - return(results_list[[1]]) - - }else{ - return(results_list) - - } - - } - - # Integrity check ----------------------------------------------------------- - - ##check if object is of class RLum.Data.Spectrum - if(!inherits(object,"RLum.Data.Spectrum")){ - stop(paste0("[apply_CosmicRayRemoval()] An object of class '",class(object)[1], "' is not supported as input; please read the manual!"), call. = FALSE) - - } - - ##deal with addition arguments - extraArgs <- list(...) - - kind <- if("kind" %in% names(extraArgs)) {extraArgs$kind} else - {"3RS3R"} - - twiceit <- if("twiceit" %in% names(extraArgs)) {extraArgs$twiceit} else - {TRUE} - - spar <- if("spar" %in% names(extraArgs)) {extraArgs$spar} else - {NULL} - - # Apply method ------------------------------------------------------------ - - ## +++++++++++++++++++++++++++++++++++ (smooth) ++++++++++++++++++++++++++++## - if(method == "smooth"){ - - ##apply smooth - object.data.temp.smooth <- apply( - X = object@data, - MARGIN = MARGIN, - FUN = stats::smooth, - kind = kind, - twiceit = twiceit - ) - - ##rotate output matrix if necessary - if(MARGIN == 1){ - object.data.temp.smooth <- t(object.data.temp.smooth) - - } - - ## +++++++++++++++++++++++++++++++++++ (smooth.spline) +++++++++++++++++++++## - }else if(method == "smooth.spline"){ - - ##write the function in a new function to acess the data more easily - temp_smooth.spline <- function(x, spar){ - stats::smooth.spline(x, spar = spar)$y - } - - ##apply smooth.spline - object.data.temp.smooth <- - apply( - X = object@data, - MARGIN = MARGIN, - FUN = temp_smooth.spline, - spar = spar - ) - - ##rotate output matrix if necessary - if(MARGIN == 1){ - object.data.temp.smooth <- t(object.data.temp.smooth) - - } - - ## +++++++++++++++++++++++++++++++++++ (Pych) ++++++++++++++++++++++++++++++## - }else if(method == "Pych"){ - - ## grep data matrix - object.data.temp <- object@data - - ## apply smoothing - object.data.temp.smooth <- sapply(X = 1:ncol(object.data.temp), function(x){ - - ##(1) - calculate sd for each subframe - temp.sd <- sd(object.data.temp[,x]) - - ##(2) - correct estimation of sd by 1-sigma clipping - temp.sd.corr <- sd(object.data.temp[ - - object.data.temp[,x] >= (mean(object.data.temp[,x]) - temp.sd) & - object.data.temp[,x] <= (mean(object.data.temp[,x]) + temp.sd) - - , x]) - - ##(3) - construct histogram of count distribution - temp.hist <- hist(object.data.temp[,x], - breaks = length(object.data.temp[,x])/2, plot = FALSE) - - ##(4) - find mode of the histogram (e.g. peak) - temp.hist.max <- which.max(temp.hist$counts) - - ##(5) - find gaps in the histogram (bins with zero value) - temp.hist.zerobin <- which(temp.hist$counts == 0) - - ##(5.1) - ##select just values right from the peak - temp.hist.zerobin <- temp.hist.zerobin[ - (temp.hist.max[1] + 1):length(temp.hist.zerobin)] - - ##(5.2) - ##select non-zerobins - temp.hist.nonzerobin <- which(temp.hist$counts != 0) - temp.hist.nonzerobin <- temp.hist.nonzerobin[ - temp.hist.nonzerobin >= (temp.hist.zerobin[1]-1)] - - ##(6) - find the first gap which is wider than the threshold - temp.hist.nonzerobin.diff <- diff( - temp.hist$breaks[temp.hist.nonzerobin]) - - - ## select the first value where the thershold is reached - ## factor 3 is defined by Pych (2003) - temp.hist.thres <- which( - temp.hist.nonzerobin.diff >= method.Pych.threshold_factor * temp.sd.corr)[1] - - ##(7) - use counts above the threshold and recalculate values - ## on all further values - if(!is.na(temp.hist.thres)){ - - object.data.temp[,x] <- sapply(1:nrow(object.data.temp), function(n){ - - if(c(n + method.Pych.smoothing) <= nrow(object.data.temp) & - (n - method.Pych.smoothing) >= 0){ - - ifelse( - object.data.temp[n,x] >= temp.hist$breaks[temp.hist.thres], - median(object.data.temp[(n-method.Pych.smoothing): - (n+method.Pych.smoothing),x]), - object.data.temp[n,x]) - - }else{ - - object.data.temp[n,x] - - } - - }) - - } - - ##(8) - return histogram used for the removal as plot - if(plot){ - - plot(temp.hist, - xlab = "Signal intensity [a.u.]", - main = "Cosmic-ray removal histogram") - - abline(v = temp.hist$breaks[temp.hist.thres], - col = "red") - - if(!is.na(temp.hist$breaks[temp.hist.thres])){ - legend("topright", "threshold" ,lty = 1, lwd = 1, col = "red", bty = "n") - mtext(side = 3, paste0("Frame: ", x, " (", - colnames(object.data.temp)[x], - ")")) - - }else{ - mtext(side = 3, paste0("Frame: ", x, " (", - colnames(object.data.temp)[x], - ") - no threshold applied!")) - } - } - - ##(9) - return information on the amount of removed cosmic-rays - - if(verbose){ - #sum up removed counts values above the threshold - sum.corrected.channels <- try( - sum(temp.hist$counts[temp.hist.thres:length(temp.hist$counts)]), - silent = TRUE) - - if(is(sum.corrected.channels)[1] == "try-error"){sum.corrected.channels <- 0} - - cat("[apply_CosmicRayRemoval()] >> ") - cat(paste(sum.corrected.channels, " channels corrected in frame ", x, "\n", sep = "")) - } - - ##return object - return(object.data.temp[,x]) - - })#end loop - - - }else{ - - stop("[apply_CosmicRayRemoval()] Unknown method for cosmic ray removal.") - - } - - # Correct row and column names -------------------------------------------- - - colnames(object.data.temp.smooth) <- colnames(object@data) - rownames(object.data.temp.smooth) <- rownames(object@data) - - - - # Return Output------------------------------------------------------------ - - temp.output <- set_RLum( - class = "RLum.Data.Spectrum", - recordType = object@recordType, - curveType = object@curveType, - data = object.data.temp.smooth, - info = object@info) - - invisible(temp.output) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/apply_EfficiencyCorrection.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/apply_EfficiencyCorrection.R deleted file mode 100644 index 3358a2b11..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/apply_EfficiencyCorrection.R +++ /dev/null @@ -1,151 +0,0 @@ -#' Function to apply spectral efficiency correction to RLum.Data.Spectrum S4 -#' class objects -#' -#' The function allows spectral efficiency corrections for RLum.Data.Spectrum -#' S4 class objects -#' -#' The efficiency correction is based on a spectral response dataset provided -#' by the user. Usually the data set for the quantum efficiency is of lower -#' resolution and values are interpolated for the required spectral resolution using -#' the function [stats::approx][stats::approxfun] -#' -#' If the energy calibration differs for both data set `NA` values are produces that -#' will be removed from the matrix. -#' -#' @param object [RLum.Data.Spectrum-class] or [RLum.Analysis-class] (**required**): -#' S4 object of class `RLum.Data.Spectrum`, `RLum.Analysis`or a [list] of such objects. Other objects in -#' the list are skipped. -#' -#' @param spectral.efficiency [data.frame] (**required**): -#' Data set containing wavelengths (x-column) and relative spectral response values -#' (y-column) (values between 0 and 1). The provided data will be used to correct all spectra if `object` is -#' a [list] -#' -#' @return Returns same object as provided as input -#' -#' @note -#' Please note that the spectral efficiency data from the camera alone may not -#' sufficiently correct for spectral efficiency of the entire optical system -#' (e.g., spectrometer, camera ...). -#' -#' @section Function version: 0.2.0 -#' -#' @author -#' Sebastian Kreutzer, IRAMAT-CRP2A, UMR 5060, CNRS-Université Bordeaux Montaigne (France)\cr -#' Johannes Friedrich, University of Bayreuth (Germany) -#' -#' @seealso [RLum.Data.Spectrum-class], [RLum.Analysis-class] -#' -#' @keywords manip -#' -#' @examples -#' -#' ##(1) - use with your own data (uncomment for usage) -#' ## spectral.efficiency <- read.csv("your data") -#' ## -#' ## your.spectrum <- apply_EfficiencyCorrection(your.spectrum, ) -#' -#' @md -#' @export -apply_EfficiencyCorrection <- function( - object, - spectral.efficiency -){ - - - # self-call ----------------------------------------------------------------------------------- - - ##case we have a list - if(inherits(object, "list")){ - output_list <- lapply(object, function(o){ - if(inherits(o, "RLum.Data.Spectrum") || inherits(o, "RLum.Analysis")){ - apply_EfficiencyCorrection(object = o, spectral.efficiency = spectral.efficiency) - - }else{ - warning(paste0("[apply_EfficiencyCorrection()] Skipping ",class(o)," object in input list."), call. = FALSE) - return(o) - } - - }) - - return(output_list) - - } - - ##the case of an RLum.Analysis object - if(inherits(object, "RLum.Analysis")){ - object@records <- lapply(object@records, function(o){ - if(inherits(o, "RLum.Data.Spectrum")){ - apply_EfficiencyCorrection(object = o, spectral.efficiency = spectral.efficiency) - - }else{ - warning(paste0("[apply_EfficiencyCorrection()] Skipping ",class(o)," object in input list."), call. = FALSE) - return(o) - } - - }) - - return(object) - - } - - - - # Integrity check ----------------------------------------------------------- - - ##check if object is of class RLum.Data.Spectrum - if(!inherits(object, "RLum.Data.Spectrum")) - stop("[apply_EfficiencyCorrection()] Input object is not of type RLum.Data.Spectrum",call. = FALSE) - - - if(!inherits(spectral.efficiency, "data.frame")) - stop("[apply_EfficiencyCorrection()] 'spectral.efficiency' is not of type data.frame", call. = FALSE) - - - ## grep data matrix from the input object - temp.matrix <- as(object, "matrix") - - ## grep efficency values - temp.efficiency <- as.matrix(spectral.efficiency[,1:2]) - - ##test max - if(max(temp.efficiency[,2]) > 1) - stop("[apply_EfficiencyCorrection()] Relative quantum efficiency values > 1 are not allowed.", call. = FALSE) - - # Apply method ------------------------------------------------------------ - - ##the interpolation is needed to align the resolution - #set data for interpolation - temp.efficiency.x <- as.numeric(row.names(temp.matrix)) - - temp.efficiency.interpolated <- approx( - x = temp.efficiency[,1], - y = temp.efficiency[,2], - xout = temp.efficiency.x, - ties = mean) - - - ##correct for quantum efficiency - temp.matrix <- vapply(X = 1:ncol(temp.matrix), FUN = function(x){ - temp.matrix[,x]/temp.efficiency.interpolated$y*max(temp.efficiency.interpolated$y, na.rm = TRUE) - - }, FUN.VALUE = numeric(length = nrow(temp.matrix))) - - ##remove NA values - temp.matrix <- na.exclude(temp.matrix) - - ##correct colnames - colnames(temp.matrix) <- colnames(get_RLum(object)) - - - # Return Output------------------------------------------------------------ - temp.output <- set_RLum( - class = "RLum.Data.Spectrum", - recordType = object@recordType, - curveType = object@curveType, - data = temp.matrix, - info = object@info) - - invisible(temp.output) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/bin_RLum.Data.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/bin_RLum.Data.R deleted file mode 100644 index 1e906501d..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/bin_RLum.Data.R +++ /dev/null @@ -1,50 +0,0 @@ -#' Channel binning - method dispatcher -#' -#' Function calls the object-specific bin functions for RLum.Data S4 class objects. -#' -#' The function provides a generalised access point for specific -#' [RLum.Data-class] objects. \cr -#' Depending on the input object, the corresponding function will be selected. -#' Allowed arguments can be found in the documentations of the corresponding -#' [RLum.Data-class] class. -#' -#' @param object [RLum.Data-class] (**required**): -#' S4 object of class `RLum.Data` -#' -#' @param ... further arguments passed to the specific class method -#' -#' @return An object of the same type as the input object is provided -#' -#' @section Function version: 0.2.0 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @note Currently only `RLum.Data` objects of class [RLum.Data.Curve-class] and [RLum.Data.Spectrum-class] are supported! -#' -#' @seealso [RLum.Data.Curve-class], [RLum.Data.Spectrum-class] -#' -#' @examples -#' -#' ##load example data -#' data(ExampleData.CW_OSL_Curve, envir = environment()) -#' -#' ##create RLum.Data.Curve object from this example -#' curve <- -#' set_RLum( -#' class = "RLum.Data.Curve", -#' recordType = "OSL", -#' data = as.matrix(ExampleData.CW_OSL_Curve) -#' ) -#' -#' ##plot data without and with 2 and 4 channel binning -#' plot_RLum(curve) -#' plot_RLum(bin_RLum.Data(curve, bin_size = 2)) -#' plot_RLum(bin_RLum.Data(curve, bin_size = 4)) -#' -#' @keywords utilities -#' -#' @md -#' @export -setGeneric("bin_RLum.Data", function(object, ...) { - standardGeneric("bin_RLum.Data") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_AliquotSize.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_AliquotSize.R deleted file mode 100644 index 665298446..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_AliquotSize.R +++ /dev/null @@ -1,447 +0,0 @@ -#' Estimate the amount of grains on an aliquot -#' -#' Estimate the number of grains on an aliquot. Alternatively, the packing -#' density of an aliquot is computed. -#' -#' This function can be used to either estimate the number of grains on an -#' aliquot or to compute the packing density depending on the the arguments -#' provided. -#' -#' The following function is used to estimate the number of grains `n`: -#' -#' \deqn{n = (\pi*x^2)/(\pi*y^2)*d} -#' -#' where `x` is the radius of the aliquot size (microns), `y` is the mean -#' radius of the mineral grains (mm) and `d` is the packing density -#' (value between 0 and 1). -#' -#' **Packing density** -#' -#' The default value for `packing.density` is 0.65, which is the mean of -#' empirical values determined by Heer et al. (2012) and unpublished data from -#' the Cologne luminescence laboratory. If `packing.density = "Inf"` a maximum -#' density of \eqn{\pi/\sqrt12 = 0.9068\ldots} is used. However, note that -#' this value is not appropriate as the standard preparation procedure of -#' aliquots resembles a PECC (*"Packing Equal Circles in a Circle"*) problem -#' where the maximum packing density is asymptotic to about 0.87. -#' -#' **Monte Carlo simulation** -#' -#' The number of grains on an aliquot can be estimated by Monte Carlo simulation -#' when setting `MC = TRUE`. Each of the parameters necessary to calculate -#' `n` (`x`, `y`, `d`) are assumed to be normally distributed with means -#' \eqn{\mu_x, \mu_y, \mu_d} and standard deviations \eqn{\sigma_x, \sigma_y, \sigma_d}. -#' -#' For the mean grain size random samples are taken first from -#' \eqn{N(\mu_y, \sigma_y)}, where \eqn{\mu_y = mean.grain.size} and -#' \eqn{\sigma_y = (max.grain.size-min.grain.size)/4} so that 95\% of all -#' grains are within the provided the grain size range. This effectively takes -#' into account that after sieving the sample there is still a small chance of -#' having grains smaller or larger than the used mesh sizes. For each random -#' sample the mean grain size is calculated, from which random subsamples are -#' drawn for the Monte Carlo simulation. -#' -#' The packing density is assumed -#' to be normally distributed with an empirically determined \eqn{\mu = 0.65} -#' (or provided value) and \eqn{\sigma = 0.18}. The normal distribution is -#' truncated at `d = 0.87` as this is approximately the maximum packing -#' density that can be achieved in PECC problem. -#' -#' The sample diameter has -#' \eqn{\mu = sample.diameter} and \eqn{\sigma = 0.2} to take into account -#' variations in sample disc preparation (i.e. applying silicon spray to the -#' disc). A lower truncation point at `x = 0.5` is used, which assumes -#' that aliquots with smaller sample diameters of 0.5 mm are discarded. -#' Likewise, the normal distribution is truncated at 9.8 mm, which is the -#' diameter of the sample disc. -#' -#' For each random sample drawn from the -#' normal distributions the amount of grains on the aliquot is calculated. By -#' default, `10^5` iterations are used, but can be reduced/increased with -#' `MC.iter` (see `...`). The results are visualised in a bar- and -#' boxplot together with a statistical summary. -#' -#' @param grain.size [numeric] (**required**): -#' mean grain size (microns) or a range of grain sizes from which the -#' mean grain size is computed (e.g. `c(100,200)`). -#' -#' @param sample.diameter [numeric] (**required**): -#' diameter (mm) of the targeted area on the sample carrier. -#' -#' @param packing.density [numeric] (*with default*): -#' empirical value for mean packing density. \cr -#' If `packing.density = "Inf"` a hexagonal structure on an infinite plane with -#' a packing density of \eqn{0.906\ldots} is assumed. -#' -#' @param MC [logical] (*optional*): -#' if `TRUE` the function performs a Monte Carlo simulation for estimating the -#' amount of grains on the sample carrier and assumes random errors in grain -#' size distribution and packing density. Requires a vector with min and max -#' grain size for `grain.size`. For more information see details. -#' -#' @param grains.counted [numeric] (*optional*): -#' grains counted on a sample carrier. If a non-zero positive integer is provided this function -#' will calculate the packing density of the aliquot. If more than one value is -#' provided the mean packing density and its standard deviation is calculated. -#' Note that this overrides `packing.density`. -#' -#' @param plot [logical] (*with default*): -#' plot output (`TRUE`/`FALSE`) -#' -#' @param ... further arguments to pass (`main, xlab, MC.iter`). -#' -#' @return -#' Returns a terminal output. In addition an -#' [RLum.Results-class] object is returned containing the -#' following element: -#' -#' \item{.$summary}{[data.frame] summary of all relevant calculation results.} -#' \item{.$args}{[list] used arguments} -#' \item{.$call}{[call] the function call} -#' \item{.$MC}{[list] results of the Monte Carlo simulation} -#' -#' The output should be accessed using the function [get_RLum]. -#' -#' @section Function version: 0.31 -#' -#' @author Christoph Burow, University of Cologne (Germany) -#' -#' @references -#' Duller, G.A.T., 2008. Single-grain optical dating of Quaternary -#' sediments: why aliquot size matters in luminescence dating. Boreas 37, -#' 589-612. -#' -#' Heer, A.J., Adamiec, G., Moska, P., 2012. How many grains -#' are there on a single aliquot?. Ancient TL 30, 9-16. -#' -#' **Further reading** -#' -#' Chang, H.-C., Wang, L.-C., 2010. A simple proof of Thue's -#' Theorem on Circle Packing. [https://arxiv.org/pdf/1009.4322v1](), -#' 2013-09-13. -#' -#' Graham, R.L., Lubachevsky, B.D., Nurmela, K.J., -#' Oestergard, P.R.J., 1998. Dense packings of congruent circles in a circle. -#' Discrete Mathematics 181, 139-154. -#' -#' Huang, W., Ye, T., 2011. Global -#' optimization method for finding dense packings of equal circles in a circle. -#' European Journal of Operational Research 210, 474-481. -#' -#' @examples -#' -#' ## Estimate the amount of grains on a small aliquot -#' calc_AliquotSize(grain.size = c(100,150), sample.diameter = 1, MC.iter = 100) -#' -#' ## Calculate the mean packing density of large aliquots -#' calc_AliquotSize(grain.size = c(100,200), sample.diameter = 8, -#' grains.counted = c(2525,2312,2880), MC.iter = 100) -#' -#' @md -#' @export -calc_AliquotSize <- function( - grain.size, - sample.diameter, - packing.density = 0.65, - MC = TRUE, - grains.counted, - plot=TRUE, - ... -){ - ##==========================================================================## - ## CONSISTENCY CHECK OF INPUT DATA - ##==========================================================================## - - if (missing(grain.size) || - length(grain.size) == 0 || length(grain.size) > 2) { - .throw_error("Please provide the mean grain size or a range ", - "of grain sizes (in microns)") - } - - if(packing.density < 0 | packing.density > 1) { - if(packing.density == "inf") { - } else { - .throw_error("'packing.density' expects values between 0 and 1") - } - } - - .validate_positive_scalar(sample.diameter) - - if (sample.diameter > 9.8) - .throw_warning("A sample diameter of ", sample.diameter, " mm was ", - "specified, but common sample discs are 9.8 mm in diameter") - - if(missing(grains.counted) == FALSE) { - if(MC == TRUE) { - MC = FALSE - cat(paste("\nMonte Carlo simulation is only available for estimating the", - "amount of grains on the sample disc. Automatically set to", - "FALSE.\n")) - } - } - - if(MC == TRUE && length(grain.size) != 2) { - .throw_error("'grain.size' must be a vector containing the min and max ", - "grain size when using Monte Carlo simulations") - } - - - ##==========================================================================## - ## ... ARGUMENTS - ##==========================================================================## - - # set default parameters - settings <- list(MC.iter = 10^4, - verbose = TRUE) - - # override settings with user arguments - settings <- modifyList(settings, list(...)) - - - ##==========================================================================## - ## CALCULATIONS - ##==========================================================================## - - # calculate the mean grain size - range.flag<- FALSE - if(length(grain.size) == 2) { - gs.range<- grain.size - grain.size<- mean(grain.size) - range.flag<- TRUE - } - - # use ~0.907... from Thue's Theorem as packing density - if(packing.density == "inf") { - packing.density = pi/sqrt(12) - } - - # function to calculate the amount of grains - calc_n<- function(sd, gs, d) { - n<- ((pi*(sd/2)^2)/ - (pi*(gs/2000)^2))*d - return(n) - } - - # calculate the amount of grains on the aliquot - if(missing(grains.counted) == TRUE) { - n.grains<- calc_n(sample.diameter, grain.size, packing.density) - - ##========================================================================## - ## MONTE CARLO SIMULATION - - if(MC == TRUE && range.flag == TRUE) { - - # create a random set of packing densities assuming a normal - # distribution with the empirically determined standard deviation of - # 0.18. - d.mc<- rnorm(settings$MC.iter, packing.density, 0.18) - - # in a PECC the packing density can not be larger than ~0.87 - d.mc[which(d.mc > 0.87)]<- 0.87 - d.mc[which(d.mc < 0.25)]<- 0.25 - - # create a random set of sample diameters assuming a normal - # distribution with an assumed standard deviation of - # 0.2. For a more conservative estimate this is divided by 2. - sd.mc<- rnorm(settings$MC.iter, sample.diameter, 0.2) - - # it is assumed that sample diameters < 0.5 mm either do not - # occur, or are discarded. Either way, any smaller sample - # diameter is capped at 0.5. - # Also, the sample diameter can not be larger than the sample - # disc, i.e. 9.8 mm. - sd.mc[which(sd.mc <0.5)]<- 0.5 - if (sample.diameter <= 9.8) - sd.mc[which(sd.mc >9.8)]<- 9.8 - - # create random samples assuming a normal distribution - # with the mean grain size as mean and half the range (min:max) - # as standard deviation. For a more conservative estimate this - # is further devided by 2, so half the range is regarded as - # two sigma. - gs.mc<- rnorm(settings$MC.iter, grain.size, diff(gs.range)/4) - - # draw random samples from the grain size spectrum (gs.mc) and calculate - # the mean for each sample. This gives an approximation of the variation - # in mean grain size on the sample disc - gs.mc.sampleMean<- vector(mode = "numeric") - - - for(i in 1:length(gs.mc)) { - gs.mc.sampleMean[i]<- mean(sample(gs.mc, calc_n( - sample(sd.mc, size = 1), - grain.size, - sample(d.mc, size = 1) - ), replace = TRUE)) - } - - # create empty vector for MC estimates of n - MC.n<- vector(mode="numeric") - - # calculate n for each MC data set - for(i in 1:length(gs.mc)) { - MC.n[i]<- calc_n(sd.mc[i], - gs.mc.sampleMean[i], - d.mc[i]) - } - - # summarize MC estimates - MC.q<- quantile(MC.n, c(0.05,0.95)) - MC.n.kde<- density(MC.n, n = 10000) - - # apply student's t-test - MC.t.test<- t.test(MC.n) - MC.t.lower<- MC.t.test["conf.int"]$conf.int[1] - MC.t.upper<- MC.t.test["conf.int"]$conf.int[2] - MC.t.se<- (MC.t.upper-MC.t.lower)/3.92 - - - # get unweighted statistics from calc_Statistics() function - MC.stats<- calc_Statistics(as.data.frame(cbind(MC.n,0.0001)))$unweighted - - } - }#EndOf:estimate number of grains - - - ##========================================================================## - ## CALCULATE PACKING DENSITY - - if(missing(grains.counted) == FALSE) { - - area.container<- pi*sample.diameter^2 - - if(length(grains.counted) == 1) { - area.grains<- (pi*(grain.size/1000)^2)*grains.counted - packing.density<- area.grains/area.container - } - else { - packing.densities<- length(grains.counted) - for(i in 1:length(grains.counted)) { - area.grains<- (pi*(grain.size/1000)^2)*grains.counted[i] - packing.densities[i]<- area.grains/area.container - } - std.d<- sd(packing.densities) - } - } - - ##==========================================================================## - ##TERMINAL OUTPUT - ##==========================================================================## - if (settings$verbose) { - - cat("\n [calc_AliquotSize]") - cat(paste("\n\n ---------------------------------------------------------")) - cat(paste("\n mean grain size (microns) :", grain.size)) - cat(paste("\n sample diameter (mm) :", sample.diameter)) - if(missing(grains.counted) == FALSE) { - if(length(grains.counted) == 1) { - cat(paste("\n counted grains :", grains.counted)) - } else { - cat(paste("\n mean counted grains :", round(mean(grains.counted)))) - } - } - if(missing(grains.counted) == TRUE) { - cat(paste("\n packing density :", round(packing.density,3))) - } - if(missing(grains.counted) == FALSE) { - if(length(grains.counted) == 1) { - cat(paste("\n packing density :", round(packing.density,3))) - } else { - cat(paste("\n mean packing density :", round(mean(packing.densities),3))) - cat(paste("\n standard deviation :", round(std.d,3))) - } - } - if(missing(grains.counted) == TRUE) { - cat(paste("\n number of grains :", round(n.grains,0))) - } - - - - if(MC == TRUE && range.flag == TRUE) { - cat(paste(cat(paste("\n\n --------------- Monte Carlo Estimates -------------------")))) - cat(paste("\n number of iterations (n) :", settings$MC.iter)) - cat(paste("\n median :", round(MC.stats$median))) - cat(paste("\n mean :", round(MC.stats$mean))) - cat(paste("\n standard deviation (mean) :", round(MC.stats$sd.abs))) - cat(paste("\n standard error (mean) :", round(MC.stats$se.abs, 1))) - cat(paste("\n 95% CI from t-test (mean) :", round(MC.t.lower), "-", round(MC.t.upper))) - cat(paste("\n standard error from CI (mean):", round(MC.t.se, 1))) - cat(paste("\n ---------------------------------------------------------\n")) - - } else { - cat(paste("\n ---------------------------------------------------------\n")) - } - - } - ##==========================================================================## - ##RETURN VALUES - ##==========================================================================## - - - # prepare return values for mode: estimate grains - if(missing(grains.counted) == TRUE) { - summary<- data.frame(grain.size = grain.size, - sample.diameter = sample.diameter, - packing.density = packing.density, - n.grains = round(n.grains,0), - grains.counted = NA) - } - - # prepare return values for mode: estimate packing density/densities - if(missing(grains.counted) == FALSE) { - - # return values if only one value for counted.grains is provided - if(length(grains.counted) == 1) { - summary<- data.frame(grain.size = grain.size, - sample.diameter = sample.diameter, - packing.density = packing.density, - n.grains = NA, - grains.counted = grains.counted) - } else { - # return values if more than one value for counted.grains is provided - summary<- data.frame(rbind(1:5)) - colnames(summary)<- c("grain.size", "sample.diameter", "packing.density", - "n.grains","grains.counted") - for(i in 1:length(grains.counted)) { - summary[i,]<- c(grain.size, sample.diameter, packing.densities[i], - n.grains = NA, grains.counted[i]) - } - } - } - - if(!MC) { - MC.n<- NULL - MC.stats<- NULL - MC.n.kde<- NULL - MC.t.test<- NULL - MC.q<- NULL - } - - if(missing(grains.counted)) grains.counted<- NA - - call<- sys.call() - args<- as.list(sys.call())[-1] - - # create S4 object - newRLumResults.calc_AliquotSize <- set_RLum( - class = "RLum.Results", - data = list( - summary=summary, - MC=list(estimates=MC.n, - statistics=MC.stats, - kde=MC.n.kde, - t.test=MC.t.test, - quantile=MC.q)), - info = list(call=call, - args=args)) - - ##=========## - ## PLOTTING - if(plot==TRUE) { - try(plot_RLum.Results(newRLumResults.calc_AliquotSize, ...)) - } - - # Return values - invisible(newRLumResults.calc_AliquotSize) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_AverageDose.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_AverageDose.R deleted file mode 100644 index 389880f9a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_AverageDose.R +++ /dev/null @@ -1,521 +0,0 @@ -#'Calculate the Average Dose and the dose rate dispersion -#' -#'This functions calculates the Average Dose and their extrinsic dispersion and estimates -#'the standard errors by bootstrapping based on the Average Dose Model by Guerin et al., 2017 -#' -#' **`sigma_m`**\cr -#' -#'The program requires the input of a known value of `sigma_m`, -#'which corresponds to the intrinsic overdispersion, as determined -#'by a dose recovery experiment. Then the dispersion in doses (`sigma_d`) -#'will be that over and above `sigma_m` (and individual uncertainties `sigma_wi`). -#' -#' @param data [RLum.Results-class] or [data.frame] (**required**): -#' for [data.frame]: two columns with `De` `(data[,1])` and `De error` `(values[,2])` -#' -#' @param sigma_m [numeric] (**required**): -#' the overdispersion resulting from a dose recovery -#' experiment, i.e. when all grains have received the same dose. Indeed in such a case, any -#' overdispersion (i.e. dispersion on top of analytical uncertainties) is, by definition, an -#' unrecognised measurement uncertainty. -#' -#' @param Nb_BE [integer] (*with default*): -#' sample size used for the bootstrapping -#' -#' @param na.rm [logical] (*with default*): -#' exclude NA values from the data set prior to any further operation. -#' -#' @param plot [logical] (*with default*): -#' enables/disables plot output -#' -#' @param verbose [logical] (*with default*): -#' enables/disables terminal output -#' -#' @param ... further arguments that can be passed to [graphics::hist]. As three plots -#' are returned all arguments need to be provided as [list], -#' e.g., `main = list("Plot 1", "Plot 2", "Plot 3")`. -#' Note: not all arguments of `hist` are -#' supported, but the output of `hist` is returned and can be used of own plots. \cr -#' -#' Further supported arguments: `mtext` ([character]), `rug` (`TRUE/FALSE`). -#' -#' @section Function version: 0.1.5 -#' -#' @author Claire Christophe, IRAMAT-CRP2A, Université de Nantes (France), -#' Anne Philippe, Université de Nantes, (France), -#' Guillaume Guérin, IRAMAT-CRP2A, Université Bordeaux Montaigne, (France), -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [read.table], [graphics::hist] -#' -#' @return The function returns numerical output and an (*optional*) plot. -#' -#' -----------------------------------\cr -#' `[ NUMERICAL OUTPUT ]` \cr -#' -----------------------------------\cr -#' **`RLum.Results`**-object\cr -#' -#' **slot:** **`@data`** \cr -#' -#' `[.. $summary : data.frame]`\cr -#' -#' \tabular{lll}{ -#' **Column** \tab **Type** \tab **Description**\cr -#' AVERAGE_DOSE \tab [numeric] \tab the obtained average dose\cr -#' AVERAGE_DOSE.SE \tab [numeric] \tab the average dose error \cr -#' SIGMA_D \tab [numeric]\tab sigma \cr -#' SIGMA_D.SE \tab [numeric]\tab standard error of the sigma \cr -#' IC_AVERAGE_DOSE.LEVEL \tab [character]\tab confidence level average dose\cr -#' IC_AVERAGE_DOSE.LOWER \tab [character]\tab lower quantile of average dose \cr -#' IC_AVERAGE_DOSE.UPPER \tab [character]\tab upper quantile of average dose\cr -#' IC_SIGMA_D.LEVEL \tab [integer]\tab confidence level sigma\cr -#' IC_SIGMA_D.LOWER \tab [character]\tab lower sigma quantile\cr -#' IC_SIGMA_D.UPPER \tab [character]\tab upper sigma quantile\cr -#' L_MAX \tab [character]\tab maximum likelihood value -#' } -#' -#' `[.. $dstar : matrix]` \cr -#' -#' Matrix with bootstrap values\cr -#' -#' `[.. $hist : list]`\cr -#' -#' Object as produced by the function histogram -#' -#' ------------------------\cr -#' `[ PLOT OUTPUT ]`\cr -#' ------------------------\cr -#' -#' The function returns two different plot panels. -#' -#' (1) An abanico plot with the dose values -#' -#' (2) A histogram panel comprising 3 histograms with the equivalent dose and the bootstrapped average -#' dose and the sigma values. -#' -#' @references -#' Guerin, G., Christophe, C., Philippe, A., Murray, A.S., Thomsen, K.J., Tribolo, C., Urbanova, P., -#' Jain, M., Guibert, P., Mercier, N., Kreutzer, S., Lahaye, C., 2017. Absorbed dose, equivalent dose, -#' measured dose rates, and implications for OSL age estimates: Introducing the Average Dose Model. -#' Quaternary Geochronology 1-32. doi:10.1016/j.quageo.2017.04.002 -#' -#' **Further reading**\cr -#' -#' Efron, B., Tibshirani, R., 1986. Bootstrap Methods for Standard Errors, Confidence Intervals, -#' and Other Measures of Statistical Accuracy. Statistical Science 1, 54-75. -#' -#' @note This function has beta status! -#' -#' @keywords datagen -#' -#' @examples -#' -#'##Example 01 using package example data -#'##load example data -#'data(ExampleData.DeValues, envir = environment()) -#' -#'##calculate Average dose -#'##(use only the first 56 values here) -#'AD <- calc_AverageDose(ExampleData.DeValues$CA1[1:56,], sigma_m = 0.1) -#' -#'##plot De and set Average dose as central value -#'plot_AbanicoPlot( -#' data = ExampleData.DeValues$CA1[1:56,], -#' z.0 = AD$summary$AVERAGE_DOSE) -#' -#' @md -#' @export -calc_AverageDose <- function( - data, - sigma_m, - Nb_BE = 500, - na.rm = TRUE, - plot = TRUE, - verbose = TRUE, - ... -){ - - # Define internal functions ------------------------------------------------------------------ - - # function which compute mle's for data (yu,su) - .mle <- function(yu , su, wu.start, sigma_d.start, delta.start){ - - ##set start parameters, otherwise the function will try to get them - ##from the parent environment, which is not wanted ... - delta.temp <- 0 - sigma_d.temp <- 0 - - sigma_d <- sigma_d.start - delta <- delta.start - wu <- wu.start - - j <- 0 - iteration_limit <- 10000 - - ##loop until convergence or the iteration limit is reached - while(j < iteration_limit) { - - ##code by Claire; in the 2nd and 3rd line delta and sigma_d are replaced by delta.temp and - ##sigma_d.temp; otherwise the iteration and its test for convergence will not work - delta.temp <- exp( sum(wu*(yu+(0.5*(sigma_d^2)))) / sum(wu) ) - sigma_d.temp <- sigma_d*sum( (wu^2) * (yu-log(delta.temp)+0.5*sigma_d^2)^2) / (sum( wu*(1+yu-log(delta.temp)+0.5*sigma_d^2))) - wu <- 1/(sigma_d.temp^2 + su^2) - - ##break loop if convergence is reached ... if not update values - if(is.infinite(delta.temp) | is.infinite(sigma_d.temp)){ - break() - - }else if ( - ##compare values ... if they are equal we have convergence - all( - c(round(c(delta, sigma_d), 4)) == c(round(c(delta.temp, sigma_d.temp), 4)) - ) - ) { - break() - - } else{ - ##update input values - delta <- delta.temp - sigma_d <- sigma_d.temp - j <- j + 1 - - } - - } - - ##if no convergence was reached stop entire function; no stop as this may happen during the - ##bootstraping procedure - if(j == iteration_limit){ - warning("[calc_AverageDoseModel()] .mle() no convergence reached for the given limits. NA returned!") - return(c(NA,NA)) - - }else if(is.infinite(delta.temp) | is.infinite(sigma_d.temp)){ - warning("[calc_AverageDoseModel()] .mle() gaves Inf values. NA returned!") - return(c(NA,NA)) - - }else{ - return(c(round(c(delta, sigma_d),4))) - - } - - } - - .CredibleInterval <- function(a_chain, level = 0.95) { - ## Aim : estimation of the shortest credible interval of the sample of parameter a - # A level % credible interval is an interval that keeps N*(1-level) elements of the sample - # The level % credible interval is the shortest of all those intervals. - ## Parameters : - # a_chain : the name of the values of the parameter a - # level : the level of the credible interval expected - ## Returns : the level and the endpoints - - sorted_sample <- sort(a_chain) - N <- length(a_chain) - OutSample <- N * (1 - level) - - I <- cbind(sorted_sample[1:(OutSample + 1)] , sorted_sample[(N - OutSample):N]) - - l <- I[, 2] - I[, 1] # length of intervals - i <- which.min(l) # look for the shortest interval - - return(c( - level = level, - CredibleIntervalInf = I[i, 1], - CredibleIntervalSup = I[i, 2] - )) - - } - - ##//////////////////////////////////////////////////////////////////////////////////////////////// - ##HERE THE MAIN FUNCTION STARTS - ##//////////////////////////////////////////////////////////////////////////////////////////////// - - # Integrity checks ---------------------------------------------------------------------------- - - if(!is(data, "RLum.Results") & !is(data, "data.frame")){ - .throw_error("Input must be of type 'RLum.Results' or 'data.frame'") - }else { - - if(is(data, "RLum.Results")){ - data <- get_RLum(data) - - } - } - - .validate_positive_scalar(sigma_m) - .validate_positive_scalar(Nb_BE, int = TRUE) - - - # Data preparation ----------------------------------------------------------------------------- - - ##problem: the entire code refers to column names the user may not provide... - ## >> to avoid changing the entire code, the data will shape to a format that - ## >> fits to the code - - ##check for number of columns - if(ncol(data)<2){ - message("[calc_AverageDose()] Error: data set contains < 2 columns! ", - "NULL returned!") - return(NULL) - } - - ##used only the first two colums - if(ncol(data)>2){ - data <- data[,1:2] - .throw_warning("number of columns in data set > 2. ", - "Only the first two columns were used.") - } - - ##exclude NA values - if(any(is.na(data))){ - data <- na.exclude(data) - .throw_warning("NA values in data set detected. ", - "Rows with NA values removed!") - } - - ##check data set - if(nrow(data) == 0){ - message("[calc_AverageDose()] Error: data set contains 0 rows! ", - "NULL returned!") - return(NULL) - } - - ##data becomes to dat (thus, make the code compatible with the code by Claire and Anne) - dat <- data - - ##preset column names, as the code refers to it - colnames(dat) <- c("cd", "se") - - - # Pre calculation ----------------------------------------------------------------------------- - - ##calculate yu = log(CD) and su = se(logCD) - yu <- log(dat$cd) - - su <- sqrt((dat$se / dat$cd) ^ 2 + sigma_m ^ 2) - - # calculate starting values and weights - sigma_d <- sd(dat$cd) / mean(dat$cd) - wu <- 1 / (sigma_d ^ 2 + su ^ 2) - - delta <- mean(dat$cd) - n <- length(yu) - - ##terminal output - if (verbose) { - cat("\n[calc_AverageDose()]") - cat("\n\n>> Initialisation <<") - cat(paste("\nn:\t\t", n)) - cat(paste("\ndelta:\t\t", delta)) - cat(paste("\nsigma_m:\t", sigma_m)) - cat(paste("\nsigma_d:\t", sigma_d)) - } - - - # mle's computation - dhat <- .mle(yu, su, wu.start = wu, sigma_d.start = sigma_d, delta.start = delta) - delta <- dhat[1] - sigma_d <- dhat[2] - wu <- 1 / (sigma_d ^ 2 + su ^ 2) - - # maximum log likelihood - llik <- sum(-log(sqrt(2 * pi / wu)) - (wu / 2) * ((yu - log(delta) + 0.5 * (sigma_d ^ 2)) ^ 2)) - - ##terminal output - if(verbose){ - cat(paste("\n\n>> Calculation <<\n")) - cat(paste("log likelihood:\t", round(llik, 4))) - - } - - - # standard errors obtained by bootstrap, we refer to Efron B. and Tibshirani R. (1986) - # est ce qu'il faut citer l'article ici ou tout simplement dans la publi ? - n <- length(yu) - - ##calculate dstar - ##set matrix for I - I <- matrix(data = sample(x = 1:n, size = n * Nb_BE, replace = TRUE), ncol = Nb_BE) - - ##iterate over the matrix and produce dstar - ##(this looks a little bit complicated, but is far more efficient) - dstar <- t(vapply( - X = 1:Nb_BE, - FUN = function(x) { - .mle(yu[I[, x]], su[I[, x]], sigma_d.start = sigma_d, delta.start = delta, wu.start = wu) - - }, - FUN.VALUE = vector(mode = "numeric", length = 2) - )) - - ##exclude NA values - dstar <- na.exclude(dstar) - - - ## calculate confidence intervals - IC_delta <- .CredibleInterval(dstar[,1],0.95) - IC_sigma_d <- .CredibleInterval(dstar[,2],0.95) - IC <- rbind(IC_delta, IC_sigma_d) - - # standard errors - sedelta <- sqrt ((1/(Nb_BE-1))*sum((dstar[,1]-mean(dstar[,1]))^2)) - sesigma_d <- sqrt ((1/(Nb_BE-1))*sum((dstar[,2]-mean(dstar[,2]))^2)) - - - ##Terminal output - if (verbose) { - cat("\nconfidence intervals\n") - cat("--------------------------------------------------\n") - print(t(IC), print.gap = 6, digits = 4) - cat("--------------------------------------------------\n") - - cat(paste("\n>> Results <<\n")) - cat("----------------------------------------------------------\n") - cat(paste( - "Average dose:\t ", - round(delta, 4), - "\tse(Aver. dose):\t", - round(sedelta, 4) - )) - if(sigma_d == 0){ - cat(paste( - "\nsigma_d:\t ", - round(sigma_d, 4), - "\t\tse(sigma_d):\t", - round(sesigma_d, 4) - )) - - }else{ - cat(paste( - "\nsigma_d:\t ", - round(sigma_d, 4), - "\tse(sigma_d):\t", - round(sesigma_d, 4) - )) - } - cat("\n----------------------------------------------------------\n") - - } - - ##compile final results data frame - results_df <- data.frame( - AVERAGE_DOSE = delta, - AVERAGE_DOSE.SE = sedelta, - SIGMA_D = sigma_d, - SIGMA_D.SE = sesigma_d, - IC_AVERAGE_DOSE.LEVEL = IC_delta[1], - IC_AVERAGE_DOSE.LOWER = IC_delta[2], - IC_AVERAGE_DOSE.UPPER = IC_delta[3], - IC_SIGMA_D.LEVEL = IC_sigma_d[1], - IC_SIGMA_D.LOWER = IC_sigma_d[2], - IC_SIGMA_D.UPPER = IC_sigma_d[3], - L_MAX = llik, - row.names = NULL - - ) - - # Plotting ------------------------------------------------------------------------------------ - - ##the plotting (enable/disable) is controlled below, as with this - ##we always get a histogram object - - ##set data list - data_list <- list(dat$cd, dstar[,1], dstar[,2]) - - ##preset plot arguments - plot_settings <- list( - breaks = list("FD", "FD", "FD"), - probability = list(FALSE, TRUE, TRUE), - main = list( - "Observed: Equivalent dose", - "Bootstrapping: Average Dose", - "Bootstrapping: Sigma_d"), - xlab = list( - "Equivalent dose [a.u.]", - "Average dose [a.u.]", - "Sigma_d"), - axes = list(TRUE, TRUE, TRUE), - col = NULL, - border = NULL, - density = NULL, - freq = NULL, - mtext = list( - paste("n = ", length(data_list[[1]])), - paste("n = ", length(data_list[[2]])), - paste("n = ", length(data_list[[3]]))), - rug = list(TRUE, TRUE, TRUE) - - ) - - ##modify this list by values the user provides - - ##expand all elements in the list - ##problem: the user might provid only one item, then the code will break - plot_settings.user <- lapply(list(...), function(x){ - rep(x, length = 3) - - }) - - ##modify - plot_settings <- modifyList(x = plot_settings.user, val = plot_settings) - - - ##get change par setting and reset on exit - if(plot) { - par.default <- par()$mfrow - on.exit(par(mfrow = par.default)) - par(mfrow = c(1,3)) - } - - ##Produce plots - ##(1) - histogram of the observed equivalent dose - ##(2) - histogram of the bootstrapped De - ##(3) - histogram of the bootstrapped sigma_d - - ##with lapply we get fetch also the return of hist, they user might want to use this later - hist <- lapply(1:length(data_list), function(x){ - temp <- suppressWarnings(hist( - x = data_list[[x]], - breaks = plot_settings$breaks[[x]], - probability = plot_settings$probability[[x]], - main = plot_settings$main[[x]], - xlab = plot_settings$xlab[[x]], - axes = plot_settings$axes[[x]], - freq = plot_settings$freq[[x]], - plot = plot, - col = plot_settings$col[[x]], - border = plot_settings$border[[x]], - density = plot_settings$density[[x]] - - )) - - if (plot) { - ##add rug - if (plot_settings$rug[[x]]) { - rug(data_list[[x]]) - - } - - ##plot mtext - mtext(side = 3, - text = plot_settings$mtext[[x]], - cex = par()$cex) - } - - return(temp) - - }) - - # Return -------------------------------------------------------------------------------------- - set_RLum( - class = "RLum.Results", - data = list( - summary = results_df, - dstar = as.data.frame(dstar), - hist = hist - ), - info = list(call = sys.call()) - - ) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_CentralDose.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_CentralDose.R deleted file mode 100644 index 140bed7a5..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_CentralDose.R +++ /dev/null @@ -1,306 +0,0 @@ -#' Apply the central age model (CAM) after Galbraith et al. (1999) to a given -#' De distribution -#' -#' This function calculates the central dose and dispersion of the De -#' distribution, their standard errors and the profile log likelihood function -#' for sigma. -#' -#' This function uses the equations of Galbraith & Roberts (2012). The -#' parameters `delta` and `sigma` are estimated by numerically solving -#' eq. 15 and 16. Their standard errors are approximated using eq. 17. -#' In addition, the profile log-likelihood function for `sigma` is -#' calculated using eq. 18 and presented as a plot. Numerical values of the -#' maximum likelihood approach are **only** presented in the plot and **not** -#' in the console. A detailed explanation on maximum likelihood estimation can -#' be found in the appendix of Galbraith & Laslett (1993, 468-470) and -#' Galbraith & Roberts (2012, 15) -#' -#' @param data [RLum.Results-class] or [data.frame] (**required**): -#' for [data.frame]: two columns with De `(data[,1])` and De error `(data[,2])` -#' -#' @param sigmab [numeric] (*with default*): -#' additional spread in De values. -#' This value represents the expected overdispersion in the data should the sample be -#' well-bleached (Cunningham & Walling 2012, p. 100). -#' **NOTE**: For the logged model (`log = TRUE`) this value must be -#' a fraction, e.g. 0.2 (= 20 \%). If the un-logged model is used (`log = FALSE`), -#' sigmab must be provided in the same absolute units of the De values (seconds or Gray). -#' -#' @param log [logical] (*with default*): -#' fit the (un-)logged central age model to De data -#' -#' @param na.rm [logical] (*with default*): strip `NA` values before the computation proceeds -#' -#' @param plot [logical] (*with default*): -#' plot output -#' -#' @param ... further arguments (`trace`, `verbose`). -#' -#' @return Returns a plot (*optional*) and terminal output. In addition an -#' [RLum.Results-class] object is returned containing the following elements: -#' -#' \item{.$summary}{[data.frame] summary of all relevant model results.} -#' \item{.$data}{[data.frame] original input data} -#' \item{.$args}{[list] used arguments} -#' \item{.$call}{[call] the function call} -#' \item{.$profile}{[data.frame] the log likelihood profile for sigma} -#' -#' The output should be accessed using the function [get_RLum] -#' -#' @section Function version: 1.4.1 -#' -#' @author -#' Christoph Burow, University of Cologne (Germany) \cr -#' Based on a rewritten S script of Rex Galbraith, 2010 -#' -#' @seealso [plot], [calc_CommonDose], [calc_FiniteMixture], -#' [calc_FuchsLang2001], [calc_MinDose] -#' -#' @references -#' Galbraith, R.F. & Laslett, G.M., 1993. Statistical models for -#' mixed fission track ages. Nuclear Tracks Radiation Measurements 4, 459-470. -#' -#' Galbraith, R.F., Roberts, R.G., Laslett, G.M., Yoshida, H. & Olley, -#' J.M., 1999. Optical dating of single grains of quartz from Jinmium rock -#' shelter, northern Australia. Part I: experimental design and statistical -#' models. Archaeometry 41, 339-364. -#' -#' Galbraith, R.F. & Roberts, R.G., 2012. Statistical aspects of equivalent dose and error calculation and -#' display in OSL dating: An overview and some recommendations. Quaternary -#' Geochronology 11, 1-27. -#' -#' **Further reading** -#' -#' Arnold, L.J. & Roberts, R.G., 2009. Stochastic modelling of multi-grain equivalent dose -#' (De) distributions: Implications for OSL dating of sediment mixtures. -#' Quaternary Geochronology 4, 204-230. -#' -#' Bailey, R.M. & Arnold, L.J., 2006. Statistical modelling of single grain quartz De distributions and an -#' assessment of procedures for estimating burial dose. Quaternary Science -#' Reviews 25, 2475-2502. -#' -#' Cunningham, A.C. & Wallinga, J., 2012. Realizing the potential of fluvial archives using robust OSL chronologies. -#' Quaternary Geochronology 12, 98-106. -#' -#' Rodnight, H., Duller, G.A.T., Wintle, A.G. & Tooth, S., 2006. Assessing the reproducibility and accuracy -#' of optical dating of fluvial deposits. Quaternary Geochronology, 1 109-120. -#' -#' Rodnight, H., 2008. How many equivalent dose values are needed to -#' obtain a reproducible distribution?. Ancient TL 26, 3-10. -#' -#' @examples -#' -#' ##load example data -#' data(ExampleData.DeValues, envir = environment()) -#' -#' ##apply the central dose model -#' calc_CentralDose(ExampleData.DeValues$CA1) -#' -#' @md -#' @export -calc_CentralDose <- function(data, sigmab, log = TRUE, na.rm = FALSE, plot = TRUE, ...) { - ## ============================================================================## - ## CONSISTENCY CHECK OF INPUT DATA - ## ============================================================================## - if (!missing(data)) { - if (!is(data, "data.frame") & !is(data, "RLum.Results")) { - stop("[calc_CentralDose()] 'data' has to be of type 'data.frame' or 'RLum.Results'!", call. = FALSE) - } else { - if (is(data, "RLum.Results")) { - data <- get_RLum(data, "data") - } - } - } - - ##remove NA values - if(na.rm == TRUE && any(is.na(data))){ - warning("[calc_CentralDose()] ", length(which(is.na(data))), " NA value(s) removed from dataset!", call. = FALSE) - data <- na.exclude(data) - } - - ##make sure we consider onlyt take the first two columns - if(ncol(data) < 2 || nrow(data) < 2) - stop("[calc_CentralDose()] 'data' should have at least two columns and two rows!", call. = FALSE) - - ##extract only the first two columns and set column names - data <- data[,1:2] - colnames(data) <- c("ED", "ED_Error") - - if (!missing(sigmab)) { - if (sigmab < 0 | sigmab > 1 & log) - stop("[calc_CentralDose()] sigmab needs to be given as a fraction between 0 and 1 (e.g., 0.2)!", call. = FALSE) - - } - - - - - ## ============================================================================## - ## ... ARGUMENTS - ## ============================================================================## - - options <- list(verbose = TRUE, - trace = FALSE) - - options <- modifyList(options, list(...)) - - - ## ============================================================================## - ## CALCULATIONS - ## ============================================================================## - - # set default value of sigmab - if (missing(sigmab)) - sigmab <- 0 - - # calculate yu = log(ED) and su = se(logED) - if (log) { - yu <- log(data$ED) - su <- sqrt((data$ED_Error / data$ED)^2 + sigmab^2) - } else { - yu <- data$ED - su <- sqrt((data$ED_Error)^2 + sigmab^2) - } - - - # What does the code do? - # >> email conversation with Rex Galbraith 2019-06-29 - # >> "fixed point iteration" method to estimate sigma - # >> starting with a fixed value - # >> once sqrt(sum((wu^2) * (yu - delta)^2 / sum(wu))) gets equal to 1 - # >> the iteration is complete - # >> if everything has converged agains those fixed values - # >> this is the maximum likelihood estimate for - # >> sigma and delta - - # calculate starting values and weights - sigma <- 0.15 # keep in mind that this is a relative value - wu <- 1 / (sigma^2 + su^2) - delta <- sum(wu * yu) / sum(wu) - n <- length(yu) - - # compute mle's - for (j in 1:200) { - delta <- sum(wu * yu) / sum(wu) - sigma <- sigma * sqrt(sum((wu^2) * (yu - delta)^2 / sum(wu))) - wu <- 1 / (sigma^2 + su^2) - - # print iterations - if (options$trace) - print(round(c(delta, sigma), 4)) - } - - # save parameters for terminal output - out.delta <- ifelse(log, exp(delta), delta) - out.sigma <- ifelse(log, sigma * 100, sigma / out.delta * 100) - - # log likelihood - llik <- 0.5 * sum(log(wu)) - 0.5 * sum(wu * (yu - delta)^2) - - # save parameter for terminal output - out.llik <- round(llik, 4) - Lmax <- llik - - # standard errors - sedelta <- 1 / sqrt(sum(wu)) - sesigma <- 1 / sqrt(2 * sigma^2 * sum(wu^2)) - - # save parameters for terminal output - if (log) { - out.sedelta <- sedelta * 100 - out.sesigma <- sesigma - } else { - out.sedelta <- sedelta / out.delta * 100 - out.sesigma <- sqrt((sedelta / delta)^2 + - (sesigma / out.delta * 100 / out.sigma)^2) * out.sigma / 100 - - } - - # profile log likelihood - sigmax <- sigma - llik <- 0 - sig0 <- max(0, sigmax - 8 * sesigma) - sig1 <- sigmax + 9.5 * sesigma - sig <- try(seq(sig0, sig1, sig1 / 1000), silent = TRUE) - - if (!inherits(sig, "try-error")) { - # TODO: rewrite this loop as a function and maximise with mle2 ll is the actual - # log likelihood, llik is a vector of all ll - for (s in sig) { - wu <- 1 / (s^2 + su^2) - mu <- sum(wu * yu)/sum(wu) - ll <- 0.5 * sum(log(wu)) - 0.5 * sum(wu * (yu - mu)^2) - llik <- c(llik, ll) - } - llik <- llik[-1] - Lmax - } - - ## ============================================================================## - ## TERMINAL OUTPUT - ## ============================================================================## - - if (options$verbose) { - cat("\n [calc_CentralDose]") - cat(paste("\n\n----------- meta data ----------------")) - cat(paste("\n n: ", n)) - cat(paste("\n log: ", log)) - cat(paste("\n----------- dose estimate ------------")) - cat(paste("\n abs. central dose: ", format(out.delta, digits = 2, nsmall = 2))) - cat(paste("\n abs. SE: ", format(out.delta * out.sedelta/100, - digits = 2, nsmall = 2))) - cat(paste("\n rel. SE [%]: ", format(out.sedelta, digits = 2, nsmall = 2))) - cat(paste("\n----------- overdispersion -----------")) - cat(paste("\n abs. OD: ", format(ifelse(log, sigma * out.delta, sigma), digits = 2, nsmall = 2))) - cat(paste("\n abs. SE: ", format(ifelse(log, sesigma * out.delta, sesigma), digits = 2, nsmall = 2))) - cat(paste("\n OD [%]: ", format(out.sigma, digits = 2, nsmall = 2))) - cat(paste("\n SE [%]: ", if (!inherits(sig, "try-error")) { - format(out.sesigma * 100, digits = 2, nsmall = 2) - } else { - "-" - })) - cat(paste("\n-------------------------------------\n\n")) - } - - ## ============================================================================## - ## RETURN VALUES - ## ============================================================================## - - if (inherits(sig, "try-error")) { - out.sigma <- 0 - out.sesigma <- NA - } - - if(!log) sig <- sig / delta - - summary <- data.frame( - de = out.delta, - de_err = out.delta * out.sedelta / 100, - OD = ifelse(log, sigma * out.delta, sigma), - OD_err = ifelse(log, sesigma * out.delta, sesigma), - rel_OD = out.sigma, - rel_OD_err = out.sesigma * 100, - Lmax = Lmax) - - args <- list(log = log, sigmab = sigmab) - - newRLumResults.calc_CentralDose <- set_RLum( - class = "RLum.Results", - data = list( - summary = summary, - data = data, - args = args, - profile = data.frame( - sig = if(!inherits(sig, "try-error")) sig else NA, - llik = llik) - ), - info = list( - call = sys.call() - ) - ) - - ## =========## PLOTTING - if (plot && !inherits(sig, "try-error")) - try(plot_RLum.Results(newRLumResults.calc_CentralDose, ...)) - - invisible(newRLumResults.calc_CentralDose) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_CobbleDoseRate.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_CobbleDoseRate.R deleted file mode 100644 index 95317ed32..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_CobbleDoseRate.R +++ /dev/null @@ -1,391 +0,0 @@ -#'@title Calculate dose rate of slices in a spherical cobble -#' -#'@description -#' -#'Calculates the dose rate profile through the cobble based on Riedesel and Autzen (2020). -#' -#'Corrects the beta dose rate in the cobble for the grain size following results -#'of Guérin et al. (2012). Sediment beta and gamma dose rates are corrected -#'for the water content of the sediment using the correction factors of Aitken (1985). -#'Water content in the cobble is assumed to be 0. -#' -#' -#'@details -#' -#'**The input table layout** -#' -#'\tabular{lll}{ -#'COLUMN \tab DATA TYPE \tab DESCRIPTION\cr -#'`Distance` \tab `numeric` \tab distance from the surface of the cobble to the top of each rock slice in mm. The distance for each slice will be listed in this column\cr -#'`DistanceError` \tab `numeric` \tab Error on the distance in mm\cr -#'`Thickness` \tab `numeric` \tab Thickness of each slice in mm\cr -#'`TicknessError` \tab `numeric` \tab uncertainty of the thickness in mm.\cr -#'`Mineral` \tab `character` \tab `'FS'` for feldspar, `'Q'` for quartz, depending which mineral in the cobble is used for dating\cr -#'`Cobble_K` \tab `numeric` \tab K nuclide content in % of the bulk cobble\cr -#'`Cobble_K_SE` \tab `numeric` \tab error on K nuclide content in % of the bulk cobble\cr -#'`Cobble_Th` \tab `numeric` \tab Th nuclide content in ppm of the bulk cobble\cr -#'`Cobble_Th_SE` \tab `numeric` \tab error on Th nuclide content in ppm of the bulk cobble\cr -#'`Cobble_U` \tab `numeric` \tab U nuclide content in ppm of the bulk cobble\cr -#'`CobbleU_SE` \tab `numeric` \tab error on U nuclide content in ppm of the bulk cobble\cr -#'`GrainSize` \tab `numeric` \tab average grain size in µm of the grains used for dating\cr -#'`Density` \tab `numeric` \tab Density of the cobble. Default is 2.7 g cm^-3\cr -#'`CobbleDiameter` \tab `numeric` \tab Diameter of the cobble in cm.\cr -#'`Sed_K` \tab `numeric` \tab K nuclide content in % of the sediment matrix\cr -#'`Sed_K_SE` \tab `numeric` \tab error on K nuclide content in % of the sediment matrix\cr -#'`Sed_Th` \tab `numeric` \tab Th nuclide content in ppm of the sediment matrix\cr -#'`Sed_Th_SE` \tab `numeric` \tab error on Th nuclide content in ppm of the sediment matrix\cr -#'`Sed_U` \tab `numeric` \tab U nuclide content in ppm of the sediment matrix\cr -#'`Sed_U_SE` \tab `numeric` \tab error on U nuclide content in ppm of the sediment matrix\cr -#'`GrainSize` \tab `numeric` \tab average grain size of the sediment matrix\cr -#'`WaterContent` \tab `numeric` \tab mean water content of the sediment matrix in %\cr -#'`WaterContent_SE` \tab `numeric` \tab relative error on water content -#'} -#' -#'**Water content** -#'The water content provided by the user should be calculated according to: -#' -#'\deqn{(Wet_weight - Dry_weight) / Dry_weight * 100} -#' -#'@param input [data.frame] (**required**): A table containing all relevant information -#'for each individual layer. For the table layout see details. -#' -#'@param conversion Which dose rate conversion factors to use. For accepted values see [BaseDataSet.ConversionFactors] -#' -#'@references -#'Riedesel, S., Autzen, M., 2020. Beta and gamma dose rate attenuation in rocks and sediment. -#'Radiation Measurements 133, 106295. -#' -#'@section Function version: 0.1.0 -#' -#'@author Svenja Riedesel, Aberystwyth University (United Kingdom) \cr -#'Martin Autzen, DTU NUTECH Center for Nuclear Technologies (Denmark) -#' -#'@return The function returns an [RLum.Results-class] object for which the first element -#'is a [matrix] (`DataIndividual`) that gives the dose rate results for each slice -#'for each decay chain individually, for both, the cobble dose rate and the sediment -#'dose rate. The second element is also a [matrix] (`DataComponent`) that gives -#'the total beta and gamma-dose rates for the cobble and the adjacent sediment -#'for each slice of the cobble. -#' -#'@keywords datagen -#' -#'@seealso [convert_Concentration2DoseRate] -#' -#'@examples -#'## load example data -#'data("ExampleData.CobbleData", envir = environment()) -#' -#'## run function -#'calc_CobbleDoseRate(ExampleData.CobbleData) -#' -#'@md -#'@export -calc_CobbleDoseRate <- function(input,conversion = "Guerinetal2011"){ - - # Integrity tests --------------------------------------------------------- - if ((max(input[,1])>input$CobbleDiameter[1]*10) || - ((max(input[,1]) + input[length(input[,1]),3]) > input$CobbleDiameter[1]*10)) - stop("[calc_CobblDoseRate()] Slices outside of cobble. Please check your distances and make sure they are in mm and diameter is in cm!", call. = FALSE) - - - # Calculate Dose Rate ----------------------------------------------------- - SedDoseData <- matrix(data = NA, nrow = 1, ncol = 10) - CobbleDoseData <- matrix(data = 0, nrow = 1, ncol = 10) - - CobbleDoseData <- input[1,5:12] - CobbleDoseData <- cbind(CobbleDoseData,0,0) - SedDoseData <- cbind(input[1,5],input[1,15:20],input[1,12],input[1,23:24]) - - CobbleDoseRate <- get_RLum(convert_Concentration2DoseRate( - input = CobbleDoseData, conversion = conversion)) - SedDoseRate <- get_RLum( - convert_Concentration2DoseRate(input = SedDoseData, conversion = conversion)) - - ## Distance should be from the surface of the rock to the top of the slice. Distances and thicknesses are in mm - N <- length(input$Distance) - - Diameter <- input$CobbleDiameter[1] - - ### Calculate gamma attenuation coefficient for the cobbles internal dose rate - if (Diameter<25){ - CobbleGammaAtt <- - (0.55 * exp(-0.45 * Diameter) + 0.09 * exp(-0.06 * Diameter)) * 10 - }else { - CobbleGammaAtt <- 0.02 - } - - ## Scale the density and infinite matrix gamma dose rates ---- - Scaling <- input$Density[1] / 2.7 - GammaEdge <- 0.5 * (1 - exp(-0.039 * Diameter)) - GammaCentre <- 2 * GammaEdge - - DiameterSeq <- - seq(0, Diameter * 10, by = 0.01) #Converts diameter into integer of 10 um - - ### Create matrices for use ---- - Temp <- matrix(data = NA, nrow = length(DiameterSeq), ncol = 9) - DistanceError <- matrix(data = NA, nrow = N, ncol = 8) - ThicknessError <- matrix(data = NA, nrow = N, ncol = 8) - DataIndividual <- matrix(data = NA, nrow = N, ncol = 25) - DataComponent <- matrix(data = NA, nrow = N, ncol = 9) - DoseRates <- matrix(data = NA, nrow = 1, ncol = 24) - output <- matrix(list(), nrow = 2, ncol = 1) - - ### Calculate dose rate profiles through the rock ---- - t <- Diameter * 10 - DiameterSeq - tGamma <- t - - #Beta and gamma functions for the cobbles own dose rate - KBetaCobble <- function(x) (1 - 0.5 * exp(-3.77 * DiameterSeq))+(1-0.5*exp(-3.77*t))-1 - ThBetaCobble_short <- function(x) (1 - 0.5 * exp(-5.36 * x * Scaling))+(1-0.5*exp(-5.36*t*Scaling))-1 - ThBetaCobble_long <- function(x) (1 - 0.33 * exp(-2.36 * x * Scaling))+(1-0.33*exp(-2.36*t*Scaling))-1 - UBetaCobble_short <- function(x) (1 - 0.5 * exp(-4.15 * x * Scaling))+(1-0.5*exp(-4.15*t*Scaling))-1 - UBetaCobble_long <- function(x) (1 - 0.33 * exp(-2.36 * x * Scaling))+(1-0.33*exp(-2.36*t*Scaling))-1 - - GammaCobble <- function(x) { - (GammaCentre - GammaEdge * exp(-CobbleGammaAtt * x * Scaling)) + - (GammaCentre - GammaEdge * exp(-CobbleGammaAtt * tGamma * Scaling)) - - GammaCentre - } - - #Beta and gamma functions for the sediment dose rates into the cobble - KBetaSed <- function(x) 2 - (1 - 0.5 * exp(-3.77 * x * Scaling)) - (1 - 0.5 * exp(-3.77 * t * Scaling)) - ThBetaSed_short <- function(x) 2 - (1 - 0.5 * exp(-5.36 * x * Scaling)) - (1 - 0.5 * exp(-5.36 * t * Scaling)) - ThBetaSed_long <- function(x) 2 - (1 - 0.33 * exp(-2.36 * x * Scaling)) - (1 - 0.33 * exp(-2.36 * t * Scaling)) - UBetaSed_short <- function(x) 2 - (1 - 0.5 * exp(-4.15 * x * Scaling)) - (1 - 0.5 * exp(-4.15 * t * Scaling)) - UBetaSed_long <- function(x) 2 - (1 - 0.33 * exp(-2.36 * x * Scaling)) - (1 - 0.33 * exp(-2.36 * t * Scaling)) - - GammaSed <- function(x) 2 - (1 - 0.5 * exp(-0.02 * x * Scaling)) - (1 - 0.5 * exp(-0.02 * tGamma * - Scaling)) - Temp[, 1] <- DiameterSeq - Temp[, 2] <- KBetaCobble(DiameterSeq) - Temp[, 3] <- ThBetaCobble_long(DiameterSeq) - Temp[, 4] <- UBetaCobble_long(DiameterSeq) - Temp[, 5] <- GammaCobble(DiameterSeq) - Temp[, 6] <- KBetaSed(DiameterSeq) - Temp[, 7] <- ThBetaSed_long(DiameterSeq) - Temp[, 8] <- UBetaSed_long(DiameterSeq) - Temp[, 9] <- GammaSed(DiameterSeq) - - TempThCob <- ThBetaCobble_short(DiameterSeq) - TempUCob <- UBetaCobble_short(DiameterSeq) - TempThSed <- ThBetaSed_short(DiameterSeq) - TempUSed <- UBetaSed_short(DiameterSeq) - - n <- which(DiameterSeq >= (max(DiameterSeq)-0.15))[1] - Max <- length(DiameterSeq) - - ## Create the full matrix based on the short and long beta attenuations - Temp[0:16, 3] <- TempThCob[0:16] - Temp[n:Max, 3] <- TempThCob[n:Max] - - Temp[0:16, 7] <- TempThSed[0:16] - Temp[n:Max, 7] <- TempThSed[n:Max] - - Temp[0:16, 4] <- TempUCob[0:16] - Temp[n:Max, 4] <- TempUCob[n:Max] - - Temp[0:16, 8] <- TempUSed[0:16] - Temp[n:Max, 8] <- TempUSed[n:Max] - - colnames(Temp) <- c( - "Distance", - "KBetaCob", - "ThBetaCob", - "UBetaCob", - "GammaCob", - "KBetaSed", - "ThBetaSed", - "UBetaSed", - "GammaSed" - ) - - ### Create data output matrices ---- - Distances <- input$Distance / 0.01 + 1 - Thicknesses <- input$Thickness / 0.01 - - MinDistance <- (input$Distance - input$DistanceError) / 0.01 + 1 - MaxDistance <- (input$Distance + input$DistanceError) / 0.01 + 1 - - MinThickness <- (input$Thickness - input$ThicknessError) / 0.01 - MaxThickness <- (input$Thickness + input$ThicknessError) / 0.01 - - for (i in 1:N){ - Start <- Distances[i] - End <- Start+Thicknesses[i] - - d_min <- MinDistance[i] - d_max <- MaxDistance[i] - - t_min <- MinThickness[i] - t_max <- MaxThickness[i] - - #Calculate errors ---- - #Check if minimum distance from top is less than 0 - if (MinDistance[i]<0){ - d_min <- 0 - } - - j <- d_min+Thicknesses[i] - k <- d_max+Thicknesses[i] - - for (l in 1:8){ - m <- l + 1 - if (d_min == Start){ - DistanceError[i,l]<- abs( - (mean(Temp[d_max:k,m])-mean(Temp[Start:End,m]))/(2*mean(Temp[Start:End,m]))) - } else if (k > Max){ - DistanceError[i,l] <- abs( - (mean(Temp[Start:End,m])-mean(Temp[d_min:j,m]))/(2*mean(Temp[Start:End,m]))) - } else { - DistanceError[i,l] <- abs( - mean((mean(Temp[d_max:k,m])-mean(Temp[Start:End,m])):(mean(Temp[Start:End,m])-mean(Temp[d_min:j,m])))/(2*mean(Temp[Start:End,m]))) - } - - j2 <- Start+t_min - k2 <- Start+t_max - - if (k2 > Max){ - ThicknessError[i,l] <- abs( - (mean(Temp[Start:End,m])-mean(Temp[Start:j2,m]))/(2*mean(Temp[Start:End,m]))) - } else { - ThicknessError[i,l] <- abs( - mean((mean(Temp[Start:k2,m])-mean(Temp[Start:End,m])):(mean(Temp[Start:End,m])-mean(Temp[Start:j2,m])))/(2*mean(Temp[Start:End,m]))) - } - } - ### Calculate average dose rates ---- - - DataIndividual[i, 1] <- input[i, 1] - # Cobble K Beta - DataIndividual[i, 2] <- mean(Temp[Start:End, 2]) * CobbleDoseRate[1, 1] - DataIndividual[i, 3] <- - DataIndividual[i, 2] * sqrt(DistanceError[i, 1] ^ 2 + ThicknessError[i, 1] ^ - 2 + (CobbleDoseRate[1, 2] / CobbleDoseRate[1, 1]) ^ 2) - # Cobble Th Beta - DataIndividual[i, 4] <- mean(Temp[Start:End, 3]) * CobbleDoseRate[1, 3] - DataIndividual[i, 5] <- - DataIndividual[i, 4] * sqrt(DistanceError[i, 2] ^ 2 + ThicknessError[i, 2] ^ - 2 + (CobbleDoseRate[1, 4] / CobbleDoseRate[1, 3]) ^ 2) - # Cobble U Beta - DataIndividual[i, 6] <- mean(Temp[Start:End, 4]) * CobbleDoseRate[1, 5] - DataIndividual[i, 7] <- DataIndividual[i, 6] * sqrt(DistanceError[i, 3] ^ 2 + ThicknessError[i, 3] ^ - 2 + (CobbleDoseRate[1, 6] / CobbleDoseRate[1, 5]) ^ 2) - # Cobble K Gamma - DataIndividual[i, 8] <- mean(Temp[Start:End, 5]) * CobbleDoseRate[2, 1] - DataIndividual[i, 9] <- DataIndividual[i, 8] * sqrt(DistanceError[i, 4] ^ 2 + ThicknessError[i, 4] ^ - 2 + (CobbleDoseRate[2, 2] / CobbleDoseRate[2, 1]) ^ 2) - # Cobble Th Gamma - DataIndividual[i, 10] <- mean(Temp[Start:End, 5]) * CobbleDoseRate[2, 3] - DataIndividual[i, 11] <- - DataIndividual[i, 10] * sqrt(DistanceError[i, 4] ^ 2 + ThicknessError[i, 4] ^ - 2 + (CobbleDoseRate[2, 4] / CobbleDoseRate[2, 3]) ^ 2) - # Cobble U Gamma - DataIndividual[i, 12] <- mean(Temp[Start:End, 5]) * CobbleDoseRate[2, 5] - DataIndividual[i, 13] <- - DataIndividual[i, 12] * sqrt(DistanceError[i, 4] ^ 2 + ThicknessError[i, 4] ^ - 2 + (CobbleDoseRate[2, 6] / CobbleDoseRate[2, 5]) ^ 2) - - # Sediment K Beta - DataIndividual[i, 14] <- mean(Temp[Start:End, 6]) * SedDoseRate[1, 1] - DataIndividual[i, 15] <- - DataIndividual[i, 14] * sqrt(DistanceError[i, 5] ^ 2 + ThicknessError[i, 5] ^ - 2 + (SedDoseRate[1, 2] / SedDoseRate[1, 1]) ^ 2) - # Sediment Th Beta - DataIndividual[i, 16] <- mean(Temp[Start:End, 7]) * SedDoseRate[1, 3] - DataIndividual[i, 17] <- - DataIndividual[i, 16] * sqrt(DistanceError[i, 6] ^ 2 + ThicknessError[i, 6] ^ - 2 + (SedDoseRate[1, 4] / SedDoseRate[1, 3]) ^ 2) - # Sediment U Beta - DataIndividual[i, 18] <- mean(Temp[Start:End, 8]) * SedDoseRate[1, 5] - DataIndividual[i, 19] <- - DataIndividual[i, 18] * sqrt(DistanceError[i, 7] ^ 2 + ThicknessError[i, 7] ^ - 2 + (SedDoseRate[1, 6] / SedDoseRate[1, 5]) ^ 2) - # Sediment K Gamma - DataIndividual[i, 20] <- mean(Temp[Start:End, 9]) * SedDoseRate[2, 1] - DataIndividual[i, 21] <- - DataIndividual[i, 20] * sqrt(DistanceError[i, 8] ^ 2 + ThicknessError[i, 8] ^ - 2 + (SedDoseRate[2, 2] / SedDoseRate[2, 1]) ^ 2) - # Sediment Th Gamma - DataIndividual[i, 22] <- mean(Temp[Start:End, 9]) * SedDoseRate[2, 3] - DataIndividual[i, 23] <- - DataIndividual[i, 22] * sqrt(DistanceError[i, 8] ^ 2 + ThicknessError[i, 8] ^ - 2 + (SedDoseRate[2, 4] / SedDoseRate[2, 3]) ^ 2) - # Sediment U Gamma - DataIndividual[i, 24] <- mean(Temp[Start:End, 9]) * SedDoseRate[2, 5] - DataIndividual[i, 25] <- - DataIndividual[i, 24] * sqrt(DistanceError[i, 8] ^ 2 + ThicknessError[i, 8] ^ - 2 + (SedDoseRate[2, 6] / SedDoseRate[2, 5]) ^ 2) - - ### Sum data into beta and gamma dose rates from cobble and sediment ---- - DataComponent[i, 1] <- input[i, 1] - DataComponent[i, 2] <- DataIndividual[i, 2] + DataIndividual[i, 4] + DataIndividual[i, 6] - DataComponent[i, 3] <- DataComponent[i,2]*sqrt((DataIndividual[i,3]/DataIndividual[i,2])^2+(DataIndividual[i,5]/DataIndividual[i,4])^2+(DataIndividual[i,7]/DataIndividual[i,6])^2) - DataComponent[i, 4] <- DataIndividual[i, 8] + DataIndividual[i, 10] + DataIndividual[i, 12] - DataComponent[i, 5] <- DataComponent[i,4]*sqrt((DataIndividual[i,9]/DataIndividual[i,8])^2+(DataIndividual[i,11]/DataIndividual[i,10])^2+(DataIndividual[i,13]/DataIndividual[i,12])^2) - - DataComponent[i, 6] <- DataIndividual[i, 14] + DataIndividual[i, 16] + DataIndividual[i, 18] - DataComponent[i, 7] <- DataComponent[i,6]*sqrt((DataIndividual[i,15]/DataIndividual[i,14])^2+(DataIndividual[i,17]/DataIndividual[i,16])^2+(DataIndividual[i,19]/DataIndividual[i,18])^2) - DataComponent[i, 8] <- DataIndividual[i, 20] + DataIndividual[i, 22] + DataIndividual[i, 24] - DataComponent[i, 9] <- DataComponent[i,8]*sqrt((DataIndividual[i,21]/DataIndividual[i,20])^2+(DataIndividual[i,23]/DataIndividual[i,22])^2 + (DataIndividual[i,25]/DataIndividual[i,24])^2) - } - - colnames(DataIndividual) <- - c( - "Distance.", - "K Beta cobble", - "SE", - "Th Beta cobble", - "SE", - "U Beta cobble", - "SE", - "K Gamma cobble", - "SE", - "Th Gamma cobble", - "SE", - "U Gamma cobble", - "SE", - "K Beta sed.", - "SE", - "Th Beta sed.", - "SE", - "U Beta sed.", - "SE", - "K Gamma sed.", - "SE", - "Th Gamma sed.", - "SE", - "U Gamma sed.", - "SE" - ) - - colnames(DataComponent) <- - c( - "Distance", - "Total Cobble Beta", - "SE", - "Total Cobble Gamma", - "SE", - "Total Beta Sed.", - "SE", - "Total Gamma Sed.", - "SE" - ) - - - DataIndividual[is.na(DataIndividual)] <- 0 - DataComponent[is.na(DataComponent)] <- 0 - - # Return ------------------------------------------------------------------ - return( - set_RLum( - class = "RLum.Results", - data = list( - DataIndividual = DataIndividual, - DataComponent = DataComponent, - input = input - ), - info = list( - call = sys.call() - ))) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_CommonDose.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_CommonDose.R deleted file mode 100644 index 731800d26..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_CommonDose.R +++ /dev/null @@ -1,204 +0,0 @@ -#' Apply the (un-)logged common age model after Galbraith et al. (1999) to a -#' given De distribution -#' -#' Function to calculate the common dose of a De distribution. -#' -#' **(Un-)logged model** -#' -#' When `log = TRUE` this function -#' calculates the weighted mean of logarithmic De values. Each of the estimates -#' is weighted by the inverse square of its relative standard error. The -#' weighted mean is then transformed back to the dose scale (Galbraith & -#' Roberts 2012, p. 14). -#' -#' The log transformation is not applicable if the -#' De estimates are close to zero or negative. In this case the un-logged model -#' can be applied instead (`log = FALSE`). The weighted mean is then -#' calculated using the un-logged estimates of De and their absolute standard -#' error (Galbraith & Roberts 2012, p. 14). -#' -#' @param data [RLum.Results-class] or [data.frame] (**required**): -#' for [data.frame]: two columns with De `(data[,1])` and De error `(data[,2])` -#' -#' @param sigmab [numeric] (*with default*): -#' additional spread in De values. -#' This value represents the expected overdispersion in the data should the sample be -#' well-bleached (Cunningham & Walling 2012, p. 100). -#' **NOTE**: For the logged model (`log = TRUE`) this value must be -#' a fraction, e.g. 0.2 (= 20 \%). If the un-logged model is used (`log = FALSE`), -#' sigmab must be provided in the same absolute units of the De values (seconds or Gray). -#' -#' @param log [logical] (*with default*): -#' fit the (un-)logged central age model to De data -#' -#' @param ... currently not used. -#' -#' @return -#' Returns a terminal output. In addition an -#' [RLum.Results-class] object is returned containing the -#' following element: -#' -#' \item{.$summary}{[data.frame] summary of all relevant model results.} -#' \item{.$data}{[data.frame] original input data} -#' \item{.$args}{[list] used arguments} -#' \item{.$call}{[call] the function call} -#' -#' The output should be accessed using the function [get_RLum] -#' -#' @section Function version: 0.1.1 -#' -#' @author -#' Christoph Burow, University of Cologne (Germany) -#' -#' @seealso [calc_CentralDose], [calc_FiniteMixture], -#' [calc_FuchsLang2001], [calc_MinDose] -#' -#' @references -#' Galbraith, R.F. & Laslett, G.M., 1993. Statistical models for -#' mixed fission track ages. Nuclear Tracks Radiation Measurements 4, 459-470. -#' -#' Galbraith, R.F., Roberts, R.G., Laslett, G.M., Yoshida, H. & Olley, -#' J.M., 1999. Optical dating of single grains of quartz from Jinmium rock -#' shelter, northern Australia. Part I: experimental design and statistical -#' models. Archaeometry 41, 339-364. -#' -#' Galbraith, R.F. & Roberts, R.G., 2012. Statistical aspects of equivalent dose and error calculation and -#' display in OSL dating: An overview and some recommendations. Quaternary -#' Geochronology 11, 1-27. -#' -#' **Further reading** -#' -#' Arnold, L.J. & Roberts, R.G., 2009. Stochastic modelling of multi-grain equivalent dose -#' (De) distributions: Implications for OSL dating of sediment mixtures. -#' Quaternary Geochronology 4, 204-230. -#' -#' Bailey, R.M. & Arnold, L.J., 2006. Statistical modelling of single grain quartz De distributions and an -#' assessment of procedures for estimating burial dose. Quaternary Science -#' Reviews 25, 2475-2502. -#' -#' Cunningham, A.C. & Wallinga, J., 2012. Realizing the potential of fluvial archives using robust OSL chronologies. -#' Quaternary Geochronology 12, 98-106. -#' -#' Rodnight, H., Duller, G.A.T., Wintle, A.G. & Tooth, S., 2006. Assessing the reproducibility and accuracy -#' of optical dating of fluvial deposits. Quaternary Geochronology, 1 109-120. -#' -#' Rodnight, H., 2008. How many equivalent dose values are needed to -#' obtain a reproducible distribution?. Ancient TL 26, 3-10. -#' -#' @examples -#' -#' ## load example data -#' data(ExampleData.DeValues, envir = environment()) -#' -#' ## apply the common dose model -#' calc_CommonDose(ExampleData.DeValues$CA1) -#' -#' @md -#' @export -calc_CommonDose <- function( - data, - sigmab, - log=TRUE, - ... -) { - - ##============================================================================## - ## CONSISTENCY CHECK OF INPUT DATA - ##============================================================================## - - if (!is.data.frame(data) && !is(data,"RLum.Results")) { - stop("[calc_CentralDose] Error: 'data' object has to be of type ", - "'data.frame' or 'RLum.Results'!") - } - if (is(data, "RLum.Results")) { - data <- get_RLum(data, "data") - } - if (ncol(data) < 2) { - stop("[calc_FiniteMixture()] 'data' object must have two columns", - call. = FALSE) - } - if(!missing(sigmab)) { - if (sigmab < 0 || sigmab > 1) { - stop("[calc_FiniteMixture()] 'sigmab' must be a value between 0 and 1", - call. = FALSE) - } - } - - ## set expected column names - colnames(data)[1:2] <- c("ED", "ED_Error") - - - ##============================================================================## - ## ADDITIONAL ARGUMENTS - ##============================================================================## - settings <- list(verbose = TRUE) - settings <- modifyList(settings, list(...)) - - ##============================================================================## - ## CALCULATIONS - ##============================================================================## - - # set default value of sigmab - if (missing(sigmab)) sigmab<- 0 - - # calculate yu = log(ED) and su = se(logED) - if (log) { - yu<- log(data$ED) - su<- sqrt( (data$ED_Error/data$ED)^2 + sigmab^2 ) - } - else { - yu<- data$ED - su<- sqrt((data$ED_Error)^2 + sigmab^2) - } - - # calculate weights - wu<- 1/su^2 - delta<- sum(wu*yu)/sum(wu) - n<- length(yu) - - #standard error - sedelta<- 1/sqrt(sum(wu)) - if (!log) { - sedelta<- sedelta/delta - } - - if (log){ - delta<- exp(delta) - } - - ##============================================================================## - ## TERMINAL OUTPUT - ##============================================================================## - - if (settings$verbose) { - cat("\n [calc_CommonDose]") - cat(paste("\n\n----------- meta data --------------")) - cat(paste("\n n: ",n)) - cat(paste("\n log: ",if(log==TRUE){"TRUE"}else{"FALSE"})) - cat(paste("\n----------- dose estimate ----------")) - cat(paste("\n common dose: ", round(delta,2))) - cat(paste("\n SE: ", round(delta*sedelta, 2))) - cat(paste("\n rel. SE [%]: ", round(sedelta*100,2))) - cat(paste("\n------------------------------------\n\n")) - } - - ##============================================================================## - ## RETURN VALUES - ##============================================================================## - - summary<- data.frame(de=delta, - de_err=delta*sedelta) - - call<- sys.call() - args<- list(log=log, sigmab=sigmab) - - newRLumResults.calc_CommonDose<- set_RLum( - class = "RLum.Results", - data = list(summary = summary, - data = data, - args = args, - call = call)) - - invisible(newRLumResults.calc_CommonDose) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_CosmicDoseRate.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_CosmicDoseRate.R deleted file mode 100644 index ece95476c..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_CosmicDoseRate.R +++ /dev/null @@ -1,619 +0,0 @@ -#' Calculate the cosmic dose rate -#' -#' This function calculates the cosmic dose rate taking into account the soft- -#' and hard-component of the cosmic ray flux and allows corrections for -#' geomagnetic latitude, altitude above sea-level and geomagnetic field -#' changes. -#' -#' This function calculates the total cosmic dose rate considering both the -#' soft- and hard-component of the cosmic ray flux. -#' -#' **Internal calculation steps** -#' -#' (1) -#' Calculate total depth of all absorber in hg/cm^2 (1 hg/cm^2 = 100 g/cm^2) -#' -#' \deqn{absorber = depth_1*density_1 + depth_2*density_2 + ... + depth_n*density_n} -#' -#' -#' (2) -#' If `half.depth = TRUE` -#' -#' \deqn{absorber = absorber/2} -#' -#' -#' (3) -#' Calculate cosmic dose rate at sea-level and 55 deg. latitude -#' -#' a) If absorber is > 167 g/cm^2 (only hard-component; Allkofer et al. 1975): -#' apply equation given by Prescott & Hutton (1994) (c.f. Barbouti & Rastin -#' 1983) -#' -#' \deqn{D0 = C/(((absorber+d)^\alpha+a)*(absober+H))*exp(-B*absorber)} -#' -#' b) If absorber is < 167 g/cm^2 (soft- and hard-component): derive D0 from -#' Fig. 1 in Prescott & Hutton (1988). -#' -#' -#' (4) -#' Calculate geomagnetic latitude (Prescott & Stephan 1982, Prescott & -#' Hutton 1994) -#' -#' \deqn{\lambda = arcsin(0.203*cos(latitude)*cos(longitude-291)+0.979* -#' sin(latitude))} -#' -#' -#' (5) -#' Apply correction for geomagnetic latitude and altitude above sea-level. -#' Values for F, J and H were read from Fig. 3 shown in Prescott & Stephan -#' (1982) and fitted with 3-degree polynomials for lambda < 35 degree and a -#' linear fit for lambda > 35 degree. -#' -#' \deqn{Dc = D0*(F+J*exp((altitude/1000)/H))} -#' -#' -#' (6) -#' Optional: Apply correction for geomagnetic field changes in the last -#' 0-80 ka (Prescott & Hutton 1994). Correction and altitude factors are given -#' in Table 1 and Fig. 1 in Prescott & Hutton (1994). Values for altitude -#' factor were fitted with a 2-degree polynomial. The altitude factor is -#' operated on the decimal part of the correction factor. -#' -#' \deqn{Dc' = Dc*correctionFactor} -#' -#' -#' **Usage of `depth` and `density`** -#' -#' (1) If only one value for depth and density is provided, the cosmic dose -#' rate is calculated for exactly one sample and one absorber as overburden -#' (i.e. `depth*density`). -#' -#' (2) In some cases it might be useful to calculate the cosmic dose rate for a -#' sample that is overlain by more than one absorber, e.g. in a profile with -#' soil layers of different thickness and a distinct difference in density. -#' This can be calculated by providing a matching number of values for -#' `depth` and `density` (e.g. `depth = c(1, 2), density = c(1.7, 2.4)`) -#' -#' (3) Another possibility is to calculate the cosmic dose rate for more than -#' one sample of the same profile. This is done by providing more than one -#' values for `depth` and only one for `density`. For example, -#' `depth = c(1, 2, 3)` and `density = 1.7` will calculate the cosmic dose rate -#' for three samples in 1, 2 and 3 m depth in a sediment of density 1.7 g/cm^3. -#' -#' @param depth [numeric] (**required**): -#' depth of overburden (m). For more than one absorber use \cr -#' `c(depth_1, depth_2, ..., depth_n)` -#' -#' @param density [numeric] (**required**): -#' average overburden density (g/cm^3). For more than one absorber use \cr -#' `c(density_1, density_2, ..., density_n)` -#' -#' @param latitude [numeric] (**required**): -#' latitude (decimal degree), N positive -#' -#' @param longitude [numeric] (**required**): -#' longitude (decimal degree), E positive -#' -#' @param altitude [numeric] (**required**): -#' altitude (m above sea-level) -#' -#' @param corr.fieldChanges [logical] (*with default*): -#' correct for geomagnetic field changes after Prescott & Hutton (1994). -#' Apply only when justified by the data. -#' -#' @param est.age [numeric] (*with default*): -#' estimated age range (ka) for geomagnetic field change correction (0-80 ka allowed) -#' -#' @param half.depth [logical] (*with default*): -#' How to overcome with varying overburden thickness. If `TRUE` only half the -#' depth is used for calculation. Apply only when justified, i.e. when a constant -#' sedimentation rate can safely be assumed. -#' -#' @param error [numeric] (*with default*): -#' general error (percentage) to be implemented on corrected cosmic dose rate estimate -#' -#' @param ... further arguments (`verbose` to disable/enable console output). -#' -#' @return -#' Returns a terminal output. In addition an -#' [RLum.Results-class]-object is returned containing the -#' following element: -#' -#' \item{summary}{[data.frame] summary of all relevant calculation results.} -#' \item{args}{[list] used arguments} -#' \item{call}{[call] the function call} -#' -#' The output should be accessed using the function [get_RLum] -#' -#' @note -#' Despite its universal use the equation to calculate the cosmic dose -#' rate provided by Prescott & Hutton (1994) is falsely stated to be valid from -#' the surface to 10^4 hg/cm^2 of standard rock. The original expression by -#' Barbouti & Rastin (1983) only considers the muon flux (i.e. hard-component) -#' and is by their own definition only valid for depths between 10-10^4 -#' hg/cm^2. -#' -#' Thus, for near-surface samples (i.e. for depths < 167 g/cm^2) the equation -#' of Prescott & Hutton (1994) underestimates the total cosmic dose rate, as it -#' neglects the influence of the soft-component of the cosmic ray flux. For -#' samples at zero depth and at sea-level the underestimation can be as large -#' as ~0.1 Gy/ka. In a previous article, Prescott & Hutton (1988) give another -#' approximation of Barbouti & Rastin's equation in the form of -#' -#' \deqn{D = 0.21*exp(-0.070*absorber+0.0005*absorber^2)} -#' -#' which is valid for depths between 150-5000 g/cm^2. For shallower depths (< -#' 150 g/cm^2) they provided a graph (Fig. 1) from which the dose rate can be -#' read. -#' -#' As a result, this function employs the equation of Prescott & Hutton (1994) -#' only for depths > 167 g/cm^2, i.e. only for the hard-component of the cosmic -#' ray flux. Cosmic dose rate values for depths < 167 g/cm^2 were obtained from -#' the "AGE" program (Gruen 2009) and fitted with a 6-degree polynomial curve -#' (and hence reproduces the graph shown in Prescott & Hutton 1988). However, -#' these values assume an average overburden density of 2 g/cm^3. -#' -#' It is currently not possible to obtain more precise cosmic dose rate values -#' for near-surface samples as there is no equation known to the author of this -#' function at the time of writing. -#' -#' -#' @section Function version: 0.5.2 -#' -#' @author -#' Christoph Burow, University of Cologne (Germany) -#' -#' @seealso [BaseDataSet.CosmicDoseRate] -#' -#' @references -#' Allkofer, O.C., Carstensen, K., Dau, W.D., Jokisch, H., 1975. -#' Letter to the editor. The absolute cosmic ray flux at sea level. Journal of -#' Physics G: Nuclear and Particle Physics 1, L51-L52. -#' -#' Barbouti, A.I., Rastin, B.C., 1983. A study of the absolute intensity of muons at sea level -#' and under various thicknesses of absorber. Journal of Physics G: Nuclear and -#' Particle Physics 9, 1577-1595. -#' -#' Crookes, J.N., Rastin, B.C., 1972. An -#' investigation of the absolute intensity of muons at sea-level. Nuclear -#' Physics B 39, 493-508. -#' -#' Gruen, R., 2009. The "AGE" program for the -#' calculation of luminescence age estimates. Ancient TL 27, 45-46. -#' -#' Prescott, J.R., Hutton, J.T., 1988. Cosmic ray and gamma ray dosimetry for -#' TL and ESR. Nuclear Tracks and Radiation Measurements 14, 223-227. -#' -#' Prescott, J.R., Hutton, J.T., 1994. Cosmic ray contributions to dose rates -#' for luminescence and ESR dating: large depths and long-term time variations. -#' Radiation Measurements 23, 497-500. -#' -#' Prescott, J.R., Stephan, L.G., 1982. The contribution of cosmic radiation to the environmental dose for -#' thermoluminescence dating. Latitude, altitude and depth dependences. PACT 6, 17-25. -#' -#' @examples -#' -#' ##(1) calculate cosmic dose rate (one absorber) -#' calc_CosmicDoseRate(depth = 2.78, density = 1.7, -#' latitude = 38.06451, longitude = 1.49646, -#' altitude = 364, error = 10) -#' -#' ##(2a) calculate cosmic dose rate (two absorber) -#' calc_CosmicDoseRate(depth = c(5.0, 2.78), density = c(2.65, 1.7), -#' latitude = 38.06451, longitude = 1.49646, -#' altitude = 364, error = 10) -#' -#' ##(2b) calculate cosmic dose rate (two absorber) and -#' ##correct for geomagnetic field changes -#' calc_CosmicDoseRate(depth = c(5.0, 2.78), density = c(2.65, 1.7), -#' latitude = 12.04332, longitude = 4.43243, -#' altitude = 364, corr.fieldChanges = TRUE, -#' est.age = 67, error = 15) -#' -#' -#' ##(3) calculate cosmic dose rate and export results to .csv file -#' #calculate cosmic dose rate and save to variable -#' results<- calc_CosmicDoseRate(depth = 2.78, density = 1.7, -#' latitude = 38.06451, longitude = 1.49646, -#' altitude = 364, error = 10) -#' -#' # the results can be accessed by -#' get_RLum(results, "summary") -#' -#' #export results to .csv file - uncomment for usage -#' #write.csv(results, file = "c:/users/public/results.csv") -#' -#' ##(4) calculate cosmic dose rate for 6 samples from the same profile -#' ## and save to .csv file -#' #calculate cosmic dose rate and save to variable -#' results<- calc_CosmicDoseRate(depth = c(0.1, 0.5 , 2.1, 2.7, 4.2, 6.3), -#' density = 1.7, latitude = 38.06451, -#' longitude = 1.49646, altitude = 364, -#' error = 10) -#' -#' #export results to .csv file - uncomment for usage -#' #write.csv(results, file = "c:/users/public/results_profile.csv") -#' -#' @md -#' @export -calc_CosmicDoseRate<- function( - depth, - density, - latitude, - longitude, - altitude, - corr.fieldChanges = FALSE, - est.age = NA, - half.depth = FALSE, - error = 10, - ... -) { - - ##============================================================================## - ## ... ARGUMENTS - ##============================================================================## - settings <- list(verbose = TRUE) - settings <- modifyList(settings, list(...)) - - ##============================================================================## - ## CONSISTENCY CHECK OF INPUT DATA - ##============================================================================## - - if(any(depth < 0) || any(density < 0)) { - stop("[calc_CosmicDoseRate()] No negative values allowed for ", - "depth and density", call. = FALSE) - } - - if(corr.fieldChanges == TRUE) { - if(is.na(est.age) == TRUE) { - stop("[calc_CosmicDoseRate()] Correction for geomagnetic field ", - "changes requires an age estimate.", call. = FALSE) - } - if(est.age > 80) { - cat("\nCAUTION: No geomagnetic field change correction for samples", - "older >80 ka possible!") - corr.fieldChanges<- FALSE - } - } - - if(length(density) > length(depth)) { - stop("\nIf you provide more than one value for density please", - " provide an equal number of values for depth.", call. = FALSE) - } - - - ##============================================================================## - ## CALCULATIONS - ##============================================================================## - - - # initialize parameter for Prescott & Hutton (1994) equation - - C<- 6072 - B<- 0.00055 - d<- 11.6 - alpha<- 1.68 - a<- 75 - H<- 212 - - #variable needed to check if cosmic dose rate is calculated for more - #than one sample - - profile.mode<- FALSE - - #calculate absorber (hgcm) of one depth and one absorber [single sample] - if(length(depth)==1) { - hgcm<- depth*density - if(half.depth == TRUE) { - hgcm<- hgcm/2 - } - } - - #calculate total absorber of n depths and n densities [single sample] - if(length(depth)==length(density)){ - - hgcm<- 0 - - for(i in 1:length(depth)) { - hgcm<- hgcm + depth[i]*density[i] - } - if(half.depth == TRUE) { - hgcm<- hgcm/2 - } - } - - #if there are >1 depths and only one density, calculate - #absorber for each sample [multi sample] - if(length(depth) > length(density) & length(density) == 1) { - profile.mode<- TRUE - hgcm<- 1:length(depth) - for(i in 1:length(depth)) { - hgcm[i]<- depth[i]*density - } - if(half.depth == TRUE) { - hgcm<- hgcm/2 - } - profile.results<- data.frame(rbind(c(1:3)),cbind(1:length(depth))) - colnames(profile.results)<- c("depth (m)", "d0 (Gy/ka)", - "dc (Gy/ka)","dc_error (Gy/ka)") - } - - - for(i in 1:length(hgcm)) { - - - # calculate cosmic dose rate at sea-level for geomagnetic latitude 55 degrees - - if(hgcm[i]*100 >= 167) { - - d0<- (C/((((hgcm[i]+d)^alpha)+a)*(hgcm[i]+H)))*exp(-B*hgcm[i]) - - } - if(hgcm[i]*100 < 167) { - - temp.hgcm<- hgcm[i]*100 - d0.ph<- (C/((((hgcm[i]+d)^alpha)+a)*(hgcm[i]+H)))*exp(-B*hgcm[i]) - - if(hgcm[i]*100 < 40) { - d0<- -6*10^-8*temp.hgcm^3+2*10^-5*temp.hgcm^2-0.0025*temp.hgcm+0.2969 - } - else { - d0<- 2*10^-6*temp.hgcm^2-0.0008*temp.hgcm+0.2535 - } - if(d0.ph > d0) { - d0<- d0.ph - } - } - # Calculate geomagnetic latitude - gml.temp<- 0.203*cos((pi/180)*latitude)* - cos(((pi/180)*longitude)-(291*pi/180))+0.979* - sin((pi/180)*latitude) - true.gml<- asin(gml.temp)/(pi/180) - gml<- abs(asin(gml.temp)/(pi/180)) - - # Find values for F, J and H from graph shown in Prescott & Hutton (1994) - # values were read from the graph and fitted with 3 degree polynomials and a - # linear part - - if(gml < 36.5) { # Polynomial fit - - F_ph<- -7*10^-7*gml^3-8*10^-5*gml^2-0.0009*gml+0.3988 - } - else { # Linear fit - - F_ph<- -0.0001*gml + 0.2347 - - } - - if(gml < 34) { # Polynomial fit - - J_ph<- 5*10^-6*gml^3-5*10^-5*gml^2+0.0026*gml+0.5177 - - } - else { # Linear fit - J_ph<- 0.0005*gml + 0.7388 - } - - if(gml < 36) { # Polynomial fit - - H_ph<- -3*10^-6*gml^3-5*10^-5*gml^2-0.0031*gml+4.398 - - } - else { # Linear fit - - H_ph<- 0.0002*gml + 4.0914 - - } - - # Apply correction for geomagnetic latitude and altitude according to - # Prescott & Hutton (1994) - - dc<- d0*(F_ph + J_ph*exp((altitude/1000)/H_ph)) - - - ## Additional correction for geomagnetic field change - - if(corr.fieldChanges==TRUE) { - - if(gml <= 35) { - - # Correction matrix for geomagnetic field changes at - # sea-level (Prescott & Hutton (1994), Table 1) - - corr.matrix<- data.frame(rbind(1:5),1:7) - colnames(corr.matrix)<- c(0, 10, 20, 30, 35, ">35") - rownames(corr.matrix)<- c("0-5","5-10","10-15","15-20","20-35","35-50", - "50-80") - - corr.matrix[1,]<- c(0.97, 0.97, 0.98, 0.98, 0.98, 1.00) - corr.matrix[2,]<- c(0.99, 0.99, 0.99, 0.99, 0.99, 1.00) - corr.matrix[3,]<- c(1.00, 1.00, 1.00, 1.00, 1.00, 1.00) - corr.matrix[4,]<- c(1.01, 1.01, 1.01, 1.00, 1.00, 1.00) - corr.matrix[5,]<- c(1.02, 1.02, 1.02, 1.01, 1.00, 1.00) - corr.matrix[6,]<- c(1.03, 1.03, 1.02, 1.01, 1.00, 1.00) - corr.matrix[7,]<- c(1.02, 1.02, 1.02, 1.01, 1.00, 1.00) - - # Find corresponding correction factor for given geomagnetic latitude - - # determine column - if(gml <= 5) { corr.c<- 1 } - if(5 < gml) { - if(gml <= 15) { corr.c<- 2 } - } - if(15 < gml){ - if(gml <= 25) { corr.c<- 3 } - } - if(25 < gml){ - if(gml <= 32.5) { corr.c<- 4 } - } - if(32.5 < gml){ - if(gml <= 35) { corr.c<- 5 } - } - - # find row - if(est.age <= 5) { corr.fac<- corr.matrix[1,corr.c] } - if(5 < est.age) { - if(est.age <= 10) { corr.fac<- corr.matrix[2,corr.c] } - } - if(10 < est.age){ - if(est.age <= 15) { corr.fac<- corr.matrix[3,corr.c] } - } - if(15 < est.age){ - if(est.age <= 20) { corr.fac<- corr.matrix[4,corr.c] } - } - if(20 < est.age){ - if(est.age <= 35) { corr.fac<- corr.matrix[5,corr.c] } - } - if(35 < est.age){ - if(est.age <= 50) { corr.fac<- corr.matrix[6,corr.c] } - } - if(50 < est.age){ - if(est.age <= 80) { corr.fac<- corr.matrix[7,corr.c] } - } - - # Find altitude factor via fitted function 2-degree polynomial - # This factor is only available for positive altitudes - if(altitude > 0) { - - alt.fac<- -0.026*(altitude/1000)^2 + 0.6628*altitude/1000 + 1.0435 - - # Combine geomagnetic latitude correction with altitude - # correction (figure caption of Fig. 1 in Precott and Hutton (1994)) - - - diff.one<- corr.fac - 1 - corr.fac<- corr.fac + diff.one * alt.fac - - } - - # Final correction of cosmic dose rate - - dc<- dc * corr.fac - - if (settings$verbose) - print(paste("corr.fac",corr.fac,"diff.one",diff.one,"alt.fac",alt.fac)) - - } else { - if (settings$verbose) - cat(paste("\n No geomagnetic field change correction necessary for geomagnetic latitude >35 degrees!")) - } - } - - # calculate error - dc.err<- dc*error/100 - - # save intermediate results before next sample is calculated - if(profile.mode==TRUE) { - profile.results[i,1]<- round(depth[i],2) - profile.results[i,2]<- round(d0,4) - profile.results[i,3]<- round(dc,4) - profile.results[i,4]<- round(dc.err,4) - } - - }#END.OF.LOOP - - call<- sys.call() - args<- list(depth = depth, density = density, latitude = latitude, longitude = longitude, - altitude = altitude, corr.fieldChanges = corr.fieldChanges, est.age = est.age, - half.depth = half.depth, error = error) - - if(length(hgcm)==1) { - - ##============================================================================## - ##TERMINAL OUTPUT - ##============================================================================## - if (settings$verbose) { - cat("\n\n [calc_CosmicDoseRate]") - cat(paste("\n\n ---------------------------------------------------------")) - cat(paste("\n depth (m) :", depth)) - cat(paste("\n density (g cm^-3) :", density)) - cat(paste("\n latitude (N deg.) :", latitude)) - cat(paste("\n longitude (E deg.) :", longitude)) - cat(paste("\n altitude (m) :", altitude)) - cat(paste("\n ---------------------------------------------------------")) - cat(paste("\n total absorber (g cm^-2) :", round(hgcm[i]*100,3))) - cat(paste("\n")) - cat(paste("\n cosmic dose rate (Gy ka^-1) :", round(d0,4))) - cat(paste("\n [@sea-level & 55 deg. N G.lat]")) - cat(paste("\n")) - cat(paste("\n geomagnetic latitude (deg.) :", round(true.gml,1))) - cat(paste("\n")) - cat(paste("\n cosmic dose rate (Gy ka^-1) :", round(dc,4),"+-", - round(dc.err,4))) - cat(paste("\n [corrected] ")) - cat(paste("\n ---------------------------------------------------------\n\n")) - } - ##============================================================================## - ##RETURN VALUES - ##============================================================================## - - if(length(depth)==1) { - temp1<- data.frame(depth=depth,density=density) - } else { - - temp1a<- data.frame(rbind(c(1:length(depth)))) - tmpcoln1<- 1:length(depth) - - for(i in 1:length(depth)) { - temp1a[i]<- depth[i] - tmpcoln1[i]<- paste("depth",i) - } - - temp1b<- data.frame(rbind(c(1:length(density)))) - tmpcoln2<- 1:length(density) - - for(i in 1:length(density)) { - temp1b[i]<- density[i] - tmpcoln2[i]<- paste("density",i) - } - - colnames(temp1a)<- tmpcoln1 - colnames(temp1b)<- tmpcoln2 - temp1<- cbind(temp1a,temp1b) - } - - temp2<- data.frame(latitude=latitude,longitude=longitude, - altitude=altitude,total_absorber.gcm2=hgcm*100, - d0=d0,geom_lat=true.gml,dc=dc) - - summary<- data.frame(cbind(temp1,temp2)) - - newRLumResults.calc_CosmicDoseRate <- set_RLum( - class = "RLum.Results", - data = list(summary=summary, - args=args, - call=call)) - - # Return values - invisible(newRLumResults.calc_CosmicDoseRate) - - } else { - - #terminal output - if (settings$verbose) { - cat("\n\n [calc_CosmicDoseRate]") - cat(paste("\n\n Calculating cosmic dose rate for",length(depth), - "samples. \n\n")) - print(profile.results) - } - - #return value - add.info<- data.frame(latitude=latitude,longitude=longitude, - altitude=altitude,total_absorber.gcm2=hgcm*100, - geom_lat=true.gml) - add.info<- rbind(add.info*length(i)) - colnames(profile.results)<- c("depth","d0","dc","dc_err") - - summary<- data.frame(cbind(profile.results,add.info)) - - newRLumResults.calc_CosmicDoseRate <- set_RLum( - class = "RLum.Results", - data = list(summary=summary, - args=args, - call=call)) - - # Return values - invisible(newRLumResults.calc_CosmicDoseRate) - - } -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_FadingCorr.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_FadingCorr.R deleted file mode 100644 index accac9e2a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_FadingCorr.R +++ /dev/null @@ -1,484 +0,0 @@ -#'@title Fading Correction after Huntley & Lamothe (2001) -#' -#'@description Apply a fading correction according to Huntley & Lamothe (2001) for a given -#'\eqn{g}-value and a given \eqn{t_{c}} -#' -#'@details -#'This function solves the equation used for correcting the fading affected age -#'including the error for a given \eqn{g}-value according to Huntley & Lamothe (2001): -#' -#'\deqn{ -#'\frac{A_{f}}{A} = 1 - \kappa * \Big[ln(\frac{A}{t_c}) - 1\Big] -#'} -#' -#'with \eqn{\kappa} defined as -#' -#'\deqn{ -#'\kappa = \frac{\frac{\mathrm{g\_value}}{ln(10)}}{100} -#'} -#' -#' \eqn{A} and \eqn{A_{f}} are given in ka. \eqn{t_c} is given in s, however, it -#' is internally recalculated to ka. -#' -#' As the \eqn{g}-value slightly depends on the time between irradiation and the -#' prompt measurement, this is \eqn{t_{c}}, always a \eqn{t_{c}} value needs to be provided. -#' If the \eqn{g}-value was normalised to a distinct -#' time or evaluated with a different tc value (e.g., external irradiation), also -#' the \eqn{t_{c}} value for the \eqn{g}-value needs to be provided (argument `tc.g_value` -#' and then the \eqn{g}-value is recalculated -#' to \eqn{t_{c}} of the measurement used for estimating the age applying the -#' following equation: -#' -#' \deqn{\kappa_{tc} = \kappa_{tc.g} / (1 - \kappa_{tc.g} * ln(tc/tc.g))} -#' -#' where -#' -#' \deqn{\kappa_{tc.g} = g / 100 / ln(10)} - -#' -#' The error of the fading-corrected age is determined using a Monte Carlo -#' simulation approach. Solving of the equation is realised using -#' [uniroot]. Large values for `n.MC` will significantly -#' increase the computation time.\cr -#' -#' **`n.MC = 'auto'`** -#' -#' The error estimation based on a stochastic process, i.e. for a small number of -#' MC runs the calculated error varies considerably every time the function is called, -#' even with the same input values. -#' The argument option `n.MC = 'auto'` tries to find a stable value for the standard error, i.e. -#' the standard deviation of values calculated during the MC runs (`age.corr.MC`), -#' within a given precision (2 digits) by increasing the number of MC runs stepwise and -#' calculating the corresponding error. -#' -#' If the determined error does not differ from the 9 values calculated previously -#' within a precision of (here) 3 digits the calculation is stopped as it is assumed -#' that the error is stable. Please note that (a) the duration depends on the input -#' values as well as on the provided computation resources and it may take a while, -#' (b) the length (size) of the output -#' vector `age.corr.MC`, where all the single values produced during the MC runs -#' are stored, equals the number of MC runs (here termed observations). -#' -#' To avoid an endless loop the calculation is stopped if the number of observations -#' exceeds 10^7. -#' This limitation can be overwritten by setting the number of MC runs manually, -#' e.g. `n.MC = 10000001`. Note: For this case the function is not checking whether the calculated -#' error is stable.\cr -#' -#' **`seed`** -#' -#' This option allows to recreate previously calculated results by setting the seed -#' for the R random number generator (see [set.seed] for details). This option -#' should not be mixed up with the option **`n.MC = 'auto'`**. The results may -#' appear similar, but they are not comparable!\cr -#' -#' **FAQ**\cr -#' -#' **Q**: Which \eqn{t_{c}} value is expected?\cr -#' -#' **A**: \eqn{t_{c}} is the time in seconds between irradiation and the prompt measurement -#' applied during your \eqn{D_{e}} measurement. However, this \eqn{t_{c}} might -#' differ from the \eqn{t_{c}} used for estimating the \eqn{g}-value. In the -#' case of an SAR measurement \eqn{t_{c}} should be similar, however, -#' if it differs, you have to provide this -#' \eqn{t_{c}} value (the one used for estimating the \eqn{g}-value) using -#' the argument `tc.g_value`.\cr -#' -#' **Q**: The function could not find a solution, what should I do?\cr -#' -#' **A**: This usually happens for model parameters exceeding the boundaries of the -#' fading correction model (e.g., very high \eqn{g}-value). Please check -#' whether another fading correction model might be more appropriate. -#' -#' @param age.faded [numeric] [vector] (**required**): -#' uncorrected age with error in ka (see example) -#' -#' @param g_value [vector] (**required**): -#' g-value and error obtained from separate fading measurements (see example). -#' Alternatively an [RLum.Results-class] object can be provided produced by the function -#' [analyse_FadingMeasurement], in this case `tc` is set automatically -#' -#' @param tc [numeric] (**required**): -#' time in seconds between irradiation and the prompt measurement (cf. Huntley & Lamothe 2001). -#' Argument will be ignored if `g_value` was an [RLum.Results-class] object -#' -#' @param tc.g_value [numeric] (*with default*): -#' the time in seconds between irradiation and the prompt measurement used for estimating the g-value. -#' If the g-value was normalised to, e.g., 2 days, this time in seconds (i.e., 172800) should be given here. -#' If nothing is provided the time is set to tc, which is usual case for g-values obtained using the -#' SAR method and \eqn{g}-values that had been not normalised to 2 days. -#' -#' @param n.MC [integer] (*with default*): -#' number of Monte Carlo simulation runs for error estimation. -#' If `n.MC = 'auto'` is used the function tries to find a 'stable' error for the age. -#' **Note:** This may take a while! -#' -#' @param seed [integer] (*optional*): -#' sets the seed for the random number generator in R using [set.seed] -#' -#' @param interval [numeric] (*with default*): -#' a vector containing the end-points (age interval) of the interval to be searched for the root in 'ka'. -#' This argument is passed to the function [stats::uniroot] used for solving the equation. -#' -#' @param txtProgressBar [logical] (*with default*): -#' enables or disables [txtProgressBar] -#' -#' @param verbose [logical] (*with default*): -#' enables or disables terminal output -#' -#' -#' @return Returns an S4 object of type [RLum.Results-class].\cr -#' -#' Slot: **`@data`**\cr -#' \tabular{lll}{ -#' **Object** \tab **Type** \tab **Comment** \cr -#' `age.corr` \tab [data.frame] \tab Corrected age \cr -#' `age.corr.MC` \tab [numeric] \tab MC simulation results with all possible ages from that simulation \cr -#' } -#' -#' Slot: **`@info`**\cr -#' -#' \tabular{lll}{ -#' **Object** \tab **Type** \tab **Comment** \cr -#' `info` \tab [character] \tab the original function call -#' } -#' -#' -#' @note Special thanks to Sébastien Huot for his support and clarification via e-mail. -#' -#' -#' @section Function version: 0.4.3 -#' -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' -#' @seealso [RLum.Results-class], [analyse_FadingMeasurement], [get_RLum], [uniroot] -#' -#' -#' @references -#' Huntley, D.J., Lamothe, M., 2001. Ubiquity of anomalous fading -#' in K-feldspars and the measurement and correction for it in optical dating. -#' Canadian Journal of Earth Sciences, 38, 1093-1106. -#' -#' -#' @keywords datagen -#' -#' -#' @examples -#' -#' ##run the examples given in the appendix of Huntley and Lamothe, 2001 -#' -#' ##(1) faded age: 100 a -#' results <- calc_FadingCorr( -#' age.faded = c(0.1,0), -#' g_value = c(5.0, 1.0), -#' tc = 2592000, -#' tc.g_value = 172800, -#' n.MC = 100) -#' -#' ##(2) faded age: 1 ka -#' results <- calc_FadingCorr( -#' age.faded = c(1,0), -#' g_value = c(5.0, 1.0), -#' tc = 2592000, -#' tc.g_value = 172800, -#' n.MC = 100) -#' -#' ##(3) faded age: 10.0 ka -#' results <- calc_FadingCorr( -#' age.faded = c(10,0), -#' g_value = c(5.0, 1.0), -#' tc = 2592000, -#' tc.g_value = 172800, -#' n.MC = 100) -#' -#' ##access the last output -#' get_RLum(results) -#' -#' @md -#' @export -calc_FadingCorr <- function( - age.faded, - g_value, - tc = NULL, - tc.g_value = tc, - n.MC = 10000, - seed = NULL, - interval = c(0.01,500), - txtProgressBar = TRUE, - verbose = TRUE -){ - - # Integrity checks --------------------------------------------------------------------------- - stopifnot(!missing(age.faded), !missing(g_value)) - - ##check input - if(inherits(g_value, "RLum.Results")){ - if(g_value@originator == "analyse_FadingMeasurement"){ - tc <- get_RLum(g_value)[["TC"]] - g_value <- as.numeric(get_RLum(g_value)[,c("FIT", "SD")]) - - }else{ - message("[calc_FadingCorr()] Error: Unknown originator for the ", - "provided RLum.Results object via 'g_value'!") - return(NULL) - } - } - - ##check if tc is still NULL - if(is.null(tc[1])) - stop("[calc_FadingCorr()] 'tc' needs to be set!", call. = FALSE) - - ##check type - if(!all(is(age.faded, "numeric") && is(g_value, "numeric") && is(tc, "numeric"))) - stop("[calc_FadingCorr()] 'age.faded', 'g_value' and 'tc' need be of type numeric!", call. = FALSE) - - ##============================================================================## - ##DEFINE FUNCTION - ##============================================================================## - f <- function(x, af, kappa, tc) { - 1 - kappa * (log(x / tc) - 1) - (af / x) - } - - ##============================================================================## - ##CALCULATION - ##============================================================================## - - ##recalculate the g-value to the given tc ... should be similar - ##of tc = tc.g_value - ##re-calculation thanks to the help by Sebastien Huot, e-mail: 2016-07-19 - ##Please note that we take the vector for the g_value here - k0 <- g_value / 100 / log(10) - k1 <- k0 / (1 - k0 * log(tc[1]/tc.g_value[1])) - g_value <- 100 * k1 * log(10) - - ##calculate kappa (equation [5] in Huntley and Lamothe, 2001) - kappa <- g_value / log(10) / 100 - - ##transform tc in ka years - ##duration of the year over a long term taken from http://wikipedia.org - tc <- tc[1] / 60 / 60 / 24 / 365.2425 / 1000 - tc.g_value <- tc.g_value[1] / 60 / 60 / 24 / 365.2425 / 1000 - - ##calculate mean value - temp <- - try(suppressWarnings(uniroot( - f, - interval = interval, - tol = 0.0001, - tc = tc, - extendInt = "yes", - af = age.faded[1], - kappa = kappa[1], - check.conv = TRUE - )), silent = TRUE) - - if(inherits(temp, "try-error")){ - message("[calc_FadingCorr()] No solution found, return NULL. This usually happens for very large, unrealistic g-values. Please consider another model for the fading correction!") - return(NULL) - - } - - ##--------------------------------------------------------------------------## - ##Monte Carlo simulation for error estimation - tempMC.sd.recent <- NA - tempMC.sd.count <- 1:10 - counter <- 1 - - ## show a progress bar of the process - if (n.MC == 'auto') { - n.MC.i <- 10000 - - cat("\n[calc_FadingCorr()] ... trying to find stable error value ...") - if (txtProgressBar) { - cat("\n -------------------------------------------------------------\n") - cat(paste0(" ",paste0("(",0:9,")", collapse = " "), "\n")) - } - }else{ - n.MC.i <- n.MC - - } - - - - # Start loop --------------------------------------------------------------------------------- - - ##set object and preallocate memory - tempMC <- vector("numeric", length = 1e+07) - tempMC[] <- NA - i <- 1 - j <- n.MC.i - - while(length(unique(tempMC.sd.count))>1 | j > 1e+07){ - - ##set previous - if(!is.na(tempMC.sd.recent)){ - tempMC.sd.count[counter] <- tempMC.sd.recent - - } - - ##set seed - if (!is.null(seed)) set.seed(seed) - - ##pre-allocate memory - g_valueMC <- vector("numeric", length = n.MC.i) - age.fadeMC <- vector("numeric", length = n.MC.i) - kappaMC <- vector("numeric", length = n.MC.i) - - ##set-values - g_valueMC <- rnorm(n.MC.i,mean = g_value[1],sd = g_value[2]) - age.fadedMC <- rnorm(n.MC.i,mean = age.faded[1],sd = age.faded[2]) - kappaMC <- g_valueMC / log(10) / 100 - - ##calculate for all values - tempMC[i:j] <- suppressWarnings(vapply(X = 1:length(age.fadedMC), FUN = function(x) { - temp <- try(uniroot( - f, - interval = interval, - tol = 0.001, - tc = tc, - af = age.fadedMC[[x]], - kappa = kappaMC[[x]], - check.conv = TRUE, - maxiter = 1000, - extendInt = "yes" - ), silent = TRUE) - - ##otherwise the automatic error value finding - ##will never work - res <- NA - if(!is(temp,"try-error") && temp$root<1e8) { - res <- temp$root - } - return(res) - - }, FUN.VALUE = 1)) - - i <- j + 1 - j <- j + n.MC.i - - ##stop here if a fixed value is set - if(n.MC != 'auto'){ - break - } - - ##set recent - tempMC.sd.recent <- round(sd(tempMC, na.rm = TRUE), digits = 3) - - if (counter %% 10 == 0) { - counter <- 1 - - }else{ - counter <- counter + 1 - - } - - ##show progress in terminal - if (txtProgressBar) { - text <- rep("CHECK",10) - if (counter %% 2 == 0) { - text[1:length(unique(tempMC.sd.count))] <- "-----" - }else{ - text[1:length(unique(tempMC.sd.count))] <- " CAL " - } - - - - cat(paste("\r ",paste(rev(text), collapse = " "))) - } - - } - - ##--------------------------------------------------------------------------## - - ##remove all NA values from tempMC - tempMC <- tempMC[!is.na(tempMC)] - - ##obtain corrected age - age.corr <- data.frame( - AGE = round(temp$root, digits = 4), - AGE.ERROR = round(sd(tempMC), digits = 4), - AGE_FADED = age.faded[1], - AGE_FADED.ERROR = age.faded[2], - G_VALUE = g_value[1], - G_VALUE.ERROR = g_value[2], - KAPPA = kappa[1], - KAPPA.ERROR = kappa[2], - TC = tc, - TC.G_VALUE = tc.g_value, - n.MC = n.MC, - OBSERVATIONS = length(tempMC), - SEED = ifelse(is.null(seed), NA, seed) - ) - - ##============================================================================## - ##OUTPUT VISUAL - ##============================================================================## - if(verbose) { - cat("\n\n[calc_FadingCorr()]\n") - cat("\n >> Fading correction according to Huntley & Lamothe (2001)") - - if (tc != tc.g_value) { - cat("\n >> g-value re-calculated for the given tc") - - } - - cat(paste( - "\n\n .. used g-value:\t", - round(g_value[1], digits = 3), - " \u00b1 ", - round(g_value[2], digits = 3), - " %/decade", - sep = "" - )) - cat(paste( - "\n .. used tc:\t\t", - format(tc, digits = 4, scientific = TRUE), - " ka", - sep = "" - )) - cat(paste0( - "\n .. used kappa:\t\t", - round(kappa[1], digits = 4), - " \u00b1 ", - round(kappa[2], digits = 4) - )) - cat("\n ----------------------------------------------") - cat(paste0("\n seed: \t\t\t", ifelse(is.null(seed), NA, seed))) - cat(paste0("\n n.MC: \t\t\t", n.MC)) - cat(paste0( - "\n observations: \t\t", - format(length(tempMC), digits = 2, scientific = TRUE), - sep = "" - )) - cat("\n ----------------------------------------------") - cat(paste0( - "\n Age (faded):\t\t", - round(age.faded[1], digits = 4), - " ka \u00b1 ", - round(age.faded[2], digits = 4), - " ka" - )) - cat(paste0( - "\n Age (corr.):\t\t", - round(age.corr[1], digits = 4), - " ka \u00b1 ", - round(age.corr[2], digits = 4), - " ka" - )) - cat("\n ---------------------------------------------- \n") - - } - - ##============================================================================## - ##OUTPUT RLUM - ##============================================================================## - return(set_RLum( - class = "RLum.Results", - data = list(age.corr = age.corr, - age.corr.MC = tempMC), - info = list(call = sys.call()) - )) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_FastRatio.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_FastRatio.R deleted file mode 100644 index d0612a106..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_FastRatio.R +++ /dev/null @@ -1,412 +0,0 @@ -#' Calculate the Fast Ratio for CW-OSL curves -#' -#' Function to calculate the fast ratio of quartz CW-OSL single grain or single -#' aliquot curves after Durcan & Duller (2011). -#' -#' This function follows the equations of Durcan & Duller (2011). The energy -#' required to reduce the fast and medium quartz OSL components to `x` and -#' `x2` \% respectively using eq. 3 to determine channels L2 and L3 (start -#' and end). The fast ratio is then calculated from: \eqn{(L1-L3)/(L2-L3)}. -#' -#' @param object [RLum.Analysis-class], [RLum.Data.Curve-class] or [data.frame] (**required**): -#' x, y data of measured values (time and counts). -#' -#' @param stimulation.power [numeric] (*with default*): -#' Stimulation power in mW/cm^2 -#' -#' @param wavelength [numeric] (*with default*): -#' Stimulation wavelength in nm -#' -#' @param sigmaF [numeric] (*with default*): -#' Photoionisation cross-section (cm^2) of the fast component. -#' Default value after Durcan & Duller (2011). -#' -#' @param sigmaM [numeric] (*with default*): -#' Photoionisation cross-section (cm^2) of the medium component. -#' Default value after Durcan & Duller (2011). -#' -#' @param Ch_L1 [numeric] (*with default*): -#' An integer specifying the channel for L1. -#' -#' @param Ch_L2 [numeric] (*optional*): -#' An integer specifying the channel for L2. -#' @param x [numeric] (*with default*): -#' -#' @param Ch_L3 [numeric] (*optional*): -#' A vector of length 2 with integer values specifying the start and end -#' channels for L3 (e.g., `c(40, 50)`), with the second component greater -#' than or equal to the first. -#' -#' \% of signal remaining from the fast component. -#' Used to define the location of L2 and L3 (start). -#' -#' @param x2 [numeric] (*with default*): -#' \% of signal remaining from the medium component. -#' Used to define the location of L3 (end). -#' -#' @param dead.channels [numeric] (*with default*): -#' Vector of length 2 in the form of `c(x, y)`. -#' Channels that do not contain OSL data, i.e. at the start or end of measurement. -#' -#' @param fitCW.sigma [logical] (*optional*): -#' fit CW-OSL curve using [fit_CWCurve] to calculate `sigmaF` and `sigmaM` (**experimental**). -#' -#' @param fitCW.curve [logical] (*optional*): -#' fit CW-OSL curve using [fit_CWCurve] and derive the counts of L2 and L3 -#' from the fitted OSL curve (**experimental**). -#' -#' @param plot [logical] (*with default*): -#' plot output (`TRUE`/`FALSE`) -#' -#' @param ... available options: `verbose` ([logical]). -#' Further arguments passed to [fit_CWCurve]. -#' -#' @return -#' Returns a plot (*optional*) and an S4 object of type [RLum.Results-class]. -#' The slot `data` contains a [list] with the following elements: -#' -#' \item{summary}{[data.frame] summary of all relevant results} -#' \item{data}{the original input data} -#' \item{fit}{[RLum.Results-class] object if either `fitCW.sigma` or `fitCW.curve` is `TRUE`} -#' \item{args}{[list] of used arguments} -#' \item{call}{`[call]` the function call} -#' -#' @section Function version: 0.1.1 -#' -#' @author -#' Georgina E. King, University of Bern (Switzerland) \cr -#' Julie A. Durcan, University of Oxford (United Kingdom) \cr -#' Christoph Burow, University of Cologne (Germany) -#' -#' @references -#' Durcan, J.A. & Duller, G.A.T., 2011. The fast ratio: A rapid measure for testing -#' the dominance of the fast component in the initial OSL signal from quartz. -#' Radiation Measurements 46, 1065-1072. -#' -#' Madsen, A.T., Duller, G.A.T., Donnelly, J.P., Roberts, H.M. & Wintle, A.G., 2009. -#' A chronology of hurricane landfalls at Little Sippewissett Marsh, Massachusetts, USA, -#' using optical dating. Geomorphology 109, 36-45. -#' -#' **Further reading** -#' -#' Steffen, D., Preusser, F. & Schlunegger, 2009. OSL quartz age underestimation -#' due to unstable signal components. Quaternary Geochronology 4, 353-362. -#' -#' -#' @seealso [fit_CWCurve], [get_RLum], [RLum.Analysis-class], -#' [RLum.Results-class], [RLum.Data.Curve-class] -#' -#' @examples -#' # load example CW-OSL curve -#' data("ExampleData.CW_OSL_Curve") -#' -#' # calculate the fast ratio w/o further adjustments -#' res <- calc_FastRatio(ExampleData.CW_OSL_Curve) -#' -#' # show the summary table -#' get_RLum(res) -#' -#' @md -#' @export -calc_FastRatio <- function(object, - stimulation.power = 30.6, - wavelength = 470, - sigmaF = 2.6E-17, - sigmaM = 4.28E-18, - Ch_L1 = 1, - Ch_L2 = NULL, - Ch_L3 = NULL, - x = 1, - x2 = 0.1, - dead.channels = c(0,0), - fitCW.sigma = FALSE, - fitCW.curve = FALSE, - plot = TRUE, - ...) { - - ## Input verification -------------------------------------------------------- - .validate_positive_scalar(Ch_L1, int = TRUE) - .validate_positive_scalar(Ch_L2, int = TRUE, null.ok = TRUE) - if (!is.null(Ch_L3)) { - if (!is.numeric(Ch_L3) || length(Ch_L3) != 2) { - .throw_error("Input for 'Ch_L3' must be a vector of length 2") - } - .validate_positive_scalar(Ch_L3[1], int = TRUE, name = "Ch_L3[1]") - .validate_positive_scalar(Ch_L3[2], int = TRUE, name = "Ch_L3[2]") - if (Ch_L3[1] > Ch_L3[2]) { - .throw_error("Ch_L3[2] must be greater than or equal to Ch_L3[1]") - } - } - - ## Input object handling ----------------------------------------------------- - if (inherits(object, "RLum.Analysis")) - object <- get_RLum(object) - - if (inherits(object, "RLum.Results")) - object <- get_RLum(object, "data") - - if (!inherits(object, "list")) - object <-list(object) - - - ## Settings ------------------------------------------------------------------ - settings <- list(verbose = TRUE, - n.components.max = 3, - fit.method = "LM", - output.terminal = FALSE, - info = list(), - fit = NULL) - - # override defaults with args in ... - settings <- modifyList(settings, list(...)) - - - ## Calculations -------------------------------------------------------------- - # iterate over all user provided objects and calculate the FR - fast.ratios <- lapply(object, function(obj) { - - if (inherits(obj, "RLum.Data.Curve")) - A <- get_RLum(obj) - else - A <- obj - - ## Energy calculation - # P = user defined stimulation power in mW - # lambdaLED = wavelength of stimulation source in nm - P <- stimulation.power - lamdaLED <- wavelength - - ## Constants - # h = speed of light, h = Planck's constant - h <- 6.62607004E-34 - c <- 299792458 - - I0 <- (P / 1000) / (h * c / (lamdaLED * 10^-9)) - Ch_width <- max(A[ ,1]) / length(A[ ,1]) - - # remove dead channels - A <- as.data.frame(A[(dead.channels[1] + 1):(nrow(A)-dead.channels[2]), ]) - A[ ,1] <- A[ ,1] - A[1,1] - - # estimate the photo-ionisation crossections of the fast and medium - # component using the fit_CWCurve function - if (fitCW.sigma | fitCW.curve) { - fitCW.res <- try(fit_CWCurve(A, n.components.max = settings$n.components.max, - fit.method = settings$fit.method, - LED.power = stimulation.power, - LED.wavelength = wavelength, - output.terminal = settings$output.terminal, - plot = plot)) - settings$fit <- fitCW.res - - if (fitCW.sigma) { - if (!inherits(fitCW.res, "try-error")) { - sigmaF <- get_RLum(fitCW.res)$cs1 - sigmaM <- get_RLum(fitCW.res)$cs2 - if (settings$verbose) { - message("\n [calc_FitCWCurve()]\n") - message("New value for sigmaF: ", format(sigmaF, digits = 3, nsmall = 2)) - message("New value for sigmaM: ", format(sigmaM, digits = 3, nsmall = 2)) - } - } else { - if (settings$verbose) - message("Fitting failed! Please call 'fit_CWCurve()' manually before ", - "calculating the fast ratio.") - } - } - - if (fitCW.curve) { - if (!inherits(fitCW.res, "try-error")) { - nls <- get_RLum(fitCW.res, "fit") - A[ ,2] <- predict(nls) - } - } - - } - - - ## The equivalent time in s of L1, L2, L3 - # Use these values to look up the channel - t_L1 <- 0 - - if (is.null(Ch_L2)) - t_L2 <- (log(x / 100)) / (-sigmaF * I0) - else - t_L2 <- A[Ch_L2, 1] - - if (is.null(Ch_L3)) { - t_L3_start <- (log(x / 100)) / (-sigmaM * I0) - t_L3_end <- (log(x2 / 100)) / (-sigmaM * I0) - } else { - if (any(Ch_L3 > nrow(A))) { - .throw_error("Value in Ch_L3 (", paste(Ch_L3, collapse = ", "), - ") exceeds number of available channels (", nrow(A), ")", - nframe = 3) # we are inside an lapply closure - } - t_L3_start <- A[Ch_L3[1], 1] - t_L3_end <- A[Ch_L3[2], 1] - } - - ## Channel number(s) of L2 and L3 - if (is.null(Ch_L2)) - Ch_L2 <- which.min(abs(A[,1] - t_L2)) - - if (Ch_L2 <= 1) { - msg <- sprintf("Calculated time/channel for L2 is too small (%.f, %.f). Returned NULL.", - t_L2, Ch_L2) - settings$info <- modifyList(settings$info, list(L2 = msg)) - warning(msg, call. = FALSE) - return(NULL) - } - - Ch_L3st<- which.min(abs(A[,1] - t_L3_start)) - Ch_L3end <- which.min(abs(A[,1] - t_L3_end)) - - ## Counts in channels L1, L2, L3 - # L1 ---- - Cts_L1 <- A[Ch_L1, 2] - - # L2 ---- - if (Ch_L2 > nrow(A)) { - msg <- sprintf(paste("The calculated channel for L2 (%i) exceeds", - "the number of available channels (%i).", - "Returned NULL."), Ch_L2, nrow(A)) - settings$info <- modifyList(settings$info, list(L2 = msg)) - warning(msg, call. = FALSE) - return(NULL) - } - - Cts_L2 <- A[Ch_L2, 2] - - # optional: predict the counts from the fitted curve - if (fitCW.curve) { - if (!inherits(fitCW.res, "try-error")) { - nls <- get_RLum(fitCW.res, "fit") - Cts_L2 <- predict(nls, list(x = t_L2)) - } - } - - - # L3 ---- - if (Ch_L3st >= nrow(A) | Ch_L3end > nrow(A)) { - msg <- sprintf(paste("The calculated channels for L3 (%i, %i) exceed", - "the number of available channels (%i).", - "\nThe background has instead been estimated from the last", - "5 channels."), Ch_L3st, Ch_L3end, nrow(A)) - settings$info <- modifyList(settings$info, list(L3 = msg)) - warning(msg, call. = FALSE) - Ch_L3st <- nrow(A) - 5 - Ch_L3end <- nrow(A) - t_L3_start <- A[Ch_L3st,1] - t_L3_end <- A[Ch_L3end,1] - } - - Cts_L3 <- mean(A[Ch_L3st:Ch_L3end, 2]) - - # optional: predict the counts from the fitted curve - if (fitCW.curve) { - if (!inherits(fitCW.res, "try-error")) { - nls <- get_RLum(fitCW.res, "fit") - Cts_L3 <- mean(predict(nls, list(x = c(t_L3_start, t_L3_end)))) - } - } - - # Warn if counts are not in decreasing order - if (Cts_L3 >= Cts_L2) - warning(sprintf("L3 contains more counts (%.f) than L2 (%.f).", - Cts_L3, Cts_L2), call. = FALSE) - - ## Fast Ratio - FR <- (Cts_L1 - Cts_L3) / (Cts_L2 - Cts_L3) - if (length(FR) != 1) - FR <- NA - - ## Fast Ratio - Error calculation - FR_se <- NA - FR_rse <- NA - if (!is.na(FR)) { - - # number of channels the background was derived from - nBG <- abs(Ch_L3end - Ch_L3st) - - # relative standard errors - rse_L1 <- sqrt(Cts_L1 + Cts_L3 / nBG) / (Cts_L1 - Cts_L3) - rse_L2 <- sqrt(Cts_L2 + Cts_L3 / nBG) / (Cts_L2 - Cts_L3) - - # absolute standard errors - se_L1 <- rse_L1 * (Cts_L1 - Cts_L3) - se_L2 <- rse_L2 * (Cts_L2 - Cts_L3) - - # absolute standard error on fast ratio - FR_se <- (sqrt((se_L1 / (Cts_L1 - Cts_L3))^2 + ((se_L2 / (Cts_L2 - Cts_L3))^2) )) * FR - FR_rse <- FR_se / FR * 100 - } - - ## Return values ----------------------------------------------------------- - summary <- data.frame(fast.ratio = FR, - fast.ratio.se = FR_se, - fast.ratio.rse = FR_rse, - channels = nrow(A), - channel.width = Ch_width, - dead.channels.start = as.integer(dead.channels[1]), - dead.channels.end = as.integer(dead.channels[2]), - sigmaF = sigmaF, - sigmaM = sigmaM, - I0 = I0, - stimulation.power = stimulation.power, - wavelength = wavelength, - t_L1 = t_L1, - t_L2 = t_L2, - t_L3_start = t_L3_start, - t_L3_end = t_L3_end, - Ch_L1 = as.integer(Ch_L1), - Ch_L2 = as.integer(Ch_L2), - Ch_L3_start = as.integer(Ch_L3st), - Ch_L3_end = as.integer(Ch_L3end), - Cts_L1 = Cts_L1, - Cts_L2 = Cts_L2, - Cts_L3 = Cts_L3) - - fast.ratio <- set_RLum(class = "RLum.Results", - originator = "calc_FastRatio", - data = list(summary = summary, - data = obj, - fit = settings$fit, - args = as.list(sys.call(-2L)[-1]), - call = sys.call(-2L)), - info = settings$info - ) - - ## Console Output ---------------------------------------------------------- - if (settings$verbose) { - - table.names <- c( - "Fast Ratio\t", " \U02EA Absolute error", " \U02EA Relative error (%)", "Channels\t", - "Channel width (s)", "Dead channels start", "Dead channels end", - "Sigma Fast\t", "Sigma Medium\t", "I0\t\t", "Stim. power (mW/cm^2)", "Wavelength (nm)", - "-\n Time L1 (s)\t", "Time L2 (s)\t", "Time L3 start (s)", "Time L3 end (s)", - "-\n Channel L1\t", "Channel L2\t", "Channel L3 start", "Channel L3 end\t", - "-\n Counts L1\t", "Counts L2\t", "Counts L3\t") - - cat("\n[calc_FastRatio()]\n") - cat("\n -------------------------------") - for (i in 1:ncol(summary)) { - cat(paste0("\n ", table.names[i],"\t: ", - format(summary[1, i], digits = 2, nsmall = 2))) - } - cat("\n -------------------------------\n\n") - - } - ## Plotting ---------------------------------------------------------------- - if (plot) - try(plot_RLum.Results(fast.ratio, ...)) - - # return - return(fast.ratio) - }) # End of lapply - - if (length(fast.ratios) == 1) - fast.ratios <- fast.ratios[[1]] - - invisible(fast.ratios) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_FiniteMixture.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_FiniteMixture.R deleted file mode 100644 index 3641932ad..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_FiniteMixture.R +++ /dev/null @@ -1,609 +0,0 @@ -#' @title Apply the finite mixture model (FMM) after Galbraith (2005) to a given De -#' distribution -#' -#' @description This function fits a k-component mixture to a De distribution with differing -#' known standard errors. Parameters (doses and mixing proportions) are -#' estimated by maximum likelihood assuming that the log dose estimates are -#' from a mixture of normal distributions. -#' -#' @details This model uses the maximum likelihood and Bayesian Information Criterion -#' (BIC) approaches. -#' -#' Indications of overfitting are: -#' -#' - increasing BIC -#' - repeated dose estimates -#' - covariance matrix not positive definite -#' - covariance matrix produces `NaN` -#' - convergence problems -#' -#' **Plot** -#' -#' If a vector (`c(k.min:k.max)`) is provided -#' for `n.components` a plot is generated showing the the k components -#' equivalent doses as normal distributions. By default `pdf.weight` is -#' set to `FALSE`, so that the area under each normal distribution is -#' always 1. If `TRUE`, the probability density functions are weighted by -#' the components proportion for each iteration of k components, so the sum of -#' areas of each component equals 1. While the density values are on the same -#' scale when no weights are used, the y-axis are individually scaled if the -#' probability density are weighted by the components proportion.\cr -#' The standard deviation (sigma) of the normal distributions is by default -#' determined by a common `sigmab` (see `pdf.sigma`). For -#' `pdf.sigma = "se"` the standard error of each component is taken -#' instead.\cr -#' The stacked [graphics::barplot] shows the proportion of each component (in -#' per cent) calculated by the FFM. The last plot shows the achieved BIC scores -#' and maximum log-likelihood estimates for each iteration of k. -#' -#' @param data [RLum.Results-class] or [data.frame] (**required**): -#' for [data.frame]: two columns with De `(data[,1])` and De error `(values[,2])` -#' -#' @param sigmab [numeric] (**required**): -#' spread in De values given as a fraction (e.g. 0.2). This value represents the expected -#' overdispersion in the data should the sample be well-bleached -#' (Cunningham & Wallinga 2012, p. 100). -#' -#' @param n.components [numeric] (**required**): -#' number of components to be fitted. If a vector is provided (e.g. `c(2:8)`) the -#' finite mixtures for 2, 3 ... 8 components are calculated and a plot and a -#' statistical evaluation of the model performance (BIC score and maximum -#' log-likelihood) is provided. -#' -#' @param grain.probability [logical] (*with default*): -#' prints the estimated probabilities of which component each grain is in -#' -#' @param dose.scale [numeric]: -#' manually set the scaling of the y-axis of the first plot with a vector -#' in the form of `c(min, max)` -#' -#' @param pdf.weight [logical] (*with default*): -#' weight the probability density functions by the components proportion (applies only -#' when a vector is provided for `n.components`) -#' -#' @param pdf.sigma [character] (*with default*): -#' if `"sigmab"` the components normal distributions are plotted with a common standard -#' deviation (i.e. `sigmab`) as assumed by the FFM. Alternatively, -#' `"se"` takes the standard error of each component for the sigma -#' parameter of the normal distribution -#' -#' @param pdf.colors [character] (*with default*): -#' colour coding of the components in the the plot. -#' Possible options are `"gray"`, `"colors"` and `"none"` -#' -#' @param pdf.scale [numeric]: -#' manually set the max density value for proper scaling of the x-axis of the first plot -#' -#' @param plot.proportions [logical] (*with default*): -#' plot [graphics::barplot] showing the proportions of components if -#' `n.components` a vector with a length > 1 (e.g., `n.components = c(2:3)`) -#' -#' @param plot [logical] (*with default*): plot output -#' -#' @param ... further arguments to pass. See details for their usage. -#' -#' @return -#' Returns a plot (*optional*) and terminal output. In addition an -#' [RLum.Results-class] object is returned containing the -#' following elements: -#' -#' \item{.$summary}{[data.frame] summary of all relevant model results.} -#' \item{.$data}{[data.frame] original input data} -#' \item{.$args}{[list] used arguments} -#' \item{.$call}{[call] the function call} -#' \item{.$mle}{ covariance matrices of the log likelihoods} -#' \item{.$BIC}{ BIC score} -#' \item{.$llik}{ maximum log likelihood} -#' \item{.$grain.probability}{ probabilities of a grain belonging to a component} -#' \item{.$components}{[matrix] estimates of the de, de error and proportion for each component} -#' \item{.$single.comp}{[data.frame] single component FFM estimate} -#' -#' If a vector for `n.components` is provided (e.g. `c(2:8)`), -#' `mle` and `grain.probability` are lists containing matrices of the -#' results for each iteration of the model. -#' -#' The output should be accessed using the function [get_RLum] -#' -#' @section Function version: 0.4.2 -#' -#' @author -#' Christoph Burow, University of Cologne (Germany) \cr -#' Based on a rewritten S script of Rex Galbraith, 2006. -#' -#' @seealso [calc_CentralDose], [calc_CommonDose], -#' [calc_FuchsLang2001], [calc_MinDose] -#' -#' @references -#' Galbraith, R.F. & Green, P.F., 1990. Estimating the component -#' ages in a finite mixture. Nuclear Tracks and Radiation Measurements 17, -#' 197-206. -#' -#' Galbraith, R.F. & Laslett, G.M., 1993. Statistical models -#' for mixed fission track ages. Nuclear Tracks Radiation Measurements 4, -#' 459-470. -#' -#' Galbraith, R.F. & Roberts, R.G., 2012. Statistical aspects of -#' equivalent dose and error calculation and display in OSL dating: An overview -#' and some recommendations. Quaternary Geochronology 11, 1-27. -#' -#' Roberts, R.G., Galbraith, R.F., Yoshida, H., Laslett, G.M. & Olley, J.M., 2000. -#' Distinguishing dose populations in sediment mixtures: a test of single-grain -#' optical dating procedures using mixtures of laboratory-dosed quartz. -#' Radiation Measurements 32, 459-465. -#' -#' Galbraith, R.F., 2005. Statistics for Fission Track Analysis, Chapman & Hall/CRC, Boca Raton. -#' -#' **Further reading** -#' -#' Arnold, L.J. & Roberts, R.G., 2009. Stochastic -#' modelling of multi-grain equivalent dose (De) distributions: Implications -#' for OSL dating of sediment mixtures. Quaternary Geochronology 4, -#' 204-230. -#' -#' Cunningham, A.C. & Wallinga, J., 2012. Realizing the -#' potential of fluvial archives using robust OSL chronologies. Quaternary -#' Geochronology 12, 98-106. -#' -#' Rodnight, H., Duller, G.A.T., Wintle, A.G. & -#' Tooth, S., 2006. Assessing the reproducibility and accuracy of optical -#' dating of fluvial deposits. Quaternary Geochronology 1, 109-120. -#' -#' Rodnight, H. 2008. How many equivalent dose values are needed to obtain a -#' reproducible distribution?. Ancient TL 26, 3-10. -#' -#' -#' @examples -#' -#' ## load example data -#' data(ExampleData.DeValues, envir = environment()) -#' -#' ## (1) apply the finite mixture model -#' ## NOTE: the data set is not suitable for the finite mixture model, -#' ## which is why a very small sigmab is necessary -#' calc_FiniteMixture(ExampleData.DeValues$CA1, -#' sigmab = 0.2, n.components = 2, -#' grain.probability = TRUE) -#' -#' ## (2) repeat the finite mixture model for 2, 3 and 4 maximum number of fitted -#' ## components and save results -#' ## NOTE: The following example is computationally intensive. Please un-comment -#' ## the following lines to make the example work. -#' FMM<- calc_FiniteMixture(ExampleData.DeValues$CA1, -#' sigmab = 0.2, n.components = c(2:4), -#' pdf.weight = TRUE, dose.scale = c(0, 100)) -#' -#' ## show structure of the results -#' FMM -#' -#' ## show the results on equivalent dose, standard error and proportion of -#' ## fitted components -#' get_RLum(object = FMM, data.object = "components") -#' -#' @md -#' @export -calc_FiniteMixture <- function( - data, - sigmab, - n.components, - grain.probability = FALSE, - dose.scale, - pdf.weight = TRUE, - pdf.sigma = "sigmab", - pdf.colors = "gray", - pdf.scale, - plot.proportions = TRUE, - plot=TRUE, - ... -){ - - ## CONSISTENCY CHECK OF INPUT DATA -------- - ##============================================================================## - if (!is(data, "data.frame") && !is(data,"RLum.Results")) { - stop("[calc_FiniteMixture()] 'data' object has to be of type ", - "'data.frame' or 'RLum.Results'!", call. = FALSE) - } - if (is(data, "RLum.Results")) { - data <- get_RLum(data, "data") - } - if (ncol(data) < 2) { - stop("[calc_FiniteMixture()] 'data' object must have two columns", - call. = FALSE) - } - if (sigmab < 0 || sigmab > 1) { - stop("[calc_FiniteMixture()] 'sigmab' must be a value between 0 and 1", - call. = FALSE) - } - if(any(n.components<2) == TRUE) { - stop("[calc_FiniteMixture()] At least two components need to be fitted", - call. = FALSE) - } - if (pdf.sigma != "se" && pdf.sigma != "sigmab") { - stop("Only 'se' or 'sigmab' allowed for the pdf.sigma argument", - call. = FALSE) - } - - ## set expected column names - colnames(data)[1:2] <- c("ED", "ED_Error") - - ## ... ARGUMENTS ------------ - ##============================================================================## - - extraArgs <- list(...) - - ## default values - verbose <- TRUE - trace <- FALSE - main <- "Finite Mixture Model" - - ## console output - if("verbose" %in% names(extraArgs)) { - verbose<- extraArgs$verbose - } - # trace calculations - if("trace" %in% names(extraArgs)) { - trace<- extraArgs$trace - } - # plot title - if("main" %in% names(extraArgs)) { - main<- extraArgs$main - } - - ##============================================================================## - ## CALCULATIONS - ##============================================================================## - - ## create storage variables if more than one k is provided - if(length(n.components)>1) { - - # counter needed for various purposes - cnt<- 1 - - # create summary matrix containing DE, standard error (se) and proportion - # for each component - comp.n<- matrix(data = NA, ncol = length(n.components), - nrow = n.components[length(n.components)] * 3, - byrow = TRUE) - - # create empty vector as storage for BIC and LLIK scores - BIC.n<- vector(mode = "double") - LLIK.n<- vector(mode = "double") - - # create empty vectors of type "lists" as storage for mle matrices and - # grain probabilities - vmat.n<- vector(mode = "list", length = length(n.components)) - grain.probability.n<- vector(mode = "list", length = length(n.components)) - - } - - ## start actual calculation (loop) for each provided maximum components to - ## be fitted. - for(i in 1:length(n.components)) { - - k<- n.components[i] - - # calculate yu = log(ED), su = se(logED), n = number of grains - yu<- log(data$ED) - su<- data$ED_Error/data$ED - n<- length(yu) - - # compute starting values - fui<- matrix(0,n,k) - pui<- matrix(0,n,k) - nui<- matrix(0,n,k) - pii<- rep(1/k,k) - mu<- min(yu) + (max(yu)-min(yu))*(1:k)/(k+1) - - # remove the # in the line below to get alternative starting values - # (useful to check that the algorithm converges to the same values) - # mu<- quantile(yu,(1:k)/(k+1)) - - # compute maximum log likelihood estimates - nit<- 499L - wu<- 1/(sigmab^2 + su^2) - rwu<- sqrt(wu) - - for(j in 1:nit){ - for(i in 1:k) - { - fui[,i]<- rwu*exp(-0.5*wu*(yu-mu[i])^2) - nui[,i]<- pii[i]*fui[,i] - } - pui<- nui/apply(nui,1,sum) - mu<- apply(wu*yu*pui,2,sum)/apply(wu*pui,2,sum) - pii<- apply(pui,2,mean) - } - - # calculate the log likelihood and BIC - llik<- sum( log( (1/sqrt(2*pi))*apply(nui,1,sum) )) - bic<- -2*llik + (2*k - 1)*log(n) - - # calculate the covariance matrix and standard errors of the estimates - # i.e., the dose estimtes in Gy and relative standard errors, and - # the mixing proportions and standard errors. - aui<- matrix(0,n,k) - bui<- matrix(0,n,k) - for(i in 1:k) - { - aui[,i]<- wu*(yu-mu[i]) - bui[,i]<- -wu + (wu*(yu-mu[i]))^2 - } - delta<- diag(rep(1,k)) - - Au<- matrix(0,k-1,k-1) - Bu<- matrix(0,k-1,k) - Cu<- matrix(0,k,k) - - for(i in 1:(k-1)){ for(j in 1:(k-1)){ - Au[i,j]<- sum( (pui[,i]/pii[i] - pui[,k]/pii[k])*(pui[,j]/pii[j] - - pui[,k]/pii[k]) )}} - - for(i in 1:(k-1)){ for(j in 1:k){ - Bu[i,j]<- sum( pui[,j]*aui[,j]*(pui[,i]/pii[i] - pui[,k]/pii[k] - - delta[i,j]/pii[i] + delta[k,j]/pii[k] ) )}} - - for(i in 1:k){ for(j in 1:k){ - Cu[i,j]<- sum( pui[,i]*pui[,j]*aui[,i]*aui[,j] - delta[i,j]*bui[,i]* - pui[,i] ) }} - - invvmat<- rbind(cbind(Au,Bu),cbind(t(Bu),Cu)) - vmat<- solve(invvmat, tol=.Machine$double.xmin) - rek<- sqrt(sum(vmat[1:(k-1),1:(k-1)])) - - # calculate DE, relative standard error, standard error - dose<- exp(mu) - re<- sqrt(diag(vmat))[-c(1:(k-1))] - - if (any(is.nan(re))) - re[is.nan(re)] <- NA - - sed<- dose*re - estd<- rbind(dose,re,sed) - - # rename proportion - prop<- pii - - # this calculates the proportional standard error of the proportion of grains - # in the fitted components. However, the calculation is most likely erroneous. - # sep<- c(sqrt(diag(vmat))[c(1:(k-1))],rek) - - # rename proportion - estp<- prop - - # merge results to a data frame - blk<- rep(" ",k) - comp<- rbind(blk,round(estd,4),blk,round(estp,4)) - comp<- data.frame(comp,row.names=c("","dose (Gy) ","rse(dose) ", - "se(dose)(Gy)"," ","proportion ")) - - # label results data frame - cp<- rep("comp",k) - cn<- c(1:k) - names(comp)<- paste(cp,cn,sep="") - - # calculate the log likelihood and BIC for a single component -- can - # be useful to see if there is evidence of more than one component - mu0<- sum(wu*yu)/sum(wu) - fu0<- rwu*exp(-0.5*wu*(yu-mu0)^2) - L0<- sum( log((1/sqrt(2*pi))*fu0 ) ) - bic0<- -2*L0 + log(n) - comp0<- round(c(exp(mu0),sigmab,L0,bic0),4) - - - ## save results for k components in storage variables - if(length(n.components)>1) { - - # vector of indices needed for finding the dose rows of the summary - # matrix - position 1,4,7...n - pos.n<- seq(from = 1, to = n.components[cnt]*3, by = 3) - - # save results of each iteration to summary matrix - for(i in 1:n.components[cnt]) { - comp.n[pos.n[i], cnt]<- round(dose[i], 2) #De - comp.n[pos.n[i]+1, cnt]<- round(sed[i], 2) #SE - comp.n[pos.n[i]+2, cnt]<- round(estp[i], 2) #Proportion - } - - # save BIC and llik of each iteration to corresponding vector - BIC.n[cnt]<- bic - LLIK.n[cnt]<- llik - - # merge BIC and llik scores to a single data frame - results.n<- rbind(BIC = round(BIC.n, 3), - llik = round(LLIK.n, 3)) - - # save mle matrix and grain probabilities to corresponding vector - vmat.n[[cnt]]<- vmat - grain.probability.n[[cnt]]<- as.data.frame(pui) - - # increase counter by one for next iteration - cnt<- cnt+1 - }#EndOf::save intermediate results - }##EndOf::calculation loop - - ##============================================================================## - ## STATISTICAL CHECK - ##============================================================================## - - if(length(n.components)>1) { - - ## Evaluate maximum log likelihood estimates - LLIK.significant<- vector(mode = "logical") - - # check if llik is at least three times greater when adding a further - # component - for(i in 1:c(length(LLIK.n)-1)) { - LLIK.significant[i]<- (LLIK.n[i+1]/LLIK.n[i])>3 - } - - ## Find lowest BIC score - BIC.lowest<- n.components[which.min(BIC.n)] - } - - ## OUTPUT --------- - ##============================================================================## - if(verbose) { - - ## HEADER (always printed) - cat("\n [calc_FiniteMixture]") - - ## OUTPUT WHEN ONLY ONE VALUE FOR n.components IS PROVIDED - if(length(n.components) == 1) { - - # covariance matrix - cat(paste("\n\n--- covariance matrix of mle's ---\n\n")) - print(round(vmat,6)) - - # general information on sample and model performance - cat(paste("\n----------- meta data ------------")) - cat(paste("\n n: ",n)) - cat(paste("\n sigmab: ",sigmab)) - cat(paste("\n number of components: ",k)) - cat(paste("\n llik: ",round(llik,4))) - cat(paste("\n BIC: ",round(bic,3))) - - # fitted components - cat(paste("\n\n----------- components -----------\n\n")) - print(comp) - - - # print (to 2 decimal places) the estimated probabilities of which component - # each grain is in -- sometimes useful for diagnostic purposes - if(grain.probability==TRUE) { - cat(paste("\n-------- grain probability -------\n\n")) - print(round(pui,2)) - } - - # output for single component - cat(paste("\n-------- single component --------")) - cat(paste("\n mu: ", comp0[1])) - cat(paste("\n sigmab: ", comp0[2])) - cat(paste("\n llik: ", comp0[3])) - cat(paste("\n BIC: ", comp0[4])) - cat(paste("\n----------------------------------\n\n")) - - }#EndOf::Output for length(n.components) == 1 - - ##---------------------------------------------------------------------------- - ## OUTPUT WHEN ONLY >1 VALUE FOR n.components IS PROVIDED - if(length(n.components) > 1) { - - ## final labeling of component and BIC/llik matrices - # create labels - dose.lab<- paste("c", 1:n.components[length(n.components)],"_dose", sep="") - se.lab<- paste("c", 1:n.components[length(n.components)],"_se", sep="") - prop.lab<- paste("c", 1:n.components[length(n.components)],"_prop", sep="") - - # empty vector which stores the labeles in correct order (dose, se, prop) - n.lab<- vector(mode = "expression", - n.components[length(n.components)]*3) - - # loop to store the labels in correct order (dose, se, prop) - cnt<- 1 - for(i in pos.n) { - n.lab[i]<- dose.lab[cnt] - n.lab[i+1]<- se.lab[cnt] - n.lab[i+2]<- prop.lab[cnt] - cnt<- cnt+1 - } - - # label columns and rows of summary matrix and BIC/LLIK data frame - colnames(comp.n)<- n.components[1]:n.components[length(n.components)] - rownames(comp.n)<- n.lab - colnames(results.n)<- n.components[1]:n.components[length(n.components)] - - ## CONSOLE OUTPUT - # general information on sample and model performance - cat(paste("\n\n----------- meta data ------------")) - cat(paste("\n n: ",n)) - cat(paste("\n sigmab: ",sigmab)) - cat(paste("\n number of components: ",n.components[1],"-", - n.components[length(n.components)], sep="")) - - # output for single component - cat(paste("\n\n-------- single component --------")) - cat(paste("\n mu: ", comp0[1])) - cat(paste("\n sigmab: ", comp0[2])) - cat(paste("\n llik: ", comp0[3])) - cat(paste("\n BIC: ", comp0[4])) - - # print component matrix - cat(paste("\n\n----------- k components -----------\n")) - print(comp.n, na.print="") - - # print BIC scores and LLIK estimates - cat(paste("\n----------- statistical criteria -----------\n")) - print(results.n) - - ## print evaluation of statistical criteria - # lowest BIC score - cat(paste("\n Lowest BIC score for k =", BIC.lowest)) - - # first significant increase in LLIK estimates - if(!any(LLIK.significant, na.rm = TRUE)) { - cat(paste("\n No significant increase in maximum log", - "likelihood estimates. \n")) - } else { - cat(paste("\n First significant increase in maximum log likelihood for", - "k =", which(LLIK.significant==TRUE)[1], "\n\n")) - } - - cat(paste("\n")) - }#EndOf::Output for length(n.components) > 1 - } - - ## RETURN VALUES -------- - ##============================================================================## - - # .@data$meta - BIC<- data.frame(n.components=k, BIC=bic) - llik<- data.frame(n.components=k, llik=llik) - - if(length(n.components)>1) { - BIC.n<- data.frame(n.components=n.components, BIC=BIC.n) - llik.n<- data.frame(n.components=n.components, llik=LLIK.n) - } - - # .@data$single.comp - single.comp<- data.frame(mu=comp0[1],sigmab=comp0[2], - llik=comp0[3],BIC=comp0[4]) - - # .@data$components - comp.re<- t(rbind(round(estd,4),round(estp,4))) - colnames(comp.re)<- c("de","rel_de_err","de_err","proportion") - comp.re<- comp.re[,-2] # remove the relative error column - - # .@data$grain.probability - grain.probability<- round(pui, 2) - - summary<- data.frame(comp.re) - call<- sys.call() - args<- list(sigmab = sigmab, n.components = n.components) - - # create S4 object - newRLumResults.calc_FiniteMixture <- set_RLum( - class = "RLum.Results", - data = list( - summary=summary, - data=data, - args=args, - call=call, - mle=if(length(n.components)==1){vmat}else{vmat.n}, - BIC=if(length(n.components)==1){BIC}else{BIC.n}, - llik=if(length(n.components)==1){llik}else{llik.n}, - grain.probability=if(length(n.components)==1){grain.probability}else{grain.probability.n}, - components=if(length(n.components)==1){comp.re}else{comp.n}, - single.comp=single.comp)) - - if (anyNA(unlist(summary)) && verbose) - warning("\n[calc_FiniteMixture] The model produced NA values. Either the input data are inapplicable for the model", - " or the the model parameters need to be adjusted (e.g. 'sigmab')", call. = FALSE) - - ##=========## - ## PLOTTING ----------- - if(plot && !anyNA(unlist(summary))) - try(do.call(plot_RLum.Results, c(list(newRLumResults.calc_FiniteMixture), as.list(sys.call())[-c(1,2)]))) - - # Return values - invisible(newRLumResults.calc_FiniteMixture) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_FuchsLang2001.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_FuchsLang2001.R deleted file mode 100644 index c0dff25a1..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_FuchsLang2001.R +++ /dev/null @@ -1,236 +0,0 @@ -#' Apply the model after Fuchs & Lang (2001) to a given De distribution. -#' -#' This function applies the method according to Fuchs & Lang (2001) for -#' heterogeneously bleached samples with a given coefficient of variation -#' threshold. -#' -#' **Used values** -#' -#' If the coefficient of variation (`c[v]`) of the first -#' two values is larger than the threshold `c[v_threshold]`, the first value is -#' skipped. Use the `startDeValue` argument to define a start value for -#' calculation (e.g. 2nd or 3rd value). -#' -#' **Basic steps of the approach** -#' -#' 1. Estimate natural relative variation of the sample using a dose recovery test -#' 2. Sort the input values in ascending order -#' 3. Calculate a running mean, starting with the lowermost two values and add values iteratively. -#' 4. Stop if the calculated `c[v]` exceeds the specified `cvThreshold` -#' -#' @param data [RLum.Results-class] or [data.frame] (**required**): -#' for [data.frame]: two columns with De `(data[,1])` and De error `(values[,2])` -#' -#' @param cvThreshold [numeric] (*with default*): -#' coefficient of variation in percent, as threshold for the method, -#' e.g. `cvThreshold = 3`. See details -#' . -#' @param startDeValue [numeric] (*with default*): -#' number of the first aliquot that is used for the calculations -#' -#' @param plot [logical] (*with default*): -#' plot output `TRUE`/`FALSE` -#' -#' @param ... further arguments and graphical parameters passed to [plot] -#' -#' @return -#' Returns a plot (*optional*) and terminal output. In addition an -#' [RLum.Results-class] object is returned containing the -#' following elements: -#' -#' \item{summary}{[data.frame] summary of all relevant model results.} -#' \item{data}{[data.frame] original input data} -#' \item{args}{[list] used arguments} -#' \item{call}{[call] the function call} -#' \item{usedDeValues}{[data.frame] containing the used values for the calculation} -#' -#' @note Please consider the requirements and the constraints of this method -#' (see Fuchs & Lang, 2001) -#' -#' @section Function version: 0.4.1 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) \cr -#' Christoph Burow, University of Cologne (Germany) -#' -#' @seealso [plot], [calc_MinDose], [calc_FiniteMixture], [calc_CentralDose], -#' [calc_CommonDose], [RLum.Results-class] -#' -#' @references -#' Fuchs, M. & Lang, A., 2001. OSL dating of coarse-grain fluvial -#' quartz using single-aliquot protocols on sediments from NE Peloponnese, -#' Greece. In: Quaternary Science Reviews 20, 783-787. -#' -#' Fuchs, M. & Wagner, G.A., 2003. Recognition of insufficient bleaching by -#' small aliquots of quartz for reconstructing soil erosion in Greece. -#' Quaternary Science Reviews 22, 1161-1167. -#' -#' @keywords dplot -#' -#' -#' @examples -#' ## load example data -#' data(ExampleData.DeValues, envir = environment()) -#' -#' ## calculate De according to Fuchs & Lang (2001) -#' temp<- calc_FuchsLang2001(ExampleData.DeValues$BT998, cvThreshold = 5) -#' -#' @md -#' @export -calc_FuchsLang2001 <- function( - data, - cvThreshold = 5, - startDeValue = 1, - plot = TRUE, - ... -){ - - # Integrity Tests --------------------------------------------------------- - if(!missing(data)){ - if(!is(data, "data.frame") & !is(data,"RLum.Results")){ - stop("[calc_FuchsLang2001()] 'data' has to be of type 'data.frame' or 'RLum.Results'!", call. = FALSE) - } else { - if(is(data, "RLum.Results")){ - data <- get_RLum(data, "data") - } - } - } - - # Deal with extra arguments ----------------------------------------------- - ##deal with addition arguments - extraArgs <- list(...) - verbose <- if("verbose" %in% names(extraArgs)) {extraArgs$verbose} else {TRUE} - - ##============================================================================## - ##PREPARE DATA - ##============================================================================## - - ##1. order values in ascending order write used D[e] values in data.frame - o <- order(data[[1]]) # o is only an order parameter - data_ordered <- data[o,] # sort values after o and write them into a new variable - - ##2. estimate D[e] - # set variables - usedDeValues <- data.frame(De = NA, De_Error = NA, cv = NA) - endDeValue <- startDeValue[1] - - # if the first D[e] values are not used write this information in the data.frame - if (startDeValue[1] != 1) { - n <- abs(1 - startDeValue[1]) - - # write used D[e] values in data.frame - usedDeValues[1:n, 1] <- data_ordered[1:n, 1] - usedDeValues[1:n, 2] <- data_ordered[1:n, 2] - usedDeValues[1:n, 3] <- "skipped" - } - - ##=================================================================================================## - ##LOOP FOR MODEL - ##=================================================================================================## - # repeat loop (run at least one time) - repeat { - #calculate mean, sd and cv - mean<-round(mean(data_ordered[startDeValue:endDeValue,1]),digits=2) #calculate mean from ordered D[e] values - sd<-round(sd(data_ordered[startDeValue:endDeValue,1]),digits=2) #calculate sd from ordered D[e] values - cv <- round(sd / mean * 100, digits = 2) #calculate coefficient of variation - - - # break if cv > cvThreshold - if (cv > cvThreshold[1] & endDeValue > startDeValue) { - # if the first two D[e] values give a cv > cvThreshold, than skip the first D[e] value - if (endDeValue-startDeValue<2) { - # write used D[e] values in data.frame - usedDeValues[endDeValue, 1] <- data_ordered[endDeValue, 1] - usedDeValues[endDeValue, 2] <- data_ordered[endDeValue, 2] - usedDeValues[endDeValue - 1, 3] <- "not used" - - # go to the next D[e] value - startDeValue <- startDeValue + 1 - - } else { - usedDeValues[endDeValue, 1] <- data_ordered[endDeValue, 1] - usedDeValues[endDeValue, 2] <- data_ordered[endDeValue, 2] - usedDeValues[endDeValue, 3] <- paste("# ", cv, " %", sep = "") - - break #break loop - } - - }#EndIf - else { - - # write used D[e] values in data.frame - usedDeValues[endDeValue,1]<-data_ordered[endDeValue,1] - usedDeValues[endDeValue,2]<-data_ordered[endDeValue,2] - - # first cv values alway contains NA to ensure that NA% is not printed test - if(is.na(cv)==TRUE) { - usedDeValues[endDeValue,3]<-cv - } else { - usedDeValues[endDeValue,3]<-paste(cv," %",sep="") - } - }#EndElse - - # go the next D[e] value until the maximum number is reached - if (endDeValue 3) - .throw_error("When 'LnTn' is specified, the 'data' data frame ", - "must have only 2 or 3 columns") - - # case 1: only one LnTn value - if (nrow(LnTn) == 1) { - LnTn <- setNames(cbind(0, LnTn), names(data)) - data <- rbind(LnTn, data) - - # case 2: >1 LnTn value - } else { - LnTn_mean <- mean(LnTn[ ,1]) - LnTn_sd <- sd(LnTn[ ,1]) - LnTn_error <- max(LnTn_sd, LnTn[ ,2]) - LnTn <- setNames(data.frame(0, LnTn_mean, LnTn_error), names(data)) - data <- rbind(LnTn, data) - } - - } - - # check number of columns - if (ncol(data) %% 3 != 0) { - .throw_error("The number of columns in 'data' must be a multiple of 3.") - } else { - # extract all LxTx values - data_tmp <- do.call(rbind, - lapply(seq(1, ncol(data), 3), function(col) { - setNames(data[2:nrow(data), col:c(col+2)], c("dose", "LxTx", "LxTxError")) - }) - ) - - # extract the LnTn values (assumed to be the first row) and calculate the column mean - LnTn_tmp <- do.call(rbind, - lapply(seq(1, ncol(data), 3), function(col) { - setNames(data[1, col:c(col+2)], c("dose", "LxTx", "LxTxError")) - }) - ) - - # check whether the standard deviation of LnTn estimates or the largest - # individual error is highest, and take the larger one - LnTn_error_tmp <- max(c(sd(LnTn_tmp[ ,2]), mean(LnTn_tmp[ ,3])), na.rm = TRUE) - LnTn_tmp <- colMeans(LnTn_tmp) - - # re-bind the data frame - data <- rbind(LnTn_tmp, data_tmp) - data[1, 3] <- LnTn_error_tmp - data <- data[complete.cases(data), ] - } - - } else { - .throw_error("'data' must be a data frame.") - } - - ## Check 'rhop' - # check if numeric - if (is.numeric(rhop)) { - - ### TODO: can be of length 2 if error - if (length(rhop) != 2) - .throw_error("'rhop' must be a vector of length 2.") - - # alternatively, and RLum.Results object produced by analyse_FadingMeasurement() - # can be provided - } else if (inherits(rhop, "RLum.Results")) { - - if (rhop@originator == "analyse_FadingMeasurement") - rhop <- c(rhop@data$rho_prime$MEAN, - rhop@data$rho_prime$SD) - else - .throw_error("'rhop' accepts RLum.Results objects only if produced ", - "by 'analyse_FadingMeasurement()'") - } else { - .throw_error("'rhop' must be a numeric vector or an RLum.Results object") - } - - # check if 'rhop' is actually a positive value - if (any(is.na(rhop)) || !rhop[1] > 0 || any(is.infinite(rhop))) { - .throw_error("'rhop' must be a positive number. Provided value ", - "was: ", signif(rhop[1], 3), " \u2213 ", signif(rhop[2], 3)) - } - - ## Check ddot & readerDdot - # check if numeric - if (any(sapply(list(ddot, readerDdot), is.numeric) == FALSE)) - .throw_error("'ddot' and 'readerDdot' must be numeric vectors.") - # check if length == 2 - if (any(sapply(list(ddot, readerDdot), function(x) length(x) == 2) == FALSE)) - .throw_error("'ddot' and 'readerDdot' must be of length 2.") - - ## Settings ------------------------------------------------------------------ - settings <- modifyList( - list( - verbose = TRUE, - n.MC = 100000), - list(...)) - - ## Define Constants ---------------------------------------------------------- - kb <- 8.617343 * 1e-5 - alpha <- 1 - Hs <- 3e15 # s value after Huntley (2006) - Ma <- 1e6 * 365.25 * 24 * 3600 #in seconds - ka <- Ma / 1000 #in seconds - - ## Define Functions ---------------------------------------------------------- - # fit data using using Eq 5. from Kars et al (2008) employing - # theta after King et al. (2016) - theta <- function(t, r) { - res <- exp(-r * log(1.8 * Hs * (0.5 * t))^3) - res[!is.finite(res)] <- 0 - return(res) - } - - ## Preprocessing ------------------------------------------------------------- - readerDdot.error <- readerDdot[2] - readerDdot <- readerDdot[1] - ddot.error <- ddot[2] - ddot <- ddot[1] - - colnames(data) <- c("dose", "LxTx", "LxTx.Error") - dosetime <- data[["dose"]][2:nrow(data)] - LxTx.measured <- data[["LxTx"]][2:nrow(data)] - LxTx.measured.error <- data[["LxTx.Error"]][2:nrow(data)] - - #Keep LnTn separate for derivation of measured fraction of saturation - Ln <- data[["LxTx"]][1] - Ln.error <- data[["LxTx.Error"]][1] - - ## (1) MEASURED ---------------------------------------------------- - if (settings$verbose) cat("\n") - - data.tmp <- data - data.tmp[ ,1] <- data.tmp[ ,1] * readerDdot - - GC.settings <- list( - sample = data.tmp, - mode = "interpolation", - fit.method = fit.method[1], - fit.bounds = TRUE, - output.plot = plot, - main = "Measured dose response curve", - xlab = "Dose (Gy)", - fit.force_through_origin = FALSE, - verbose = FALSE) - - GC.settings <- modifyList(GC.settings, list(...)) - GC.settings$verbose <- FALSE - - ## take of force_through origin settings - force_through_origin <- GC.settings$fit.force_through_origin - - ## call the fitting - GC.measured <- try(do.call(plot_GrowthCurve, GC.settings)) - - if (inherits(GC.measured$Fit, "try-error")) - stop("\n[calc_Huntley2006()] Unable to fit growth curve to measured data. Try to set fit.bounds to FALSE!", - call. = FALSE) - - # extract results and calculate age - GC.results <- get_RLum(GC.measured) - fit_measured <- GC.measured@data$Fit - De.measured <- GC.results$De - De.measured.error <- GC.results$De.Error - D0.measured <- GC.results$D01 - D0.measured.error <- GC.results$D01.ERROR - Age.measured <- De.measured/ ddot - Age.measured.error <- Age.measured * sqrt( (De.measured.error / De.measured)^2 + - (readerDdot.error / readerDdot)^2 + - (ddot.error / ddot)^2) - - - ## (2) SIMULATED ----------------------------------------------------- - # create MC samples - rhop_MC <- rnorm(n = settings$n.MC, mean = rhop[1], sd = rhop[2]) - - ## do the fitting - fitcoef <- do.call(rbind, sapply(rhop_MC, function(rhop_i) { - if (fit.method[1] == "EXP") { - fit_sim <- try({ - minpack.lm::nlsLM( - LxTx.measured ~ a * theta(dosetime, rhop_i) * (1 - exp(-(dosetime + c)/ D0)), - start = list( - a = coef(fit_measured)[["a"]], - c = coef(fit_measured)[["c"]], - D0 = D0.measured / readerDdot), - lower = lower.bounds[1:3], - upper = if(force_through_origin) c(a = Inf, c = 0, D0 = Inf) else rep(Inf,3), - control = list(maxiter = settings$maxiter)) - }, silent = TRUE) - - } else if (fit.method[1] == "GOK") { - fit_sim <- try({ - minpack.lm::nlsLM( - LxTx.measured ~ a * theta(dosetime, rhop_i) * (d-(1+(1/D0)*dosetime*c)^(-1/c)), - start = list( - a = coef(fit_measured)[["a"]], - D0 = D0.measured / readerDdot, - c = coef(fit_measured)[["c"]] * ddot, - d = coef(fit_measured)[["d"]]), - upper = if(force_through_origin) { - c(a = Inf, D0 = Inf, c = Inf, d = 1) - } else { - rep(Inf, 4)}, - lower = lower.bounds, - control = list(maxiter = settings$maxiter))}, - silent = TRUE) - } - - if (!inherits(fit_sim, "try-error")) - coefs <- coef(fit_sim) - else - coefs <- c(a = NA, D0 = NA, c = NA, d = NA) - return(coefs) - }, simplify = FALSE)) - - # final fit for export - # fit_simulated <- minpack.lm::nlsLM(LxTx.measured ~ a * theta(dosetime, rhop[1]) * (1 - exp(-dosetime / D0)), - # start = list(a = max(LxTx.measured), D0 = D0.measured / readerDdot)) - - # scaling factor - A <- mean(fitcoef[, "a"], na.rm = TRUE) - A.error <- sd(fitcoef[ ,"a"], na.rm = TRUE) - - # calculate measured fraction of saturation - nN <- Ln / A - nN.error <- nN * sqrt( (Ln.error / Ln)^2 + (A.error / A)^2) - - # compute a natural dose response curve following the assumptions of - # Morthekai et al. 2011, Geochronometria - # natdosetime <- seq(0, 1e14, length.out = settings$n.MC) - # natdosetimeGray <- natdosetime * ddot / ka - - # calculate D0 dose in seconds - computedD0 <- (fitcoef[ ,"D0"] * readerDdot) / (ddot / ka) - - # Legacy code: - # This is an older approximation to calculate the natural dose response curve, - # which sometimes tended to slightly underestimate nN_ss. This is now replaced - # with the newer approach below. - # compute natural dose response curve - # LxTx.sim <- A * theta(natdosetime, rhop[1]) * (1 - exp(-natdosetime / mean(computedD0, na.rm = TRUE) )) - # warning("LxTx Curve: ", round(max(LxTx.sim) / A, 3), call. = FALSE) - - # compute natural dose response curve - ddots <- ddot / ka - natdosetimeGray <- c(0, exp(seq(1, log(max(data[ ,1]) * 2), length.out = 999))) - natdosetime <- natdosetimeGray - rprime <- seq(0.01, 5, length.out = 500) - pr <- 3 * rprime^2 * exp(-rprime^3) # Huntley 2006, eq. 3 - K <- Hs * exp(-rhop[1]^-(1/3) * rprime) - TermA <- matrix(NA, nrow = length(rprime), ncol = length(natdosetime)) - UFD0 <- mean(fitcoef[ ,"D0"], na.rm = TRUE) * readerDdot - - if(fit.method[1] == "EXP") - c_exp <- mean(fitcoef[ ,"c"], na.rm = TRUE) - - if (fit.method[1] == "GOK") { - c_gok <- mean(fitcoef[ ,"c"], na.rm = TRUE) - - ## prevent negative c_gok values, which will cause NaN values - if(c_gok < 0) c_gok <- 1 - - d_gok <- mean(fitcoef[ ,"d"], na.rm = TRUE) - } - - for (j in 1:length(natdosetime)) { - for (k in 1:length(rprime)) { - if (fit.method[1] == "EXP") { - TermA[k,j] <- A * pr[k] * - ((ddots / UFD0) / (ddots / UFD0 + K[k]) * - (1 - exp(-(natdosetime[j] + c_exp) * (1 / UFD0 + K[k]/ddots)))) - } else if (fit.method[1] == "GOK") { - TermA[k,j] <- A * pr[k] * (ddots / UFD0) / (ddots / UFD0 + K[k]) * - (d_gok-(1+(1/UFD0 + K[k]/ddots) * natdosetime[j] * c_gok)^(-1/c_gok)) - } - }} - - LxTx.sim <- colSums(TermA) / sum(pr) - # warning("LxTx Curve (new): ", round(max(LxTx.sim) / A, 3), call. = FALSE) - - # calculate Age - positive <- which(diff(LxTx.sim) > 0) - - data.unfaded <- data.frame( - dose = c(0, natdosetimeGray[positive]), - LxTx = c(Ln, LxTx.sim[positive]), - LxTx.error = c(Ln.error, LxTx.sim[positive] * A.error/A)) - - data.unfaded$LxTx.error[2] <- 0.0001 - - GC.settings <- list( - sample = data.unfaded, - mode = "interpolation", - fit.method = fit.method[1], - fit.bounds = TRUE, - output.plot = plot, - fit.force_through_origin = FALSE, - verbose = FALSE, - main = "Simulated dose response curve", - xlab = "Dose (Gy)" - ) - - GC.settings <- modifyList(GC.settings, list(...)) - - GC.settings$verbose <- FALSE - - ## calculate simulated DE - suppressWarnings( - GC.simulated <- try(do.call(plot_GrowthCurve, GC.settings)) - ) - - if (!inherits(GC.simulated, "try-error")) { - GC.simulated.results <- get_RLum(GC.simulated) - fit_simulated <- get_RLum(GC.simulated, "Fit") - De.sim <- GC.simulated.results$De - - De.error.sim <- GC.simulated.results$De.Error - - # derive simulated D0 - D0.sim.Gy <- GC.simulated.results$D01 - D0.sim.Gy.error <- GC.simulated.results$D01.ERROR - - Age.sim <- De.sim / ddot - Age.sim.error <- Age.sim * sqrt( ( De.error.sim/ De.sim)^2 + - (readerDdot.error / readerDdot)^2 + - (ddot.error / ddot)^2) - - Age.sim.2D0 <- 2 * D0.sim.Gy / ddot - Age.sim.2D0.error <- Age.sim.2D0 * sqrt( ( D0.sim.Gy.error / D0.sim.Gy)^2 + - (readerDdot.error / readerDdot)^2 + - (ddot.error / ddot)^2) - - } else { - De.sim <- De.error.sim <- Age.sim <- Age.sim.error <- fit_simulated <- D0.sim.Gy <- D0.sim.Gy.error <- NA - Age.sim.2D0 <- Age.sim.2D0.error <- NA - - } - - if (Ln > max(LxTx.sim) * 1.1) - warning("[calc_Huntley2006()] Ln is >10 % larger than the maximum computed LxTx value.", - " The De and age should be regarded as infinite estimates.", - call. = FALSE) - - if (Ln < min(LxTx.sim) * 0.95) - warning("[calc_Huntley2006()] Ln/Tn is smaller than the minimum computed LxTx value. - If, in consequence, your age result is NA, either your input values are - unsuitable, or you should consider using a different model for your dataset!", - call. = FALSE) - - - - # Estimate nN_(steady state) by Monte Carlo Simulation - ddot_MC <- rnorm(n = settings$n.MC, mean = ddot, sd = ddot.error) - UFD0_MC <- rnorm(n = settings$n.MC, mean = D0.sim.Gy, sd = D0.sim.Gy.error) - - nN_SS_MC <- mapply(function(rhop_i, ddot_i, UFD0_i) { - rprime <- seq(0.01, 5, length.out = settings$n.MC) - rho <- 3 * alpha^3 * rhop_i / (4 * pi) - r <- rprime / (4 * pi * rho / 3)^(1 / 3) - pr <- 3 * rprime^2 * exp(-rprime^3) - tau <- ((1 / Hs) * exp(1)^(alpha * r)) / ka - Ls <- 1 / (1 + UFD0_i / (ddot_i * tau)) - Lstrap <- (pr * Ls) / sum(pr) - - # field saturation - nN_SS_i <- sum(Lstrap) - return(nN_SS_i) - - }, rhop_MC, ddot_MC, UFD0_MC, SIMPLIFY = TRUE) - - nN_SS <- suppressWarnings(exp(mean(log(nN_SS_MC), na.rm = TRUE))) - nN_SS.error <- suppressWarnings(nN_SS * abs(sd(log(nN_SS_MC), na.rm = TRUE) / mean(log(nN_SS_MC), na.rm = TRUE))) - - ## legacy code for debugging purposes - ## nN_SS is often lognormally distributed, so we now take the mean and sd - ## of the log values. - # warning(mean(nN_SS_MC, na.rm = TRUE)) - # warning(sd(nN_SS_MC, na.rm = TRUE)) - - ## (3) UNFADED --------------------------------------------------------------- - LxTx.unfaded <- LxTx.measured / theta(dosetime, rhop[1]) - LxTx.unfaded[is.nan((LxTx.unfaded))] <- 0 - LxTx.unfaded[is.infinite(LxTx.unfaded)] <- 0 - dosetimeGray <- dosetime * readerDdot - if (fit.method[1] == "EXP" || fit.method[1] == "GOK") { - ## we let it run regardless of the selection - fit_unfaded <- minpack.lm::nlsLM( - LxTx.unfaded ~ a * (1 - exp(-(dosetimeGray + c) / D0)), - start = list( - a = coef(fit_simulated)[["a"]], - c = coef(fit_simulated)[["c"]], - D0 = D0.measured / readerDdot), - upper = if(force_through_origin) { - c(a = Inf, c = 0, D0 = max(dosetimeGray)) - } else { - c(Inf, Inf, max(dosetimeGray)) - }, - lower = lower.bounds[1:3], - control = list(maxiter = settings$maxiter)) } - - if (fit.method[1] == "GOK") { - fit_unfaded <- try(minpack.lm::nlsLM( - LxTx.unfaded ~ a * (d-(1+(1/D0)*dosetimeGray*c)^(-1/c)), - start = list( - a = coef(fit_unfaded)[["a"]], - D0 = coef(fit_unfaded)[["D0"]], - c = coef(fit_unfaded)[["c"]], - d = coef(fit_simulated)[["d"]]), - upper = if(force_through_origin) { - c(a = Inf, D0 = max(dosetimeGray), c = Inf, d = 1) - } else { - c(Inf, max(dosetimeGray), Inf, Inf)}, - lower = lower.bounds[1:4], - control = list(maxiter = settings$maxiter)), silent = TRUE) - - if(inherits(fit_unfaded, "try-error")) - stop("[calc_Huntely2006()] Could not fit simulated curve. - -> Check suitability of the model and the parameters!", - call. = FALSE) - } - - D0.unfaded <- coef(fit_unfaded)[["D0"]] - D0.error.unfaded <- summary(fit_unfaded)$coefficients["D0", "Std. Error"] - - ## Create LxTx tables -------------------------------------------------------- - # normalise by A (saturation point of the un-faded curve) - if (normalise) { - LxTx.measured.relErr <- (LxTx.measured.error / LxTx.measured) - LxTx.measured <- LxTx.measured / A - LxTx.measured.error <- LxTx.measured * LxTx.measured.relErr - - LxTx.sim <- LxTx.sim / A - LxTx.unfaded <- LxTx.unfaded / A - - Ln.relErr <- Ln.error / Ln - Ln <- Ln / A - Ln.error <- Ln * Ln.relErr - } - - # combine all computed LxTx values - LxTx_measured <- data.frame( - dose = dosetimeGray, - LxTx = LxTx.measured, - LxTx.Error = LxTx.measured.error) - - LxTx_simulated <- data.frame( - dose = natdosetimeGray, - LxTx = LxTx.sim, - LxTx.Error = LxTx.sim * A.error / A) - - LxTx_unfaded <- data.frame( - dose = dosetimeGray, - LxTx = LxTx.unfaded, - LxTx.Error = LxTx.unfaded * A.error / A) - - ## Plot settings ------------------------------------------------------------- - plot.settings <- modifyList(list( - main = "Dose response curves", - xlab = "Dose (Gy)", - ylab = ifelse(normalise, "normalised LxTx (a.u.)", "LxTx (a.u.)") - ), list(...)) - - ## Plotting ------------------------------------------------------------------ - if (plot) { - ### par settings --------- - # set plot parameters - par.old.full <- par(no.readonly = TRUE) - - # set graphical parameters - par(mfrow = c(1,1), mar = c(4.5, 4, 4, 4), cex = 0.8) - if (summary) - par(oma = c(0, 3, 0, 9)) - else - par(oma = c(0, 9, 0, 9)) - - # Find a good estimate of the x-axis limits - if(GC.settings$mode == "extrapolation" & !force_through_origin) { - dosetimeGray <- c(-De.measured - De.measured.error, dosetimeGray) - De.measured <- -De.measured - } - - xlim <- range(pretty(dosetimeGray)) - if (!is.na(De.sim) & De.sim > xlim[2]) - xlim <- range(pretty(c(min(dosetimeGray), De.sim))) - - # Create figure after Kars et al. (2008) contrasting the dose response curves - ## open plot window ------------ - plot( - x = dosetimeGray[dosetimeGray >= 0], - y = LxTx_measured$LxTx, - main = plot.settings$main, - xlab = plot.settings$xlab, - ylab = plot.settings$ylab, - pch = 16, - ylim = c(0, max(do.call(rbind, list(LxTx_measured, LxTx_unfaded))[["LxTx"]])), - xlim = xlim - ) - - ##add ablines for extrapolation - if(GC.settings$mode == "extrapolation") - abline(v = 0, h = 0, col = "gray") - - # LxTx error bars - segments(x0 = dosetimeGray[dosetimeGray >= 0], - y0 = LxTx_measured$LxTx + LxTx_measured$LxTx.Error, - x1 = dosetimeGray[dosetimeGray >= 0], - y1 = LxTx_measured$LxTx - LxTx_measured$LxTx.Error, - col = "black") - - # re-calculate the measured dose response curve in Gray - xNew <- seq(par()$usr[1],par()$usr[2], length.out = 200) - yNew <- predict(GC.measured@data$Fit, list(x = xNew)) - if (normalise) - yNew <- yNew / A - - ## add measured curve ------- - lines(xNew, yNew, col = "black") - - # add error polygon - polygon(x = c(natdosetimeGray, rev(natdosetimeGray)), - y = c(LxTx_simulated$LxTx + LxTx_simulated$LxTx.Error, - rev(LxTx_simulated$LxTx - LxTx_simulated$LxTx.Error)), - col = adjustcolor("grey", alpha.f = 0.5), border = NA) - - ## add simulated curve ------- - points( - x = natdosetimeGray, - y = LxTx_simulated$LxTx, - type = "l", - lty = 3) - - # Ln and DE as points - points(x = if(GC.settings$mode == "extrapolation") - rep(De.measured, 2) - else - c(0, De.measured), - y = if(GC.settings$mode == "extrapolation") - c(0,0) - else - c(Ln, Ln), - col = "red", - pch = c(2, 16)) - - # Ln error bar - segments(x0 = 0, y0 = Ln - Ln.error, - x1 = 0, y1 = Ln + Ln.error, - col = "red") - - # Ln as a horizontal line - lines(x = if(GC.settings$mode == "extrapolation") - c(0, min(c(De.measured, De.sim), na.rm = TRUE)) - else - c(par()$usr[1], max(c(De.measured, De.sim), na.rm = TRUE)), - y = c(Ln, Ln), - col = "red ", lty = 3) - - #vertical line of measured DE - lines(x = c(De.measured, De.measured), - y = c(par()$usr[3], Ln), - col = "red", - lty = 3) - - # add legends - legend("bottomright", - legend = c( - "Unfaded DRC", - "Measured DRC", - "Simulated natural DRC"), - lty = c(5, 1, 3), - bty = "n", - cex = 0.8) - - # add vertical line of simulated De - if (!is.na(De.sim)) { - lines(x = if(GC.settings$mode == "extrapolation") - c(-De.sim, -De.sim) - else - c(De.sim, De.sim), - y = c(par()$usr[3], Ln), - col = "red", lty = 3) - - points(x = if(GC.settings$mode == "extrapolation") -De.sim else De.sim, - y = if(GC.settings$mode == "extrapolation") 0 else Ln, - col = "red" , pch = 16) - } else { - lines(x = c(De.measured, xlim[2]), - y = c(Ln, Ln), - col = "black", lty = 3) - } - - # add unfaded DRC -------- - yNew <- predict(fit_unfaded, list(dosetimeGray = xNew)) - if (normalise) - yNew <- yNew / A - - lines(xNew, yNew, col = "black", lty = 5) - - points(x = dosetimeGray[dosetimeGray >= 0], - y = LxTx_unfaded$LxTx, - col = "black") - - # LxTx error bars - segments( - x0 = dosetimeGray[dosetimeGray >= 0], - y0 = LxTx_unfaded$LxTx + LxTx_unfaded$LxTx.Error, - x1 = dosetimeGray[dosetimeGray >= 0], - y1 = LxTx_unfaded$LxTx - LxTx_unfaded$LxTx.Error, - col = "black") - - # add text - if (summary) { - # define labels as expressions - labels.text <- list( - bquote(dot(D) == .(format(ddot, digits = 2, nsmall = 2)) %+-% .(round(as.numeric(format(ddot.error, digits = 3, nsmall = 3)), 3)) ~ frac(Gy, ka)), - bquote(dot(D)["Reader"] == .(format(readerDdot, digits = 2, nsmall = 2)) %+-% .(round(as.numeric(format(readerDdot.error, digits = 3, nsmall = 3)), 3)) ~ frac(Gy, s)), - bquote(log[10]~(rho~"'") == .(format(log10(rhop[1]), digits = 2, nsmall = 2)) %+-% .(round(as.numeric(format(rhop[2] / (rhop[1] * log(10, base = exp(1))), digits = 2, nsmall = 2)), 2)) ), - bquote(bgroup("(", frac(n, N), ")") == .(format(nN, digits = 2, nsmall = 2)) %+-% .(round(as.numeric(format(nN.error, digits = 2, nsmall = 2)), 2)) ), - bquote(bgroup("(", frac(n, N), ")")[SS] == .(format(nN_SS, digits = 2, nsmall = 2)) %+-% .(round(as.numeric(format(nN_SS.error, digits = 2, nsmall = 2)), 2)) ), - bquote(D["E,sim"] == .(format(De.sim, digits = 1, nsmall = 0)) %+-% .(format(De.error.sim, digits = 1, nsmall = 0)) ~ Gy), - bquote(D["0,sim"] == .(format(D0.sim.Gy, digits = 1, nsmall = 0)) %+-% .(format(D0.sim.Gy.error, digits = 1, nsmall = 0)) ~ Gy), - bquote(Age["sim"] == .(format(Age.sim, digits = 1, nsmall = 0)) %+-% .(format(Age.sim.error, digits = 1, nsmall = 0)) ~ ka) - ) - - # each of the labels is positioned at 1/10 of the available y-axis space - ypos <- seq(range(axTicks(2))[2], range(axTicks(2))[1], length.out = 10)[1:length(labels.text)] - - # allow overprinting - par(xpd = NA) - - # add labels iteratively - mapply(function(label, pos) { - text(x = max(axTicks(1)) * 1.05, - y = pos, - labels = label, - pos = 4) - }, labels.text, ypos) - } - - # recover plot parameters - on.exit(par(par.old.full)) - - } - - ## Results ------------------------------------------------------------------- - results <- set_RLum( - class = "RLum.Results", - data = list( - results = data.frame( - "nN" = nN, - "nN.error" = nN.error, - "nN_SS" = nN_SS, - "nN_SS.error" = nN_SS.error, - "Meas_De" = abs(De.measured), - "Meas_De.error" = De.measured.error, - "Meas_D0" = D0.measured, - "Meas_D0.error" = D0.measured.error, - "Meas_Age" = Age.measured, - "Meas_Age.error" = Age.measured.error, - "Sim_De" = De.sim, - "Sim_De.error" = De.error.sim, - "Sim_D0" = D0.sim.Gy, - "Sim_D0.error" = D0.sim.Gy.error, - "Sim_Age" = Age.sim, - "Sim_Age.error" = Age.sim.error, - "Sim_Age_2D0" = Age.sim.2D0, - "Sim_Age_2D0.error" = Age.sim.2D0.error, - "Unfaded_D0" = D0.unfaded, - "Unfaded_D0.error" = D0.error.unfaded, - row.names = NULL), - data = data, - Ln = c(Ln, Ln.error), - LxTx_tables = list( - simulated = LxTx_simulated, - measured = LxTx_measured, - unfaded = LxTx_unfaded), - fits = list( - simulated = fit_simulated, - measured = fit_measured, - unfaded = fit_unfaded - ) - ), - info = list( - call = sys.call(), - args = as.list(sys.call())[-1]) - ) - - ## Console output ------------------------------------------------------------ - if (settings$verbose) { - cat("\n[calc_Huntley2006()]\n") - cat("\n -------------------------------") - cat("\n (n/N) [-]:\t", - round(results@data$results$nN, 2), "\u00b1", - round(results@data$results$nN.error, 2)) - cat("\n (n/N)_SS [-]:\t", - round(results@data$results$nN_SS, 2),"\u00b1", - round(results@data$results$nN_SS.error, 2)) - cat("\n\n ---------- Measured -----------") - cat("\n DE [Gy]:\t", - round(results@data$results$Meas_De, 2), "\u00b1", - round(results@data$results$Meas_De.error, 2)) - cat("\n D0 [Gy]:\t", - round(results@data$results$Meas_D0, 2), "\u00b1", - round(results@data$results$Meas_D0.error, 2)) - if (fit.method[1] == "GOK") { - cat("\n c [-]:\t\t", - round(summary(fit_measured)$coefficients["c", "Estimate"], 2), "\u00b1", - round(summary(fit_measured)$coefficients["c", "Std. Error"], 2)) - } - cat("\n Age [ka]:\t", - round(results@data$results$Meas_Age, 2), "\u00b1", - round(results@data$results$Meas_Age.error, 2)) - cat("\n\n ---------- Un-faded -----------") - cat("\n D0 [Gy]:\t", - round(results@data$results$Unfaded_D0, 2), "\u00b1", - round(results@data$results$Unfaded_D0.error, 2)) - if (fit.method[1] == "GOK") { - cat("\n c [-]:\t\t", - round(summary(fit_unfaded)$coefficients["c", "Estimate"], 2), "\u00b1", - round(summary(fit_unfaded)$coefficients["c", "Std. Error"], 2)) - } - cat("\n\n ---------- Simulated ----------") - cat("\n DE [Gy]:\t", - round(results@data$results$Sim_De, 2), "\u00b1", - round(results@data$results$Sim_De.error, 2)) - cat("\n D0 [Gy]:\t", - round(results@data$results$Sim_D0, 2), "\u00b1", - round(results@data$results$Sim_D0.error, 2)) - if (fit.method[1] == "GOK") { - cat("\n c [-]:\t\t", - round(summary(fit_simulated)$coefficients["c", "Estimate"], 2), "\u00b1", - round(summary(fit_simulated)$coefficients["c", "Std. Error"], 2)) - } - cat("\n Age [ka]:\t", - round(results@data$results$Sim_Age, 2), "\u00b1", - round(results@data$results$Sim_Age.error, 2)) - cat("\n Age @2D0 [ka]:\t", - round(results@data$results$Sim_Age_2D0, 2), "\u00b1", - round(results@data$results$Sim_Age_2D0.error, 2)) - cat("\n -------------------------------\n\n") - - } - - ## Return value -------------------------------------------------------------- - return(results) - } diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_IEU.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_IEU.R deleted file mode 100644 index 59b197db8..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_IEU.R +++ /dev/null @@ -1,452 +0,0 @@ -#' Apply the internal-external-uncertainty (IEU) model after Thomsen et al. -#' (2007) to a given De distribution -#' -#' Function to calculate the IEU De for a De data set. -#' -#' This function uses the equations of Thomsen et al. (2007). The parameters a -#' and b are estimated from dose-recovery experiments. -#' -#' @param data [RLum.Results-class] or [data.frame] (**required**): -#' for [data.frame]: two columns with De `(data[,1])` and -#' De error `(values[,2])` -#' -#' @param a [numeric] (**required**): -#' slope -#' -#' @param b [numeric] (**required**): -#' intercept -#' -#' @param interval [numeric] (**required**): -#' fixed interval (e.g. 5 Gy) used for iteration of `Dbar`, from the mean to -#' Lowest.De used to create Graph.IEU `[Dbar.Fixed vs Z]` -#' -#' @param decimal.point [numeric] (*with default*): -#' number of decimal points for rounding calculations (e.g. 2) -#' -#' @param plot [logical] (*with default*): -#' plot output -#' -#' @param ... further arguments (`trace, verbose`). -#' -#' @return -#' Returns a plot (*optional*) and terminal output. In addition an -#' [RLum.Results-class] object is returned containing the -#' following elements: -#' -#' \item{.$summary}{[data.frame] summary of all relevant model results.} -#' \item{.$data}{[data.frame] original input data} -#' \item{.$args}{[list] used arguments} -#' \item{.$call}{[call] the function call} -#' \item{.$tables}{[list] a list of data frames containing all calculation tables} -#' -#' The output should be accessed using the function [get_RLum]. -#' -#' @section Function version: 0.1.1 -#' -#' @author -#' Rachel Smedley, Geography & Earth Sciences, Aberystwyth University (United Kingdom) \cr -#' Based on an excel spreadsheet and accompanying macro written by Kristina Thomsen. -#' -#' @seealso [plot], [calc_CommonDose], [calc_CentralDose], [calc_FiniteMixture], -#' [calc_FuchsLang2001], [calc_MinDose] -#' -#' @references -#' Smedley, R.K., 2015. A new R function for the Internal External Uncertainty (IEU) model. -#' Ancient TL 33, 16-21. -#' -#' Thomsen, K.J., Murray, A.S., Boetter-Jensen, L. & Kinahan, J., -#' 2007. Determination of burial dose in incompletely bleached fluvial samples -#' using single grains of quartz. Radiation Measurements 42, 370-379. -#' -#' @examples -#' -#' ## load data -#' data(ExampleData.DeValues, envir = environment()) -#' -#' ## apply the IEU model -#' ieu <- calc_IEU(ExampleData.DeValues$CA1, a = 0.2, b = 1.9, interval = 1) -#' -#' @md -#' @export -calc_IEU <- function( - data, - a, - b, - interval, - decimal.point = 2, - plot = TRUE, - ... -) { - - ##==========================================================================## - ## CONSISTENCY CHECK OF INPUT DATA - ##==========================================================================## - if(missing(data)==FALSE){ - if(is(data, "data.frame") == FALSE & is(data,"RLum.Results") == FALSE){ - stop("[calc_IEU()] 'data' object has to be of type - 'data.frame' or 'RLum.Results'!", call = FALSE) - }else{ - if(is(data, "RLum.Results") == TRUE){ - data <- get_RLum(data) - } - } - } - - ##==========================================================================## - ## ... ARGUMENTS - ##==========================================================================## - extraArgs <- list(...) - ## console output - if ("verbose" %in% names(extraArgs)) { - verbose <- extraArgs$verbose - } else { - verbose <- TRUE - } - # trace calculations - if ("trace" %in% names(extraArgs)) { - trace <- extraArgs$trace - } else { - trace <- FALSE - } - # TODO: main, xlab, ylab, xlim, ylim, pch, col - - - ##============================================================================## - ## CALCULATIONS - ##============================================================================## - empty <- NULL - Table.Fixed.Iteration <- data.frame(matrix(nrow = 0, ncol = 9)) - colnames(data) <- c("De", "De.Error") - data <- data[order(data$De), ] - Mean <- mean(data$De) - Dbar <- round(Mean, decimal.point) - Lowest.De <- round(data$De[1], decimal.point) - - # (a) Calculate IEU at fixed intervals of Dbar starting from the Mean and - # subtracting the interval until Dbar is < Lowest.De; this creates a plot - N <- nrow(data) - Rank.number <- t(c(1:N)) - De.Total.Error <- sqrt((data$De.Error^2) + (((a * Dbar) + b)^2)) - Table.Calculations <- data.frame(Rank.number = c(Rank.number), - De = c(data$De), - De.Total.Error = c(De.Total.Error)) - Z.top <- cumsum(Table.Calculations$De/(Table.Calculations$De.Total.Error^2)) - Z.bottom <- cumsum(1/(Table.Calculations$De.Total.Error^2)) - Z <- Z.top/Z.bottom - Table.Calculations["Z"] <- Z - - temp <- NULL - for (j in 1:N) { - for (i in j) { - Z <- Table.Calculations$Z[j] - x <- ((Table.Calculations$De[1:i] - Z)^2)/((Table.Calculations$De.Total.Error[1:i])^2) - y <- (sum(x)) - temp <- rbind(temp, data.frame(y)) - } - } - - EXT.top <- temp - EXT.bottom <- (Table.Calculations$Rank.number - 1) * Z.bottom - EXT <- EXT.top/EXT.bottom - INT <- 1/Z.bottom - R <- sqrt(INT/EXT) - R.Error <- (2 * (Table.Calculations$Rank.number - 1))^(-0.5) - - Table.IEU <- data.frame(Table.Calculations$Rank.number, Table.Calculations$De, - Table.Calculations$De.Total.Error, Table.Calculations$Z, - EXT.top, EXT, INT, R, R.Error) - - colnames(Table.IEU) <- c("Rank.number", "De", "De.Error", "Z", "EXT.top", - "EXT", "INT", "R", "R.Uncertainty") - - Unity <- Table.IEU[R >= 1, ] - Max <- max(Unity$Rank.number, na.rm = TRUE) - Above.Z <- Table.IEU[Max, 4] - Above.Error <- Table.IEU[Max, 6] - Below.Z <- Table.IEU[Max + 1, 4] - Below.Error <- Table.IEU[Max + 1, 6] - Above.R <- Table.IEU[Max, 8] - Below.R <- Table.IEU[Max + 1, 8] - Slope <- (Above.R - Below.R)/(Above.Z - Below.Z) - Intercept <- Above.R - (Slope * Above.Z) - IEU.De <- round(((1 - Intercept)/Slope), decimal.point) - IEU.Error <- max(sqrt(Above.Error), sqrt(Below.Error)) - IEU.Error <- round(IEU.Error, decimal.point) - n <- Max + 1 - - Dbar.Fixed <- Dbar - interval - Dbar.Mean <- c(1, Dbar, Dbar.Fixed, IEU.De, IEU.Error, n, Below.R, a, b) - - repeat { - if (Dbar.Fixed < Lowest.De) { - break - } else { - Dbar <- Dbar.Fixed - } - De.Total.Error <- sqrt((data$De.Error^2) + (((a * Dbar) + b)^2)) - Table.Calculations <- data.frame(Rank.number = c(Rank.number), - De = c(data$De), - De.Total.Error = c(De.Total.Error)) - Z.top <- cumsum(Table.Calculations$De/(Table.Calculations$De.Total.Error^2)) - Z.bottom <- cumsum(1/(Table.Calculations$De.Total.Error^2)) - Z <- Z.top/Z.bottom - Table.Calculations["Z"] <- Z - - temp <- NULL - for (j in 1:N) { - for (i in j) { - Z <- Table.Calculations$Z[j] - x <- ((Table.Calculations$De[1:i] - Z)^2)/((Table.Calculations$De.Total.Error[1:i])^2) - y <- (sum(x)) - temp <- rbind(temp, data.frame(y)) - } - } - - EXT.top <- temp - EXT.bottom <- (Table.Calculations$Rank.number - 1) * Z.bottom - EXT <- EXT.top/EXT.bottom - INT <- 1/Z.bottom - R <- sqrt(INT/EXT) - R.Error <- (2 * (Table.Calculations$Rank.number - 1))^(-0.5) - - Table.IEU <- data.frame(Table.Calculations$Rank.number, Table.Calculations$De, - Table.Calculations$De.Total.Error, Table.Calculations$Z, - EXT.top, EXT, INT, R, R.Error) - - colnames(Table.IEU) <- c("Rank.number", "De", "De.Error", "Z", "EXT.top", - "EXT", "INT", "R", "R.Uncertainty") - - Unity <- Table.IEU[R >= 1, ] - Max <- max(Unity$Rank.number, na.rm = TRUE) - Above.Z <- Table.IEU[Max, 4] - Above.Error <- Table.IEU[Max, 6] - Below.Z <- Table.IEU[Max + 1, 4] - Below.Error <- Table.IEU[Max + 1, 6] - Above.R <- Table.IEU[Max, 8] - Below.R <- Table.IEU[Max + 1, 8] - Slope <- (Above.R - Below.R)/(Above.Z - Below.Z) - Intercept <- Above.R - (Slope * Above.Z) - Zbar <- round(((1 - Intercept)/Slope), decimal.point) - Zbar.Error <- max(sqrt(Above.Error), sqrt(Below.Error)) - Zbar.Error <- round(IEU.Error, decimal.point) - n <- Max + 1 - Dbar.Fixed <- Dbar - interval - Table.Fixed.Iteration <- rbind(Table.Fixed.Iteration, - cbind(1, Dbar, Dbar.Fixed, Zbar, Zbar.Error, - n, Below.R, a, b)) - } - - Table.Fixed.Iteration <- rbind(Dbar.Mean, Table.Fixed.Iteration) - colnames(Table.Fixed.Iteration) <- c(FALSE, "Dbar", "Dbar.Fixed", "Zbar", - "Zbar.Error", "n", "Below.R", "a", "b") - - if (plot) { - plot(Table.Fixed.Iteration$Dbar, - Table.Fixed.Iteration$Zbar, - type = "b", - ylab = "Zbar, weighted mean (Gy)", - xlab = "Dbar (Gy)", - asp = 1/1) - - arrows(Table.Fixed.Iteration$Dbar, Table.Fixed.Iteration$Zbar + Table.Fixed.Iteration$Zbar.Error, - Table.Fixed.Iteration$Dbar, Table.Fixed.Iteration$Zbar - Table.Fixed.Iteration$Zbar.Error, - col = 1, angle = 90, length = 0.05, code = 3) - - abline(0, 1, untf = FALSE, lty = 3) - } - - # (b) Calculate Dbar by iteration from [Dbar = Lowest.De] until [IEU.De = Dbar]; - # this calculates the IEU De - Dbar <- Lowest.De - N <- nrow(data) - Rank.number <- t(c(1:N)) - De.Total.Error <- sqrt((data$De.Error^2) + (((a * Dbar) + b)^2)) - Table.Calculations <- data.frame(Rank.number = c(Rank.number), - De = c(data$De), - De.Total.Error = c(De.Total.Error)) - Z.top <- cumsum(Table.Calculations$De/(Table.Calculations$De.Total.Error^2)) - Z.bottom <- cumsum(1/(Table.Calculations$De.Total.Error^2)) - Z <- Z.top/Z.bottom - Table.Calculations["Z"] <- Z - - temp <- NULL - for (j in 1:N) { - for (i in j) { - Z <- Table.Calculations$Z[j] - x <- ((Table.Calculations$De[1:i] - Z)^2)/((Table.Calculations$De.Total.Error[1:i])^2) - y <- (sum(x)) - temp <- rbind(temp, data.frame(y)) - } - } - - EXT.top <- temp - EXT.bottom <- (Table.Calculations$Rank.number - 1) * Z.bottom - EXT <- EXT.top/EXT.bottom - INT <- 1/Z.bottom - R <- sqrt(INT/EXT) - R.Error <- (2 * (Table.Calculations$Rank.number - 1))^(-0.5) - - Table.IEU <- data.frame(Table.Calculations$Rank.number, Table.Calculations$De, - Table.Calculations$De.Total.Error, Table.Calculations$Z, - EXT.top, EXT, INT, R, R.Error) - - colnames(Table.IEU) <- c("Rank.number", "De", "De.Error", "Z", - "EXT.top", "EXT", "INT", "R", "R.Uncertainty") - - Unity <- Table.IEU[R >= 1, ] - Max <- max(Unity$Rank.number, na.rm = TRUE) - Above.Z <- Table.IEU[Max, 4] - Above.Error <- Table.IEU[Max, 6] - Below.Z <- Table.IEU[Max + 1, 4] - Below.Error <- Table.IEU[Max + 1, 6] - Above.R <- Table.IEU[Max, 8] - Below.R <- Table.IEU[Max + 1, 8] - Slope <- (Above.R - Below.R)/(Above.Z - Below.Z) - Intercept <- Above.R - (Slope * Above.Z) - IEU.De <- round(((1 - Intercept)/Slope), decimal.point) - IEU.Error <- max(sqrt(Above.Error), sqrt(Below.Error)) - IEU.Error <- round(IEU.Error, decimal.point) - n <- Max + 1 - - repeat { - if (IEU.De <= Dbar) { - break - } else { - Dbar <- IEU.De - } - De.Total.Error <- sqrt((data$De.Error^2) + (((a * Dbar) + b)^2)) - Table.Calculations <- data.frame(Rank.number = c(Rank.number), - De = c(data$De), - De.Total.Error = c(De.Total.Error)) - Z.top <- cumsum(Table.Calculations$De/(Table.Calculations$De.Total.Error^2)) - Z.bottom <- cumsum(1/(Table.Calculations$De.Total.Error^2)) - Z <- round((Z.top/Z.bottom), decimal.point) - Table.Calculations["Z"] <- Z - - temp <- NULL - for (j in 1:N) { - for (i in j) { - Z <- Table.Calculations$Z[j] - x <- ((Table.Calculations$De[1:i] - Z)^2)/((Table.Calculations$De.Total.Error[1:i])^2) - y <- (sum(x)) - temp <- rbind(temp, data.frame(y)) - } - } - - EXT.top <- temp - EXT.bottom <- (Table.Calculations$Rank.number - 1) * Z.bottom - EXT <- EXT.top/EXT.bottom - INT <- 1/Z.bottom - R <- sqrt(INT/EXT) - R.Error <- (2 * (Table.Calculations$Rank.number - 1))^(-0.5) - - Table.IEU <- data.frame(Table.Calculations$Rank.number, Table.Calculations$De, - Table.Calculations$De.Total.Error, Table.Calculations$Z, - EXT.top, EXT, INT, R, R.Error) - - colnames(Table.IEU) <- c("Rank.number", "De", "De.Error", "Z", "EXT.top", - "EXT", "INT", "R", "R.Error") - - # to reduce the number of plots and increase perfomance - # intermediate calculations are only plotted when trace = TRUE - if (plot && trace) { - ymin <- min(Table.IEU$R[2:nrow(Table.IEU)] - Table.IEU$R.Error[2:nrow(Table.IEU)]) - ymax <- max(Table.IEU$R[2:nrow(Table.IEU)] + Table.IEU$R.Error[2:nrow(Table.IEU)]) - ylim <- c(ifelse(ymin > 0, 0, ymin), ymax) - - plot(Table.IEU$Z, Table.IEU$R, - type = "b", - ylab = expression(paste("R = [", alpha["in"], "/", alpha["ex"],"]")), - xlab = "Z [Gy]", - ylim = ylim) - - arrows(Table.IEU$Z, Table.IEU$R + Table.IEU$R.Error, - Table.IEU$Z, Table.IEU$R - Table.IEU$R.Error, - col = 1, angle = 90, - length = 0.05, code = 3) - - abline(1, 0, untf = FALSE, lty = 3) - } - - Unity <- Table.IEU[R >= 1, ] - Max <- max(Unity$Rank.number, na.rm = TRUE) - Above.Z <- Table.IEU[Max, 4] - Above.Error <- Table.IEU[Max, 6] - Below.Z <- Table.IEU[Max + 1, 4] - Below.Error <- Table.IEU[Max + 1, 6] - Above.R <- Table.IEU[Max, 8] - Below.R <- Table.IEU[Max + 1, 8] - Slope <- (Above.R - Below.R)/(Above.Z - Below.Z) - Intercept <- Above.R - (Slope * Above.Z) - IEU.De <- round(((1 - Intercept)/Slope), decimal.point) - IEU.Error <- max(sqrt(Above.Error), sqrt(Below.Error)) - IEU.Error <- round(IEU.Error, decimal.point) - n <- Max + 1 - - if (trace) { - message(sprintf("[Iteration of Dbar] \n Dbar: %.4f \n IEU.De: %.4f \n IEU.Error: %.4f \n n: %i \n R: %.4f \n", - Dbar, IEU.De, IEU.Error, n, Below.R)) - } - - } - - # final plot - if (plot) { - ymin <- min(Table.IEU$R[2:nrow(Table.IEU)] - Table.IEU$R.Error[2:nrow(Table.IEU)]) - ymax <- max(Table.IEU$R[2:nrow(Table.IEU)] + Table.IEU$R.Error[2:nrow(Table.IEU)]) - ylim <- c(ifelse(ymin > 0, 0, ymin), ymax) - - plot(Table.IEU$Z, Table.IEU$R, - type = "b", - ylab = expression(paste("R = [", alpha["in"], "/", alpha["ex"],"]")), - xlab = "Z [Gy]", - ylim = ylim) - - arrows(Table.IEU$Z, Table.IEU$R + Table.IEU$R.Error, - Table.IEU$Z, Table.IEU$R - Table.IEU$R.Error, - col = 1, angle = 90, - length = 0.05, code = 3) - - abline(1, 0, untf = FALSE, lty = 3) - } - - - Table.Results <- data.frame(Dbar, IEU.De, IEU.Error, n, a, b) - colnames(Table.Results) <- c("Dbar", "IEU.De (Gy)", "IEU.Error (Gy)", - "Number of De", "a", "b") - - ##==========================================================================## - ## TERMINAL OUTPUT - ##==========================================================================## - if (verbose) { - message(sprintf( - "\n [calc_IEU] \n\n Dbar: %.2f \n IEU.De (Gy): %.2f \n IEU.Error (Gy): %.2f Number of De: %.0f \n a: %.4f \n b: %.4f", - Table.Results[1], Table.Results[2], Table.Results[3], - Table.Results[4], Table.Results[5], Table.Results[6])) - } - - ##==========================================================================## - ## RETURN VALUES - ##==========================================================================## - summary <- Table.Results[ ,c(-1, -5, -6)] - colnames(summary) <- c("de", "de_err", "n") - - call <- sys.call() - args <- list(a = a, b = b, interval = interval, - decimal.point = decimal.point, plot = plot) - - newRLumResults.calc_IEU <- set_RLum( - class = "RLum.Results", - data = list(summary = summary, - data = data, - args = args, - call = call, - tables = list( - Table.IEUCalculations = Table.IEU, - Table.Fixed.Iteration = Table.Fixed.Iteration, - Table.IEUResults = Table.Results - ))) - - invisible(newRLumResults.calc_IEU) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_Kars2008.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_Kars2008.R deleted file mode 100644 index 408fe44f3..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_Kars2008.R +++ /dev/null @@ -1,91 +0,0 @@ -#' Apply the Kars et al. (2008) model (deprecated) -#' -#' A function to calculate the expected sample specific fraction of saturation -#' following Kars et al. (2008) and Huntley (2006). This function is deprecated -#' and will eventually be removed. Please use `calc_Huntley2006()` instead. -#' -#' This function applies the approach described in Kars et al. (2008), -#' developed from the model of Huntley (2006) to calculate the expected sample -#' specific fraction of saturation of a feldspar and also to calculate fading -#' corrected age using this model. \eqn{\rho}' (`rhop`), the density of recombination -#' centres, is a crucial parameter of this model and must be determined -#' separately from a fading measurement. The function [analyse_FadingMeasurement] -#' can be used to calculate the sample specific \eqn{\rho}' value. -#' -#' @param fit.method [character] (*with default*): -#' Fit function of the dose response curve. Can either be `EXP` (the default) -#' or `GOK`. Note that `EXP` (single saturating exponential) is the original -#' function the model after Huntley (2006) and Kars et al. (2008) was -#' designed to use. The use of a general-order kinetics function (`GOK`) -#' is an experimental adaption of the model and should only be used -#' with great care. -#' -#' @param ... Parameters passed to [calc_Huntley2006]. -#' -#' @return An [RLum.Results-class] object is returned: -#' -#' @section Function version: 0.4.0 -#' -#' @author -#' Georgina E. King, University of Bern (Switzerland) \cr -#' Christoph Burow, University of Cologne (Germany) -#' -#' @note **This function is deprecated and will eventually be removed from the package.** -#' **Please use the function [calc_Huntley2006()] instead** -#' **(use `fit.method = "EXP"` to apply the model after Kars et al., 2008).** -#' -#' @keywords datagen -#' -#' @references -#' -#' Kars, R.H., Wallinga, J., Cohen, K.M., 2008. A new approach towards anomalous fading correction for feldspar -#' IRSL dating-tests on samples in field saturation. Radiation Measurements 43, 786-790. doi:10.1016/j.radmeas.2008.01.021 -#' -#' Huntley, D.J., 2006. An explanation of the power-law decay of luminescence. -#' Journal of Physics: Condensed Matter 18, 1359-1365. doi:10.1088/0953-8984/18/4/020 -#' -#' King, G.E., Herman, F., Lambert, R., Valla, P.G., Guralnik, B., 2016. -#' Multi-OSL-thermochronometry of feldspar. Quaternary Geochronology 33, 76-87. doi:10.1016/j.quageo.2016.01.004 -#' -#' -#' **Further reading** -#' -#' Morthekai, P., Jain, M., Cunha, P.P., Azevedo, J.M., Singhvi, A.K., 2011. An attempt to correct -#' for the fading in million year old basaltic rocks. Geochronometria 38(3), 223-230. -#' -#' @examples -#' -#' ## Load example data (sample UNIL/NB123, see ?ExampleData.Fading) -#' data("ExampleData.Fading", envir = environment()) -#' -#' ## (1) Set all relevant parameters -#' # a. fading measurement data (IR50) -#' fading_data <- ExampleData.Fading$fading.data$IR50 -#' -#' # b. Dose response curve data -#' data <- ExampleData.Fading$equivalentDose.data$IR50 -#' -#' ## (2) Define required function parameters -#' ddot <- c(7.00, 0.004) -#' readerDdot <- c(0.134, 0.0067) -#' -#' # Analyse fading measurement and get an estimate of rho'. -#' # Note that the RLum.Results object can be directly used for further processing. -#' # The number of MC runs is reduced for this example -#' rhop <- analyse_FadingMeasurement(fading_data, plot = TRUE, verbose = FALSE, n.MC = 10) -#' -#' ## (3) Apply the Kars et al. (2008) model to the data -#' kars <- suppressWarnings( -#' calc_Kars2008(data = data, -#' rhop = rhop, -#' ddot = ddot, -#' readerDdot = readerDdot, -#' n.MC = 25) -#' ) -#' -#' @md -#' @export -calc_Kars2008 <- function(fit.method = "EXP", ...) { - .Deprecated("calc_Huntley2006") - calc_Huntley2006(fit.method = fit.method, ...) -} \ No newline at end of file diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_Lamothe2003.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_Lamothe2003.R deleted file mode 100644 index 73a58f760..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_Lamothe2003.R +++ /dev/null @@ -1,393 +0,0 @@ -#'@title Apply fading correction after Lamothe et al., 2003 -#' -#'@description This function applies the fading correction for the prediction of long-term fading as suggested -#' by Lamothe et al., 2003. The function basically adjusts the $L_n/T_n$ values and fits a new dose-response -#' curve using the function [plot_GrowthCurve]. -#' -#'@details -#' -#' **Format of `object` if `data.frame`** -#' -#' If `object` is of type [data.frame], all input values most be of type [numeric]. -#' Dose values are excepted in seconds (s) not Gray (Gy). No `NA` values are allowed and -#' the value for the natural dose (first row) should be `0`. Example for three dose points, -#' column names are arbitrary: -#' -#' ``` -#' object <- data.frame( -#' dose = c(0,25,50), -#' LxTx = c(4.2, 2.5, 5.0), -#' LxTx_error = c(0.2, 0.1, 0.2)) -#' ``` -#' -#' **Note on the g-value and `tc`** -#' -#' Users new to R and fading measurements are often confused about what to -#' enter for `tc` and why it may differ from `tc.g_value`. The `tc` value -#' is, by convention (Huntley & Lamothe 2001), the time elapsed between the end of the irradiation and the prompt -#' measurement. Usually there is no reason for having a `tc` value different for the equivalent dose measurement -#' and the *g*-value measurement, except if different equipment was used. -#' However, if, for instance, the *g*-value measurement sequence was analysed -#' with the *Analyst* (Duller 2015) and the `'Luminescence` is used to correct for fading, -#' there is a high chance that the value returned by the *Analyst* comes normalised to 2-days; -#' even the `tc` values of the measurement were identical. -#' In such cases, the fading correction cannot be correct until the `tc.g_value` was manually -#' set to 2-days (`172800` s) because the function will internally recalculate values -#' to an identical `tc` value. -#' -#' @param object [RLum.Results-class] [data.frame] (**required**): Input data for applying the -#' fading correction. Allow are (1) [data.frame] with three columns (`dose`, `LxTx`, `LxTx error`; see details), (2) -#' [RLum.Results-class] object created by the function [analyse_SAR.CWOSL] or [analyse_pIRIRSequence] -#' -#' @param dose_rate.envir [numeric] vector of length 2 (**required**): Environmental dose rate in mGy/a -#' -#' @param dose_rate.source [numeric] vector of length 2 (**required**): Irradiation source dose rate in Gy/s, -#' which is, according to Lamothe et al. (2003) De/t*. -#' -#' @param g_value [numeric] vector of length 2 (**required**): g_value in \%/decade *recalculated at the moment* -#' the equivalent dose was calculated, i.e. `tc` is either similar for the *g*-value measurement **and** the De measurement or -#' needs be to recalculated (cf. [calc_FadingCorr]). Inserting a normalised g-value, e.g., normalised to 2-days , will -#' lead to wrong results -#' -#' @param tc [numeric] (optional): time in seconds between the **end** of the irradiation and -#' the prompt measurement used in the equivalent dose estimation (cf. Huntley & Lamothe 2001). -#' If set to `NULL` it is assumed that `tc` is similar for the equivalent dose -#' estimation and the *g*-value estimation -#' -#' @param tc.g_value [numeric] (with default): the time in seconds between irradiation and the -#' prompt measurement estimating the *g*-value. If the *g*-value was normalised to, e.g., 2 days, -#' this time in seconds (i.e., `172800`) should be entered here along with the time used for the -#' equivalent dose estimation. If nothing is provided the time is set to `tc`, which is the -#' usual case for *g*-values obtained using the SAR method and *g*-values that had been not normalised to 2 days. -#' Note: If this value is not `NULL` the functions expects a [numeric] value for `tc`. -#' -#' @param plot [logical] (with default): Enables/disables plot output -#' -#' @param verbose [logical] (with default): Enables/disables terminal verbose mode -#' -#' @param ... further arguments passed to the function [plot_GrowthCurve] -#' -#' @return The function returns are graphical output produced by the function [plot_GrowthCurve] and -#' an [RLum.Results-class]. -#' -#' -----------------------------------\cr -#' `[ NUMERICAL OUTPUT ]`\cr -#' -----------------------------------\cr -#' -#' **`RLum.Results`**-object -#' -#' **slot:** **`@data`** -#' -#' \tabular{lll}{ -#' **Element** \tab **Type** \tab **Description**\cr -#' `$data` \tab `data.frame` \tab the fading corrected values \cr -#' `$fit` \tab `nls` \tab the object returned by the dose response curve fitting \cr -#' } -#' -#' '**slot:** **`@info`** -#' -#' The original function call -#' -#' @references -#' -#' Huntley, D.J., Lamothe, M., 2001. Ubiquity of anomalous fading in K-feldspars and the measurement -#' and correction for it in optical dating. Canadian Journal of Earth Sciences 38, 1093-1106. -#' -#' Duller, G.A.T., 2015. The Analyst software package for luminescence data: overview and recent improvements. -#' Ancient TL 33, 35–42. -#' -#' Lamothe, M., Auclair, M., Hamzaoui, C., Huot, S., 2003. -#' Towards a prediction of long-term anomalous fading of feldspar IRSL. Radiation Measurements 37, -#' 493-498. -#' -#' @section Function version: 0.1.0 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany), Norbert Mercier, -#' IRAMAT-CRP2A, Université Bordeaux Montaigne (France) -#' -#' @keywords datagen -#' -#' @seealso [plot_GrowthCurve], [calc_FadingCorr], [analyse_SAR.CWOSL], [analyse_pIRIRSequence] -#' -#' @examples -#' -#'##load data -#'##ExampleData.BINfileData contains two BINfileData objects -#'##CWOSL.SAR.Data and TL.SAR.Data -#'data(ExampleData.BINfileData, envir = environment()) -#' -#'##transform the values from the first position in a RLum.Analysis object -#'object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) -#' -#'##perform SAR analysis and set rejection criteria -#'results <- analyse_SAR.CWOSL( -#' object = object, -#' signal.integral.min = 1, -#' signal.integral.max = 2, -#' background.integral.min = 900, -#' background.integral.max = 1000, -#' verbose = FALSE, -#' plot = FALSE, -#' onlyLxTxTable = TRUE -#' ) -#' -#' ##run fading correction -#' results_corr <- calc_Lamothe2003( -#' object = results, -#' dose_rate.envir = c(1.676 , 0.180), -#' dose_rate.source = c(0.184, 0.003), -#' g_value = c(2.36, 0.6), -#' plot = TRUE, -#' fit.method = "EXP") -#' -#' -#'@md -#'@export -calc_Lamothe2003 <- function( - object, - dose_rate.envir, - dose_rate.source, - g_value, - tc = NULL, - tc.g_value = tc, - verbose = TRUE, - plot = TRUE, - ... -){ - - # Input parameter test ------------------------------------------------------------------------ - ##object - if(missing(object)){ - stop("[calc_Lamothe2003()] Input for 'object' missing but required!", call. = FALSE) - } - - ##dose_rate.envir - if(missing(dose_rate.envir)){ - stop("[calc_Lamothe2003()] Input for 'dose_rate.envir' missing but required!", call. = FALSE) - } - - ##dose_rate.source - if(missing(dose_rate.source)){ - stop("[calc_Lamothe2003()] Input for 'dose_rate.source' missing but required!", call. = FALSE) - } - - ##g_value - if(missing(g_value)){ - stop("[calc_Lamothe2003()] Input for 'g_value' missing but required!", call. = FALSE) - } - - ##check input type and length - ##dose_rate.envir - if(!inherits(dose_rate.envir, "numeric") || length(dose_rate.envir) < 2){ - stop("[calc_Lamothe2003()] Input for 'dose_rate.envir' is not of type 'numeric' and/or of length < 2!", call. = FALSE) - - }else{ - if(length(dose_rate.envir) > 2){ - warning("[calc_Lamothe2003()] 'dose_rate.envir' has length > 2. Take only the first two entries.",call. = FALSE, immediate. = TRUE) - dose_rate.envir <- dose_rate.envir[1:2] - } - - } - - ##dose_rate.source - if(!inherits(dose_rate.source, "numeric") || length(dose_rate.source) < 2){ - stop("[calc_Lamothe2003()] Input for 'dose_rate.source' is not of type 'numeric' and/or of length < 2!", call. = FALSE) - - }else{ - if(length(dose_rate.source) > 2){ - warning("[calc_Lamothe2003()] 'dose_rate.source' has length > 2. Take only the first two entries.",call. = FALSE, immediate. = TRUE) - dose_rate.source <- dose_rate.source[1:2] - } - } - - ## g_value - if (!inherits(g_value, "numeric") || length(g_value) < 2) { - stop("[calc_Lamothe2003()] Input for 'g_value' is not of type 'numeric' and/or of length < 2!", call. = FALSE) - } else { - if (length(g_value) > 2) { - warning("[calc_Lamothe2003()] 'g_value' has length > 2. Take only the first two entries.", - call. = FALSE, immediate. = TRUE) - g_value <- g_value[1:2] - } - } - - ##tc - if(is.null(tc) && !is.null(tc.g_value)) - stop("[calc_Lamothe2003()] If you set 'tc.g_value' you have to provide a value for 'tc' too!", call. = FALSE) - - - # Input assignment ----------------------------------------------------------------------------- - ## We allow input as data.frame() and RLum.Results objects ... the output from functions listed - ## below .. if we allow a data.frame it should have at least Dose, Lx/Tx, Lx/Tx Error - if(inherits(object, "data.frame")){ - data <- object[,1:3] - - ##add signal information - if(any(grepl(pattern = "Signal", x = colnames(object), fixed = TRUE))){ - SIGNAL <- object[[which(grepl(pattern = "Signal", colnames(object), fixed = TRUE))[1]]] - - }else{ - SIGNAL <- NA - - } - - }else if(inherits(object, "RLum.Results")){ - if(object@originator == "analyse_SAR.CWOSL" || object@originator == "analyse_pIRIRSequence"){ - ##now we do crazy stuff, we make a self-call here since this file can contain a lot of information - - ##get number of datasets; we have to search for the word natural, everything else is not safe enough - full_table <- object@data$LnLxTnTx.table - set_start <- which(grepl(full_table$Name, pattern = "Natural", fixed = TRUE)) - set_end <- c(set_start[-1] - 1, nrow(full_table)) - - ##signal column if available - if(object@originator == "analyse_pIRIRSequence"){ - object <- full_table[,c("Dose", "LxTx", "LxTx.Error", "Signal")] - }else{ - object <- full_table[,c("Dose", "LxTx", "LxTx.Error")] - - } - - ##now run the function - results <- lapply(1:length(set_start), function(x){ - calc_Lamothe2003( - object = object[set_start[x]:set_end[x], ], - dose_rate.envir = dose_rate.envir, - dose_rate.source = dose_rate.source, - g_value = g_value, - tc = tc, - tc.g_value = tc.g_value, - verbose = verbose, - plot = plot, - ... - ) - }) - - ##merge output - return(merge_RLum(results)) - }else{ - stop(paste0("[calc_Lamothe2003()] Input for 'object' created by function ",object@originator, "() not supported!"), call. = FALSE) - - } - - - }else{ - stop("[calc_Lamothe2003()] Unsupported data type for 'object'!", call. = FALSE) - - } - - # Apply correction---------------------------------------------------------------------------- - - ##recalculate the g-value to the given tc ... - ##re-calculation thanks to the help by Sébastien Huot, e-mail: 2016-07-19 - if(!is.null(tc)){ - k0 <- g_value / 100 / log(10) - k1 <- k0 / (1 - k0 * log(tc[1]/tc.g_value[1])) - g_value <- 100 * k1 * log(10) - - } - - # transform irradiation times to dose values - data[[1]] <- data[[1]] * dose_rate.source[1] - - ## fading correction (including dose rate conversion from Gy/s to Gy/ka) - ## and error calculation - ## the formula in Lamothe et al. (2003) reads: - ## I_faded = I_unfaded*(1-g*log((1/e)*DR_lab/DR_soil))) - rr <- 31.5576e+09 * dose_rate.source[1] / (exp(1) * dose_rate.envir[1]) - s_rr <- sqrt((dose_rate.source[2]/dose_rate.source[1])^2 + (dose_rate.envir[2]/dose_rate.envir[1])^2) * rr - Fading_C <- 1 - g_value[1] / 100 * log10(rr) - sFading_C <- sqrt((log10(rr) * g_value[2]/100)^2 + (g_value[1]/(100 * rr) * s_rr)^2) - - # store original Lx/Tx in new object - LnTn_BEFORE <- data[[2]][1] - LnTn_BEFORE.ERROR <- data[[3]][1] - - # apply to input data - data[[2]][1] <- data[[2]][1] / Fading_C - data[[3]][1] <- sqrt((data[[3]][1]/data[[2]][1])^2 + - ((1/Fading_C - 1) * sFading_C/Fading_C)^2) * data[[2]][1] - - ##TODO discuss with Norbert - # data[[3]][1] <- sqrt((data[[3]][1]/data[[2]][1])^2 + - # (sFading_C/Fading_C)^2) * data[[2]][1] - # - # print(LnTn_BEFORE.ERROR/LnTn_BEFORE) - # print(data[[3]][1]/ data[[2]][1] ) - - # Fitting --------------------------------------------------------------------------------- - ##set arguments - argument_list <- list( - sample = data, - verbose = FALSE, - main = "Corrected Dose Response Curve", - xlab = "Dose [Gy]", - txtProgressBar = verbose, - output.plotExtended = FALSE, - output.plot = plot - - ) - - ##filter doubled arguments - argument_list <- modifyList(x = argument_list, val = list(...)) - - ##run plot function - fit_results <- do.call(what = plot_GrowthCurve,args = argument_list) - - - # Age calculation ----------------------------------------------------------------------------- - Age <- get_RLum(fit_results)[["De"]] / dose_rate.envir[1] - s_Age <- sqrt((100*get_RLum(fit_results)[["De.Error"]]/get_RLum(fit_results)[["De"]])^2 + (100*dose_rate.envir[2]/dose_rate.envir[1])^2) *Age/100 - - - # Terminal output ----------------------------------------------------------------------------- - if(verbose){ - cat("\n[calc_Lamothe2003()] \n\n") - cat(" Used g_value:\t\t", round(g_value[1],3)," \u00b1 ",round(g_value[2],3),"%/decade \n") - if(!is.null(tc)){ - cat(" tc for g_value:\t", tc.g_value, " s\n") - - } - cat("\n") - cat(" Fading_C:\t\t", round(Fading_C,3), " \u00b1 ", round(sFading_C,3),"\n") - cat(" Corrected Ln/Tn:\t", round(data[[2]][1],3), " \u00b1 ", round(data[[3]][1],3),"\n") - cat(" Corrected De:\t\t", round(get_RLum(fit_results)[["De"]],2), " \u00b1 ", round(get_RLum(fit_results)[["De.Error"]],2)," Gy \n") - cat("--------------------------------------------------------\n") - cat(" Corrected Age:\t\t", round(Age,2), " \u00b1 ", round(s_Age,2)," ka \n") - cat("--------------------------------------------------------\n") - - } - - # Compile output ------------------------------------------------------------------------------ - return( - set_RLum( - class = "RLum.Results", - data = list( - data = data.frame( - g_value = g_value[1], - g_value.ERROR = g_value[2], - tc = ifelse(is.null(tc), NA, tc), - tc.g_value = ifelse(is.null(tc.g_value), NA, tc.g_value), - FADING_C = Fading_C, - FADING_C.ERROR = sFading_C, - LnTn_BEFORE = LnTn_BEFORE, - LnTn_BEFORE.ERROR = LnTn_BEFORE.ERROR, - LnTn_AFTER = data[[2]][1], - LnTn_AFTER.ERROR = data[[3]][1], - DE = get_RLum(fit_results)[["De"]], - DE.ERROR = get_RLum(fit_results)[["De.Error"]], - AGE = Age, - AGE.ERROR = s_Age, - SIGNAL = SIGNAL - ), - fit = get_RLum(fit_results, data.object = "Fit") - - ), - info = list( - call = sys.call() - ) - ) - - ) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_MaxDose.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_MaxDose.R deleted file mode 100644 index 553f79b01..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_MaxDose.R +++ /dev/null @@ -1,140 +0,0 @@ -#' Apply the maximum age model to a given De distribution -#' -#' Function to fit the maximum age model to De data. This is a wrapper function -#' that calls [calc_MinDose] and applies a similar approach as described in -#' Olley et al. (2006). -#' -#' **Data transformation** -#' -#' To estimate the maximum dose population -#' and its standard error, the three parameter minimum age model of Galbraith -#' et al. (1999) is adapted. The measured De values are transformed as follows: -#' -#' 1. convert De values to natural logs -#' 2. multiply the logged data to create a mirror image of the De distribution -#' 3. shift De values along x-axis by the smallest x-value found to obtain only positive values -#' 4. combine in quadrature the measurement error associated with each De value -#' with a relative error specified by `sigmab` -#' 5. apply the MAM to these data -#' -#' When all calculations are done the results are then converted as follows -#' 1. subtract the x-offset -#' 2. multiply the natural logs by -1 -#' 3. take the exponent to obtain the maximum dose estimate in Gy -#' -#' **Further documentation** -#' -#' Please see [calc_MinDose]. -#' -#' @param data [RLum.Results-class] or [data.frame] (**required**): -#' for [data.frame]: two columns with De `(data[ ,1])` and De error `(data[ ,2])`. -#' -#' @param sigmab [numeric] (**required**): -#' additional spread in De values. -#' This value represents the expected overdispersion in the data should the sample be -#' well-bleached (Cunningham & Walling 2012, p. 100). -#' **NOTE**: For the logged model (`log = TRUE`) this value must be -#' a fraction, e.g. 0.2 (= 20 \%). If the un-logged model is used (`log = FALSE`), -#' sigmab must be provided in the same absolute units of the De values (seconds or Gray). -#' See details ([calc_MinDose]. -#' -#' @param log [logical] (*with default*): -#' fit the (un-)logged three parameter minimum dose model to De data -#' -#' @param par [numeric] (*with default*): -#' apply the 3- or 4-parameter minimum age model (`par=3` or `par=4`). -#' -#' @param bootstrap [logical] (*with default*): -#' apply the recycled bootstrap approach of Cunningham & Wallinga (2012). -#' -#' @param init.values [numeric] (*with default*): -#' starting values for gamma, sigma, p0 and mu. Custom values need to be provided in a vector of -#' length three in the form of `c(gamma, sigma, p0)`. -#' -#' @param plot [logical] (*with default*): -#' plot output (`TRUE`/`FALSE`) -#' -#' @param ... further arguments for bootstrapping (`bs.M, bs.N, bs.h, sigmab.sd`). -#' See details for their usage. -#' -#' @return Please see [calc_MinDose]. -#' -#' @section Function version: 0.3.1 -#' -#' @author -#' Christoph Burow, University of Cologne (Germany) \cr -#' Based on a rewritten S script of Rex Galbraith, 2010 -#' -#' -#' @seealso [calc_CentralDose], [calc_CommonDose], [calc_FiniteMixture], -#' [calc_FuchsLang2001], [calc_MinDose] -#' -#' @references -#' Arnold, L.J., Roberts, R.G., Galbraith, R.F. & DeLong, S.B., -#' 2009. A revised burial dose estimation procedure for optical dating of young -#' and modern-age sediments. Quaternary Geochronology 4, 306-325. -#' -#' Galbraith, R.F. & Laslett, G.M., 1993. Statistical models for mixed fission -#' track ages. Nuclear Tracks Radiation Measurements 4, 459-470. -#' -#' Galbraith, R.F., Roberts, R.G., Laslett, G.M., Yoshida, H. & Olley, J.M., -#' 1999. Optical dating of single grains of quartz from Jinmium rock shelter, -#' northern Australia. Part I: experimental design and statistical models. -#' Archaeometry 41, 339-364. -#' -#' Galbraith, R.F., 2005. Statistics for -#' Fission Track Analysis, Chapman & Hall/CRC, Boca Raton. -#' -#' Galbraith, R.F. & Roberts, R.G., 2012. Statistical aspects of equivalent dose and error -#' calculation and display in OSL dating: An overview and some recommendations. -#' Quaternary Geochronology 11, 1-27. -#' -#' Olley, J.M., Roberts, R.G., Yoshida, H., Bowler, J.M., 2006. Single-grain optical dating of grave-infill -#' associated with human burials at Lake Mungo, Australia. Quaternary Science -#' Reviews 25, 2469-2474 -#' -#' **Further reading** -#' -#' Arnold, L.J. & Roberts, R.G., 2009. Stochastic modelling of multi-grain equivalent dose -#' (De) distributions: Implications for OSL dating of sediment mixtures. -#' Quaternary Geochronology 4, 204-230. -#' -#' Bailey, R.M. & Arnold, L.J., 2006. Statistical modelling of single grain quartz De distributions and an -#' assessment of procedures for estimating burial dose. Quaternary Science -#' Reviews 25, 2475-2502. -#' -#' Cunningham, A.C. & Wallinga, J., 2012. Realizing the potential of fluvial archives using robust OSL chronologies. -#' Quaternary Geochronology 12, 98-106. -#' -#' Rodnight, H., Duller, G.A.T., Wintle, A.G. & Tooth, S., 2006. Assessing the reproducibility and accuracy -#' of optical dating of fluvial deposits. Quaternary Geochronology 1, 109-120. -#' -#' Rodnight, H., 2008. How many equivalent dose values are needed to -#' obtain a reproducible distribution?. Ancient TL 26, 3-10. -#' -#' @examples -#' -#' ## load example data -#' data(ExampleData.DeValues, envir = environment()) -#' -#' # apply the maximum dose model -#' calc_MaxDose(ExampleData.DeValues$CA1, sigmab = 0.2, par = 3) -#' -#' @md -#' @export -calc_MaxDose<- function( - data, - sigmab, - log=TRUE, - par=3, - bootstrap=FALSE, - init.values, - plot=TRUE, - ... -){ - res<- calc_MinDose(data, sigmab, log, par, bootstrap, init.values, plot=FALSE, invert=TRUE, ...) - res@originator<- "calc_MaxDose" - if (plot) try(plot_RLum.Results(res, ...)) - - invisible(res) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_MinDose.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_MinDose.R deleted file mode 100644 index 05d1400d5..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_MinDose.R +++ /dev/null @@ -1,1049 +0,0 @@ -#' Apply the (un-)logged minimum age model (MAM) after Galbraith et al. (1999) -#' to a given De distribution -#' -#' Function to fit the (un-)logged three or four parameter minimum dose model -#' (MAM-3/4) to De data. -#' -#' **Parameters** -#' -#' This model has four parameters: -#' \tabular{rl}{ -#' `gamma`: \tab minimum dose on the log scale \cr -#' `mu`: \tab mean of the non-truncated normal distribution \cr -#' `sigma`: \tab spread in ages above the minimum \cr -#' `p0`: \tab proportion of grains at gamma \cr } -#' -#' If `par=3` (default) the 3-parameter minimum age model is applied, -#' where `gamma=mu`. For `par=4` the 4-parameter model is applied instead. -#' -#' **(Un-)logged model** -#' -#' In the original version of the minimum dose model, the basic data are the natural -#' logarithms of the De estimates and relative standard errors of the De -#' estimates. The value for `sigmab` must be provided as a ratio -#' (e.g, 0.2 for 20 \%). This model will be applied if `log = TRUE`. -#' -#' If `log=FALSE`, the modified un-logged model will be applied instead. This -#' has essentially the same form as the original version. `gamma` and -#' `sigma` are in Gy and `gamma` becomes the minimum true dose in the -#' population. -#' **Note** that the un-logged model requires `sigmab` to be in the same -#' absolute unit as the provided De values (seconds or Gray). -#' -#' While the original (logged) version of the minimum dose -#' model may be appropriate for most samples (i.e. De distributions), the -#' modified (un-logged) version is specially designed for modern-age and young -#' samples containing negative, zero or near-zero De estimates (Arnold et al. -#' 2009, p. 323). -#' -#' **Initial values & boundaries** -#' -#' The log likelihood calculations use the [nlminb] function for box-constrained -#' optimisation using PORT routines. Accordingly, initial values for the four -#' parameters can be specified via `init.values`. If no values are -#' provided for `init.values` reasonable starting values are estimated -#' from the input data. If the final estimates of *gamma*, *mu*, -#' *sigma* and *p0* are totally off target, consider providing custom -#' starting values via `init.values`. -#' In contrast to previous versions of this function the boundaries for the -#' individual model parameters are no longer required to be explicitly specified. -#' If you want to override the default boundary values use the arguments -#' `gamma.lower`, `gamma.upper`, `sigma.lower`, `sigma.upper`, `p0.lower`, `p0.upper`, -#' `mu.lower` and `mu.upper`. -#' -#' **Bootstrap** -#' -#' When `bootstrap=TRUE` the function applies the bootstrapping method as -#' described in Wallinga & Cunningham (2012). By default, the minimum age model -#' produces 1000 first level and 3000 second level bootstrap replicates -#' (actually, the number of second level bootstrap replicates is three times -#' the number of first level replicates unless specified otherwise). The -#' uncertainty on sigmab is 0.04 by default. These values can be changed by -#' using the arguments `bs.M` (first level replicates), `bs.N` -#' (second level replicates) and `sigmab.sd` (error on sigmab). With -#' `bs.h` the bandwidth of the kernel density estimate can be specified. -#' By default, `h` is calculated as -#' -#' \deqn{h = (2*\sigma_{DE})/\sqrt{n}} -#' -#' **Multicore support** -#' -#' This function supports parallel computing and can be activated by `multicore=TRUE`. -#' By default, the number of available logical CPU cores is determined -#' automatically, but can be changed with `cores`. The multicore support -#' is only available when `bootstrap=TRUE` and spawns `n` R instances -#' for each core to get MAM estimates for each of the N and M bootstrap -#' replicates. Note that this option is highly experimental and may or may not -#' work for your machine. Also the performance gain increases for larger number -#' of bootstrap replicates. Also note that with each additional core and hence -#' R instance and depending on the number of bootstrap replicates the memory -#' usage can significantly increase. Make sure that memory is always available, -#' otherwise there will be a massive performance hit. -#' -#' **Likelihood profiles** -#' -#' The likelihood profiles are generated and plotted by the `bbmle` package. -#' The profile likelihood plots look different to ordinary profile likelihood as -#' -#' "`[...]` the plot method for likelihood profiles displays the square root of -#' the the deviance difference (twice the difference in negative log-likelihood from -#' the best fit), so it will be V-shaped for cases where the quadratic approximation -#' works well `[...]`." (Bolker 2016). -#' -#' For more details on the profile likelihood -#' calculations and plots please see the vignettes of the `bbmle` package -#' (also available here: [https://CRAN.R-project.org/package=bbmle]()). -#' -#' @param data [RLum.Results-class] or [data.frame] (**required**): -#' for [data.frame]: two columns with De `(data[ ,1])` and De error `(data[ ,2])`. -#' -#' @param sigmab [numeric] (**required**): -#' additional spread in De values. -#' This value represents the expected overdispersion in the data should the sample be -#' well-bleached (Cunningham & Walling 2012, p. 100). -#' **NOTE**: For the logged model (`log = TRUE`) this value must be -#' a fraction, e.g. 0.2 (= 20 \%). If the un-logged model is used (`log = FALSE`), -#' sigmab must be provided in the same absolute units of the De values (seconds or Gray). -#' See details. -#' -#' @param log [logical] (*with default*): -#' fit the (un-)logged minimum dose model to De data. -#' -#' @param par [numeric] (*with default*): -#' apply the 3- or 4-parameter minimum age model (`par=3` or `par=4`). The MAM-3 is -#' used by default. -#' -#' @param bootstrap [logical] (*with default*): -#' apply the recycled bootstrap approach of Cunningham & Wallinga (2012). -#' -#' @param init.values [numeric] (*optional*): -#' a named list with starting values for gamma, sigma, p0 and mu -#' (e.g. `list(gamma=100, sigma=1.5, p0=0.1, mu=100)`). If no values are provided reasonable values -#' are tried to be estimated from the data. **NOTE** that the initial values must always be given -#' in the absolute units. The the logged model is applied (`log = TRUE`), the provided `init.values` -#' are automatically log transformed. -#' -#' @param level [logical] (*with default*): -#' the confidence level required (defaults to 0.95). -#' -#' @param log.output [logical] (*with default*): -#' If `TRUE` the console output will also show the logged values of the final parameter estimates -#' and confidence intervals (only applicable if `log = TRUE`). -#' -#' @param plot [logical] (*with default*): -#' plot output (`TRUE`/`FALSE`) -#' -#' @param multicore [logical] (*with default*): -#' enable parallel computation of the bootstrap by creating a multicore SNOW cluster. Depending -#' on the number of available logical CPU cores this may drastically reduce -#' the computation time. Note that this option is highly experimental and may not -#' work on all machines. (`TRUE`/`FALSE`) -#' -#' @param ... (*optional*) further arguments for bootstrapping -#' (`bs.M, bs.N, bs.h, sigmab.sd`). See details for their usage. -#' Further arguments are -#' - `verbose` to de-/activate console output (logical), -#' - `debug` for extended console output (logical) and -#' - `cores` (integer) to manually specify the number of cores to be used when `multicore=TRUE`. -#' -#' @return Returns a plot (*optional*) and terminal output. In addition an -#' [RLum.Results-class] object is returned containing the -#' following elements: -#' -#' \item{.$summary}{[data.frame] summary of all relevant model results.} -#' \item{.$data}{[data.frame] original input data} -#' \item{args}{[list] used arguments} -#' \item{call}{[call] the function call} -#' \item{.$mle}{[bbmle::mle2] object containing the maximum log likelihood functions for all parameters} -#' \item{BIC}{[numeric] BIC score} -#' \item{.$confint}{[data.frame] confidence intervals for all parameters} -#' \item{.$profile}{[stats::profile] the log likelihood profiles} -#' \item{.$bootstrap}{[list] bootstrap results} -#' -#' The output should be accessed using the function [get_RLum] -#' -#' @note -#' The default starting values for *gamma*, *mu*, *sigma* -#' and *p0* may only be appropriate for some De data sets and may need to -#' be changed for other data. This is especially true when the un-logged -#' version is applied. \cr -#' Also note that all R warning messages are suppressed -#' when running this function. If the results seem odd consider re-running the -#' model with `debug=TRUE` which provides extended console output and -#' forwards all internal warning messages. -#' -#' @section Function version: 0.4.4 -#' -#' @author -#' Christoph Burow, University of Cologne (Germany) \cr -#' Based on a rewritten S script of Rex Galbraith, 2010 \cr -#' The bootstrap approach is based on a rewritten MATLAB script of Alastair Cunningham. \cr -#' Alastair Cunningham is thanked for his help in implementing and cross-checking the code. -#' -#' @seealso [calc_CentralDose], [calc_CommonDose], [calc_FiniteMixture], -#' [calc_FuchsLang2001], [calc_MaxDose] -#' -#' @references -#' Arnold, L.J., Roberts, R.G., Galbraith, R.F. & DeLong, S.B., -#' 2009. A revised burial dose estimation procedure for optical dating of young -#' and modern-age sediments. Quaternary Geochronology 4, 306-325. -#' -#' Galbraith, R.F. & Laslett, G.M., 1993. Statistical models for mixed fission -#' track ages. Nuclear Tracks Radiation Measurements 4, 459-470. -#' -#' Galbraith, R.F., Roberts, R.G., Laslett, G.M., Yoshida, H. & Olley, J.M., -#' 1999. Optical dating of single grains of quartz from Jinmium rock shelter, -#' northern Australia. Part I: experimental design and statistical models. -#' Archaeometry 41, 339-364. -#' -#' Galbraith, R.F., 2005. Statistics for -#' Fission Track Analysis, Chapman & Hall/CRC, Boca Raton. -#' -#' Galbraith, R.F. & Roberts, R.G., 2012. Statistical aspects of equivalent dose and error -#' calculation and display in OSL dating: An overview and some recommendations. -#' Quaternary Geochronology 11, 1-27. -#' -#' Olley, J.M., Roberts, R.G., Yoshida, H., Bowler, J.M., 2006. Single-grain optical dating of grave-infill -#' associated with human burials at Lake Mungo, Australia. Quaternary Science -#' Reviews 25, 2469-2474. -#' -#' **Further reading** -#' -#' Arnold, L.J. & Roberts, R.G., 2009. Stochastic modelling of multi-grain equivalent dose -#' (De) distributions: Implications for OSL dating of sediment mixtures. -#' Quaternary Geochronology 4, 204-230. -#' -#' Bolker, B., 2016. Maximum likelihood estimation analysis with the bbmle package. -#' In: Bolker, B., R Development Core Team, 2016. bbmle: Tools for General Maximum Likelihood Estimation. -#' R package version 1.0.18. [https://CRAN.R-project.org/package=bbmle]() -#' -#' Bailey, R.M. & Arnold, L.J., 2006. Statistical modelling of single grain quartz De distributions and an -#' assessment of procedures for estimating burial dose. Quaternary Science -#' Reviews 25, 2475-2502. -#' -#' Cunningham, A.C. & Wallinga, J., 2012. Realizing the potential of fluvial archives using robust OSL chronologies. -#' Quaternary Geochronology 12, 98-106. -#' -#' Rodnight, H., Duller, G.A.T., Wintle, A.G. & Tooth, S., 2006. Assessing the reproducibility and accuracy -#' of optical dating of fluvial deposits. Quaternary Geochronology 1, 109-120. -#' -#' Rodnight, H., 2008. How many equivalent dose values are needed to -#' obtain a reproducible distribution?. Ancient TL 26, 3-10. -#' -#' -#' @examples -#' -#' ## Load example data -#' data(ExampleData.DeValues, envir = environment()) -#' -#' # (1) Apply the minimum age model with minimum required parameters. -#' # By default, this will apply the un-logged 3-parameter MAM. -#' calc_MinDose(data = ExampleData.DeValues$CA1, sigmab = 0.1) -#' -#' \dontrun{ -#' # (2) Re-run the model, but save results to a variable and turn -#' # plotting of the log-likelihood profiles off. -#' mam <- calc_MinDose( -#' data = ExampleData.DeValues$CA1, -#' sigmab = 0.1, -#' plot = FALSE) -#' -#' # Show structure of the RLum.Results object -#' mam -#' -#' # Show summary table that contains the most relevant results -#' res <- get_RLum(mam, "summary") -#' res -#' -#' # Plot the log likelihood profiles retroactively, because before -#' # we set plot = FALSE -#' plot_RLum(mam) -#' -#' # Plot the dose distribution in an abanico plot and draw a line -#' # at the minimum dose estimate -#' plot_AbanicoPlot(data = ExampleData.DeValues$CA1, -#' main = "3-parameter Minimum Age Model", -#' line = mam,polygon.col = "none", -#' hist = TRUE, -#' rug = TRUE, -#' summary = c("n", "mean", "mean.weighted", "median", "in.ci"), -#' centrality = res$de, -#' line.col = "red", -#' grid.col = "none", -#' line.label = paste0(round(res$de, 1), "\U00B1", -#' round(res$de_err, 1), " Gy"), -#' bw = 0.1, -#' ylim = c(-25, 18), -#' summary.pos = "topleft", -#' mtext = bquote("Parameters: " ~ -#' sigma[b] == .(get_RLum(mam, "args")$sigmab) ~ ", " ~ -#' gamma == .(round(log(res$de), 1)) ~ ", " ~ -#' sigma == .(round(res$sig, 1)) ~ ", " ~ -#' rho == .(round(res$p0, 2)))) -#' -#' -#' -#' # (3) Run the minimum age model with bootstrap -#' # NOTE: Bootstrapping is computationally intensive -#' # (3.1) run the minimum age model with default values for bootstrapping -#' calc_MinDose(data = ExampleData.DeValues$CA1, -#' sigmab = 0.15, -#' bootstrap = TRUE) -#' -#' # (3.2) Bootstrap control parameters -#' mam <- calc_MinDose(data = ExampleData.DeValues$CA1, -#' sigmab = 0.15, -#' bootstrap = TRUE, -#' bs.M = 300, -#' bs.N = 500, -#' bs.h = 4, -#' sigmab.sd = 0.06, -#' plot = FALSE) -#' -#' # Plot the results -#' plot_RLum(mam) -#' -#' # save bootstrap results in a separate variable -#' bs <- get_RLum(mam, "bootstrap") -#' -#' # show structure of the bootstrap results -#' str(bs, max.level = 2, give.attr = FALSE) -#' -#' # print summary of minimum dose and likelihood pairs -#' summary(bs$pairs$gamma) -#' -#' # Show polynomial fits of the bootstrap pairs -#' bs$poly.fits$poly.three -#' -#' # Plot various statistics of the fit using the generic plot() function -#' par(mfcol=c(2,2)) -#' plot(bs$poly.fits$poly.three, ask = FALSE) -#' -#' # Show the fitted values of the polynomials -#' summary(bs$poly.fits$poly.three$fitted.values) -#' } -#' -#' @md -#' @export -calc_MinDose <- function( - data, - sigmab, - log = TRUE, - par = 3, - bootstrap = FALSE, - init.values, - level = 0.95, - log.output = FALSE, - plot = TRUE, - multicore = FALSE, - ... -){ - - ## ============================================================================## - ## CONSISTENCY CHECK OF INPUT DATA - ## ============================================================================## - if (!missing(data)) { - if (!is(data, "data.frame") & !is(data, "RLum.Results")) { - .throw_error("Error: 'data' object must be of type ", - "'data.frame' or 'RLum.Results'") - } - if (is(data, "RLum.Results")) { - data <- get_RLum(data, "data") - } - } - - if (any(!complete.cases(data))) { - message("\n[calc_MinDose] Warning: Input data contained NA/NaN values, ", - "which were removed prior to calculations!") - data <- data[complete.cases(data), ] - } - - if (!missing(init.values)) { - if (!is.list(init.values)) { - .throw_error("'init.values' is expected to be a named list") - } - exp.names <- c("gamma", "sigma", "p0", "mu") - mis.names <- setdiff(exp.names, names(init.values)) - if (length(init.values) != length(exp.names) || length(mis.names) > 0) { - .throw_error("Please provide initial values for all model parameters. ", - "\nMissing parameters: ", - paste(mis.names, collapse = ", ")) - } - } - - ## par can only be 3 or 4 - .validate_positive_scalar(par, int = TRUE) - if (!par %in% c(3, 4)) { - .throw_error("'par' can only be set to 3 or 4") - } - - ##============================================================================## - ## ... ARGUMENTS - ##============================================================================## - - extraArgs <- list(...) - - ## check if this function is called by calc_MaxDose() - if ("invert" %in% names(extraArgs)) { - invert <- extraArgs$invert - if (!log) { - log <- TRUE # overwrite user choice as max dose model currently only supports the logged version - cat(paste("\n[WARNING] The maximum dose model only supports the logged version.", - "'log' was automatically changed to TRUE.\n\n")) - } - } else { - invert <- FALSE - } - - ## console output - if ("verbose" %in% names(extraArgs)) { - verbose <- extraArgs$verbose - } else { - verbose <- TRUE - } - - ## bootstrap replications - # first level bootstrap - if ("bs.M" %in% names(extraArgs)) { - M <- as.integer(extraArgs$bs.M) - } else { - M <- 1000 - } - - # second level bootstrap - if ("bs.N" %in% names(extraArgs)) { - N <- as.integer(extraArgs$bs.N) - } else { - N <- 3*M - } - - # KDE bandwith - if ("bs.h" %in% names(extraArgs)) { - h <- extraArgs$bs.h - } else { - h <- (sd(data[ ,1])/sqrt(length(data[ ,1])))*2 - } - - # standard deviation of sigmab - if ("sigmab.sd" %in% names(extraArgs)) { - sigmab.sd <- extraArgs$sigmab.sd - } else { - sigmab.sd <- 0.04 - } - - if ("debug" %in% names(extraArgs)) { - debug <- extraArgs$debug - } else { - debug <- FALSE - } - - if ("cores" %in% names(extraArgs)) { - cores <- extraArgs$cores - } else { - cores <- parallel::detectCores() - if (multicore) - message(paste("Logical CPU cores detected:", cores)) - } - - ## WARNINGS ---- - # if (!debug) - # options(warn = -1) - - ##============================================================================## - ## START VALUES - ##============================================================================## - - if (missing(init.values)) { - start <- list(gamma = ifelse(log, log(quantile(data[ ,1], probs = 0.25, na.rm = TRUE)), - quantile(data[ ,1], probs = 0.25, na.rm = TRUE)), - sigma = 1.2, - p0 = 0.01, - mu = ifelse(log, log(quantile(data[ ,1], probs = 0.25, na.rm = TRUE)), - mean(data[ ,1]))) - } else { - start <- list(gamma = ifelse(log, log(init.values$gamma), init.values$gamma), - sigma = ifelse(log, log(init.values$sigma), init.values$sigma), - p0 = init.values$p0, - mu = ifelse(log, log(init.values$mu), init.values$mu)) - } - - ##============================================================================## - ## ESTIMATE BOUNDARY PARAMETERS - ##============================================================================## - - boundaries <- list( - # gamma.lower = min(data[ ,1]/10), - # gamma.upper = max(data[ ,1]*1.1), - # sigma.lower = 0, - # sigma.upper = 5, - # mu.lower = min(data[ ,1])/10, - # mu.upper = max(data[ ,1]*1.1) - gamma.lower = -Inf, - gamma.upper = Inf, - - sigma.lower = 0, - sigma.upper = Inf, - - p0.lower = 0, - p0.upper = 1, - - mu.lower = -Inf, - mu.upper = Inf - ) - - boundaries <- modifyList(boundaries, list(...)) - - # combine lower and upper boundary values to vectors - if (log) { - xlb <- c(ifelse(is.infinite(boundaries$gamma.lower), - boundaries$gamma.lower, - log(boundaries$gamma.lower)), - boundaries$sigma.lower, - boundaries$p0.lower) - xub <- c(ifelse(is.infinite(boundaries$gamma.upper), - boundaries$gamma.upper, - log(boundaries$gamma.upper)), - boundaries$sigma.upper, - boundaries$p0.lower) - } else { - xlb <- c(boundaries$gamma.lower, - boundaries$sigma.lower, - boundaries$p0.lower) - xub <- c(boundaries$gamma.upper, - exp(boundaries$sigma.upper), - boundaries$p0.lower) - } - if (par == 4) { - xlb <- c(xlb, - ifelse(log, - ifelse(is.infinite(boundaries$mu.lower), -Inf, log(boundaries$mu.lower)), - boundaries$mu.lower)) - xub <- c(xub, - ifelse(log, - ifelse(is.infinite(boundaries$mu.upper), -Inf, log(boundaries$mu.upper)), - boundaries$mu.upper)) - } - - ##============================================================================## - ## AUXILLARY FUNCTIONS - ##============================================================================## - - # THIS FUNCTION CALCULATES THE NEGATIVE LOG LIKELIHOOD OF THE DATA - Neglik_f <- function(gamma, sigma, p0, mu, data) { - # this calculates the negative of the log likelihood of the - # data (data) for a given set of parameters (gamma, sigma, p0) - # data is a 2x2 matrix of data: De, rel_error (including sigma_b) - - # recover the data - zi <- data[ ,1] - si <- data[ ,2] - n <- length(zi) - - # in the MAM-3 gamma and mu are assumed to be equal - if (par == 3) - mu <- gamma - - # calculate sigma^2 + seld^2, mu0 and sigma0 - s2 <- sigma^2 + si^2 - sigma0 <- 1/sqrt(1/sigma^2 + 1/si^2) - mu0 <- (mu/sigma^2 + zi/si^2)/(1/sigma^2 + 1/si^2) - - # calculate the log-likelihood - logsqrt2pi <- 0.5*log(2*pi) - res0 <- (gamma - mu0)/sigma0 - res1 <- (gamma - mu)/sigma - lf1i <- log(p0) - log(si) - 0.5*((zi-gamma)/si)^2 - logsqrt2pi - lf2i <- log(1-p0) - 0.5*log(s2) - 0.5*(zi-mu)^2/s2 - logsqrt2pi - lf2i <- lf2i + log(1-pnorm(res0)) - log(1-pnorm(res1)) - llik <- log( exp(lf1i) + exp(lf2i) ) - negll <- -sum(llik) - - return(negll) - } - - # THIS MAXIMIZES THE Neglik_f LIKELIHOOD FUNCTION AND RETURNS AN MLE OBJECT - Get_mle <- function(data) { - # TODO: PROPER ERROR HANDLING - tryCatch({ - suppressWarnings( - mle <- bbmle::mle2(data = list(data = data), - optimizer = "nlminb", - lower=c(gamma = boundaries$gamma.lower, - sigma = boundaries$sigma.lower, - p0 = boundaries$p0.lower, - mu = boundaries$mu.lower), - upper=c(gamma = boundaries$gamma.upper, - sigma = boundaries$sigma.upper, - p0 = boundaries$p0.upper, - mu = boundaries$mu.upper), - minuslogl = Neglik_f, - control = list(iter.max = 1000L), - start = start) - ) - - }, error = function(e) { - .throw_error("Sorry, seems like I encountered an error: ", e) - }) - return(mle) - } - - ##============================================================================## - ## MAIN PROGRAM - ##============================================================================## - - # combine errors - if (log) { - if (invert) { - lcd <- log(data[ ,1])*-1 - x.offset <- abs(min(lcd)) - lcd <- lcd+x.offset - } else { - lcd <- log(data[ ,1]) - } - lse <- sqrt((data[ ,2]/data[ ,1])^2 + sigmab^2) - } else { - lcd <- data[ ,1] - lse <- sqrt(data[ ,2]^2 + sigmab^2) - } - - # create new data frame with DE and combined relative error - dat <- cbind(lcd, lse) - - # get the maximum likelihood estimate - ests <- Get_mle(dat) - - # check if any standard errors are NA or NaN - coef_err <- suppressWarnings( - t(as.data.frame(bbmle::summary(ests)@coef[ ,2])) - ) - - if (debug) - print(bbmle::summary(ests)) - - if (any(is.nan(coef_err))) - coef_err[which(is.nan(coef_err))] <- t(as.data.frame(ests@coef))[which(is.nan(coef_err))] / 100 - if (any(is.na(coef_err))) - coef_err[which(is.na(coef_err))] <- t(as.data.frame(ests@coef))[which(is.na(coef_err))] / 100 - - if (par == 3) - which <- c("gamma", "sigma", "p0") - if (par == 4) - which <- c("gamma", "sigma", "p0", "mu") - - # calculate profile log likelihoods - prof <- suppressWarnings( - bbmle::profile(ests, - which = which, - std.err = as.vector(coef_err), - #try_harder = TRUE, - quietly = TRUE, - tol.newmin = Inf, - skiperrs = TRUE, - prof.lower=c(gamma = -Inf, - sigma = 0, - p0 = 0, - mu = -Inf), - prof.upper=c(gamma = Inf, - sigma = Inf, - p0 = 1, - mu = Inf) - ) - ) - # Fallback when profile() returns a 'better' fit - maxsteps <- 100 - cnt <- 1 - while (!inherits(prof, "profile.mle2")) { - if (maxsteps == 0L) - .throw_error("Couldn't find a converging fit for the profile log-likelihood") - if (verbose) - message("## Trying to find a better fit (", cnt, "/10) ##") - prof <- suppressWarnings( - bbmle::profile(ests, - which = which, - std.err = as.vector(coef_err), - try_harder = TRUE, - quietly = TRUE, - maxsteps = maxsteps, - tol.newmin = Inf, - skiperrs = TRUE, - prof.lower=c(gamma = -Inf, - sigma = 0, - p0 = 0, - mu = -Inf), - prof.upper=c(gamma = Inf, - sigma = Inf, - p0 = 1, - mu = Inf) - ) - ) - maxsteps <- maxsteps - 10 - cnt <- cnt + 1 - } - - ## TODO: reduce the redundant code - ## DELETE rows where z = -Inf/Inf - prof@profile$gamma <- prof@profile$gamma[which(prof@profile$gamma["z"] != Inf), ] - prof@profile$gamma <- prof@profile$gamma[which(prof@profile$gamma["z"] != -Inf), ] - prof@profile$sigma <- prof@profile$sigma[which(prof@profile$sigma["z"] != Inf), ] - prof@profile$sigma <- prof@profile$sigma[which(prof@profile$sigma["z"] != -Inf), ] - prof@profile$p0 <- prof@profile$p0[which(prof@profile$p0["z"] != Inf), ] - prof@profile$p0 <- prof@profile$p0[which(prof@profile$p0["z"] != -Inf), ] - - if (par == 4) { - prof@profile$mu <- prof@profile$mu[which(prof@profile$mu["z"] != Inf), ] - prof@profile$mu <- prof@profile$mu[which(prof@profile$mu["z"] != -Inf), ] - } - - # calculate Bayesian Information Criterion (BIC) - BIC <- BIC(ests) - - # retrieve results from mle2-object - pal <- if (log) { - if (invert) { - exp((bbmle::coef(ests)[["gamma"]]-x.offset)*-1) - } else { - exp(bbmle::coef(ests)[["gamma"]]) - } - } else { - bbmle::coef(ests)[["gamma"]] - } - sig <- bbmle::coef(ests)[["sigma"]] - p0end <- bbmle::coef(ests)[["p0"]] - - if (par == 4) { - muend <- ifelse(log, exp(bbmle::coef(ests)[["mu"]]), bbmle::coef(ests)[["mu"]]) - } else { - muend <- NA - } - - ##============================================================================## - ## ERROR CALCULATION - - #### METHOD 1: follow the instructions of Galbraith & Roberts (2012) #### - # "If the likelihood profile is symmetrical about the parameter, an approximate standard error - # can be calculated by dividing the length of this interval by 3.92" - conf <- suppressWarnings( - as.data.frame(bbmle::confint(prof, tol.newmin = Inf, quietly = TRUE, level = level)) - ) - class(conf[,1]) <- class(conf[,2]) <- "numeric" - - if (invert) { - conf[1, ] <- (conf[1, ]-x.offset)*-1 - t <- conf[1,1] - conf[1,1] <- conf[1,2] - conf[1,2] <- t - } - gamma_err <- if (log) { - (exp(conf["gamma",2])-exp(conf["gamma",1]))/3.92 - } else { - (conf["gamma",2]-conf["gamma",1])/3.92 - } - - ##============================================================================## - ## AGGREGATE RESULTS - summary <- data.frame(de=pal, - de_err=gamma_err, - ci_level = level, - "ci_lower"=ifelse(log, exp(conf["gamma",1]), conf["gamma",1]), - "ci_upper"=ifelse(log, exp(conf["gamma",2]), conf["gamma",2]), - par=par, - sig=ifelse(log, exp(sig), sig), - p0=p0end, - mu=muend, - Lmax=-ests@min, - BIC=BIC) - call <- sys.call() - args <- list(log=log, sigmab=sigmab, par = par, bootstrap=bootstrap, - init.values=start, log.output = log.output, - bs.M=M, bs.N=N, bs.h=h, sigmab.sd=sigmab.sd) - - ##============================================================================## - ## BOOTSTRAP - ##============================================================================## - if (bootstrap) { - - ## BOOTSTRAP FUNCTIONS ---- - # Function that draws N+M sets of integer values from 1:n and returns - # both the indices and frequencies - draw_Freq <- function() { - f <- R <- matrix(0L, N+M, n) - for (i in seq_len(N+M)) { - R[i, ] <- sample(x = n, size = n, replace = TRUE) - f[i, ] <- tabulate(R, n) - } - return(list(R = R, freq = f)) - } - - # Function that adds the additional error sigmab to each individual DE error - combine_Errors <- function(d, e) { - if (log) { - d[ ,2] <- sqrt((d[ ,2]/d[ ,1])^2 + e^2) - d[ ,1] <- log(d[ ,1]) - } else { - d[ ,2] <- sqrt(d[ ,2]^2 + e^2) - } - return(d) - } - - # Function that produces N+M replicates from the original data set using - # randomly sampled indices with replacement and adding a randomly drawn - # sigmab error - create_Replicates <- function(f, s) { - d <- apply(f$R, 1, function(x) data[x, ]) - r <- mapply(function(x, y) combine_Errors(x, y), d, s, SIMPLIFY = FALSE) - return(r) - } - - # Function to extract the estimate of gamma from mle2 objects and converting - # it back to the 'normal' scale - save_Gamma <- function(d) { - if (log) { - if (invert) { - m <- exp((bbmle::coef(d)[["gamma"]]-x.offset)*-1) - } else { - m <- exp(bbmle::coef(d)[["gamma"]]) - } - } else { - m <- bbmle::coef(d)[["gamma"]] - } - return(m) - } - - # Function that takes each of the N replicates and produces a kernel density - # estimate of length n. The normalised values are then returned as a matrix - # with dimensions [N, n] - get_KDE <- function(d) { - f <- approx(density(x=d[ ,1], kernel="gaussian", bw = h), xout = d[ ,1]) - pStarTheta <- as.vector(f$y / sum(f$y)) - x <- matrix(t(pStarTheta/(1/n)), N, n, byrow = TRUE) - return(x) - } - - # Function that calculates the product term of the recycled bootstrap - get_ProductTerm <- function(Pmat, b2Pmatrix) { - prodterm <- apply(Pmat^b2Pmatrix$freq[1:N, ], 1, prod) - return(prodterm) - } - - # Function that calculates the pseudo likelihoods for M replicates and - # returns the dose-likelihood pairs - make_Pairs <- function(theta, b2mamvec, prodterm) { - pairs <- matrix(0, M, 2) - for (i in seq_len(M)) { - thetavec <- matrix(theta[i], N, 1) - kdthis <- (thetavec-b2mamvec)/h - kd1 <- dnorm(kdthis) - - kd2 <- kd1*prodterm[[i]] - kd <- sum(kd2, na.rm = TRUE) - likelihood <- (1/(N*h))*kd - pairs[i, ] <- c(theta[i], likelihood) - } - return(pairs) - } - - ## START BOOTSTRAP ---- - msg <- sprintf(paste("\n [calc_MinDose] \n\nRecycled Bootstrap", - "\n\nParameters:", - "\n M = %d", - "\n N = %d", - "\n sigmab = %.2f \U00B1 %.2f", - "\n h = %.2f", - "\n\n Creating %d bootstrap replicates..."), - M, N, sigmab, sigmab.sd, h, N+M) - if (verbose) - message(msg) - - n <- length(data[ ,1]) - # Draw N+M samples of a normale distributed sigmab - sigmab <- rnorm(N + M, sigmab, sigmab.sd) - # Draw N+M random indices and their frequencies - b2Pmatrix <- draw_Freq() - # Finally draw N+M bootstrap replicates - replicates <- create_Replicates(b2Pmatrix, sigmab) - - # MULTICORE: The call to 'Get_mle' is the bottleneck of the function. - # Using multiple CPU cores can reduce the computation cost, but may - # not work for all machines. - if (multicore) { - if (verbose) { - message("\n Spawning ", cores, " instances of R for ", - "parallel computation. This may take a few seconds...") - } - cl <- parallel::makeCluster(cores) - if (verbose) { - message(" Done!\n Applying the model to all replicates. ", - "This may take a while...") - } - mle <- parallel::parLapply(cl, replicates, Get_mle) - parallel::stopCluster(cl) - } else { - if (verbose) { - message("\n Applying the model to all replicates. This may take a while...") - } - mle <- lapply(replicates, Get_mle) - } - - # Final bootstrap calculations - if (verbose) - message("\n Calculating the likelihoods...") - # Save 2nd- and 1st-level bootstrap results (i.e. estimates of gamma) - b2mamvec <- as.matrix(sapply(mle[1:N], save_Gamma, simplify = TRUE)) - theta <- sapply(mle[c(N+1):c(N+M)], save_Gamma) - # Calculate the probability/pseudo-likelihood - Pmat <- lapply(replicates[c(N+1):c(N+M)], get_KDE) - prodterm <- lapply(Pmat, get_ProductTerm, b2Pmatrix) - # Save the bootstrap results as dose-likelihood pairs - pairs <- make_Pairs(theta, b2mamvec, prodterm) - - ## --------- FIT POLYNOMIALS -------------- ## - if (verbose) - message("\n Fit curves to dose-likelihood pairs...") - # polynomial fits of increasing degrees - - ## if the input values are too close to zero, we may get - ## Inf values >>> we remove them here with a warning - if(any(is.infinite(pairs))){ - inf_count <- length(which(is.infinite(pairs[,2])))/nrow(pairs) - pairs <- pairs[!is.infinite(pairs[,2]),] - .throw_warning("Inf values produced by bootstrapping removed ", - "for LOcal polynominal regrESSion fitting (loess)!", - "\n The removed values represent ", - round(inf_count * 100,2), " % of the total dataset. ", - "This message usually indicates that your values ", - "are close to 0.") - } - - poly.three <- lm(pairs[ ,2] ~ poly(pairs[ ,1], degree = 3, raw = TRUE)) - poly.four <- lm(pairs[ ,2] ~ poly(pairs[ ,1], degree = 4, raw = TRUE)) - poly.five <- lm(pairs[ ,2] ~ poly(pairs[ ,1], degree = 5, raw = TRUE)) - poly.six <- lm(pairs[ ,2] ~ poly(pairs[ ,1], degree = 6, raw = TRUE)) - - ## --------- FIT LOESS -------------- ## - # Polynomials are probably not reasonable and often suffer badly from - # overfitting, especially towards the margins of the fitted data. In this - # particular use case polynomials may suggest a multimodal likelihood - # distribution where actually none is given. The non-parametric - # LOESS (LOcal polynomial regrESSion) often yields better results than - # standard polynomials. - loess <- loess(pairs[ ,2] ~ pairs[ ,1]) - - }#EndOf::Bootstrap - - ##============================================================================## - ## CONSOLE PRINT - ##============================================================================## - if (verbose) { - if (!bootstrap) { - cat("\n----------- meta data -----------\n") - print(data.frame(n=length(data[ ,1]), - par=par, - sigmab=sigmab, - logged=log, - Lmax=-ests@min, - BIC=BIC, - row.names = "")) - - cat("\n--- final parameter estimates ---\n") - tmp <- round(data.frame( - gamma=ifelse(!invert, - ifelse(log, exp(bbmle::coef(ests)[["gamma"]]), bbmle::coef(ests)[["gamma"]]), - ifelse(log, exp((bbmle::coef(ests)[["gamma"]]-x.offset)*-1),(bbmle::coef(ests)[["gamma"]]-x.offset)*-1) - ), - sigma=ifelse(log, exp(bbmle::coef(ests)[["sigma"]]), bbmle::coef(ests)[["sigma"]]), - p0=bbmle::coef(ests)[["p0"]], - mu=ifelse(par==4, - muend, - 0), - row.names="", check.names = FALSE), 2) - - - if (log && log.output) { - tmp$`log(gamma)` = round(log(tmp$gamma),2) - tmp$`log(sigma)` = round(log(tmp$sigma),2) - if (par == 4) - tmp$`log(mu)` = round(log(tmp$mu),2) - } - - print(tmp) - - cat("\n------ confidence intervals -----\n") - conf_print <- round(conf, 2) - if (log) { - logged_rows <- row.names(conf_print) != "p0" - conf_print[logged_rows, ] <- exp(conf_print[logged_rows, ]) - conf_print <- round(conf_print, 2) - - if (log.output) { - conf_tmp <- round(conf, 2) - conf_tmp[which(rownames(conf_tmp) == "p0"), ] <- "-" - conf_print <- cbind(round(conf_print, 2), - setNames(conf_tmp, names(conf_tmp))) - conf_print <- rbind( - setNames(data.frame("", "", "(logged)", "(logged)", row.names = "", stringsAsFactors = FALSE), names(conf_print)), - conf_print) - } - } - print(conf_print) - - cat("\n------ De (asymmetric error) -----\n") - print(round(data.frame(De=pal, - "lower"=ifelse(log, exp(conf["gamma",1]), conf["gamma",1]), - "upper"=ifelse(log, exp(conf["gamma",2]), conf["gamma",2]), - row.names=""), 2)) - - cat("\n------ De (symmetric error) -----\n") - print(round(data.frame(De=pal, - error=gamma_err, - row.names=""), 2)) - - } else if (bootstrap && verbose) { - message("\n Finished!") - } - } - - ##============================================================================## - ## RETURN VALUES - ##============================================================================## - - if (invert) - prof@profile$gamma$par.vals[ ,"gamma"] <- rev((prof@profile$gamma$par.vals[ ,"gamma"] - x.offset)*-1) - - if (!bootstrap) - pairs <- poly.three <- poly.four <- poly.five <- poly.six <- loess <- NULL - - newRLumResults.calc_MinDose <- set_RLum( - class = "RLum.Results", - originator = "calc_MinDose", - data = list(summary = summary, - data = data, - args = args, - call = call, - mle = ests, - BIC = BIC, - confint = conf, - profile = prof, - bootstrap = list( - pairs = list(gamma=pairs), - poly.fits = list(poly.three = poly.three, - poly.four = poly.four, - poly.five = poly.five, - poly.six = poly.six), - loess.fit = loess))) - - ##=========## - ## PLOTTING - if (plot) - try(plot_RLum.Results(newRLumResults.calc_MinDose, ...)) - - # if (!debug) - # options(warn = 0) - - if (!is.na(summary$mu) && !is.na(summary$de)) { - if (log(summary$de) > summary$mu) - .throw_warning("Gamma is larger than mu, consider running the model ", - "with new boundary values (see details '?calc_MinDose')") - } - - invisible(newRLumResults.calc_MinDose) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_OSLLxTxDecomposed.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_OSLLxTxDecomposed.R deleted file mode 100644 index 725cfdfea..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_OSLLxTxDecomposed.R +++ /dev/null @@ -1,191 +0,0 @@ -#' @title Calculate Lx/Tx ratio for decomposed CW-OSL signal components -#' -#' @description Calculate `Lx/Tx` ratios from a given set of decomposed -#' CW-OSL curves decomposed by `[OSLdecomposition::RLum.OSL_decomposition]` -#' -#' @param OSL.component [integer] or [character] (*optional*): -#' a single index or a name describing which OSL signal component shall be evaluated. -#' This argument can either be the name of the OSL component assigned by -#' `[OSLdecomposition::RLum.OSL_global_fitting]` or the index of component. -#' Then `'1'` selects the fastest decaying component, `'2'` the -#' second fastest and so on. If not defined, the fastest decaying component is selected. -#' -#' @param Lx.data [data.frame] (**required**): Component table created by -#' `[OSLdecomposition::RLum.OSL_decomposition]` and per default located -#' at `object@records[[...]]@info$COMPONENTS`.The value of `$n[OSL.component]` -#' is set as `LnLx`. The value of `$n.error[OSL.component]` is set as `LnLx.error` -#' -#' @param Tx.data [data.frame] (*optional*): Component table created by -#' `[OSLdecomposition::RLum.OSL_decomposition]` and per default located at -#' `object@records[[...]]@info$COMPONENTS`. The value of `$n[OSL.component]` -#' is set as `TnTx`. The value of `$n.error[OSL.component]` is set as `TnTx.error` -#' -#' @param sig0 [numeric] (*with default*): allows adding an extra error component -#' to the final `Lx/Tx` error value (e.g., instrumental error). -#' -#' @param digits [integer] (*with default*): round numbers to the specified digits. -#' If digits is set to `NULL` nothing is rounded. -#' -#' @return Returns an S4 object of type [RLum.Results-class]. -#' -#' Slot `data` contains a [list] with the following structure: -#' -#' **@data** -#' ``` -#' $LxTx.table (data.frame) -#' .. $ LnLx -#' .. $ TnTx -#' .. $ Net_LnLx -#' .. $ Net_LnLx.Error -#' .. $ Net_TnTx -#' .. $ Net_TnTx.Error -#' .. $ LxTx -#' .. $ LxTx.relError -#' .. $ LxTx.Error -#' ``` -#' -#' @section Function version: 0.1.0 -#' -#' @author Dirk Mittelstrass -#' -#' @seealso [RLum.Data.Curve-class], [plot_GrowthCurve], [analyse_SAR.CWOSL] -#' -#' @references Mittelstrass D., Schmidt C., Beyer J., Straessner A., 2019. -#' Automated identification and separation of quartz CW-OSL signal components with R. -#' talk presented at DLED 2019, Bingen, Germany -#' [http://luminescence.de/OSLdecomp_talk.pdf]()\cr -#' -#' @keywords datagen -#' @md -#' @export -calc_OSLLxTxDecomposed <- function( - Lx.data, - Tx.data = NULL, - OSL.component = 1L, - sig0 = 0, - digits = NULL -){ - - # ToDo: - # - Integrity checks for the component table - # - Handle background-signal-component if present - # - add Tx.data integrity checks - # - add previous-residual-subtraction functionality - # - add list with decomposition algorithm parameters to return object - # - add example in documentation - - ##--------------------------------------------------------------------------## - ## (1) - integrity checks - if (!(is.data.frame(Lx.data) && (nrow(Lx.data) >= 1))) - .throw_error("No valid component data.frame for Lx value") - - if (!(is.null(Tx.data)) && !(is.data.frame(Tx.data) && (nrow(Tx.data) >= 1))) - .throw_error("No valid component data.frame for Tx value") - - # define the component - component_index <- NA - - #select only the first element; we do this silently because it is clearly - #written in the documentation - OSL.component <- OSL.component[1] - - if (!(is.numeric(OSL.component) || is.character(OSL.component)) || - is.na(OSL.component)) - .throw_error("Invalid data type for OSL component") - - # get component index from component name - if (is.character(OSL.component)) { - if (tolower(OSL.component) %in% tolower(Lx.data$name)) { - component_index <- which(tolower(OSL.component) == tolower(Lx.data$name)) - - } else { - .throw_error("Invalid OSL component name, valid names are: ", - paste(Lx.data$name, collapse = ", ")) - } - } - - # if a numeric is given, check if it matches with any component index - if (is.numeric(OSL.component)) { - OSL.component <- as.integer(OSL.component) - if (OSL.component %in% 1:nrow(Lx.data)) { - component_index <- OSL.component - - # insert background-signal-component check here - - } else { - .throw_error("Invalid OSL component index, ", - "component table has ", nrow(Lx.data), " rows") - } - } - - .validate_positive_scalar(digits, int = TRUE, null.ok = TRUE) - - ##--------------------------------------------------------------------------## - ## (2) - extract Lx and Tx values - - LnLx <- Lx.data$n[component_index] - LnLx.Error <- Lx.data$n.error[component_index] - - TnTx <- 1 - TnTx.Error <- 0 - if (!is.null(Tx.data)) { - TnTx <- Tx.data$n[component_index] - TnTx.Error <- Tx.data$n.error[component_index] - } - - ##combine results - LnLxTnTx <- cbind( - LnLx, - LnLx.Error, - TnTx, - TnTx.Error - ) - - # THE FOLLOWING CODE IS MOSTLY IDENTICAL WITH (4) IN calc_OSLLxTxRatio() - - ##--------------------------------------------------------------------------## - ##(4) Calculate LxTx error according Galbraith (2014) - - ## transform results to a data.frame - LnLxTnTx <- as.data.frame(LnLxTnTx) - - #add col names - colnames(LnLxTnTx)<-c("Net_LnLx", "Net_LnLx.Error", - "Net_TnTx", "Net_TnTx.Error") - - ##calculate Ln/Tx - LxTx <- LnLxTnTx$Net_LnLx/LnLxTnTx$Net_TnTx - - ##set NaN - if(is.nan(LxTx)) LxTx <- 0 - - ##calculate Ln/Tx error - LxTx.relError <- sqrt((LnLx.Error / LnLx)^2 + (TnTx.Error / TnTx)^2) - LxTx.Error <- abs(LxTx * LxTx.relError) - - ##set NaN - if(is.nan(LxTx.Error)) LxTx.Error <- 0 - - ##add an extra component of error - LxTx.Error <- sqrt(LxTx.Error^2 + (sig0 * LxTx)^2) - - ##return combined values - temp <- cbind(LnLxTnTx, LxTx, LxTx.Error) - - ##apply digits if wanted - if(!is.null(digits)){ - temp[1,] <- round(temp[1,], digits = digits) - } - - # ToDo: Add decomposition algorithm parameters here - # calc.parameters <- list(...) - - ##set results object - return(set_RLum( - class = "RLum.Results", - data = list( - LxTx.table = temp), - # calc.parameters = calc.parameters), - info = list(call = sys.call()) - )) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_OSLLxTxRatio.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_OSLLxTxRatio.R deleted file mode 100644 index 73364bbb1..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_OSLLxTxRatio.R +++ /dev/null @@ -1,563 +0,0 @@ -#' @title Calculate `Lx/Tx` ratio for CW-OSL curves -#' -#' @description -#' Calculate `Lx/Tx` ratios from a given set of CW-OSL curves assuming late light -#' background subtraction. -#' -#' @details -#' The integrity of the chosen values for the signal and background integral is -#' checked by the function; the signal integral limits have to be lower than -#' the background integral limits. If a [vector] is given as input instead -#' of a [data.frame], an artificial [data.frame] is produced. The -#' error calculation is done according to Galbraith (2002). -#' -#' **Please note:** In cases where the calculation results in `NaN` values (for -#' example due to zero-signal, and therefore a division of 0 by 0), these `NaN` -#' values are replaced by 0. -#' -#' **`sigmab`** -#' -#' The default value of `sigmab` is calculated assuming the background is -#' constant and **would not** applicable when the background varies as, -#' e.g., as observed for the early light subtraction method. -#' -#' **sig0** -#' -#' This argument allows to add an extra component of error to the final `Lx/Tx` -#' error value. The input will be treated as factor that is multiplied with -#' the already calculated `LxTx` and the result is add up by: -#' -#' \deqn{se(LxTx) = \sqrt(se(LxTx)^2 + (LxTx * sig0)^2)} -#' -#' -#' **background.count.distribution** -#' -#' This argument allows selecting the distribution assumption that is used for -#' the error calculation. According to Galbraith (2002, 2014) the background -#' counts may be overdispersed (i.e. do not follow a Poisson distribution, -#' which is assumed for the photomultiplier counts). In that case (might be the -#' normal case) it has to be accounted for the overdispersion by estimating -#' \eqn{\sigma^2} (i.e. the overdispersion value). Therefore the relative -#' standard error is calculated as: -#' -#' - `poisson` -#' \deqn{rse(\mu_{S}) \approx \sqrt(Y_{0} + Y_{1}/k^2)/Y_{0} - Y_{1}/k} -#' -#' - `non-poisson` -#' \deqn{rse(\mu_{S}) \approx \sqrt(Y_{0} + Y_{1}/k^2 + \sigma^2(1+1/k))/Y_{0} - Y_{1}/k} -#' -#' **Please note** that when using the early background subtraction method in -#' combination with the 'non-poisson' distribution argument, the corresponding `Lx/Tx` error -#' may considerably increase due to a high `sigmab` value. -#' Please check whether this is valid for your data set and if necessary -#' consider to provide an own `sigmab` value using the corresponding argument `sigmab`. -#' -#' @param Lx.data [RLum.Data.Curve-class] or [data.frame] (**required**): -#' requires a CW-OSL shine down curve (x = time, y = counts) -#' -#' @param Tx.data [RLum.Data.Curve-class] or [data.frame] (*optional*): -#' requires a CW-OSL shine down curve (x = time, y = counts). If no -#' input is given the `Tx.data` will be treated as `NA` and no `Lx/Tx` ratio -#' is calculated. -#' -#' @param signal.integral [numeric] (**required**): vector with the limits for the signal integral. -#' Can be set to `NA` than now integrals are considered and all other integrals are set to `NA` as well. -#' -#' @param signal.integral.Tx [numeric] (*optional*): -#' vector with the limits for the signal integral for the `Tx`-curve. If nothing is provided the -#' value from `signal.integral` is used. -#' -#' @param background.integral [numeric] (**required**): -#' vector with the bounds for the background integral. -#' Can be set to `NA` than now integrals are considered and all other integrals are set to `NA` as well. -#' -#' @param background.integral.Tx [numeric] (*optional*): -#' vector with the limits for the background integral for the `Tx` curve. -#' If nothing is provided the value from `background.integral` is used. -#' -#' @param background.count.distribution [character] (*with default*): -#' sets the count distribution assumed for the error calculation. -#' Possible arguments `poisson` or `non-poisson`. See details for further information -#' -#' @param use_previousBG [logical] (*with default*): -#' If set to `TRUE` the background of the `Lx`-signal is subtracted also -#' from the `Tx`-signal. Please note that in this case separate -#' signal integral limits for the `Tx`-signal are not allowed and will be reset. -#' -#' @param sigmab [numeric] (*optional*): -#' option to set a manual value for the overdispersion (for `LnTx` and `TnTx`), -#' used for the `Lx/Tx` error calculation. The value should be provided as -#' absolute squared count values, e.g. `sigmab = c(300,300)`. -#' **Note:** If only one value is provided this value is taken for both (`LnTx` and `TnTx`) signals. -#' -#' @param sig0 [numeric] (*with default*): -#' allow adding an extra component of error to the final `Lx/Tx` error value -#' (e.g., instrumental error, see details). -#' -#' @param digits [integer] (*with default*): -#' round numbers to the specified digits. -#' If digits is set to `NULL` nothing is rounded. -#' -#' @return -#' Returns an S4 object of type [RLum.Results-class]. -#' -#' Slot `data` contains a [list] with the following structure: -#' -#' **@data** -#' ``` -#' $LxTx.table (data.frame) -#' .. $ LnLx -#' .. $ LnLx.BG -#' .. $ TnTx -#' .. $ TnTx.BG -#' .. $ Net_LnLx -#' .. $ Net_LnLx.Error -#' .. $ Net_TnTx -#' .. $ Net_TnTx.Error -#' .. $ LxTx -#' .. $ LxTx.Error -#' $ calc.parameters (list) -#' .. $ sigmab.LnTx -#' .. $ sigmab.TnTx -#' .. $ k -#' ``` -#' -#' **@info** -#' ``` -#' $ call (original function call) -#' ``` -#' -#' @note -#' The results of this function have been cross-checked with the Analyst -#' (version 3.24b). Access to the results object via [get_RLum]. -#' -#' **Caution:** If you are using early light subtraction (EBG), please either provide your -#' own `sigmab` value or use `background.count.distribution = "poisson"`. -#' -#' @section Function version: 0.8.0 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum.Data.Curve-class], [Analyse_SAR.OSLdata], [plot_GrowthCurve], -#' [analyse_SAR.CWOSL] -#' -#' @references Duller, G., 2018. Analyst v4.57 - User Manual. -#' `https://users.aber.ac.uk/ggd`\cr -#' -#' Galbraith, R.F., 2002. A note on the variance of a background-corrected OSL -#' count. Ancient TL, 20 (2), 49-51. -#' -#' Galbraith, R.F., 2014. A further note on the variance of a -#' background-corrected OSL count. Ancient TL, 31 (2), 1-3. -#' -#' @keywords datagen -#' -#' @examples -#' -#' ##load data -#' data(ExampleData.LxTxOSLData, envir = environment()) -#' -#' ##calculate Lx/Tx ratio -#' results <- calc_OSLLxTxRatio( -#' Lx.data = Lx.data, -#' Tx.data = Tx.data, -#' signal.integral = c(1:2), -#' background.integral = c(85:100)) -#' -#' ##get results object -#' get_RLum(results) -#' -#' @md -#' @export -calc_OSLLxTxRatio <- function( - Lx.data, - Tx.data = NULL, - signal.integral, - signal.integral.Tx = NULL, - background.integral, - background.integral.Tx = NULL, - background.count.distribution = "non-poisson", - use_previousBG = FALSE, - sigmab = NULL, - sig0 = 0, - digits = NULL -){ - - -# Test input data --------------------------------------------------------- - ##(1) - integrity checks - if(!is.null(Tx.data)){ - ##(a) - check data type - if(is(Lx.data)[1]!=is(Tx.data)[1]){ - stop("[calc_OSLLxTxRatio()] Data type of Lx and Tx data differs!", - call. = FALSE) - } - - ##(b) - test if data.type is valid in general - if(inherits(Lx.data, "RLum.Data.Curve")){ - Lx.data <- as(Lx.data, "data.frame") - Tx.data <- as(Tx.data, "data.frame") - - }else{ - ##go further - if((is(Lx.data)[1] != "data.frame" & - is(Lx.data)[1] != "numeric") & - is(Lx.data)[1] != "matrix"){ - stop("[calc_OSLLxTxRatio()] Data type error! Required types are data.frame or numeric vector.", call. = FALSE) - } - } - - ##(c) - convert vector to data.frame if necessary - if(is(Lx.data)[1] != "data.frame" & - is(Lx.data)[1] != "matrix"){ - Lx.data <- data.frame(x = 1:length(Lx.data), y = Lx.data) - Tx.data <- data.frame(x = 1:length(Tx.data), y = Tx.data) - } - - ##(d) - check if Lx and Tx curves have the same channel length - if(length(Lx.data[,2]) != length(Tx.data[,2])) - stop("[calc_OSLLxTxRatio()] Channel numbers of Lx and Tx data differ!", - call. = FALSE) - - }else{ - Tx.data <- data.frame(x = NA,y = NA) - - ##support RLum.objects - if(inherits(Lx.data, "RLum.Data.Curve")){ - Lx.data <- as(Lx.data, "data.frame") - - } - - ##check for matrix - if(is(Lx.data)[1] == "matrix"){ - Lx.data <- as.data.frame(Lx.data) - - } - - ##no it should be a data.frame, if not, try to produce one - if(is(Lx.data)[1]!="data.frame") { - Lx.data <- data.frame(x = 1:length(Lx.data),y = Lx.data) - } - - }#endif::missing Tx.data - - # Alternate mode ---------------------------------------------------------- - if(any(is.na(c(signal.integral, background.integral)))){ - signal.integral <- background.integral <- NA - LnLx <- sum(Lx.data[,2]) - TnTx <- sum(Tx.data[,2]) - - LnLxTnTx <- data.frame( - LnLx = LnLx, - LnLx.BG = 0, - TnTx = TnTx, - TnTx.BG = 0, - Net_LnLx = LnLx, - Net_LnLx.Error = 0, - Net_TnTx = TnTx, - Net_TnTx.Error = 0, - LxTx = LnLx/TnTx, - LxTx.Error = 0) - - return(set_RLum( - class = "RLum.Results", - data = list( - LxTx.table = LnLxTnTx, - calc.parameters = NULL, - info = list(call = sys.call()) - ))) - - } - - # Continue checks --------------------------------------------------------- - ##(e) - check if signal integral is valid - if(min(signal.integral) < 1 | max(signal.integral>length(Lx.data[,2]))){ - stop("[calc_OSLLxTxRatio()] signal.integral is not valid!", call. = FALSE)} - - ##(f) - check if background integral is valid - if(min(background.integral)<1 | max(background.integral>length(Lx.data[,2]))){ - stop(paste("[calc_OSLLxTxRatio()] background.integral is not valid! Max: ",length(Lx.data[,2]),sep=""), call. = FALSE)} - - ##(g) - check if signal and background integral overlapping - if(min(background.integral)<=max(signal.integral)){ - stop("[calc_OSLLxTxRatio()] Overlapping of 'signal.integral' and 'background.integral' is not permitted!", call. = FALSE)} - - ##(h) - similar procedure for the Tx limits - if(all(c(!is.null(signal.integral.Tx),!is.null(background.integral.Tx)))){ - - if(use_previousBG){ - warning("[calc_OSLLxTxRatio()] For option use_previousBG = TRUE independent Lx and Tx integral limits are not allowed. Integral limits of Lx used for Tx.", call. = FALSE) - signal.integral.Tx <- signal.integral - background.integral.Tx <- background.integral - - } - - if(min(signal.integral.Tx) < 1 | max(signal.integral.Tx>length(Tx.data[,2]))){ - stop("[calc_OSLLxTxRatio()] signal.integral.Tx is not valid!", call. = FALSE)} - - if(min(background.integral.Tx)<1 | max(background.integral.Tx>length(Tx.data[,2]))){ - stop(paste("[calc_OSLLxTxRatio()] background.integral.Tx is not valid! Max: ",length(Tx.data[,2]),sep=""), - call. = FALSE)} - - if(min(background.integral.Tx)<=max(signal.integral.Tx)){ - stop("[calc_OSLLxTxRatio()] Overlapping of 'signal.integral.Tx' and 'background.integral.Tx' is not permitted!", - call. = FALSE)} - - }else if(!all(c(is.null(signal.integral.Tx),is.null(background.integral.Tx)))){ - stop("[calc_OSLLxTxRatio()] You have to provide both: signal.integral.Tx and background.integral.Tx!", - call. = FALSE) - - }else{ - signal.integral.Tx <- signal.integral - background.integral.Tx <- background.integral - - } - - ##check sigmab - if (!is.null(sigmab)) { - if (!is(sigmab, "numeric")) { - stop("[calc_OSLLxTxRatio()] 'sigmab' has to be of type numeric.", call. = FALSE) - } - - if (length(sigmab) > 2) { - stop("[calc_OSLLxTxRatio()] Maximum allowed vector length for 'sigmab' is 2.", call. = FALSE) - } - } - - ##--------------------------------------------------------------------------## - ##(2) - read data and produce background subtracted values - - ## calculate k value - express the background as mutiple value from the number - ## of signal integral channels, however, it can be < 1 also - n <- length(signal.integral) - m <- length(background.integral) - k <- m/n - n.Tx <- length(signal.integral.Tx) - - ##use previous BG and account for the option to set different integral limits - if(use_previousBG){ - m.Tx <- m - - }else{ - m.Tx <- length(background.integral.Tx) - - } - - k.Tx <- m.Tx/n.Tx - - ##LnLx (comments are corresponding variables to Galbraith, 2002) - Lx.curve <- Lx.data[,2] - Lx.signal <- sum(Lx.curve[signal.integral]) #Y.0 - Lx.background <- sum(Lx.curve[background.integral]) #Y.1 - Lx.background <- Lx.background*1/k #mu.B - LnLx <- Lx.signal - Lx.background - - ##TnTx - Tx.curve <- ifelse(is.na(Tx.data[,1])==FALSE, Tx.data[,2], NA) - Tx.signal <- sum(Tx.curve[signal.integral.Tx]) - - ##use previous BG - if(use_previousBG){ - Tx.background <- Lx.background - - }else{ - Tx.background <- sum(Tx.curve[background.integral.Tx])*1/k.Tx - - } - - TnTx <- (Tx.signal-Tx.background) - - ##--------------------------------------------------------------------------## - ##(3) - ## calculate Lx/Tx Errors according Galbraith (2002) and the personal - ## communication of Galbraith (2014) via e-mail - ## Nomenclature as stated in the articles - - ##(a) - ## set Y.0 (sum OSL signal including the background) and - ## Y.1 (total counts over m later channels) - Y.0 <- Lx.signal - Y.0_TnTx <- Tx.signal - Y.1 <- sum(Lx.curve[background.integral]) - Y.1_TnTx <- sum(Tx.curve[background.integral.Tx]) - - ##(b) estimate overdispersion (here called sigmab), see equation (4) in - ## Galbraith (2002), Galbraith (2014) - ## If else condition for the case that k < 2 - - if(round(k,digits = 1) >= 2 & ((min(background.integral) + length(signal.integral)*(2+1)) <= length(Lx.curve))){ - - ##(b)(1)(1) - ## note that m = n*k = multiple of background.integral from signal.integral - Y.i <- vapply(0:round(k,digits=0), function(i){ - sum(Lx.curve[ - (min(background.integral)+length(signal.integral)*i): - (min(background.integral)+length(signal.integral)+length(signal.integral)*i)]) - }, FUN.VALUE = vector(mode = "numeric", length = 1L)) - - Y.i <- na.exclude(Y.i) - sigmab.LnLx <- abs(var(Y.i) - mean(Y.i)) ##sigmab is denoted as sigma^2 = s.Y^2-Y.mean - ##therefore here absolute values are given - - }else{ - ## provide warning if m is < 25, as suggested by Rex Galbraith - ## low number of degree of freedom - if (m < 25) { - warning( - "[calc_OSLLxTxRatio()] Number of background channels for Lx < 25; error estimation might not be reliable!", - call. = FALSE) - - } - - sigmab.LnLx <- abs((var(Lx.curve[background.integral]) - - mean(Lx.curve[background.integral])) * n) - - } - - if (round(k.Tx, digits = 1) >= 2 & - (( - min(background.integral.Tx) + length(signal.integral.Tx) * (2 + 1) - ) <= length(Tx.curve))) { - ##(b)(1)(1) - ## note that m.Tx = n.Tx*k.Tx = multiple of background.integral.Tx from signal.integral.Tx - ## also for the TnTx signal - Y.i_TnTx <- vapply(0:round(k.Tx, digits = 0), function(i) { - sum(Tx.curve[(min(background.integral.Tx) + length(signal.integral.Tx) * - i):( - min(background.integral.Tx) + length(signal.integral.Tx) + length(signal.integral.Tx) * - i - )]) - }, FUN.VALUE = vector(mode = "numeric", length = 1L)) - - Y.i_TnTx <- na.exclude(Y.i_TnTx) - sigmab.TnTx <- abs(var(Y.i_TnTx) - mean(Y.i_TnTx)) - - } else{ - ## provide warning if m is < 25, as suggested by Rex Galbraith - ## low number of degree of freedom - if (m.Tx < 25 && use_previousBG == FALSE) { - warning("[calc_OSLLxTxRatio()] Number of background channels for Tx < 25; error estimation might not be reliable!", - call. = FALSE) - - } - - sigmab.TnTx <- abs((var(Tx.curve[background.integral.Tx]) - - mean(Tx.curve[background.integral.Tx])) * n.Tx) - } - - - ##account for a manually set sigmab value - if (!is.null(sigmab)) { - if (length(sigmab) == 2) { - sigmab.LnLx <- sigmab[1] - sigmab.TnTx <- sigmab[2] - - }else{ - sigmab.LnLx <- sigmab[1] - sigmab.TnTx <- sigmab[1] - - } - } - - ##(c) - ## Calculate relative error of the background subtracted signal - ## according to Galbraith (2002), equation (6) with changes - ## from Galbraith (2014), equation 6 - ## Discussion with Rex Galbraith via e-mail (2014-02-27): - ## Equation 6 is appropriate to be implemented as standard - - if(background.count.distribution == "poisson"){ - - ##(c.1) estimate relative standard error for assuming a poisson distribution - LnLx.relError <- sqrt((Y.0 + Y.1/k^2))/(Y.0-Y.1/k) ## rse(mu.s) - TnTx.relError <- sqrt((Y.0_TnTx + Y.1_TnTx/k^2))/(Y.0_TnTx-Y.1_TnTx/k) - - }else{ - - ##(c.2) estimate relative standard error for a non-poisson distribution - if(background.count.distribution != "non-poisson"){ - warning("Unknown method for background.count.distribution. A non-poisson distribution is assumed!", call. = FALSE)} - - LnLx.relError <- sqrt(Y.0 + Y.1/k^2 + sigmab.LnLx*(1+1/k))/ - (Y.0 - Y.1/k) - TnTx.relError <- sqrt(Y.0_TnTx + Y.1_TnTx/k^2 + sigmab.TnTx*(1+1/k))/ - (Y.0_TnTx - Y.1_TnTx/k) - - } - - ##(d) - ##calculate absolute standard error - LnLx.Error <- abs(LnLx*LnLx.relError) - TnTx.Error <- abs(TnTx*TnTx.relError) - - ##we do not want to have NaN values, as they are mathematically correct, but make - ##no sense and would result in aliquots that become rejected later - if(is.nan(LnLx.Error)) LnLx.Error <- 0 - if(is.nan(TnTx.Error)) TnTx.Error <- 0 - - ##combine results - LnLxTnTx <- cbind( - Lx.signal, - Lx.background, - Tx.signal, - Tx.background, - LnLx, - LnLx.Error, - TnTx, - TnTx.Error - ) - - ##--------------------------------------------------------------------------## - ##(4) Calculate LxTx error according Galbraith (2014) - - #transform results in a data.frame - LnLxTnTx <- as.data.frame((LnLxTnTx)) - - #add col names - colnames(LnLxTnTx)<-c("LnLx", "LnLx.BG", - "TnTx", "TnTx.BG", - "Net_LnLx", "Net_LnLx.Error", - "Net_TnTx", "Net_TnTx.Error") - - ##calculate Ln/Tx - LxTx <- LnLxTnTx$Net_LnLx/LnLxTnTx$Net_TnTx - - ##set NaN - if(is.nan(LxTx)) LxTx <- 0 - - ##calculate Ln/Tx error - LxTx.relError <- sqrt(LnLx.relError^2 + TnTx.relError^2) - LxTx.Error <- abs(LxTx * LxTx.relError) - - ##set NaN - if(is.nan(LxTx.Error)) LxTx.Error <- 0 - - ##add an extra component of error - LxTx.Error <- sqrt(LxTx.Error^2 + (sig0 * LxTx)^2) - - ##return combined values - temp <- cbind(LnLxTnTx,LxTx,LxTx.Error) - - - ##apply digits if wanted - if(!is.null(digits)){ - temp[1,] <- round(temp[1,], digits = digits) - - } - - calc.parameters <- list( - sigmab.LnLx = sigmab.LnLx, - sigmab.TnTx = sigmab.TnTx, - k = k) - - ##set results object - return(set_RLum( - class = "RLum.Results", - data = list( - LxTx.table = temp, - calc.parameters = calc.parameters), - info = list(call = sys.call()) - )) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_SourceDoseRate.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_SourceDoseRate.R deleted file mode 100644 index 3e3c24fc7..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_SourceDoseRate.R +++ /dev/null @@ -1,224 +0,0 @@ -#' Calculation of the source dose rate via the date of measurement -#' -#' Calculating the dose rate of the irradiation source via the date of -#' measurement based on: source calibration date, source dose rate, dose rate -#' error. The function returns a data.frame that provides the input argument -#' dose_rate for the function [Second2Gray]. -#' -#' Calculation of the source dose rate based on the time elapsed since the last -#' calibration of the irradiation source. Decay parameters assume a Sr-90 beta -#' source. \deqn{dose.rate = D0 * exp(-log(2) / T.1/2 * t)} \cr with: D0 <- -#' calibration dose rate T.1/2 <- half-life of the source nuclide (here in -#' days) t <- time since source calibration (in days) log(2) / T.1/2 equals the -#' decay constant lambda -#' -#' Information on the date of measurements may be taken from the data's -#' original .BIN file (using e.g., `BINfile <- readBIN2R()` and the slot -#' `BINfile@@METADATA$DATE`) -#' -#' **Allowed source types and related values** -#' -#' \tabular{rllll}{ -#' **#** \tab **Source type** \tab **T.1/2** \tab **Reference** \cr -#' `[1]` \tab Sr-90 \tab 28.90 y \tab NNDC, Brookhaven National Laboratory \cr -#' `[2]`\tab Am-214 \tab 432.6 y \tab NNDC, Brookhaven National Laboratory \cr -#' `[3]` \tab Co-60 \tab 5.274 y \tab NNDC, Brookhaven National Laboratory \cr -#' `[4` \tab Cs-137 \tab 30.08 y \tab NNDC, Brookhaven National Laboratory} -#' -#' @param measurement.date [character] or [Date] (with default): Date of measurement in `"YYYY-MM-DD"`. -#' If no value is provided, the date will be set to today. The argument can be provided as vector. -#' -#' @param calib.date [character] or [Date] (**required**): -#' date of source calibration in `"YYYY-MM-DD"` -#' -#' @param calib.dose.rate [numeric] (**required**): -#' dose rate at date of calibration in Gy/s or Gy/min -#' -#' @param calib.error [numeric] (**required**): -#' error of dose rate at date of calibration Gy/s or Gy/min -#' -#' @param source.type [character] (*with default*): -#' specify irradiation source (`Sr-90`, `Co-60`, `Cs-137`, `Am-214`), -#' see details for further information -#' -#' @param dose.rate.unit [character] (*with default*): -#' specify dose rate unit for input (`Gy/min` or `Gy/s`), the output is given in -#' Gy/s as valid for the function [Second2Gray] -#' -#' @param predict [integer] (*with default*): -#' option allowing to predict the dose rate of the source over time in days -#' set by the provided value. Starting date is the value set with -#' `measurement.date`, e.g., `calc_SourceDoseRate(..., predict = 100)` calculates -#' the source dose rate for the next 100 days. -#' -#' @return -#' Returns an S4 object of type [RLum.Results-class]. -#' Slot `data` contains a [list] with the following structure: -#' -#' ``` -#' $ dose.rate (data.frame) -#' .. $ dose.rate -#' .. $ dose.rate.error -#' .. $ date (corresponding measurement date) -#' $ parameters (list) -#' .. $ source.type -#' .. $ halflife -#' .. $ dose.rate.unit -#' $ call (the original function call) -#' ``` -#' -#' The output should be accessed using the function [get_RLum].\cr -#' A plot method of the output is provided via [plot_RLum] -#' -#' @note -#' Please be careful when using the option `predict`, especially when a multiple set -#' for `measurement.date` and `calib.date` is provided. For the source dose rate prediction -#' the function takes the last value `measurement.date` and predicts from that the the source -#' source dose rate for the number of days requested, -#' means: the (multiple) original input will be replaced. However, the function -#' do not change entries for the calibration dates, but mix them up. Therefore, -#' it is not recommended to use this option when multiple calibration dates (`calib.date`) -#' are provided. -#' -#' @section Function version: 0.3.2 -#' -#' @author -#' Margret C. Fuchs, HZDR, Helmholtz-Institute Freiberg for Resource Technology (Germany) \cr -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' -#' @seealso [Second2Gray], [get_RLum], [plot_RLum] -#' -#' @references -#' NNDC, Brookhaven National Laboratory `http://www.nndc.bnl.gov/` -#' -#' @keywords manip -#' -#' @examples -#' -#' -#' ##(1) Simple function usage -#' ##Basic calculation of the dose rate for a specific date -#' dose.rate <- calc_SourceDoseRate(measurement.date = "2012-01-27", -#' calib.date = "2014-12-19", -#' calib.dose.rate = 0.0438, -#' calib.error = 0.0019) -#' -#' ##show results -#' get_RLum(dose.rate) -#' -#' ##(2) Usage in combination with another function (e.g., Second2Gray() ) -#' ## load example data -#' data(ExampleData.DeValues, envir = environment()) -#' -#' ## use the calculated variable dose.rate as input argument -#' ## to convert De(s) to De(Gy) -#' Second2Gray(ExampleData.DeValues$BT998, dose.rate) -#' -#' ##(3) source rate prediction and plotting -#' dose.rate <- calc_SourceDoseRate(measurement.date = "2012-01-27", -#' calib.date = "2014-12-19", -#' calib.dose.rate = 0.0438, -#' calib.error = 0.0019, -#' predict = 1000) -#' plot_RLum(dose.rate) -#' -#' -#'##(4) export output to a LaTeX table (example using the package 'xtable') -#'\dontrun{ -#' xtable::xtable(get_RLum(dose.rate)) -#' -#'} -#' -#' @md -#' @export -calc_SourceDoseRate <- function( - measurement.date = Sys.Date(), - calib.date, - calib.dose.rate, - calib.error, - source.type = "Sr-90", - dose.rate.unit = "Gy/s", - predict = NULL -){ - - - if (is(measurement.date, "character")) { - measurement.date <- as.Date(measurement.date) - } - - ##calibration date - if(is(calib.date, "character")) { - calib.date <- as.Date(calib.date) - } - - # --- if predict is set - if(!is.null(predict) && predict > 1){ - measurement.date <- seq(tail(measurement.date), by = 1, length = predict) - - } - - # -- calc days since source calibration - decay.days <- measurement.date - calib.date - - - # -- calc dose rate of source at date of measurement, considering the chosen source-type - - ##set halflife - halflife.years <- switch( - source.type, - "Sr-90" = 28.90, - "Am-241" = 432.6, - "Co-60" = 5.274, - "Cs-137" = 30.08 - ) - - if(is.null(halflife.years)) - stop("[calc_SourceDoseRate()] Source type unknown or currently not supported!", call. = FALSE) - - - halflife.days <- halflife.years * 365 - - # N(t) = N(0)*e^((lambda * t) with lambda = log(2)/T1.2) - measurement.dose.rate <- (calib.dose.rate) * - exp((-log(2) / halflife.days) * as.numeric(decay.days)) - measurement.dose.rate.error <- (calib.error) * - exp((-log(2) / halflife.days) * as.numeric(decay.days)) - - - - # -- convert to input unit to [Gy/s] - if(dose.rate.unit == "Gy/min"){ - source.dose.rate <- measurement.dose.rate / 60 - source.dose.rate.error <- source.dose.rate * - (measurement.dose.rate.error / measurement.dose.rate) - - }else if(dose.rate.unit == "Gy/s"){ - source.dose.rate <- measurement.dose.rate - source.dose.rate.error <- measurement.dose.rate.error - - } - - - # Output -------------------------------------------------------------------------------------- - - dose_rate <- data.frame( - dose.rate = source.dose.rate, - dose.rate.error = source.dose.rate.error, - date = measurement.date, - stringsAsFactors = TRUE - ) - - temp.return <- set_RLum( - class = "RLum.Results", - data = list( - dose.rate = dose_rate, - parameters = list(source.type = source.type, - halflife = halflife.years, - dose.rate.unit = dose.rate.unit), - call = sys.call() - )) - - return(temp.return) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_Statistics.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_Statistics.R deleted file mode 100644 index 2d252345d..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_Statistics.R +++ /dev/null @@ -1,260 +0,0 @@ -#' Function to calculate statistic measures -#' -#' This function calculates a number of descriptive statistics for estimates -#' with a given standard error (SE), most fundamentally using error-weighted approaches. -#' -#' The option to use Monte Carlo Methods (`n.MCM`) allows calculating -#' all descriptive statistics based on random values. The distribution of these -#' random values is based on the Normal distribution with `De` values as -#' means and `De_error` values as one standard deviation. Increasing the -#' number of MCM-samples linearly increases computation time. On a Lenovo X230 -#' machine evaluation of 25 Aliquots with n.MCM = 1000 takes 0.01 s, with -#' n = 100000, ca. 1.65 s. It might be useful to work with logarithms of these -#' values. See Dietze et al. (2016, Quaternary Geochronology) and the function -#' [plot_AbanicoPlot] for details. -#' -#' @param data [data.frame] or [RLum.Results-class] object (**required**): -#' for [data.frame] two columns: De (`data[,1]`) and De error (`data[,2]`). -#' To plot several data sets in one plot the data sets must be provided -#' as `list`, e.g. `list(data.1, data.2)`. -#' -#' @param weight.calc [character]: -#' type of weight calculation. One out of `"reciprocal"` (weight is 1/error), -#' `"square"` (weight is 1/error^2). Default is `"square"`. -#' -#' @param digits [integer] (*with default*): -#' round numbers to the specified digits. -#' If digits is set to `NULL` nothing is rounded. -#' -#' @param n.MCM [numeric] (*with default*): -#' number of samples drawn for Monte Carlo-based statistics. -#' `NULL` (the default) disables MC runs. -#' -#' @param na.rm [logical] (*with default*): -#' indicating whether `NA` values should be stripped before the computation proceeds. -#' -#' @return Returns a list with weighted and unweighted statistic measures. -#' -#' @section Function version: 0.1.7 -#' -#' @keywords datagen -#' -#' @author Michael Dietze, GFZ Potsdam (Germany) -#' -#' @examples -#' -#' ## load example data -#' data(ExampleData.DeValues, envir = environment()) -#' -#' ## show a rough plot of the data to illustrate the non-normal distribution -#' plot_KDE(ExampleData.DeValues$BT998) -#' -#' ## calculate statistics and show output -#' str(calc_Statistics(ExampleData.DeValues$BT998)) -#' -#' \dontrun{ -#' ## now the same for 10000 normal distributed random numbers with equal errors -#' x <- as.data.frame(cbind(rnorm(n = 10^5, mean = 0, sd = 1), -#' rep(0.001, 10^5))) -#' -#' ## note the congruent results for weighted and unweighted measures -#' str(calc_Statistics(x)) -#' } -#' -#' @md -#' @export -calc_Statistics <- function( - data, - weight.calc = "square", - digits = NULL, - n.MCM = NULL, - na.rm = TRUE -) { - - ## Check input data - if(is(data, "RLum.Results") == FALSE & - is(data, "data.frame") == FALSE) { - stop("[calc_Statistics()] Input data is neither of type 'data.frame' nor 'RLum.Results'", call. = FALSE) - - } else { - if(is(data, "RLum.Results")) { - data <- get_RLum(data, "data")[,1:2] - } - } - - ##strip na values - if(na.rm){ - data <- na.exclude(data) - } - - ## handle error-free data sets - if(ncol(data) == 1) { - data <- cbind(data, rep(NA, length(data))) - } - - ## replace Na values in error by 0 - data[is.na(data[,2]),2] <- 0 - - if(sum(data[,2]) == 0) { - warning("[calc_Statistics()] All errors are NA or zero! Automatically set to 10^-9!", call. = FALSE) - data[,2] <- rep(x = 10^-9, length(data[,2])) - } - - if(weight.calc == "reciprocal") { - S.weights <- 1 / data[,2] - } else if(weight.calc == "square") { - S.weights <- 1 / data[,2]^2 - } else { - stop ("[calc_Statistics()] Weight calculation type not supported!", call. = FALSE) - } - - S.weights <- S.weights / sum(S.weights) - - ## create MCM data - if (is.null(n.MCM)) { - data.MCM <- cbind(data[, 1]) - } else { - data.MCM <- - matrix(data = rnorm( - n = n.MCM * nrow(data), - mean = data[, 1], - sd = data[, 2] - ), - ncol = n.MCM) - - } - - ## calculate n - S.n <- nrow(data) - S.m.n <- S.n * ncol(data.MCM) - - ## calculate mean - S.mean <- mean(x = data[,1], - na.rm = na.rm) - - S.wg.mean <- weighted.mean(x = data[,1], - w = S.weights, - n.rm = na.rm) - - S.m.mean <- mean(x = data.MCM, - na.rm = na.rm) - - - ## calculate median - S.median <- median(x = data[,1], - na.rm = na.rm) - - S.wg.median <- S.median - - S.m.median <- median(x = data.MCM, - na.rm = na.rm) - - ## calculate absolute standard deviation - S.sd.abs <- sd(x = data[,1], - na.rm = na.rm) - - S.wg.sd.abs <- sqrt(sum(S.weights * (data[,1] - S.wg.mean)^2) / - (((S.n - 1) * sum(S.weights)) / S.n)) - - S.m.sd.abs <- sd(x = data.MCM, - na.rm = na.rm) - - - ## calculate relative standard deviation - S.sd.rel <- S.sd.abs / S.mean * 100 - - S.wg.sd.rel <- S.wg.sd.abs / S.wg.mean * 100 - - S.m.sd.rel <- S.m.sd.abs / S.m.mean * 100 - - ## calculate absolute standard error of the mean - S.se.abs <- S.sd.abs / sqrt(S.n) - - S.wg.se.abs <- S.wg.sd.abs / sqrt(S.n) - - S.m.se.abs <- S.m.sd.abs / sqrt(S.n) - - ## calculate relative standard error of the mean - S.se.rel <- S.se.abs / S.mean * 100 - - S.wg.se.rel <- S.wg.se.abs / S.wg.mean * 100 - - S.m.se.rel <- S.m.se.abs / S.m.mean * 100 - - ## calculate skewness - S.skewness <- 1 / S.n * sum(((data[,1] - S.mean) / S.sd.abs)^3) - - S.m.skewness <- 1 / S.m.n * sum(((data.MCM - S.m.mean) / S.m.sd.abs)^3) - - ## calculate kurtosis - S.kurtosis <- 1 / S.n * sum(((data[,1] - S.mean) / S.sd.abs)^4) - - S.m.kurtosis <- 1 / S.m.n * sum(((data.MCM - S.m.mean) / S.m.sd.abs)^4) - - ## create list objects of calculation output - S.weighted <- list(n = S.n, - mean = S.wg.mean, - median = S.wg.median, - sd.abs = S.wg.sd.abs, - sd.rel = S.wg.sd.rel, - se.abs = S.wg.se.abs, - se.rel = S.wg.se.rel, - skewness = S.skewness, - kurtosis = S.kurtosis) - - - if(!is.null(digits)) { - - S.weighted <- sapply(names(S.weighted), - simplify = FALSE, - USE.NAMES = TRUE, - function(x) { - round(S.weighted[[x]], - digits = digits)}) - } - - S.unweighted <- list(n = S.n, - mean = S.mean, - median = S.median, - sd.abs = S.sd.abs, - sd.rel = S.sd.rel, - se.abs = S.se.abs, - se.rel = S.se.rel, - skewness = S.skewness, - kurtosis = S.kurtosis) - - if(!is.null(digits)){ - S.unweighted <- sapply(names(S.unweighted), - simplify = FALSE, - USE.NAMES = TRUE, - function(x) { - round(S.unweighted [[x]], - digits = digits)}) - - } - - S.MCM <- list(n = S.n, - mean = S.m.mean, - median = S.m.median, - sd.abs = S.m.sd.abs, - sd.rel = S.m.sd.rel, - se.abs = S.m.se.abs, - se.rel = S.m.se.rel, - skewness = S.m.skewness, - kurtosis = S.m.kurtosis) - - if(!is.null(digits)){ - - S.MCM <- sapply(names(S.MCM), - simplify = FALSE, - USE.NAMES = TRUE, - function(x) { - round(S.MCM [[x]], - digits = digits)}) - } - - list(weighted = S.weighted, - unweighted = S.unweighted, - MCM = S.MCM) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_TLLxTxRatio.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_TLLxTxRatio.R deleted file mode 100644 index 2f70a8947..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_TLLxTxRatio.R +++ /dev/null @@ -1,219 +0,0 @@ -#'@title Calculate the Lx/Tx ratio for a given set of TL curves -beta version- -#' -#'@description Calculate Lx/Tx ratio for a given set of TL curves. -#' -#'@details -#' **Uncertainty estimation** -#' -#' The standard errors are calculated using the following generalised equation: -#' -#' \deqn{SE_{signal} = abs(Signal_{net} * BG_f /BG_{signal})} -#' -#' where \eqn{BG_f} is a term estimated by calculating the standard deviation of the sum of -#' the \eqn{L_x} background counts and the sum of the \eqn{T_x} background counts. However, -#' if both signals are similar the error becomes zero. -#' -#' @param Lx.data.signal [RLum.Data.Curve-class] or [data.frame] (**required**): -#' TL data (x = temperature, y = counts) (TL signal) -#' -#' @param Lx.data.background [RLum.Data.Curve-class] or [data.frame] (*optional*): -#' TL data (x = temperature, y = counts). -#' If no data are provided no background subtraction is performed. -#' -#' @param Tx.data.signal [RLum.Data.Curve-class] or [data.frame] (**required**): -#' TL data (x = temperature, y = counts) (TL test signal) -#' -#' @param Tx.data.background [RLum.Data.Curve-class] or [data.frame] (*optional*): -#' TL data (x = temperature, y = counts). -#' If no data are provided no background subtraction is performed. -#' -#' @param signal.integral.min [integer] (**required**): -#' channel number for the lower signal integral bound -#' (e.g. `signal.integral.min = 100`) -#' -#' @param signal.integral.max [integer] (**required**): -#' channel number for the upper signal integral bound -#' (e.g. `signal.integral.max = 200`) -#' -#' @return -#' Returns an S4 object of type [RLum.Results-class]. -#' Slot `data` contains a [list] with the following structure: -#' -#' ``` -#' $ LxTx.table -#' .. $ LnLx -#' .. $ LnLx.BG -#' .. $ TnTx -#' .. $ TnTx.BG -#' .. $ Net_LnLx -#' .. $ Net_LnLx.Error -#' ``` -#' -#' @note -#' **This function has still BETA status!** Please further note that a similar -#' background for both curves results in a zero error and is therefore set to `NA`. -#' -#' @section Function version: 0.3.3 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) \cr -#' Christoph Schmidt, University of Bayreuth (Germany) -#' -#' @seealso [RLum.Results-class], [analyse_SAR.TL] -#' -#' @keywords datagen -#' -#' @examples -#' -#' ##load package example data -#' data(ExampleData.BINfileData, envir = environment()) -#' -#' ##convert Risoe.BINfileData into a curve object -#' temp <- Risoe.BINfileData2RLum.Analysis(TL.SAR.Data, pos = 3) -#' -#' -#' Lx.data.signal <- get_RLum(temp, record.id=1) -#' Lx.data.background <- get_RLum(temp, record.id=2) -#' Tx.data.signal <- get_RLum(temp, record.id=3) -#' Tx.data.background <- get_RLum(temp, record.id=4) -#' signal.integral.min <- 210 -#' signal.integral.max <- 230 -#' -#' output <- calc_TLLxTxRatio( -#' Lx.data.signal, -#' Lx.data.background, -#' Tx.data.signal, -#' Tx.data.background, -#' signal.integral.min, -#' signal.integral.max) -#' get_RLum(output) -#' -#' @md -#' @export -calc_TLLxTxRatio <- function( - Lx.data.signal, - Lx.data.background = NULL, - Tx.data.signal, - Tx.data.background = NULL, - signal.integral.min, - signal.integral.max -){ - - ##--------------------------------------------------------------------------## - ##(1) - a few integrity check - ##check DATA TYPE differences - if(is(Lx.data.signal)[1] != is(Tx.data.signal)[1]) - stop("[calc_TLLxTxRatio()] Data types of Lx and Tx data differ!", call. = FALSE) - - ##check for allowed data.types - if(!inherits(Lx.data.signal, "data.frame") & - !inherits(Lx.data.signal, "RLum.Data.Curve")){ - stop("[calc_TLLxTxRatio()] Input data type for not allowed. Allowed are 'RLum.Data.Curve' and 'data.frame'", - call. = FALSE) - - } - - ##--------------------------------------------------------------------------## - ## Type conversion (assuming that all input variables are of the same type) - if(inherits(Lx.data.signal, "RLum.Data.Curve")){ - Lx.data.signal <- as(Lx.data.signal, "matrix") - Tx.data.signal <- as(Tx.data.signal, "matrix") - - if(!missing(Lx.data.background) && !is.null(Lx.data.background)) - Lx.data.background <- as(Lx.data.background, "matrix") - - if(!missing(Tx.data.background) && !is.null(Tx.data.background)) - Tx.data.background <- as(Tx.data.background, "matrix") - - } - - ##(d) - check if Lx and Tx curves have the same channel length - if(length(Lx.data.signal[,2])!=length(Tx.data.signal[,2])){ - stop("[calc_TLLxTxRatio()] Channel numbers differ for Lx and Tx data!", call. = FALSE)} - - ##(e) - check if signal integral is valid - if(signal.integral.min < 1 | signal.integral.max > length(Lx.data.signal[,2])){ - stop("[calc_TLLxTxRatio()] signal.integral is not valid!", call. = FALSE)} - -# Background Consideration -------------------------------------------------- - LnLx.BG <- TnTx.BG <- NA - - ##Lx.data - if(!is.null(Lx.data.background)) - LnLx.BG <- sum(Lx.data.background[signal.integral.min:signal.integral.max, 2]) - - ##Tx.data - if(!is.null(Tx.data.background)) - TnTx.BG <- sum(Tx.data.background[signal.integral.min:signal.integral.max, 2]) - -# Calculate Lx/Tx values -------------------------------------------------- - ## preset variables - net_LnLx <- net_LnLx.Error <- net_TnTx <- net_TnTx.Error <- NA - BG.Error <- NA - - ## calculate values - LnLx <- sum(Lx.data.signal[signal.integral.min:signal.integral.max, 2]) - TnTx <- sum(Tx.data.signal[signal.integral.min:signal.integral.max, 2]) - - ##calculate standard deviation of background - if(!is.na(LnLx.BG) & !is.na(TnTx.BG)){ - BG.Error <- sd(c(LnLx.BG, TnTx.BG)) - - if(BG.Error == 0) { - warning( - "[calc_TLLxTxRatio()] The background signals for Lx and Tx appear to be similar, no background error was calculated.", - call. = FALSE - ) - BG.Error <- NA - - } - - } - - ## calculate net LnLx - if(!is.na(LnLx.BG)){ - net_LnLx <- LnLx - LnLx.BG - net_LnLx.Error <- abs(net_LnLx * BG.Error/LnLx.BG) - - } - - ## calculate net TnTx - if(!is.na(TnTx.BG)){ - net_TnTx <- TnTx - TnTx.BG - net_TnTx.Error <- abs(net_TnTx * BG.Error/TnTx.BG) - - } - - ## calculate LxTx - if(is.na(net_TnTx)){ - LxTx <- LnLx/TnTx - LxTx.Error <- NA - - }else{ - LxTx <- net_LnLx/net_TnTx - LxTx.Error <- abs(LxTx*((net_LnLx.Error/net_LnLx) + (net_TnTx.Error/net_TnTx))) - - } - - ##COMBINE into a data.frame - temp.results <- data.frame( - LnLx, - LnLx.BG, - TnTx, - TnTx.BG, - net_LnLx, - net_LnLx.Error, - net_TnTx, - net_TnTx.Error, - LxTx, - LxTx.Error - ) - -# Return values ----------------------------------------------------------- - return(set_RLum( - class = "RLum.Results", - data = list(LxTx.table = temp.results), - info = list(call = sys.call()) - )) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_ThermalLifetime.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_ThermalLifetime.R deleted file mode 100644 index 98db08719..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_ThermalLifetime.R +++ /dev/null @@ -1,408 +0,0 @@ -#' Calculates the Thermal Lifetime using the Arrhenius equation -#' -#' The function calculates the thermal lifetime of charges for given E (in eV), s (in 1/s) and -#' T (in deg. C.) parameters. The function can be used in two operational modes: -#' -#' **Mode 1 `(profiling = FALSE)`** -#' -#' An arbitrary set of input parameters (E, s, T) can be provided and the -#' function calculates the thermal lifetimes using the Arrhenius equation for -#' all possible combinations of these input parameters. An array with 3-dimensions -#' is returned that can be used for further analyses or graphical output (see example 1) -#' -#' **Mode 2 `(profiling = TRUE)`** -#' -#' This mode tries to profile the variation of the thermal lifetime for a chosen -#' temperature by accounting for the provided E and s parameters and their corresponding -#' standard errors, e.g., `E = c(1.600, 0.001)` -#' The calculation based on a Monte Carlo simulation, where values are sampled from a normal -#' distribution (for E and s). -#' -#' **Used equation (Arrhenius equation)** -#' -#' \deqn{\tau = 1/s exp(E/kT)} -#' where: -#' \eqn{\tau} in s as the mean time an electron spends in the trap for a given \eqn{T}, -#' \eqn{E} trap depth in eV, -#' \eqn{s} the frequency factor in 1/s, -#' \eqn{T} the temperature in K and \eqn{k} the Boltzmann constant in eV/K (cf. Furetta, 2010). -#' -#' -#' @param E [numeric] (**required**): -#' vector of trap depths in eV, -#' if `profiling = TRUE` only the first two elements are considered -#' -#' @param s [numeric] (**required**): -#' vector of frequency factor in 1/s, -#' if `profiling = TRUE` only the first two elements are considered -#' -#' @param T [numeric] (*with default*): -#' temperature in deg. C for which the lifetime(s) will be calculated. -#' A vector can be provided. -#' -#' @param output_unit [character] (*with default*): -#' output unit of the calculated lifetimes, accepted -#' entries are: `"Ma"`, `"ka"`, `"a"`, `"d"`, `"h"`, `"min"`, `"s"` -#' -#' @param profiling [logical] (*with default*): -#' this option allows to estimate uncertainties based on -#' given E and s parameters and their corresponding standard error -#' (cf. details and examples section) -#' -#' @param profiling_config [list] (*optional*): -#' allows to set configuration parameters used for the profiling -#' (and only have an effect here). Supported parameters are: -#' -#' - `n` (number of MC runs), -#' - `E.distribution` (distribution used for the re-sampling for E) and -#' - `s.distribution` (distribution used for the re-sampling for s). -#' -#' Currently only the normal distribution is supported -#' (e.g., `profiling_config = list(E.distribution = "norm")` -#' -#' @param verbose [logical]: -#' enables/disables verbose mode -#' -#' @param plot [logical]: -#' enables/disables output plot, currently only in combination with `profiling = TRUE`. -#' -#' @param ... further arguments that can be passed in combination with the plot output. -#' Standard plot parameters are supported ([plot.default]) -#' -#' @return -#' A [RLum.Results-class] object is returned a along with a plot (for -#' `profiling = TRUE`). The output object contain the following slots: -#' -#' **`@data`** -#' -#' \tabular{lll}{ -#' **Object** \tab **Type** \tab **Description** \cr -#' `lifetimes` \tab [array] or [numeric] \tab calculated lifetimes \cr -#' `profiling_matrix` \tab [matrix] \tab profiling matrix used for the MC runs -#' } -#' -#' **`@info`** -#' -#' \tabular{lll}{ -#' **Object** \tab **Type** \tab **Description** \cr -#' `call` \tab `call` \tab the original function call -#' } -#' -#' @note -#' The profiling is currently based on re-sampling from a normal distribution, this -#' distribution assumption might be, however, not valid for given E and s parameters. -#' -#' @section Function version: 0.1.0 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [graphics::matplot], [stats::rnorm][stats::Normal], [get_RLum] -#' -#' @references -#' -#' Furetta, C., 2010. Handbook of Thermoluminescence, Second Edition. World Scientific. -#' -#' @keywords datagen -#' -#' @examples -#' -#' ##EXAMPLE 1 -#' ##calculation for two trap-depths with similar frequency factor for different temperatures -#' E <- c(1.66, 1.70) -#' s <- 1e+13 -#' T <- 10:20 -#' temp <- calc_ThermalLifetime( -#' E = E, -#' s = s, -#' T = T, -#' output_unit = "Ma" -#' ) -#' contour(x = E, y = T, z = temp$lifetimes[1,,], -#' ylab = "Temperature [\u00B0C]", -#' xlab = "Trap depth [eV]", -#' main = "Thermal Lifetime Contour Plot" -#' ) -#' mtext(side = 3, "(values quoted in Ma)") -#' -#' ##EXAMPLE 2 -#' ##profiling of thermal life time for E and s and their standard error -#' E <- c(1.600, 0.003) -#' s <- c(1e+13,1e+011) -#' T <- 20 -#' calc_ThermalLifetime( -#' E = E, -#' s = s, -#' T = T, -#' profiling = TRUE, -#' output_unit = "Ma" -#') -#' -#' @md -#' @export -calc_ThermalLifetime <- function( - E, - s, - T = 20, - output_unit = "Ma", - profiling = FALSE, - profiling_config = NULL, - verbose = TRUE, - plot = TRUE, - ... - -){ - -# Integrity ----------------------------------------------------------------------------------- - - if (missing(E) || missing(s)) { - .throw_error("'E' or 's' or both are missing, but required.") - } - - -# Set variables ------------------------------------------------------------------------------- - - ##Boltzmann constant - k <- 8.6173324e-05 #eV/K - - ##recalculate temparature - T.K <- T + 273.15 #K - - - ##SETTINGS FOR PROFILING - ##profiling settings - profiling_settings <- list( - n = 1000, - E.distribution = "norm", - s.distribution = "norm" - - ) - - ##replace if set - if(!is.null(profiling_config)){ - profiling_settings <- modifyList(profiling_settings, profiling_config) - - } - - ##check for odd input values - if (profiling_settings$n < 1000){ - profiling_settings$n <- 1000 - .throw_warning("Minimum MC runs are 1000, parameter 'n' ", - "in profiling_config reset to 1000.") - } - -# Calculation --------------------------------------------------------------------------------- - - ##set function for the calculation - f <- function(E, s, T.K) { - 1 / s * exp(E / (k * T.K)) - } - - ##PROFILING - if(profiling) { - ##set profiling matrix - profiling_matrix <- - matrix(NA, ncol = 4, nrow = profiling_settings$n) - - ##fill matrix - - ##E - profiling_matrix[, 1] <- - if( profiling_settings$E.distribution == "norm"){ - rnorm(profiling_settings$n, mean = E[1], sd = E[2]) - - }else{ - .throw_error("Unknown distribution setting for E profiling") - } - - - ##s - profiling_matrix[, 2] <- - if (profiling_settings$s.distribution == "norm") { - rnorm(profiling_settings$n, mean = s[1], sd = s[2]) - - } else{ - .throw_error("Unknown distribution setting for s profiling") - } - - ##T - profiling_matrix[, 3] <- - rep(T.K[1], each = profiling_settings$n) - - - ##calulate lifetimes - profiling_matrix[, 4] <- - f(profiling_matrix[, 1], profiling_matrix[, 2], profiling_matrix[, 3]) - - ##reduce E and s vector on the first entry - T <- T[1] - - ##set lifetimes - lifetimes <- profiling_matrix[, 4] - - } else{ - - ##set empty profiling matrix - profiling_matrix <- matrix() - - ##calculate lifetimes - lifetimes <- vapply( - X = T.K, - FUN = function(i) { - vapply( - X = E, - FUN = function(j) { - f(E = j, s = s, T.K = i) - - }, - FUN.VALUE = vector(mode = "numeric", length = length(s)) - ) - - }, - FUN.VALUE = matrix(numeric(), ncol = length(E), nrow = length(s)) - ) - - - - ##transform to an arry in either case to have the same output - if (!is(lifetimes, "array")) { - lifetimes <- - array(lifetimes, dim = c(length(s), length(E), length(T))) - - } - - ##set dimnames to make reading more clear - dimnames(lifetimes) <- list(s, E, paste0("T = ", T, " \u00B0C")) - - } - - ##re-calculate lifetimes accourding to the chosen output unit - temp.lifetimes <- switch ( - output_unit, - "s" = lifetimes, - "min" = lifetimes / 60, - "h" = lifetimes / 60 / 60, - "d" = lifetimes / 60 / 60 / 24, - "a" = lifetimes / 60 / 60 / 24 / 365, - "ka" = lifetimes / 60 / 60 / 24 / 365 / 1000, - "Ma" = lifetimes / 60 / 60 / 24 / 365 / 1000 / 1000 - ) - - ##check for invalid values - if(is.null(temp.lifetimes)){ - output_unit <- "s" - .throw_warning("'output_unit' unknown, reset to 's'") - }else{ - lifetimes <- temp.lifetimes - rm(temp.lifetimes) - - } - - - # Terminal output ----------------------------------------------------------------------------- - - if(verbose){ - cat("\n[calc_ThermalLifetime()]\n\n") - - if(profiling){ - - - cat("\tprofiling = TRUE") - cat("\n\t--------------------------\n") - } - cat(paste("\tmean:\t", format(mean(lifetimes), scientific = TRUE), output_unit)) - cat(paste("\n\tsd:\t", format(sd(lifetimes), scientific = TRUE), output_unit)) - cat(paste("\n\tmin:\t", format(min(lifetimes), scientific = TRUE), output_unit)) - - if(!profiling){ - cat(paste0(" (@",T[which(lifetimes == min(lifetimes), arr.ind = TRUE)[3]], " \u00B0C)")) - } - - cat(paste("\n\tmax:\t", format(max(lifetimes), scientific = TRUE), output_unit)) - - if(!profiling){ - cat(paste0(" (@",T[which(lifetimes == max(lifetimes), arr.ind = TRUE)[3]], " \u00B0C)")) - } - - cat("\n\t--------------------------") - cat(paste0("\n\t(", length(lifetimes), " lifetimes calculated in total)")) - - } - - - # Plotting ------------------------------------------------------------------------------------ - if(plot & profiling){ - - ##plot settings - plot.settings <- list( - main = "Thermal Lifetime Density Plot", - xlab = paste0("Thermal lifetime [",output_unit,"]"), - ylab = "Density", - xlim = NULL, - ylim = NULL, - log = "", - lwd = 1, - lty = 1, - col = rgb(0, 0, 0, 0.25) - ) - - ##modify on request - plot.settings <- modifyList(plot.settings, list(...)) - - ##split data and calculate density - ##set seq - id_seq <- seq( - from = 1, - to = length(lifetimes), - length.out = 200) - - ##calculate lifetime of the density - lifetimes_density <- - lapply(1:(length(id_seq) - 1), - function(x) { - density(lifetimes[id_seq[x]:id_seq[x+1]]) - - }) - - ##get x values - lifetimes_density.x <- matrix(unlist(lapply(1:length(lifetimes_density), function(i){ - lifetimes_density[[i]]$x - - - })), nrow = length(lifetimes_density[[1]]$x)) - - ##get y values - lifetimes_density.y <- matrix(unlist(lapply(1:length(lifetimes_density), function(i){ - lifetimes_density[[i]]$y - - - })), nrow = length(lifetimes_density[[1]]$y)) - - - ##plot density curves - graphics::matplot( - lifetimes_density.x, - lifetimes_density.y, - type = "l", - lwd = plot.settings$lwd, - lty = plot.settings$lty, - col = plot.settings$col, - main = plot.settings$main, - xlab = plot.settings$xlab, - ylab = plot.settings$ylab, - xlim = plot.settings$xlim, - ylim = plot.settings$ylim, - log = plot.settings$log - ) - - } - - # Return values ------------------------------------------------------------------------------- - return(set_RLum( - class = "RLum.Results", - data = list(lifetimes = lifetimes, - profiling_matrix = profiling_matrix), - info = list(call = sys.call()) - )) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_WodaFuchs2008.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_WodaFuchs2008.R deleted file mode 100644 index 27fc86ef7..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_WodaFuchs2008.R +++ /dev/null @@ -1,232 +0,0 @@ -#' Obtain the equivalent dose using the approach by Woda and Fuchs 2008 -#' -#' The function generates a histogram-like reorganisation of the data, to -#' assess counts per bin. The log-transformed counts per bin are used to -#' calculate the second derivative of the data (i.e., the curvature of the -#' curve) and to find the central value of the bin hosting the distribution -#' maximum. A normal distribution model is fitted to the counts per bin -#' data to estimate the dose distribution parameters. The uncertainty of the -#' model is estimated based on all input equivalent doses smaller that of the -#' modelled central value. -#' -#' @param data [data.frame] [vector], or [RLum.Results-class] object (**required**): -#' for [data.frame]: either two columns: De (`values[,1]`) and De error -#' (`values[,2]`), or one: De (`values[,1]`). If a numeric vector or a -#' single-column data frame is provided, De error is set to `NA`. -#' For plotting multiple data sets, these must be provided as `list` -#' (e.g. `list(dataset1, dataset2)`). -#' -#' @param breaks [numeric]: -#' Either number or locations of breaks. See `[hist]` for details. -#' If missing, the number of breaks will be estimated based on the bin width -#' (as function of median error). -#' -#' @param plot [logical] (*with default*): -#' enable plot output. -#' -#' @param ... Further plot arguments passed to the function. -#' -#' @section Function version: 0.2.0 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany),\cr -#' Michael Dietze, GFZ Potsdam (Germany) -#' -#' @seealso [calc_FuchsLang2001], [calc_CentralDose] -#' -#' @references -#' Woda, C., Fuchs, M., 2008. On the applicability of the leading edge method to -#' obtain equivalent doses in OSL dating and dosimetry. Radiation Measurements 43, 26-37. -#' -#' @examples -#' -#' ## read example data set -#' data(ExampleData.DeValues, envir = environment()) -#' -#' results <- calc_WodaFuchs2008( -#' data = ExampleData.DeValues$CA1, -#' xlab = expression(paste(D[e], " [Gy]")) -#' ) -#' -#' @md -#' @export -calc_WodaFuchs2008 <- function( - data, - breaks = NULL, - plot = TRUE, - ... -) { - - ##TODO - # - complete manual - # - add statistics to the plot - # - check whether this makes sense at all ... - - ## check data and parameter consistency ------------------------------------- - - if(is(data, "RLum.Results") == FALSE & - is(data, "data.frame") == FALSE & - is.numeric(data) == FALSE) { - - .throw_warning("Input data must be one of 'data.frame', 'RLum.Results' ", - "or 'numeric', NULL returned") - return(NULL) - - } else { - - if(is(data, "RLum.Results") == TRUE) { - data <- tryCatch(get_RLum(data, "data"), - error = function(e) get_RLum(data)) - } - - ## if data is a numeric vector or a single-column data frame, - ## append a second column of NAs - if (NCOL(data) < 2) { - data <- cbind(data, NA) - } - - ## with just one data point, it's possible to cause nls() to hang - if (nrow(data) < 2) { - .throw_error("Insufficient number of data points") - } - } - - ## read additional arguments - - if("trace" %in% names(list(...))) { - - trace <- list(...)$trace - } else { - - trace <- FALSE - } - - ## calculations ------------------------------------------------------------- - - ## estimate bin width based on Woda and Fuchs (2008) - if (all(is.na(data[, 2]))) { - message("[calc_WodFuchs2008()] No errors provided. Bin width set ", - "by 10 percent of input data") - bin_width <- median(data[,1] / 10, - na.rm = TRUE) - } else { - - bin_width <- median(data[,2], - na.rm = TRUE) - } - - ## optionally estimate class breaks based on bin width - if(is.null(breaks)) { - n_breaks <- diff(range(data[, 1], na.rm = TRUE)) / bin_width - } else { - n_breaks <- breaks - } - - if (n_breaks <= 3) { - .throw_warning("Fewer than 4 bins produced, 'breaks' set to 4") - n_breaks = 4 - } - - ## calculate histogram - H <- hist(x = data[,1], - breaks = n_breaks, - plot = FALSE) - - ## extract values from histogram object - H_c <- H$counts - H_m <- H$mids - - ## log counts - counts_log <- log(H_c) - - ## estimate curvature - curvature <- (counts_log[1] - counts_log[2]) / - (counts_log[1] - counts_log[3]) - - ## do some other black magic - class_center <- H$mids[H_c == max(H_c)] - - ## optionally print warning - if(length(class_center) != 1) { - .throw_warning("More than one maximum, fit may be invalid") - class_center <- class_center[1] - } - - ## fit normal distribution to data - fit <- nls(H_c ~ (A / sqrt(2 * pi * sigma^2)) * - exp(-(H_m - class_center)^2 / (2 * sigma^2)), - start = c(A = mean(H_m), - sigma = bin_width), - control = c(maxiter = 5000), - algorithm = "port", - trace = trace) - - ## extract fitted parameters - A <- coef(fit)["A"] - sigma <- coef(fit)["sigma"] - - ## estimate dose - D_estimate <- as.numeric(x = class_center - sigma) - - ## count number of values smaller than center class - count_ID <- length(which(H_m <= class_center)) - - ## extract H_m values smaller than center class - H_m_smaller <- H_m[1:count_ID] - - ## calculate uncertainty according to Woda and Fuchs (2008) - s <- round(sqrt(sum((H_m_smaller - D_estimate)^2) / (count_ID - 1)), - digits = 2) - - ## plot output -------------------------------------------------------------- - if(plot) { - - ##define plot settings - plot_settings <- list( - xlab = expression(paste(D[e], " [s]")), - ylab = "Frequency", - xlim = range(data[,1], na.rm = TRUE) + c(-10, 20), - ylim = NULL, - main = expression(paste(D[e]," applying Woda and Fuchs (2008)")), - sub = NULL - ) - - plot_settings <- modifyList(x = plot_settings, val = list(...), keep.null = TRUE) - - plot( - x = H, - xlab = plot_settings$xlab, - ylab = plot_settings$ylab, - xlim = plot_settings$xlim, - ylim = plot_settings$ylim, - main = plot_settings$main, - sub = plot_settings$sub - ) - - ## add curve with normal distribution - x <- 0 - rm(x) - curve((A / sqrt(2 * pi * sigma^2)) * exp(-(x- class_center)^2 / (2 * sigma^2)), - add = TRUE, - to = class_center, - col = "red" - ) - } - - ## return output ------------------------------------------------------------ - return(set_RLum( - class = "RLum.Results", - data = list( - D_estimate = data.frame( - DP = D_estimate, - DP.ERROR = s, - CLASS_CENTER = class_center, - BIN_WIDTH = bin_width, - SIGMA = sigma, - A = A, - row.names = NULL - ), - breaks = H$breaks - ), - info = list(call = sys.call()) - )) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_gSGC.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_gSGC.R deleted file mode 100644 index ff124a1f3..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_gSGC.R +++ /dev/null @@ -1,423 +0,0 @@ -#' Calculate De value based on the gSGC by Li et al., 2015 -#' -#' Function returns De value and De value error using the global standardised growth -#' curve (gSGC) assumption proposed by Li et al., 2015 for OSL dating of sedimentary quartz -#' -#' The error of the De value is determined using a Monte Carlo simulation approach. -#' Solving of the equation is realised using [uniroot]. -#' Large values for `n.MC` will significantly increase the computation time. -#' -#' -#' @param data [data.frame] (**required**): -#' input data of providing the following columns: `LnTn`, `LnTn.error`, `Lr1Tr1`, `Lr1Tr1.error`, `Dr1` -#' **Note:** column names are not required. The function expects the input data in the given order -#' -#' @param gSGC.type [character] (*with default*): -#' define the function parameters that -#' should be used for the iteration procedure: Li et al., 2015 (Table 2) -#' presented function parameters for two dose ranges: `"0-450"` and `"0-250"` -#' -#' @param gSGC.parameters [list] (*optional*): -#' option to provide own function parameters used for fitting as named list. -#' Nomenclature follows Li et al., 2015, i.e. `list(A,A.error,D0,D0.error,c,c.error,Y0,Y0.error,range)`, -#' range requires a vector for the range the function is considered as valid, e.g. `range = c(0,250)`\cr -#' Using this option overwrites the default parameter list of the gSGC, meaning the argument -#' `gSGC.type` will be without effect -#' -#' @param n.MC [integer] (*with default*): -#' number of Monte Carlo simulation runs for error estimation, see details. -#' -#' @param verbose [logical]: -#' enable or disable terminal output -#' -#' @param plot [logical]: -#' enable or disable graphical feedback as plot -#' -#' @param ... parameters will be passed to the plot output -#' -#' @return Returns an S4 object of type [RLum.Results-class]. -#' -#' **`@data`**\cr -#' `$ De.value` ([data.frame]) \cr -#' `.. $ De` \cr -#' `.. $ De.error` \cr -#' `.. $ Eta` \cr -#' `$ De.MC` ([list]) contains the matrices from the error estimation.\cr -#' `$ uniroot` ([list]) contains the [uniroot] outputs of the De estimations\cr -#' -#' **`@info`**\cr -#' `$ call`` ([call]) the original function call -#' -#' -#' @section Function version: 0.1.1 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum.Results-class], [get_RLum], [uniroot] -#' -#' @references -#' Li, B., Roberts, R.G., Jacobs, Z., Li, S.-H., 2015. Potential of establishing -#' a 'global standardised growth curve' (gSGC) for optical dating of quartz from sediments. -#' Quaternary Geochronology 27, 94-104. doi:10.1016/j.quageo.2015.02.011 -#' -#' @keywords datagen -#' -#' @examples -#' -#' results <- calc_gSGC(data = data.frame( -#' LnTn = 2.361, LnTn.error = 0.087, -#' Lr1Tr1 = 2.744, Lr1Tr1.error = 0.091, -#' Dr1 = 34.4)) -#' -#' get_RLum(results, data.object = "De") -#' -#' @md -#' @export -calc_gSGC<- function( - data, - gSGC.type = "0-250", - gSGC.parameters, - n.MC = 100, - verbose = TRUE, - plot = TRUE, - ... -){ - -##============================================================================## -##CHECK INPUT DATA -##============================================================================## - - if (!is.data.frame(data)) - .throw_error("'data' must be a data.frame") - if (ncol(data) != 5) - .throw_error("'data' is expected to have 5 columns") - if (!is.character(gSGC.type)) - .throw_error("'gSGC.type' must be of type 'character'") - - ##rename columns for consistency reasons - colnames(data) <- c('LnTn', 'LnTn.error', 'Lr1Tr1', 'Lr1Tr1.error', 'Dr1') - - -##============================================================================## -##DEFINE FUNCTION -##============================================================================## - - ##define function, nomenclature according to publication that should be solved - f <- function(x,A,D0,c,Y0,Dr1,Lr1Tr1,LnTn) { - (((A * (1 - exp( - Dr1 / D0))) + c * Dr1 + Y0)/Lr1Tr1) - - (((A * (1 - exp( - x/D0))) + c * x + Y0)/LnTn) - } - - ##set general parameters - if (!missing(gSGC.parameters)) { - A <- gSGC.parameters$A - A.error <- gSGC.parameters$A.error - D0 <- gSGC.parameters$D0 - D0.error <- gSGC.parameters$D0.error - c <- gSGC.parameters$c - c.error <- gSGC.parameters$c.error - Y0 <- gSGC.parameters$Y0 - Y0.error <- gSGC.parameters$Y0.error - range <- gSGC.parameters$range - - }else{ - if (gSGC.type == "0-450") { - A <- 0.723 - A.error <- 0.014 - D0 <- 65.1 - D0.error <- 0.9 - c <- 0.001784 - c.error <- 0.000016 - Y0 <- 0.009159 - Y0.error <- 0.004795 - - range <- c(0.1,250) - - }else if (gSGC.type == "0-250") { - A <- 0.787 - A.error <- 0.051 - D0 <- 73.9 - D0.error <- 2.2 - c <- 0.001539 - c.error <- 0.000068 - Y0 <- 0.01791 - Y0.error <- 0.00490 - - range <- c(0.1,250) - - }else{ - .throw_error("Unknown 'gSGC.type'") - } - } - - ##Define size of output objects - output.data <- data.table::data.table( - DE = numeric(length = nrow(data)), - DE.ERROR = numeric(length = nrow(data)), - ETA = numeric(length = nrow(data)) - ) - - ##set list for De.MC - output.De.MC <- vector("list", nrow(data)) - - ##set list for uniroot - output.uniroot <- vector("list", nrow(data)) - - -##============================================================================## -##CALCULATION -##============================================================================## -for(i in 1:nrow(data)){ - Lr1Tr1 <- data[i, "Lr1Tr1"] - Lr1Tr1.error <- data[i,"Lr1Tr1.error"] - Dr1 <- data[i,"Dr1"] - Dr1.error <- data[i,"Dr1.error"] - - LnTn <- data[i,"LnTn"] - LnTn.error <- data[i,"LnTn.error"] - - ##calculate mean value - temp <- try(uniroot( - f, - interval = c(0.1,450), - tol = 0.001, - A = A, - D0 = D0, - c = c, - Y0 = Y0, - Dr1 = Dr1, - Lr1Tr1 = Lr1Tr1, - LnTn = LnTn, - extendInt = 'yes', - check.conv = TRUE, - maxiter = 1000 - ), silent = TRUE) - - if(!inherits(temp, "try-error")){ - - ##get De - De <- temp$root - - ##calculate Eta, which is the normalisation factor - Eta <- ((A * (1 - exp( - Dr1 / D0))) + c * Dr1 + Y0)/Lr1Tr1 - - ##--------------------------------------------------------------------------## - ##Monte Carlo simulation for error estimation - - ##set matrix - temp.MC.matrix <- matrix(nrow = n.MC, ncol = 8) - - ##fill matrix - temp.MC.matrix[,1:6] <- matrix(rnorm( - n.MC * 6, - mean = c(LnTn, Lr1Tr1, A, D0, c, Y0), - sd = c(LnTn.error, Lr1Tr1.error, A.error, D0.error, c.error, Y0.error) - ), ncol = 6, byrow = TRUE) - - - ##run uniroot to get the De - temp.MC.matrix[,7] <- vapply(X = 1:n.MC, FUN = function(x){ - - uniroot(f, - interval = c(0.1,450), - tol = 0.001, - A = temp.MC.matrix[x,3], - D0 = temp.MC.matrix[x,4], - c = temp.MC.matrix[x,5], - Y0 = temp.MC.matrix[x,6], - Dr1 = Dr1, - Lr1Tr1 =temp.MC.matrix[x,2], - LnTn = temp.MC.matrix[x,1], - check.conv = TRUE, - extendInt = 'yes', - maxiter = 1000 - )$root - - }, FUN.VALUE = vector(mode = "numeric", length = 1)) - - ##calculate also the normalisation factor - temp.MC.matrix[,8] <- (temp.MC.matrix[,3] * (1 - exp( - Dr1 / temp.MC.matrix[,4])) + - temp.MC.matrix[,5] * Dr1 + temp.MC.matrix[,6])/temp.MC.matrix[,2] - - - ##re-name matrix - colnames(temp.MC.matrix) <- c("LnTn","Lr1Tr1","A","D0","c","Y0","De","Eta") - - ##get De error as SD - De.error <- sd(temp.MC.matrix[,7]) - - }else{ - .throw_warning("No solution was found") - De <- NA - Eta <- NA - De.error <- NA - - ##set matrix - temp.MC.matrix <- matrix(nrow = n.MC, ncol = 8) - - ##fill matrix - temp.MC.matrix[,1:6] <- matrix(rnorm( - n.MC * 6, - mean = c(LnTn, Lr1Tr1, A, D0, c, Y0), - sd = c(LnTn.error, Lr1Tr1.error, A.error, D0.error, c.error, Y0.error) - ), ncol = 6, byrow = TRUE) - } - - -# Plot output ------------------------------------------------------------- - if (plot) { - - ##set plot settings - plot.settings <- list( - main = "gSGC and resulting De", - xlab = "Dose [a.u.]", - ylab = expression(paste("Re-norm. ", L[x]/T[x])), - xlim = NULL, - ylim = NULL, - lwd = 1, - lty = 1, - pch = 21, - col = "red", - grid = expression(nx = 10, ny = 10), - mtext = "" - ) - - plot.settings <- modifyList(plot.settings, list(...)) - - ##graphical feedback - x <- NA - curve( - A * (1 - exp(-x / D0)) + c * x + Y0, from = 0, to = 500, - xlab = plot.settings$xlab, - ylab = plot.settings$ylab, - main = plot.settings$main, - xlim = plot.settings$xlim, - ylim = plot.settings$ylim, - lwd = plot.settings$lwd, - lty = plot.settings$lty - ) - - mtext(side = 3, plot.settings$mtext) - - if(!is.null(plot.settings$grid)){ - graphics::grid(eval(plot.settings$grid)) - } - - if(!inherits(temp, "try-error")){ - - if(temp$root < 450 & temp$root > 0){ - points(temp$root,Eta*LnTn, col = plot.settings$col, pch = plot.settings$pch) - segments(De - De.error,Eta * LnTn, - De + De.error,Eta * LnTn) - - hist <- - hist( - temp.MC.matrix[, 7], - freq = FALSE, - add = TRUE, - col = rgb(0, 0, 0, 0.2), - border = rgb(0, 0, 0, 0.5) - ) - lines(hist$mids,hist$density) - - }else{ - - if(temp$root < 450){ - shape::Arrows( - x0 = 450, - y0 = par()$usr[4] - 0.2, - x1 = 500, - y1 = par()$usr[4] - 0.2, - arr.type = "triangle", - col = "red" - ) - }else{ - - shape::Arrows( - x0 = 50, - y0 = par()$usr[4] - 0.2, - x1 = 0, - y1 = par()$usr[4] - 0.2, - arr.type = "triangle", - col = "red" - ) - } - - mtext(side = 1, text = "Out of bounds!", col = "red") - } - - }else{ - mtext(side = 1, text = "No solution found!", col = "red") - } - } - - -# Terminal output --------------------------------------------------------- - if (verbose) { - cat("\n[calc_gSGC()]") - cat("\n Corresponding De based on the gSGC\n") - - cat(paste0("\n"," Ln/Tn:\t\t ",LnTn," \u00B1 ", LnTn.error,"\n")) - cat(paste0(""," Lr1/Tr1:\t ",Lr1Tr1," \u00B1 ", Lr1Tr1.error,"\n")) - cat(paste0(""," Dr1:\t\t ",Dr1,"\n")) - cat(paste0(""," f(D):\t\t ",A," * (1 - exp(-D /",D0,")) + c * D + ",Y0,"\n")) - cat(paste0(""," n.MC:\t\t ",n.MC,"\n")) - cat(paste0(" ------------------------------ \n")) - cat(paste0(" De:\t\t",round(De,digits = 2)," \u00B1 ",round(De.error,digits = 2),"\n")) - cat(paste0(" ------------------------------ \n")) - } - - -##============================================================================## -##CREATE OUTPUT OBJECTS -##============================================================================## - - ##needed for data.table - temp.De <- De - temp.De.error <- De.error - temp.Eta <- Eta - - ##replace values in the data.table with values - output.data[i, `:=` (DE = temp.De, - DE.ERROR = temp.De.error, - ETA = temp.Eta)] - - rm(list = c('temp.De', 'temp.De.error', 'temp.Eta')) - - ##matrix - to prevent memory overload limit output - if(n.MC * nrow(data) > 1e6){ - # nocov start - if(i == 1){ - output.De.MC[[i]] <- temp.MC.matrix - }else{ - output.De.MC[[i]] <- NA - } - - .throw_warning("Only the first MC matrix is returned to prevent ", - "memory overload") - # nocov end - }else{ - output.De.MC[[i]] <- temp.MC.matrix - } - - output.uniroot[[i]] <- temp - -}##end for loop - -##============================================================================## -##OUTPUT RLUM -##============================================================================## - - temp.RLum.Results <- set_RLum( - class = "RLum.Results", - data = list( - De = as.data.frame(output.data), - De.MC = output.De.MC, - uniroot = output.uniroot - ), - info = list( call = sys.call()) - ) - - return(temp.RLum.Results) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_gSGC_feldspar.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_gSGC_feldspar.R deleted file mode 100644 index f8686ee59..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/calc_gSGC_feldspar.R +++ /dev/null @@ -1,335 +0,0 @@ -#'@title Calculate Global Standardised Growth Curve (gSGC) for Feldspar MET-pIRIR -#' -#'@description Implementation of the gSGC approach for feldspar MET-pIRIR by Li et al. (2015) -#' -#'@details ##TODO -#' -#'@param data [data.frame] (**required**): data frame with five columns per sample -#'`c("LnTn", "LnTn.error", "Lr1Tr1", "Lr1Tr1.error","Dr1")` -#' -#'@param gSGC.type [character] (*with default*): growth curve type to be selected -#'according to Table 3 in Li et al. (2015). Allowed options are -#'`"50LxTx"`, `"50Lx"`, `"50Tx"`, `"100LxTx"`, `"100Lx"`, `"100Tx"`, `"150LxTx"`, -#' `"150Lx"`, `"150Tx"`, `"200LxTx"`, `"200Lx"`, `"200Tx"`, `"250LxTx"`, `"250Lx"`, -#' `"250Tx"` -#' -#'@param gSGC.parameters [data.frame] (*optional*): an own parameter set for the -#'gSGC with the following columns `y1`, `y1_err`, `D1` -#'`D1_err`, `y2`, `y2_err`, `y0`, `y0_err`. -#' -#'@param n.MC [numeric] (*with default*): number of Monte-Carlo runs for the -#'error calculation -#' -#'@param plot [logical] (*with default*): enables/disables the control plot output -#' -#'@return Returns an S4 object of type [RLum.Results-class]. -#' -#' **`@data`**\cr -#' `$ df` ([data.frame]) \cr -#' `.. $DE` the calculated equivalent dose\cr -#' `.. $DE.ERROR` error on the equivalent dose, which is the standard deviation of the MC runs\cr -#' `.. $HPD95_LOWER` lower boundary of the highest probability density (95%)\cr -#' `.. $HPD95_UPPER` upper boundary of the highest probability density (95%)\cr -#' `$ m.MC` ([list]) numeric vector with results from the MC runs.\cr -#' -#' **`@info`**\cr -#' `$ call`` ([call]) the original function call -#' -#' @section Function version: 0.1.0 -#' -#' @author Harrison Gray, USGS (United States), -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum.Results-class], [get_RLum], [uniroot], [calc_gSGC] -#' -#' @references Li, B., Roberts, R.G., Jacobs, Z., Li, S.-H., Guo, Y.-J., 2015. -#' Construction of a “global standardised growth curve” (gSGC) for infrared -#' stimulated luminescence dating of K-feldspar 27, 119–130. \doi{10.1016/j.quageo.2015.02.010} -#' -#' @keywords datagen -#' -#' @examples -#' -#' ##test on a generated random sample -#' n_samples <- 10 -#' data <- data.frame( -#' LnTn = rnorm(n=n_samples, mean=1.0, sd=0.02), -#' LnTn.error = rnorm(n=n_samples, mean=0.05, sd=0.002), -#' Lr1Tr1 = rnorm(n=n_samples, mean=1.0, sd=0.02), -#' Lr1Tr1.error = rnorm(n=n_samples, mean=0.05, sd=0.002), -#' Dr1 = rep(100,n_samples)) -#' -#' results <- calc_gSGC_feldspar( -#' data = data, gSGC.type = "50LxTx", -#' plot = FALSE) -#' -#' plot_AbanicoPlot(results) -#' -#'@md -#'@export -calc_gSGC_feldspar <- function ( - data, - gSGC.type = "50LxTx", - gSGC.parameters, - n.MC = 100, - plot = FALSE -){ - -# Integrity checks -------------------------------------------------------- - if (!is(data, "data.frame")) { - stop("[calc_gSGC_feldspar()] 'data' needs to be of type data.frame.", call. = FALSE) - } - if (!is(gSGC.type[1], "character")) { - stop("[calc_gSGC_feldspar()] 'gSGC.type' needs to be of type character.", call. = FALSE) - } - if (ncol(data) != 5) { - stop("[calc_gSGC_feldspar()] Structure of 'data' does not fit the expectations.", call. = FALSE) - } - colnames(data) <- c("LnTn", "LnTn.error", "Lr1Tr1", "Lr1Tr1.error", - "Dr1") - -# Parametrize ------------------------------------------------------------- - params <- data.frame( # this is the data from Table 3 of Li et al., 2015 - Type = c("50LxTx", "50Lx", "50Tx", "100LxTx", "100Lx", "100Tx", "150LxTx", "150Lx", "150Tx", "200LxTx", "200Lx", "200Tx", "250LxTx", "250Lx", "250Tx"), - y1 = c( 0.57, 0.36, 0.2, 0.39, 0.41, 0.28, 0.43, 0.4, 0.31, 0.3, 0.34, 0.37, 0.37, 0.17, 0.48), - y1_err = c( 0.19, 0.25, 0.24, 0.12, 0.28, 0.22, 0.11, 0.27, 0.33, 0.06, 0.28, 0.28, 0.1, 0.12, 0.37), - D1 = c( 241, 276, 259, 159, 304, 310, 177, 327, 372, 119, 316, 372, 142, 197, 410), - D1_err = c( 66, 137, 279, 48, 131, 220, 41, 132, 300, 32, 145, 218, 35, 116, 210), - y2 = c( 0.88, 1.37, 0.34, 0.91, 1.22, 0.42, 0.88, 1.26, 0.45, 0.95, 1.24, 0.43, 0.74, 1.32, 0.45), - y2_err = c( 0.15, 0.19, 0.15, 0.1, 0.23, 0.26, 0.09, 0.23, 0.18, 0.05, 0.25, 0.24, 0.09, 0.1, 0.15), - D2 = c( 1115, 1187, 1462, 741, 1146, 2715, 801, 1157, 2533, 661, 1023, 2792, 545, 830, 2175), - D2_err = c( 344, 287, 191, 105, 288, 639, 109, 263, 608, 49, 205, 709, 62, 79, 420), - y0 = c( 0.008, 0.003, 0.685, 0.018, 0.01, 0.64, 0.026, 0.015, 0.61, 0.034, 0.02, 0.573, 0.062, 0.028, 0.455), - y0_err = c( 0.009, 0.009, 0.014, 0.008, 0.008, 0.015, 0.006, 0.007, 0.014, 0.006, 0.006, 0.013, 0.005, 0.005, 0.011), - D0_2.3 = c( 2000, 2450, 1420, 1420, 2300, 2900, 1500, 2340, 2880, 1320, 2080, 2980, 1000, 1780, 2500), - D0_3 = c( 2780, 3280, 2520, 1950, 3100, 4960, 2060, 3130, 4760, 1780, 2800, 5120, 1380, 2360, 4060) - ) - - # these are user specified parameters if they so desire - if (!missing(gSGC.parameters)){ - y1 <- gSGC.parameters$y1 - y1_err <- gSGC.parameters$y1_err - D1 <- gSGC.parameters$D1 - D1_err <- gSGC.parameters$D1_err - y2 <- gSGC.parameters$y2 - y2_err <- gSGC.parameters$y2_err - y0 <- gSGC.parameters$y0 - y0_err <- gSGC.parameters$y0_err - - } else { - if (gSGC.type[1] %in% params$Type){ - # take the user input pIRSL temperature and assign the correct parameters - index <- match(gSGC.type,params$Type) - - y1 <- params$y1[index] - y1_err <- params$y1_err[index] - - D1 <- params$D1[index] - D1_err <- params$D1_err[index] - - y2 <- params$y2[index] - y2_err <- params$y2_err[index] - - D2 <- params$D2[index] - D2_err <- params$D2_err[index] - - y0 <- params$y0[index] - y0_err <- params$y0_err[index] - - } else { - # give error if input is wrong - stop( - paste0("[calc_gSGC_feldspar()] 'gSGC.type' needs to be one of the accepted values, such as: ", - paste(params$Type, collapse = ", ")), - call. = FALSE) - } - } - - ##set function for uniroot - ## function from Li et al., 2015 eq: 3 - ## function that equals zero when the correct De is found. - ## This is so uniroot can find the correct value or 'root' - f <- function(De, Dr1, Lr1Tr1, LnTn, y1, D1, y2, D2, y0){ - f_D <- y1 * (1 - exp(-De / D1)) + y2 * (1 - exp(-De / D2)) + y0 - f_Dr <- y1 * (1 - exp(-Dr1 / D1)) + y2 * (1 - exp(-Dr1 / D2)) + y0 - ##return(f_D/Lr1Tr1 - f_Dr/LnTn) ##TODO double check seems to be wrong - return(f_Dr/Lr1Tr1 - f_D/LnTn) - - } - -# Run calculation --------------------------------------------------------- - l <- lapply(1:nrow(data), function(i) { - Lr1Tr1 <- data[i, "Lr1Tr1"] #assign user's input data - Lr1Tr1.error <- data[i, "Lr1Tr1.error"] - Dr1 <- data[i, "Dr1"] - LnTn <- data[i, "LnTn"] - LnTn.error <- data[i, "LnTn.error"] - - ## uniroot solution - temp <- try({ - uniroot( - f, - interval = c(0.1, 3000), - tol = 0.001, - Dr1 = Dr1, - Lr1Tr1 = Lr1Tr1, - LnTn = LnTn, - y1 = y1, - D1 = D1, - y2 = y2, - D2 = D2, - y0 = y0, - extendInt = "yes", - check.conv = TRUE, - maxiter = 1000) - }, silent = TRUE) # solve for the correct De - - ## in case the initial uniroot solve does not work - if(inherits(temp, "try-error")) { - message("[calc_gSGC_feldspar()] Error: No solution found for ", - "dataset #", i, ", NA returned") - return(NA) - } - - De <- temp$root - temp.MC.matrix <- matrix(nrow = n.MC, ncol = 8) - - # to estimate the error, use a monte carlo simulation. assume error in input data is gaussian - # create a matrix - colnames(temp.MC.matrix) <- c("LnTn", "Lr1Tr1","y1", "D1", "y2", "D2", "y0", "De") - - # simulate random values for each parameter - temp.MC.matrix[, 1:7] <- matrix( - rnorm(n.MC * 7, - mean = c(LnTn, Lr1Tr1, y1, D1, y2, D2, y0), - sd = c(LnTn.error, Lr1Tr1.error, y1_err, D1_err, y2_err, D2_err, y0_err)), - ncol = 7, - byrow = TRUE) - - # now use the randomly generated parameters to calculate De's with uniroot - for (j in 1:n.MC){ - temp2 <- try({ - uniroot( - f, - interval = c(0.1, 3000), - tol = 0.001, - LnTn = temp.MC.matrix[j, 1], - Lr1Tr1 = temp.MC.matrix[j, 2], - y1 = temp.MC.matrix[j, 3], - D1 = temp.MC.matrix[j, 4], - y2 = temp.MC.matrix[j, 5], - D2 = temp.MC.matrix[j, 6], - y0 = temp.MC.matrix[j, 7], - Dr1 = Dr1, - extendInt = "yes", - check.conv = TRUE, - maxiter = 1000 - ) - }, silent = TRUE) - - if (!inherits(temp2, "try-error")){ - temp.MC.matrix[j,8] <- temp2$root - - } else { - # give an NA if uniroot cannot find a root (usually due to bad random values) - temp.MC.matrix[j,8] <- NA - } - - } - - # set the De uncertainty as the standard deviations of the randomly generated des - De.error <- sd(temp.MC.matrix[, 8], na.rm = TRUE) - - return(list( - DE = De, - DE.ERROR = De.error, - m.MC = temp.MC.matrix)) - }) - -# Plotting ---------------------------------------------------------------- - if(plot){ - old.par <- par(no.readonly = TRUE) - on.exit(par(old.par)) - - par(mfrow = c(mfrow = c(3,3))) - for (i in 1:length(l)) { - if(is.na(l[[i]][1])) next(); - - y_max <- max(l[[i]]$m.MC[, 1:2]) - plot(NA, NA, - xlab = "Dose [a.u.]", - ylab = "Norm. Signal", - xlim = c(0, 3000), - main = paste0("Dataset #", i), - ylim = c(0, y_max) - ) - - for(j in 1:nrow(l[[i]]$m.MC)){ - #y1 * (1 - exp(-De / D1)) + y2 * (1 - exp(-De / D2)) + y0 - x <- NA - curve( - l[[i]]$m.MC[j, 3] * (1 - exp(-x / l[[i]]$m.MC[j, 4])) + - l[[i]]$m.MC[j, 5] * (1 - exp(-x / l[[i]]$m.MC[j, 6])) + - l[[i]]$m.MC[j, 7], - col = rgb(0,0,0,0.4), - add = TRUE) - } - - par(new = TRUE) - hist <- hist(na.exclude(l[[i]]$m.MC[, 8]), - plot = FALSE - ) - - hist$counts <- ((y_max/max(hist$counts)) * hist$counts) / 2 - plot( - hist, - xlab = "", - ylab = "", - axes = FALSE, - xlim = c(0, 3000), - ylim = c(0, y_max), - main = "" - ) - - } - - } - - -# Return ------------------------------------------------------------------ - - ##output matrix - m <- matrix(ncol = 4, nrow = nrow(data)) - - ##calculate a few useful parameters - for(i in 1:nrow(m)){ - if(is.na(l[[i]][1])) next(); - - m[i,1] <- l[[i]]$DE - m[i,2] <- l[[i]]$DE.ERROR - - HPD <- .calc_HPDI(na.exclude(l[[i]]$m.MC[,8])) - m[i,3] <- HPD[1,1] - m[i,4] <- HPD[1,2] - - } - - df <- data.frame( - DE = m[, 1], - DE.ERROR = m[, 2], - HPD95_LOWER = m[, 3], - HPD95_UPPER = m[, 4] - ) - - return( - set_RLum("RLum.Results", - data = list( - data = df, - m.MC = lapply(l, function(x) {if(is.na(x[[1]])) {return(x)} else {x$m.MC} }) - ), - info = list( - call = sys.call() - ) - )) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/combine_De_Dr.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/combine_De_Dr.R deleted file mode 100644 index 01500a709..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/combine_De_Dr.R +++ /dev/null @@ -1,827 +0,0 @@ -#'@title Estimate Individual Age using Bayesian Inference -#' -#'@description A Bayesian robust estimation of central age from equivalent dose -#' measurements under the assumption that the dose rate is modelled by a -#' finite Gaussian mixture model. -#' -#'@param theta [numeric] (**required**): the weight vector of the Gaussian mixture -#' -#'@param mu [numeric] (**required**): is the mean vector of the Gaussian mixture -#' -#'@param sigma [numeric] (**required**): is the standard deviation vector of the Gaussian mixture -#' -#'@param De [numeric] (**required**): the equivalent dose sample -#' -#'@param s [numeric] (**required**): the vector of measurement errors on De. -#' -#'@param sig0 [numeric] (**required**): the prior shrinkage parameter -#' -#'@param Age_range [numeric] (*with default*): the age range to investigate -#' -#'@param method_control [list] (*with default*): parameters passed down -#' to the jags process -#' -#'@param verbose [logical] (*with default*): enable/disable terminal feedback -#' -#'@return An [RLum.Results-class] object to be used in [combine_De_Dr] -#' -#'@section Function version: 0.1.0 -#' -#'@note The function is intended to be called by [combine_De_Dr], however, for -#' reasons of transparency -#' -#'@author Anne Philippe, Université de Nantes (France), -#' Jean-Michel Galharret, Université de Nantes (France), -#' Norbert Mercier, IRAMAT-CRP2A, Université Bordeaux Montaigne (France), -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#'@examples -#' n <- 1000 -#' sdt <- 0.3 -#' Dr <- stats::rlnorm (n, 0, sdt) -#' int_OD <- 0.1 -#' tildeDr = Dr * (1 + rnorm(length(Dr), 0, int_OD)) -#' De <- c(50 * sample(Dr, 50, replace = TRUE), 10, 12, 200, 250) -#' k <- length(De) -#' s <- stats::rnorm(k, 10, 2) -#' a <- De / mean(tildeDr) -#' sig_a2 <- a ^ 2 * (s / De) ^ 2 -#' sig0 <- sqrt(1 / mean(1 / sig_a2)) -#' fit <- mclust::Mclust(tildeDr, model = "V") -#' theta <- fit$parameters$pro -#' mu <- fit$parameters$mean -#' sigma <- sqrt(fit$parameters$variance$sigmasq) -#' Age_range <- c(0, Dr * (1 + rnorm(length(Dr), 0, int_OD[1]))) -#' res <- .calc_IndividualAgeModel(theta, mu, sigma, De, s, sig0, Age_range = Age_range) -#'@md -#'@noRd -.calc_IndividualAgeModel <- function( - theta, - mu, - sigma, - De, - s, - sig0, - Age_range, - method_control = list(), - verbose = TRUE -){ - - # Set parameters and models ----------------------------------------------- - nobs <- length(De) - event1 <- "model{ - for( i in 1 : N ) { - D_e[i] ~ dnorm(a[i] * mu, tau[i]) - tau[i] <- 1 / (a[i] * sigma) ^ 2 - De[i] ~ dnorm(D_e[i], prec2[i]) - a[i] ~ dnorm(A, prec_a[i]) - u[i] ~ dunif(0,1) - prec_a[i] <- 1 / s02 * u[i] / (1 - u[i]) - prec2[i] <- 1 / (s2[i]) - sig_a[i] <- 1 / sqrt(prec_a[i]) - } - A ~ dunif(Amin, Amax) - }" - - event2 <- "model{ - for( i in 1 : N ) { - D_e[i] ~ dnorm(a[i] * mu[z[i]], tau[i]) - tau[i] <- 1 / (a[i] * sigma[z[i]]) ^ 2 - z[i] ~ dcat(theta) - De[i] ~ dnorm(D_e[i], prec2[i]) - a[i] ~ dnorm(A, prec_a[i]) - u[i] ~ dunif(0, 1) - prec_a[i] <- 1 / s02 * u[i] / (1 - u[i]) - prec2[i] <- 1 / (s2[i]) - sig_a[i] <- 1 / sqrt(prec_a[i]) - } - A ~ dunif(Amin, Amax) - }" - - data1 <- list( - 'theta' = theta, - 'mu' = mu, - 'sigma' = sigma, - 'N' = nobs , - 'De' = De, - 's2' = s ^ 2, - 's02' = sig0[1] ^ 2, - 'Amin' = Age_range[1], - 'Amax' = Age_range[2] - ) - - # Run Bayesian model ------------------------------------------------------ - method_control <- modifyList( - x = list( - variable.names = c('A', 'a', 'sig_a'), - n.chains = 4, - n.adapt = 1000, - n.iter = 5000, - thin = 1, - progress.bar = if(verbose) "text" else "none", - quiet = if(verbose) FALSE else TRUE, - diag = if(verbose) TRUE else FALSE, - return_mcmc = FALSE - ), - val = method_control) - - on.exit(close(model)) - ## select model - if(length(theta) == 1) { - data1$theta <- NULL - model <- textConnection(event1) - - } else { - model <- textConnection(event2) - - } - - ## run model - if(verbose) cat("(1) Running Bayesian modelling 'Individual Age Model' ... ") - - jags <- rjags::jags.model( - file = model, - data = data1, - n.chains = method_control$n.chains, - n.adapt = method_control$n.adapt, - quiet = method_control$quiet - ) - - stats::update( - jags, - n.iter = method_control$n.iter, - progress.bar = method_control$progress.bar, - quiet = method_control$quiet - ) - - samp <- - rjags::coda.samples( - model = jags, - variable.names = method_control$variable.names, - n.iter = method_control$n.iter, - thin = method_control$thin, - progress.bar = method_control$progress.bar - ) - - if(verbose & method_control$quiet) cat("DONE") - if(method_control$diag) { - cat("\n[.calc_IndividualAgeModel()]\n") - print(coda::gelman.diag(samp)) - - } - - # Return ------------------------------------------------------------------ - return(set_RLum( - "RLum.Results", - data = list( - A = unlist(samp[, "A"]), - a = do.call(rbind, samp[, 2:(nobs + 1)]), - sig_a = do.call(rbind, samp[, (2 + nobs):(2 * nobs + 1)]), - model = paste(jags$model(), ""), - mcmc_IAM = if(method_control$return_mcmc) samp else NULL), - info = list(call = sys.call()) - )) -} - - -#'@title Central Bayesian Central Age Model -#' -#'@description A Bayesian estimation of central age from equivalent dose measurements -#'under the assumption that the dose rate is modelled by finite Gaussian mixture model. -#'MCMC outputs provide to JAGS program. -#' -#'@param theta [numeric] (**required**): the weight vector of the Gaussian mixture -#' -#'@param mu [numeric] (**required**): is the mean vector of the Gaussian mixture -#' -#'@param sigma [numeric] (**required**): is the standard deviation vector of the Gaussian mixture -#' -#'@param De [numeric] (**required**): the equivalent dose sample -#' -#'@param s [numeric] (**required**): the vector of measurement errors on De. -#' -#'@param Age_range [numeric] (*with default*): the age range to investigate -#' -#'@param method_control [list] (*with default*): parameters passed down to the jags process -#' -#'@param verbose [logical] (*with default*): enable/disable terminal feedback -#' -#'@return An [RLum.Results-class] object -#' -#'@section Function version: 0.1.0 -#' -#'@author Anne Philippe, Université de Nantes (France), -#'Jean-Michel Galharret, Université de Nantes (France), -#'Norbert Mercier, IRAMAT-CRP2A, Université Bordeaux Montaigne (France), -#'Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#'@md -#'@noRd -.calc_BayesianCentralAgeModel <- function( - theta, - mu, - sigma, - De, - s, - Age_range, - method_control = list(), - verbose = TRUE -){ - - # Set models -------------------------------------------------------------- - central_age_model1 <- " - model{ - for( i in 1:J) { - D_e[i] ~ dnorm(A*mu,1/(A*sigma)^2) - De[i] ~ dnorm(D_e[i], prec2[i]) - prec2[i] <- 1/(s2[i]) - } - - A ~ dunif(Amin,Amax) - }" - - central_age_model2 <- " - model{ - for( i in 1:J) { - D_e[i] ~ dnorm(A*mu[z[i]],tau[i]) - tau[i]<-1/(A*sigma[z[i]])^2 - z[i] ~ dcat(theta) - De[i] ~ dnorm(D_e[i], prec2[i]) - prec2[i] <- 1/(s2[i]) - } - - A ~ dunif(Amin,Amax) - }" - - # Run Bayesian modelling -------------------------------------------------- - method_control <- modifyList( - x = list( - variable.names = c('A', 'D_e'), - n.chains = 4, - n.adapt = 1000, - n.iter = 5000, - thin = 1, - progress.bar = if(verbose) "text" else "none", - quiet = if(verbose) FALSE else TRUE, - diag = if(verbose) TRUE else FALSE, - return_mcmc = FALSE - ), - val = method_control) - - on.exit(close(model)) - data <- - list( - 'theta' = theta, - 'mu' = mu, - 'sigma' = sigma, - 'De' = De, - 'J' = length(De), - 's2' = s ^ 2, - 'Amin' = Age_range[1], - 'Amax' = Age_range[2] - ) - - ## select model - if(length(theta) == 1) { - data$theta <- NULL - model <- textConnection(central_age_model1) - - } else { - model <- textConnection(central_age_model2) - - } - - ## run modelling - if(verbose) cat("\n(2) Running Bayesian modelling 'Bayesian Central Age Model' ... ") - - jags2 <- rjags::jags.model( - file = model, - data = data, - n.chains = method_control$n.chains, - n.adapt = method_control$n.adapt, - quiet = method_control$quiet - ) - - stats::update( - object = jags2, - n.iter = method_control$n.iter, - progress.bar = method_control$progress.bar, - quiet = method_control$quiet - ) - - samp2 <- rjags::coda.samples( - model = jags2, - variable.names = method_control$variable.names, - n.iter = method_control$n.iter, - thin = method_control$thin, - progress.bar = method_control$progress.bar - ) - - if(verbose & method_control$quiet) cat("DONE\n") - - if(method_control$diag) { - cat("\n[.calc_BayesianCentralAgeModel()]\n") - print(coda::gelman.diag(samp2)) - - } - - # Return ------------------------------------------------------------------ - return(set_RLum( - "RLum.Results", - data = list( - A = unlist(samp2[, "A"]), - D_e = do.call(rbind, samp2[, -1]), - model = paste(jags2$model(), ""), - mcmc_BCAM = if(method_control$return_mcmc) samp2 else NULL), - info = list(call = sys.call()) - )) - -} - -#'@title Combine Dose Rate and Equivalent Dose Distribution -#' -#'@description A Bayesian statistical analysis of OSL age requiring dose rate sample. -#'Estimation contains a preliminary step for detecting outliers in the equivalent -#'dose sample. -#' -#'@details -#' -#'**Outlier detection** -#' -#'Two different outlier detection methods are implemented (full details are given -#'in the cited literature). -#' -#'1. The *default* and recommend method, uses quantiles to compare prior and -#'posterior distributions of the individual variances of the equivalent doses. -#'If the corresponding quantile in the corresponding posterior distribution is larger -#'than the quantile in the prior distribution, the value is marked -#'as outlier (cf. Galharret et al., preprint) -#' -#'2. The alternative method employs the method suggested by Rousseeuw and Croux (1993) -#'using the absolute median distance. -#' -#'**Parameters available for `method_control`** -#' -#'The parameters listed below are used to granular control Bayesian modelling using -#'[rjags::rjags]. Internally the functions `.calc_IndividualAgeModel()` and -#'`.calc_BayesianCentraAgelModel()`. The parameter settings affect both models. -#'Note: `method_control` expects a **named** list of parameters -#' -#'\tabular{llll}{ -#' **PARAMETER** \tab **TYPE** \tab **DEFAULT** \tab **REMARKS** \cr -#' `variable.names_IAM` \tab [character] \tab `c('A', 'a', 'sig_a')` \tab variables names to be monitored in the modelling process using the internal function `.calc_IndividualAgeModel()`\cr -#' `variable.names_BCAM` \tab [character] \tab `c('A', 'D_e')` \tab variables names to be monitored in the modelling process using the internal function `.calc_BayesianCentraAgelModel()`\cr -#' `n.chains` \tab [integer] \tab `4` \tab number of MCMC chains\cr -#' `n.adapt` \tab [integer] \tab `1000` \tab number of iterations for the adaptation\cr -#' `n.iter` \tab [integer] \tab `5000` \tab number of iterations to monitor cf. [rjags::coda.samples]\cr -#' `thin` \tab [numeric] \tab `1` \tab thinning interval for the monitoring cf. [rjags::coda.samples]\cr -#' `diag` \tab [logical] \tab `FALSE` \tab additional terminal convergence diagnostic. -#' `FALSE` if `verbose = FALSE`\cr -#' `progress.bar` \tab [logical] \tab `FALSE` \tab enable/disable progress bar. `FALSE` if `verbose = FALSE`\cr -#' `quiet` \tab [logical] \tab `TRUE` \tab silence terminal output. Set to `TRUE` if `verbose = FALSE`\cr -#' `return_mcmc`\tab [logical] \tab `FALSE` \tab return additional MCMC diagnostic information\cr -#'} -#' -#'@param De [numeric] (**required**): a equivalent dose sample -#' -#'@param s [numeric] (**required**): a vector of measurement errors on the equivalent dose -#' -#'@param Dr [numeric] (**required**): a dose rate sample -#' -#'@param int_OD [numeric] (**required**): the intrinsic overdispersion, typically the standard deviation -#'characterizing a dose-recovery test distribution -#' -#'@param Age_range [numeric] (*with default*): the age range to be investigated by the algorithm, the larger -#'the value the more iterations are needed and the longer it takes. Should not be set too narrow, cut -#'the algorithm some slack. -#' -#'@param outlier_threshold [numeric] (*with default*): the required significance level used -#'for the outlier detection. If set to `1`, no outliers are removed. If -#'`outlier_method = "RousseeuwCroux1993"`, the median distance is used as outlier threshold. -#'Please see details for further information. -#' -#'@param outlier_method [character] (*with default*): select the outlier detection -#'method, either `"default"` or `"RousseeuwCroux1993"`. See details for further information. -#' -#'@param outlier_analysis_plot [logical] (*with default*): enables/disables the outlier analysis plot. Note: the outlier analysis will happen with or without plot output -#' -#'@param method_control [list] (*with default*): named [list] of further parameters passed down -#' to the [rjags::rjags] modelling -#' -#'@param par_local [logical] (*with default*): if set to `TRUE` the function uses its -#'own [graphics::par] settings (which will end in two plots next to each other) -#' -#'@param verbose [logical] (*with default*): enable/disable terminal feedback -#' -#'@param plot [logical] (*with default*): enable/disable plot output -#' -#'@param ... a few further arguments to fine-tune the plot output such as -#'`cdf_ADr_quantiles` (`TRUE`/`FALSE`), `legend.pos`, `legend` (`TRUE`/`FALSE`) -#' -#'@return The function returns a plot if `plot = TRUE` and an [RLum.Results-class] -#'object with the following slots: -#' -#' `@data`\cr -#' `.. $Ages`: a [numeric] vector with the modelled ages to be further analysed or visualised\cr -#' `.. $Ages_stats`: a [data.frame] with sum HPD, CI 68% and CI 95% for the ages \cr -#' `.. $outliers_index`: the index with the detected outliers\cr -#' `.. $cdf_ADr_mean` : empirical cumulative density distribution A * Dr (mean)\cr -#' `.. $cdf_ADr_quantiles` : empirical cumulative density distribution A * Dr (quantiles .025,.975)\cr -#' `.. $cdf_De_no_outlier` : empirical cumulative density distribution of the De with no outliers\cr -#' `.. $cdf_De_initial` : empirical cumulative density distribution of the initial De\cr -#' `.. $mcmc_IAM` : the MCMC list of the Individual Age Model, only of `method_control = list(return_mcmc = TRUE)` otherwise `NULL`\cr -#' `.. $mcmc_BCAM` : the MCMC list of the Bayesian Central Age Model, only of `method_control = list(return_mcmc = TRUE)` otherwise `NULL`\cr -#' -#' `@info`\cr -#' `.. $call`: the original function call\cr -#' `.. $model_IAM`: the BUGS model used to derive the individual age\cr -#' `.. $model_BCAM`: the BUGS model used to calculate the Bayesian Central Age\cr -#' -#'@references -#' -#'Mercier, N., Galharret, J.-M., Tribolo, C., Kreutzer, S., Philippe, A., preprint. -#'Luminescence age calculation through Bayesian convolution of equivalent dose and -#'dose-rate distributions: the De_Dr model. Geochronology, 1-22. -#' -#'Galharret, J-M., Philippe, A., Mercier, N., preprint. Detection of outliers with -#'a Bayesian hierarchical model: application to the single-grain luminescence dating method. -#'Electronic Journal of Applied Statistics -#' -#'**Further reading** -#' -#'Rousseeuw, P.J., Croux, C., 1993. Alternatives to the median absolute deviation. -#'Journal of the American Statistical Association 88, 1273–1283. \doi{10.2307/2291267} -#' -#'Rousseeuw, P.J., Debruyne, M., Engelen, S., Hubert, M., 2006. Robustness and outlier detection in chemometrics. -#'Critical Reviews in Analytical Chemistry 36, 221–242. \doi{10.1080/10408340600969403} -#' -#'@author Anne Philippe, Université de Nantes (France), -#'Jean-Michel Galharret, Université de Nantes (France), -#'Norbert Mercier, IRAMAT-CRP2A, Université Bordeaux Montaigne (France), -#'Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#'@seealso [plot_OSLAgeSummary], [rjags::rjags], [mclust::mclust-package] -#' -#'@section Function version: 0.1.0 -#' -#'@keywords dplot distribution datagen -#' -#'@examples -#'## set parameters -#' Dr <- stats::rlnorm (1000, 0, 0.3) -#' De <- 50*sample(Dr, 50, replace = TRUE) -#' s <- stats::rnorm(50, 10, 2) -#' -#'## run modelling -#'## note: modify parameters for more realistic results -#'\dontrun{ -#'results <- combine_De_Dr( -#' Dr = Dr, -#' int_OD = 0.1, -#' De, -#' s, -#' Age_range = c(0,100), -#' method_control = list( -#' n.iter = 100, -#' n.chains = 1)) -#' -#'## show models used -#'writeLines(results@info$model_IAM) -#'writeLines(results@info$model_BCAM) -#'} -#' -#'@md -#'@export -combine_De_Dr <- function( - De, - s, - Dr, - int_OD, - Age_range = c(1,300), - outlier_threshold = .05, - outlier_method = "default", - outlier_analysis_plot = FALSE, - method_control = list(), - par_local = TRUE, - verbose = TRUE, - plot = TRUE, - ... -) { - -# Check input data -------------------------------------------------------- -if (!all(t_pkg <- c( - requireNamespace("rjags", quietly = TRUE), - requireNamespace("coda", quietly = TRUE), - requireNamespace("mclust", quietly = TRUE)))) { - # nocov start - t_names <- c('rjags', 'coda', 'mclust') - stop(paste0("[combine_De_Dr()] To use this function you have to first - install the package(s) ", paste(t_names[!t_pkg], collapse = ",")), - call. = FALSE) - # nocov end -} - -# Integrity checks -------------------------------------------------------- - if(length(De) != length(s)) - stop("[combine_De_Dr()] 'De' and 's' are not of similar length!", call. = FALSE) - -# Prepare data ------------------------------------------------------------ - ## we have to fetch the function otherwise - ## we would need it in import instead of suggests - mclustBIC <- mclust::mclustBIC - - ## Estimation of the rate dose Dr1 by a Gaussian Mixture Model - tildeDr <- Dr * (1 + rnorm(length(Dr), 0, int_OD[1])) - fit <- - mclust::Mclust(data = tildeDr, - modelNames = "V", - verbose = FALSE) - - theta <- fit$parameters$pro - mu <- fit$parameters$mean - sigma <- sqrt(fit$parameters$variance$sigmasq) - a <- De / mean(tildeDr) - sig_a2 <- a ^ 2 * (s / De) ^ 2 - sig0 <- sqrt(1 / mean(1 / sig_a2)) - -# Set parameters ---------------------------------------------------------- - method_control <- modifyList( - x = list( - variable.names_IAM = c('A', 'a', 'sig_a'), - variable.names_BCAM = c('A', 'D_e'), - n.chains = 4, - n.adapt = 1000, - n.iter = 5000, - thin = 1, - progress.bar = "none", - quiet = TRUE, - diag = FALSE, - return_mcmc = FALSE - ), - val = method_control) - -# Bayesian Modelling IAM -------------------------------------------------- -if(verbose) cat("\n[combine_De_Dr()]\n") - -fit_IAM <- .calc_IndividualAgeModel( - theta = theta, - mu = mu, - sigma = sigma, - De = De, - s = s, - sig0 = sig0, - Age_range = Age_range[1:2], - verbose = verbose, - method_control = list( - variable.names = method_control$variable.names_IAM, - n.chains = method_control$n.chains, - n.adapt = method_control$n.adapt, - n.iter = method_control$n.iter, - thin = method_control$thin, - progress.bar = method_control$progress.bar, - quiet = method_control$quiet, - diag = method_control$diag, - return_mcmc = method_control$return_mcmc) - ) - -# Outlier detection ------------------------------------------------------- - ## set threshold for outliers - alpha <- outlier_threshold[1] - - ## apply method ... default is method develop by Jean-Michel and Anne - if(outlier_method == "RousseeuwCroux1993") { - ## calculate the median of the sig_a - xj <- log(matrixStats::colMedians(fit_IAM$sig_a)) - MAD <- 1.483 * median(abs(xj - median(xj))) - test <- (xj - median(xj)) / MAD - out <- sort(which(test > alpha)) - - } else { - sig_max <- sig0 * ((1 - alpha) / alpha) ^ .5 - test <- vapply(1:length(De), function(j){ - mean(fit_IAM$sig_a[, j] >= sig_max) - - }, numeric(1)) - - out <- sort(which(test > alpha)) - } - - ##some terminal output - if(verbose){ - if (length(out) > 0) { - cat( - paste0( - "\n >> Outliers detected: ", - length(out), "/", length(De), - " (", round(length(out) / length(De) * 100, 1), "%)" - ) - ) - } - } - - ## apply the removal - if (length(out) == 0) { - De1 <- De - s1 <- s - - } else { - De1 <- De[-out] - s1 <- s[-out] - } - -# Bayesian modelling BCAM ------------------------------------------------- - fit_BCAM <- .calc_BayesianCentralAgeModel( - theta, - mu, - sigma, - De = De1, - s = s1, - Age_range = Age_range, - verbose = verbose, - method_control = list( - variable.names = method_control$variable.names_BCAM, - n.chains = method_control$n.chains, - n.adapt = method_control$n.adapt, - n.iter = method_control$n.iter, - thin = method_control$thin, - progress.bar = method_control$progress.bar, - quiet = method_control$quiet, - diag = method_control$diag, - return_mcmc = method_control$return_mcmc) - ) - -# Calculate EDFC ------------------------------------------------- - ## calculate various parameters - D_e <- fit_BCAM$D_e - A2 <- fit_BCAM$A - - ## calculate bandwidths - h <- density(De)$bw - h1 <- density(De1)$bw - - t <- seq(min(D_e), max(D_e), length.out = min(1000, round(max(D_e) - min(D_e), 0))) - - ind <- min(5000, length(A2)) - subsamp <- sample(1:length(A2), ind, replace = FALSE) - cdf_ADr <- matrix(0, nrow = ind, ncol = length(t)) - - ## De distribution re-sampled without outliers -> De2 - ## De distribution re-sampled initial -> De3 - De2 <- - rnorm(length(subsamp), sample(De1, size = length(subsamp), replace = TRUE), h1) - De3 <- - rnorm(length(subsamp), sample(De, size = length(subsamp), replace = TRUE), h) - - ## calculate ecdf - cdf_De_no_outlier<- stats::ecdf(De2)(t) - cdf_De_initial <- stats::ecdf(De3)(t) - - for (i in 1:ind) - cdf_ADr[i, ] <- stats::ecdf(A2[subsamp[i]] * tildeDr)(t) - - ## calculate mean value and quantiles for the ecdf A * Dr - cdf_ADr_mean <- matrixStats::colMeans2(cdf_ADr) - cdf_ADr_quantiles <- matrixStats::colQuantiles(cdf_ADr, probs = c(.025,.975)) - - ## further values to ease the interpretation - d <- density(fit_BCAM$A) - HPD <- d$x[which.max(d$y)[1]] - CI_68 <- .calc_HPDI(fit_BCAM$A, prob = 0.68) - CI_95 <- .calc_HPDI(fit_BCAM$A, prob = 0.95) - -# Additional terminal output ---------------------------------------------- -if(verbose){ - cat("(3) Age results (presumably in ka) \n") - cat(" -----------------------------------\n") - cat(" Age (HPD) :\t", format(round(HPD,2), nsmall = 2), "\n") - cat(" Age (CI 68%):\t", paste(format(round(range(CI_68),2), nsmall =2), collapse = " : "), "\n") - cat(" Age (CI 95%):\t", paste(format(round(range(CI_95),2), nsmall =2), collapse = " : "), "\n") - cat(" -----------------------------------\n") - -} - -# Plotting ---------------------------------------------------------------- -if(plot){ - ##check incoming plot settings - plot_settings <- modifyList(x = list( - cdf_ADr_quantiles = FALSE, - legend = TRUE, - legend.pos = "bottomright" - ), list(...)) - - ##make sure we reset plots - if(par_local) { - old.par <- par(mfrow = c(1, 2)) - on.exit(par(old.par)) - - } - - if(outlier_analysis_plot){ - N <- length(De) - - ##plot with outliers - boxplot(fit_IAM$sig_a, outline = FALSE, - col = (abs(as.numeric( - 1:length(De) %in% out - ) - 1) + 2), - main = "Outlier detection", - xaxt = "n", - xlab = expression(paste("Index of ", sigma[a]))) - - ## add axis - axis(side = 1, at = 1:length(De), labels = 1:length(De), ) - mtext( - text = paste0(length(out), "/", N, " (", round(length(out) / N * 100, 1), "%)"), - side = 3, - cex = 0.8 - ) - abline(h = sig0, col = "violet") - - ##plot sd of outliers - if(length(out) > 0){ - boxplot(fit_IAM$sig_a[, out], - outline = FALSE, - names = out, - ylab = "Individual sd [a.u.]", - main = "Outliers: posterior distr.") - - abline(h = sig0, col = "violet") - - - } else { - shape::emptyplot() - text(0.5, 0.5, "No outlier detected!") - - } - } - - ##plot age summary - plot_OSLAgeSummary( - object = fit_BCAM, - level = 0.68, - rug = FALSE, - polygon_col = rgb(100, 149, 237, 75, maxColorValue = 255), - verbose = FALSE - ) - - ## open plot area - plot(NA, - xlim = range(t), - ylim = c(0, 1), - ylab = "ecdf (mean)", - xlab = "Dose [Gy]", - main= "ECDF") - - ## add quantile range (only for A * Dr) - if(plot_settings$cdf_ADr_quantiles){ - polygon( - x = c(t, rev(t)), - y = c(cdf_ADr_quantiles[,1], rev(cdf_ADr_quantiles[,2])), - col = rgb(1,0,0,0.2), lty = 0) - } - - ##add mean lines for the ecdfs - lines(t, cdf_ADr_mean, col = 2, lty = 1, lwd = 2) - lines(t, cdf_De_no_outlier, type = "l", col = 3, lty = 2, lwd = 2) - lines(t, cdf_De_initial, type = "l", col = 4, lty = 3, lwd = 2) - - if(plot_settings$legend){ - legend( - plot_settings$legend.pos, - legend = c( - expression(A %*% Dr), - expression(paste(D[e], " no outliers")), - expression(paste(D[e], " initial"))), - lty = c(1,2,3), - bty = "n", - col = c(2,3,4), - cex = 0.8) - } -} - -# Return results ---------------------------------------------------------- - return(set_RLum( - "RLum.Results", - data = list( - Ages = fit_BCAM$A, - Ages_stats = data.frame( - HPD = HPD, - CI_68_lower = CI_68[1], - CI_68_upper = CI_68[2], - CI_95_lower = CI_95[1], - CI_95_upper = CI_95[2]), - outliers_index = out, - cdf_ADr_mean = cdf_ADr_mean, - cdf_ADr_quantiles = cdf_ADr_quantiles, - cdf_De_no_outlier = cdf_De_no_outlier, - cdf_De_initial = cdf_De_initial, - mcmc_IAM = fit_IAM$mcmc_IAM, - mcmc_BCAM = fit_BCAM$mcmc_BCAM - ), - info = list( - call = sys.call(), - model_IAM = fit_IAM$model, - model_BCAM = fit_BCAM$model) - )) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_Activity2Concentration.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_Activity2Concentration.R deleted file mode 100644 index 06632bb23..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_Activity2Concentration.R +++ /dev/null @@ -1,192 +0,0 @@ -#' @title Convert Nuclide Activities to Abundance and Vice Versa -#' -#' @description The function performs the conversion of the specific activities into -#' mass abundance and vice versa for the radioelements U, Th, and K to -#' harmonise the measurement unit with the required data input unit of -#' potential analytical tools for, e.g. dose rate calculation or related -#' functions such as [use_DRAC]. -#' -#' @details The conversion from nuclide activity of a sample to nuclide concentration -#' is performed using conversion factors that are based on the mass-related -#' specific activity of the respective nuclide. -#' -#' Constants used in this function were obtained from `https://physics.nist.gov/cuu/Constants/` -#' all atomic weights and composition values from -#' `https://www.nist.gov/pml/atomic-weights-and-isotopic-compositions-relative-atomic-masses` -#' and the nuclide data from `https://www.iaea.org/resources/databases/livechart-of-nuclides-advanced-version` -#' -#' The factors can be calculated using the equation: -#' -#' \deqn{ -#' A = N_A \frac{N_{abund}}{N_{mol.mass}} ln(2) / N.half.life -#' } -#' -#' to convert in µg/g we further use: -#' -#' \deqn{ -#' f = A / 10^6 -#' } -#' -#' where: -#' -#' - `N_A` - Avogadro constant in 1/mol -#' - `A` - specific activity of the nuclide in Bq/kg -#' - `N.abund` - relative natural abundance of the isotope -#' - `N.mol.mass` molar mass in kg/mol -#' - `N.half.life` half-life of the nuclide in s -#' -#' example for calculating the activity of the radionuclide U-238: -#' -#' * `N_A` = 6.02214076e+23 (1/mol) -#' * `T_0.5` = 1.41e+17 (s) -#' * `m_U_238` = 0.23802891 (kg/mol) -#' * `U_abund` = 0.992745 (unitless) -#' -#' \deqn{A_{U} = N_{A} * U_{abund} / m_{U_238} * ln(2) / T_{1/2} = 2347046} (Bq/kg) -#' -#' \deqn{f.U = A_{U} / 10^6} -#' -#' @param data [data.frame] **(required)**: -#' provide dose rate data (activity or concentration) in three columns. -#' The first column indicates the nuclide, the 2nd column measured value and -#' in the 3rd column its error value. Allowed nuclide data are -#' `'U-238'`, `'Th-232'` and `'K-40'`. See examples for an example. -#' -#' @param input_unit [character] (*with default*): -#' specify unit of input data given in the dose rate data frame, choose between -#' `"activity"` (considered as given Bq/kg) and `"abundance"` (considered as given in mug/g or mass. %). -#' The default value is `"activity"` -#' -#' @param verbose [logical] (*with default*): -#' enable or disable verbose mode -#' -#' @section Function version: 0.1.2 -#' -#' @author Margret C. Fuchs, Helmholtz-Institute Freiberg for Resource Technology (Germany) -#' -#' @references -#' Debertin, K., Helmer, R.G., 1988. Gamma- and X-ray Spectrometry with -#' Semiconductor Detectors, Elsevier Science Publishers, p.283 -#' -#' Wiechen, A., Ruehle, H., Vogl, K., 2013. Bestimmung der massebezogenen -#' Aktivitaet von Radionukliden. AEQUIVAL/MASSAKT, ISSN 1865-8725, -#' [https://www.bmuv.de/fileadmin/Daten_BMU/Download_PDF/Strahlenschutz/aequival-massakt_v2013-07_bf.pdf]() -#' -#' @keywords IO -#' -#' @note Although written otherwise for historical reasons. Input values must be element values. -#' For instance, if a value is provided for U-238 the function assumes that this value -#' represents the sum (activity or abundance) of U-238, U-235 and U-234. -#' In other words, 1 µg/g of U means that this is the composition of 0.992 parts of U-238, -#' 0.000054 parts of U-234, and 0.00072 parts of U-235. -#' -#' @return Returns an [RLum.Results-class] object with a [data.frame] containing -#' input and newly calculated values. Please not that in the column header µg/g -#' is written as `mug/g` due to the R requirement to maintain packages portable using -#' ASCII characters only. -#' -#' @examples -#' -#' ##construct data.frame -#' data <- data.frame( -#' NUCLIDES = c("U-238", "Th-232", "K-40"), -#' VALUE = c(40,80,100), -#' VALUE_ERROR = c(4,8,10), -#' stringsAsFactors = FALSE) -#' -#' ##perform analysis -#' convert_Activity2Concentration(data) -#' -#' @md -#' @export -convert_Activity2Concentration <- function( - data, - input_unit = "activity", - verbose = TRUE - -){ - # Integrity checks ---------------------------------------------------------------------------- - if(missing(data)) - stop("[convert_Activity2Concentration()] I'm still waiting for input data ...", call. = FALSE) - - if(ncol(data)<3) - stop("[convert_Activity2Concentration()] Input data.frame should have at least three columns.", call. = FALSE) - - # Set output data.frame ----------------------------------------------------------------------- - output <- data.frame( - NUCLIDE = rep(NA, nrow(data)), - ACTIVIY = rep(NA, nrow(data)), - ACTIVIY_ERROR = rep(NA, nrow(data)), - CONC = rep(NA, nrow(data)), - CONC_ERROR = rep(NA, nrow(data)), - stringsAsFactors = FALSE - ) - - ##set column names - colnames(output) <- c( - "NUCLIDE", - "ACTIVIY (Bq/kg)", - "ACTIVIY ERROR (Bq/kg)", - "ABUND. (mug/g or mass. %)", - "ABUND. ERROR (mug/g or mass. %)") - - ##set column for output - output$NUCLIDE = data[[1]] - - ## check input unit - ## we silently let the old input values unflagged for back compatibility reasons - input_unit <- tolower(input_unit[1]) - if(!input_unit[1] %in% c("activity", "abundance", "bq/kg", "ppm/%")) - stop("[convert_Activity2Concentrations()] Input for parameter 'input_unit' invalid. Valid are 'activity' or 'abundance'!", - call. = FALSE) - - # Set conversion factors ---------------------------------------------------------------------- - - ############################################################################# - ### conversion factors - mass_constant <- 1.66053906660e-27 # in kg - - ## set conversion factors ... this are the expected activity per kg of the radionuclide - ## a = log(2) / ((unified_atomic_mass * mass_constant) / abundance) * T_0.5 - convers.factor.U238 <- log(2) / (((238.0507884 * mass_constant)/ 0.992742) * 1.409963e+17) / 1e+06 - convers.factor.Th232 <- log(2) / (((232.0380558 * mass_constant)/ 1) * 4.41797e+17) / 1e+06 - convers.factor.K40 <- log(2) / (((39.963998166 * mass_constant)/ 0.000117) * 3.9383e+16) / 1e+02 - - # Run conversion ------------------------------------------------------------------------------ - U <- which(data$NUCLIDE == "U-238") - Th <- which(data$NUCLIDE == "Th-232") - K <- which(data$NUCLIDE == "K-40") - - ##Activity to concentration - if(input_unit == "activity" || input_unit == "bq/kg"){ - output[U,4:5] <- data[U,2:3] / convers.factor.U238 - output[Th,4:5] <- data[Th,2:3] / convers.factor.Th232 - output[K,4:5] <- data[K,2:3] / convers.factor.K40 - - output[U,2:3] <- data[U,2:3] - output[Th,2:3] <- data[Th,2:3] - output[K,2:3] <- data[K,2:3] - - } - - ##Concentration to activity - if(input_unit == "abundance" || input_unit == "ppm/%"){ - output[U,2:3] <- data[U,2:3] * convers.factor.U238 - output[Th,2:3] <- data[Th,2:3] * convers.factor.Th232 - output[K,2:3] <- data[K,2:3] * convers.factor.K40 - - output[U,4:5] <- data[U,2:3] - output[Th,4:5] <- data[Th,2:3] - output[K,4:5] <- data[K,2:3] - - } - - # Return value -------------------------------------------------------------------------------- - if(verbose) print(output) - - invisible(set_RLum( - class = "RLum.Results", - data = list(data = output), - info = list(call = sys.call()))) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_BIN2CSV.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_BIN2CSV.R deleted file mode 100644 index 8a3999c46..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_BIN2CSV.R +++ /dev/null @@ -1,119 +0,0 @@ -#' Export Risoe BIN-file(s) to CSV-files -#' -#' This function is a wrapper function around the functions [read_BIN2R] and -#' [write_RLum2CSV] and it imports a Risoe BIN-file and directly exports its -#' content to CSV-files. If nothing is set for the argument `path` -#' ([write_RLum2CSV]) the input folder will become the output folder. -#' -#' @param file [character] (**required**): -#' name of the BIN-file to be converted to CSV-files -#' -#' @param ... further arguments that will be passed to the function -#' [read_BIN2R] and [write_RLum2CSV] -#' -#' @return -#' The function returns either a CSV-file (or many of them) or for the -#' option `export == FALSE` a list comprising objects of type [data.frame] and [matrix] -#' -#' @section Function version: 0.1.0 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum.Analysis-class], [RLum.Data-class], [RLum.Results-class], -#' [utils::write.table], [write_RLum2CSV], [read_BIN2R] -#' -#' @keywords IO -#' -#' @examples -#' -#' ##transform Risoe.BINfileData values to a list -#' data(ExampleData.BINfileData, envir = environment()) -#' convert_BIN2CSV(subset(CWOSL.SAR.Data, POSITION == 1), export = FALSE) -#' -#' \dontrun{ -#' ##select your BIN-file -#' file <- file.choose() -#' -#' ##convert -#' convert_BIN2CSV(file) -#' -#' } -#' -#' @md -#' @export -convert_BIN2CSV <- function( - file, - ... - -){ - - # General tests ------------------------------------------------------------------------------- - - ##file is missing? - if(missing(file)){ - stop("[convert_BIN2CSV()] file is missing!", call. = FALSE) - - } - - - ##set input arguments - convert_BIN2CSV_settings.default <- list( - path = if(!is(file, "Risoe.BINfileData")){dirname(file)}else{NULL}, - show.raw.values = FALSE, - position = NULL, - n.records = NULL, - zero_data.rm = TRUE, - duplicated.rm = FALSE, - show.record.number = FALSE, - txtProgressBar = TRUE, - forced.VersionNumber = NULL, - ignore.RECTYPE = FALSE, - pattern = NULL, - verbose = TRUE, - export = TRUE - - ) - - ##modify list on demand - convert_BIN2CSV_settings <- modifyList(x = convert_BIN2CSV_settings.default, val = list(...)) - - # Import file --------------------------------------------------------------------------------- - if(!is(file, "Risoe.BINfileData")){ - object <- read_BIN2R( - file = file, - show.raw.values = convert_BIN2CSV_settings$show.raw.values, - position = convert_BIN2CSV_settings$position, - n.records = convert_BIN2CSV_settings$n.records, - zero_data.rm = convert_BIN2CSV_settings$zero_data.rm, - duplicated.rm = convert_BIN2CSV_settings$duplicated.rm, - fastForward = TRUE, - show.record.number = convert_BIN2CSV_settings$show.record.number, - txtProgressBar = convert_BIN2CSV_settings$txtProgressBar, - forced.VersionNumber = convert_BIN2CSV_settings$forced.VersionNumber, - ignore.RECTYPE = convert_BIN2CSV_settings$ignore.RECTYPE, - pattern = convert_BIN2CSV_settings$pattern, - verbose = convert_BIN2CSV_settings$verbose - ) - - }else{ - object <- Risoe.BINfileData2RLum.Analysis(file) - - - } - - # Export to CSV ------------------------------------------------------------------------------- - - ##get all arguments we want to pass and remove the doubled one - arguments <- c(list(object = object, export = convert_BIN2CSV_settings$export), list(...)) - arguments[duplicated(names(arguments))] <- NULL - - ##this if-condition prevents NULL in the terminal - if(convert_BIN2CSV_settings$export == TRUE){ - invisible(do.call("write_RLum2CSV", arguments)) - - }else{ - do.call("write_RLum2CSV", arguments) - - } - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_Concentration2DoseRate.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_Concentration2DoseRate.R deleted file mode 100644 index 0cff07976..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_Concentration2DoseRate.R +++ /dev/null @@ -1,258 +0,0 @@ -#'@title Dose-rate conversion function -#' -#'@description This function converts radionuclide concentrations -#'(K in %, Th and U in ppm) into dose rates (Gy/ka). Beta-dose rates are also -#'attenuated for the grain size. Beta and gamma-dose rates are corrected -#'for the water content. This function converts concentrations into dose rates -#'(Gy/ka) and corrects for grain size attenuation and water content -#' -#'Dose rate conversion factors can be chosen from Adamiec and Aitken (1998), -#'Guerin et al. (2011), Liritzis et al. (201) and Cresswell et al. (2018). -#'Default is Guerin et al. (2011). -#' -#'Grain size correction for beta dose rates is achieved using the correction -#'factors published by Guérin et al. (2012). -#' -#'Water content correction is based on factors provided by Aitken (1985), -#'with the factor for beta dose rate being 1.25 and for gamma 1.14. -#' -#'@details -#' -#'**The input data** -#' -#'\tabular{lll}{ -#'COLUMN \tab DATA TYPE \tab DESCRIPTION\cr -#'`Mineral` \tab `character` \tab `'FS'` for feldspar, `'Q'` for quartz\cr -#'`K` \tab `numeric` \tab K nuclide content in %\cr -#'`K_SE` \tab `numeric` \tab error on K nuclide content in %\cr -#'`Th` \tab `numeric` \tab Th nuclide content in ppm\cr -#'`Th_SE` \tab `numeric` error on Th nuclide content in ppm\cr -#'`U` \tab `numeric` U nuclide content in ppm\cr -#'`U_SE` \tab `numeric` \tab error on U nuclide content in ppm\cr -#'`GrainSize` \tab `numeric` \tab average grain size in µm\cr -#'`WaterContent` \tab `numeric` \tab mean water content in %\cr -#'`WaterContent_SE` \tab `numeric` \tab relative error on water content -#'} -#' -#' -#'**Water content** -#'The water content provided by the user should be calculated according to: -#' -#'\deqn{(Wet_weight - Dry_weight) / Dry_weight * 100} -#' -#'The unit for the weight is gram (g). -#' -#'@param input [data.frame] (*optional*): a table containing all relevant information -#' for each individual layer if nothing is provided, the function returns a template [data.frame] -#' Please note that until one dataset per input is supported! -#' -#'@param conversion [character] (*with default*): which dose rate conversion factors to use, -#' defaults uses Guérin et al. (2011). For accepted values see [BaseDataSet.ConversionFactors] -#' -#'@return The function returns an [RLum.Results-class] object for which the first -#'element is [matrix] with the converted values. If no input is provided, the -#'function returns a template [data.frame] that can be used as input. -#' -#'@section Function version: 0.1.0 -#' -#'@author Svenja Riedesel, Aberystwyth University (United Kingdom) \cr -#'Martin Autzen, DTU NUTECH Center for Nuclear Technologies (Denmark) -#' -#'@references -#'Adamiec, G., Aitken, M.J., 1998. Dose-rate conversion factors: update. Ancient TL 16, 37-46. -#' -#'Cresswell., A.J., Carter, J., Sanderson, D.C.W., 2018. Dose rate conversion parameters: -#'Assessment of nuclear data. Radiation Measurements 120, 195-201. -#' -#'Guerin, G., Mercier, N., Adamiec, G., 2011. Dose-rate conversion factors: update. -#'Ancient TL, 29, 5-8. -#' -#'Guerin, G., Mercier, N., Nathan, R., Adamiec, G., Lefrais, Y., 2012. On the use -#'of the infinite matrix assumption and associated concepts: A critical review. -#'Radiation Measurements, 47, 778-785. -#' -#'Liritzis, I., Stamoulis, K., Papachristodoulou, C., Ioannides, K., 2013. -#'A re-evaluation of radiation dose-rate conversion factors. Mediterranean -#'Archaeology and Archaeometry 13, 1-15. -#' -#'@keywords datagen -#' -#'@examples -#' -#'## create input template -#'input <- convert_Concentration2DoseRate() -#' -#'## fill input -#'input$Mineral <- "FS" -#'input$K <- 2.13 -#'input$K_SE <- 0.07 -#'input$Th <- 9.76 -#'input$Th_SE <- 0.32 -#'input$U <- 2.24 -#'input$U_SE <- 0.12 -#'input$GrainSize <- 200 -#'input$WaterContent <- 30 -#'input$WaterContent_SE <- 5 -#' -#'## convert -#'convert_Concentration2DoseRate(input) -#' -#'@md -#'@export -convert_Concentration2DoseRate <- function( - input, - conversion = "Guerinetal2011" -){ - - -# Alternate mode ---------------------------------------------------------- - if(missing(input)){ - message("[convert_Concentration2DoseRate()] Input template returned. Please fill this data.frame and use it as input to the function!") - - df <- data.frame( - Mineral = NA_character_, - K = NA_integer_, - K_SE = NA_integer_, - Th = NA_integer_, - Th_SE = NA_integer_, - U = NA_integer_, - U_SE = NA_integer_, - GrainSize = NA_integer_, - WaterContent = NA_integer_, - WaterContent_SE = NA_integer_) - - return(df) - - } - - -# Load datasets ----------------------------------------------------------- - ## fulfil CRAN checks - BaseDataSet.ConversionFactors <- BaseDataSet.GrainSizeAttenuation <- NA - - ## load datasets - load(system.file("data", "BaseDataSet.ConversionFactors.rda", - package = "Luminescence")) - load(system.file("data", "BaseDataSet.GrainSizeAttenuation.rda", - package = "Luminescence")) - - ## we do this to be consistent with the code written by Svenja and Martin - GSA <- BaseDataSet.GrainSizeAttenuation - -# Integrity tests ------------------------------------------------------------ - if(!inherits(input, "data.frame") & !inherits(input, "matrix")) - stop("[convert_Concentration2DoseRate()] input must be of type 'data.frame or 'matrix'!", - call. = FALSE) - - if(ncol(input) != ncol(suppressMessages(convert_Concentration2DoseRate())) || nrow(input) > 1) - stop("[convert_Concentration2DoseRate()] number of rows/columns in input does not match the requirements. See manual!", - call. = FALSE) - - if(!conversion[1] %in% names(BaseDataSet.ConversionFactors)) - stop("[convert_Concentration2DoseRate()] You have not entered a valid conversion. Please check your spelling and consult the documentation!", - call. = FALSE) - - if(!any(input[,1] %in% c("FS","Q"))) - stop("[convert_Concentration2DoseRate()] As mineral only 'FS' or 'Q' is supported!", call. = FALSE) - -# Convert ----------------------------------------------------------------- - InfDR <- matrix(data = NA, nrow = 2, ncol = 6) - colnames(InfDR) <- c("K","SE","Th","SE","U","SE") - rownames(InfDR) <- c("Beta","Gamma") - - ### --- BETA DOSE RATES - for (i in 1:3){ - if (i == 1){ - Col <- "K" - } else if (i == 2){ - Col <- "Th" - } else { - Col <- "U" - } - - for (j in 1:2){ - if (j== 1){ - Temp = "beta" - } else { - Temp = "gamma" - } - - Nuclide <- i * 2 - N <- 2 * i - 1 - Error <- Nuclide + 1 - InfDR[j, N] <- - input[1, Nuclide] * BaseDataSet.ConversionFactors[[conversion]][[Temp]][[Col]][1] # Calculate Dose Rate - InfDR[j, Nuclide] <- - sqrt((input[1, Error] / input[1, Nuclide]) ^ 2 + ( - BaseDataSet.ConversionFactors[[conversion]][[Temp]][[Col]][2] / - BaseDataSet.ConversionFactors[[conversion]][[Temp]][[Col]][1] - ) ^ 2 - ) # Calculate Error - } - } - - ##### --- dose rate for grain size --- ##### - - if (input[1,1] == "FS") { # FELDSPAR - KFit <- approx(GSA$GrainSize, GSA$FS_K, n = 981, method = "linear") - ThFit <- approx(GSA$GrainSize, GSA$FS_Th,n = 981, method = "linear") - UFit <- approx(GSA$GrainSize, GSA$FS_U, n = 981, method = "linear") - - Temp <- which(KFit$x == input[1, 8]) - - InfDR[1, 1] <- InfDR[1, 1] * (1 - KFit$y[Temp]) # K - InfDR[1, 3] <- InfDR[1, 3] * (1 - ThFit$y[Temp]) # Th - InfDR[1, 5] <- InfDR[1, 5] * (1 - UFit$y[Temp]) # U - - } else if (input[1,1] == "Q") { # QUARTZ - KFit <- approx(GSA$GrainSize, GSA$Q_K, n = 981, method = "linear") - ThFit <- approx(GSA$GrainSize, GSA$Q_Th, n = 981, method = "linear") - UFit <- approx(GSA$GrainSize, GSA$Q_U, n = 981, method = "linear") - - Temp <- which(KFit$x == input[1, 8]) - InfDR[1, 1] <- InfDR[1, 1] * (1 - KFit$y[Temp]) # K - InfDR[1, 3] <- InfDR[1, 3] * (1 - ThFit$y[Temp]) # Th - InfDR[1, 5] <- InfDR[1, 5] * (1 - UFit$y[Temp]) # U - } - - ##### --- Correct beta sediment dose rate for water content --- ##### - InfDRG <- matrix(data = NA, nrow = 2, ncol = 6) - colnames(InfDRG) <- c("K", "SE", "Th", "SE", "U", "SE") - rownames(InfDRG) <- c("Beta", "Gamma") - - WC <- input[1, 9] / 100 - WCerr <- input[1, 10] / 100 - - for (i in 1:6){ - for (j in 1:2){ - if (j == 1){ - k = 1.25 #Water content correction for beta - } else { - k = 1.14 #Water content correction for gamma - } - - Remain <- i %% 2 - - if (Remain == 1){ - InfDRG[j,i] <- InfDR[j,i]/(1 + k*WC) - } else if (Remain == 0){ - Temp <- (InfDR[j,i]/(1 + k*WC)) - (InfDR[j,i]/(1+k*(WC+WCerr))) - InfDRG[j,i] <- InfDRG[j,i-1]*sqrt(InfDR[j,i]^2+(Temp/InfDR[j,i-1])^2) - } - } - } - InfDRG <- round(InfDRG, digits = 3) - -# Return ------------------------------------------------------------------ - return( - set_RLum( - class = "RLum.Results", - data = list( - InfDRG = InfDRG, - input_data = input - ), - info = list( - call = sys.call() - ))) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_Daybreak2CSV.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_Daybreak2CSV.R deleted file mode 100644 index b31123b48..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_Daybreak2CSV.R +++ /dev/null @@ -1,95 +0,0 @@ -#' Export measurement data produced by a Daybreak luminescence reader to CSV-files -#' -#' This function is a wrapper function around the functions [read_Daybreak2R] and -#' [write_RLum2CSV] and it imports a Daybreak-file (TXT-file, DAT-file) -#' and directly exports its content to CSV-files. If nothing is set for the -#' argument `path` ([write_RLum2CSV]) the input folder will become the output folder. -#' -#' @param file [character] (**required**): -#' name of the Daybreak-file (TXT-file, DAT-file) to be converted to CSV-files -#' -#' @param ... further arguments that will be passed to the function -#' [read_Daybreak2R] and [write_RLum2CSV] -#' -#' @return -#' The function returns either a CSV-file (or many of them) or for the option `export = FALSE` -#' a list comprising objects of type [data.frame] and [matrix] -#' -#' @section Function version: 0.1.0 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum.Analysis-class], [RLum.Data-class], [RLum.Results-class], -#' [utils::write.table], [write_RLum2CSV], [read_Daybreak2R] -#' -#' @keywords IO -#' -#' @examples -#' -#' \dontrun{ -#' ##select your BIN-file -#' file <- file.choose() -#' -#' ##convert -#' convert_Daybreak2CSV(file) -#' -#' } -#' -#' @md -#' @export -convert_Daybreak2CSV <- function( - file, - ... - -){ - - # General tests ------------------------------------------------------------------------------- - - ##file is missing? - if(missing(file)){ - stop("[convert_Daybreak2R()] file is missing!", call. = FALSE) - - } - - - ##set input arguments - convert_Daybreak2R_settings.default <- list( - raw = FALSE, - verbose = TRUE, - txtProgressBar = TRUE, - export = TRUE - ) - - ##modify list on demand - convert_Daybreak2R_settings <- modifyList(x = convert_Daybreak2R_settings.default, val = list(...)) - - # Import file --------------------------------------------------------------------------------- - if(!inherits(file, "RLum")){ - object <- read_Daybreak2R( - file = file, - raw = convert_Daybreak2R_settings$raw, - verbose = convert_Daybreak2R_settings$raw, - txtProgressBar = convert_Daybreak2R_settings$raw - - ) - }else{ - object <- file - - } - - # Export to CSV ------------------------------------------------------------------------------- - - ##get all arguments we want to pass and remove the doubled one - arguments <- c(list(object = object, export = convert_Daybreak2R_settings$export), list(...)) - arguments[duplicated(names(arguments))] <- NULL - - ##this if-condition prevents NULL in the terminal - if(convert_Daybreak2R_settings$export == TRUE){ - invisible(do.call("write_RLum2CSV", arguments)) - - }else{ - do.call("write_RLum2CSV", arguments) - - } - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_PSL2CSV.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_PSL2CSV.R deleted file mode 100644 index 25158901b..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_PSL2CSV.R +++ /dev/null @@ -1,182 +0,0 @@ -#' @title Export PSL-file(s) to CSV-files -#' -#' @description This function is a wrapper function around the functions [read_PSL2R] and -#' [write_RLum2CSV] and it imports an PSL-file (SUERC portable OSL reader file format) -#' and directly exports its content to CSV-files. -#' If nothing is set for the argument `path` ([write_RLum2CSV]) the input folder will -#' become the output folder. -#' -#' @param file [character] (**required**): -#' name of the PSL-file to be converted to CSV-files -#' -#' @param extract_raw_data [logical] (*with default*): enable/disable raw data -#' extraction. The PSL files imported into R contain an element `$raw_data`, which -#' provides a few more information (e.g., count errors), sometimes it makes -#' sense to use this data of the more compact standard values created by [read_PSL2R] -#' -#' @param single_table [logical] (*with default*): enable/disable the creation -#' of single table with n rows and n columns, instead of separate [data.frame] -#' objects. Each curve will be represented by two columns for time and counts -#' -#' @param ... further arguments that will be passed to the function -#' [read_PSL2R] and [write_RLum2CSV] -#' -#' @return -#' The function returns either a CSV-file (or many of them) or for the option -#' `export = FALSE` a list comprising objects of type [data.frame] and [matrix] -#' -#' @section Function version: 0.1.2 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum.Analysis-class], [RLum.Data-class], [RLum.Results-class], -#' [utils::write.table], [write_RLum2CSV], [read_PSL2R] -#' -#' @keywords IO -#' -#' @examples -#' -#' ## export into single data.frame -#' file <- system.file("extdata/DorNie_0016.psl", package="Luminescence") -#' convert_PSL2CSV(file, export = FALSE, single_table = TRUE) -#' -#' -#' \dontrun{ -#' ##select your BIN-file -#' file <- file.choose() -#' -#' ##convert -#' convert_PSL2CSV(file) -#' -#' } -#' -#' @md -#' @export -convert_PSL2CSV <- function( - file, - extract_raw_data = FALSE, - single_table = FALSE, - ... - -){ - - # General tests ------------------------------------------------------------------------------- - ##file is missing? - if(missing(file)){ - stop("[convert_PSL2CSV()] 'file' is missing!", call. = FALSE) - - } - - ##set input arguments - convert_PSL2R_settings.default <- list( - drop_bg = FALSE, - as_decay_curve = TRUE, - smooth = FALSE, - merge = if(single_table) TRUE else FALSE, - export = TRUE - ) - - ##modify list on demand - convert_PSL2R_settings <- modifyList(x = convert_PSL2R_settings.default, val = list(...)) - - # Import file --------------------------------------------------------------------------------- - if(!inherits(file, "RLum")){ - object <- read_PSL2R( - file = file, - drop_bg = convert_PSL2R_settings$drop_bg, - as_decay_curve = convert_PSL2R_settings$as_decay_curve, - smooth = convert_PSL2R_settings$smooth, - merge = convert_PSL2R_settings$merge - - ) - }else{ - object <- file - - } - - ## try to extract file name from object ... this will be needed later - filename <- try({ - rev(strsplit(object@info$Datafile_Path, "\\", fixed = TRUE)[[1]])[1] - }, silent = TRUE) - - # raw data ---------------------------------------------------------------- - ## extract raw data instead of conventional data - if(extract_raw_data) { - psl_raw <- lapply(object@records, function(x) x@info$raw_data) - - names(psl_raw) <- names(object) - object <- psl_raw - - } - - # single_table ------------------------------------------------------------ - ## generate a single table - if(single_table) { - ## run the conversion to CSV objects - if(inherits(object, "RLum")) { - l <- convert_PSL2CSV(object, export = FALSE, compact = FALSE) - - } else { - l <- object - - } - - ## get max row number - nrow_max <- vapply(l, nrow, numeric(1)) - - ## create super matrix - m <- matrix(NA, nrow = max(nrow_max), ncol = length(nrow_max) * ncol(l[[1]])) - - ## fill matrix - s <- matrix(seq_len(length(l) * ncol(l[[1]])), nrow = ncol(l[[1]])) - for(i in 1:length(l)) { - m[1:nrow(l[[i]]), s[1,i]:(rev(s[,i])[1])] <- as.matrix(l[[i]]) - - } - - ## set column names - if(!extract_raw_data) { - colnames(m) <- paste0(rep(names(l), each = 2), c("_t", "_cts")) - - } else { - colnames(m) <- paste0( - rep(seq_along(l), each = ncol(l[[1]])), - "_" , - rep(names(l), each = ncol(l[[1]])), - "_", - rep(colnames(l[[1]]), length(l))) - - } - - ## overwrite object - object <- as.data.frame(m) - - ## if possible, provide the file name as attribute - if(!inherits(filename, "try-error")) - attr(object, "filename") <- gsub(".", "_", filename, fixed = TRUE) - - } - - # Export to CSV ------------------------------------------------------------------------------- - ##get all arguments we want to pass and remove the doubled one - arguments <- c( - list( - object = object, - col.names = if(single_table[1] || extract_raw_data[1]) TRUE else FALSE, - export = convert_PSL2R_settings$export), - list(...)) - arguments[duplicated(names(arguments))] <- NULL - - ## now modify list again to ensure that the user input is always respected - arguments <- modifyList(arguments, val = list(...), keep.null = TRUE) - - ##this if-condition prevents NULL in the terminal - if(convert_PSL2R_settings$export){ - invisible(do.call("write_RLum2CSV", arguments)) - - }else{ - do.call("write_RLum2CSV", arguments) - - } - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_RLum2Risoe.BINfileData.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_RLum2Risoe.BINfileData.R deleted file mode 100644 index 7ca486e1c..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_RLum2Risoe.BINfileData.R +++ /dev/null @@ -1,302 +0,0 @@ -#'Converts RLum.Analysis-objects and RLum.Data.Curve-objects to RLum2Risoe.BINfileData-objects -#' -#'The functions converts [RLum.Analysis-class] and [RLum.Data.Curve-class] objects and a [list] of those -#'to [Risoe.BINfileData-class] objects. The function intends to provide a minimum of compatibility -#'between both formats. The created [RLum.Analysis-class] object can be later exported to a -#'BIN-file using the function [write_R2BIN]. -#' -#'@param object [RLum.Analysis-class] or [RLum.Data.Curve-class] (**required**): input object to -#'be converted -#' -#'@param keep.position.number [logical] (with default): keeps the original position number or re-calculate -#'the numbers to avoid doubling -#' -#'@section Function version: 0.1.3 -#' -#'@author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#'@seealso [RLum.Analysis-class], [RLum.Data.Curve-class], [write_R2BIN] -#' -#'@note The conversion can be never perfect. The `RLum` objects may contain information which are -#'not part of the [Risoe.BINfileData-class] definition. -#' -#'@keywords IO -#' -#'@examples -#' -#'##simple conversion using the example dataset -#'data(ExampleData.RLum.Analysis, envir = environment()) -#'convert_RLum2Risoe.BINfileData(IRSAR.RF.Data) -#' -#'@return The function returns a [Risoe.BINfileData-class] object. -#' -#'@md -#'@export -convert_RLum2Risoe.BINfileData <- function( - object, - keep.position.number = FALSE - -){ - - - # Self call ----------------------------------------------------------------------------------- - if(is(object, "list")){ - ##call function - object_list <- - lapply(object, function(x) { - convert_RLum2Risoe.BINfileData(x) - }) - - ##merge objects - if(length(object_list) == 1){ - return(object_list[[1]]) - - }else{ - return(merge_Risoe.BINfileData(object_list, keep.position.number = keep.position.number)) - - } - - } - - # Integrity tests ----------------------------------------------------------------------------- - ##RLum.Data.Curve - if(inherits(object, "RLum.Data.Curve")) - object <- set_RLum(class = "RLum.Analysis", records = list(object)) - - ##RLum.Analysis - final check, from here we just accept RLum.Analysis - if(!inherits(object, "RLum.Analysis")) - stop("[convert_RLum2Risoe.BINfileData()] Input object needs to be of class 'RLum.Analysis', 'RLum.Data.Curve' or a 'list' of such objects!", call. = FALSE) - - - # Set PROTOTYPE & DATA -------------------------------------------------------------------------- - - ##set Risoe.BINfiledata prototype - prototype <- set_Risoe.BINfileData() - - ##grep allowed names - allowed_names <- names(prototype@METADATA) - - ##grep records (this will avoid further the subsetting) - records <- object@records - - ##write DATA - prototype@DATA <- lapply(records, function(x) {x@data[,2]}) - - # Create METADATA ----------------------------------------------------------------------------- - - ##create METADATA list - METADATA_list <- lapply(records, function(x){ - ##grep matching arguments only - temp <- x@info[toupper(names(x@info)) %in% allowed_names] - - ##account for the case that no matching name was found - if(length(temp) != 0){ - ##correct names - names(temp) <- toupper(names(temp)) - return(temp) - - }else{ - return(list(ID = NA)) - - } - - }) - - ##make data.frame out of it - METADATA_df <- as.data.frame(data.table::rbindlist(METADATA_list, fill = TRUE)) - - ##write METADATA - prototype@METADATA <- merge(prototype@METADATA, METADATA_df, all = TRUE) - - - ## +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++# - ##fill various missing values - - ##helper function ...otherwise the code gets too nasty ... only used for NA values! - .replace <- function(field, value){ - prototype@METADATA[[field]][which(sapply(prototype@METADATA[[field]], is.na))] <<- value - - } - - ## >> ID << ## - prototype@METADATA[["ID"]] <- 1:length(records) - - ## >> SEL << ## - prototype@METADATA[["SEL"]] <- TRUE - - ## >> VERSION << ## - .replace("VERSION", "08") - - ## >> RECTYPE << ## - .replace("RECTYPE", 0) - - ## >> NPOINTS << ## - if(any(is.na(prototype@METADATA[["NPOINTS"]]))){ - prototype@METADATA[["NPOINTS"]] <- vapply(records, function(x){ - length(x@data)/2 - - }, FUN.VALUE = numeric(1)) - - } - - ## >> LENGTH << + PREVIOUS - if(any(is.na(prototype@METADATA[["LENGTH"]]))){ - ##even we have values here before, it will make no difference - prototype@METADATA[["LENGTH"]] <- (prototype@METADATA[["NPOINTS"]] * 4) + 507 - prototype@METADATA[["PREVIOUS"]] <- c(0,prototype@METADATA[["LENGTH"]][1:length(records) - 1]) - - } - - ## >> RUN << ## - ##if there is only one NA, we should overwrite it, to be consistent - if(any(is.na(prototype@METADATA[["RUN"]]))) - prototype@METADATA[["RUN"]] <- 1:length(records) - - ## >> SET << ## - .replace("SET", 1) - - ## >> GRAIN << ## - .replace("GRAIN", 0) - - ## >> GRAINNUMBER << ## - .replace("GRAINNUMBER", 0) - - ## >> USER << ## - .replace("USER", "RLum.Data") - - ## >> DTYPE << ## - .replace("DTYPE", "Natural") - - ## >> LIGHTSOURCE << ## - .replace("LIGHTSOURCE", "None") - - ## >> SAMPLE << ## - if(any(is.na(prototype@METADATA[["SAMPLE"]]))){ - ##get only the id's to change - temp_id <- which(is.na(prototype@METADATA[["SAMPLE"]])) - - ##set name - prototype@METADATA[["SAMPLE"]] <- vapply(temp_id, function(x){ - if(any(names(records[[x]]@info) == "name")){ - records[[x]]@info$name - - }else{ - "unknown" - - } - - }, character(length = 1)) - - } - - ## >> COMMENT << ## - .replace("COMMENT", "convert_RLum2Risoe.BINfileData()") - - ## >> FNAME << ## - .replace("FNAME", " ") - - ## >> DATE << ## + TIME - if(any(is.na(prototype@METADATA[["DATE"]]))){ - ##get only the id's to change - temp_id <- which(is.na(prototype@METADATA[["DATE"]])) - - ##set date - prototype@METADATA[["DATE"]] <- vapply(temp_id, function(x){ - if(any(names(records[[x]]@info) == "startDate")){ - strtrim(records[[x]]@info[["startDate"]], width = 8) - - }else{ - as.character(format(Sys.Date(),"%Y%m%d")) - - } - - - }, character(length = 1)) - - ##set time - prototype@METADATA[["TIME"]] <- vapply(temp_id, function(x){ - if(any(names(records[[x]]@info) == "startDate")){ - substr(records[[x]]@info[["startDate"]], start = 9, stop = 14) - - }else{ - as.character(format(Sys.time(),"%H%m%S")) - - } - - }, character(length = 1)) - - } - - ## >> LOW << ## - if(any(is.na(prototype@METADATA[["LOW"]]))){ - ##get only the id's to change - temp_id <- which(is.na(prototype@METADATA[["LOW"]])) - - ##set date - prototype@METADATA[["LOW"]] <- vapply(temp_id, function(x){ - min(records[[x]]@data[,1]) - - }, numeric(length = 1)) - - } - - ## >> HIGH << ## - if(any(is.na(prototype@METADATA[["HIGH"]]))){ - ##get only the id's to change - temp_id <- which(is.na(prototype@METADATA[["HIGH"]])) - - ##set date - prototype@METADATA[["HIGH"]] <- vapply(temp_id, function(x){ - max(records[[x]]@data[,1]) - - }, numeric(length = 1)) - - } - - ## >> SEQUENCE << ## - .replace("SEQUENCE", "") - - - # METADA >> correct information ------------------------------------------------------------------------- - ##we have to correct the LTYPE, the format is rather strict - ##(a) create LTYPE from names of objects - LTYPE <- vapply(names(object), function(s){ - if(grepl(pattern = " (", x = s, fixed = TRUE)){ - strsplit(s, split = " (", fixed = TRUE)[[1]][1] - - }else{ - s - } - - - }, FUN.VALUE = character(1)) - - ##(b) replace characters - ##(b.1) irradiation - LTYPE <- gsub(pattern = "irradiation", replacement = "USER", fixed = TRUE, x = LTYPE) - - ##(b.2 RF - LTYPE <- gsub(pattern = "RF", replacement = "RL", fixed = TRUE, x = LTYPE) - - ##set value - prototype@METADATA[["LTYPE"]] <- LTYPE - - - ##correct USER - ##limit user to 8 characters - prototype@METADATA[["USER"]] <- strtrim(prototype@METADATA[["USER"]], 8) - - - ##correct SAMPLE - ##limit user to 21 characters - prototype@METADATA[["SAMPLE"]] <- strtrim(prototype@METADATA[["SAMPLE"]], 20) - - ##replace all remaining NA values by 0 - ##all remaining values are numbers - prototype@METADATA <- replace(prototype@METADATA, is.na(prototype@METADATA), 0L) - - - # Return -------------------------------------------------------------------------------------- - return(prototype) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_SG2MG.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_SG2MG.R deleted file mode 100644 index 62b6f1fb1..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_SG2MG.R +++ /dev/null @@ -1,95 +0,0 @@ -#' @title Converts Single-Grain Data to Multiple-Grain Data -#' -#' @description Conversion of single-grain data to multiple-grain data by adding signals -#' from grains belonging to one disc (unique pairs of position, set and run). -#' -#' @param object [Risoe.BINfileData-class] [character] (**required**): [Risoe.BINfileData-class] -#' object or BIN/BINX-file name -#' -#' @param write_file [logical] (*with default*): if the input was a path to a file, the -#' output can be written to a file if `TRUE`. The multiple grain file will be written into the -#' same folder and with extension `-SG` to the file name. -#' -#' @param ... further arguments passed down to [read_BIN2R] if input is file path -#' -#' @return [Risoe.BINfileData-class] object and if `write_file = TRUE` and the input -#' was a file path, a file is written to origin folder. -#' -#' @section Function version: 0.1.0 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany), Norbert Mercier, IRAMAT-CRP2A, UMR 5060, CNRS-Université Bordeaux Montaigne (France); -#' -#' -#' @seealso [Risoe.BINfileData-class], [read_BIN2R], [write_R2BIN] -#' -#' @keywords IO -#' -#' @examples -#' ## simple run -#' ## (please not that the example is not using SG data) -#' data(ExampleData.BINfileData, envir = environment()) -#' convert_SG2MG(CWOSL.SAR.Data) -#' -#' @md -#' @export -convert_SG2MG <- function( - object, - write_file = FALSE, - ... - ){ - -# Check input ------------------------------------------------------------- - if(!is(object, "Risoe.BINfileData")) { - file_name <- object - object <- read_BIN2R(object, ...) - - } - -# Transform --------------------------------------------------------------- - ## get unique pairs of position, run and set and then - upairs_sg_id <- as.numeric(rownames( - unique(object@METADATA[object@METADATA[["GRAIN"]] != 0,c("POSITION", "RUN", "SET")]))) - - for(i in upairs_sg_id){ - ##get IDs of all relevant records - records_id <- object@METADATA[ - object@METADATA[["POSITION"]] == object@METADATA[["POSITION"]][[i]] & - object@METADATA[["RUN"]] == object@METADATA[["RUN"]][[i]] & - object@METADATA[["SET"]] == object@METADATA[["SET"]][[i]], - "ID"] - - # sum up count values and write it into the first grain record - object@DATA[[i]] <- matrixStats::rowSums2( - matrix( - unlist(object@DATA[records_id]), - ncol = length(records_id))) - - } - - ## clean dataset and remove all irrelevant data - upairs_id <- as.numeric(rownames( - unique(object@METADATA[, c("POSITION", "RUN", "SET")]))) - - object@METADATA <- object@METADATA[upairs_id, ] - object@DATA <- object@DATA[upairs_id] - - ##recalculate IDs and reset GRAIN - object@METADATA[["ID"]] <- 1:length(object@DATA) - object@METADATA[["GRAIN"]] <- 0 - - -# Write file -------------------------------------------------------------- - if(write_file[1]){ - if(!inherits(try(file.exists(file_name), silent = FALSE), "try-error")){ - dirname <- dirname(normalizePath(file_name)) - filename <- strsplit(basename(normalizePath(file_name)), ".", fixed = TRUE)[[1]] - - write_R2BIN(object, paste0(dirname,"/",filename[1],"_SG.",filename[2]), ...) - } - - } - -# Return object ----------------------------------------------------------- -return(object) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_Wavelength2Energy.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_Wavelength2Energy.R deleted file mode 100644 index d3b15cebc..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_Wavelength2Energy.R +++ /dev/null @@ -1,226 +0,0 @@ -#'@title Emission Spectra Conversion from Wavelength to Energy Scales (Jacobian Conversion) -#' -#'@description The function provides a convenient and fast way to convert emission spectra wavelength -#'to energy scales. The function works on [RLum.Data.Spectrum-class], [data.frame] and [matrix] and -#'a [list] of such objects. The function was written to smooth the workflow while analysing -#'emission spectra data. This is in particular useful if you want to further treat your data -#'and apply, e.g., a signal deconvolution. -#' -#'@details -#' -#' The intensity of the spectrum is re-calculated using the following approach to recalculate -#' wavelength and corresponding intensity values -#' (e.g., Appendix 4 in Blasse and Grabmeier, 1994; Mooney and Kambhampati, 2013): -#' -#' \deqn{\phi_{E} = \phi_{\lambda} * \lambda^2 / (hc)} -#' -#' with -#' \eqn{\phi_{E}} the intensity per interval of energy \eqn{E} (1/eV), -#' \eqn{\phi_{\lambda}} the intensity per interval of wavelength \eqn{\lambda} -#' (1/nm) and -#' \eqn{h} (eV * s) the Planck constant and \eqn{c} (nm/s) the velocity of light. -#' -#' For transforming the wavelength axis (x-values) the equation as follow is used -#' -#' \deqn{E = hc/\lambda} -#' -#' @param object [RLum.Data.Spectrum-class], [data.frame], [matrix] (**required**): input object to be converted. -#' If the input is not an [RLum.Data.Spectrum-class], the first column is always treated as the wavelength -#' column. The function supports a list of allowed input objects. -#' -#' @param digits [integer] (*with default*): set the number of digits on the returned energy axis -#' -#' @param order [logical] (*with default*): enables/disables sorting of the values in ascending energy -#' order. After the conversion the longest wavelength has the lowest energy value and the shortest -#' wavelength the highest. While this is correct, some R functions expect increasing x-values. -#' -#' @return The same object class as provided as input is returned. -#' -#' @note This conversion works solely for emission spectra. In case of absorption spectra only -#' the x-axis has to be converted. -#' -#' @section Function version: 0.1.1 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum.Data.Spectrum-class], [plot_RLum] -#' -#' @keywords IO -#' -#' @references -#' -#' Blasse, G., Grabmaier, B.C., 1994. Luminescent Materials. Springer. -#' -#' Mooney, J., Kambhampati, P., 2013. Get the Basics Right: Jacobian Conversion of Wavelength and -#' Energy Scales for Quantitative Analysis of Emission Spectra. J. Phys. Chem. Lett. 4, 3316–3318. -#' \doi{10.1021/jz401508t} -#' -#' Mooney, J., Kambhampati, P., 2013. Correction to “Get the Basics Right: Jacobian Conversion of -#' Wavelength and Energy Scales for Quantitative Analysis of Emission Spectra.” J. Phys. Chem. Lett. 4, -#' 3316–3318. \doi{10.1021/jz401508t} -#' -#' **Further reading** -#' -#' Angulo, G., Grampp, G., Rosspeintner, A., 2006. Recalling the appropriate representation of -#' electronic spectra. Spectrochimica Acta Part A: Molecular and Biomolecular Spectroscopy 65, -#' 727–731. \doi{10.1016/j.saa.2006.01.007} -#' -#' Wang, Y., Townsend, P.D., 2013. Potential problems in collection and data processing of -#' luminescence signals. Journal of Luminescence 142, 202–211. \doi{10.1016/j.jlumin.2013.03.052} -#' -#' @examples -#' -#' ##=====================## -#' ##(1) Literature example after Mooney et al. (2013) -#' ##(1.1) create matrix -#' m <- matrix( -#' data = c(seq(400, 800, 50), rep(1, 9)), ncol = 2) -#' -#'##(1.2) set plot function to reproduce the -#'##literature figure -#'p <- function(m) { -#' plot(x = m[, 1], y = m[, 2]) -#' polygon( -#' x = c(m[, 1], rev(m[, 1])), -#' y = c(m[, 2], rep(0, nrow(m)))) -#' for (i in 1:nrow(m)) { -#' lines(x = rep(m[i, 1], 2), y = c(0, m[i, 2])) -#' } -#'} -#' -#'##(1.3) plot curves -#' par(mfrow = c(1,2)) -#' p(m) -#' p(convert_Wavelength2Energy(m)) -#' -#'##=====================## -#'##(2) Another example using density curves -#' ##create dataset -#' xy <- density( -#' c(rnorm(n = 100, mean = 500, sd = 20), -#' rnorm(n = 100, mean = 800, sd = 20))) -#' xy <- data.frame(xy$x, xy$y) -#' -#' ##plot -#' par(mfrow = c(1,2)) -#' plot( -#' xy, -#' type = "l", -#' xlim = c(150, 1000), -#' xlab = "Wavelength [nm]", -#' ylab = "Luminescence [a.u.]" -#' ) -#'plot( -#' convert_Wavelength2Energy(xy), -#' xy$y, -#' type = "l", -#' xlim = c(1.23, 8.3), -#' xlab = "Energy [eV]", -#' ylab = "Luminescence [a.u.]" -#' ) -#' -#'@md -#'@export -convert_Wavelength2Energy <- function( - object, - digits = 3L, - order = FALSE - ){ - - - # Self-call ----------------------------------------------------------------------------------- - if(inherits(object, "list")){ - return(lapply(object, convert_Wavelength2Energy)) - - } - - # Conversion function ------------------------------------------------------------------------- - - ##this treats the matrix; in either caes and we play safe, means, we create in either case - ##colnames and rownames, but remove them later depending on the input - .conv_intensity <- function(m){ - h <- 4.135667662e-15 #eV * s - c <- 299792458e+09 #nm/s - - ##convert count values - m[] <- m * as.numeric(rownames(m))^2 / (h * c) - - ##modify rownames - rownames(m) <- round((h * c) / as.numeric(rownames(m)),digits) - - ##return results - return(m) - - } - - - # Treat input data ---------------------------------------------------------------------------- - if(inherits(object, "RLum.Data.Spectrum")){ - ##check whether the object might have this scale already - ##this only works on RLum.Data.Spectrum objects and is sugar for using RLum-objects - if(any("curveDescripter" %in% names(object@info))){ - if(any(grepl(pattern = "energy", x = tolower(object@info$curveDescripter), fixed = TRUE))){ - message("[convert_Wavelength2Energy()] Your object has already an energy scale, nothing done!") - return(object) - } - - } - - - ##convert data - object@data <- .conv_intensity(object@data) - - #sort values if needed - if(order){ - object@data <- object@data[order(as.numeric(rownames(object@data))), , - drop = FALSE] - rownames(object@data) <- sort(as.numeric(rownames(object@data))) - - } - - ##correct $curveDescripter (we do not attach the table, otherwise the object gets too big) - if(any("curveDescripter" %in% names(object@info))){ - temp_descripter <- strsplit(object@info$curveDescripter, ";", TRUE)[[1]] - temp_descripter[grepl(x = temp_descripter,pattern = "wavelength", fixed = TRUE)] <- "energy [eV]" - object@info$curveDescripter <- paste(temp_descripter, collapse = ";") - } - - ##return new object - return(object) - - }else if(inherits(object, "matrix") || inherits(object, "data.frame")){ - temp <- as.matrix(object[,2:ncol(object)]) - - ##set rownames - rownames(temp) <- object[,1] - - ##convert values - temp <- .conv_intensity(temp) - - ##construct new full matrix - temp <- cbind(as.numeric(rownames(temp)), temp) - rownames(temp) <- rownames(object) - colnames(temp) <- colnames(object) - - ##order on request (remember, here it is the first column) - if(order) temp <- temp[order(temp[,1]),] - - ##return - if(inherits(object, "data.frame")) - return(as.data.frame(temp)) - - return(temp) - }else{ - stop( - paste0( - "[convert_Wavelength2Energy()] Class '", - class(object)[1], - "' not supported as input!" - ), - call. = FALSE - ) - - } - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_XSYG2CSV.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_XSYG2CSV.R deleted file mode 100644 index 620adcafc..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/convert_XSYG2CSV.R +++ /dev/null @@ -1,101 +0,0 @@ -#' Export XSYG-file(s) to CSV-files -#' -#' This function is a wrapper function around the functions [read_XSYG2R] and -#' [write_RLum2CSV] and it imports an XSYG-file and directly exports its content -#' to CSV-files. If nothing is set for the argument `path` ([write_RLum2CSV]) -#' the input folder will become the output folder. -#' -#' @param file [character] (**required**): -#' name of the XSYG-file to be converted to CSV-files -#' -#' @param ... further arguments that will be passed to the function -#' [read_XSYG2R] and [write_RLum2CSV] -#' -#' @return -#' The function returns either a CSV-file (or many of them) or for the option `export = FALSE` -#' a list comprising objects of type [data.frame] and [matrix] -#' -#' @section Function version: 0.1.0 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum.Analysis-class], [RLum.Data-class], [RLum.Results-class], -#' [utils::write.table], [write_RLum2CSV], [read_XSYG2R] -#' -#' @keywords IO -#' -#' @examples -#' -#' ##transform XSYG-file values to a list -#' data(ExampleData.XSYG, envir = environment()) -#' convert_XSYG2CSV(OSL.SARMeasurement$Sequence.Object[1:10], export = FALSE) -#' -#' \dontrun{ -#' ##select your BIN-file -#' file <- file.choose() -#' -#' ##convert -#' convert_XSYG2CSV(file) -#' -#' } -#' -#' @md -#' @export -convert_XSYG2CSV <- function( - file, - ... - -){ - - # General tests ------------------------------------------------------------------------------- - - ##file is missing? - if(missing(file)){ - stop("[convert_XSYG2CSV()] file is missing!", call. = FALSE) - - } - - - ##set input arguments - convert_XSYG2R_settings.default <- list( - recalculate.TL.curves = TRUE, - pattern = ".xsyg", - txtProgressBar = TRUE, - export = TRUE - - ) - - ##modify list on demand - convert_XSYG2R_settings <- modifyList(x = convert_XSYG2R_settings.default, val = list(...)) - - # Import file --------------------------------------------------------------------------------- - if(!inherits(file, "RLum")){ - object <- read_XSYG2R( - file = file, - fastForward = TRUE, - recalculate.TL.curves = convert_XSYG2R_settings$recalculate.TL.curves, - pattern = convert_XSYG2R_settings$pattern, - txtProgressBar = convert_XSYG2R_settings$txtProgressBar - - ) - }else{ - object <- file - - } - - # Export to CSV ------------------------------------------------------------------------------- - - ##get all arguments we want to pass and remove the doubled one - arguments <- c(list(object = object, export = convert_XSYG2R_settings$export), list(...)) - arguments[duplicated(names(arguments))] <- NULL - - ##this if-condition prevents NULL in the terminal - if(convert_XSYG2R_settings$export == TRUE){ - invisible(do.call("write_RLum2CSV", arguments)) - - }else{ - do.call("write_RLum2CSV", arguments) - - } - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/extract_IrradiationTimes.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/extract_IrradiationTimes.R deleted file mode 100644 index d0ab4fd17..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/extract_IrradiationTimes.R +++ /dev/null @@ -1,403 +0,0 @@ -#' @title Extract Irradiation Times from an XSYG-file -#' -#' @description Extracts irradiation times, dose and times since last irradiation, from a -#' Freiberg Instruments XSYG-file. These information can be further used to -#' update an existing BINX-file. -#' -#' @details -#' The function was written to compensate missing information in the BINX-file -#' output of Freiberg Instruments lexsyg readers. As all information are -#' available within the XSYG-file anyway, these information can be extracted -#' and used for further analysis or/and to stored in a new BINX-file, which can -#' be further used by other software, e.g., Analyst (Geoff Duller). -#' -#' Typical application example: g-value estimation from fading measurements -#' using the Analyst or any other self-written script. -#' -#' Beside some simple data transformation steps, the function applies -#' functions [read_XSYG2R], [read_BIN2R], [write_R2BIN] for data import and export. -#' -#' @param object [character], [RLum.Analysis-class] or [list] (**required**): -#' path and file name of the XSYG file or an [RLum.Analysis-class] -#' produced by the function [read_XSYG2R]; -#' alternatively a `list` of [RLum.Analysis-class] can be provided. -#' -#' **Note**: If an [RLum.Analysis-class] is used, any input for -#' the arguments `file.BINX` and `recordType` will be ignored! -#' -#' @param file.BINX [character] (*optional*): -#' path and file name of an existing BINX-file. If a file name is provided the -#' file will be updated with the information from the XSYG file in the same -#' folder as the original BINX-file. -#' -#' **Note:** The XSYG and the BINX-file must originate from the -#' same measurement! -#' -#' @param recordType [character] (*with default*): -#' select relevant curves types from the XSYG file or [RLum.Analysis-class] -#' object. As the XSYG-file format comprises much more information than usually -#' needed for routine data analysis and allowed in the BINX-file format, only -#' the relevant curves are selected by using the function -#' [get_RLum]. The argument `recordType` works as -#' described for this function. -#' -#' **Note:** A wrong selection will causes a function error. Please change this -#' argument only if you have reasons to do so. -#' -#' @param compatibility.mode [logical] (*with default*): -#' this option is parsed only if a BIN/BINX file is produced and it will reset all position -#' values to a max. value of 48, cf.[write_R2BIN] -#' -#' @param txtProgressBar [logical] (*with default*): -#' enables `TRUE` or disables `FALSE` the progress bars during import and export -#' -#' @note The function can be also used to extract irradiation times from [RLum.Analysis-class] objects -#' previously imported via [read_BIN2R] (`fastForward = TRUE`) or in combination with [Risoe.BINfileData2RLum.Analysis]. -#' Unfortunately the timestamp might not be very precise (or even invalid), -#' but it allows to essentially treat different formats in a similar manner. -#' -#' @return -#' An [RLum.Results-class] object is returned with the -#' following structure: -#' -#' ``` -#' .. $irr.times (data.frame) -#' ``` -#' -#' If a BINX-file path and name is set, the output will be additionally -#' transferred into a new BINX-file with the function name as suffix. For the -#' output the path of the input BINX-file itself is used. Note that this will -#' not work if the input object is a file path to an XSYG-file, instead of a -#' link to only one file. In this case the argument input for `file.BINX` is ignored. -#' -#' In the self call mode (input is a `list` of [RLum.Analysis-class] objects -#' a list of [RLum.Results-class] is returned. -#' -#' @note -#' The produced output object contains still the irradiation steps to -#' keep the output transparent. However, for the BINX-file export this steps -#' are removed as the BINX-file format description does not allow irradiations -#' as separate sequences steps. -#' -#' **BINX-file 'Time Since Irradiation' value differs from the table output?** -#' -#' The way the value 'Time Since Irradiation' is defined differs. In the BINX-file the -#' 'Time Since Irradiation' is calculated as the 'Time Since Irradiation' plus the 'Irradiation -#' Time'. The table output returns only the real 'Time Since Irradiation', i.e. time between the -#' end of the irradiation and the next step. -#' -#' **Negative values for `TIMESINCELAST.STEP`?** -#' -#' Yes, this is possible and no bug, as in the XSYG-file multiple curves are stored for one step. -#' Example: TL step may comprise three curves: -#' -#' - (a) counts vs. time, -#' - (b) measured temperature vs. time and -#' - (c) predefined temperature vs. time. -#' -#' Three curves, but they are all belonging to one TL measurement step, but with regard to -#' the time stamps this could produce negative values as the important function -#' ([read_XSYG2R]) do not change the order of entries for one step -#' towards a correct time order. -#' -#' @section Function version: 0.3.3 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum.Analysis-class], [RLum.Results-class], [Risoe.BINfileData-class], -#' [read_XSYG2R], [read_BIN2R], [write_R2BIN] -#' -#' @references -#' Duller, G.A.T., 2015. The Analyst software package for luminescence data: overview and -#' recent improvements. Ancient TL 33, 35-42. -#' -#' @keywords IO manip -#' -#' @examples -#' ## (1) - example for your own data -#' ## -#' ## set files and run function -#' # -#' # file.XSYG <- file.choose() -#' # file.BINX <- file.choose() -#' # -#' # output <- extract_IrradiationTimes(file.XSYG = file.XSYG, file.BINX = file.BINX) -#' # get_RLum(output) -#' # -#' ## export results additionally to a CSV.file in the same directory as the XSYG-file -#' # write.table(x = get_RLum(output), -#' # file = paste0(file.BINX,"_extract_IrradiationTimes.csv"), -#' # sep = ";", -#' # row.names = FALSE) -#' -#' @md -#' @export -extract_IrradiationTimes <- function( - object, - file.BINX, - recordType = c("irradiation (NA)", "IRSL (UVVIS)", "OSL (UVVIS)", "TL (UVVIS)"), - compatibility.mode = TRUE, - txtProgressBar = TRUE -){ - - # SELF CALL ----------------------------------------------------------------------------------- - if(is.list(object)){ - ##show message for non-supported arguments - if(!missing(file.BINX)){ - .throw_warning("argument 'file.BINX' is not supported in self-call mode.") - } - - ##extend arguments - ##extent recordType - if(is(recordType, "list")){ - recordType <- - rep(recordType, length = length(object)) - - }else{ - recordType <- - rep(list(recordType), length = length(object)) - } - - ##run function - results <- lapply(1:length(object), function(x) { - extract_IrradiationTimes( - object = object[[x]], - recordType = recordType[[x]], - txtProgressBar = txtProgressBar - ) - }) - - ##DO NOT use invisible here, this will stop the function from stopping - if(length(results) == 0){ - return(NULL) - - }else{ - return(results) - } - } - -# Integrity tests ----------------------------------------------------------------------------- - ##check whether an character or an RLum.Analysis object is provided - if(is(object)[1] != "character" & is(object)[1] != "RLum.Analysis"){ - .throw_error("Input object is neither of type 'character' nor ", - "of type 'RLum.Analysis'.") - } else if(is(object)[1] == "character"){ - - ##set object to file.XSYG - file.XSYG <- object - - ##XSYG - if (!file.exists(file.XSYG)) { - .throw_error("Wrong XSYG file name or file does not exist!") - } - - ##check if file is XML file - if(tail(unlist(strsplit(file.XSYG, split = "\\.")), 1) != "xsyg" & - tail(unlist(strsplit(file.XSYG, split = "\\.")), 1) != "XSYG" ){ - .throw_error("File is expected to have 'xsyg' or 'XSYG' extension") - } - - ##BINX - if(!missing(file.BINX)){ - if (!file.exists(file.BINX)) { - .throw_error("Wrong BINX file name or file does not exist!") - } - - ##check if file is XML file - if(tail(unlist(strsplit(file.BINX, split = "\\.")), 1) != "binx" & - tail(unlist(strsplit(file.BINX, split = "\\.")), 1) != "BINX" ){ - .throw_error("File is expected to have 'binx' or 'BINX' extension") - } - } - - # Settings and import XSYG -------------------------------------------------------------------- - temp.XSYG <- read_XSYG2R(file.XSYG, txtProgressBar = txtProgressBar, - verbose = txtProgressBar) - - if(!missing(file.BINX)){ - temp.BINX <- read_BIN2R(file.BINX, txtProgressBar = txtProgressBar, - verbose = txtProgressBar) - temp.BINX.dirname <- (dirname(file.XSYG)) - } - - # Some data preparation ----------------------------------------------------------------------- - ##set list - temp.sequence.list <- list() - - ##select all analysis objects and combine them - for(i in 1:length(temp.XSYG)){ - ##select sequence and reduce the data set to really wanted values - temp.sequence.list[[i]] <- get_RLum( - object = temp.XSYG[[i]]$Sequence.Object, - recordType = recordType, - drop = FALSE) - - ##get corresponding position number, this will be needed later on - temp.sequence.position <- as.numeric(as.character(temp.XSYG[[i]]$Sequence.Header["position",])) - } - - }else{ - ##now we assume a single RLum.Analysis object - ##select sequence and reduce the data set to really wanted values, note that no - ##record selection was made! - temp.sequence.list <- list(object) - } - - ##merge objects - if(length(temp.sequence.list)>1){ - temp.sequence <- merge_RLum(temp.sequence.list) - - }else{ - temp.sequence <- temp.sequence.list[[1]] - } - -# Grep relevant information ------------------------------------------------------------------- - ##Sequence STEP - STEP <- names_RLum(temp.sequence) - - #START time of each step - ## we try also to support BIN/BINX files with this function if imported - ## accordingly - if(any(temp.sequence@originator %in% c("Risoe.BINfileData2RLum.Analysis", "read_BIN2R"))) { - temp.START <- vapply(temp.sequence, function(x) { - paste0(get_RLum(x, info.object = c("DATE")), get_RLum(x, info.object = c("TIME"))) - - }, character(1)) - - ##a little bit reformatting. - START <- strptime(temp.START, format = "%y%m%d%H%M%S", tz = "GMT") - ## make another try in case it does not make sense - if(any(is.na(START))) - START <- strptime(temp.START, format = "%y%m%d%H:%M:%S", tz = "GMT") - - } else { - temp.START <- vapply(temp.sequence, function(x) { - get_RLum(x, info.object = c("startDate")) - - }, character(1)) - - ##a little bit reformatting. - START <- strptime(temp.START, format = "%Y%m%d%H%M%S", tz = "GMT") - } - - ##DURATION of each STEP - DURATION.STEP <- vapply(temp.sequence, function(x){ - max(get_RLum(x)[,1]) - }, numeric(1)) - - - ##Calculate END time of each STEP - END <- START + DURATION.STEP - - ##add position number so far an XSYG file was the input - POSITION <- NA - if(exists("file.XSYG")){ - POSITION <- rep(temp.sequence.position, each = length_RLum(temp.sequence)) - - }else if(!inherits(try( - suppressWarnings(get_RLum( - get_RLum(temp.sequence, record.id = 1), info.object = "position")), - silent = TRUE), "try-error")){ - - ##POSITION of each STEP - POSITION <- vapply(temp.sequence, function(x){ - tmp <- suppressWarnings(get_RLum(x, info.object = c("position"))) - - if(is.null(tmp)) - tmp <- get_RLum(x, info.object = c("POSITION")) - - tmp - }, numeric(1)) - } - - ##Combine the results - temp.results <- data.frame(POSITION,STEP,START,DURATION.STEP,END) - - # Calculate irradiation duration ------------------------------------------------------------ - if(any(temp.sequence@originator %in% c("Risoe.BINfileData2RLum.Analysis", "read_BIN2R"))) { - IRR_TIME <- vapply(temp.sequence, function(x) get_RLum(x, info.object = c("IRR_TIME")), numeric(1)) - - } else { - IRR_TIME <- numeric(length = nrow(temp.results)) - temp_last <- 0 - for(i in 1:nrow(temp.results)){ - if(grepl("irradiation", temp.results[["STEP"]][i])) { - temp_last <- temp.results[["DURATION.STEP"]][i] - next() - } - - IRR_TIME[i] <- temp_last - } - } - # Calculate time since irradiation ------------------------------------------------------------ - ##set objects - time.irr.end <- NA - - TIMESINCEIRR <- unlist(sapply(1:nrow(temp.results), function(x){ - if(grepl("irradiation", temp.results[x,"STEP"])){ - time.irr.end<<-temp.results[x,"END"] - return(-1) - - }else{ - if(is.na(time.irr.end)){ - return(-1) - - }else{ - return(difftime(temp.results[x,"START"],time.irr.end, units = "secs")) - - } - } - - })) - - # Calculate time since last step -------------------------------------------------------------- - TIMESINCELAST.STEP <- unlist(sapply(1:nrow(temp.results), function(x){ - if(x == 1){ - return(0) - }else{ - return(difftime(temp.results[x,"START"],temp.results[x-1, "END"], units = "secs")) - } - - })) - - # Combine final results ----------------------------------------------------------------------- - ##results table, export as CSV - results <- cbind(temp.results,IRR_TIME, TIMESINCEIRR,TIMESINCELAST.STEP) - - # Write BINX-file if wanted ------------------------------------------------------------------- - if(!missing(file.BINX)){ - ##(1) remove all irradiation steps as there is no record in the BINX file and update information - results.BINX <- results[-which(results[,"STEP"] == "irradiation (NA)"),] - - ## (2) compare entries in the BINX-file with the entries in the table - ## to make sure that both have the same length - if(nrow(results.BINX) == nrow(temp.BINX@METADATA)){ - - ## (1a) update information on the irradiation time - temp.BINX@METADATA[["IRR_TIME"]] <- results.BINX[["IRR_TIME"]] - - ## (1b) update information on the time since irradiation by using the - ## Risoe definition of the parameter, to make the file compatible to - ## the Analyst - temp.BINX@METADATA[["TIMESINCEIRR"]] <- results.BINX[["IRR_TIME"]] + results.BINX[["TIMESINCEIRR"]] - - ## update BINX-file - try <- write_R2BIN(temp.BINX, version = "06", - file = paste0(file.BINX,"_extract_IrradiationTimes.BINX"), - compatibility.mode = compatibility.mode, - txtProgressBar = txtProgressBar) - - ##set message on the format definition - if(!inherits(x = try, 'try-error')){ - message("[extract_IrradiationTimes()] 'Time Since Irradiation' was redefined in the exported BINX-file to: 'Time Since Irradiation' plus the 'Irradiation Time' to be compatible with the Analyst.") - } - } else { - message("[extract_IrradiationTimes()] XSYG-file and BINX-file ", - "do not contain similar entries, BINX-file update skipped") - } - } - - # Output -------------------------------------------------------------------------------------- - return(set_RLum(class = "RLum.Results", data = list(irr.times = results))) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/extract_ROI.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/extract_ROI.R deleted file mode 100644 index 467981aa2..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/extract_ROI.R +++ /dev/null @@ -1,220 +0,0 @@ -#'@title Extract Pixel Values through Circular Region-of-Interests (ROI) from an Image -#' -#'@description Light-weighted function to extract pixel values from pre-defined regions-of-interest (ROI) from -#'[RLum.Data.Image-class], [array] or [matrix] objects and provide simple image processing -#'capacity. The function is limited to circular ROIs. -#' -#'@details The function uses a cheap approach to decide whether a pixel lies within -#'a circle or not. It assumes that pixel coordinates are integer values and -#'that a pixel centring within the circle is satisfied by: -#' -#'\deqn{x^2 + y^2 <= (d/2)^2} -#' -#'where \eqn{x} and \eqn{y} are integer pixel coordinates and \eqn{d} is the integer -#'diameter of the circle in pixel. -#' -#'@param object [RLum.Data.Image-class], [array] or [matrix] (**required**): input image data -#' -#'@param roi [matrix] (**required**): matrix with three columns containing the centre coordinates -#'of the ROI (first two columns) and the diameter of the circular ROI. All numbers must by of type [integer] -#'and will forcefully coerced into such numbers using `as.integer()` regardless. -#' -#'@param roi_summary (**with default**): if `"mean"` (the default) defines what is returned -#'in the element `roi_summary`; alternatively `"mean"`, `"median"`, `"sd"` or `"sum"` can be chosen. -#'Pixel values are conveniently summarised using the above defined keyword. -#' -#'@param plot [logical] (*optional*): enables/disables control plot. Only the first -#'image frame is shown -#' -#'@return [RLum.Results-class] object with the following elements: -#'`..$roi_signals`: a named [list] with all ROI values and their coordinates -#'`..$roi_summary`: an [matrix] where rows are frames from the image, and columns are different ROI -#'The element has two attributes: `summary` (the method used to summarise pixels) and `area` (the pixel area) -#'`..$roi_coord`: a [matrix] that can be passed to [plot_ROI] -#' -#'If `plot = TRUE` a control plot is returned. -#' -#'@section Function version: 0.1.0 -#' -#'@author -#'Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#'@seealso [RLum.Data.Image-class] -#' -#'@keywords manip -#' -#'@examples -#' -#' m <- matrix(runif(100,0,255), ncol = 10, nrow = 10) -#' roi <- matrix(c(2.,4,2,5,6,7,3,1,1), ncol = 3) -#' extract_ROI(object = m, roi = roi, plot = TRUE) -#' -#'@md -#'@export -extract_ROI <- function( - object, - roi, - roi_summary = "mean", - plot = FALSE -){ - -# Self call --------------------------------------------------------------- - if (is(object, "list")) - return(merge_RLum(lapply(object, extract_ROI, roi = roi, plot = plot))) - -# Check input ------------------------------------------------------------- - ## check input for ROIs - if (!is.matrix(roi) || nrow(roi) < 1 || ncol(roi) < 3) - stop("[extract_ROI()] Please check the format of roi, it looks wrong!", call. = FALSE) - - ## check input for object - if (!is(object, "matrix") && !is(object, "array") && !is(object, "RLum.Data.Image")) - stop("[extract_ROI()] Input for argument 'object' not supported!", call. = FALSE) - - ## calculate the radius - roi <- roi[,1:3] - roi[,3] <- ceiling(roi[,3]/2) - - ## make sure that we have integer values only in the matrix - roi[] <- as.integer(roi) - - ## copy object (to not work on the input data) - a <- object - - ## try to convert into something meaningful - if (is(object, "RLum.Data.Image")) - a <- object@data - - if (is(object, "matrix")) - a <- array(data = object, dim = c(nrow(object), ncol(object), 1)) - -# Helper function --------------------------------------------------------- - .extract_pixel <- function(m, r, mid) { - ## get row - column combinations - grid <- as.matrix(expand.grid(x = 1:nrow(m), y = 1:ncol(m))) - - ## adjust values for mid point - ## + get pixel coordinates if within the circle - px_id <- grid[(grid[,"x"] - mid[1])^2 + (grid[,"y"] - mid[2])^2 <= r[1]^2,] - - ## extract values from matrix - px_extract <- NA - if (nrow(px_id) > 0) { - px_extract <- vapply(1:nrow(px_id), function(x) { - m[px_id[x,1],px_id[x,2]] - - }, numeric(1)) - } - - attr(px_extract, "coord") <- px_id - return(px_extract) - } - -# Extract ROIs ------------------------------------------------------------ - roi_signals <- lapply(1:nrow(roi), function(x){ - ## iterate through a stack if needed - temp <- lapply(1:(dim(a)[3]), function(z){ - .extract_pixel(a[,,z], roi[x,3], mid = roi[x,1:2]) - - }) - - ## compile into matrix - m <- matrix(unlist(temp), nrow = length(temp[[1]])) - - ## add attributes ... including coordinates; but only one time - colnames(m) <- paste0("frame_", 1:ncol(m)) - attr(m, "px_coord") <- attr(temp[[1]], "coord") - return(m) - - }) - - ## add names - names(roi_signals) <- paste0("ROI_", 1:nrow(roi)) - -# Plot check -------------------------------------------------------------- - if (plot) { - ## this is a control plot, so we plot only the first image; nothing more - - ## image - graphics::image( - x = 1:nrow(a[, , 1]), - y = 1:ncol(a[, , 1]), - a[, , 1], - ylab = "y-dim [px]", - xlab = "x-dim [px]", - useRaster = TRUE, - main = "extract_ROIs() - control plot") - box() - - ## visualise ROIs - overlay <- a[,,1] - overlay[] <- 0 - for (i in 1:length(roi_signals)) - overlay[attr(roi_signals[[i]], "px_coord")[,1], attr(roi_signals[[i]], "px_coord")[,2]] <- 1 - - ## marked ROIs - graphics::image( - x = 1:nrow(a[, , 1]), - y = 1:ncol(a[, , 1]), - overlay, - axes = FALSE, - add = TRUE, - useRaster = TRUE, - col = c(rgb(1, 1, 1, 0), rgb(0, 1, 0, 0.5))) - - ## add circles and points - for (i in 1:nrow(roi)) { - lines(shape::getellipse(rx = roi[i, 3], mid = c(roi[i, 1:2], dr = 0.1)), col = "red", lwd = 1.5) - text(x = roi[i,1], y = roi[i,2], i, col = "black", cex = 1.2) - - } - - } - -# ROI summary ------------------------------------------------------------- - ## set roi fun and avoid add input - if(!any(roi_summary[1]%in%c("mean", "median", "sd", "sum"))) - stop("[extract_ROI()] roi_summary method not supported, check manual!", call. = FALSE) - - ## set function - roi_fun <- roi_summary[1] - - ## create summary using matrixStats - roi_summary <- matrix(unlist( - switch(roi_fun, - "mean" = lapply(roi_signals, matrixStats::colMeans2), - "median" = lapply(roi_signals, matrixStats::colMedians), - "sd" = lapply(roi_signals, matrixStats::colSds), - "sum" = lapply(roi_signals, matrixStats::colSums2))), - ncol = length(roi_signals)) - - ## set names to make it easier - colnames(roi_summary) <- names(roi_signals) - rownames(roi_summary) <- paste0("frame_", 1:nrow(roi_summary)) - attr(roi_summary, "summary") <- roi_fun - attr(roi_summary, "area") <- vapply(roi_signals, nrow, numeric(1)) - - ## add more roi information to the output for further processing - roi <- cbind( - ROI = 1:nrow(roi), - x = roi[,1], - y = roi[,2], - area = attr(roi_summary, "area"), - width = vapply(roi_signals, function(x) diff(range(attr(x, "px_coord")[,"x"])), numeric(1)), - height = vapply(roi_signals, function(x) diff(range(attr(x, "px_coord")[,"y"])), numeric(1)), - img_width = nrow(a[, , 1]), - img_height = ncol(a[, , 1]), - grain_d = roi[,3]) - -# Return ------------------------------------------------------------------ - return( - set_RLum( - class = "RLum.Results", - data = list( - roi_signals = roi_signals, - roi_summary = roi_summary, - roi_coord = roi), - info = list( - call = sys.call()))) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/fit_CWCurve.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/fit_CWCurve.R deleted file mode 100644 index 1c7205139..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/fit_CWCurve.R +++ /dev/null @@ -1,854 +0,0 @@ -#' Nonlinear Least Squares Fit for CW-OSL curves -beta version- -#' -#' The function determines the weighted least-squares estimates of the -#' component parameters of a CW-OSL signal for a given maximum number of -#' components and returns various component parameters. The fitting procedure -#' uses the [nls] function with the `port` algorithm. -#' -#' **Fitting function** -#' -#' The function for the CW-OSL fitting has the general form: -#' -#' \deqn{y = I0_{1}*\lambda_{1}*exp(-\lambda_1*x) + ,\ldots, + I0_{i}*\lambda_{i}*exp(-\lambda_i*x) } -#' -#' where \eqn{0 < i < 8} -#' -#' and \eqn{\lambda} is the decay constant \cr -#' and \eqn{I0} the initial number of trapped electrons. -#' -#' *(for the used equation cf. Boetter-Jensen et al., 2003, Eq. 2.31)* -#' -#' **Start values** -#' -#' Start values are estimated automatically by fitting a linear function to the -#' logarithmized input data set. Currently, there is no option to manually -#' provide start parameters. -#' -#' **Goodness of fit** -#' -#' The goodness of the fit is given as pseudoR^2 value (pseudo coefficient of -#' determination). According to Lave (1970), the value is calculated as: -#' -#' \deqn{pseudoR^2 = 1 - RSS/TSS} -#' -#' where \eqn{RSS = Residual~Sum~of~Squares} \cr -#' and \eqn{TSS = Total~Sum~of~Squares} -#' -#' -#' -#' **Error of fitted component parameters** -#' -#' The 1-sigma error for the -#' components is calculated using the function [stats::confint]. Due to -#' considerable calculation time, this option is deactivated by default. In -#' addition, the error for the components can be estimated by using internal R -#' functions like [summary]. See the [nls] help page -#' for more information. -#' -#' *For details on the nonlinear regression in R, see Ritz & Streibig (2008).* -#' -#' @param values [RLum.Data.Curve-class] or [data.frame] (**required**): -#' x, y data of measured values (time and counts). See examples. -#' -#' @param n.components.max [vector] (*optional*): -#' maximum number of components that are to be used for fitting. -#' The upper limit is 7. -#' -#' @param fit.failure_threshold [vector] (*with default*): -#' limits the failed fitting attempts. -#' -#' @param fit.method [character] (*with default*): -#' select fit method, allowed values: `'port'` and `'LM'`. `'port'` uses the 'port' -#' routine from the function [nls] `'LM'` utilises the function `nlsLM` from -#' the package `minpack.lm` and with that the Levenberg-Marquardt algorithm. -#' -#' @param fit.trace [logical] (*with default*): -#' traces the fitting process on the terminal. -#' -#' @param fit.calcError [logical] (*with default*): -#' calculate 1-sigma error range of components using [stats::confint] -#' -#' @param LED.power [numeric] (*with default*): -#' LED power (max.) used for intensity ramping in mW/cm^2. -#' **Note:** The value is used for the calculation of the absolute -#' photoionisation cross section. -#' -#' @param LED.wavelength [numeric] (*with default*): -#' LED wavelength used for stimulation in nm. -#' **Note:** The value is used for the calculation of the absolute -#' photoionisation cross section. -#' -#' @param cex.global [numeric] (*with default*): -#' global scaling factor. -#' -#' @param sample_code [character] (*optional*): -#' sample code used for the plot and the optional output table (`mtext`). -#' -#' @param output.terminal [logical] (*with default*): -#' terminal output with fitting results. -#' -#' @param output.terminalAdvanced [logical] (*with default*): -#' enhanced terminal output. Requires `output.terminal = TRUE`. -#' If `output.terminal = FALSE` no advanced output is possible. -#' -#' @param plot [logical] (*with default*): -#' returns a plot of the fitted curves. -#' -#' @param ... further arguments and graphical parameters passed to [plot]. -#' -#' @return -#' **plot (*optional*)** -#' -#' the fitted CW-OSL curves are returned as plot. -#' -#' **RLum.Results** -#' -#' Beside the plot and table output options, an [RLum.Results-class] object is -#' returned. -#' -#' `fit`: -#' an `nls` object (`$fit`) for which generic R functions are -#' provided, e.g. [summary], [stats::confint], [profile]. For more -#' details, see [nls]. -#' -#' `output.table`: -#' a [data.frame] containing the summarised parameters including the error -#' -#' `component.contribution.matrix`: -#' [matrix] containing the values for the component to sum contribution plot -#' (`$component.contribution.matrix`). -#' -#' Matrix structure:\cr -#' Column 1 and 2: time and `rev(time)` values \cr -#' Additional columns are used for the components, two for each component, -#' containing I0 and n0. The last columns `cont.` provide information on -#' the relative component contribution for each time interval including the row -#' sum for this values. -#' -#' **object** -#' -#' beside the plot and table output options, an [RLum.Results-class] object -#' is returned. -#' -#' `fit`: -#' an `nls` object (`$fit`) for which generic R functions -#' are provided, e.g. [summary], [confint], [profile]. For more -#' details, see [nls]. -#' -#' `output.table`: -#' a [data.frame] containing the summarised parameters including the error\cr -#' `component.contribution.matrix`: [matrix] containing the values -#' for the component to sum contribution plot (`$component.contribution.matrix`).\cr -#' -#' Matrix structure:\cr -#' Column 1 and 2: time and `rev(time)` values\cr -#' Additional columns are used for the components, two for each component, -#' containing I0 and n0. The last columns `cont.` provide information on -#' the relative component contribution for each time interval including the row -#' sum for this values. -#' -#' -#' @note -#' -#' **Beta version - This function has not been properly tested yet and** -#' **should therefore not be used for publication purposes!** -#' -#' The pseudo-R^2 may not be the best parameter to describe the goodness of the -#' fit. The trade off between the `n.components` and the pseudo-R^2 value -#' is currently not considered. -#' -#' The function **does not** ensure that the fitting procedure has reached a -#' global minimum rather than a local minimum! -#' -#' @section Function version: 0.5.3 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [fit_LMCurve], [plot],[nls], [RLum.Data.Curve-class], -#' [RLum.Results-class], [get_RLum], [minpack.lm::nlsLM] -#' -#' @references -#' Boetter-Jensen, L., McKeever, S.W.S., Wintle, A.G., 2003. -#' Optically Stimulated Luminescence Dosimetry. Elsevier Science B.V. -#' -#' Lave, C.A.T., 1970. The Demand for Urban Mass Transportation. The Review of -#' Economics and Statistics, 52 (3), 320-323. -#' -#' Ritz, C. & Streibig, J.C., 2008. Nonlinear Regression with R. In: R. -#' Gentleman, K. Hornik, G. Parmigiani, eds., Springer, p. 150. -#' -#' @keywords dplot models -#' -#' @examples -#' -#' ##load data -#' data(ExampleData.CW_OSL_Curve, envir = environment()) -#' -#' ##fit data -#' fit <- fit_CWCurve(values = ExampleData.CW_OSL_Curve, -#' main = "CW Curve Fit", -#' n.components.max = 4, -#' log = "x") -#' -#' @md -#' @export -fit_CWCurve<- function( - values, - n.components.max, - fit.failure_threshold = 5, - fit.method = "port", - fit.trace = FALSE, - fit.calcError = FALSE, - LED.power = 36, - LED.wavelength = 470, - cex.global = 0.6, - sample_code = "Default", - output.terminal = TRUE, - output.terminalAdvanced = TRUE, - plot = TRUE, - ... -){ - # INTEGRITY CHECKS -------------------------------------------------------- - - ##INPUT OBJECTS - if(is(values, "RLum.Data.Curve") == FALSE & is(values, "data.frame") == FALSE){ - .throw_error("Input object is not of type 'RLum.Data.Curve' or 'data.frame'") - } - - - if(is(values, "RLum.Data.Curve") == TRUE){ - - x <- values@data[,1] - y <- values@data[,2] - - ##needed due to inconsistencies in the R code below - values <- data.frame(x,y) - - }else{ - - ##set x and y values - x<-values[,1] - y<-values[,2] - - } - - - # Deal with extra arguments ----------------------------------------------- - - ##deal with addition arguments - extraArgs <- list(...) - - main <- if("main" %in% names(extraArgs)) {extraArgs$main} else - {"CW-OSL Curve Fit"} - - log <- if("log" %in% names(extraArgs)) {extraArgs$log} else - {""} - - xlab <- if("xlab" %in% names(extraArgs)) {extraArgs$xlab} else - {"Time [s]"} - - ylab <- if("ylab" %in% names(extraArgs)) {extraArgs$ylab} else - {paste("OSL [cts/",round(max(x)/length(x), digits = 2)," s]",sep="")} - - if ("output.path" %in% names(extraArgs)) - .throw_warning("Argument 'output.path' no longer supported, ignored") - - ##============================================================================## - ## FITTING - ##============================================================================## - ## - ##////equation used for fitting////(start) - fit.equation <- function(I0.i,lambda.i){ - equation<-parse( - text=paste("I0[",I0.i,"]*lambda[",lambda.i,"]*exp(-lambda[",lambda.i,"]*x)", - collapse="+",sep="")) - return(equation) - } - ##////equation used for fitting///(end) - - ##set formula elements for fitting functions - ## the upper two funtions should be removed ... but chances are needed ... TODO - ##////equation used for fitting////(start) - fit.formula <- function(n.components){ - - I0 <- paste0("I0.",1:n.components) - lambda <- paste0("lambda.",1:n.components) - as.formula(paste0("y ~ ", paste(I0," * ", lambda, "* exp(-",lambda," * x)", collapse=" + "))) - - } - ##////equation used for fitting///(end) - - ##////equation used for fitting////(start) - fit.formula.simple <- function(n.components){ - - I0 <- paste0("I0.",1:n.components) - lambda <- paste0("lambda.",1:n.components) - as.formula(paste0("y ~ ", paste(I0," * exp(-",lambda," * x)", collapse=" + "))) - - } - ##////equation used for fitting///(end) - - ##set variables - fit.trigger <- TRUE #triggers if the fitting should stopped - n.components <- 1 #number of components used for fitting - start with 1 - fit.failure_counter <- 0 #counts the failed fitting attempts - - ##if n.components_max is missing, then it is Inf - if(missing(n.components.max)==TRUE){n.components.max<-Inf} - - - ## - ##++++Fitting loop++++(start) - while(fit.trigger==TRUE & n.components <= n.components.max){ - - ##(0) START PARAMETER ESTIMATION - ##rough automatic start parameter estimation - - ##I0 - I0<-rep(values[1,2]/3,n.components) - names(I0) <- paste0("I0.",1:n.components) - - ##lambda - ##ensure that no values <=0 are included remove them for start parameter - ##estimation and fit an linear function a first guess - if(min(y)<=0){ - temp.values<-data.frame(x[-which(y<=0)], log(y[-which(y<=0)])) - }else{ - temp.values<-data.frame(x, log(y)) - } - - temp<-lm(temp.values) - lambda<-abs(temp$coefficient[2])/nrow(values) - - k<-2 - while(k<=n.components){ - lambda[k]<-lambda[k-1]/100 - k<-k+1 - } - names(lambda) <- paste0("lambda.",1:n.components) - - ##(1) FIRST FIT WITH A SIMPLE FUNCTION - if(fit.method == "LM"){ - - ##try fit simple - fit.try<-suppressWarnings(try(minpack.lm::nlsLM(fit.formula.simple(n.components), - data=values, - start=c(I0,lambda), - na.action = "na.exclude", - trace = fit.trace, - control = minpack.lm::nls.lm.control( - maxiter = 500 - )), - silent = TRUE - - ))#end try - - - }else if(fit.method == "port"){ - - ##try fit simple - fit.try<-suppressWarnings(try(nls(fit.formula.simple(n.components), - data=values, - trace = fit.trace, - algorithm="port", - na.action = "na.exclude", - start=c(I0,lambda), - nls.control( - tol = 1, - maxiter=100, - warnOnly=FALSE, - minFactor=1/1024 - ), - lower=rep(0,n.components * 2)# set lower boundaries for components - ), silent=TRUE# nls - ))#end try - - }else{ - .throw_error("'fit.method' unknown") - } - - - ##(3) FIT WITH THE FULL FUNCTION - if(inherits(fit.try,"try-error") == FALSE){ - - ##grep parameters from simple fit to further work with them - parameters <- coef(fit.try) - - ##grep parameters an set new starting parameters, here just lambda is choosen as - ##it seems to be the most valuable parameter - lambda <- parameters[(n.components+1):length(parameters)] - - if(fit.method == "LM"){ - - ##try fit simple - fit.try<-suppressWarnings(try(minpack.lm::nlsLM(fit.formula(n.components), - data=values, - start=c(I0,lambda), - trace = fit.trace, - na.action = "na.exclude", - lower = rep(0,n.components * 2), - control = minpack.lm::nls.lm.control( - maxiter = 500 - )), - silent = TRUE)) - - ## HACK: - # minpack.lm::nlsLM() stores the 'lower' argument as class "call" rather - # than "numeric" as nls() does. Before running confint() on this object - # we overwrite the "lower" slot with the numeric values again. - if (!inherits(fit.try, "try-error")) { - fit.try$call$lower <- rep(0,n.components * 2) - } - - }else{ - - - ##try fit - fit.try<-suppressWarnings(try(nls(fit.formula(n.components), - trace=fit.trace, - data=values, - algorithm="port", - na.action = "na.exclude", - start=c(I0,lambda), - nls.control( - maxiter = 500, - warnOnly = FALSE, - minFactor = 1/4096 - ), - lower=rep(0,n.components * 2)# set lower boundaries for components - ), silent=TRUE# nls - ))#end try - - }#fit.method - } - - ##count failed attempts for fitting - if(inherits(fit.try,"try-error")==FALSE){ - - fit <- fit.try - n.components <- n.components + 1 - - }else{ - - n.components<-n.components+1 - fit.failure_counter <- fit.failure_counter+1 - if(n.components==fit.failure_counter & exists("fit")==FALSE){fit<-fit.try}} - - - ##stop fitting after a given number of wrong attempts - if(fit.failure_counter>=fit.failure_threshold){ - - fit.trigger <- FALSE - if(!exists("fit")){fit <- fit.try} - - }else if(n.components == n.components.max & exists("fit") == FALSE){ - - fit <- fit.try - - } - - }##end while - ##++++Fitting loop++++(end) - - ##============================================================================## - ## FITTING OUTPUT - ##============================================================================## - - ##grep parameters - if(inherits(fit,"try-error")==FALSE){ - - parameters <- coef(fit) - - ##correct fit equation for the de facto used number of components - I0.i<-1:(length(parameters)/2) - lambda.i<-1:(length(parameters)/2) - fit.function<-fit.equation(I0.i=I0.i,lambda.i=lambda.i) - n.components<-length(I0.i) - - ##write parameters in vectors and order by decreasing lambda value - I0<-parameters[1:(length(parameters)/2)] - lambda<-parameters[(1+(length(parameters)/2)):length(parameters)] - - o<-order(lambda,decreasing=TRUE) - I0<-I0[o] - lambda<-lambda[o] - - ##============================================================================## - ## Additional Calculation - ##============================================================================## - - - ## --------------------------------------------- - ##calculate stimulation intensity Schmidt (2008) - - ##Energy - E = h*v - h<-6.62606957e-34 #in W*s^2 - Planck constant - ny<-299792458/(LED.wavelength/10^9) #frequency of light - E<-h*ny - - ##transform LED.power in W/cm^2 - LED.power<-LED.power/1000 - - ##gets stimulation intensity - stimulation_intensity<-LED.power/E - - ## --------------------------------------------- - ##calculate photoionisation cross section and print on terminal - - ##using EQ (5) in Kitis - cs<-as.vector(lambda/stimulation_intensity) - cs.rel<-round(cs/cs[1],digits=4) - - ## --------------------------------------------- - ##coefficient of determination after law - - RSS <- sum(residuals(fit)^2) #residual sum of squares - TSS <- sum((y - mean(y))^2) #total sum of squares - pR<-round(1-RSS/TSS,digits=4) - - if(pR<0){ - .throw_warning("pseudo-R^2 < 0!") - } - - ## --------------------------------------------- - ##calculate 1- sigma CONFIDENCE INTERVALL - - lambda.error<-rep(NA, n.components) - I0.error<-rep(NA, n.components) - - if(fit.calcError==TRUE){ - ##option for confidence interval - values.confint<-confint(fit, level=0.68) - I0.confint<-values.confint[1:(length(values.confint[,1])/2),] - lambda.confint<-values.confint[((length(values.confint[,1])/2)+1):length(values.confint[,1]),] - - ##error calculation - I0.error<-as.vector(abs(I0.confint[,1]-I0.confint[,2])) - lambda.error<-as.vector(abs(lambda.confint[,1]-lambda.confint[,2])) - - }#endif::fit.calcError - - ##============================================================================## - ## Terminal Output - ##============================================================================## - - if (output.terminal==TRUE){ - - ##print rough fitting information - use the nls() control for more information - writeLines("\n[fit_CWCurve()]") - writeLines(paste("\nFitting was finally done using a ",n.components, - "-component function (max=",n.components.max,"):",sep="")) - writeLines("------------------------------------------------------------------------------") - writeLines(paste0("y ~ ", as.character(fit.formula(n.components))[3], "\n")) - - ##combine values and change rows names - fit.results<-cbind(I0,I0.error,lambda,lambda.error,cs, cs.rel) - row.names(fit.results)<-paste("c", 1:(length(parameters)/2), sep="") - - ##print parameters - print(fit.results) - - #print some additional information - if(fit.calcError==TRUE){writeLines("(errors quoted as 1-sigma values)")} - writeLines("------------------------------------------------------------------------------") - }#end if - - ##============================================================================## - ## Terminal Output (advanced) - ##============================================================================## - if (output.terminalAdvanced==TRUE && output.terminal==TRUE){ - - ##sum of squares - writeLines(paste("pseudo-R^2 = ",pR,sep="")) - }#end if - ##============================================================================## - ## Table Output - ##============================================================================## - - ##write output table if values exists - if (exists("fit")){ - - ##set data.frame for a max value of 7 components - output.table<-data.frame(NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA, - NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA, - NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA) - output.tableColNames<-c("I01","I01.error","lambda1", "lambda1.error", - "cs1","cs1.rel", - "I02","I02.error","lambda2", "lambda2.error", - "cs2","cs2.rel", - "I03","I03.error","lambda3", "lambda3.error", - "cs3","cs3.rel", - "I04","I04.error","lambda4", "lambda4.error", - "cs4","cs4.rel", - "I05","I05.error","lambda5", "lambda5.error", - "cs5","cs5.rel", - "I06","I06.error","lambda6", "lambda6.error", - "cs6","cs6.rel", - "I07","I07.error","lambda7", "lambda7.error", - "cs7","cs7.rel" - ) - - ##write components in output table - i<-0 - k<-1 - while(i<=n.components*6){ - output.table[1,i+1]<-I0[k] - output.table[1,i+2]<-I0.error[k] - output.table[1,i+3]<-lambda[k] - output.table[1,i+4]<-lambda.error[k] - output.table[1,i+5]<-cs[k] - output.table[1,i+6]<-cs.rel[k] - i<-i+6 - k<-k+1 - } - - ##add pR and n.components - output.table<-cbind(sample_code,n.components,output.table,pR) - - ##alter column names - colnames(output.table)<-c("sample_code","n.components", - output.tableColNames,"pseudo-R^2") - - ##============================================================================## - ## COMPONENT TO SUM CONTRIBUTION PLOT - ##============================================================================## - - ##+++++++++++++++++++++++++++++++ - ##set matrix - ##set polygon matrix for optional plot output - component.contribution.matrix <- matrix(NA, - nrow = length(values[,1]), - ncol = (2*length(I0)) + 2) - - ##set x-values - component.contribution.matrix[,1] <- values[,1] - component.contribution.matrix[,2] <- rev(values[,1]) - - ##+++++++++++++++++++++++++++++++ - ##set 1st polygon - ##1st polygon (calculation) - y.contribution_first<-(I0[1]*lambda[1]*exp(-lambda[1]*x))/(eval(fit.function))*100 - - ##avoid NaN values (might happen with synthetic curves) - y.contribution_first[is.nan(y.contribution_first)==TRUE] <- 0 - - ##set values in matrix - component.contribution.matrix[,3] <- 100 - component.contribution.matrix[,4] <- 100 - rev(y.contribution_first) - - ##+++++++++++++++++++++++++++++++ - ##set polygons in between - ##polygons in between (calculate and plot) - if (length(I0)>2){ - - y.contribution_prev <- y.contribution_first - i<-2 - - ##matrix stepping - k <- seq(3, ncol(component.contribution.matrix), by=2) - - while (i<=length(I0)-1) { - - y.contribution_next<-I0[i]*lambda[i]*exp(-lambda[i]*x)/(eval(fit.function))*100 - - ##avoid NaN values - y.contribution_next[is.nan(y.contribution_next)==TRUE] <- 0 - - ##set values in matrix - component.contribution.matrix[,k[i]] <- 100 - y.contribution_prev - component.contribution.matrix[, k[i]+1] <- rev(100-y.contribution_prev- - y.contribution_next) - - y.contribution_prev <- y.contribution_prev + y.contribution_next - - i <- i+1 - - }#end while loop - }#end if - - ##+++++++++++++++++++++++++++++++ - ##set last polygon - - ##last polygon (calculation) - y.contribution_last <- I0[length(I0)]*lambda[length(lambda)]*exp(-lambda[length(lambda)]*x)/ - (eval(fit.function))*100 - - ##avoid NaN values - y.contribution_last[is.nan(y.contribution_last)==TRUE]<-0 - - component.contribution.matrix[,((2*length(I0))+1)] <- y.contribution_last - component.contribution.matrix[,((2*length(I0))+2)] <- 0 - - ##change names of matrix to make more easy to understand - component.contribution.matrix.names <- c( - "x", "rev.x", - paste(c("y.c","rev.y.c"),rep(1:n.components,each=2), sep="")) - - ##calculate area for each component, for each time interval - component.contribution.matrix.area <- sapply( - seq(3,ncol(component.contribution.matrix),by=2), - function(x){ - - matrixStats::rowDiffs(cbind(rev(component.contribution.matrix[,(x+1)]), - component.contribution.matrix[,x])) - - }) - - ##append to existing matrix - component.contribution.matrix <- cbind( - component.contribution.matrix, - component.contribution.matrix.area, - rowSums(component.contribution.matrix.area) - ) - - ##set final column names - colnames(component.contribution.matrix) <- c( - component.contribution.matrix.names, - paste(c("cont.c"),rep(1:n.components,each=1), sep=""), - "cont.sum") - - - }#endif :: (exists("fit")) - - }else{ - - if (output.terminal==TRUE) - writeLines("[fit_CWCurve()] Fitting Error >> Plot without fit produced!") - - output.table<-NA - component.contribution.matrix <- NA - } - - ##============================================================================## - ## PLOTTING - ##============================================================================## - if(plot==TRUE){ - - ##grep par parameters - par.default <- par(no.readonly = TRUE) - - ##set colors gallery to provide more colors - col <- get("col", pos = .LuminescenceEnv) - - ##set plot frame - if(!inherits(fit, "try-error")){ - layout(matrix(c(1,2,3),3,1,byrow=TRUE),c(1.6,1,1), c(1,0.3,0.4),TRUE) - par(oma=c(1,1,1,1),mar=c(0,4,3,0),cex=cex.global) - }else{ - par(cex=cex.global) - } - - - ##==uppper plot==## - ##open plot area - - plot(NA,NA, - xlim=c(min(x),max(x)), - ylim=if(log=="xy"){c(1,max(y))}else{c(0,max(y))}, - xlab=if(!inherits(fit, "try-error")){""}else{xlab}, - xaxt=if(!inherits(fit, "try-error")){"n"}else{"s"}, - ylab=ylab, - main=main, - log=log) - - ##plotting measured signal - points(x,y,pch=20, col="grey") - - ##add additional labeling (fitted function) - mtext(side=3, sample_code, cex=0.7*cex.global) - - ##plot sum function - if(inherits(fit,"try-error")==FALSE){ - lines(x,eval(fit.function), lwd=2, col="black") - legend.caption<-"sum curve" - curve.col <- 1 - - ##plot signal curves - - ##plot curve for additional parameters - if(length(I0)>1){ - - for (i in 1:length(I0)) { - curve(I0[i]*lambda[i]*exp(-lambda[i]*x),col=col[i+1], - lwd = 2, - add = TRUE) - legend.caption<-c(legend.caption,paste("component ",i,sep="")) - curve.col<-c(curve.col,i+1) - } - }#end if - ##plot legend - #legend(y=max(y)*1,"measured values",pch=20, col="gray", bty="n") - legend("topright",legend.caption,lty=rep(1,n.components+1,NA),lwd=2,col=col[curve.col], bty="n") - - ##==lower plot==## - ##plot residuals - par(mar=c(4.2,4,0,0)) - plot(x,residuals(fit), - xlim=c(min(x),max(x)), - xlab=xlab, - type="l", - col="grey", - ylab="Residual [a.u.]", - lwd=2, - log=if(log=="x" | log=="xy"){log="x"}else{""} - ) - - ##add 0 line - abline(h=0) - - ##------------------------------------------------------------------------## - ##++component to sum contribution plot ++## - ##------------------------------------------------------------------------## - - ##plot component contribution to the whole signal - #open plot area - par(mar=c(4,4,3.2,0)) - plot(NA,NA, - xlim=c(min(x),max(x)), - ylim=c(0,100), - ylab="Contribution [%]", - xlab=xlab, - main="Component contribution to sum curve", - log=if(log=="x" | log=="xy"){log="x"}else{""}) - - stepping <- seq(3,length(component.contribution.matrix[1,]),2) - - for(i in 1:length(I0)){ - - polygon(c(component.contribution.matrix[,1], - component.contribution.matrix[,2]), - c(component.contribution.matrix[,stepping[i]], - component.contribution.matrix[,stepping[i]+1]), - col = col[i+1]) - } - rm(stepping) - - - }#end if try-error for fit - - par(par.default) - rm(par.default) - } - - ##============================================================================## - ## Return Values - ##============================================================================## - - newRLumResults.fit_CWCurve <- set_RLum( - class = "RLum.Results", - data = list( - data = output.table, - fit = fit, - component.contribution.matrix = list(component.contribution.matrix) - ), - info = list(call = sys.call()) - ) - - rm(fit) - rm(output.table) - rm(component.contribution.matrix) - - invisible(newRLumResults.fit_CWCurve) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/fit_EmissionSpectra.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/fit_EmissionSpectra.R deleted file mode 100644 index a1cb9bd0d..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/fit_EmissionSpectra.R +++ /dev/null @@ -1,685 +0,0 @@ -#'@title Luminescence Emission Spectra Deconvolution -#' -#'@description Luminescence spectra deconvolution on [RLum.Data.Spectrum-class] and [matrix] objects -#'on an **energy scale**. The function is optimised for emission spectra typically -#'obtained in the context of TL, OSL and RF measurements detected between 200 and 1000 nm. -#'The function is not prepared to deconvolve TL curves (counts against temperature; -#'no wavelength scale). If you are interested in such analysis, please check, e.g., -#'the package `'tgcd'`. -#' -#'@details -#' -#'**Used equation** -#' -#'The emission spectra (on an energy scale) can be best described as the sum of multiple -#'Gaussian components: -#' -#''\deqn{ -#'y = \Sigma Ci * 1/(\sigma_{i} * \sqrt(2 * \pi)) * exp(-1/2 * ((x - \mu_{i})/\sigma_{i}))^2) -#'} -#' -#'with the parameters \eqn{\sigma} (peak width) and \eqn{\mu} (peak centre) and \eqn{C} -#'(scaling factor). -#' -#' -#'**Start parameter estimation and fitting algorithm** -#' -#'The spectrum deconvolution consists of the following steps: -#' -#'1. Peak finding \cr -#'2. Start parameter estimation \cr -#'3. Fitting via [minpack.lm::nls.lm]\cr -#' -#'The peak finding is realised by an approach (re-)suggested by Petr Pikal via the R-help -#'mailing list (`https://stat.ethz.ch/pipermail/r-help/2005-November/thread.html`) in November 2005. -#'This goes back to even earlier discussion in 2001 based on Prof Brian Ripley's idea. -#'It smartly uses the functions [stats::embed] and [max.col] to identify peaks positions. -#'For the use in this context, the algorithm has been further modified to scale on the -#'input data resolution (cf. source code).\cr -#' -#'The start parameter estimation uses random sampling from a range of meaningful parameters -#'and repeats the fitting until 1000 successful fits have been produced or the set `max.runs` value -#'is exceeded. -#' -#'Currently the best fit is the one with the lowest number for squared residuals, but -#'other parameters are returned as well. If a series of curves needs to be analysed, -#'it is recommended to make few trial runs, then fix the number of components and -#'run at least 10,000 iterations (parameter `method_control = list(max.runs = 10000)`). -#' -#'**Supported `method_control` settings** -#' -#'\tabular{llll}{ -#' **Parameter** \tab **Type** \tab **Default** \tab **Description**\cr -#' `max.runs` \tab [integer] \tab `10000` \tab maximum allowed search iterations, if exceed -#' the searching stops \cr -#' `graining` \tab [numeric] \tab `15` \tab gives control over how coarse or fine the spectrum is split into search intervals for the peak finding algorithm \cr -#' `norm` \tab [logical] \tab `TRUE` \tab normalises data to the highest count value before fitting \cr -#' `trace` \tab [logical] \tab `FALSE` \tab enables/disables the tracing of the minimisation routine -#'} -#' -#'@param object [RLum.Data.Spectrum-class], [matrix] (**required**): input -#'object. Please note that an energy spectrum is expected -#' -#'@param frame [numeric] (*optional*): defines the frame to be analysed -#' -#'@param start_parameters [numeric] (*optional*): allows to provide own start parameters for a -#'semi-automated procedure. Parameters need to be provided in eV. Every value provided replaces a -#'value from the automated peak finding algorithm (in ascending order). -#' -#'@param n_components [numeric] (*optional*): allows a number of the aimed number of -#'components. However, it defines rather a maximum than than a minimum. Can be combined with -#'other parameters. -#' -#'@param input_scale [character] (*optional*): defines whether your x-values define wavelength or -#'energy values. For the analysis an energy scale is expected, allowed values are `'wavelength'` and -#'`'energy'`. If nothing (`NULL`) is defined, the function tries to understand the input -#'automatically. -#' -#'@param sub_negative [numeric] (*with default*): substitute negative values in the input object -#'by the number provided here (default: `0`). Can be set to `NULL`, i.e. negative values are kept. -#' -#'@param method_control [list] (*optional*): options to control the fit method, see details -#' -#'@param verbose [logical] (*with default*): enable/disable verbose mode -#' -#'@param plot [logical] (*with default*): enable/disable plot output -#' -#'@param ... further arguments to be passed to control the plot output -#'(supported: `main`, `xlab`, `ylab`, `xlim`, `ylim`, `log`, `mtext`, `legend` (`TRUE` or `FALSE`), -#'`legend.text`, `legend.pos`) -#' -#'@return -#' -----------------------------------\cr -#' `[ NUMERICAL OUTPUT ]`\cr -#' -----------------------------------\cr -#' -#' **`RLum.Results`**-object -#' -#' **slot:** **`@data`** -#' -#' \tabular{lll}{ -#' **Element** \tab **Type** \tab **Description**\cr -#' `$data` \tab `matrix` \tab the final fit matrix \cr -#' `$fit` \tab `nls` \tab the fit object returned by [minpack.lm::nls.lm] \cr -#' `$fit_info` \tab `list` \tab a few additional parameters that can be used to asses the quality -#' of the fit -#' } -#' -#' -#'**slot:** **`@info`** -#' -#' The original function call -#' -#' ---------------------------------\cr -#' `[ TERMINAL OUTPUT ]` \cr -#' ---------------------------------\cr -#' -#' The terminal output provides brief information on the -#' deconvolution process and the obtained results. -#' Terminal output is only shown of the argument `verbose = TRUE`. -#' -#' ---------------------------\cr -#' `[ PLOT OUTPUT ]` \cr -#' ---------------------------\cr -#' -#' The function returns a plot showing the raw signal with the -#' detected components. If the fitting failed, a basic plot is returned -#' showing the raw data and indicating the peaks detected for the start -#' parameter estimation. The grey band in the residual plot indicates the -#' 10% deviation from 0 (means no residual). -#' -#'@section Function version: 0.1.1 -#' -#'@author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#'@seealso [RLum.Data.Spectrum-class], [RLum.Results-class], [plot_RLum], -#'[convert_Wavelength2Energy], [minpack.lm::nls.lm] -#' -#'@keywords datagen -#' -#'@examples -#' -#'##load example data -#'data(ExampleData.XSYG, envir = environment()) -#' -#'##subtract background -#'TL.Spectrum@@data <- TL.Spectrum@@data[] - TL.Spectrum@@data[,15] -#' -#'results <- fit_EmissionSpectra( -#' object = TL.Spectrum, -#' frame = 5, -#' method_control = list(max.runs = 10) -#' ) -#' -#' ##deconvolution of a TL spectrum -#' \dontrun{ -#' -#' ##load example data -#' -#' ##replace 0 values -#' results <- fit_EmissionSpectra( -#' object = TL.Spectrum, -#' frame = 5, main = "TL spectrum" -#' ) -#' -#'} -#' -#'@md -#'@export -fit_EmissionSpectra <- function( - object, - frame = NULL, - n_components = NULL, - start_parameters = NULL, - sub_negative = 0, - input_scale = NULL, - method_control = list(), - verbose = TRUE, - plot = TRUE, - ... -){ - - - ##TODO: Find a way to get a significant number of components - ## This function works only on a list of matrices, so what ever we do here, we have to - ## create a list of data treat, frame controls the number of frames analysed - - ##input RLum.Data.Spectrum ... make list either way - if(inherits(object, "RLum.Data.Spectrum")) - object <- list(object) - - ##stop, mixed input is not allowed - if(inherits(object, "list") && length(unique(sapply(object, class))) != 1) - stop("[fit_EmissionSpectra()] List elements of different class detected!", call. = FALSE) - - ##deal with RLum.Data.Spectrum lists - if(inherits(object, "list") && all(sapply(object, class) == "RLum.Data.Spectrum")){ - temp <- lapply(object, function(o){ - ##get x-axis - x <- as.numeric(rownames(o@data)) - rownames(o@data) <- NULL - - ##set frame - if(is.null(frame)){ - frame <- 1:ncol(o@data) - - }else{ - if(max(frame) > ncol(o@data)|| min(frame) < 1){ - .throw_error("'frame' invalid. Allowed range min: 1 and max: ", - ncol(o@data), nframe = 3) # we are inside an lapply closure - } - } - - ##get frame - temp_frame <- lapply(frame, function(f) cbind(x, o@data[,f])) - names(temp_frame) <- paste0("Frame: ", frame) - return(temp_frame) - - }) - - ##set object name - names(temp) <- paste0("ALQ: ", 1:length(temp), " ") - - ##unlist, now we have what we want - object <- unlist(temp, use.names = TRUE, recursive = FALSE) - names(object) <- gsub(" .", names(object), replacement = " | ", fixed = TRUE) - rm(temp) - - } - - ##handle a single matrix that may have different columns - if(inherits(object, "matrix") && ncol(object) > 2){ - rownames(object) <- NULL - - ##set frame - if(is.null(frame)){ - frame <- 1:(ncol(object) - 1) - - }else{ - if(max(frame) > (ncol(object)-1) || min(frame) < 1){ - .throw_error("'frame' invalid. Allowed range min: 1 and max: ", - ncol(object) - 1, nframe = 3) # we are inside an lapply closure - } - } - - temp <- lapply(frame +1 , function(x) cbind(object[,1],object[,x])) - names(temp) <- paste0("Frame: ",frame) - object <- temp - rm(temp) - } - - ##now treat different lists, the aim is to have a list of 2-column matrices - ##we have two types of lists, - # Self-call ----------------------------------------------------------------------------------- - if(inherits(object, "list")){ - ##get argument list - args_list <- list(...) - - ##recycle arguments - if(!"mtext" %in% names(args_list)){ - mtext <- names(object) - - }else{ - mtext <- as.list(rep(args_list$mtext, length(object))) - args_list$mtext <- NULL - - } - - ##run over the list - results <- lapply(1:length(object), function(o){ - do.call(fit_EmissionSpectra, args = c( - list( - object = object[[o]], - start_parameters = start_parameters, - n_components = n_components, - sub_negative = sub_negative, - input_scale = input_scale, - method_control = method_control, - frame = frame, - mtext = mtext[[o]]), - verbose = verbose, - plot = plot, - args_list) - ) - - }) - - ##merge output and return - return(merge_RLum(results)) - - } - - - # Start main core ----------------------------------------------------------------------------- - ##backstop, from here we allow only a matrix - if(!inherits(object, "matrix")) - .throw_error("Objects of type '", is(object)[1], "' are not supported") - - ##extract matrix for everything below - m <- object[,1:2] - - ##replace all negative values - if(!is.null(sub_negative)) - m[m[,2] < 0,2] <- sub_negative - - ##output - if(verbose){ - cat("\n[fit_EmissionSpectra()]\n") - cat("\n>> Treating dataset >>",frame,"<<\n") - } - - ##check the scale - if(is.null(input_scale)){ - ##values above 30 are unlikely, means its likely that we have a wavelength scale - if(max(m[,1]) > 30){ - if(verbose) cat(">> Wavelength scale detected ...\n") - m <- convert_Wavelength2Energy(m, order = TRUE) - if(verbose) cat(">> Wavelength to energy scale conversion ... \t[OK]\n") - - } - - }else if(input_scale == "wavelength"){ - m <- convert_Wavelength2Energy(m, order = TRUE) - if(verbose) cat(">> Wavelength to energy scale conversion ... \t[OK]\n") - - } - - - # Settings ------------------------------------------------------------------------------------ - ##create peak finding function ... this helps to get good start parameters - ##https://grokbase.com/t/r/r-help/05bqza71c4/r-finding-peaks-in-a-simple-dataset-with-r - ##https://stat.ethz.ch/pipermail/r-help/2005-November/thread.html - ##author: Petr Pikal in 2004; with modifications by Sebastian Kreutzer - .peaks <- function(x, span, size = nrow(m)) { - z <- stats::embed(x, span) - s <- span %/% sample(1:4, size = 1) - ##the part `ceiling(...)` scales the entire algorithm - v <- max.col(z, ties.method = "first") == ceiling(10^(3 - log10(nrow(m)))) + s - result <- c(rep(FALSE, s), v) - which(result[1:(length(result) - s)]) - - } - - ##set fit function - x <- 0 #cheat R check routine - fit_formula <- function(n.components) { - sigma <- paste0("sigma.",1:n.components) - mu <- paste0("mu.",1:n.components) - C <- paste0("C.",1:n.components) - as.formula( - paste0("y ~ ", - paste(C," * 1/(",sigma," * sqrt(2 * pi)) * exp(-0.5 * ((x - ",mu,")/",sigma,")^2)", - collapse = " + "))) - - } - -# Fitting ------------------------------------------------------------------------------------- - ## method_control -------- - method_control <- modifyList(x = list( - max.runs = 10000, - graining = 15, - norm = TRUE, - trace = FALSE - ), val = method_control) - - # set data.frame ------------------------------------------------------------------------------ - df <- data.frame(x = m[,1], y = m[,2]) ##normalise values, it is just easier - - if(method_control$norm[1]) - df[["y"]] <- df[["y"]]/max(m[,2]) ##normalise values, it is just easier - - ## check graining parameter - if (method_control$graining >= nrow(m)) - .throw_error("method_control$graining cannot exceed the ", - "available channels (", nrow(m) ,")", nframe = 5) - - ##initialise objects - success_counter <- 0 - run <- 0 - fit <- list() - mu <- C <- sigma <- NA - R2 <- SSR <- SST <- R2adj <- NA - - ## (WHILE LOOP START) ------- - ##run iterations - while(success_counter < 1000 && run < method_control$max.runs){ - ##try to find start parameters - - ##identify peaks - id_peaks <- .peaks(m[,2], sample(method_control$graining[1]:(nrow(m) - 1), 1)) - - ##make sure that we do not end up in an endless loop - if(length(id_peaks) == 0){ - if (verbose) cat("\r>> Searching components ... \t\t\t[-]") - run <- run + 1 - next() - } - - ## set start parameters for fitting -------- - mu <- m[id_peaks,1] - - if(!is.null(start_parameters)) - mu <- c(sort(start_parameters), mu[-c(1:length(start_parameters))]) - - ## limit the number of components - if(!is.null(n_components[1])) - mu <- mu[seq(1,length(mu), length.out = n_components[1])] - - sigma <- rep(sample(0.01:10,1),length(mu)) - C <- rep(max(df[[2]])/2, length(mu)) - - names(mu) <- paste0("mu.", 1:length(mu)) - names(sigma) <- paste0("sigma.", 1:length(mu)) - names(C) <- paste0("C.", 1:length(mu)) - - ##run fitting using the Levenberg-Marquardt algorithm - fit_try <- try(minpack.lm::nlsLM( - formula = fit_formula(n.components = length(mu)), - data = df, - start = c(sigma, mu, C), - trace = method_control$trace, - lower = rep(0, 3 * length(mu)), - upper = c( - rep(1000, length(mu)), - rep(max(df[[1]]), length(mu)), - rep(max(df[[2]]), length(mu))), - control = minpack.lm::nls.lm.control(maxiter = 500) - ), silent = TRUE) - - ##handle output - if (class(fit_try)[1] != "try-error") { - success_counter <- success_counter + 1 - fit[[success_counter]] <- fit_try - if (verbose) cat("\r>> Searching components ... \t\t\t[/]") - } else{ - if (verbose) cat("\r>> Searching components ... \t\t\t[\\]") - - } - - ##update run counter - run <- run + 1 - - } - - - ## handle the output - if (verbose) { - cat("\r>> Searching components ... \t\t\t", - if (length(fit) > 0) "[OK]" else "[FAILED]") - } - - ##Extract best fit values - ##TODO ... should be improved, its works, but maybe there are better solutions - if (length(fit) != 0) { - ##obtain the fit with the best fit - best_fit <- vapply(fit, function(x) sum(residuals(x) ^ 2), numeric(1)) - fit <- fit[[which.min(best_fit)]] - - ## more parameters - SSR <- min(best_fit) - SST <- sum((df[[2]] - mean(df[[2]]))^2) - R2 <- 1 - SSR/SST - R2adj <- ((1 - R2) * (nrow(df) - 1)) / - (nrow(df) - length(coef(fit)) - 1) - - - }else{ - fit <- NA - - } - - # Extract values ------------------------------------------------------------------------------ - ##extract components - m_coef <- NA - if(!is.na(fit[1]) && is(fit, "nls")){ - ##extract values we need only - m_coef <- summary(fit)$coefficients - m_coef <- matrix( - data = c( - as.numeric(m_coef[grepl(pattern = "mu", x = rownames(m_coef), fixed = TRUE),1:2]), - as.numeric(m_coef[grepl(pattern = "sigma", x = rownames(m_coef), fixed = TRUE),1:2]), - as.numeric(m_coef[grepl(pattern = "C", x = rownames(m_coef), fixed = TRUE),1:2]) - ), - ncol = 6 - ) - - ##set colnames - colnames(m_coef) <- c("mu", "SE(mu)", "sigma", "SE(sigma)", "C", "SE(C)") - - ##order by sigma - m_coef <- m_coef[order(m_coef[,1]),, drop = FALSE] - - ##extract single values, we need this later - mu <- m_coef[,"mu"] - sigma <- m_coef[,"sigma"] - C <- m_coef[,"C"] - } - - # Terminal output ----------------------------------------------------------------------------- - if(verbose && !is.na(m_coef[1])){ - cat(paste0("\n\n>> Fitting results (",length(mu), " component model):\n")) - cat("-------------------------------------------------------------------------\n") - print(m_coef) - cat("-------------------------------------------------------------------------") - cat(paste0("\nSE: standard error | SSR: ", format(min(best_fit), scientific=TRUE, digits = 4), - "| R^2: ", round(R2,3), " | R^2_adj: ", round(R2adj,4))) - cat("\n(use the output in $fit for a more detailed analysis)\n\n") - - } - - # Plotting ------------------------------------------------------------------------------------ - if(plot){ - ##get colour values - col <- get("col", pos = .LuminescenceEnv)[-1] - - ##plot settings - plot_settings <- modifyList(x = list( - xlab = "Energy [eV]", - ylab = "Luminescence [a.u.]", - main = "Emission Spectrum Deconvolution", - xlim = range(df[[1]]), - ylim = range(df[[2]]), - log = "", - mtext = "", - legend = TRUE, - legend.pos = "topright", - legend.text = c("sum", paste0("c",1:length(mu),": ", round(mu,2), " eV")) - - ), val = list(...)) - - if(!is.na(fit[1]) && class(fit)[1] != "try-error"){ - ##make sure that the screen closes if something is wrong - on.exit(close.screen(n = c(1,2))) - - ##set split screen settings - split.screen(rbind( - c(0.1,1,0.32, 0.98), - c(0.1,1,0.1, 0.315))) - - ##SCREEN 1 ---------- - screen(1) - par(mar = c(0, 4, 3, 4)) - plot( - df, - pch = 20, - xlab = plot_settings$xlab, - ylab = plot_settings$ylab, - xlim = plot_settings$xlim, - ylim = plot_settings$ylim, - main = plot_settings$main, - col = rgb(0, 0, 0, .6), - xaxt = "n", - yaxt = "n", - log = plot_settings$log - ) - - ## add axis normalised - axis(side = 2, - at = axTicks(side = 2), - labels = c(axTicks(2))) - - ## add axis with real count vales - if(method_control$norm[1]) { - axis( - side = 2, - axTicks(side = 2)[-1], - labels = format( - max(m[, 2]) * axTicks(side = 2)[-1], - digit = 1, - scientific = TRUE - ), - line = 0.8, - cex.axis = 0.7, - tick = FALSE - ) - } - - ##plot sum curve - lines(x = df[[1]], y = predict(fit), col = col[1], lwd = 1.5) - - ##add mtext - mtext(side = 3, text = plot_settings$mtext) - - ##add components - for(i in 1:length(mu)){ - curve( - (C[i] * 1 / (sigma[i] * sqrt(2 * pi)) * exp(-0.5 * ((x - mu[i])/sigma[i])^2)), - add = TRUE, - col = col[i + 1] - ) - - } - - ##add legend - if(plot_settings$legend){ - legend( - plot_settings$legend.pos, - legend = plot_settings$legend.text, - lwd = 1, - col = col[1:(length(mu) + 2)], - bty = "n" - ) - } - - ## SCREEN 2 ----- - screen(2) - par(mar = c(4, 4, 0, 4)) - plot(NA, NA, - ylim = range(residuals(fit)), - xlab = plot_settings$xlab, - type = "b", - pch = 20, - yaxt = "n", - xlim = plot_settings$xlim, - ylab = "", - col = rgb(0,0,0,.6), - log = ifelse(grepl(plot_settings$log[1], pattern = "x", fixed = TRUE), "x", "") - ) - - ## add one axis label - axis(side = 2, at = 0, labels = 0) - - ## add ± 5 line - polygon(x = c(df[[1]], rev(df[[1]])), - y = c(df[[2]] * 1.1 - df[[2]], rev(df[[2]] * 0.9 - df[[2]])), - border = FALSE, col = rgb(0.8,0.8,0.8)) - - ## add points - points(df[[1]],residuals(fit), pch = 20, col = rgb(0,0,0,0.3)) - - ## add zero line - abline(h = 0, lty = 2) - - ##add wavelength axis - h <- 4.135667662e-15 #eV * s - c <- 299792458e+09 #nm/s - axis( - side = 1, - labels = paste0("(",round((h * c) / axTicks(side = 3), 0), " nm)"), - at = axTicks(side = 3), - cex.axis = .7, - line = .8, - tick = FALSE - ) - - }else{ - - ##provide control plot - plot(df, main = "fit_EmissionSpectra() - control plot") - - ##abline - abline(v = mu, lty = 2) - - ##add information - mtext(side = 3, text = "(dashed lines indicate identified peaks)") - - ##add components - for(i in 1:length(mu)){ - curve( - (C[i] * 1 / (sigma[i] * sqrt(2 * pi)) * exp(-0.5 * ((x - mu[i])/sigma[i])^2)), - add = TRUE, - col = i - ) - } - - } - }##if plot - - # Output -------------------------------------------------------------------------------------- - results <- set_RLum( - class = "RLum.Results", - data = list(data = m_coef, - fit = fit, - fit_info = list( - SSR = SSR, - SST = SST, - R2 = R2, - R2adj = R2adj) - ), - info = list(call = sys.call()) - ) - - ##return - return(results) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/fit_LMCurve.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/fit_LMCurve.R deleted file mode 100644 index 77e01b0f4..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/fit_LMCurve.R +++ /dev/null @@ -1,1054 +0,0 @@ -#' @title Nonlinear Least Squares Fit for LM-OSL curves -#' -#' @description The function determines weighted nonlinear least-squares estimates of the -#' component parameters of an LM-OSL curve (Bulur 1996) for a given number of -#' components and returns various component parameters. The fitting procedure -#' uses the function [nls] with the `port` algorithm. -#' -#' @details -#' **Fitting function** -#' -#' The function for the fitting has the general -#' form: -#' -#' \deqn{y = (exp(0.5)*Im_1*x/xm_1)*exp(-x^2/(2*xm_1^2)) + ,\ldots, + exp(0.5)*Im_i*x/xm_i)*exp(-x^2/(2*xm_i^2))} -#' -#' where \eqn{1 < i < 8} -#' -#' This function and the equations for the conversion to b (detrapping probability) -#' and n0 (proportional to initially trapped charge) have been taken from Kitis -#' et al. (2008): -#' -#' \deqn{xm_i=\sqrt{max(t)/b_i}} -#' \deqn{Im_i=exp(-0.5)n0/xm_i} -#' -#' **Background subtraction** -#' -#' Three methods for background subtraction -#' are provided for a given background signal (`values.bg`). -#' -#' - `polynomial`: default method. A polynomial function is fitted using [glm] -#' and the resulting function is used for background subtraction: -#' \deqn{y = a*x^4 + b*x^3 + c*x^2 + d*x + e} -#' -#' - `linear`: a linear function is fitted using [glm] and the resulting function -#' is used for background subtraction: -#' \deqn{y = a*x + b} -#' -#' - `channel`: the measured -#' background signal is subtracted channel wise from the measured signal. -#' -#' -#' **Start values** -#' -#' The choice of the initial parameters for the `nls`-fitting is a crucial -#' point and the fitting procedure may mainly fail due to ill chosen start -#' parameters. Here, three options are provided: -#' -#' **(a)** -#' If no start values (`start_values`) are provided by the user, a cheap guess is made -#' by using the detrapping values found by Jain et al. (2003) for quartz for a -#' maximum of 7 components. Based on these values, the pseudo start parameters -#' `xm` and `Im` are recalculated for the given data set. In all cases, the fitting -#' starts with the ultra-fast component and (depending on `n.components`) -#' steps through the following values. If no fit could be achieved, an error -#' plot (for `plot = TRUE`) with the pseudo curve (based on the -#' pseudo start parameters) is provided. This may give the opportunity to -#' identify appropriate start parameters visually. -#' -#' **(b)** -#' If start values are provided, the function works like a simple [nls] -#' fitting approach. -#' -#' **(c)** -#' If no start parameters are provided and -#' the option `fit.advanced = TRUE` is chosen, an advanced start parameter -#' estimation is applied using a stochastic attempt. Therefore, the -#' recalculated start parameters **(a)** are used to construct a normal -#' distribution. The start parameters are then sampled randomly from this -#' distribution. A maximum of 100 attempts will be made. **Note:** This -#' process may be time consuming. -#' -#' **Goodness of fit** -#' -#' The goodness of the fit is given by a pseudo-R^2 value (pseudo coefficient of -#' determination). According to Lave (1970), the value is calculated as: -#' -#' \deqn{pseudoR^2 = 1 - RSS/TSS} -#' -#' where \eqn{RSS = Residual~Sum~of~Squares} -#' and \eqn{TSS = Total~Sum~of~Squares} -#' -#' **Error of fitted component parameters** -#' -#' The 1-sigma error for the components is calculated using -#' the function [stats::confint]. Due to considerable calculation time, this -#' option is deactivated by default. In addition, the error for the components -#' can be estimated by using internal R functions like [summary]. See the -#' [nls] help page for more information. -#' -#' *For more details on the nonlinear regression in R, see Ritz & Streibig (2008).* -#' -#' @param values [RLum.Data.Curve-class] or [data.frame] (**required**): -#' x,y data of measured values (time and counts). See examples. -#' -#' @param values.bg [RLum.Data.Curve-class] or [data.frame] (*optional*): -#' x,y data of measured values (time and counts) for background subtraction. -#' -#' @param n.components [integer] (*with default*): -#' fixed number of components that are to be recognised during fitting -#' (min = 1, max = 7). -#' -#' @param start_values [data.frame] (*optional*): -#' start parameters for `lm` and `xm` data for the fit. If no start values are given, -#' an automatic start value estimation is attempted (see details). -#' -#' @param input.dataType [character] (*with default*): -#' alter the plot output depending on the input data: `"LM"` or `"pLM"` (pseudo-LM). -#' See: [CW2pLM] -#' -#' @param fit.method [character] (*with default*): -#' select fit method, allowed values: `'port'` and `'LM'`. `'port'` uses the 'port' -#' routine from the function [nls] `'LM'` utilises the function `nlsLM` from -#' the package `minpack.lm` and with that the Levenberg-Marquardt algorithm. -#' -#' @param sample_code [character] (*optional*): -#' sample code used for the plot and the optional output table (mtext). -#' -#' @param sample_ID [character] (*optional*): -#' additional identifier used as column header for the table output. -#' -#' @param LED.power [numeric] (*with default*): -#' LED power (max.) used for intensity ramping in mW/cm^2. -#' **Note:** This value is used for the calculation of the absolute -#' photoionisation cross section. -#' -#' @param LED.wavelength [numeric] (*with default*): -#' LED wavelength in nm used for stimulation. -#' **Note:** This value is used for the calculation of the absolute -#' photoionisation cross section. -#' -#' @param fit.trace [logical] (*with default*): -#' traces the fitting process on the terminal. -#' -#' @param fit.advanced [logical] (*with default*): -#' enables advanced fitting attempt for automatic start parameter recognition. -#' Works only if no start parameters are provided. -#' **Note:** It may take a while and it is not compatible with `fit.method = "LM"`. -#' -#' @param fit.calcError [logical] (*with default*): -#' calculate 1-sigma error range of components using [stats::confint]. -#' -#' @param bg.subtraction [character] (*with default*): -#' specifies method for background subtraction (`polynomial`, `linear`, `channel`, -#' see Details). **Note:** requires input for `values.bg`. -#' -#' @param verbose [logical] (*with default*): -#' terminal output with fitting results. -#' -#' @param plot [logical] (*with default*): -#' returns a plot of the fitted curves. -#' -#' @param plot.BG [logical] (*with default*): -#' returns a plot of the background values with the fit used for the -#' background subtraction. -#' -#' @param ... Further arguments that may be passed to the plot output, e.g. -#' `xlab`, `xlab`, `main`, `log`. -#' -#' @return -#' Various types of plots are returned. For details see above. Furthermore an -#' `RLum.Results` object is returned with the following structure: -#' -#' **`@data:`** -#' -#' `.. $data` : [data.frame] with fitting results\cr -#' `.. $fit` : nls ([nls] object)\cr -#' `.. $component_matrix` : [matrix] with numerical xy-values of the single fitted components with the resolution of the input data -#' `.. $component.contribution.matrix` : [list] component distribution matrix -#' -#' **`info:`** -#' -#' `.. $call` : [call] the original function call -#' -#' Matrix structure for the distribution matrix: -#' -#' Column 1 and 2: time and `rev(time)` values\cr -#' Additional columns are used for the components, two for each component, -#' containing I0 and n0. The last columns `cont.` provide information on -#' the relative component contribution for each time interval including the row -#' sum for this values. -#' -#' @note -#' The pseudo-R^2 may not be the best parameter to describe the goodness -#' of the fit. The trade off between the `n.components` and the pseudo-R^2 -#' value currently remains unconsidered. -#' -#' The function **does not** ensure that the fitting procedure has reached a -#' global minimum rather than a local minimum! In any case of doubt, the use of -#' manual start values is highly recommended. -#' -#' @section Function version: 0.3.4 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [fit_CWCurve], [plot], [nls], [minpack.lm::nlsLM], [get_RLum] -#' -#' @references -#' Bulur, E., 1996. An Alternative Technique For Optically -#' Stimulated Luminescence (OSL) Experiment. Radiation Measurements, 26, 5, -#' 701-709. -#' -#' Jain, M., Murray, A.S., Boetter-Jensen, L., 2003. Characterisation of -#' blue-light stimulated luminescence components in different quartz samples: -#' implications for dose measurement. Radiation Measurements, 37 (4-5), -#' 441-449. -#' -#' Kitis, G. & Pagonis, V., 2008. Computerized curve deconvolution analysis for -#' LM-OSL. Radiation Measurements, 43, 737-741. -#' -#' Lave, C.A.T., 1970. The Demand for Urban Mass Transportation. The Review of -#' Economics and Statistics, 52 (3), 320-323. -#' -#' Ritz, C. & Streibig, J.C., 2008. Nonlinear Regression with R. R. Gentleman, -#' K. Hornik, & G. Parmigiani, eds., Springer, p. 150. -#' -#' @keywords dplot models -#' -#' @examples -#' -#' ##(1) fit LM data without background subtraction -#' data(ExampleData.FittingLM, envir = environment()) -#' fit_LMCurve(values = values.curve, n.components = 3, log = "x") -#' -#' ##(2) fit LM data with background subtraction and export as JPEG -#' ## -alter file path for your preferred system -#' ##jpeg(file = "~/Desktop/Fit_Output\%03d.jpg", quality = 100, -#' ## height = 3000, width = 3000, res = 300) -#' data(ExampleData.FittingLM, envir = environment()) -#' fit_LMCurve(values = values.curve, values.bg = values.curveBG, -#' n.components = 2, log = "x", plot.BG = TRUE) -#' ##dev.off() -#' -#' ##(3) fit LM data with manual start parameters -#' data(ExampleData.FittingLM, envir = environment()) -#' fit_LMCurve(values = values.curve, -#' values.bg = values.curveBG, -#' n.components = 3, -#' log = "x", -#' start_values = data.frame(Im = c(170,25,400), xm = c(56,200,1500))) -#' -#' @md -#' @export -fit_LMCurve<- function( - values, - values.bg, - n.components = 3, - start_values, - input.dataType = "LM", - fit.method = "port", - sample_code = "", - sample_ID = "", - LED.power = 36, - LED.wavelength = 470, - fit.trace = FALSE, - fit.advanced = FALSE, - fit.calcError = FALSE, - bg.subtraction = "polynomial", - verbose = TRUE, - plot = TRUE, - plot.BG = FALSE, - ... -){ - - # (0) Integrity checks ------------------------------------------------------- - - ##(1) data.frame or RLum.Data.Curve object? - if (!is(values, "data.frame") && !is(values, "RLum.Data.Curve")) { - .throw_error("'values' has to be of type 'data.frame' or 'RLum.Data.Curve'") - } - - if (is(values, "RLum.Data.Curve")) { - if (values@recordType != "RBR" && values@recordType != "LM-OSL") { - .throw_error("recordType should be 'RBR' or 'LM-OSL'. ", - "Consider using as(object,'data.frame') if you had used ", - "a pseudo transformation function.") - } - - values <- as(values,"data.frame") - } - - ##(2) data.frame or RLum.Data.Curve object? - if (!missing(values.bg)) { - if (!is(values.bg, "data.frame") && !is(values.bg, "RLum.Data.Curve")) { - .throw_error("'values.bg' must be of type 'data.frame' or 'RLum.Data.Curve'") - } - if (is(values, "RLum.Data.Curve") && values@recordType != "RBR") { - .throw_error("'recordType' should be 'RBR'!") - - }else if(is(values.bg, "RLum.Data.Curve")){ - values.bg <- as(values.bg,"data.frame") - } - } - - ## Set plot format parameters ----------------------------------------------- - extraArgs <- list(...) # read out additional arguments list - - log <- if("log" %in% names(extraArgs)) {extraArgs$log} - else {""} - - xlim <- if("xlim" %in% names(extraArgs)) {extraArgs$xlim} - else {c(min(values[,1]),max(values[,1]))} - - ylim <- if("ylim" %in% names(extraArgs)) {extraArgs$ylim} - else { - - if(input.dataType=="pLM"){ - c(0,max(values[,2]*1.1)) - }else{ - c(min(values[,2]),max(values[,2]*1.1)) - } - - } - - xlab <- if("xlab" %in% names(extraArgs)) {extraArgs$xlab} - else { - - if(input.dataType=="LM"){"Time [s]"}else{"u [s]"} - - } - - ylab <- if("ylab" %in% names(extraArgs)) {extraArgs$ylab} - else { - - if(input.dataType=="LM"){ - paste("LM-OSL [cts/",round(max(values[,1])/length(values[,1]),digits=2)," s]",sep="") - }else{"pLM-OSL [a.u.]"} - } - - - main <- if("main" %in% names(extraArgs)) {extraArgs$main} - else {"Default"} - - cex <- if("cex" %in% names(extraArgs)) {extraArgs$cex} - else {0.8} - - - fun <- if ("fun" %in% names(extraArgs)) extraArgs$fun else FALSE # nocov - - # layout safety settings - par.default <- par()[c("mfrow", "cex", "mar", "omi", "oma")] - on.exit(par(par.default)) - - ##============================================================================## - ## BACKGROUND SUBTRACTION - ##============================================================================## - if(missing(values.bg)==FALSE){ - #set graphical parameters - par(mfrow=c(1,1), cex=1.5*cex) - - ##check if length of bg and signal is consistent - if(length(values[,2])!=length(values.bg[,2])) - .throw_error("Lengths of 'values' and 'values.bg' differ") - - if(bg.subtraction=="polynomial"){ - - #fit polynomial function to background - glm.fit<-glm(values.bg[,2] ~ values.bg[,1]+I(values.bg[,1]^2)+I(values.bg[,1]^3)) - glm.coef<-coef(glm.fit) - - #subtract background with fitted function - values[,2]<-values[,2]- - (glm.coef[4]*values[,1]^3+glm.coef[3]*values[,1]^2+glm.coef[2]*values[,1]+glm.coef[1]) - writeLines("[fit_LMCurve] >> Background subtracted (method=\"polynomial\")!") - - ##plot Background measurement if needed - if(plot.BG==TRUE){ - - plot(values.bg, ylab="LM-OSL [a.u.]", xlab="Time [s]", main="Background") - curve((glm.coef[4]*x^3+glm.coef[3]*x^2+glm.coef[2]*x+glm.coef[1]),add=TRUE,col="red",lwd=2) - text(0,max(values.bg[,2]),paste("y = ", round(glm.coef[4],digits=2), - "*x^3+", - round(glm.coef[3],digits=2), - "*x^2+", - round(glm.coef[2],digits=2), - "*x+", - round(glm.coef[1],digits=2), - sep=""),pos=4) - mtext(side=3,sample_code,cex=.8*cex) - } - - }else if(bg.subtraction=="linear"){ - - #fit linear function to background - glm.fit<-glm(values.bg[,2] ~ values.bg[,1]) - glm.coef<-coef(glm.fit) - - ##substract bg - values[,2]<-values[,2]-(glm.coef[2]*values[,1]+glm.coef[1]) - writeLines("[fit_LMCurve.R] >> Background subtracted (method=\"linear\")!") - - ##plot Background measurement if needed - if(plot.BG){ - - plot(values.bg, ylab="LM-OSL [a.u.]", xlab="Time [s]", main="Background") - curve((glm.coef[2]*x+glm.coef[1]),add=TRUE,col="red",lwd=1.5) - text(0,max(values.bg[,2]),paste("y = ", - round(glm.coef[2],digits=2), - "*x+", - round(glm.coef[1],digits=2), - sep=""),pos=4) - mtext(side=3,sample_code,cex=.8*cex) - - }#endif::plot BG - - }else if(bg.subtraction=="channel"){ - - values[,2]<-values[,2]-values.bg[,2] - writeLines("[fit_LMCurve.R] >> Background subtracted (method=\"channel\")!") - - if(plot.BG==TRUE){ - - plot(values.bg, ylab="LM-OSL [a.u.]", xlab="Time [s]", main="Background") - mtext(side=3,sample_code,cex=.8*cex) - } - - } else { - .throw_error("Invalid method for background subtraction") - } - } - - - ##============================================================================## - ## FITTING - ##============================================================================## - - .validate_positive_scalar(n.components, int = TRUE) - - ##------------------------------------------------------------------------## - ##set function for fit equation (according Kitis and Pagonis, 2008) - ##////equation used for fitting////(start) - fit.equation<-function(Im.i,xm.i){ - equation<-parse( - text=paste("exp(0.5)*Im[",Im.i,"]*(values[,1]/xm[",xm.i,"])*exp(-values[,1]^2/(2*xm[",xm.i,"]^2))", - collapse="+",sep="")) - return(equation) - } - ##////equation used for fitting///(end) - ##------------------------------------------------------------------------## - - ##set formula elements for fitting functions - ## the upper two functions should be removed ... but chances are needed ... TODO - ##////equation used for fitting////(start) - fit.formula <- function(n.components){ - - Im <- paste0("Im.",1:n.components) - xm <- paste0("xm.",1:n.components) - - as.formula(paste0("y ~ ", paste("(exp(0.5) * ", Im, "* x/", xm, ") * exp(-x^2/(2 *",xm,"^2))", collapse=" + "))) - - } - ##////equation used for fitting///(end) - - ##------------------------------------------------------------------------## - ##automatic start parameter estimation - - ##set fit function - fit.function <- fit.equation(Im.i = 1:n.components, xm.i = 1:n.components) - - if(missing(start_values)){ - - ##set b (detrapping) values for a 7-component function taken from Jain et al. (2003) - b.pseudo<-c(32,2.5,0.65,0.15,0.025,0.0025,0.00030) - - ##calculate xm parameters from values set based on the pseudo curves - xm.pseudo<-sqrt(max(values[,1])/b.pseudo) - - ##the Im values obtaind by calculating residuals - xm.residual<-sapply(1:length(b.pseudo),function(x){abs(values[,1]-xm.pseudo[x])}) - xm.residual<-cbind(xm.residual,values[,1]) - Im.pseudo<-sapply(1:length(xm.pseudo),function(x){ - min(xm.residual[which(xm.residual[,x]==min(xm.residual[,x])),8])#8 is time index - }) - - ##set additional variables - b.pseudo_start<-1 - b.pseudo_end<-0 - fit.trigger<-FALSE - - while(fit.trigger==FALSE){ - - - xm <- xm.pseudo[b.pseudo_start:(n.components + b.pseudo_end)] - Im <- Im.pseudo[b.pseudo_start:(n.components + b.pseudo_end)] - - if(fit.advanced){ - ##---------------------------------------------------------------## - ##MC for fitting parameter - ##make the fitting more stable by small variations of the parameters - - ##sample input parameters values from a normal distribution - xm.MC<-sapply(1:length(xm),function(x){ - xm.MC<-sample(rnorm(30,mean=xm[x],sd=xm[x]/10), replace=TRUE) - }) - - - Im.MC<-sapply(1:length(xm),function(x){ - Im.MC<-sample(rnorm(30,mean=Im[x],sd=Im[x]/10), replace=TRUE) - - }) - ##---------------------------------------------------------------## - - for(i in 1:length(xm.MC[,1])){ - - ##NLS ##try fit - fit<-try(nls(y~eval(fit.function), - trace=fit.trace, - data=data.frame(x=values[,1],y=values[,2]), - algorithm="port", - start=list(Im=Im.MC[i,],xm=xm.MC[i,]),#end start values input - nls.control( - maxiter=500 - ),#end nls control - lower=c(xm=min(values[,1]),Im=0), - upper=c(xm=max(values[,1]),Im=max(values[,2]*1.1)) - ),# nls - silent=TRUE)# end try - ##graphical output - if(i==1){cat(paste("[fit_LMCurve()] >> advanced fitting attempt (#", - b.pseudo_start,"): ",sep=""))} - cat("*") - - if(inherits(fit,"try-error") == FALSE){break} - }#end::forloop - - cat("\n") - - }else{ - - - if(fit.method == "port") { - fit <- try(nls( - y ~ eval(fit.function), - trace = fit.trace, - data = data.frame(x = values[,1],y = values[,2]), - algorithm = "port", - start = list(Im = Im,xm = xm),#end start values input - nls.control(maxiter = 500),#end nls control - lower = c(xm = 0,Im = 0) - ),# nls - silent = TRUE) - # end try - - }else if (fit.method == "LM") { - ##re-name for method == "LM" - names(Im) <- paste0("Im.", 1:n.components) - names(xm) <- paste0("xm.", 1:n.components) - start.list <- c(as.list(Im), as.list(xm)) - lower <- - vapply(start.list, function(x) { - start.list[[x]] <- 0 - }, FUN.VALUE = vector(mode = "numeric", length = 1)) - - fit <- try(minpack.lm::nlsLM( - fit.formula(n.components), - data = data.frame(x = values[,1], - y = values[,2]), - start = start.list, - lower = lower, - trace = fit.trace, - control = minpack.lm::nls.lm.control(maxiter = 500) - ), silent = TRUE) - - }else{ - .throw_error("Unknown method for 'fit.method'") - } - - }#endifelse::fit.advanced - - - if(inherits(fit,"try-error")==FALSE){fit.trigger<-TRUE} - else{ - - if((n.components+b.pseudo_end)==7){fit.trigger<-TRUE - }else{ - b.pseudo_start<-b.pseudo_start+1 - b.pseudo_end<-b.pseudo_end+1 - }#endif::maximum loops - }#endif::try-error - }#end:whileloop fit trigger - - }else{#endif::missing start values - ##------------------------------------------------------------------------## - fit<-try(nls(y~eval(fit.function), - trace=fit.trace, data.frame(x=values[,1],y=values[,2]), - algorithm="port", start=list(Im=start_values[,1],xm=start_values[,2]),#end start values input - nls.control(maxiter=500), - lower=c(xm=0,Im=0), - #upper=c(xm=max(x),Im=max(y)*1.1)# set lower boundaries for components - ), outFile = stdout() # redirect error messages so they can be silenced - ) # end try - }#endif::startparameter - - ##------------------------------------------------------------------------## - - ##grep parameters - if(inherits(fit,"try-error")==FALSE){ - parameters<-coef(fit) - - ##write parameters in vectors and order parameters - Im<-parameters[1:(length(parameters)/2)] - Im.names <- names(Im) - xm<-parameters[(1+(length(parameters)/2)):length(parameters)] - xm.names <- names(xm) - - ##order parameters - o <- order(xm) - xm <- xm[o] - names(xm) <- xm.names - Im <- Im[o] - names(Im) <- Im.names - - if (verbose){ - ##print rough fitting information - use the nls() control for more information - writeLines("\n[fit_LMCurve()]") - writeLines(paste("\nFitting was done using a ",n.components, "-component function:\n",sep="")) - - ##print parameters - print(c(xm, Im)) - - #print some additional information - writeLines("\n(equation used for fitting according to Kitis & Pagonis, 2008)") - }#end if - - ##============================================================================## - ## Additional Calculations - ##============================================================================## - - ##calculate stimulation intensity Schmidt (2008) - - ##Energy - E = h*v - h<-6.62606957e-34 #in W*s^2 - Planck constant - ny<-299792458/(LED.wavelength/10^9) #frequency of the light - E<-h*ny - - ##transform LED.power in W/cm^2 - LED.power<-LED.power/1000 - - stimulation_intensity<-LED.power/E - - - ##calculate b and n from the equation of Bulur(1996) to compare results - ##Using Equation 5 and 6 from Kitis (2008) - b<-as.vector(max(values[,1])/xm^2) #detrapping probability - n0<-as.vector((Im/exp(-0.5))*xm) - - - ##CALCULATE 1- sigma CONFIDENCE INTERVAL - ##------------------------------------------------------------------------## - b.error <- rep(NA, n.components) - n0.error <- rep(NA, n.components) - - if(fit.calcError){ - ##option for confidence interval - values.confint <- try(confint(fit, level = 0.68), silent = TRUE) - - if(!inherits(values.confint, "try-error")) { - Im.confint <- values.confint[1:(length(values.confint[, 1]) / 2), ] - xm.confint <- values.confint[((length(values.confint[,1])/2)+1):length(values.confint[,1]),] - - ##error calculation - b.error < -as.vector(abs((max(values[,1])/xm.confint[,1]^2)-(max(values[,1])/xm.confint[,2]^2))) - n0.error <- as.vector(abs(((Im.confint[,1]/exp(-0.5))*xm.confint[,1]) - ((Im.confint[,2]/exp(-0.5))*xm.confint[,2]))) - - } else { - .throw_warning("The computation of the parameter confidence intervals ", - "failed. Please try to run stats::confint() manually ", - "on the $fit output object") - } - } - ##------------------------------------------------------------------------## - - - ##calculate photoionisation cross section and print on terminal - ##using EQ (5) in Kitis - cs<-as.vector((max(values[,1])/xm^2)/stimulation_intensity) - rel_cs<-round(cs/cs[1],digits=4) - - ##coefficient of determination after law - RSS <- sum(residuals(fit)^2) #residual sum of squares - TSS <- sum((values[,2] - mean(values[,2]))^2) #total sum of squares - pR<-round(1-RSS/TSS,digits=4) - - ##============================================================================## - ## COMPONENT TO SUM CONTRIBUTION MATRIX - ##============================================================================## - - ##+++++++++++++++++++++++++++++++ - ##set matrix - ##set polygon matrix for optional plot output - component.contribution.matrix <- matrix(NA, - nrow = length(values[,1]), - ncol = (2*length(xm)) + 2) - - ##set x-values - component.contribution.matrix[,1] <- values[,1] - component.contribution.matrix[,2] <- rev(values[,1]) - - ##+++++++++++++++++++++++++++++++ - ##set 1st polygon - ##1st polygon (calculation) - y.contribution_first <- (exp(0.5)*Im[1]*values[,1]/ - xm[1]*exp(-values[,1]^2/(2*xm[1]^2))/ - (eval(fit.function))*100) - - ##avoid NaN values (might happen with synthetic curves) - y.contribution_first[is.nan(y.contribution_first)==TRUE] <- 0 - - ##set values in matrix - component.contribution.matrix[,3] <- 100 - component.contribution.matrix[,4] <- 100-rev(y.contribution_first) - - ##+++++++++++++++++++++++++++++++ - ##set polygons in between - ##polygons in between (calculate and plot) - if (length(xm)>2){ - - y.contribution_prev <- y.contribution_first - i<-2 - - ##matrix stepping - k <- seq(3, ncol(component.contribution.matrix), by=2) - - while (i<=length(xm)-1) { - y.contribution_next<-(exp(0.5)*Im[i]*values[,1]/ - xm[i]*exp(-values[,1]^2/(2*xm[i]^2))/ - (eval(fit.function))*100) - - ##avoid NaN values - y.contribution_next[is.nan(y.contribution_next)==TRUE] <- 0 - - ##set values in matrix - component.contribution.matrix[, k[i]] <- 100-y.contribution_prev - component.contribution.matrix[, k[i]+1] <- rev(100-y.contribution_prev- - y.contribution_next) - - y.contribution_prev <- y.contribution_prev + y.contribution_next - - i<-i+1 - }#end while loop - }#end if - - ##+++++++++++++++++++++++++++++++ - ##set last polygon - - ##last polygon (calculation) - y.contribution_last<-(exp(0.5)*Im[length(xm)]*values[,1]/ - xm[length(xm)]*exp(-values[,1]^2/ - (2*xm[length(xm)]^2))/ - (eval(fit.function))*100) - - ##avoid NaN values - y.contribution_last[is.nan(y.contribution_last)==TRUE]<-0 - - component.contribution.matrix[,((2*length(xm))+1)] <- y.contribution_last - component.contribution.matrix[,((2*length(xm))+2)] <- 0 - - ##change names of matrix to make more easy to understand - component.contribution.matrix.names <- c("x", "rev.x", - paste(c("y.c","rev.y.c"),rep(1:n.components,each=2), sep="")) - - - ##calculate area for each component, for each time interval - component.contribution.matrix.area <- sapply( - seq(3,ncol(component.contribution.matrix),by=2), - function(x){ - matrixStats::rowDiffs(cbind(rev(component.contribution.matrix[,(x+1)]), - component.contribution.matrix[,x])) - - }) - - ##append to existing matrix - component.contribution.matrix <- cbind( - component.contribution.matrix, - component.contribution.matrix.area, - rowSums(component.contribution.matrix.area) - ) - - ##set final column names - colnames(component.contribution.matrix) <- c( - component.contribution.matrix.names, - paste(c("cont.c"),rep(1:n.components,each=1), sep=""), - "cont.sum") - - ##============================================================================## - ## Terminal Output (advanced) - ##============================================================================## - if (verbose){ - ##write fill lines - writeLines("------------------------------------------------------------------------------") - writeLines("(1) Corresponding values according to the equation in Bulur, 1996 for b and n0:\n") - for (i in 1:length(b)){ - writeLines(paste("b",i," = ",format(b[i],scientific=TRUE)," +/- ",format(b.error[i],scientific=TRUE),sep="")) - writeLines(paste("n0",i," = ",format(n0[i],scientific=TRUE)," +/- ",format(n0.error[i],scientific=TRUE),"\n",sep="")) - }#end for loop - - ##write photoionisation cross section on terminal - for (i in 1:length(cs)){ - writeLines(paste("cs from component.",i," = ",format(cs[i],scientific=TRUE, digits=4), " cm^2", - "\t >> relative: ",round(cs[i]/cs[1],digits=4),sep="")) - - }#end for loop - - writeLines(paste( - "\n(stimulation intensity value used for calculation: ",format(stimulation_intensity,scientific=TRUE)," 1/s 1/cm^2)",sep="")) - writeLines("(errors quoted as 1-sigma uncertainties)") - writeLines("------------------------------------------------------------------------------\n") - - #sum of squares - writeLines(paste("pseudo-R^2 = ",pR,sep="")) - }#end if - - ##============================================================================## - ## COMPOSE RETURN VALUES (data.frame) - ##============================================================================## - - ##write output table if values exists - if (exists("fit")){ - ##set data.frame for a max value of 7 components - output.table <- data.frame(NA,NA,NA,NA,NA,NA,NA,NA, - NA,NA,NA,NA,NA,NA,NA,NA, - NA,NA,NA,NA,NA,NA,NA,NA, - NA,NA,NA,NA,NA,NA,NA,NA, - NA,NA,NA,NA,NA,NA,NA,NA, - NA,NA,NA,NA,NA,NA,NA,NA, - NA,NA,NA,NA,NA,NA,NA,NA) - - output.tableColNames<-c("Im1","xm1", - "b1","b1.error","n01","n01.error", - "cs1","rel_cs1", - "Im2","xm2", - "b2","b2.error","n02","n02.error", - "cs2","rel_cs2", - "Im3","xm3", - "b3","b3.error","n03","n03.error", - "cs3","rel_cs3", - "Im4","xm4", - "b4","b4.error","n04","n04.error", - "cs4","rel_cs4", - "Im5","xm5", - "b5","b5.error","n05","n05.error", - "cs5","rel_cs5", - "Im6","xm6", - "b6","b6.error","n06","n06.error", - "cs6","rel_cs6", - "Im7","xm7", - "b7","b7.error","n07","n07.error", - "cs7","rel_cs7") - - - ##write components in output table - i<-0 - k<-1 - while(i<=n.components*8){ - output.table[1,i+1]<-Im[k] - output.table[1,i+2]<-xm[k] - output.table[1,i+3]<-b[k] - output.table[1,i+4]<-b.error[k] - output.table[1,i+5]<-n0[k] - output.table[1,i+6]<-n0.error[k] - output.table[1,i+7]<-cs[k] - output.table[1,i+8]<-rel_cs[k] - i<-i+8 - k<-k+1 - } - - ##add pR and n.components - output.table<-cbind(sample_ID,sample_code,n.components,output.table,pR) - - ###alter column names - colnames(output.table)<-c("ID","sample_code","n.components",output.tableColNames,"pseudo-R^2") - - ##----------------------------------------------------------------------------## - }#endif::exists fit - - }else{ - output.table <- NA - component.contribution.matrix <- NA - message("[fit_LMCurve] Fitting Error: Plot without fit produced!") - - } - - # Calculate component curves ---------------------------------------------- - component_matrix <- NA - if(!inherits(fit,"try-error")){ - component_matrix <- matrix(NA, nrow = nrow(values), ncol = 2 + length(Im)) - colnames(component_matrix) <- c("TIME", "SUM", paste("COMP_", 1:length(Im))) - component_matrix[, 1] <- values[, 1] - component_matrix[, 2] <- eval(fit.function) - - ## add single components - for(i in 1:length(Im)){ - component_matrix[, 2 + i] <- - exp(0.5) * Im[i] * values[, 1] / - xm[i] * exp(-values[, 1] ^ 2 / (2 * xm[i] ^ 2)) - - } - } - - # Plotting ---------------------------------------------------------------- - if(plot){ - ##cheat the R check routine - x <- NULL; rm(x) - - ##grep package colour gallery - col <- get("col", pos = .LuminescenceEnv) - - ##change xlim values in case of the log plot the avoid problems - if((log == "x" | log == "xy") && xlim[1] == 0){ - warning("[fit_LMCurve()] x-axis limitation change to avoid 0 values for log-scale!", call. = FALSE) - xlim <- c(2^0.5/2 * max(values[,1])/length(values[,1]), xlim[2]) - - } - - ##set plot frame - layout(matrix(c(1,2,3),3,1, byrow=TRUE),c(1.6,1,1), c(1,0.3,0.4),TRUE) - par(oma = c(1,1,1,1), mar = c(0,4,3,0), cex=cex) - - ##==upper plot==## - ##open plot area - plot( - NA, - NA, - xlim = xlim, - ylim = ylim, - xlab = "", - xaxt = "n", - main = main, - log = log, - ylab = ylab - )#endplot - - mtext(side=3,sample_code,cex=0.8*cex) - - ##plotting measured signal - points(values[, 1], - values[, 2], - pch = 20, - col = rgb(0.4, 0.4, 0.4, 0.5)) - - ##==pseudo curve==##------------------------------------------------------# - - ##curve for used pseudo values - if(inherits(fit,"try-error")==TRUE & missing(start_values)==TRUE){ - fit.function<-fit.equation(Im.i=1:n.components,xm.i=1:n.components) - Im<-Im.pseudo[1:n.components] - xm<-xm.pseudo[1:n.components] - - ##draw pseudo curve - lines(values[,1],eval(fit.function), lwd=2, col="red", lty=2) - - axis(side=1) - mtext(side=1,xlab, cex=.9*cex,line=2) - - mtext(side=4,paste(n.components, " component pseduo function is shown",sep=""),cex=0.7, col="blue") - - ##draw information text on plot - text(min(values[,1]),max(values[,2]),"FITTING ERROR!",pos=4) - - ##additional legend - legend("topright",c("pseudo sum function"),lty=2,lwd=2,col="red",bty="n") - - } - ##==pseudo curve==##------------------------------------------------------## - - ##plot sum function - if(inherits(fit,"try-error")==FALSE){ - lines(values[,1],eval(fit.function), lwd=2, col="black") - legend.caption<-"sum curve" - curve.col<-1 - - ##plot signal curves - - ##plot curve for additional parameters - for (i in 1:length(xm)) { - curve(exp(0.5)*Im[i]*x/xm[i]*exp(-x^2/(2*xm[i]^2)),col=col[i+1], lwd=2,add=TRUE) - legend.caption<-c(legend.caption,paste("component ",i,sep="")) - curve.col<-c(curve.col,i+1) - } - ##plot legend - legend(if(log=="x"| log=="xy"){ - if(input.dataType=="pLM"){"topright"}else{"topleft"}}else{"topright"}, - legend.caption,lty=1,lwd=2,col=col[curve.col], bty="n") - - - ##==lower plot==## - ##plot residuals - par(mar=c(4.2,4,0,0)) - plot(values[,1],residuals(fit), - xlim=xlim, - xlab=xlab, - type="l", - col="grey", - ylab="Residual", - lwd=2, - log=log) - - ##ad 0 line - abline(h=0) - - - ##------------------------------------------------------------------------# - ##++component to sum contribution plot ++## - ##------------------------------------------------------------------------# - - ##plot component contribution to the whole signal - #open plot area - par(mar=c(4,4,3.2,0)) - plot(NA,NA, - xlim=xlim, - ylim=c(0,100), - ylab="Contribution [%]", - xlab=xlab, - main="Component contribution to sum curve", - log=if(log=="xy"){"x"}else{log}) - - stepping <- seq(3,length(component.contribution.matrix),2) - - for(i in 1:length(xm)){ - - polygon(c(component.contribution.matrix[,1], - component.contribution.matrix[,2]), - c(component.contribution.matrix[,stepping[i]], - component.contribution.matrix[,stepping[i]+1]), - col = col[i+1]) - } - rm(stepping) - - ##------------------------------------------------------------------------## - }#end if try-error for fit - - if (fun == TRUE) sTeve() # nocov - } - ##----------------------------------------------------------------------------- - ##remove objects - try(unlist("parameters")) - - ##============================================================================# - ## Return Values - ##============================================================================# - newRLumResults.fit_LMCurve <- set_RLum( - class = "RLum.Results", - data = list( - data = output.table, - fit = fit, - component_matrix = component_matrix, - component.contribution.matrix = list(component.contribution.matrix) - ), - info = list(call = sys.call()) - ) - - invisible(newRLumResults.fit_LMCurve) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/fit_OSLLifeTimes.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/fit_OSLLifeTimes.R deleted file mode 100644 index b90463a3c..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/fit_OSLLifeTimes.R +++ /dev/null @@ -1,799 +0,0 @@ -#' Fitting and Deconvolution of OSL Lifetime Components -#' -#' @details -#' The function intends to provide an easy access to pulsed optically stimulated luminescence (POSL) data, -#' in order determine signal lifetimes. The fitting is currently optimised to work with the off-time flank of POSL measurements -#' only. For the signal deconvolution, a differential evolution optimisation is combined with nonlinear least-square fitting -#' following the approach by Bluszcz & Adamiec (2006). -#' -#' **Component deconvolution algorithm** -#' -#' The component deconvolution consists of two steps: -#' -#' (1) Adaptation phase -#' -#' In the adaptation phase the function tries to figure out the optimal and statistically justified -#' number of signal components following roughly the approach suggested by Bluszcz & Adamiec (2006). In -#' contrast to their work, for the optimisation by differential evolution here the package `'DEoptim'` is used. -#' -#' The function to be optimized has the form: -#' -#' \deqn{\chi^2 = \sum(w * (n_i/c - \sum(A_i * exp(-x/(tau_i + t_p))))^2)} -#' -#' with \eqn{w = 1} for unweighted regression analysis (`method_control = list(weights = FALSE)`) or -#' \eqn{w = c^2/n_i} for weighted regression analysis. The default values is `TRUE`. -#' -#' \deqn{F = (\Delta\chi^2 / 2) / (\chi^2/(N - 2*m - 2))} -#' -#' (2) Final fitting -#' -#' **`method_control`** -#' -#' \tabular{lll}{ -#' **Parameter** \tab **Type** \tab **Description**\cr -#' `p` \tab [numeric] \tab controls the probability for the F statistic reference values. For a significance level of 5 % a value of 0.95 (the default) should be added, for 1 %, a value of 0.99 is sufficient: 1 > p > 0 (cf. [stats::FDist])\cr -#' `seed` \tab [numeric] \tab set the seed for the random number generator, provide a value here to get reproducible results \cr -#' `DEoptim.trace` \tab [logical] \tab enables/disables the tracing of the differential evolution (cf. [DEoptim::DEoptim.control]) \cr -#' `DEoptim.itermax` \tab [logical] \tab controls the number of the allowed generations (cf. [DEoptim::DEoptim.control]) \cr -#' `weights` \tab [logical] \tab enables/disables the weighting for the start parameter estimation and fitting (see equations above). -#' The default values is `TRUE` \cr -#' `nlsLM.trace` \tab [logical] \tab enables/disables trace mode for the nls fitting ([minpack.lm::nlsLM]), can be used to identify convergence problems, default is `FALSE` \cr -#' `nlsLM.upper` \tab [logical] \tab enables/disables upper parameter boundary, default is `TRUE` \cr -#' `nlsLM.lower` \tab [logical] \tab enables/disables lower parameter boundary, default is `TRUE` -#' } -#' -#' @param object [RLum.Data.Curve-class], [RLum.Analysis-class], [data.frame] or [matrix] **(required)**: -#' Input object containing the data to be analysed. All objects can be provided also as list for an automated -#' processing. Please note: `NA` values are automatically removed and the dataset should comprise at least 5 data points (possibly more if `n.components` is -#' set to a value greater than 1) -#' -#' @param tp [numeric] (*with default*): option to account for the stimulation pulse width. For off-time measurements -#' the default value is 0. `tp` has the same unit as the measurement data, e.g., µs. Please set this parameter -#' carefully, if it all, otherwise you may heavily bias your fit results. -#' -#' @param signal_range [numeric] (*optional*): allows to set a channel range, by default all channels are used, e.g. -#' `signal_range = c(2,100)` considers only channels 2 to 100 and `signal_range = c(2)` considers only channels -#' from channel 2 onwards. -#' -#' @param n.components [numeric] (*optional*): Fix the number of components. If set the algorithm will try -#' to fit the number of predefined components. If nothing is set, the algorithm will try to find the best number -#' of components. -#' -#' @param method_control [list] (*optional*): Named to allow a more fine control of the fitting process. See details -#' for allowed options. -#' -#' @param plot [logical] (*with default*): Enable/disable plot output -#' -#' @param plot_simple [logical] (*with default*): Enable/disable reduced plot output. If `TRUE`, no -#' residual plot is shown, however, plot output can be combined using the standard R layout options, -#' such as `par(mfrow = c(2,2))`. -#' -#' @param verbose [logical] (*with default*): Enable/disable terminal feedback -#' -#' @param ... parameters passed to [plot.default] to control the plot output, supported are: -#' `main`, `xlab`, `ylab`, `log`, `xlim`, `ylim`, `col`, `lty`, `legend.pos`, `legend.text`. If the input -#' object is of type [RLum.Analysis-class] this arguments can be provided as a [list]. -#' -#' @return -#' -#' -----------------------------------\cr -#' `[ NUMERICAL OUTPUT ]`\cr -#' -----------------------------------\cr -#' -#' **`RLum.Results`**-object -#' -#' **slot:** **`@data`** -#' -#' \tabular{lll}{ -#' **Element** \tab **Type** \tab **Description**\cr -#' `$data` \tab `matrix` \tab the final fit matrix \cr -#' `$start_matrix` \tab `matrix` \tab the start matrix used for the fitting \cr -#' `$total_counts` \tab `integer` \tab Photon count sum \cr -#' `$fit` \tab `nls` \tab the fit object returned by [minpack.lm::nls.lm] \cr -#' } -#' -#' -#'**slot:** **`@info`** -#' -#' The original function call -#' -#' ------------------------\cr -#' `[ TERMINAL OUTPUT ]`\cr -#' ------------------------\cr -#' -#' Terminal output is only shown of the argument `verbose = TRUE`. -#' -#' *(1) Start parameter and component adaption*\cr -#' Trave of the parameter adaptation process -#' -#' *(2) Fitting results (sorted by ascending tau)*\cr -#' The fitting results sorted by ascending tau value. Please note -#' that if you access the `nls` fitting object, the values are not sorted. -#' -#' *(3) Further information*\cr -#' - The photon count sum -#' - Durbin-Watson residual statistic to asses whether the residuals are correlated, ideally -#' the residuals should be not correlated at all. Rough measures are: \cr -#' D = 0: the residuals are systematically correlated \cr -#' D = 2: the residuals are randomly distributed \cr -#' D = 4: the residuals are systematically anti-correlated\cr -#' -#' You should be suspicious if D differs largely from 2. -#' -#' -#' ------------------------\cr -#' `[ PLOT OUTPUT ]`\cr -#' ------------------------\cr -#' -#' A plot showing the original data and the fit so far possible. The lower plot shows the -#' residuals of the fit. -#' -#' @section Function version: 0.1.5 -#' -#' @author Sebastian Kreutzer, Geography & Earth Sciences, Aberystwyth University, -#' Christoph Schmidt, University of Bayreuth (Germany) -#' -#' @seealso [minpack.lm::nls.lm], [DEoptim::DEoptim] -#' -#' @references -#' Bluszcz, A., Adamiec, G., 2006. Application of differential evolution to fitting OSL decay curves. -#' Radiation Measurements 41, 886-891. \doi{10.1016/j.radmeas.2006.05.016}\cr -#' -#' Durbin, J., Watson, G.S., 1950. Testing for Serial Correlation in Least Squares Regression: I. -#' Biometrika 37, 409-21. doi:10.2307/2332391 -#' -#' **Further reading** -#' -#' Hughes, I., Hase, T., 2010. Measurements and Their Uncertainties. Oxford University Press. -#' -#' Storn, R., Price, K., 1997. Differential Evolution – -#' A Simple and Efficient Heuristic for Global Optimization over Continuous Spaces. -#' Journal of Global Optimization 11, 341–359. -#' -#'@examples -#' -#'##load example data -#'data(ExampleData.TR_OSL, envir = environment()) -#' -#'##fit lifetimes (short run) -#'fit_OSLLifeTimes( -#' object = ExampleData.TR_OSL, -#' n.components = 1) -#' -#'##long example -#'\dontrun{ -#'fit_OSLLifeTimes( -#' object = ExampleData.TR_OSL) -#' } -#' -#'@md -#'@export -fit_OSLLifeTimes <- function( - object, - tp = 0, - signal_range = NULL, - n.components = NULL, - method_control = list(), - plot = TRUE, - plot_simple = FALSE, - verbose = TRUE, - ... - ){ - - -# Self-call ----------------------------------------------------------------------------------- -if(inherits(object, "list") || inherits(object, "RLum.Analysis")){ - ##allow RLum.Analysis objects - if(all(vapply(object, function(x){ - inherits(x, "RLum.Analysis")}, logical(1)))){ - object <- lapply(object, function(x){x@records}) - object <- .unlist_RLum(object) - - } - - ##expand parameters - ##n.components - if(!is.null(n.components)) - n.components <- as.list(rep(n.components, length(object))) - - ##tp - tp <- as.list(rep(tp, length(object))) - - ## names of extra arguments - arg_names <- names(list(...)) - - ##pretreat some of the ... settings to avoid - ## expand all arguments - arg_list <- NULL - if(!is.null(arg_names)){ - arg_list <- lapply(arg_names , function(x){ - unlist(rep(list(...)[[x]], length.out = length(object))) - }) - - ## make sure we organise this list (not nice but it works) - arg_list <- lapply(1:length(object), function(x){ - args <- lapply(1:length(arg_names), function(y){ - arg_list[[y]][[x]] - - }) - names(args) <- arg_names - args - - }) - } - - ##run function - temp_results <- lapply(1:length(object), function(x){ - temp <- try(do.call(what = fit_OSLLifeTimes, - c(list( - object = object[[x]], - tp = tp[[x]], - signal_range = signal_range, - n.components = n.components[[x]], - method_control = method_control, - plot = plot, - plot_simple = plot_simple, - verbose = verbose - ), - arg_list[[x]]) - - ), silent = FALSE) - - if(inherits(temp, "try-error")){ - return(NULL) - - }else{ - return(temp) - } - }) - - ##combine results and return - results <- merge_RLum(temp_results) - - if(!is.null(results)) - results@originator <- "fit_OSLLifeTimes" - - ##return - return(results) - -} - -# Input integrity tests ------------------------------------------------------------------ - if(inherits(object, "RLum.Data.Curve")){ - if(!grepl(pattern = "POSL", x = object@recordType, fixed = TRUE)) - .throw_error("recordType ", object@recordType, - " not supported for input object") - - df <- as.data.frame(object@data) - - }else if(inherits(object, "data.frame")){ - df <- object[,1:2] - - } else if(inherits(object, "matrix")){ - df <- as.data.frame(object[,1:2]) - - }else{ - message("[fit_OSLLifeTime()] Error: Class '", class(object), - "' not supported as input, NULL returned!") - return(NULL) - - } - - ##remove NA values, whatever it is worth for - if(any(is.na(df))){ - df <- na.exclude(df) - .throw_warning("NA values detected and removed from dataset") - } - - ##rename columns for data.frame - colnames(df) <- c("x","y") - - #check for 0 data in dataset ... we opt for hard stop - if(any(df[[2]] == 0)){ - .throw_warning("The dataset contains 0, a value of 0.1 ", - "has been added to your count values") - df[[2]] <- df[[2]] + 0.1 - } - - ##save original data for later - df_raw <- df - - ##signal_range - if(!is.null(signal_range)){ - if (!is.numeric(signal_range)) - .throw_error("'signal_range' must be of type numeric") - - ##check lengths - if(length(signal_range) == 1) - signal_range <- c(signal_range, nrow(df)) - - if(length(signal_range) > 2) - .throw_warning("'signal_range' has more than 2 elements, ", - "only the first 2 will be used") - - if(signal_range[2] > nrow(df)){ - .throw_warning("'signal_range' > number of channels, reset to maximum") - signal_range[2] <- nrow(df) - } - - if(signal_range[1] > signal_range[2]){ - .throw_warning("'signal_range' first element > last element, reset to default") - signal_range <- c(1, nrow(df)) - } - - ##set range - df <- df[signal_range[1]:signal_range[2],] - - } - - ## number of components requested - .validate_positive_scalar(n.components, int = TRUE, null.ok = TRUE) - if (is.null(n.components)){ - m <- 1 - } else{ - m <- n.components - } - - ## ensure that we have a minimum of data points available: the minimum - ## is computed so that the degrees of freedom for the F distribution is - ## positive (see `qf()` in the `while` loop further down at (B)) - min.num.signals <- 2 * m + 2 + 1 - if (nrow(df) < min.num.signals) { - message("[fit_OSLLifeTimes()] Error: For ", m, " components ", - "the dataset must have at least ", min.num.signals, - " signal points, NULL returned") - return(NULL) - } - - -# Fitting ------------------------------------------------------------------------------------- - - ##(0) CONTROL +++++++++++++++++++++++++++++++++++++++++++++++++++++ - method_control_setting <- list( - p = 0.95, - seed = NULL, - DEoptim.trace = FALSE, - DEoptim.itermax = 1000, - weights = TRUE, - nlsLM.trace = FALSE, - nlsLM.upper = TRUE, - nlsLM.lower = TRUE - - ) - - ##udpate list if the user did something - method_control_setting <- modifyList(x = method_control_setting, val = method_control) - - ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ##(A) SETTINGS - ## - ## - ##(1) >> set fitting function for minpack.lm - x <- 0 #cheat R check routine - fit_formula <- function(n.components, tp) { - A <- paste0("A.",1:n.components) - tau <- paste0("tau.",1:n.components) - as.formula(paste0("y ~ ", paste(A," * exp(- x/(",tau," + ", tp, "))", collapse = " + "))) - - } - ## - ## - ##(2) create formula for differential evolution run - fn_constructor <- function(m){ - ##get length of x-vector - x_len <- 1:(2 * m) - - ##generate term - term <- vapply(seq(1,length(x_len), by = 2), function(i){ - paste0("(x[", i, "] * exp(-t/(x[", i + 1, "] + tp)))") - - },character(1)) - - ##parse - term <- paste(term, collapse = " + ") - - ##set weight (should be given as character) - if(method_control_setting$weights){ - w <- "c^2/n" - - }else{ - w <- "1" - - } - - ##combine - term <- paste0("sum(",w," * ((n/c) - (",term,"))^2)") - - ##parse ... if we do it here, we boost the speed of the evaluation - parse(text = eval(term)) - - } - ## - ## - ##(3) initialise objects - chi_squared <- c(NA, NA) - F <- c(Inf, Inf) - start <- NULL - - ## - ## - ##(4) set seed - if(!is.null(method_control_setting$seed)) - set.seed(method_control_setting$seed) - - ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ##(B) RUN DIFFERENTIAL EVOLUTION TO DETERMINE NUMBER OF COMPONENTS - ##prevent collateral damage, so we want a data.frame that has at least 10 rows - if(verbose){ - cat("\n[fit_OSLLifeTime()]\n") - cat("\n(1) Start parameter and component adapation") - cat("\n---------------------(start adaption)------------------------------------") - - } - - while(!is.na(suppressWarnings(qf(method_control_setting$p, df1 = 2, df2 = length(df[[2]]) - 2 * m - 2))) && ( - F[2] > qf(method_control_setting$p, df1 = 2, df2 = length(df[[2]]) - 2 * m - 2) & F[1] >= F[2])){ - - ##set F - F[1] <- F[2] - - ##construct formula outside of the loop; needs to be done here, otherwise the performance - ##goes down - formula_string <- fn_constructor(m) - - ##set fn - set_tp <- tp - set_c <- diff(c(0,df[[1]])) - set_t <- df[[1]] - set_n <- df[[2]] - - ##set function - ##Personal reminder: - ##Why this function is not written in C++ ... because it adds basically nothing - ##in terms of speed ~ 10 µs faster, but needed to be compiled and thus cannot be changed - ##directly in the code - fn <- function(x, tp = set_tp, n = set_n, c = set_c, t = set_t, term = formula_string){ - eval(formula_string) - } - - ##set start parameters - if(!is.null(start)) - start_parameters <- start$optim$bestmem - - ##run differential evolution - start <- DEoptim::DEoptim( - fn = fn, - lower = rep(0, 2 * m), - upper = rep(c(10 * sum(df[[2]]), 10000), m), - control = DEoptim::DEoptim.control( - trace = method_control_setting$DEoptim.trace, - itermax = method_control_setting$DEoptim.itermax, - c = .5, - strategy = 2, - parallelType = 0 #Does it make sense to use parallel processing here: no, it does not scale well - ) - ) - - ##set chi^2 value and calculate F for the 2nd run - chi_squared[2] <- start$optim$bestval - if(!is.na(chi_squared[1])){ - F[2] <- (abs(diff(chi_squared))/2) / - (chi_squared[2]/(nrow(df) - 2 * m - 2)) - - } - - ##terminal feedback - if(verbose){ - cat("\n>> + adaption for",m, "comp.", ": ", round(F[2],2), "(calc.) <> ", - round(qf(method_control_setting$p, df1 = 2, df2 = length(df[[2]]) - 2 * m - 2), 2), "(ref.)") - - if(F[2] > qf(method_control_setting$p, df1 = 2, df2 = length(df[[2]]) - 2 * m - 2) & F[1] >= F[2]){ - cat(" >> [add comp.]") - - }else{ - cat(" >> [stop]\n") - cat("---------------------(end adaption)--------------------------------------\n\n") - - } - - } - - ##break here if n.components was set others than NULL, in such case we force the number - if(!is.null(n.components)){ - if(verbose){ - cat(" >> [forced stop]\n") - cat("---------------------(end adaption)--------------------------------------\n\n") - } - - start_parameters <- start$optim$bestmem - break() - } - - ##update objects - chi_squared[1] <- chi_squared[2] - m <- m + 1 - - } - - ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ##(C) RUN LM-FITTING - ## - ##reduce m by 2, why 2? - ## - the last component violated the F statistic, so was obviously not the best call - ## - the loop adds every time another component - if(is.null(n.components)){ - ##this covers the extrem case that the process stops after the first run - if(m == 2){ - m <- 1 - start_parameters <- start$optim$bestmem - - }else{ - m <- m - 2 - - } - } - - A <- start_parameters[seq(1,length(start_parameters), by = 2)] - tau <- start_parameters[seq(2,length(start_parameters), by = 2)] - names(A) <- paste0("A.", 1:(m)) - names(tau) <- paste0("tau.", 1:(m)) - - ##create start_matrix - start_matrix <- matrix(data = c(A,tau), ncol = 2) - colnames(start_matrix) <- c("A", "tau") - rownames(start_matrix) <- paste0("Comp.", 1:(m)) - - ##add terminal feedback - if(verbose){ - cat("\n>> Applied component matrix\n") - print(start_matrix) - cat("\n\n") - - } - - ##run fitting using the Levenberg-Marquardt algorithm - fit <- try(minpack.lm::nlsLM( - formula = fit_formula(n.components = m, tp = tp), - data = df, - start = c(A, tau), - upper = if(method_control_setting$nlsLM.upper){ - c(rep(sum(df[[2]]), length(A)), rep(Inf,length(tau))) - }else{ - NULL - }, - lower = if(method_control_setting$nlsLM.lower){ - c(rep(0,2*length(A))) - }else{ - NULL - }, - na.action = "na.exclude", - weights = if(method_control_setting$weights){ - set_c^2/df[,2] - }else{ - rep(1,nrow(df)) - }, - trace = method_control_setting$nlsLM.trace, - control = minpack.lm::nls.lm.control(maxiter = 500) - ), silent = FALSE) - -# Post-processing ----------------------------------------------------------------------------- - - A <- NA - tau <- NA - summary_matrix <- NA - D <- NA - if (!inherits(fit, 'try-error')) { - ##extract coefficients - A <- coef(fit)[1:(m)] - tau <- coef(fit)[(m + 1):(2 * m)] - - ##order coef - o <- order(tau) - tau <- tau[o] - A <- A[o] - - ##summary matrix - summary_matrix <- summary(fit)$coefficients - - ##return warning if one parameter is negative, this can happen if the user let the boundaries - ##free float - if(any(summary_matrix[,1]<0)) - .throw_warning("At least one parameter is negative, ", - "please check carefully your results") - - ##order matrix by tau, but keep the rownames - temp_rownames <- rownames(summary_matrix) - summary_matrix <- summary_matrix[c(o,o + length(A)),] - rownames(summary_matrix) <- temp_rownames - rm(temp_rownames) - - ##calculate Durbin-Watson statistic - R <- residuals(fit) - D <- round(sum((R - c(0,R[-length(R)]))^2) / sum(R^2),2) - rm(R) - } else { - m <- 1 - } - -# Terminal output ----------------------------------------------------------------------------- -if(verbose){ - - if (!inherits(fit, 'try-error')) { - cat("(2) Fitting results (sorted by ascending tau)\n") - cat("-------------------------------------------------------------------------\n") - print(summary_matrix) - cat("-------------------------------------------------------------------------\n") - - }else{ - message("[fit_OSLLifeTimes()] Error: The fitting was not successful, ", - "consider trying again") - } - - cat("\n(3) Further information\n") - cat("-------------------------------------------------------------------------\n") - cat("Photon count sum: ", sum(df[[2]]),"\n") - cat("Durbin-Watson residual statistic: ", D,"") - - string <- NA - if(!is.na(D)){ - string <- c("\u005b",rep(" ",(D * 10)/4),"\u003c\u003e",rep(" ",10 - (D * 10)/4),"\u005d\n") - } - cat(paste(string, collapse = "")) - cat("\n") - -} - -# Plotting ------------------------------------------------------------------------------------ -if(plot) { - - ##set plot default settings - plot_settings <- list( - main = "OSL Lifetimes", - xlab = "Time [a.u.]", - ylab = "POSL [a.u.]", - log = "", - xlim = c(0,max(df_raw[[1]])), - ylim = c(0,max(df_raw[[2]])), - col = get("col", pos = .LuminescenceEnv)[-1], - lty = rep(1, (m + 1)), - legend.pos = "topright", - legend.text = c("sum", paste0("comp. ", 1:m)) - - ) - - ##modify settings on request - plot_settings <- modifyList(x = plot_settings, val = list(...)) - - ##catch log scale - if(grepl(pattern = "x", plot_settings$log, fixed = TRUE)){ - if(plot_settings$xlim[1] == 0){ - plot_settings$xlim[1] <- if(min(df_raw[[1]]) == 0) 1e-04 else min(df_raw[[1]]) - .throw_warning("log-scale requires x-values > 0, set min xlim to ", - round(plot_settings$xlim[1], 4)) - } - } - - if(grepl(pattern = "y", plot_settings$log, fixed = TRUE)){ - if(plot_settings$ylim[1] == 0){ - plot_settings$ylim[1] <- if(min(df_raw[[2]]) == 0) 1e-04 else min(df_raw[[2]]) - .throw_warning("log-scale requires y-values > 0, set min ylim to ", - round(plot_settings$ylim[1], 4)) - } - } - - ##plot if the fitting was a success - if (!inherits(fit, 'try-error')) { - - if(!plot_simple){ - ##make sure that the screen closes if something is wrong - on.exit(close.screen(all.screens = TRUE)) - - split.screen(rbind( - c(0.1,1,0.32, 0.98), - c(0.1,1,0.1, 0.32))) - - screen(1) - par(mar = c(0, 4, 3, 4)) - } - - plot(NA,NA, - xaxt = if(plot_simple) "s" else "n", - xlab = if(plot_simple) plot_settings$xlab else "", - ylab = plot_settings$ylab, - ylim = plot_settings$ylim, - xlim = plot_settings$xlim, - log = plot_settings$log, - main = plot_settings$main - ) - - ##add used points - points(df, col = rgb(0,0,0,0.8)) - - ##add not used points df_raw (this solution avoids overplotting) - if(nrow(df) != nrow(df_raw)) - points(df_raw[!df_raw[[1]]%in%df[[1]],], col = "grey") - - ##+ add some curve - lines( - df$x, - fitted(fit), - col = plot_settings$col[1], - lwd = 1.3, - lty = plot_settings$lty[1] - ) - - ##+ add components - for(i in 1:m) { - if (length(plot_settings$lty) < 2) - plot_settings$lty <- rep(plot_settings$lty, 1 + m) - - if (length(plot_settings$col) < 2) - plot_settings$col <- rep(plot_settings$col, 1 + m) - - curve( - A[i] * exp(-x / (tau[i] + tp)), - add = TRUE, - col = plot_settings$col[i + 1], - lty = plot_settings$lty[i + 1] - ) - - } - - ##+ add legend - legend( - plot_settings$legend.pos, - legend = plot_settings$legend.text, - lty = plot_settings$lty, - col = plot_settings$col[c(1, 2:(m + 2))], - bty = "n" - ) - - - if(!plot_simple){ - screen(2) - par(mar = c(4, 4, 0, 4)) - plot( - x = df[[1]], - y = residuals(fit), - xlab = plot_settings$xlab, - type = "b", - pch = 20, - xlim = plot_settings$xlim, - log = if(plot_settings$log == "x"){"x"}else{""}, - ylab = "Resid." - ) - } - - }else{ - plot( - df, - xlab = plot_settings$xlab, - ylab = plot_settings$ylab, - col = rgb(0, 0, 0, 0.8), - main = plot_settings$main, - xlim = plot_settings$xlim, - ylim = plot_settings$ylim, - log = plot_settings$log - ) - } - -}#if plot - -# Return -------------------------------------------------------------------------------------- - - ##create return object - return( - set_RLum( - class = "RLum.Results", - data = list( - data = summary_matrix, - start_matrix = start_matrix, - total_counts = sum(df[[2]]), - fit = fit - ), - info = list( - call = sys.call() - ) - ) - ) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/fit_SurfaceExposure.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/fit_SurfaceExposure.R deleted file mode 100644 index fe997010b..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/fit_SurfaceExposure.R +++ /dev/null @@ -1,587 +0,0 @@ -#' @title Nonlinear Least Squares Fit for OSL surface exposure data -#' -#' @description -#' This function determines the (weighted) least-squares estimates of the -#' parameters of either equation 1 in *Sohbati et al. (2012a)* or equation 12 in -#' *Sohbati et al. (2012b)* for a given OSL surface exposure data set (**BETA**). -#' -#' @details -#' **Weighted fitting** -#' -#' If `weights = TRUE` the function will use the inverse square of the error (\eqn{1/\sigma^2}) -#' as weights during fitting using [minpack.lm::nlsLM]. Naturally, for this to -#' take effect individual errors must be provided in the third column of the -#' `data.frame` for `data`. Weighted fitting is **not** supported if `data` -#' is a list of multiple `data.frame`s, i.e., it is not available for global -#' fitting. -#' -#' **Dose rate** -#' If any of the arguments `Ddot` or `D0` is at its default value (`NULL`), -#' this function will fit equation 1 in Sohbati et al. (2012a) to the data. If -#' the effect of dose rate (i.e., signal saturation) needs to be considered, -#' numeric values for the dose rate (`Ddot`) (in Gy/ka) and the characteristic -#' saturation dose (`D0`) (in Gy) must be provided. The function will then fit -#' equation 12 in Sohbati et al. (2012b) to the data. -#' -#' **NOTE**: Currently, this function does **not** consider the variability -#' of the dose rate with sample depth (`x`)! In the original equation the dose -#' rate `D` is an arbitrary function of `x` (term `D(x)`), but here `D` is assumed -#' constant. -#' -#' **Global fitting** -#' If `data` is [list] of multiple `data.frame`s, each representing a separate -#' sample, the function automatically performs a global fit to the data. This -#' may be useful to better constrain the parameters `sigmaphi` or `mu` and -#' **requires** that known ages for each sample is provided -#' (e.g., `age = c(100, 1000)` if `data` is a list with two samples). -#' -#' -#' @param data [data.frame] or [list] (**required**): -#' Measured OSL surface exposure data with the following structure: -#' -#' ``` -#' (optional) -#' | depth (a.u.)| intensity | error | -#' | [ ,1] | [ ,2] | [ ,3] | -#' |-------------|-----------|-------| -#' [1, ]| ~~~~ | ~~~~ | ~~~~ | -#' [2, ]| ~~~~ | ~~~~ | ~~~~ | -#' ... | ... | ... | ... | -#' [x, ]| ~~~~ | ~~~~ | ~~~~ | -#' -#' ``` -#' -#' Alternatively, a [list] of `data.frames` can be provided, where each -#' `data.frame` has the same structure as shown above, with the exception that -#' they must **not** include the optional error column. Providing a [list] as -#' input automatically activates the global fitting procedure (see details). -#' -#' @param sigmaphi [numeric] (*optional*): -#' A numeric value for `sigmaphi`, i.e. the charge detrapping rate. -#' Example: `sigmaphi = 5e-10` -#' -#' @param mu [numeric] (*optional*): -#' A numeric value for mu, i.e. the light attenuation coefficient. -#' Example: `mu = 0.9` -#' -#' @param age [numeric] (*optional*): -#' The age (a) of the sample, if known. If `data` is a [list] of *x* samples, -#' then `age` must be a numeric vector of length *x*. -#' Example: `age = 10000`, or `age = c(1e4, 1e5, 1e6)`. -#' -#' @param Ddot [numeric] (*optional*): -#' A numeric value for the environmental dose rate (Gy/ka). For this argument -#' to be considered a value for `D0` must also be provided; otherwise it will be -#' ignored. -#' -#' @param D0 [numeric] (*optional*): -#' A numeric value for the characteristic saturation dose (Gy). For this argument -#' to be considered a value for `Ddot` must also be provided; otherwise it will be -#' ignored. -#' -#' @param weights [logical] (*optional*): -#' If `TRUE` the fit will be weighted by the inverse square of the error. -#' Requires `data` to be a [data.frame] with three columns. -#' -#' @param plot [logical] (*optional*): -#' Show or hide the plot. -#' -#' @param legend [logical] (*optional*): -#' Show or hide the equation inside the plot. -#' -#' @param error_bars [logical] (*optional*): -#' Show or hide error bars (only applies if errors were provided). -#' -#' @param coord_flip [logical] (*optional*): -#' Flip the coordinate system. -#' -#' @param ... Further parameters passed to [plot]. -#' Custom parameters include: -#' - `verbose` ([logical]): show or hide console output -#' - `line_col`: Colour of the fitted line -#' - `line_lty`: Type of the fitted line (see `lty` in `?par`) -#' - `line_lwd`: Line width of the fitted line (see `lwd` in `?par`) -#' -#' @return -#' -#' Function returns results numerically and graphically: -#' -#' -----------------------------------\cr -#' `[ NUMERICAL OUTPUT ]`\cr -#' -----------------------------------\cr -#' -#' **`RLum.Results`**-object -#' -#' **slot:** **`@data`** -#' -#' \tabular{lll}{ -#' **Element** \tab **Type** \tab **Description**\cr -#' `$summary` \tab `data.frame` \tab summary of the fitting results \cr -#' `$data` \tab `data.frame` \tab the original input data \cr -#' `$fit` \tab `nls` \tab the fitting object produced by [minpack.lm::nlsLM] \cr -#' `$args` \tab `character` \tab arguments of the call \cr -#' `$call` \tab `call` \tab the original function call \cr -#' } -#' -#'**slot:** **`@info`** -#' -#' Currently unused. -#' -#' ------------------------\cr -#' `[ PLOT OUTPUT ]`\cr -#' ------------------------\cr -#' -#' A scatter plot of the provided depth-intensity OSL surface exposure data -#' with the fitted model. -#' -#' @section Function version: 0.1.0 -#' -#' @note -#' **This function has BETA status. If possible, results should be** -#' **cross-checked.** -#' -#' @author Christoph Burow, University of Cologne (Germany) -#' -#' @seealso [ExampleData.SurfaceExposure], [minpack.lm::nlsLM] -#' -#' @references -#' -#' Sohbati, R., Murray, A.S., Chapot, M.S., Jain, M., Pederson, J., 2012a. -#' Optically stimulated luminescence (OSL) as a chronometer for surface exposure -#' dating. Journal of Geophysical Research 117, B09202. doi: -#' \doi{10.1029/2012JB009383} -#' -#' Sohbati, R., Jain, M., Murray, A.S., 2012b. Surface exposure dating of -#' non-terrestrial bodies using optically stimulated luminescence: A new method. -#' Icarus 221, 160-166. -#' -#' @keywords datagen -#' -#' @examples -#' -#' ## Load example data -#' data("ExampleData.SurfaceExposure") -#' -#' ## Example 1 - Single sample -#' # Known parameters: 10000 a, mu = 0.9, sigmaphi = 5e-10 -#' sample_1 <- ExampleData.SurfaceExposure$sample_1 -#' head(sample_1) -#' results <- fit_SurfaceExposure( -#' data = sample_1, -#' mu = 0.9, -#' sigmaphi = 5e-10) -#' get_RLum(results) -#' -#' -#' ## Example 2 - Single sample and considering dose rate -#' # Known parameters: 10000 a, mu = 0.9, sigmaphi = 5e-10, -#' # dose rate = 2.5 Gy/ka, D0 = 40 Gy -#' sample_2 <- ExampleData.SurfaceExposure$sample_2 -#' head(sample_2) -#' results <- fit_SurfaceExposure( -#' data = sample_2, -#' mu = 0.9, -#' sigmaphi = 5e-10, -#' Ddot = 2.5, -#' D0 = 40) -#' get_RLum(results) -#' -#' ## Example 3 - Multiple samples (global fit) to better constrain 'mu' -#' # Known parameters: ages = 1e3, 1e4, 1e5, 1e6 a, mu = 0.9, sigmaphi = 5e-10 -#' set_1 <- ExampleData.SurfaceExposure$set_1 -#' str(set_1, max.level = 2) -#' results <- fit_SurfaceExposure( -#' data = set_1, -#' age = c(1e3, 1e4, 1e5, 1e6), -#' sigmaphi = 5e-10) -#' get_RLum(results) -#' -#' -#' ## Example 4 - Multiple samples (global fit) and considering dose rate -#' # Known parameters: ages = 1e2, 1e3, 1e4, 1e5, 1e6 a, mu = 0.9, sigmaphi = 5e-10, -#' # dose rate = 1.0 Ga/ka, D0 = 40 Gy -#' set_2 <- ExampleData.SurfaceExposure$set_2 -#' str(set_2, max.level = 2) -#' results <- fit_SurfaceExposure( -#' data = set_2, -#' age = c(1e2, 1e3, 1e4, 1e5, 1e6), -#' sigmaphi = 5e-10, -#' Ddot = 1, -#' D0 = 40) -#'get_RLum(results) -#' -#' @md -#' @export -fit_SurfaceExposure <- function( - data, - sigmaphi = NULL, - mu = NULL, - age = NULL, - Ddot = NULL, - D0 = NULL, - weights = FALSE, - plot = TRUE, - legend = TRUE, - error_bars = TRUE, - coord_flip = FALSE, -...) { - - ## SETTINGS ---- - settings <- list( - verbose = TRUE, - info = list() - ) - settings <- modifyList(settings, list(...)) - - ## Input object handling ----------------------------------------------------- - - ## Data type validation - if (inherits(data, "RLum.Results")) - data <- get_RLum(data, "data") - - if (inherits(data, "matrix")) - data <- as.data.frame(data) - - if (inherits(data, "data.table")) - data <- as.data.frame(data) - - ## For global fitting of multiple data sets 'data' must be a list - if (inherits(data, "list")) { - - # Global fitting requires and equal amount of ages to be provided - if (length(data) != length(age)) - stop("If 'data' is a list of data sets for global fitting, 'age' must be of the same length.", call. = FALSE) - - # TODO: Support weighted fitting for global fit - if (weights) { - if (settings$verbose) - warning("[fit_SurfaceExposure()] Argument 'weights' is not supported when multiple data sets are provided for global fitting.", call. = FALSE) - weights <- FALSE - } - - # collapse list into a data.frame with a $group column to distinguish - # between individual samples - data_list <- data - - for (i in 1:length(data)) - data[[i]]$group <- LETTERS[[i]] - - data <- do.call(rbind, data) - data$group <- as.factor(data$group) - global_fit <- TRUE - } else { - # ignore 'global_fit' if 'data' is a data.frame - global_fit <- FALSE - } - - # Exit if data type is invalid - if (!inherits(data, "data.frame")) - stop("'data' must be of class data.frame.", call. = FALSE) - - # Check which parameters have been provided - if (!is.null(age) && any(is.na(age))) age <- NULL - if (!is.null(sigmaphi) && any(is.na(sigmaphi))) sigmaphi <- NULL - if (!is.null(mu) && any(is.na(mu))) mu <- NULL - - ## Weighting options (only available for global fitting) - if (ncol(data) >= 3 && weights && !global_fit) - wi <- (1 / data[ ,3]^2) / sum(1 / data[ ,3]^2) - else - wi <- rep(1, times = nrow(data)) - - ## remove rows with NA - if (any(is.na(data))) { - data <- data[complete.cases(data), ] - if (settings$verbose) - warning("[fit_SurfaceExposure()] NA values in 'data' were removed.", call. = FALSE) - } - - ## extract errors into separate variable - if (ncol(data) >= 3 && !global_fit) - error <- data[ ,3] - else - error <- NULL - - ## Take only the first to columns (depth, signal) - if (ncol(data) > 2 && !global_fit) - data <- data[ ,1:2] - - ## Data preprocessing ---- - - # set column names - if (!global_fit) - colnames(data) <- c("x", "y") - else - colnames(data) <- c("x", "y", "group") - - ## FITTING ---- - - ## Functions - # w/o dose rate - fun <- formula(y ~ exp(-sigmaphi * age * 365.25*24*3600 * exp(-mu * x))) - fun_global <- formula(y ~ exp(-sigmaphi * age[group] * 365.25*24*3600 * exp(-mu * x))) - - # w/ dose rate (Sohbati et al. 2012, eq 12) - if (!is.null(Ddot)) - Ddot <- Ddot / 1000 / 365.25 / 24 / 60 / 60 - - fun_w_dr <- formula( y ~ (sigmaphi * exp(-mu * x) * exp(-(age * 365.25*24*3600) * (sigmaphi * exp(-mu * x) + Ddot/D0)) + Ddot/D0) / - (sigmaphi * exp(-mu * x) + Ddot/D0) ) - fun_global_w_dr <- formula( y ~ (sigmaphi * exp(-mu * x) * exp(-(age[group] * 365.25*24*3600) * (sigmaphi * exp(-mu * x) + Ddot/D0)) + Ddot/D0) / - (sigmaphi * exp(-mu * x) + Ddot/D0) ) - - ## start parameter - start <- list(sigmaphi = if (is.null(sigmaphi)) 5.890e-09 else NULL, - mu = if (is.null(mu)) 1 else NULL, - age = if (is.null(age)) 2 else NULL) - - start <- start[!sapply(start, is.null)] - - ## fitting boundaries - lower <- list(sigmaphi = if (is.null(sigmaphi)) -Inf else NULL, - mu = if (is.null(mu)) 0 else NULL, - age = if (is.null(age)) 0 else NULL) - upper <- list(sigmaphi = if (is.null(sigmaphi)) Inf else NULL, - mu = if (is.null(mu)) Inf else NULL, - age = if (is.null(age)) Inf else NULL) - - ## Decision tree which of the functions to use - if (!is.null(Ddot) && !is.null(D0)) { - if (global_fit) - use_fun <- fun_global_w_dr - else - use_fun <- fun_w_dr - } else { - if (global_fit) - use_fun <- fun_global - else - use_fun <- fun - } - - # (un)constrained fitting - fit <- tryCatch({ - minpack.lm::nlsLM(formula = use_fun, - data = data, - start = start, - lower = unlist(lower), - upper = unlist(upper), - weights = wi) - }, - error = function(e) { e } - ) - - # return NULL if fitting failed - if (!inherits(fit, "simpleError") && !inherits(try(summary(fit), silent = TRUE), "try-error")) { - # Extract coefficients - coef <- as.data.frame(coef(summary(fit))) - } else { - if (settings$verbose) - message("[fit_SurfaceExposure()] Unable to fit the data. ", - "Original error from minpack.lm::nlsLM(): ", fit$message) - - # Fill with NA values - coef <- data.frame( - "Estimate" = rep(NA, 3), - "Std. Error" = rep(NA, 3), - row.names = c("age", "sigmaphi", "mu"), check.names = FALSE - ) - } - - ## RESULTS ---- - summary <- data.frame( - age = if (is.null(age)) coef["age", "Estimate"] else age, - age_error = coef["age", "Std. Error"], - sigmaphi = if (is.null(sigmaphi)) coef["sigmaphi", "Estimate"] else sigmaphi, - sigmaphi_error = coef["sigmaphi", "Std. Error"], - mu = if (is.null(mu)) coef["mu", "Estimate"] else mu, - mu_error = coef["mu", "Std. Error"] - ) - - ## Create RLum.Results object - results <- set_RLum(class = "RLum.Results", - originator = "fit_SurfaceExposure", - data = list(summary = summary, - data = data, - fit = fit, - args = as.list(sys.call()[-1]), - call = sys.call()), - info = settings$info - ) - - ## PLOT ---- - if (plot) { - - # remove $group column for easier data handling - if (global_fit) - data$group <- NULL - - # re-order x,y columns - if (coord_flip) - data <- data.frame(data$y, data$x) - - # set default plot settings - plot_settings <- list( - x = data, - main = "", - pch = 21, - col = "black", - bg = "red", - xlab = if (!coord_flip) "Depth (mm)" else "OSL intensity (Ln/Tn)", - ylab = if (!coord_flip) "OSL intensity (Ln/Tn)" else "Depth (mm)", - cex = 1.0, - lty = 1, - lwd = 1, - log = "", - ylim = if (!coord_flip) range(pretty(data[ ,2])) else rev(range(pretty(data[ ,2]))), - xlim = range(pretty(data[ ,1])) - ) - - # override default settings with valid arguments in ... - plot_settings <- modifyList(plot_settings, list(...)) - valid_settings <- c(names(par()), formalArgs("title"), formalArgs("plot.default"), "cex") - plot_settings <- plot_settings[names(plot_settings) %in% valid_settings] - - # set global plot settings - par(cex = plot_settings$cex) - - if (grepl("y", plot_settings$log)) { - plot_settings$ylim[1] <- 0.01 - pos.idx <- which(data[, 2] > 0) - error <- error[pos.idx] - plot_settings$x <- data[pos.idx, ] - } - - ## create main plot - do.call("plot", modifyList(plot_settings, list(x = NA))) - - - ## add data points - if (!global_fit) { - points(data, type = "p", pch = plot_settings$pch, bg = plot_settings$bg, col = plot_settings$col) - } else { - Map(function(d, i) { - points(d, type = "p", pch = plot_settings$pch, bg = i, col = plot_settings$col) - }, split(results$data, results$data$group), 1:length(unique(results$data$group))) - } - - ## add fitted curve - if (!inherits(fit, "error") && !inherits(fit, "simpleError")) { - - if (coord_flip) { - oldx <- data[ ,2] - } else { - oldx <- data[ ,1] - } - - newx <- seq(range(oldx)[1], range(oldx)[2], length.out = 10000) - newy <- suppressWarnings(predict(fit, newdata = list(x = newx))) - - if (coord_flip) { - tmp <- newx - newx <- newy - newy <- tmp - } - - if (!global_fit) { - points(newx, newy, - type = "l", - col = ifelse("line_col" %in% names(list(...)), list(...)$line_col, "blue"), - lty = ifelse("line_lty" %in% names(list(...)), list(...)$line_lty, 1), - lwd = ifelse("line_lwd" %in% names(list(...)), list(...)$line_lwd, 1)) - } else { - for (i in 1:length(data_list)) { - seg <- seq(i * 101 - 100, 10000, nrow(data)) - points(newx[seg], newy[seg], - type = "l", - col = ifelse("line_col" %in% names(list(...)), list(...)$line_col, i), - lty = ifelse("line_lty" %in% names(list(...)), list(...)$line_lty, 1), - lwd = ifelse("line_lwd" %in% names(list(...)), list(...)$line_lwd, 1)) - } - } - - } else { - legend("center", legend = "Unable to fit the data!\t\t") - } - - # add error bars (if weighted fit) - if (!is.null(error) && error_bars) { - segments(plot_settings$x[ ,1], plot_settings$x[ ,2] - error, - plot_settings$x[ ,1], plot_settings$x[ ,2] + error) - - } - - # add formula - if (legend && !inherits(fit, "simpleError")) { - formula_text <- paste0("y = ", as.character(fit$m$formula())[3], "\t\t") - - if (!is.null(age)) { - if (!global_fit) { - formula_text <- gsub("age", age, formula_text) - } else { - formula_text <- gsub("age", paste0("[", paste(age, collapse = "|"), "]"), formula_text) - formula_text <- gsub("\\[group\\]", "", formula_text) - } - } - if (!is.null(sigmaphi)) - formula_text <- gsub("sigmaphi", sigmaphi, formula_text) - if (!is.null(mu)) - formula_text <- gsub("mu", mu, formula_text) - - legend(ifelse(coord_flip, "bottomleft", "bottomright"), legend = formula_text, cex = 0.8, bty = "n") - } - } - - ## CONSOLE ---- - if (settings$verbose) { - cat("\n [fit_SurfaceExposure()] \n\n") - - if (!global_fit) { - ## STANDARD OUTPUT - cat(" Estimated paramater(s):\n", - "-----------------------\n") - if (is.null(age)) - cat(paste0(" age (a):\t", signif(results$summary$age, 3), " \u00B1 ", - signif(results$summary$age_error, 3), "\n")) - if (is.null(sigmaphi)) - cat(paste0(" sigmaphi:\t", signif(results$summary$sigmaphi, 3), " \u00B1 ", - signif(results$summary$sigmaphi_error, 3), "\n")) - if (is.null(mu)) - cat(paste0(" mu:\t\t", signif(results$summary$mu, 3), " \u00B1 ", - signif(results$summary$mu_error, 3), "\n")) - cat("\n") - } else { - ## GLOBAL FIT OUTPUT - cat(" Shared estimated paramater(s):\n", - "-----------------------\n") - if (is.null(sigmaphi)) - cat(paste0(" sigmaphi:\t", signif(unique(results$summary$sigmaphi), 3), " \u00B1 ", - signif(unique(results$summary$sigmaphi_error), 3), "\n")) - if (is.null(mu)) - cat(paste0(" mu:\t\t", signif(unique(results$summary$mu), 3), " \u00B1 ", - signif(unique(results$summary$mu_error), 3), "\n")) - cat("\n") - } - - ## STANDARD OUTPUT - cat(" Fixed parameters(s):\n", - "--------------------\n") - if (!is.null(age)) - cat(paste0(" age (a):\t", paste(age, collapse = ", "), "\n")) - if (!is.null(sigmaphi)) - cat(paste0(" sigmaphi:\t", sigmaphi, "\n")) - if (!is.null(mu)) - cat(paste0(" mu:\t\t", mu, "\n")) - cat("\n") - - if (!is.null(age)) { - message(paste0("To apply the estimated parameters to a sample of unknown age run:\n\n", - "fit_SurfaceExposure(data = ", capture.output(results$args[[1]]), - ", sigmaphi = ", signif(unique(results$summary$sigmaphi), 3), - ", mu = ", signif(unique(results$summary$mu), 3), - ")\n\n")) - } - } - - ## EXIT ---- - return(results) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/fit_ThermalQuenching.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/fit_ThermalQuenching.R deleted file mode 100644 index c2efc06c2..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/fit_ThermalQuenching.R +++ /dev/null @@ -1,424 +0,0 @@ -#' @title Fitting Thermal Quenching Data -#' -#' @description Applying a nls-fitting to thermal quenching data. -#' -#' @details -#' -#' **Used equation**\cr -#' -#' The equation used for the fitting is -#' -#' \deqn{y = (A / (1 + C * (exp(-W / (k * x))))) + c} -#' -#' *W* is the energy depth in eV and *C* is dimensionless constant. *A* and *c* are used to -#' adjust the curve for the given signal. *k* is the Boltzmann in eV/K and *x* is the absolute -#' temperature in K. -#' -#' **Error estimation**\cr -#' -#' The error estimation is done be varying the input parameters using the given uncertainties in -#' a Monte Carlo simulation. Errors are assumed to follow a normal distribution. -#' -#' **`start_param`** \cr -#' -#' The function allows the injection of own start parameters via the argument `start_param`. The -#' parameters needs to be provided as names list. The names are the parameters to be optimised. -#' Examples: `start_param = list(A = 1, C = 1e+5, W = 0.5, c = 0)` -#' -#' -#' **`method_control`** \cr -#' -#' The following arguments can be provided via `method_control`. Please note that arguments provided -#' via `method_control` are not further tested, i.e., if the function crashes your input was probably -#' wrong. -#' -#' \tabular{lll}{ -#' **ARGUMENT** \tab **TYPE** \tab **DESCRIPTION**\cr -#' `upper` \tab named [vector] \tab sets upper fitting boundaries, if provided boundaries for all arguments -#' are required, e.g., `c(A = 0, C = 0, W = 0, c = 0)` \cr -#' `lower` \tab names [vector] \tab sets lower fitting boundaries (see `upper` for details) \cr -#' `trace` \tab [logical] \tab enables/disables progression trace for [minpack.lm::nlsLM]\cr -#' `weights` \tab [numeric] \tab option to provide own weights for the fitting, the length of this -#' vector needs to be equal to the number for rows of the input `data.frame`. If set to `NULL` no weights -#' are applied. The weights are defined by the third column of the input `data.frame`. -#' } -#' -#' @param data [data.frame] (**required**): input data with three columns, the first column contains -#' temperature values in deg. C, columns 2 and 3 the dependent values with its error -#' -#' @param start_param [list] (optional): option to provide own start parameters for the fitting, see -#' details -#' -#' @param method_control [list] (optional): further options to fine tune the fitting, see details for -#' further information -#' -#' @param n.MC [numeric] (*with default*): number of Monte Carlo runs for the error estimation. If `n.MC` is -#' `NULL` or `<=1`, the error estimation is skipped -#' -#' @param verbose [logical] (*with default*): enables/disables terminal output -#' -#' @param plot [logical] (*with default*): enables/disables plot output -#' -#' @param ... further arguments that can be passed to control the plotting, support are `main`, `pch`, -#' `col_fit`, `col_points`, `lty`, `lwd`, `xlab`, `ylab`, `xlim`, `ylim`, `xaxt` -#' -#' @return -#' -#' The function returns numerical output and an (*optional*) plot. -#' -#' -----------------------------------\cr -#' `[ NUMERICAL OUTPUT ]`\cr -#' -----------------------------------\cr -#' -#' **`RLum.Results`**-object -#' -#' **slot:** **`@data`** -#' -#' `[.. $data : data.frame]`\cr -#' -#' A table with all fitting parameters and the number of Monte Carlo runs used for the error estimation. -#' -#' `[.. $fit : nls object]` \cr -#' -#' The nls [stats::nls] object returned by the function [minpack.lm::nlsLM]. This object -#' can be further passed to other functions supporting an nls object (cf. details section -#' in [stats::nls]) -#' -#' **slot:** **`@info`** -#' -#' `[.. $call : call]`\cr -#' -#' The original function call. -#' -#' -----------------------------------\cr -#' `[ GAPHICAL OUTPUT ]`\cr -#' -----------------------------------\cr -#' -#' Plotted are temperature against the signal and their uncertainties. -#' The fit is shown as dashed-line (can be modified). Please note that for the fitting the absolute -#' temperature values are used but are re-calculated to deg. C for the plot. -#' -#' -#' @section Function version: 0.1.0 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @references -#' -#' Wintle, A.G., 1975. Thermal Quenching of Thermoluminescence in Quartz. Geophys. J. R. astr. Soc. 41, 107–113. -#' -#' @seealso [minpack.lm::nlsLM] -#' -#' @examples -#' -#' ##create short example dataset -#' data <- data.frame( -#' T = c(25, 40, 50, 60, 70, 80, 90, 100, 110), -#' V = c(0.06, 0.058, 0.052, 0.051, 0.041, 0.034, 0.035, 0.033, 0.032), -#' V_X = c(0.012, 0.009, 0.008, 0.008, 0.007, 0.006, 0.005, 0.005, 0.004)) -#' -#' ##fit -#' fit_ThermalQuenching( -#' data = data, -#' n.MC = NULL) -#' -#' @md -#' @export -fit_ThermalQuenching <- function( - data, - start_param = list(), - method_control = list(), - n.MC = 100, - verbose = TRUE, - plot = TRUE, - ... -){ - - - # Self-call ----------------------------------------------------------------------------------- - if(inherits(data, "list")){ - - ##get arguments - args <- as.list(match.call()) - args[[1]] <- NULL - args$data <- NULL - - - ##run function - results_list <- lapply(data, function(x){ - do.call(fit_ThermalQuenching, c(list(data = x),args)) - }) - - ##combine and return - return(merge_RLum(results_list)) - - } - - - # Integrity checks ---------------------------------------------------------------------------- - if(!inherits(data, 'data.frame')){ - stop("[fit_ThermalQuenching()] 'data' must by of type 'data.frame' or list of 'data.frames'!", call. = FALSE) - - }else{ - if(nrow(data) < 1 || ncol(data) < 3) - stop("[fit_ThermalQuenching()] 'data' is empty or has less than three columns!", call. = FALSE) - - if(ncol(data) > 3) - warning("[fit_ThermalQuenching()] 'data' has more than 3 columns, taking only the first three!", call. = FALSE) - - if(any(is.na(data))) - warning("[fit_ThermalQuenching()] NA values in 'data' automatically removed!", call. = FALSE) - - - ##this we do anyway, you never know - data <- na.exclude(data[,1:3]) - } - - - - # Prepare data -------------------------------------------------------------------------------- - ##set formula for quenching accordingt to Wintle 1973 - ##we here add a constant, otherwise the fit will not really work - k <- 8.6173303e-05 - f <- y ~ (A / (1 + C * (exp(-W / (k * x))))) + c - - ##set translate values in data.frame to absolute temperature - data_raw <- data - data[[1]] <- data[[1]] + 273.15 - - ##start parameter - start_param <- modifyList(x = list( - A = max(data[[2]]), - C = max(data[[1]] * 10e+5), - W = 0.5, - c = 0), - val = start_param) - - - ##method control - method_control <- modifyList( - x = list( - lower = c(A = 0, C = 0, W = 0, c = 0), - upper = c(A = 10 * start_param$A, C = Inf, W = 10, c = start_param$A), - trace = FALSE, - weights = data[[3]] - ), - val = method_control) - - # Fitting ------------------------------------------------------------------------------------- - ##guine fitting - fit <- try(minpack.lm::nlsLM( - formula = f, - data = data.frame(x = data[[1]], y = data[[2]]), - weights = if(is.null(method_control$weights)){ - rep(1, length(data[[2]])) - } else { - method_control$weights}, - control = list( - maxiter = 500, - maxfev = 1000, - trace = method_control$weights - ), - start = start_param, - lower = method_control$lower, - upper = method_control$upper - ), silent = TRUE) - - ##only continue if the first fitting worked out - if(!inherits(fit, "try-error")){ - - ##reset n.MC - if(is.null(n.MC) || n.MC < 1) - n.MC <- 1 - - ##Prepare MC runs for the fitting - x_MC <- data[[1]] - y_MC <- matrix( - data = data[[2]] + rnorm(n.MC * length(x_MC)) * data[[3]], - nrow = length(x_MC), - ncol = n.MC) - y_MC[y_MC < 0] <- 0 - - ##run fitting - fit_MC <- lapply(1:n.MC, function(x){ - temp <- try(minpack.lm::nlsLM( - formula = f, - data = data.frame(x = x_MC, y = y_MC[,x]), - weights = if(is.null(method_control$weights)){ - rep(1, length(data[[2]])) - } else { - method_control$weights}, - control = list( - maxiter = 500, - maxfev = 1000 - ), - start = start_param, - lower = method_control$lower, - upper = method_control$upper - ), silent = TRUE) - - ##return value - if(inherits(temp, 'try-error')) { - return(NULL) - } else{ - temp - } - }) - - }else{ - message("[fit_ThermalQuenching()] Error: Fitting failed, NULL returned!") - return(NULL) - } - - ## remove NULL (the fit was not successful) - fit_MC <- fit_MC[!sapply(X = fit_MC, is.null)] - n.MC <- length(fit_MC) - -# Extract values ------------------------------------------------------------------------------ - - ##(1) - extract parameters from main fit - fit_coef <- coef(fit) - A <- fit_coef[["A"]] - C <- fit_coef[["C"]] - W <- fit_coef[["W"]] - c <- fit_coef[["c"]] - - ##(2) - extract values from MC run - fit_coef_MC_full <- vapply(X = fit_MC, FUN = coef, FUN.VALUE = numeric(4)) - fit_coef_MC <- round(matrixStats::rowSds(fit_coef_MC_full),3) - - A_MC_X <- fit_coef_MC[1] - C_MC_X <- fit_coef_MC[2] - W_MC_X <- fit_coef_MC[3] - c_MC_X <- fit_coef_MC[4] - -# Terminal output ----------------------------------------------------------------------------- -if(verbose){ - - cat("\n[fit_ThermalQuenching()]\n\n") - cat(" A = ", A, " \u00b1 ",A_MC_X,"\n") - cat(" C = ", C, " \u00b1 ",C_MC_X,"\n") - cat(" W = ", W, " \u00b1 ",W_MC_X, " eV\n") - cat(" c = ", c, " \u00b1 ",c_MC_X, "\n") - cat(" --------------------------------\n") - -} - -# Potting ------------------------------------------------------------------------------------- - if(plot) { - ##plot settings - plot_settings <- list( - xlim = range(data[[1]]), - ylim = c(min(data[[2]]) - data[[3]][which.min(data[[2]])], - max(data[[2]]) + data[[3]][which.max(data[[2]])]), - pch = 1, - xaxt = "n", - xlab = "Temperature [\u00b0C]", - ylab = "Dependent [a.u.]", - main = "Thermal quenching", - lty = 2, - col_points = "black", - col_fit = "red", - lwd = 1.3, - mtext = if(n.MC == 1) "" else paste0("n.MC = ", n.MC) - ) - - ##overwrite settings - plot_settings <- modifyList(x = plot_settings, val = list(...)) - - ##create plot window - plot( - x = NA, - y = NA, - xlim = plot_settings$xlim, - ylim = plot_settings$ylim, - xaxt = plot_settings$xaxt, - xlab = plot_settings$xlab, - ylab = plot_settings$ylab, - main = plot_settings$main - ) - - ##add axis with correct temperature - if(!is.null(plot_settings$xaxt) && plot_settings$xaxt == "n"){ - at <- pretty(round(axTicks(side = 1) - 273.15)) - axis(side = 1, at = at + 273.15, labels = at) - - } - - ##reset n.MC - if(!is.null(n.MC) && n.MC > 1){ - ##add MC curves - for(i in 1:n.MC){ - A <- fit_coef_MC_full[1,i] - C <- fit_coef_MC_full[2,i] - W <- fit_coef_MC_full[3,i] - c <- fit_coef_MC_full[4,i] - x <- 0 - curve((A / (1 + C * (exp(-W / (k * x))))) + c, col = rgb(0,0,0,.1), add = TRUE) - - } - } - - ##add points and uncertainties - points(data[, 1:2], - pch = plot_settings$pch, - lwd = 2, - col = plot_settings$col_points) - segments(x0 = data[[1]], x1 = data[[1]], - y0 = data[[2]] + data[[3]], - y1 = data[[2]] - data[[3]], - col = plot_settings$col_points - ) - - - ##add central fit - A <- fit_coef[["A"]] - C <- fit_coef[["C"]] - W <- fit_coef[["W"]] - c <- fit_coef[["c"]] - - x <- 0 - curve((A / (1 + C * (exp( - -W / (k * x) - )))) + c, - lty = plot_settings$lty, - lwd = plot_settings$lwd, - col = plot_settings$col_fit, - add = TRUE - ) - - ##add mtext - mtext(side = 3, text = plot_settings$mtext) - - } - - - # Return -------------------------------------------------------------------------------------- - output_df <- data.frame( - A = A, - A_X = A_MC_X, - C = C, - C_X = C_MC_X, - W = W, - W_X = W_MC_X, - c = c, - c_X = c_MC_X, - n.MC = n.MC - ) - - output <- set_RLum( - class = "RLum.Results", - data = list( - data = output_df, - fit = fit - ), - info = list( - call = sys.call() - - ) - ) - - return(output) - - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/get_Layout.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/get_Layout.R deleted file mode 100644 index b0b01c750..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/get_Layout.R +++ /dev/null @@ -1,652 +0,0 @@ -#' Collection of layout definitions -#' -#' This helper function returns a list with layout definitions for homogeneous -#' plotting. -#' -#' The easiest way to create a user-specific layout definition is perhaps to -#' create either an empty or a default layout object and fill/modify the -#' definitions (`user.layout <- get_Layout(data = "empty")`). -#' -#' @param layout [character] or [list] object (**required**): -#' name of the layout definition to be returned. If name is provided the -#' respective definition is returned. One of the following -#' supported layout definitions is possible: `"default"`, -#' `"journal.1"`, `"small"`, `"empty"`. -#' -#' User-specific layout definitions must be provided as a list object of -#' predefined structure, see details. -#' -#' @return A list object with layout definitions for plot functions. -#' -#' @section Function version: 0.1 -#' -#' @author Michael Dietze, GFZ Potsdam (Germany) -#' -#' @examples -#' -#' ## read example data set -#' data(ExampleData.DeValues, envir = environment()) -#' -#' ## show structure of the default layout definition -#' layout.default <- get_Layout(layout = "default") -#' str(layout.default) -#' -#' ## show colour definitions for Abanico plot, only -#' layout.default$abanico$colour -#' -#' ## set Abanico plot title colour to orange -#' layout.default$abanico$colour$main <- "orange" -#' -#' ## create Abanico plot with modofied layout definition -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' layout = layout.default) -#' -#' ## create Abanico plot with predefined layout "journal" -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' layout = "journal") -#' -#' @md -#' @export -get_Layout <- function( - layout -) { - - ## pre-defined layout selections - if(is.character(layout) == TRUE & length(layout) == 1) { - - if(layout == "empty") { - - layout = list( - - ## empty Abanico plot ------------------------------------------------- - abanico = list( - font.type = list( - main = character(1), - xlab1 = character(1), - xlab2 = character(1), - ylab = character(1), - zlab = character(1), - xtck1 = character(1), - xtck2 = character(1), - xtck3 = character(1), - ytck = character(1), - ztck = character(1), - mtext = character(1), - summary = character(1), # optionally vector - stats = character(1), # optionally vector - legend = character(1) # optionally vector - ), - - font.size = list( - main = numeric(1), - xlab1 = numeric(1), - xlab2 = numeric(1), - xlab3 = numeric(1), - ylab = numeric(1), - zlab = numeric(1), - xtck1 = numeric(1), - xtck2 = numeric(1), - xtck3 = numeric(1), - ytck = numeric(1), - ztck = numeric(1), - mtext = numeric(1), - summary = numeric(1), # optionally vector - stats = numeric(1), # optionally vector - legend = numeric(1) # optionally vector - ), - - font.deco = list( - main = character(1), - xlab1 = character(1), - xlab2 = character(1), - xlab3 = character(1), - ylab = character(1), - zlab = character(1), - xtck1 = character(1), - xtck2 = character(1), - xtck3 = character(1), - ytck = character(1), - ztck = character(1), - mtext = character(1), - summary = character(1), # optionally vector - stats = character(1), # optionally vector - legend = character(1) # optionally vector - ), - - colour = list( - main = numeric(1), # plot title colour - xlab1 = numeric(1), # left x-axis label colour - xlab2 = numeric(1), # right x-axis label colour - xlab3 = numeric(1), # right x-axis label colour - ylab = numeric(1), # y-axis label colour - zlab = numeric(1), # z-axis label colour - xtck1 = numeric(1), # left x-axis tick colour - xtck2 = numeric(1), # right x-axis tick colour - xtck3 = numeric(1), # right x-axis tick colour - ytck = numeric(1), # y-axis tick colour - ztck = numeric(1), # z-axis tick colour - mtext = numeric(1), # subheader text colour - summary = numeric(1), # statistic summary colour - stats = numeric(1), # value statistics colour - legend = numeric(1), # legend colour - centrality = numeric(1), # Centrality line colour - value.dot = numeric(1), # De value dot colour - value.bar = numeric(1), # De value error bar colour - value.rug = numeric(1), # De value rug colour - poly.line = numeric(1), # polygon line colour - poly.fill = numeric(1), # polygon fill colour - bar.line = numeric(1), # polygon line colour - bar.fill = numeric(1), # polygon fill colour - kde.line = numeric(1), - kde.fill = numeric(1), - grid.major = numeric(1), - grid.minor = numeric(1), - border = numeric(1), - background = numeric(1)), - - dimension = list( - figure.width = numeric(1), # figure width in mm - figure.height = numeric(1), # figure height in mm - margin = numeric(4), # margin sizes in mm - main.line = numeric(1), # line height in % - xlab1.line = numeric(1), # line height in % - xlab2.line = numeric(1), # line height in % - xlab3.line = numeric(1), # line height in % - ylab.line = numeric(1), # line height in % - zlab.line = numeric(1), # line height in % - xtck1.line = numeric(1), # line height in % - xtck2.line = numeric(1), # line height in % - xtck3.line = numeric(1), # line height in % - ytck.line = numeric(1), # line height in % - ztck.line = numeric(1), # line height in % - xtcl1 = numeric(1), # tick length in % - xtcl2 = numeric(1), # tick length in % - xtcl3 = numeric(1), # tick length in % - ytcl = numeric(1), # tick length in % - ztcl = numeric(1), # tick length in % - rugl = numeric(1), # rug length in % - mtext = numeric(1), # line height in % - summary.line = numeric(1) # line height in % - )), - - ## empty KDE plot ----------------------------------------------------- - kde = list( - font.type = list( - main = character(1), - xlab = character(1), - ylab1 = character(1), - ylab2 = character(1), - xtck = character(1), - ytck1 = character(1), - ytck2 = character(1), - stats = character(1), # optionally vector - legend = character(1) # optionally vector - ), - - font.size = list( - main = numeric(1), - xlab = numeric(1), - ylab1 = numeric(1), - ylab2 = numeric(1), - xtck = numeric(1), - ytck1 = numeric(1), - ytck2 = numeric(1), - stats = numeric(1), # optionally vector - legend = numeric(1) # optionally vector - ), - - font.deco = list( - main = character(1), - xlab = character(1), - ylab1 = character(1), - ylab2 = character(1), - xtck = character(1), - ytck1 = character(1), - ytck2 = character(1), - stats = character(1), # optionally vector - legend = character(1) # optionally vector - ), - - colour = list( - main = numeric(1), # plot title colour - xlab = numeric(1), # x-axis label colour - ylab1 = numeric(1), # primary y-axis label colour - ylab2 = numeric(1), # secondary y-axis label colour - xtck = numeric(1), # x-axis tick colour - ytck1 = numeric(1), # primary y-axis tick colour - ytck2 = numeric(1), # secondary y-axis tick colour - box = numeric(1), # plot frame box line colour - mtext = numeric(1), # subheader text colour - stats = numeric(1), # statistic summary colour - kde.line = numeric(1), # KDE line colour - kde.fill = numeric(1), # KDE fill colour - value.dot = numeric(1), # De value dot colour - value.bar = numeric(1), # De value error bar colour - value.rug = numeric(1), # De value rug colour - boxplot.line = numeric(1), # boxplot line colour - boxplot.fill = numeric(1), # boxplot fill colour - mean.line = numeric(1), # mean line colour - sd.bar = numeric(1), # sd-line colour - background = numeric(1)), # background colour - - dimension = list( - figure.width = numeric(1), # figure width in mm - figure.height = numeric(1), # figure height in mm - margin = numeric(4), # margin sizes in mm - main.line = numeric(1), # line height in % - xlab.line = numeric(1), # line height in % - ylab1.line = numeric(1), # line height in % - ylab2.line = numeric(1), # line height in % - xtck.line = numeric(1), # line height in % - ytck1.line = numeric(1), # line height in % - ytck2.line = numeric(1), # line height in % - xtcl = numeric(1), # tick length in % - ytcl1 = numeric(1), # tick length in % - ytcl2 = numeric(1), # tick length in % - stats.line = numeric(1) # line height in % - ) - ) - ) - } else if(layout == "default") { - - layout = list( - - ## default Abanico plot ----------------------------------------------- - abanico = list( - font.type = list( - main = "", - xlab1 = "", - xlab2 = "", - ylab = "", - zlab = "", - xtck1 = "", - xtck2 = "", - xtck3 = "", - ytck = "", - ztck = "", - mtext = "", - summary = "", # optionally vector - stats = "", # optionally vector - legend = "" # optionally vector - ), - - font.size = list( - main = 12, - xlab1 = 12, - xlab2 = 12, - xlab3 = 12, - ylab = 12, - zlab = 12, - xtck1 = 12, - xtck2 = 12, - xtck3 = 12, - ytck = 12, - ztck = 12, - mtext = 10, - summary = 10, # optionally vector - stats = 10, # optionally vector - legend = 10 # optionally vector - ), - - font.deco = list( - main = "bold", - xlab1 = "normal", - xlab2 = "normal", - xlab3 = "normal", - ylab = "normal", - zlab = "normal", - xtck1 = "normal", - xtck2 = "normal", - xtck3 = "normal", - ytck = "normal", - ztck = "normal", - mtext = "normal", - summary = "normal", # optionally vector - stats = "normal", # optionally vector - legend = "normal" # optionally vector - ), - - colour = list( - main = 1, # plot title colour - xlab1 = 1, # left x-axis label colour - xlab2 = 1, # right x-axis label colour - xlab3 = 1, # right x-axis label colour - ylab = 1, # y-axis label colour - zlab = 1, # z-axis label colour - xtck1 = 1, # left x-axis tick colour - xtck2 = 1, # right x-axis tick colour - xtck3 = 1, # right x-axis tick colour - ytck = 1, # y-axis tick colour - ztck = 1, # z-axis tick colour - mtext = 1, # subheader text colour - summary = 1, # statistic summary colour - stats = 1, # value statistics colour - legend = 1, # legend colour - centrality = 1, # Centrality line colour - value.dot = 1, # De value dot colour - value.bar = 1, # De value error bar colour - value.rug = 1, # De value rug colour - poly.line = NA, # polygon line colour - poly.fill = adjustcolor("grey75", alpha.f = 0.6), # polygon fill colour - bar.line = NA, # polygon line colour - bar.fill = "grey60", # bar fill colour - kde.line = 1, - kde.fill = NA, - grid.major = "grey80", - grid.minor = "none", - border = 1, - background = NA), - - dimension = list( - figure.width = "auto", # figure width in mm - figure.height = "auto", # figure height in mm - margin = c(10, 10, 10, 10), # margin sizes in mm - main.line = 100, # line height in % - xlab1.line = 90, # line height in % - xlab2.line = 90, # line height in % - xlab3.line = 90, # line height in % - ylab.line = 100, # line height in % - zlab.line = 70, # line height in % - xtck1.line = 100, # line height in % - xtck2.line = 100, # line height in % - xtck3.line = 100, # line height in % - ytck.line = 100, # line height in % - ztck.line = 100, # line height in % - xtcl1 = 100, # tick length in % - xtcl2 = 100, # tick length in % - xtcl3 = 100, # tick length in % - ytcl = 100, # tick length in % - ztcl = 100, # tick length in % - rugl = 100, # rug length in % - mtext = 100, # line height in % - summary.line = 100 # line height in % - )), - - ## default KDE plot --------------------------------------------------- - kde = list( - font.type = list( - main = "", - xlab = "", - ylab1 = "", - ylab2 = "", - xtck = "", - ytck1 = "", - ytck2 = "", - stats = "", # optionally vector - legend = "" # optionally vector - ), - - font.size = list( - main = 14, - xlab = 12, - ylab1 = 12, - ylab2 = 12, - xtck = 12, - ytck1 = 12, - ytck2 = 12, - stats = 12, # optionally vector - legend = 12 # optionally vector - ), - - font.deco = list( - main = "bold", - xlab = "normal", - ylab1 = "normal", - ylab2 = "normal", - xtck = "normal", - ytck1 = "normal", - ytck2 = "normal", - stats = "normal", # optionally vector - legend = "normal" # optionally vector - ), - - colour = list( - main = 1, # plot title colour - xlab = 1, # x-axis label colour - ylab1 = 1, # primary y-axis label colour - ylab2 = 1, # secondary y-axis label colour - xtck = 1, # x-axis tick colour - ytck1 = 1, # primary y-axis tick colour - ytck2 = 1, # secondary y-axis tick colour - box = 1, # plot frame box line colour - mtext = 2, # subheader text colour - stats = 1, # statistic summary colour - kde.line = 1, # KDE line colour - kde.fill = NULL, # KDE fill colour - value.dot = 1, # De value dot colour - value.bar = 1, # De value error bar colour - value.rug = 1, # De value rug colour - boxplot.line = 1, # boxplot line colour - boxplot.fill = NULL, # boxplot fill colour - mean.point = 1, # mean line colour - sd.line = 1, # sd bar colour - background = NULL), # background colour - - dimension = list( - figure.width = "auto", # figure width in mm - figure.height = "auto", # figure height in mm - margin = c(10, 10, 10, 10), # margin sizes in mm - main.line = 100, # line height in % - xlab.line = 100, # line height in % - ylab1.line = 100, # line height in % - ylab2.line = 100, # line height in % - xtck.line = 100, # line height in % - ytck1.line = 100, # line height in % - ytck2.line = 100, # line height in % - xtcl = 100, # tick length in % - ytcl1 = 100, # tick length in % - ytcl2 = 100, # tick length in % - stats.line = 100 # line height in % - ) - ) - ) - } else if(layout == "journal") { - - layout = list( - - ## journal Abanico plot ----------------------------------------------- - abanico = list( - font.type = list( - main = "", - xlab1 = "", - xlab2 = "", - ylab = "", - zlab = "", - xtck1 = "", - xtck2 = "", - xtck3 = "", - ytck = "", - ztck = "", - mtext = "", - summary = "", # optionally vector - stats = "", # optionally vector - legend = "" # optionally vector - ), - - font.size = list( - main = 8, - xlab1 = 7, - xlab2 = 7, - xlab3 = 7, - ylab = 7, - zlab = 7, - xtck1 = 7, - xtck2 = 7, - xtck3 = 7, - ytck = 7, - ztck = 7, - mtext = 6, - summary = 6, # optionally vector - stats = 6, # optionally vector - legend = 6 # optionally vector - ), - - font.deco = list( - main = "bold", - xlab1 = "normal", - xlab2 = "normal", - xlab3 = "normal", - ylab = "normal", - zlab = "normal", - xtck1 = "normal", - xtck2 = "normal", - xtck3 = "normal", - ytck = "normal", - ztck = "normal", - mtext = "normal", - summary = "normal", # optionally vector - stats = "normal", # optionally vector - legend = "normal" # optionally vector - ), - - colour = list( - main = 1, # plot title colour - xlab1 = 1, # left x-axis label colour - xlab2 = 1, # right x-axis label colour - xlab3 = 1, # right x-axis label colour - ylab = 1, # y-axis label colour - zlab = 1, # z-axis label colour - xtck1 = 1, # left x-axis tick colour - xtck2 = 1, # right x-axis tick colour - xtck3 = 1, # right x-axis tick colour - ytck = 1, # y-axis tick colour - ztck = 1, # z-axis tick colour - mtext = 1, # subheader text colour - summary = 1, # statistic summary colour - stats = 1, # value statistics colour - legend = 1, # legend colour - centrality = 1, # Centrality line colour - value.dot = 1, # De value dot colour - value.bar = 1, # De value error bar colour - value.rug = 1, # De value rug colour - poly.line = NA, # polygon line colour - poly.fill = adjustcolor("grey75", alpha.f = 0.6), # polygon fill colour - bar.line = NA, # polygon line colour - bar.fill = "grey60", # bar fill colour - kde.line = 1, - kde.fill = NA, - grid.major = "grey80", - grid.minor = "none", - border = 1, - background = NA), - - dimension = list( - figure.width = 100, # figure width in mm - figure.height = 100, # figure height in mm - margin = c(10, 10, 10, 10), # margin sizes in mm - main.line = 70, # line height in % - xlab1.line = 30, # line height in % - xlab2.line = 65, # line height in % - xlab3.line = 30, # line height in % - ylab.line = 30, # line height in % - zlab.line = 40, # line height in % - xtck1.line = 50, # line height in % - xtck2.line = 50, # line height in % - xtck3.line = 50, # line height in % - ytck.line = 70, # line height in % - ztck.line = 70, # line height in % - xtcl1 = 50, # tick length in % - xtcl2 = 50, # tick length in % - xtcl3 = 50, # tick length in % - ytcl = 50, # tick length in % - ztcl = 70, # tick length in % - rugl = 70, # rug length in % - mtext = 100, # line height in % - summary.line = 70, # line height in % - pch = 50 # point size in % - )), - - ## journal KDE plot --------------------------------------------------- - kde = list( - font.type = list( - main = "", - xlab = "", - ylab1 = "", - ylab2 = "", - xtck = "", - ytck1 = "", - ytck2 = "", - stats = "", # optionally vector - legend = "" # optionally vector - ), - - font.size = list( - main = 8, - xlab = 7, - ylab1 = 7, - ylab2 = 7, - xtck = 7, - ytck1 = 7, - ytck2 = 7, - stats = 7, - legend = 7 - ), - - font.deco = list( - main = "bold", - xlab = "normal", - ylab1 = "normal", - ylab2 = "normal", - xtck = "normal", - ytck1 = "normal", - ytck2 = "normal", - stats = "normal", # optionally vector - legend = "normal" # optionally vector - ), - - colour = list( - main = 1, # plot title colour - xlab = 1, # x-axis label colour - ylab1 = 1, # primary y-axis label colour - ylab2 = 1, # secondary y-axis label colour - xtck = 1, # x-axis tick colour - ytck1 = 1, # primary y-axis tick colour - ytck2 = 1, # secondary y-axis tick colour - box = 1, # plot frame box line colour - mtext = 1, # subheader text colour - stats = "#2062B3", # statistic summary colour - kde.line = "#2062B3", # KDE line colour - kde.fill = NULL, # KDE fill colour - value.dot = 1, # De value dot colour - value.bar = 1, # De value error bar colour - value.rug = 1, # De value rug colour - boxplot.line = 1, # boxplot line colour - boxplot.fill = NULL, # boxplot fill colour - mean.line = adjustcolor(col = 1, - alpha.f = 0.4), # mean line colour - sd.bar = adjustcolor(col = 1, - alpha.f = 0.4), # sd bar colour - background = NULL), - - dimension = list( - figure.width = 80, # figure width in mm - figure.height = 80, # figure height in mm - margin = c(10, 10, 10, 10), # margin sizes in mm - main.line = 70, # line height in % - xlab.line = 30, # line height in % - ylab1.line = 40, # line height in % - ylab2.line = 30, # line height in % - xtck.line = 50, # line height in % - ytck1.line = 65, # line height in % - ytck2.line = 50, # line height in % - xtcl = 50, # tick length in % - ytcl1 = 20, # tick length in % - ytcl2 = 50, # tick length in % - stats.line = 70 # line height in % - ) - ) - ) - } else { - .throw_warning("Layout definition not supported, ", - "default layout is used.") - layout <- get_Layout(layout = "default") - } - } else if(is.list(layout) == TRUE) { - - ## user-specific layout definition assignment - layout <- layout - } - - ## return layout parameters - return(layout) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/get_Quote.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/get_Quote.R deleted file mode 100644 index a74461dcb..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/get_Quote.R +++ /dev/null @@ -1,105 +0,0 @@ -#' Function to return essential quotes -#' -#' This function returns one of the collected essential quotes in the -#' growing library. If called without any parameters, a random quote is -#' returned. -#' -#' @param ID [character] (*optional*): quote ID to be returned. -#' -#' @param separated [logical] (*with default*): return result in separated form. -#' -#' @return Returns a character with quote and respective (false) author. -#' -#' @section Function version: 0.1.5 -#' -#' @author Quote credits: Michael Dietze, GFZ Potsdam (Germany), Sebastian Kreutzer, Geography & Earth Science, Aberystwyth University (United Kingdom), Dirk Mittelstraß, TU Dresden (Germany), Jakob Wallinga (Wageningen University, Netherlands) -#' -#' @examples -#' -#' ## ask for an arbitrary quote -#' get_Quote() -#' -#' @md -#' @export -get_Quote <- function( - ID, - separated = FALSE -) { - - ## definition of the ever growing quote data set - quotes <- rbind( - c("Anonymous student hotel employee", "Let me double check this."), - c("The ordinary reviewer", "I love it when a plan comes together."), - c("A tunnelling electron", "God does not play dice."), - c("Goldfinger", "You cannot get this machine better and cheaper than from us."), - c("A PhD supervisor", "Live long and in prosper."), - c("A PhD supervisor", "You are not depressive, you simply have a crappy life."), - c("A trapped charge", "I want to break free."), - c("The R-package Luminescence manual", "Call unto me, and I will answer thee, and will shew thee great things, and difficult, which thou knowest not."), - c("A stimulated feldspar grain", "I'm so excited and I just can't hide it."), - c("The true age", "How many roads..."), - c("The undecided OSL component", "Should I stay or should I go?"), - c("A fluvially transported quartz grain at night", "Always look at the bright side of life."), - c("An arctic sediment outcrop", "Marmor, Stein und Eisen bricht..."), - c("A common luminescence reader customer", "If anything can go wrong, it will."), - c("A blue LED to a trapped electron", "Resistance is futile."), - c("A trapped electron to a yellow LED", "Well, that's all you've got?"), - c("A weathering rock", "Who wants to live forever?"), - c("A new pIRIR derivative", "20,000 miles below the sea."), - c("Robert Oppenheimer", "I want this thing to work by just pressing one button."), - c("An arbitrary member of the CRAN team", "No shirt, no shoes, no service!"), - c("Rubber mallet to steel cylinder", "Let's rock and roll."), - c("A data import function", "Better late than never."), - c("A luminescence lab staff member to its customer", "Tell me the age, I tell you the price."), - c("The NSA", "O'zapft is."), - c("The natural dose", "You only live once."), - c("A Windows user", "An apple a day keeps the doctor away."), - c("The authors of sTeve", "We love to entertain you."), - c("Any arbitrary independent OSL device manufacturer", "Sure it will work, it was me who built it!"), - c("Response to the reviewer", "You are right, it was just a guess."), - c("An aliquot disc", "The answer [...] is: 48"), - c("Push Pin", "Made of used sample carriers"), - c("A motivated R-Team member", "We are doing this not just for statistical reasons, there is real science behind it!"), - c("An unbiased reviewer", "The data is too poor to be published in QG, try a higher ranked journal."), - c("R Team member, asked about statistical details", "No idea, I'm just here for the visualisation."), - c("An arbitrary unexperienced RLum-user", "Little by little, the bird builds its nest."), - c("The answer to life, the universe and everything", "get_rightAnswer()"), - c("Der Tatortreiniger", "Dreck ist nur Materie am falschen Ort."), - c("Die Ex vom Tatortreiniger", "Das Ziel ist im Weg."), - c("Bright grain to dim grains", "I'm so shiny!"), - c("Fast component to slow component", "Life is short!"), - c("Fast component to slow component", "What are you waiting for?"), - c("Violet photon to deep trap electron", "Today I'm kicking you out of your comfort zone!"), - c("Deep trap electron to infrared photon", "Don't bother me, I need to rest."), - c("A single grain", "I feel so lonley."), - c("Luminescence data to Bayesian process", "Don't you ever touch me again."), - c("Quartz grain to heating plate", "Go ahead, I need a phase change."), - c("Photon to electron", "I am in charge!"), - c("You cannot spell 'data analysis' without 'daily satan'"), - c("Bright grain to dim grain", "Don't you get it?") - ) - - ## Check input data - if(missing(ID) == TRUE) { - ID <- sample(x = seq(from = 1, - to = nrow(quotes)), - size = 1) - } - - ## check for correct ID and generate qoute - if(length(ID) < 1 | ID > nrow(quotes)) { - quote.out <- "Sorry, but this was an impossible task!" - - } else { - - ## generate qoute(s) - if(separated == FALSE) { - quote.out <- paste(quotes[ID,1], ": '", quotes[ID,2], "'", sep = "") - } else { - quote.out <- quotes[ID,] - } - } - - ## return quotes - return(quote.out) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/get_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/get_RLum.R deleted file mode 100644 index ef540011a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/get_RLum.R +++ /dev/null @@ -1,137 +0,0 @@ -#' General accessors function for RLum S4 class objects -#' -#' Function calls object-specific get functions for RLum S4 class objects. -#' -#' The function provides a generalised access point for specific -#' [RLum-class] objects.\cr -#' Depending on the input object, the corresponding get function will be selected. -#' Allowed arguments can be found in the documentations of the corresponding -#' [RLum-class] class. -#' -#' @param object [RLum-class] (**required**): -#' S4 object of class `RLum` or an object of type [list] containing only objects -#' of type [RLum-class] -#' -#' @param ... further arguments that will be passed to the object specific methods. For -#' further details on the supported arguments please see the class -#' documentation: [RLum.Data.Curve-class], [RLum.Data.Spectrum-class], -#' [RLum.Data.Image-class], [RLum.Analysis-class] and [RLum.Results-class] -#' -#' @return Return is the same as input objects as provided in the list. -#' -#' @section Function version: 0.3.3 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum.Data.Curve-class], [RLum.Data.Image-class], -#' [RLum.Data.Spectrum-class], [RLum.Analysis-class], [RLum.Results-class] -#' -#' @keywords utilities -#' -#' @examples -#' -#' ##Example based using data and from the calc_CentralDose() function -#' -#' ##load example data -#' data(ExampleData.DeValues, envir = environment()) -#' -#' ##apply the central dose model 1st time -#' temp1 <- calc_CentralDose(ExampleData.DeValues$CA1) -#' -#' ##get results and store them in a new object -#' temp.get <- get_RLum(object = temp1) -#' -#' @md -#' @export -setGeneric("get_RLum", function (object, ...) {standardGeneric("get_RLum") }) - -# Method for get_RLum method for RLum objects in a list for a list of objects ------------------- -#' @describeIn get_RLum -#' Returns a list of [RLum-class] objects that had been passed to [get_RLum] -#' -#' @param class [character] (*optional*): allows to define the class that gets selected if -#' applied to a list, e.g., if a list consists of different type of RLum-class objects, this -#' arguments allows to make selection. If nothing is provided, all RLum-objects are treated. -#' -#' @param null.rm [logical] (*with default*): option to get rid of empty and NULL objects -#' -#' @md -#' @export -setMethod("get_RLum", - signature = "list", - function(object, class = NULL, null.rm = FALSE, ...){ - - ##take care of the class argument - if(!is.null(class)){ - sel <- class[1] == vapply(object, function(x) class(x), character(1)) - if(any(sel)) - object <- object[sel] - - rm(sel) - } - - - ##make remove all non-RLum objects - selection <- lapply(1:length(object), function(x){ - - ##get rid of all objects that are not of type RLum, this is better than leaving that - ##to the user - if(inherits(object[[x]], what = "RLum")){ - - ##it might be the case the object already comes with empty objects, this would - ##cause a crash - if(inherits(object[[x]], "RLum.Analysis") && length(object[[x]]@records) == 0) - return(NULL) - - get_RLum(object[[x]], ...) - - - } else { - - warning(paste0("[get_RLum()] object #",x," in the list was not of type 'RLum' and has been removed!"), - call. = FALSE) - return(NULL) - - } - - }) - - ##remove empty or NULL objects after the selection ... if wanted - if(null.rm){ - - - ##first set all empty objects to NULL ... for RLum.Analysis objects - selection <- lapply(1:length(selection), function(x){ - if(inherits(selection[[x]], "RLum.Analysis") && length(selection[[x]]@records) == 0){ - return(NULL) - - }else{ - return(selection[[x]]) - - } - - }) - - ##get rid of all NULL objects - selection <- selection[!sapply(selection, is.null)] - - - } - - return(selection) - - }) - - -#' Method to handle NULL if the user calls get_RLum -#' -#' @describeIn get_RLum -#' -#' Returns NULL -#' -#' @md -#' @export -setMethod("get_RLum", - signature = "NULL", - function(object, ...){NULL}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/get_Risoe.BINfileData.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/get_Risoe.BINfileData.R deleted file mode 100644 index 5e0e0b561..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/get_Risoe.BINfileData.R +++ /dev/null @@ -1,36 +0,0 @@ -#' General accessor function for RLum S4 class objects -#' -#' Function calls object-specific get functions for RisoeBINfileData S4 class objects. -#' -#' The function provides a generalised access point for specific -#' [Risoe.BINfileData-class] objects. \cr -#' Depending on the input object, the corresponding get function will be selected. -#' Allowed arguments can be found in the documentations of the corresponding -#' [Risoe.BINfileData-class] class. -#' -#' @param object [Risoe.BINfileData-class] (**required**): -#' S4 object of class `RLum` -#' -#' @param ... further arguments that one might want to pass to the specific -#' get function -#' -#' @return Return is the same as input objects as provided in the list -#' -#' @section Function version: 0.1.0 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [Risoe.BINfileData-class] -#' -#' @keywords utilities -#' -#' @md -#' @export -setGeneric( - name = "get_Risoe.BINfileData", - def = function(object, ...) { - standardGeneric("get_Risoe.BINfileData") - }, - package = "Luminescence" -) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/get_rightAnswer.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/get_rightAnswer.R deleted file mode 100644 index 677fbbf40..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/get_rightAnswer.R +++ /dev/null @@ -1,22 +0,0 @@ -#' Function to get the right answer -#' -#' This function returns just the right answer -#' -#' @param ... you can pass an infinite number of further arguments -#' -#' @return Returns the right answer -#' -#' @section Function version: 0.1.0 -#' -#' @author inspired by R.G. -#' -#' @examples -#' -#' ## you really want to know? -#' get_rightAnswer() -#' -#' @md -#' @export -get_rightAnswer <- function(...) { - return(46) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/github.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/github.R deleted file mode 100644 index f8b1a5961..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/github.R +++ /dev/null @@ -1,223 +0,0 @@ -# ------------------------------------------------------------------------ -# Author: Christoph Burow -# Affiliation: University of Cologne -# Date: 15/01/2019 -# API version: v3 -# Reference: https://docs.github.com/v3/ -# ------------------------------------------------------------------------ - -#' GitHub API -#' -#' R Interface to the GitHub API v3. -#' -#' These functions can be used to query a specific repository hosted on GitHub. \cr -#' -#' -#' @param user [character] (*with default*): -#' GitHub user name (defaults to `'r-lum'`). -#' -#' @param repo [character] (*with default*): -#' name of a GitHub repository (defaults to `'luminescence'`). -#' -#' @param branch [character] (*with default*): -#' branch of a GitHub repository (defaults to `'master'`). -#' -#' @param n [integer] (*with default*): -#' number of commits returned (defaults to 5). -#' -#' @param verbose [logical] (*with default*): -#' print the output to the console (defaults to `TRUE`). -#' -#' @author Christoph Burow, University of Cologne (Germany) -#' -#' @section Function version: 0.1.0 -#' -#' @references -#' -#' GitHub Developer API v3. [https://docs.github.com/v3/](), last accessed: 10/01/2017. -#' -#' @examples -#' -#' \dontrun{ -#' github_branches(user = "r-lum", repo = "luminescence") -#' github_issues(user = "r-lum", repo = "luminescence") -#' github_commits(user = "r-lum", repo = "luminescence", branch = "master", n = 10) -#' } -#' -#' @md -#' @name GitHub-API -NULL - -# COMMITS ----------------------------------------------------------------- -#' @rdname GitHub-API -#' -#' @details -#' `github_commits` lists the most recent `n` commits of a specific branch of a repository. -#' -#' @return -#' `github_commits`: [data.frame] with columns: -#' -#' \tabular{ll}{ -#' `[ ,1]` \tab SHA \cr -#' `[ ,2]` \tab AUTHOR \cr -#' `[ ,3]` \tab DATE \cr -#' `[ ,4]` \tab MESSAGE \cr -#' } -#' -#' @md -#' @export -github_commits <- function(user = "r-lum", repo = "luminescence", - branch = "master", n = 5) { - - # fetch available branches and check if provided branch exists - branches <- github_branches(user, repo) - if (!any(grepl(branch, branches$BRANCH))) - stop("Branch ", branch, " does not exist.", call. = FALSE) - - # build URL and retrieve content - sha <- branches$SHA[grep(paste0("^", branch, "$"), branches$BRANCH)] - url <- paste0("https://api.github.com/repos/", user, "/", repo, "/commits?", - "per_page=", n, "&sha=", sha) - content <- github_getContent(url) - - # format output as data.frame - output <- do.call(rbind, lapply(content, function(x) { - data.frame(SHA = x$sha, - AUTHOR = x$commit$author$name, - DATE = x$commit$author$date, - MESSAGE = x$commit$message, - stringsAsFactors = FALSE) - })) - - return(output) -} - - -# BRANCHES ---------------------------------------------------------------- -#' @rdname GitHub-API -#' -#' @details -#' `github_branches` can be used to list all current branches of a -#' repository and returns the corresponding SHA hash as well as an installation -#' command to install the branch in R via the 'devtools' package. -#' -#' @return -#' `github_branches`: [data.frame] with columns: -#' -#' \tabular{ll}{ -#' `[ ,1]` \tab BRANCH \cr -#' `[ ,2]` \tab SHA \cr -#' `[ ,3]` \tab INSTALL \cr -#' } -#' -#' @md -#' @export -github_branches <- function(user = "r-lum", repo = "luminescence") { - - # build URL and retrieve content - url <- paste0("https://api.github.com/repos/", user, "/", repo, "/branches") - content <- github_getContent(url) - - # extract relevant information from server response - branches <- sapply(content, function(x) x$name) - sha <- sapply(content, function(x) x$commit$sha) - - # format output as data.frame - output <- data.frame( - BRANCH = branches, - SHA = sha, - INSTALL = paste0("devtools::install_github('r-lum/luminescence@", branches, "')"), - stringsAsFactors = FALSE - ) - - return(output) -} - - -# ISSUES ------------------------------------------------------------------ -#' @rdname GitHub-API -#' -#' @details -#' `github_issues` lists all open issues for a repository in valid YAML. -#' -#' @return -#' `github_commits`: Nested [list] with `n` elements. -#' Each commit element is a list with elements: -#' -#' \tabular{ll}{ -#' `[[1]]` \tab NUMBER \cr -#' `[[2]]` \tab TITLE \cr -#' `[[3]]` \tab BODY \cr -#' `[[4]]` \tab CREATED \cr -#' `[[5]]` \tab UPDATED \cr -#' `[[6]]` \tab CREATOR \cr -#' `[[7]]` \tab URL \cr -#' `[[8]]` \tab STATUS \cr -#' } -#' -#' @md -#' @export -github_issues <- function(user = "r-lum", repo = "luminescence", verbose = TRUE) { - - # build URL and retrieve content - url <- paste0("https://api.github.com/repos/", user,"/", repo, "/issues") - content <- github_getContent(url) - - # format output as nested list - issues <- lapply(content, function(x) { - list( - NUMBER = x$number, - TITLE = x$title, - BODY = gsub("\n", "", x$body), - CREATED = x$created_at, - UPDATED = x$updated_at, - CREATOR = x$user$login, - URL = x$url, - STATUS = x$state, - MILESTONE = x$milestone$title) - }) - - # custom printing of the the issues-list as print.list produces unreadable - # console output - if (verbose) { - tmp <- lapply(issues, function(x) { - - # limit width of description text - DESCRIPTION <- "" - for (i in seq_len(ceiling(nchar(x$BODY) / 100))) - DESCRIPTION <- paste(DESCRIPTION, " ", - substr(x$BODY, i*100-99, i*100), "\n") - - # print to console in valid YAML - cat(paste0("---\n", - 'title: "', x$TITLE, '"', "\n", - "number: ", x$NUMBER, "\n", - 'url: "', x$URL, '"', "\n", - "created: ", x$CREATED, "\n", - "updated: ", x$UPDATED, "\n", - "creator: ", x$CREATOR, "\n", - "status: ", x$STATUS, "\n", - 'milestone: "', x$MILESTONE, '"', "\n", - "description: >\n", DESCRIPTION, - "\n\n\n")) - - }) - } - # return invisible as we explicitly print the output - invisible(issues) -} - - - -# HELPER ------------------------------------------------------------------ - -# This function queries the URL, checks the server response and returns -# the content. -github_getContent <- function(url) { - response <- GET(url, accept_json()) - if (status_code(response) != 200) - stop("Contacting ", url, " had status code ", status_code(response), - call. = FALSE) - content <- content(response) - return(content) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/import_Data.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/import_Data.R deleted file mode 100644 index 69101db1e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/import_Data.R +++ /dev/null @@ -1,68 +0,0 @@ -#'@title Import Luminescence Data into R -#' -#'@description -#'Convenience wrapper function to provide a quicker and more standardised way of -#'reading data into R by looping through all in the package available data import functions starting with `read_`. -#' -#'@param file [character] (**required**): file to be imported, can be a [list] -#' -#'@param ... arguments to be further passed down to supported functions (please check the functions -#'to determine the correct arguments) -#' -#'@param fastForward [logical] (*with default*): option to create [RLum-class] objects -#'during import or a [list] of such objects -#' -#'@param verbose [logical] (*with default*): enable/disable verbose mode -#' -#'@section Function version: 0.1.1 -#' -#'@author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#'@seealso [read_BIN2R], [read_XSYG2R], [read_PSL2R], [read_SPE2R], [read_TIFF2R], [read_RF2R], -#'[read_Daybreak2R] -#' -#'@keywords datagen -#' -#'@examples -#' -#' ## import BINX/BIN -#' file <- system.file("extdata/BINfile_V8.binx", package = "Luminescence") -#' temp <- import_Data(file) -#' -#' ## RF data -#' file <- system.file("extdata", "RF_file.rf", package = "Luminescence") -#' temp <- import_Data(file) -#' -#'@md -#'@export -import_Data <- function ( - file, - ..., - fastForward = TRUE, - verbose = FALSE -) { - ## supported functions - fun <- c( - "read_BIN2R", - "read_XSYG2R", - "read_PSL2R", - "read_Daybreak2R", - "read_RF2R", - "read_SPE2R", - "read_TIFF2R", - "read_HeliosOSL2R") - - ## get arguments of functions - args <- c(list(file = file, fastForward = fastForward, verbose = verbose), list(...)) - - ## just try all functions - for (i in fun) { - ## get arguments and remove non-supported arguments - t <- suppressWarnings(suppressMessages(try(do.call(what = i, args = args), silent = TRUE))) - if (!is.null(t) && !inherits(t, "try-error")) - return(t) - - } - message("[import_Data()] Unknown file format, nothing imported!") - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/install_DevelopmentVersion.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/install_DevelopmentVersion.R deleted file mode 100644 index c51934bf2..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/install_DevelopmentVersion.R +++ /dev/null @@ -1,116 +0,0 @@ -#' @title Attempts to install the development version of the 'Luminescence' package -#' -#' @description This function is a convenient method for installing the development -#' version of the R package 'Luminescence' directly from GitHub. -#' -#' @details -#' This function uses [Luminescence::github_branches][Luminescence::GitHub-API] to check -#' which development branches of the R package 'Luminescence' are currently -#' available on GitHub. The user is then prompted to choose one of the branches -#' to be installed. It further checks whether the R package 'devtools' is -#' currently installed and available on the system. Finally, it prints R code -#' to the console that the user can copy and paste to the R console in order -#' to install the desired development version of the package. -#' -#' -#' If `force_install = TRUE` the functions checks if 'devtools' is available -#' and then attempts to install the chosen development branch via -#' [devtools::install_github]. -#' -#' @param force_install [logical] (*optional*): -#' If `FALSE` (the default) the function produces and prints the required -#' code to the console for the user to run manually afterwards. When `TRUE` -#' and all requirements are fulfilled (see details) this function attempts to install -#' the package itself. -#' -#' @return -#' This function requires user input at the command prompt to choose the -#' desired development branch to be installed. The required R code to install -#' the package is then printed to the console. -#' -#' @examples -#' -#' \dontrun{ -#' install_DevelopmentVersion() -#' } -#' -#' @md -#' @export -install_DevelopmentVersion <- function(force_install = FALSE) { - # nocov start - message("\n[install_DevelopmentVersion]\n") - - # check which branches are currently available - # see ?github_branches for GitHub API implementation - branches <- github_branches() - - index <- NULL - - # let user pick which branch he wants to install - while(is.null(index)) { - message(paste0("Which development branch do you want to install? \n", - paste0(" [", 1:length(branches$BRANCH), "]: ", branches$BRANCH, collapse = "\n"))) - message("\n [0]: ") - - index <- readline() - - if (index == 0) - return(NULL) - if (!index %in% seq_len(length(branches$BRANCH))) - index <- NULL - - cat("\n") - } - - # select the correct branch - branch <- branches$BRANCH[as.numeric(index)] - - if (!force_install) { - - message("----\n", - "Are all prerequisites installed? Make sure to have read\n", - "https://github.com/R-Lum/Luminescence/blob/master/README.md\n", - "----\n") - - message("Please copy and run the following code in your R command-line:\n") - if (!requireNamespace("devtools", quietly = TRUE)) - message("install.packages('devtools')") # nocov - - message(branches$INSTALL[as.numeric(index)], "\n") - - } else { - - reply <- NULL - while(is.null(reply)) { - message("Are all prerequisites installed?", - " (https://github.com/R-Lum/Luminescence/blob/master/README.md)\n", - " [n/N]: No\n", - " [y/Y]: Yes\n") - reply <- readline() - - if (reply == "n" || reply == "N") - return(NULL) - if (reply != "y" && reply != "Y") - reply <- NULL - } - - # check if 'devtools' is available and install if not - if (!requireNamespace("devtools", quietly = TRUE)) { - message("Please install the 'devtools' package first by running the following command:\n", - "install.packages('devtools')") - return(NULL) - } - - # detach the 'Luminescence' package - try(detach(name = "package:Luminescence", unload = TRUE, force = TRUE), - silent = TRUE) - - # try to unload the dynamic library - dynLibs <- sapply(.dynLibs(), function(x) x[["path"]] ) - try(dyn.unload(dynLibs[grep("Luminescence", dynLibs)]), silent = TRUE) - - # install the development version - devtools::install_github(paste0("r-lum/luminescence@", branch)) - } - # nocov end -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/internal_as.latex.table.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/internal_as.latex.table.R deleted file mode 100644 index 381486932..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/internal_as.latex.table.R +++ /dev/null @@ -1,307 +0,0 @@ -#' Create LaTex tables from data.frames and RLum objects -#' -#' This function takes a data.frame and returns a table in LaTex code that -#' can be copied into any tex document. -#' -#' @param x [data.frame] or `RLum` object (**required**) -#' -#' @param row.names currently unused -#' -#' @param col.names currently unused -#' -#' @param comments [logical] (*with default*): -#' insert LaTex comments -#' -#' @param pos [character] (*with default*): -#' `character` of length one specifying the alignment of each column, e.g., -#' pos'clr' for a three column data frame and center, left -#' and right alignment -#' -#' @param digits [numeric] (*with default*): -#' number of digits (numeric fields) -#' -#' @param rm.zero [logical] (*with default*): remove columns containing -#' only zeros, however this might not be wanted in all cases -#' -#' @param select [character] (*optional*): -#' a [character] vector passed to [subset] -#' -#' @param split [integer] (*optional*): -#' an [integer] specifying the number of individual tables -#' the data frame is split into. Useful for wide tables. Currently unused. -#' -#' @param tabular_only [logical] (*with default*): if `TRUE` only the tabular but not the -#' table environment is returned. This gives a lot of additional flexibility at hand -#' -#' @param ... options: `verbose` -#' -#' @section TODO: -#' - Improve by using RegEx to dynamically find error fields, eg. ( "([ ]err)|(^err)" ) -#' - -#' -#' @return -#' Returns LaTex code -#' -#' @examples -#' df <- data.frame(x = 1:10, y = letters[1:10]) -#' .as.latex.table(df) -#' .as.latex.table(df, pos = "lr") -#' .as.latex.table(df, select = "y", pos = "r") -#' -#' @md -#' @noRd -.as.latex.table <- function(x, - row.names = NULL, - col.names = NULL, - comments = TRUE, - pos = "c", - digits = 3, - rm.zero = TRUE, - select, - split = NULL, - tabular_only = FALSE, - ...) { - - args <- list(x = x, - row.names = row.names, - col.names = col.names, - comments = comments, - pos = pos, - digits = digits, - rm.zero = rm.zero, - split = split, - tabular_only = tabular_only, - ... = ...) - if (!missing(select)) - args$select <- select - - switch(class(x)[1], - data.frame = do.call(".as.latex.table.data.frame", args), - DRAC.highlights = do.call(".as.latex.table.data.frame", args), - RLum.Results = do.call(".as.latex.table.RLum.Results", args)) -} - -################################################################################ -## "Method" RLum.Results ## -##----------------------------------------------------------------------------## -.as.latex.table.RLum.Results <- function(x, - row.names = NULL, - col.names = NULL, - comments = TRUE, - pos = "c", - digits = 3, - rm.zero = TRUE, - select, - split = NULL, - ...) { - - ## Object: DRAC.highlights - if (x@originator == "use_DRAC") { - x <- get_RLum(x)$highlights - x <- .digits(x, digits) - - ##remove columns containing zero values ... they add no information - if(rm.zero){ - x <- x[sapply(x, function(y){ - y <- suppressWarnings(as.numeric(y)) - if(anyNA(y) || sum(y, na.rm = TRUE) != 0){ - TRUE - - }else{ - FALSE - - } - })] - } - - ##add +/- symbol and remove the columns we don't need - fields.w.error <- (grep(names(x), pattern = "err", fixed = TRUE) - 1) - - for(i in fields.w.error) - x[ ,i] <- paste0(x[ ,i], "\\,$\\pm$\\,", trimws(x[ ,i + 1])) - x <- x[-c(fields.w.error + 1)] - - ##create latex table - text <- .as.latex.table(x, comments = comments, pos = pos, split = split, ...) - - ##split table - text <- strsplit(text[[1]], split = "\n", fixed = TRUE) - - ##exchange columns ... or delete them at all (2nd step) - - ##Mineral ID - for(i in 1:length(text)){ - text[[i]][grepl(pattern = "Mineral", x = text[[i]], fixed = TRUE)] <- - "\t\\multicolumn{1}{p{0.5cm}}{\\centering \\textbf{M.}} & " - - - } - - ##put things again together (single character) - text <- paste(text[[1]], collapse = "\n") - - ##replace some latex stuff - text <- gsub(pattern = "p{2cm}", replacement = "p{1.5cm}", x = text, fixed = TRUE) - text <- gsub(pattern = "Gy.ka-1", replacement = "Gy~ka$^{-1}$", x = text, fixed = TRUE) - text <- gsub(pattern = "De", replacement = "$D_{E}$", x = text, fixed = TRUE) - text <- gsub(pattern = "alphadoserate", replacement = "$\\dot{D}_{\\alpha}$", x = text, fixed = TRUE) - text <- gsub(pattern = "betadoserate", replacement = "$\\dot{D}_{\\beta}$", x = text, fixed = TRUE) - text <- gsub(pattern = "gammadoserate", replacement = "$\\dot{D}_{\\gamma}$", x = text, fixed = TRUE) - text <- gsub(pattern = "Cosmicdoserate", replacement = "$\\dot{D}_{cosm.}$", x = text, fixed = TRUE) - text <- gsub(pattern = "External \\\\ doserate", replacement = "$\\dot{D}_{ext.}$", x = text, fixed = TRUE) - text <- gsub(pattern = "Internal \\\\ doserate", replacement = "$\\dot{D}_{int.}$", x = text, fixed = TRUE) - text <- gsub(pattern = "Environmental \\\\ Dose \\\\ Rate", replacement = "$\\dot{D}_{env.}$", x = text, fixed = TRUE) - - ## return result - return(text) - - }# EndOf::use_DRAC - -} - -################################################################################ -## "Method" data.frame ## -##----------------------------------------------------------------------------## -.as.latex.table.data.frame <- function(x, - row.names = NULL, - col.names = NULL, - comments = TRUE, - pos = "c", - digits = 3, - select, - split = NULL, - tabular_only = FALSE, - ...) { - ## Integrity checks ---- - if (!is.data.frame(x)) - .throw_error("'x' must be a data frame") - if (!is.null(col.names) && length(col.names) != ncol(x)) - .throw_error("Length of 'col.names' does not match the number of columns") - if (!is.null(row.names) && length(row.names) != nrow(x)) - .throw_error("Length of 'row.names' does not match the number of rows") - if (length(pos) != 1) - .throw_error("Length of 'pos' does not match the number of columns") - - ## Default settings ---- - options <- list(verbose = TRUE) - - ## Override settings ---- - options <- modifyList(options, list(...)) - - ## Subset data frame ---- - if (!missing(select)) { - is.name <- select %in% names(x) - if (any(!is.name)) - .throw_error("Undefined columns selected. Please check provided ", - "column names in 'select'.") - x <- subset(x, select = select) - } - - ## Format numeric fields ---- - x <- .digits(x, digits) - - ## Split the table - if (is.null(split)) - split <- 1 - chunks <- ceiling(ncol(x) / split) - chunks.start <- seq(1, ncol(x), chunks) - chunks.end <- chunks.start + chunks - 1 - chunks.end[length(chunks.end)] <- ncol(x) - - tex.table.list <- vector("list", split) - - for (i in 1:length(tex.table.list)) { - - x.chunk <- x[ ,chunks.start[i]:chunks.end[i]] - - if (ncol(x) == 1) { - x.chunk <- as.data.frame(x.chunk) - colnames(x.chunk) <- names(x[i]) - } - - - ## Comments ---- - tex.comment.usePackage <- ifelse(comments, - "% add usepackage{adjustbox} to latex preamble \n", - "") - - ## Header ---- - col.names <- tex.table.header <- gsub(pattern = " ", - x = names(x.chunk), - replacement = " \\\\\\\\ ") - tex.table.header <- paste0("\t", - paste("\\multicolumn{1}{p{2cm}}{\\centering", - col.names, - "}", - collapse = " & \n\t"), - "\\\\ \n") - - ## Rows ---- - tex.table.rows <- "" - for (j in 1:nrow(x.chunk)) { - tex.table.rows <- paste0(tex.table.rows, - paste(paste(x.chunk[j, ], collapse = " & "), - "\\\\ \n")) - } - - ## catch potential latex problems with underscores - after all are numbers, in can be only - ## on the ID - tex.table.rows <- gsub("_", "\\_", tex.table.rows, fixed = TRUE) - - ## Tex table ---- - if (nchar(pos) != 1 && nchar(pos) != ncol(x)) - pos <- "c" - if (!any(strsplit(pos, split = "")[[1]] %in% c("l", "c", "r"))) - pos <- "c" - if (nchar(pos) == 1) - pos <- paste0(rep(pos, ncol(x)), collapse = "") - - if(tabular_only){ - tex.table.begin <- paste0(paste(" \\begin{tabular}{", pos, "}\n"), - " \\hline \n") - - tex.table.end <- paste0(" \\hline \n", - " \\end{tabular}") - - }else{ - tex.table.begin <- paste0("\\begin{table}[ht] \n", - " \\centering \n", - " \\begin{adjustbox}{max width=\\textwidth} \n", - paste(" \\begin{tabular}{", pos, "}\n"), - " \\hline \n") - - tex.table.end <- paste0(" \\hline \n", - " \\end{tabular} \n", - " \\end{adjustbox} \n", - "\\end{table}") - } - - tex.table <- paste0(tex.comment.usePackage, - tex.table.begin, - tex.table.header, - "\\hline \n", - tex.table.rows, - tex.table.end) - - if (options$verbose) - cat(tex.table) - - tex.table.list[[i]] <- tex.table - } - - invisible(tex.table.list) -} - -# This function takes a data.frame, checks each column and tries to -# force the specified amount of digits if numeric or coerceable to numeric -.digits <- function(x, digits) { - for (i in 1:ncol(x)) { - if (is.factor(x[ ,i])) - x[ ,i] <- as.character(x[ ,i]) - test.numeric <- suppressWarnings(as.numeric(x[ ,i])) - if (!is.na(test.numeric[1])) - x[ ,i] <- format(round(test.numeric, digits), nsmall = digits, digits = digits) - - } - return(x) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/internals_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/internals_RLum.R deleted file mode 100644 index 5eca5446b..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/internals_RLum.R +++ /dev/null @@ -1,921 +0,0 @@ -# INTERNAL HELPER FUNCTIONS ----------------------------------------------- -#+++++++++++++++++++++ -#+ .set_pid() + -#+++++++++++++++++++++ -#' Set unique id of the RLum.Analysis object as parent id for each RLum.Data -#' object in the record list -#' -#' This function only applies on RLum.Analysis objects and was written for performance not -#' usability, means the functions runs without any checks and is for internal usage only. -#' -#' @param [RLum.Analysis-class] (**required**): -#' input object where the function should be applied on -#' -#' @return -#' Returns the same object as the input -#' -#' @section Function version: 0.1.0 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @examples -#' -#' ##example using self created data -#' object <- set_RLum( -#' "RLum.Analysis", -#' records = list( -#' set_RLum("RLum.Data.Curve"), -#' set_RLum("RLum.Data.Curve"))) -#' -#' object <- .set_pid(object) -#' -#' @md -#' @noRd -.set_pid <- function(object){ - object@records <- - lapply(object@records, function(x) { - x@.pid <- object@.uid - return(x) - }) - - return(object) -} - -#+++++++++++++++++++++ -#+ .warningCatcher() + -#+++++++++++++++++++++ - -#' Catches warning returned by a function and merges them. -#' The original return of the function is returned. This function is in particular -#' helpful if a function returns a lot of warnings with the same content. -#' -#' @param expr [expression] (**required**): -#' the R expression, usually a function -#' -#' @return -#' Returns the same object as the input and a warning table -#' -#' @section Function version: 0.1.0 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @examples -#' -#' f <- function() { -#' warning("warning 1") -#' warning("warning 1") -#' warning("warning 2") -#' 1:10 -#' } -#' print(.warningCatcher(f())) -#' -#' @md -#' @noRd -.warningCatcher <- function(expr) { - ##set variables - warning_collector <- list() - env <- environment() - - ##run function and catch warnings - results <- withCallingHandlers( - expr = expr, - warning = function(c) { - temp <- c(get("warning_collector", envir = env), c[[1]]) - assign(x = "warning_collector", - value = temp, - envir = env) - ##TODO should be replaced tryInvokeRestart once R 4.1 was released - invokeRestart("muffleWarning") - } - ) - - ##set new warning messages with merged results - if (length(warning_collector) > 0) { - w_table <- table(as.character(unlist(warning_collector))) - w_table_names <- names(w_table) - - warning(paste0( - "(", - 1:length(w_table), - ") ", - w_table_names, - ": This warning occurred ", - w_table, - " times!" - ,collapse = "\n"), - call. = FALSE) - - } - return(results) - -} - -#+++++++++++++++++++++ -#+ .smoothing() + -#+++++++++++++++++++++ - -#' Allows smoothing of data based on the function zoo::rollmean -#' -#' The function just allows a direct and meaningful access to the functionality of the zoo::rollmean() -#' function. Arguments of the function are only partly valid. -#' -#' @param x [numeric] (**required**): -#' the object for which the smoothing should be applied. -#' -#' @param k [integer] (*with default*): -#' window for the rolling mean; must be odd for rollmedian. -#' If nothing is set k is set automatically -#' -#' @param fill [numeric] (*with default*): -#' a vector defining the left and the right hand data -#' -#' @param align [character] (*with default*): -#' specifying whether the index of the result should be -#' left- or right-aligned or centered (default) compared to the rolling window of observations, -#' allowed `"right"`, `"center"` and `left` -#' -#' @param method [method] (*with default*): -#' defines which method should be applied for the smoothing: `"mean"` or `"median"` -#' -#' @return -#' Returns the same object as the input and a warning table -#' -#' @section Function version: 0.1.1 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @examples -#' -#' v <- 1:100 -#' .smoothing(v) -#' -#' @md -#' @noRd -.smoothing <- function( - x, - k = NULL, - fill = NA, - align = "right", - method = "mean") { - - ##set k - if (is.null(k)){ - k <- ceiling(length(x) / 100) - if(method == "median" && k %%2 ==0) - k <- k + 1 - } - - ##smooth data - if(method == "mean"){ - zoo::rollmean(x, k = k, fill = fill, align = align) - - }else if(method == "median"){ - zoo::rollmedian(x, k = k, fill = fill, align = align) - - }else{ - stop("[Luminescence:::.smoothing()] Unvalid input for 'method'!") - - } - -} - - -#++++++++++++++++++++++++++++++ -#+ Scientific axis annotation + -#++++++++++++++++++++++++++++++ - -#' Bored of the 1e10 notation of large numbers in R? Already tried to force -#' R to produce more fancy labels? Worry not, fancy_scientific() (written by -#' Jack Aidley) is at your help! -#' -#' Source: -#' [http://stackoverflow.com/questions/11610377/how-do-i-change-the-formatting-of-numbers-on-an-axis-with-ggplot]() -#' -#' @param l [numeric] (**required**): -#' a numeric vector, i.e. the labels that you want to add to your plot -#' -#' @return -#' Returns an expression -#' -#' @section Function version: 0.1.0 -#' -#' @author Jack Aidley -#' -#' @examples -#' plot(seq(1e10, 1e20, length.out = 10), -#' 1:10, -#' xaxt = "n") -#' -#' axis(1, at = axTicks(1), -#' labels = fancy_scientific(axTicks(1))) -#' -#' @md -#' @noRd -fancy_scientific <- function(l) { - # turn in to character string in scientific notation - l <- format(l, scientific = TRUE) - # quote the part before the exponent to keep all the digits - l <- gsub("^(.*)e", "'\\1'e", l) - # turn the 'e+' into plotmath format - l <- gsub("e", "%*%10^", l) - # remove plus sign - l <- gsub("\\+", "", l) - # return this as an expression - parse(text=l) -} - -#'Add fancy log axis with minor ticks the fancy axis labelling -#' -#'@param side [numeric] (**required**): the side where to plot the axis -#' -#'@param ... extra arguments to be passed to [graphics::axis], `side`, `at`and `labels` -#'are pre-defined and cannot be modified -#' -#'@return -#'Returns fancy log axis -#' -#'@author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#'@examples -#' -#'y <- c(0.1, 0.001, 0.0001) -#'plot(1:length(y), y, yaxt = "n", log = "y") -#'.add_fancy_log_axis(side = 2, las = 1) -#' -#'@md -#'@noRd -.add_fancy_log_axis <- function(side, ...){ - ## do just nothing if it would cause an error - if(!(par()$xlog && any(c(1,3) %in% side[1])) && !(par()$ylog && any(c(2,4) %in% side[1]))) - return(NULL) - - ## get current axis ticks and get exponent - ticks <- graphics::axTicks(side, log = TRUE) - ticks <- unique(floor(log10(ticks))) - minor_ticks <- vapply(ticks, function(x) { - seq(10^(x-1),10^x, length.out = 10)[-10] - }, numeric(9)) - - ## add minor ticks - graphics::axis( - side, - at = as.numeric(minor_ticks), - lwd.ticks = 0.5, - tcl = -.35, - labels = FALSE) - - ## add main axis - ## remove settings we set - args <- list(...) - args$side <- NULL - args$at <- NULL - args$labels <- NULL - - ## call the axis - do.call(what = graphics::axis, args = c( - list(side = side, - at = 10^ticks, - labels = fancy_scientific(10^ticks)), - args)) -} - - -#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -#+ Statistical Summary for Plot functions -#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -#' Create Statistical Summary Character Vector for Plot functions -#' -#' This function automatically generates the statistical summary for the plot functions within -#' the package. This should unify the approach how such things are created and support, theoretically -#' all keywords for all plot functions in a similar way. -#' -#'@param x [data.frame] (optional): output from the function `calc_Statistics()`. If nothing is -#'provided a list of prefix keyword combinations supported by the function `calc_Statistics()` is returned. -#' -#'@param keywords[character] (with default): keywords supported by the function `calc_Statistics()` -#' -#'@param digits [numeric] (with default): modifiy the digits independently for the plot output -#' -#'@param sep [character] (with default): a separator used for the creation of the output of the plot -#' -#'@param prefix [character] (with default): allows to add a leading prefix to the string -#' -#'@param suffix [character] (with default): allows to add a suffix to the entire string -#' -#'@author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#'@section Version: 0.1.0 -#' -#' -#'@md -#'@noRd -.create_StatisticalSummaryText <- function( - x = NULL, #insert the output of calc_Statistics - keywords = NULL, - digits = 2, #allow for different digits - sep = " \n ", - prefix = "", - suffix = "" -){ - - ## Grep keyword information - if (is.null(x)) { - summary <- calc_Statistics(data.frame(x = 1:2, y = 1:2)) - - } else { - summary <- x - - } - - #all allowed combinations - keywords_allowed <- unlist(lapply(names(summary), function(x){ - paste0(x, "$", names(summary[[x]])) - - })) - - ##return if for x == NULL - if(is.null(x)) - return(keywords_allowed) - - ## Create call - #create list - l <- lapply(keywords, function(k) { - ##strip keyword if necessary - if (grepl(pattern = "$", - x = k, - fixed = TRUE)[1]) { - strip <- strsplit(k, split = "$", fixed = TRUE)[[1]] - keywords_prefix <- strip[1] - k_strip <- strip[2] - } else{ - keywords_prefix <- "unweighted" - k_strip <- k - - } - - ##construct string - if(!is.null(summary[[keywords_prefix]][[k_strip]])){ - if(keywords_prefix == "unweighted"){ - paste0(k_strip, " = ", round(summary[[keywords_prefix]][[k_strip]], digits)) - - }else{ - paste0(k, " = ", round(summary[[keywords_prefix]][[k_strip]], digits)) - - } - - }else{ - return(NULL) - - } - - }) - - ##remove NULL entries - l <- l[!sapply(l, is.null)] - - ##construct final call - return(paste0(prefix, paste(unlist(l), collapse = sep), suffix)) - -} - -#++++++++++++++++++++++++++++++ -#+ Unlist RLum + -#++++++++++++++++++++++++++++++ -#' -#' Recursive unlisting of lists until the first element in the list -#' is something, but not a list. This funktion helps -#' to get rid of nested lists. The function stops running if a single -#' level list is reached. -#' -#' @param x [list] (**required**): list with lists -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @examples -#' a <- list(b = list(c = list("test"))) -#' .unlist_RLum(a) -#' -#' @return [list] with only one level left -#' @md -#' @noRd -.unlist_RLum <- function(x){ - stopifnot(class(x) == "list") - - if(length(x) > 0 && inherits(x[[1]], "list")){ - x <- unlist(x, recursive = FALSE) - .unlist_RLum(x) - }else{ - return(x) - - } - -} - -#++++++++++++++++++++++++++++++ -#+ .rm_nonRLum + -#++++++++++++++++++++++++++++++ -#' @title Removes all non-RLum objects from list -#' -#' @description Removes all non RLum objects from a list -#' supposed to consist only of RLum-class objects -#' As an internal function, the function is rather unforgiving, no further -#' checks are applied. -#' -#' @param x [list] (**required**): list -#' -#' @param class [character]: class to look for, if nothing is set -#' it checks for RLum in general -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @examples -#' x <- c(list(set_RLum("RLum.Analysis"), set_RLum("RLum.Analysis")), 2) -#' .rm_nonRLum(x) -#' -#' @return [list] with only RLum objects -#' -#' @md -#' @noRd -.rm_nonRLum <- function(x, class = NULL){ - if(is.null(class)) - return(x[vapply(x, inherits, logical(1), "RLum")]) - - x[vapply(x, "class", character(1)) == class[1]] -} - -#++++++++++++++++++++++++++++++ -#+ .matrix_binning + -#++++++++++++++++++++++++++++++ -#' @title Efficient binning of matrices -#' -#' @description This function allows efficient binning of matrices including -#' row and column name handling. Internally, the function uses [rowsum], -#' means the binning is always applied on the rows. For column binning the function -#' internally transposes the matrix first -#' -#' @param m [matrix] (**required**): the matrix uses the base function [rowsum] -#' -#' @param bin_size [integer] (*with default*): bin size -#' -#' @param bin_col [logical] (*with default*): applies the binning on the columns instead of the -#' rows. If you want to perform binning on rows and columns, you have to call this function twice. -#' -#' @param names [character] (*with default*): the handling of the row and column names. The default -#' `NULL` removes the column and row names. Other allowed input is: `'groups'` this uses the group -#' name, e.g., the last time value of a group, `'mean'` this calculates the mean value of a group, -#' `'sum'` to sum-up groups and you can provide any other value which will then be recycled throughout. -#' For example: `c('row1', 'row2')`. -#' -#' @author Sebastian Kreutzer, IRAMAT-CRP2A, UMR 5060, CNRS - Université Bordeaux Montaigne (France) -#' -#' @section Function version: 0.1.2 -#' -#' @note Row and column names are transformed to numeric and also summed up; this is not a bug -#' but a feature! -#' -#' @return [matrix] -#' -#' @examples -#' m <- matrix(data = c(rep(1:20,each = 20)), ncol = 10, nrow = 20) -#' rownames(m) <- 1:nrow(m) -#' colnames(m) <- 1:ncol(m) -#' -#' .matrix_binning(m, bin_size = 4) -#' -#' @md -#' @noRd -.matrix_binning <- function( - m, - bin_size = 1, - bin_col = FALSE, - names = NULL) { - - #@ The only check - if(!inherits(m, "matrix")) - stop("[.matrix_binning()] Input is not of class 'matrix'!", call. = FALSE) - - ## transpose in column mode - if(bin_col) m <- t(m) - - ## binning calculation - ##set groups - ##with the correction in the 2nd line we - ##get rid potential problems - groups <- rep(1:nrow(m), each = bin_size)[1:nrow(m)] - - ##row binning (thats all) - temp_m <- rowsum(m, group = groups) - - ## Correct names - if(!is.null(names[1])){ - if(names[1] == "groups"){ - ##get rownames correct (it is the end of each bin) - row_names <- rownames(m)[which(diff(groups) != 0)] - - ##correct last value - if(length(row_names) < nrow(m)) - row_names <- c(row_names,rownames(m)[nrow(m)]) - - }else if(names[1] == "mean"){ - groups <- rep(1:nrow(m), each = bin_size)[1:nrow(m)] - row_names <- as.numeric(rownames(m)) - row_names <- tapply(X = row_names, INDEX = groups, FUN = mean) - - }else if(names[1] == "sum"){ - row_names <- rowsum(as.numeric(rownames(m)), group = groups) - - }else{ - row_names <- names - - } - - ##reset rownames and make sure it fits the length - rownames(temp_m) <- rep(row_names, length.out = nrow(temp_m)) - - }else{ - rownames(temp_m) <- NULL - - } - - ## re-transpose in column mode - if(bin_col) temp_m <- t(temp_m) - - ## return - return(temp_m) -} - -#++++++++++++++++++++++++++++++ -#+ .expand_parameters + -#++++++++++++++++++++++++++++++ -#' @title Expand function parameters of self-call -#' -#' @description For the self-call, the function parameters need to -#' be expanded, this was done, so far in a non-consistent way and -#' repeated in every function using the self-call. This functions -#' does it once and for all similar in all functions. -#' -#' **NOTE**: the first argument is never extended due to performance reasons, -#' it might be a very large object -#' -#' @param len [numeric] (**required**): length of the parameter expansion -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @return [list] with expanded parameters -#' -#' @md -#' @noRd -.expand_parameters <- function(len){ - ##get original definition and the call of f - f_def <- sys.function(sys.parent()) - f_call <- sys.call(sys.parent()) - - ## get parent environment because we have to evaluate - ## objects in the parent environment. - p_env <- parent.env(environment()) - - ##extract arguments (do not consider the first argument, this might be a very - ##large object) - args_default <- as.list(f_def)[-length(as.list(f_def))][-1] - args_new <- as.list(match.call(f_def, f_call, FALSE))[-c(1:2)] - - ##now we have to make sure that we evaluate all language objects - ##before passing them further down - if(length(args_new) > 0){ - for(i in 1:length(args_new)){ - if(class(args_new[[i]])[1] == "name" | - class(args_new[[i]])[1] == "call" | - class(args_new[[i]])[1] == "(" ) { - args_new[[i]] <- eval(args_new[[i]], envir = p_env) - - } - } - } - - ##combine the two argument lists - args <- modifyList( - x = args_default, - val = args_new, - keep.null = TRUE) - - ##evaluate arguments and take care of missing values - for(i in 1:length(args)){ - if(is.na(names(args[i])) || names(args[i]) == "...") next - if(class(args[[i]])[1] == "name" & names(args[i]) != "...") { - stop(paste0("[",f_call[[1]],"()]: Argument <", - names(args[i]), "> missing; with no default!"), call. = FALSE) - } - - ##evaluate and cover special cases - if(!is.null(args[[i]])) args[[i]] <- eval(args[[i]]) - if(inherits(args[i], "list") & length(args[[i]]) == 0) args[[i]] <- list() - - } - ##expand all arguments - ##we have two conditions and three cases - ##1: the argument is a list AND the list itself is not named - ## ... the case when the user what to use different values for the objects - ##2: the argument is no list ... - ## ... the standard automated expansion - ## ... OR it is a list with names (e.g., rejection.criteria = list(recycling.ration = 10)) - for(i in 1:length(args)){ - if(inherits(args[[i]], "list") & is.null(names(args[[i]]))){ - args[[i]] <- rep(args[[i]], length = len[1]) - - } else { - args[[i]] <- rep(list(args[[i]]), length = len[1]) - - } - } - - return(args) -} - -#++++++++++++++++++++++++++++++ -#+ .calc_HPDI + -#++++++++++++++++++++++++++++++ -#' @title Calculates Highest Probability Density Interval -#' -#' @description The idea of this function is to provide a convenient -#' method to calculate the highest probability density intervals for -#' sets of data. This function might be exported later -#' Currently it follows roughly the idea of what is implemented -#' in `code` and `hdrcde`. If the results has more than one peak, -#' also this is shown, therefore the output is a matrix -#' -#' @param object [numeric] (**required**): numeric object with input data -#' -#' @param prob [numeric] (*with default*): sets aimed probability interval -#' -#' @param plot [logical] (*with default*): enables/disables additional control -#' plot -#' -#' @param ... further arguments passed to [stats::density] -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @references -#' Hyndman, R.J., 1996. Computing and Graphing Highest Density Regions. -#' The American Statistician 50, 120–8. doi:10.2307/2684423 -#' -#' @examples -#' x <- rnorm(100) -#' .calc_HPDI(x) -#' -#' @return [matrix] with HPDI -#' -#' @md -#' @noRd -.calc_HPDI <- function(object, prob = 0.95, plot = FALSE, ...){ - ##estimate density - dens <- density(object, ...) - diff <- diff(dens$x[1:2]) - - ##calculate probabilities - m <- cbind(matrix(c(dens$x, dens$y), ncol = 2), dens$y * diff) - o <- order(m[, 3], decreasing = TRUE) - m_ind <- which(cumsum(m[o, 3]) <= prob) - thres <- suppressWarnings(min(m[o, 2][m_ind])) - - ##get peaks - peaks_id <- which(abs(diff((m[,2] - thres) > 0)) == 1) - - ##calculate HPDI - HPDI <- matrix(NA, ncol = 2, nrow = 1) - if(length(peaks_id != 0)) - HPDI <- matrix(m[peaks_id,1], ncol = 2) - - colnames(HPDI) <- c("lower", "upper") - attr(HPDI, "Probabilty") <- prob - - if(plot){ - xy <- m[m_ind,c(1,2)] - plot(dens, main = "HPDI (control plot)") - abline(h = thres, lty = 2) - if(length(peaks_id != 0)) { - for(i in seq(1,length(peaks_id),2)) { - lines(x = m[peaks_id[i]:peaks_id[i + 1], 1], - y = m[peaks_id[i]:peaks_id[i + 1], 2], col = "red") - } - } - - } - - return(HPDI) -} - -#++++++++++++++++++++++++++++++ -#+ .download_file + -#++++++++++++++++++++++++++++++ -#'@title Internal File Download Handler -#' -#'@description For file imports using function commencing with `read_` the file download -#'was little consistent and surprisingly error-prone. This function should keep the requirements -#'more consistent -#' -#'@param url [character] (**required**) -#' -#'@param dest [character] (*with default*) -#' -#'@returns Returns either nothing (no URL) or the file path of the downloaded file -#' -#'@author Sebastian Kreutzer, Insitut of Geography, Heidelberg University, Germany -#' -#'@examples -#' -#'## returns just NULL (no URL detected) -#'.download_file(url = "teststs") -#' -#'## attempts download -#'.download_file(url = "https://raw.githubusercontent.com/R-Lum/rxylib/master/inst/extg") -#' -#'## attempts download silently -#' suppressMessages( -#' .download_file(url = "https://raw.githubusercontent.com/R-Lum/rxylib/master/inst/extg")) -#' -#'@md -#'@noRd -.download_file <- function( - url, - destfile = tempfile() -) { - - ## get name of calling function - caller <- paste0("[", as.character(sys.call(which = -1)[[1]]), "()]") - out_file_path <- NULL - - ## detect and extract URL - if(grepl(pattern = "https?\\:\\/\\/", x = url, perl = TRUE)) { - ## status reports - message(paste0(caller, " URL detected: ", url), appendLF = TRUE) - message(paste0(caller, " Attempting download ... "), appendLF = FALSE) - - ## extract URL from string only - url <- regmatches(x = url, m = regexec(pattern = "https?\\:\\/\\/.+", text = url, perl = TRUE))[[1]] - - ## use internal download - t <- tryCatch( - expr = download.file( - url = url, - destfile = destfile, - quiet = TRUE, - mode = "wb", ## this is needed for Windows otherwise the download does not work - cacheOK = FALSE, - method = "auto"), - warning = function(w) { - message("FAILED ", appendLF = TRUE) - return(NULL) - }, - error = function(e) { - message("FAILED ", appendLF = TRUE) - return(NULL) - }) - - if(!is.null(t) && t == 0) { - message("OK ", appendLF = TRUE) - out_file_path <- destfile - unlink(url) - - } - - } - - ## return file path - return(out_file_path) - -} - -#'@title Extract named element from nested list -#' -#'@description The function extracts a named element from a nested list. It assumes -#'that the name is unique in the nested list -#' -#'@param l [list] (**required**): input list for which we search the elements -#' -#'@param element [character] (**required**): name of the element we are looking for -#' -#'@returns Returns a flat [list] with only the elements with a particular name -#' -#'@author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany); -#'inspired by a ChatGPT request (2024-07-01) -#' -#'@md -#'@noRd -.get_named_list_element <- function(l, element) { - ## set helper function to iterate over list - f_iterate <- function(x, env) { - if (inherits(x, "list")) { - ## if name is in element, return element and update out - if (element %in% names(x)) { - tmp <- c(out, list(x[names(x) %in% element])) - assign(x = "out", value = tmp, envir = env) - } - - ## call the helper function with lapply - lapply(x, f_iterate, env = env) - } - } - - ## set output list and get current environment - out <- list() - env <- environment() - - ## call recursive function - f_iterate(l, env) - - ## unlist output (and keep NA) - out <- unlist(out, recursive = FALSE) - - ## return - return(out) - -} - -#'@title Throws a Custom Tailored Error Message -#' -#'@param ... the error message to throw -#'@param nframe [numeric] (*with default*): the frame where the function -#' name to return in the error message should be searched: the -#' default value of 1 is generally fine, unless [throw_error] is -#' called from an internal function (whose name is not of interest -#' to the user), in which case a value of 2 should be used. -#' -#'@md -#'@noRd -.throw_error <- function(..., nframe = 1) { - ## get name of calling function - f_calling <- paste0("[", deparse(sys.call(-nframe)[1]), "] ") - - ## stop - stop(paste0(f_calling, ...), call. = FALSE) - -} - -#'@title Throws a Custom Tailored Warning Message -#' -#'@param ... the warning message to throw -#'@param nframe [numeric] (*with default*): the frame where the function -#' name to return in the warning message should be searched: the -#' default value of 1 is generally fine, unless [throw_warning] is -#' called from an internal function (whose name is not of interest -#' to the user), in which case a value of 2 should be used -#' -#'@md -#'@noRd -.throw_warning <- function(..., nframe = 1) { - ## get name of calling function - f_calling <- paste0("[", deparse(sys.call(-nframe)[1]), "] ") - - ## stop - warning(paste0(f_calling, ...), call. = FALSE) - -} - -#' @title Silence Output and Warnings during Tests -#' -#' @description -#' This is helpful so that during tests the terminal is not filled up by -#' the output from the function tested, which is often left intentionally -#' verbose to facilitate the coverage analysis. -#' -#' This was originally defined in `tests/testthat/setup.R`, but unfortunately -#' that file is not sourced by `covr::file_coverage()` (as opposed to what -#' happens with `testthat::test_file()` and `covr::package_coverage()`), -#' which makes it harder to work iteratively with it. -#' -#' @param expr [expression] an R expression (often a function, but can be -#' any amount of code) the output of which needs to be silenced -#' -#' @examples -#' SW({ -#' template_DRAC(preset = "DRAC-example_quartz") -#' }) -#' -#' @md -#' @noRd -SW <- function(expr) capture.output(suppressMessages(suppressWarnings(expr))) - -#' @title Validate Scalar Variables Expected to be Positive -#' -#' @param val [numeric] (**required**): value to validate -#' @param int [logical] (*with default*): whether the value has to be an -#' integer (`FALSE` by default) -#' @param null.ok [logical] (*with default*): whether a `NULL` value should be -#' considered valid (`FALSE` by default) -#' @param name [character] (*with default*): Variable name to report in case of error; if not specified -#' it's inferred from the name of the name of the variable tested -#' -#' @md -#' @noRd -.validate_positive_scalar <- function(val, int = FALSE, null.ok = FALSE, - name = NULL) { - if (is.null(val) && null.ok) - return() - if (!is.numeric(val) || length(val) != 1 || is.na(val) || val <= 0 || - (int && val != as.integer(val))) { - if (is.null(name)) - name <- all.vars(match.call())[1] - .throw_error("'", name, "' must be a positive ", if (int) "integer ", - "scalar", nframe = 2) - } -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/internals_Thermochronometry.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/internals_Thermochronometry.R deleted file mode 100644 index 1c8121a14..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/internals_Thermochronometry.R +++ /dev/null @@ -1,202 +0,0 @@ -#'@title Import Thermochronometry Data -#' -#'@description Import Excel Data from Thermochronometry Experiments into R. -#'This function is an adaption of the script `STAGE1, ExcelToStructure` by -#'Benny Guralnik, 2014 -#' -#'@param file [character] (**required**): path to XLS file; alternatively a [list] created -#' -#'@param output_type [character] (*with default*): defines the output for the function, -#'which can be either `"RLum.Results"` (the default) or a plain R list (`"list"`) -#' -#'@author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#'@seealso [readxl::read_excel] -#' -#'@returns Depending on the setting of `output_type` it will be either a plain R [list] -#'or an [RLum.Results-class] object with the following structure data elements -#' -#'`$data: ` -#'`.. $ITL` : a [data.frame] with five columns, `SAMPLE`, `TEMP`, `TIME`, `LxTx`, `LxTx_ERROR` -#'`.. $DRC` : a [data.frame] with five columns, `SAMPLE`, `ALQ`, `TIME`, `LxTx`, `LxTx_ERROR` -#'`.. $FAD` : a [data.frame] with five columns, `SAMPLE`, `ALQ`, `TIME`, `LxTx`, `LxTx_ERROR` -#' -#'This refers to `$ITL`: Isothermal curves, `$DRC`: Dose-response curve, `$FAD`: Fading -#' -#'@md -#'@noRd -.import_ThermochronometryData <- function( - file, - output_type = "RLum.Results" -) { -# Helper functions ------------------------------------------------------- - ## consistently extract numerical data - .extract_numerics <- function(x) { - tmp <- suppressWarnings(as.numeric(na.exclude(as.numeric(x)))) - if(length(tmp) == 0) - tmp <- NA - - tmp - } - - ## define variable - ka <- 1e+3 * 365 * 24 * 3600 # ka in seconds - -# Import ------------------------------------------------------------------ - ## preset records - records <- file[1] - - if (inherits(file, "character")) { - ## get number of sheets in the file - sheets <- readxl::excel_sheets(file) - - ## import data from all sheets ... separate header and body - tmp_records <- lapply(sheets, function(x) { - header <- readxl::read_excel(file, sheet = x, .name_repair = "unique_quiet", n_max = 3) - body <- readxl::read_excel(file, sheet = x, .name_repair = "unique_quiet", skip = 3) - list(as.data.frame(header), as.data.frame(body)) - }) - names(tmp_records) <- sheets - - ## compile records - records <- lapply(tmp_records, function(x){ - list( - id = colnames(x[[1]][-1])[!grepl(pattern = "\\.\\.\\.[0-9]+", x = colnames(x[[1]])[-1])], - params = list( - natT = .extract_numerics(x[[1]][1,-1]), #natural temperature - natDdot = .extract_numerics(x[[1]][2,-1]) / ka, #natural dose rate - rawdata = lapply(seq(1,nrow(x[[2]]),2), function(y) { - list( - T = x[[2]][y, 2], # Temperature - Ddot = x[[2]][y + 1, 2], # Instrument dose rate - t = .extract_numerics(x[[2]][y, -c(2:4)]) * 1e+3, # Measurement time (irradiation or delay time) - L = .extract_numerics(x[[2]][y + 1, -c(2:4)])/max(.extract_numerics(x[[2]][y + 1, -c(2:4)])) # normalise the luminescence signal data to the maximum - ) - }) - )) - }) - - ## assign originator to this list - attr(records, "originator") <- ".import_ThermochronometryData " - - }#end XLSX import - - ## if input is a list check what is coming in - if(!inherits(records, "list") || - is.null(attr(records, "originator")) || - attr(records, "originator") != ".import_ThermochronometryData ") - stop("[.import_ThermochronometryData ] import not supported!", call. = FALSE) - - # Create output ----------------------------------------------------------- - if (output_type == "RLum.Results") { - ## create data frame for each data type - - ## we will use the temperature to discriminate the records; everything - ## with temperature < 15 is either for DRC or FAD, the rest ITL. - ## here we safe the list index of each record type so that we can access those - ## data later - ## index -------- - id_l <- lapply(records, function(x) { - tmp <- cumsum(unlist(.get_named_list_element(x, "T")) > 15) - names(tmp) <- NULL - - ## create index list - list( - DRC = which(tmp == 0), - ITL = which(!duplicated(tmp))[-1], - FAD = which(tmp == max(tmp))[-1]) - - }) - - ## now we create for each data type a data.frame in the ggplot2 accessible - ## way - ## DRC --------- - DRC <- as.data.frame(data.table::rbindlist(lapply(seq_along(records), function(x) { - ## extract variables - ALQ <- seq_along(id_l[[x]]$DRC) - TIME <- .get_named_list_element(records[[x]], "t")[id_l[[x]]$DRC] - LxTx <- .get_named_list_element(records[[x]], "L")[id_l[[x]]$DRC] - - ## get length of each record - n_length <- vapply(TIME, length, numeric(1)) - - ## the number of rows are determined automatically - data.frame( - SAMPLE = names(records)[x], - ALQ = as.numeric(mapply(rep, ALQ, n_length)), - TIME = unlist(.get_named_list_element(records[[x]], "t")[id_l[[x]]$DRC]), - LxTx = unlist(.get_named_list_element(records[[x]], "L")[id_l[[x]]$DRC]), - LxTx_ERROR = NA) - - }))) - - ## ITL --------- - ITL <- as.data.frame(data.table::rbindlist(lapply(seq_along(records), function(x) { - ## extract variables - TEMP <- .get_named_list_element(records[[x]], "T")[id_l[[x]]$ITL] - TIME <- .get_named_list_element(records[[x]], "t")[id_l[[x]]$ITL] - LxTx <- .get_named_list_element(records[[x]], "L")[id_l[[x]]$ITL] - - ## get length of each record - n_length <- vapply(TIME, length, numeric(1)) - - ## the number of rows are determined automatically - data.frame( - SAMPLE = names(records)[x], - TEMP = unlist(mapply(rep, TEMP, n_length, SIMPLIFY = FALSE)), - TIME = unlist(TIME), - LxTx = unlist(LxTx), - LxTx_ERROR = NA) - - }))) - - ## FAD --------- - FAD <- as.data.frame(data.table::rbindlist(lapply(seq_along(records), function(x) { - ## extract variables - ALQ <- seq_along(id_l[[x]]$FAD) - TIME <- .get_named_list_element(records[[x]], "t")[id_l[[x]]$FAD] - LxTx <- .get_named_list_element(records[[x]], "L")[id_l[[x]]$FAD] - - ## get length of each record - n_length <- vapply(TIME, length, numeric(1)) - - ## the number of rows are determined automatically - data.frame( - SAMPLE = names(records)[x], - ALQ = unlist(mapply(rep, ALQ, n_length)), - TIME = unlist(.get_named_list_element(records[[x]], "t")[id_l[[x]]$FAD]), - LxTx = unlist(.get_named_list_element(records[[x]], "L")[id_l[[x]]$FAD]), - LxTx_ERROR = NA) - - }))) - - ## Ddot ---------- - ## Ddot is only relevant for DRC data - Ddot_DRC <- lapply(seq_along(records), function(x) { - unlist(.get_named_list_element(records[[x]], "Ddot"))[id_l[[x]]$DRC] - }) - - ##natDdot - nat_Ddot <- unlist( - lapply(records, .get_named_list_element, "natDdot"), - recursive = FALSE) - - ## create RLum.Results object - records <- set_RLum( - class = "RLum.Results", - data = list( - DRC = DRC, - ITL = ITL, - FAD = FAD), - info = list( - call = sys.call(), - sample_names = unique(names(records)), - Ddot_DRC = Ddot_DRC, - nat_Ddot = nat_Ddot) - ) - - } - - ## always return records - return(records) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/length_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/length_RLum.R deleted file mode 100644 index b45d8d771..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/length_RLum.R +++ /dev/null @@ -1,34 +0,0 @@ -#' General accessor function for RLum S4 class objects -#' -#' Function calls object-specific get functions for RLum S4 class objects. -#' -#' The function provides a generalised access point for specific -#' [RLum-class] objects.\cr -#' Depending on the input object, the corresponding get function will be selected. -#' Allowed arguments can be found in the documentations of the corresponding -#' [RLum-class] class. -#' -#' @param object [RLum-class] (**required**): -#' S4 object of class `RLum` -#' -#' @return Return is the same as input objects as provided in the list. -#' -#' @section Function version: 0.1.0 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' (France) -#' @seealso -#' [RLum.Data.Curve-class], -#' [RLum.Data.Image-class], -#' [RLum.Data.Spectrum-class], -#' [RLum.Analysis-class], -#' [RLum.Results-class] -#' @keywords utilities -#' -#' -#' @md -#' @export -setGeneric("length_RLum", function(object) { - standardGeneric("length_RLum") -}) - diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/merge_RLum.Analysis.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/merge_RLum.Analysis.R deleted file mode 100644 index e98f36ace..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/merge_RLum.Analysis.R +++ /dev/null @@ -1,137 +0,0 @@ -#' Merge function for RLum.Analysis S4 class objects -#' -#' Function allows merging of RLum.Analysis objects and adding of allowed -#' objects to an RLum.Analysis. -#' -#' This function simply allows to merge [RLum.Analysis-class] -#' objects. Moreover, other [RLum-class] objects can be added -#' to an existing [RLum.Analysis-class] object. Supported objects -#' to be added are: [RLum.Data.Curve-class], -#' [RLum.Data.Spectrum-class] and -#' [RLum.Data.Image-class]. -#' -#' The order in the new [RLum.Analysis-class] object is the object -#' order provided with the input list. -#' -#' @param objects [list] of [RLum.Analysis-class] (**required**): -#' list of S4 objects of class `RLum.Analysis`. Furthermore other objects of -#' class [RLum-class] can be added, see details. -#' -#' @return Return an [RLum.Analysis-class] object. -#' -#' @note -#' The information for the slot 'protocol' is taken from the first -#' [RLum.Analysis-class] object in the input list. Therefore at -#' least one object of type [RLum.Analysis-class] has to be provided. -#' -#' @section Function version: 0.2.0 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [merge_RLum], [RLum.Analysis-class], [RLum.Data.Curve-class], -#' [RLum.Data.Spectrum-class], [RLum.Data.Image-class], [RLum-class] -#' -#' -#' @keywords utilities internal -#' -#' @examples -#' -#' -#' ##merge different RLum objects from the example data -#' data(ExampleData.RLum.Analysis, envir = environment()) -#' data(ExampleData.BINfileData, envir = environment()) -#' -#' object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) -#' curve <- get_RLum(object)[[2]] -#' -#' temp.merged <- merge_RLum.Analysis(list(curve, IRSAR.RF.Data, IRSAR.RF.Data)) -#' -#' @md -#' @export -merge_RLum.Analysis<- function( - objects -){ - - # Ingegrity checks ---------------------------------------------------------------------------- - - ##check if object is of class RLum - temp.class.test <- sapply(1:length(objects), function(x){ - - if(is(objects[[x]], "RLum") == FALSE){ - stop("[merge_RLum.Analysis()]: At least element #", x, - " is not of class 'RLum' or a derivative class!", call. = FALSE) - } - - ##provide class of objects - is(objects[[x]])[1] - - }) - - ##check if at least one object of RLum.Analysis is provided - if(!"RLum.Analysis"%in%temp.class.test){ - stop("[merge_RLum.Analysis()] At least one input object in the list ", - "has to be of class 'RLum.Analysis'!") - } - - - - # Merge objects ------------------------------------------------------------------------------- - - ##(0) get recent environment to later set variable temp.meta.data.first - temp.environment <- environment() - temp.meta.data.first <- NA; rm(temp.meta.data.first) #to avoid problems with the R check routine - - ##(1) collect all elements in a list - temp.element.list <- unlist(lapply(1:length(objects), function(x){ - - ##Depending on the element the right functions is used - if(is(objects[[x]])[1] == "RLum.Analysis"){ - - ##grep export meta data from the first RLum.Analysis objects an write - if(!exists("temp.meta.data.first")){ - - assign("temp.meta.data.first", objects[[x]]@protocol, envir = temp.environment) - - } - - ##return to list - get_RLum(objects[[x]]) - - }else if((is(objects[[x]])[1] == "RLum.Data.Curve") | - (is(objects[[x]])[1] == "RLum.Data.Image") | - (is(objects[[x]])[1] == "RLum.Data.Spectrum")){ - - ##return to list - objects[[x]] - - }else{ - - stop("[merge_RLum.Analysis()] Object of class '", - class(objects[[x]]), "' not supported!") - - } - - - })) - - - # Build new RLum.Analysis object -------------------------------------------------------------- - temp.new.RLum.Analysis <- set_RLum( - class = "RLum.Analysis", - originator = "merge_RLum.Analysis", - records = temp.element.list, - protocol = temp.meta.data.first, - info = unlist(lapply(objects, function(x) { - x@info - }), recursive = FALSE), - .pid = unlist(lapply(objects, function(x) { - x@.uid - })) - ) - - - # Return object ------------------------------------------------------------------------------- - return( temp.new.RLum.Analysis) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/merge_RLum.Data.Curve.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/merge_RLum.Data.Curve.R deleted file mode 100644 index bbe9ccf29..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/merge_RLum.Data.Curve.R +++ /dev/null @@ -1,284 +0,0 @@ -#' Merge function for RLum.Data.Curve S4 class objects -#' -#' Function allows merging of RLum.Data.Curve objects in different ways -#' -#' This function simply allowing to merge [RLum.Data.Curve-class] -#' objects without touching the objects itself. Merging is always applied on -#' the 2nd column of the data matrix of the object. -#' -#' **Supported merge operations are [RLum.Data.Curve-class]** -#' -#' `"sum"` -#' -#' All count values will be summed up using the function [rowSums]. -#' -#' `"mean"` -#' -#' The mean over the count values is calculated using the function -#' [rowMeans]. -#' -#' `"median"` -#' -#' The median over the count values is calculated using the function -#' [matrixStats::rowMedians]. -#' -#' `"sd"` -#' -#' The standard deviation over the count values is calculated using the function -#' [matrixStats::rowSds]. -#' -#' `"var"` -#' -#' The variance over the count values is calculated using the function -#' [matrixStats::rowVars]. -#' -#' `"min"` -#' -#' The min values from the count values is chosen using the function -#' [matrixStats::rowMins][matrixStats::rowRanges]. -#' -#' `"max"` -#' -#' The max values from the count values is chosen using the function -#' [matrixStats::rowMins][matrixStats::rowRanges]. -#' -#' `"append"` -#' -#' Appends count values of all curves to one combined data curve. The channel width -#' is automatically re-calculated, but requires a constant channel width of the -#' original data. -#' -#' `"-"` -#' -#' The row sums of the last objects are subtracted from the first object. -#' -#' `"*"` -#' -#' The row sums of the last objects are multiplied with the first object. -#' -#' `"/"` -#' -#' Values of the first object are divided by row sums of the last objects. -#' -#' @param object [list] of [RLum.Data.Curve-class] (**required**): -#' list of S4 objects of class `RLum.Curve`. -#' -#' @param merge.method [character] (**required**): -#' method for combining of the objects, e.g. `'mean'`, `'sum'`, see details for -#' further information and allowed methods. Note: Elements in slot info will -#' be taken from the first curve in the list. -#' -#' @param method.info [numeric] (*optional*): -#' allows to specify how info elements of the input objects are combined, -#' e.g. `1` means that just the elements from the first object are kept, -#' `2` keeps only the info elements from the 2 object etc. -#' If nothing is provided all elements are combined. -#' -#' @return Returns an [RLum.Data.Curve-class] object. -#' -#' @note -#' The information from the slot `recordType` is taken from the first -#' [RLum.Data.Curve-class] object in the input list. The slot -#' 'curveType' is filled with the name `merged`. -#' -#' @section S3-generic support: -#' -#' This function is fully operational via S3-generics: -#' ``+``, ``-``, ``/``, ``*``, `merge` -#' -#' @section Function version: 0.2.1 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [merge_RLum], [RLum.Data.Curve-class] -#' -#' -#' @keywords utilities internal -#' -#' @examples -#' -#' -#' ##load example data -#' data(ExampleData.XSYG, envir = environment()) -#' -#' ##grep first and 3d TL curves -#' TL.curves <- get_RLum(OSL.SARMeasurement$Sequence.Object, recordType = "TL (UVVIS)") -#' TL.curve.1 <- TL.curves[[1]] -#' TL.curve.3 <- TL.curves[[3]] -#' -#' ##plot single curves -#' plot_RLum(TL.curve.1) -#' plot_RLum(TL.curve.3) -#' -#' ##subtract the 1st curve from the 2nd and plot -#' TL.curve.merged <- merge_RLum.Data.Curve(list(TL.curve.3, TL.curve.1), merge.method = "/") -#' plot_RLum(TL.curve.merged) -#' -#' @md -#' @export -merge_RLum.Data.Curve<- function( - object, - merge.method = "mean", - method.info -){ - -# Integrity checks ---------------------------------------------------------------------------- - - ##(1) check if object is of class RLum.Data.Curve - temp.recordType.test <- sapply(1:length(object), function(x){ - if(!inherits(object[[x]], "RLum.Data.Curve")){ - .throw_error("At least object ", x, " is not of class 'RLum.Data.Curve'") - } - - ##provide class of objects - return(object[[x]]@recordType) - - }) - - ##(2) Check for similar record types - record.types <- unique(temp.recordType.test) - if (length(record.types) > 1) { - .throw_error("Only similar record types are supported; you are trying to merge: ", - paste0("'", record.types, "'", collapse = ", ")) - } - -# Merge objects ---------------------------------------------------------------- - ##merge data objects - ##problem ... how to handle data with different resolution or length? - - ##(1) build new data matrix - ##first find shortest object - check.length <- vapply(object, function(x) nrow(x@data), numeric(1)) - - ## do something about it - temp.matrix <- .warningCatcher(sapply(1:length(object), function(x){ - ##check if the objects are of equal length - if (length(unique(check.length)) != 1) { - ##but we have to at least check the resolution (roughly) - if (round(diff(object[[x]]@data[,1]),1)[1] != round(diff(object[[1]]@data[,1]),1)[1]) - .throw_error("The objects do not seem to have the same channel resolution") - - ## either way, throw a warning - .throw_warning("The number of channels between the curves differs. ", - "Resulting curve has the length of shortest curve.") - - ##if this is OK, we can continue and shorten the rest of the objects - return(object[[x]]@data[1:min(check.length),2]) - - }else{ - object[[x]]@data[,2] - - } - - })) - - ##(2) apply selected method for merging - if(merge.method == "sum"){ - temp.matrix <- rowSums(temp.matrix) - - }else if(merge.method == "mean"){ - temp.matrix <- rowMeans(temp.matrix) - - }else if(merge.method == "median"){ - temp.matrix <- matrixStats::rowMedians(temp.matrix) - - }else if(merge.method == "sd"){ - temp.matrix <- matrixStats::rowSds(temp.matrix) - - }else if(merge.method == "var"){ - temp.matrix <- matrixStats::rowVars(temp.matrix) - - }else if(merge.method == "max"){ - temp.matrix <- matrixStats::rowMaxs(temp.matrix) - - }else if(merge.method == "min"){ - temp.matrix <- matrixStats::rowMins(temp.matrix) - - }else if(merge.method == "append") { - temp.matrix <- sapply(temp.matrix, c) - - }else if(merge.method == "-"){ - if(ncol(temp.matrix) > 2){ - temp.matrix <- temp.matrix[,1] - rowSums(temp.matrix[,-1]) - }else{ - temp.matrix <- temp.matrix[,1] - temp.matrix[,2] - } - - }else if(merge.method == "*"){ - if(ncol(temp.matrix) > 2){ - temp.matrix <- temp.matrix[,1] * rowSums(temp.matrix[,-1]) - }else{ - temp.matrix <- temp.matrix[,1] * temp.matrix[,2] - } - - }else if(merge.method == "/"){ - if(ncol(temp.matrix) > 2){ - temp.matrix <- temp.matrix[,1] / rowSums(temp.matrix[,-1]) - }else{ - temp.matrix <- temp.matrix[,1] / temp.matrix[,2] - } - - ##get index of inf values - id.inf <- which(is.infinite(temp.matrix) == TRUE) - - ##replace with 0 and throw warning - if (length(id.inf) > 0) { - temp.matrix[id.inf] <- 0 - .throw_warning(length(id.inf), - " 'inf' values have been replaced by 0 in the matrix.") - } - }else{ - .throw_error("Unsupported or unknown merge method") - } - - ##add first column - #If we append the data of the second to the first curve we have to recalculate - #the x-values (probably time/channel). The difference should always be the - #same, so we just expand the sequence if this is true. If this is not true, - #we revert to the default behaviour (i.e., append the x values) - if (merge.method[1] == "append" & length(unique(diff(object[[1]]@data[,1])))) { - step <- unique(diff(object[[1]]@data[,1])) - newx <- seq(from = min(object[[1]]@data[,1]), by = step, length.out = sum(check.length)) - temp.matrix <- cbind(newx, temp.matrix) - } else { - temp.matrix <- cbind(object[[1]]@data[1:min(check.length),1], temp.matrix) - } - - - - ##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - ##merge info objects as simple as possible ... just keep them all ... other possibility - ##would be to chose on the the input objects - - ##unlist is needed here, as otherwise i would cause unexpected behaviour further using - ##the RLum.object - if(missing(method.info)){ - temp.info <- unlist(lapply(1:length(object), function(x){ - object[[x]]@info - - }), recursive = FALSE) - - }else{ - temp.info <- object[[method.info]]@info - - } - - # Build new RLum.Data.Curve object -------------------------------------------------------------- - temp.new.Data.Curve <- set_RLum( - class = "RLum.Data.Curve", - originator = "merge_RLum.Data.Curve", - recordType = object[[1]]@recordType, - curveType = "merged", - data = temp.matrix, - info = temp.info, - .pid = unlist(lapply(object, function(x) { - x@.uid - })) - - ) - -# Return object ------------------------------------------------------------------------------- - return(temp.new.Data.Curve) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/merge_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/merge_RLum.R deleted file mode 100644 index 4f4fcd468..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/merge_RLum.R +++ /dev/null @@ -1,118 +0,0 @@ -#' General merge function for RLum S4 class objects -#' -#' Function calls object-specific merge functions for RLum S4 class objects. -#' -#' The function provides a generalised access point for merging specific -#' [RLum-class] objects. Depending on the input object, the -#' corresponding merge function will be selected. Allowed arguments can be -#' found in the documentation of each merge function. -#' Empty list elements (`NULL`) are automatically removed from the input `list`. -#' -#' \tabular{lll}{ -#' **object** \tab \tab **corresponding merge function** \cr -#' [RLum.Data.Curve-class] \tab : \tab `merge_RLum.Data.Curve` \cr -#' [RLum.Analysis-class] \tab : \tab `merge_RLum.Analysis` \cr -#' [RLum.Results-class] \tab : \tab `merge_RLum.Results` -#' } -#' -#' @param objects [list] of [RLum-class] (**required**): -#' list of S4 object of class `RLum` -#' -#' @param ... further arguments that one might want to pass to the specific merge function -#' -#' @return Return is the same as input objects as provided in the list. -#' -#' @note So far not for every `RLum` object a merging function exists. -#' -#' @section Function version: 0.1.3 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum.Data.Curve-class], [RLum.Data.Image-class], -#' [RLum.Data.Spectrum-class], [RLum.Analysis-class], [RLum.Results-class] -#' -#' -#' @keywords utilities -#' -#' @examples -#' -#' -#' ##Example based using data and from the calc_CentralDose() function -#' -#' ##load example data -#' data(ExampleData.DeValues, envir = environment()) -#' -#' ##apply the central dose model 1st time -#' temp1 <- calc_CentralDose(ExampleData.DeValues$CA1) -#' -#' ##apply the central dose model 2nd time -#' temp2 <- calc_CentralDose(ExampleData.DeValues$CA1) -#' -#' ##merge the results and store them in a new object -#' temp.merged <- get_RLum(merge_RLum(objects = list(temp1, temp2))) -#' -#' @md -#' @export -merge_RLum<- function( - objects, - ... -){ - - # Integrity check ---------------------------------------------------------- - if(!inherits(objects, "list")) - stop("[merge_RLum()] argument 'objects' needs to be of type list!", - call. = FALSE) - - ##we are friendly and remove all empty list elements, this helps a lot if we place things - ##we DO NOT provide a warning as this lowers the computation speed in particular cases. - objects <- objects[!sapply(objects, is.null)] - - ##if list is empty afterwards we do nothing - if(length(objects) >= 1) { - ##check if objects are of class RLum - temp.class.test <- unique(sapply(1:length(objects), function(x) { - if (!is(objects[[x]], "RLum")) { - temp.text <- - paste0( - "[merge_RLum()]: At least element #", x, " is not of class 'RLum' or a derivative class!" - ) - stop(temp.text, call. = FALSE) - } - ##provide class of objects ... so far they should be similar - is(objects[[x]])[1] - })) - - ##check if objects are consistent - if (length(temp.class.test) > 1) { - ##This is not valid for RLum.Analysis objects - if (!"RLum.Analysis" %in% temp.class.test) { - stop("[merge_RLum()] So far only similar input objects in the list are supported!") - } - } - - ##grep object class - objects.class <- - ifelse("RLum.Analysis" %in% temp.class.test, "RLum.Analysis", temp.class.test) - - ##select which merge function should be used - switch ( - objects.class, - RLum.Data.Image = stop( - "[merge_RLum()] Merging of 'RLum.Data.Image' objects is currently not supported" - ), - RLum.Data.Spectrum = stop( - "[merge_RLum()] Merging of 'RLum.Data.Spectrum' objects is currently not supported" - ), - RLum.Data.Curve = merge_RLum.Data.Curve(objects, ...), - RLum.Analysis = merge_RLum.Analysis(objects, ...), - RLum.Results = merge_RLum.Results(objects, ...) - ) - - }else{ - warning("[merge_RLum()] Nothing was merged as the object list was found to be empty or contains only one object!") - return(NULL) - - } - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/merge_RLum.Results.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/merge_RLum.Results.R deleted file mode 100644 index 0be1d5e0c..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/merge_RLum.Results.R +++ /dev/null @@ -1,131 +0,0 @@ -#' @title Merge function for RLum.Results S4-class objects -#' -#' @description Function merges objects of class [RLum.Results-class]. The slots in the objects -#' are combined depending on the object type, e.g., for [data.frame] and [matrix] -#' rows are appended. -#' -#' @details Elements are appended where possible and attributes are preserved if -#' not of similar name as the default attributes of, e.g., a [data.frame] -#' -#' @note The `originator` is taken from the first element and not reset to `merge_RLum` -#' -#' @param objects [list] (**required**): -#' a list of [RLum.Results-class] objects -#' -#' @section Function version: 0.2.1 -#' -#' @keywords internal -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @md -#' @export -merge_RLum.Results <- function( - objects){ - - ##------------------------------------------------------------- - ##Some integrity checks - - ##check if input object is a list - if(!is(objects, "list")){ - .throw_error("'objects' has to be of type 'list'") - }else{ - ##check if objects in the list are of type RLum.Results - temp.originator <- sapply(1:length(objects), function(x){ - if(is(objects[[x]], "RLum.Results") == FALSE){ - .throw_error("All objects to be merged must have type 'RLum.Results'") - } - - objects[[x]]@originator - - }) - } - - ##check if originator is different - if(length(unique(temp.originator))>1){ - .throw_error("Objects cannot be merged, different 'RLum.Results' originators found") - } - - ##------------------------------------------------------------- - ##merge objects depending on the data structure - for(i in 1:length(objects[[1]]@data)){ - ## shelf list of attributes - attr_list <- unlist( - lapply(1:length(objects), function(x) attributes(objects[[x]]@data[[i]])), - recursive = FALSE) - - ##++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ##numeric vector or data.frame or matrix - if(is(objects[[1]]@data[[i]], "data.frame")|| - is(objects[[1]]@data[[i]], "numeric") || - is(objects[[1]]@data[[i]], "matrix")){ - - ##grep elements and combine them into a list - temp.list <- lapply(1:length(objects), function(x) objects[[x]]@data[[i]]) - - ##check whether the objects can be combined by rbind - if(length(unique(unlist(lapply(temp.list, FUN = ncol)))) > 1) - .throw_error("Objects cannot be merged, different number of columns") - - ##combine them using rbind or data.table::rbindList (depends on the data type) - if(is(objects[[1]]@data[[i]], "numeric")){ - objects[[1]]@data[[i]] <- unlist(temp.list) - - }else if(is(objects[[1]]@data[[i]], "matrix")){ - objects[[1]]@data[[i]] <- do.call("rbind", temp.list) - - }else{ - objects[[1]]@data[[i]] <- as.data.frame(data.table::rbindlist(temp.list)) - - } - - ## continue attribute preservation - ## remove attributes that stem from the object itself - attr_list[names(attr_list) %in% names(attributes(objects[[1]]@data[[i]]))] <- NULL - - ## just to avoid working the code if not needed - if(length(attr_list) > 0) { - ## merge attributes with similar name - attrs <- lapply(unique(names(attr_list)), function(x){ - tmp <- unlist(attr_list[names(attr_list)%in%x], recursive = FALSE) - names(tmp) <- NULL - tmp - }) - names(attrs) <- unique(names(attr_list)) - - # set attributes ... we try because some attributes - for(n in names(attrs)) - attr(objects[[1]]@data[[i]], n) <- attrs[[n]] - } - - - }else{ - ##all other elements - ##grep elements and write them into a list - objects[[1]]@data[[i]] <- lapply(1:length(objects), function(x) objects[[x]]@data[[i]]) - - ##unlist to flatten list if necessary for the elements - if(is(objects[[1]]@data[[i]][[1]])[1] == "list"){ - objects[[1]]@data[[i]] <- unlist(objects[[1]]@data[[i]], - recursive = FALSE) - } - } - - }##end loop - - #return by setting a new RLum.Results (for the .uid) - #the originator is not reset - objects_merged <- set_RLum( - class = "RLum.Results", - originator = objects[[1]]@originator, - data = objects[[1]]@data, - info = unlist(lapply(objects, function(x) { - x@info - }), recursive = FALSE), - .pid = unlist(lapply(objects, function(x) { - x@.uid - }))) - - return(objects_merged) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/merge_Risoe.BINfileData.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/merge_Risoe.BINfileData.R deleted file mode 100644 index 23e539fd0..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/merge_Risoe.BINfileData.R +++ /dev/null @@ -1,227 +0,0 @@ -#' @title Merge Risoe.BINfileData objects or Risoe BIN-files -#' -#' @description Function allows merging Risoe BIN/BINX files or [Risoe.BINfileData-class] objects. -#' -#' @details -#' The function allows merging different measurements to one file or one -#' object. The record IDs are recalculated for the new object. Other values -#' are kept for each object. The number of input objects is not limited. -#' -#' `position.number.append.gap` option -#' -#' If the option `keep.position.number = FALSE` is used, the position -#' numbers of the new data set are recalculated by adding the highest position -#' number of the previous data set to the each position number of the next data -#' set. For example: The highest position number is 48, then this number will -#' be added to all other position numbers of the next data set (e.g. 1 + 48 = -#' 49) -#' -#' However, there might be cases where an additional addend (summand) is needed -#' before the next position starts. Example: -#' -#' - Position number set (A): `1,3,5,7` -#' - Position number set (B): `1,3,5,7` -#' -#' With no additional summand the new position numbers would be: -#' `1,3,5,7,8,9,10,11`. That might be unwanted. Using the argument -#' `position.number.append.gap = 1` it will become: -#' `1,3,5,7,9,11,13,15,17`. -#' -#' @param input.objects [character] with [Risoe.BINfileData-class] objects (**required**): -#' Character vector with path and files names -#' (e.g. `input.objects = c("path/file1.bin", "path/file2.bin")` or -#' [Risoe.BINfileData-class] objects (e.g. `input.objects = c(object1, object2)`). -#' Alternatively a `list` is supported. -#' -#' -#' @param output.file [character] (*optional*): -#' File output path and name. If no value is given, a [Risoe.BINfileData-class] is -#' returned instead of a file. -#' -#' @param keep.position.number [logical] (*with default*): -#' Allows keeping the original position numbers of the input objects. -#' Otherwise the position numbers are recalculated. -#' -#' @param position.number.append.gap [integer] (*with default*): -#' Set the position number gap between merged BIN-file sets, if the option -#' `keep.position.number = FALSE` is used. See details for further -#' information. -#' -#' @return Returns a `file` or a [Risoe.BINfileData-class] object. -#' -#' @note -#' The validity of the output objects is not further checked. -#' -#' @section Function version: 0.2.9 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [Risoe.BINfileData-class], [read_BIN2R], [write_R2BIN] -#' -#' @references -#' Duller, G.A.T., 2007. Analyst (Version 3.24) (manual). Aberystwyth University, Aberystwyth. -#' -#' -#' @keywords IO manip -#' -#' -#' @examples -#' -#' ##merge two objects -#' data(ExampleData.BINfileData, envir = environment()) -#' -#' object1 <- CWOSL.SAR.Data -#' object2 <- CWOSL.SAR.Data -#' -#' object.new <- merge_Risoe.BINfileData(c(object1, object2)) -#' -#' @md -#' @export -merge_Risoe.BINfileData <- function( - input.objects, - output.file, - keep.position.number = FALSE, - position.number.append.gap = 0 -){ - - # Integrity Checks -------------------------------------------------------- - if(length(input.objects) < 2){ - message("[merge_Risoe.BINfileData()] Nothing done: at least two input objects are needed!") - return(input.objects) - - } - - if(is(input.objects, "character") == TRUE){ - for(i in 1:length(input.objects)){ - if(file.exists(input.objects[i])==FALSE){ - stop("[merge_Risoe.BINfileData()] File '", input.objects[i], - "' does not exist!", call. = FALSE) - } - } - - }else{ - - if(is(input.objects, "list") == TRUE){ - for(i in 1:length(input.objects)){ - if(is(input.objects[[i]], "Risoe.BINfileData") == FALSE){ - - stop("[merge_Risoe.BINfileData()] Input list does not contain Risoe.BINfileData objects!") - - } - - } - - }else{ - stop("[merge_Risoe.BINfileData()] Input object is neither a character nor a list!") - } - } - - - # Import Files ------------------------------------------------------------ - - ##loop over all files to store the results in a list - ##or the input is already a list - - if(is(input.objects, "character") == TRUE){ - temp <- lapply(input.objects, read_BIN2R, txtProgressBar = FALSE) - - }else{ - temp <- input.objects - - } - - # Get POSITION values ------------------------------------------------------- - - ##grep maximum position value from the first file - temp.position.max <- max(temp[[1]]@METADATA[["POSITION"]]) - - ##grep all position values except from the first file - temp.position.values <- unlist(sapply(2:length(temp), function(x){ - temp <- temp[[x]]@METADATA[["POSITION"]] + - temp.position.max + - position.number.append.gap - - assign(x = "temp.position.max", value = max(temp), envir = parent.env(environment())) - - return(temp) - })) - - - temp.position.values <- c(temp[[1]]@METADATA[["POSITION"]], temp.position.values) - - - # Get overall record length ----------------------------------------------- - temp.record.length <- sum(sapply(1:length(temp), function(x){ - length(temp[[x]]@METADATA[,"ID"]) - - })) - - - # Merge Files ------------------------------------------------------------- - ##loop for similar input objects - for(i in 1:length(input.objects)){ - if(exists("temp.new.METADATA") == FALSE){ - - temp.new.METADATA <- temp[[i]]@METADATA - temp.new.DATA <- temp[[i]]@DATA - - - if(inherits(try(temp[[i]]@.RESERVED, silent = TRUE), "try-error")){ - - temp.new.RESERVED <- list() - - }else{ - - temp.new.RESERVED <- temp[[i]]@.RESERVED - - } - - }else{ - - temp.new.METADATA <- rbind(temp.new.METADATA, temp[[i]]@METADATA) - temp.new.DATA <- c(temp.new.DATA, temp[[i]]@DATA) - - if(inherits(try(temp[[i]]@.RESERVED, silent = TRUE), "try-error")){ - - temp.new.RESERVED <- c(temp.new.RESERVED, list()) - - }else{ - - temp.new.RESERVED <- c(temp.new.RESERVED, temp[[i]]@.RESERVED) - - } - - } - } - - - ##SET RECORD ID in METADATA - temp.new.METADATA$ID <- 1:temp.record.length - - ##SET POSITION VALUES - if(keep.position.number == FALSE){ - temp.new.METADATA$POSITION <- temp.position.values - - } - - ##TODO version number? - # Produce BIN file object ------------------------------------------------- - temp.new <- set_Risoe.BINfileData( - METADATA = temp.new.METADATA, - DATA = temp.new.DATA, - .RESERVED = temp.new.RESERVED - - ) - - - # OUTPUT ------------------------------------------------------------------ - if(missing(output.file) == FALSE){ - write_R2BIN(temp.new, output.file) - - }else{ - return(temp.new) - - } - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/methods_DRAC.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/methods_DRAC.R deleted file mode 100644 index 97036d5be..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/methods_DRAC.R +++ /dev/null @@ -1,250 +0,0 @@ -################################################################################## -## METHODS FOR S3 GENERICS ## -################################################################################## - -## ---------------------------------------------------------------------------## -## DATA FRAME COERCION METHOD - -## This is a method for the as.data.frame S3 generic. We need this to intercept the -## DRAC list object after it hast passed the actual list-method. After it was -## coerced to a data.frame we assign new column names (DRAC ID keys) and -## make sure that all columns are either of class 'character' or 'numeric'. -## Finally, we attach a further class name to identify it as a valid DRAC object -## when passed to use_DRAC - -#' @export -as.data.frame.DRAC.list <- function(x, row.names = NULL, optional = FALSE, ...) { - DF <- as.data.frame.list(x) - colnames(DF) <- paste0("TI:", 1:ncol(DF)) - for (i in 1:ncol(DF)) { - if (is.factor(DF[ ,i])) - DF[ ,i] <- as.character(DF[, i]) - } - class(DF) <- c("data.frame", "DRAC.data.frame") - return(DF) -} - - -## ---------------------------------------------------------------------------## -## PRINT METHOD - -#' @export -print.DRAC.highlights <- function(x, ...) { - x <- as.list(x) - names <- names(x) - mapply(function(el, name) { - cat(paste0(attributes(el)$key, " = ", name,":\n ", paste(el, collapse = ",\n "), "\n")) - }, x, names) -} - -#' @export -print.DRAC.list <- function(x, blueprint = FALSE, ...) { - - ## CASE 1: Pretty print the structure of the DRAC list - if (!blueprint) { - limit <- 80 - - for (i in 1:length(x)) { - # for pretty printing we insert newlines and tabs at specified lengths - ls <- attributes(x[[i]])$description - ls.n <- nchar(ls) - ls.block <- floor(ls.n / limit) - strStarts <- seq(0, ls.n, limit) - strEnds <- seq(limit-1, ls.n + limit, limit) - blockString <- paste(mapply(function(start, end) { - trimmedString <- paste(substr(ls, start, end), "\n\t\t\t") - if (substr(trimmedString, 1, 1) == " ") - trimmedString <- gsub("^[ ]*", "", trimmedString) - return(trimmedString) - }, strStarts, strEnds), collapse="") - - msg <- paste(attributes(x[[i]])$key, "=>",names(x)[i], "\n", - "\t VALUES =", paste(x[[i]], collapse = ", "), "\n", - "\t ALLOWS 'X' = ", attributes(x[[i]])$allowsX, "\n", - "\t REQUIRED =", attributes(x[[i]])$required, "\n", - "\t DESCRIPTION = ", blockString, "\n" - ) - if (!is.null(levels(x[[i]]))) { - msg <- paste(msg, - "\t OPTIONS = ", paste(levels(x[[i]]), collapse = ", "), - "\n\n") - } else { - msg <- paste(msg, "\n") - } - cat(msg) - } - } - - ## CASE 2: Return a 'blueprint' that can be copied from the console to a - ## script so the user does not need to write down all >50 fields by hand - if (blueprint) { - var <- as.list(sys.call())[[2]] - names <- names(x) - - for (i in 1:length(x)) { - - # in case of factors also show available levels as comments so you don't - # have to look it up - if (is.factor(x[[i]])) - options <- paste("# OPTIONS:", paste(levels(x[[i]]), collapse = ", ")) - else - options <- "" - - # determine if values need brackets (strings) - if (is.numeric(x[[i]]) | is.integer(x[[i]])) - values <- paste(x[[i]], collapse = ", ") - if (is.character(x[[i]]) | is.factor(x[[i]])) - values <- paste0("'", paste0(x[[i]], collapse = "', '"), "'") - - cat(paste0(var, "$`", names[i], "` <- c(", values,") ", options ,"\n")) - } - message("\n\t You can copy all lines above to your script and fill in the data.") - } -} - - -## ---------------------------------------------------------------------------## -## DOUBLE SQUARE BRACKETS METHOD - -#' @export -`[[<-.DRAC.list` <- function(x, i, value) { - - - ## REJECT ALL INADEQUATE CLASSES ---- - acceptedClasses <- c("integer", "character", "numeric", "factor") - if (is.na(match(class(value), acceptedClasses))) { - warning(paste("I cannot use objects of class", class(value)), - call. = FALSE) - return(x) - } - - ## CHECK INPUT LENGTH ---- - length.old <- length(x[[i]]) - length.new <- length(value) - - if (length.old != length.new) { - warning(paste(names(x)[i], ": Input must be of length", length.old), - call. = FALSE) - return(x) - } - - ## CHECK INPUT CLASS ---- - class.old <- class(x[[i]]) - class.new <- class(value) - - ## CHECK INPUT FIELDS THAT ALLOW 'X' ----- - # the following checks apply to fields that are normally numeric, but also - # accept 'X' as input. this EXCLUDES factors! - if (class.old != "factor") { - # some input fields allow 'X' as input, so in terms of R can be of class - # "character" or "numeric/integer". hence, we check if input is "X" and - # if the filed allows it. If so, we change the old class to "character". - if (any(value == "X") && attributes(x[[i]])$allowsX) { - - if (any(is.na(as.numeric(value[which(value != "X")])))) { - warning(paste("Cannot coerce <", value[which(value != "X")], "> to a numeric value.", - "Input must be numeric or 'X'."), - call. = FALSE) - return(x) - } - class.old <- "character" - } - - # where the input field is alreay "X" we have to check whether the new - # non-character input is allowed - if (!all(is.na(x[[i]]))) { - if (any(x[[i]] == "X") && attributes(x[[i]])$allowsX) { - if (any(is.na(as.numeric(value[which(value != "X")])))) { - warning(paste("Cannot coerce <", value[which(value != "X")], "> to a numeric value.", - "Input must be numeric or 'X'. \n"), - call. = FALSE) - return(x) - } - class.new <- "character" - value <- as.character(value) - } - } - - # when a numeric input field was inserted an "X" it was coerced to class - # character. since we are now allowed to insert any character (later tests) - # we need to make sure that the new input can be coerced to class numeric. - # and if the new values are numeric, we coerce them to character - if (attributes(x[[i]])$allowsX && class.old == "character") { - if (any(is.na(as.numeric(value[which(value != "X")])))) { - warning(paste("Cannot coerce <", value[which(value != "X")], "> to a numeric value.", - "Input must be numeric or 'X'. \n"), - call. = FALSE) - return(x) - } - class.new <- "character" - value <- as.character(value) - } - } - - - # numeric input can be both of class 'integer' or 'numeric'. We will - # allow any combination and reject only non-numeric/integer input - if (class.old == "numeric" || class.old == "integer") { - if (class.new != "numeric" && class.new != "integer") { - warning(paste(names(x)[i], ": Input must be of class", class.old), - call. = FALSE) - return(x) - } - } - - # for 'factor' and 'character' elements only 'character' input is allowed - if (class.old == "factor" || class.old == "character") { - if (class.new != "character") { - warning(paste(names(x)[i], ": Input must be of class", "character"), - call. = FALSE) - return(x) - } - } - - ## CHECK IF VALID OPTION ---- - # in case of 'factor's the user is only allowed input that matches one of - # the options specified by the factor levels. if it is a valid option, - # the input is converted to a factor to keep the information. - if (class.old == "factor") { - levels <- levels(x[[i]]) - if (any(`%in%`(value, levels) == FALSE)) { - warning(paste(names(x)[i], ": Invalid option. Valid options are:", paste(levels, collapse = ", ")), - call. = FALSE) - return(x) - } else { - value <- factor(value, levels) - } - } - - ## WRITE NEW VALUES ---- - # we strip our custom class and the attributes, pass the object to the default generic and - # finally re-attach our class and attributes - tmp.attributes <- attributes(x[[i]])[names(attributes(x[[i]])) != "class"] - class(x) <- "list" - x <- `[[<-`(x, i, value) - attributes(x[[i]]) <- tmp.attributes - if (class.old == "factor") - class(x[[i]]) <- "factor" - class(x) <- c("DRAC.list", "list") - return(x) -} - -## ---------------------------------------------------------------------------## -## SINGLE SQUARE BRACKET METHOD - -#' @export -`[<-.DRAC.list` <- function(x, i, value) { - return(`[[<-`(x, i, value)) -} - -## ---------------------------------------------------------------------------## -## DOLLAR SIGN METHOD - -#' @export -`$<-.DRAC.list`<- function(x, name, value) { - # this is straightforward; retrieve the index and pass the object - # to the custom [[<- function, which does the data verification - index <- which(names(x) == name) - x[[index]] <- value - return(x) -} \ No newline at end of file diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/methods_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/methods_RLum.R deleted file mode 100644 index f62c65184..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/methods_RLum.R +++ /dev/null @@ -1,582 +0,0 @@ -################################################################################## -## METHODS FOR S3 GENERICS ## -################################################################################## - -##CAUTION NOTE: -##(1) Please DO NOT access to the S4 objects by using the slots this causes inconsistent -## behaviour, please use the corresponding RLum-methods instead! -## -##(2) Especially, please DO NOT include S3-methods for which no S4-method is implemented! Especially -##for coercing. -## -##(3) Finally, what ever you want to implement, check whether a S4-method exists, it should -##be just passed to this methods, not the opposite, otherwise this will yield in undesired behaviour -## -##TODO: For this S3 generics so far no proper documentation exists ... we should consider -##to provide an overview within a separate document, as it becomes otherwise rather -##complicated for beginners to work with the documentation. -## - - -## -------------------- INTRODUCED WITH 0.5.0 ----------------------- ## - - -#' methods_RLum -#' -#' Methods for S3-generics implemented for the package 'Luminescence'. -#' This document summarises all implemented S3-generics. The name of the function -#' is given before the first dot, after the dot the name of the object that is -#' supported by this method is given, e.g. `plot.RLum.Data.Curve` can be called -#' by `plot(object, ...)`, where `object` is the `RLum.Data.Curve` object. -#' -#' The term S3-generics sounds complicated, however, it just means that something -#' has been implemented in the package to increase the usability for users new -#' in R and who are not familiar with the underlying `RLum`-object structure of -#' the package. The practical outcome is that operations and functions presented -#' in standard books on R can be used without knowing the specifics of the R -#' package `'Luminescence'`. For examples see the example section. -#' -#' @param x [RLum-class] or [Risoe.BINfileData-class] (**required**): -#' input object -#' -#' @param object [RLum-class] (**required**): -#' input object -#' -#' @param y [integer] (*optional*): -#' the row index of the matrix, data.frame -#' -#' @param z [integer] (*optional*): -#' the column index of the matrix, data.frame -#' -#' @param i [character] (*optional*): -#' name of the wanted record type or data object or row in the `RLum.Data.Curve` object -#' -#' @param j [integer] (*optional*): -#' column of the data matrix in the `RLum.Data.Curve` object -#' -#' @param value [numeric] **(required)**: -#' numeric value which replace the value in the `RLum.Data.Curve` object -#' -#' @param drop [logical] (*with default*): -#' keep object structure or drop it -#' -#' @param subset `[subset]` [expression] (**required**): -#' logical expression indicating elements or rows to keep, this function works -#' in [Risoe.BINfileData-class] objects like [subset.data.frame], but takes care -#' of the object structure. Works also on [RLum.Analysis-class] objects. -#' -#' @param row.names [logical] (*with default*): -#' enables or disables row names (`as.data.frame`) -#' -#' @param recursive [logical] (*with default*): -#' enables or disables further sub-setting (`unlist`) -#' -#' @param optional [logical] (*with default*): -#' logical. If TRUE, setting row names and converting column names -#' (to syntactic names: see make.names) is optional (see [base::as.data.frame]) -#' -#' @param ... further arguments that can be passed to the method -#' -#' @note -#' `methods_RLum` are not really new functions, everything given here are mostly just -#' surrogates for existing functions in the package. -#' -#' @examples -#' -#' ##load example data -#' data(ExampleData.RLum.Analysis, envir = environment()) -#' -#' @keywords internal -#' @md -#' @name methods_RLum -NULL - -#################################################################################################### -# methods for generic: plot() -# ################################################################################################## -#' @rdname methods_RLum -#' @method plot list -#' @export -plot.list <- function(x, y, ...) { - if (all(sapply(x, function(x) inherits(x, "RLum")))) { - plot_RLum(object = x, ...) - } - else { - if (missing(y)) - y <- NULL - plot.default(x, y, ...) - } -} - - -#' @rdname methods_RLum -#' @method plot RLum.Results -#' @export -plot.RLum.Results <- function(x, y, ...) plot_RLum(object = x, ...) - -#' @rdname methods_RLum -#' @method plot RLum.Analysis -#' @export -plot.RLum.Analysis <- function(x, y, ...) plot_RLum(object = x, ...) - -#' @rdname methods_RLum -#' @method plot RLum.Data.Curve -#' @export -plot.RLum.Data.Curve <- function(x, y, ...) plot_RLum(object = x, ...) - -#' @rdname methods_RLum -#' @method plot RLum.Data.Spectrum -#' @export -plot.RLum.Data.Spectrum <- function(x, y, ...) plot_RLum(object = x, ...) - -#' @rdname methods_RLum -#' @method plot RLum.Data.Image -#' @export -plot.RLum.Data.Image <- function(x, y, ...) plot_RLum(object = x, ...) - -#' @rdname methods_RLum -#' @method plot Risoe.BINfileData -#' @export -plot.Risoe.BINfileData <- function(x, y, ...) plot_Risoe.BINfileData(BINfileData = x, ...) - -#################################################################################################### -# methods for generic: hist() -# ################################################################################################## - -#' @rdname methods_RLum -#' @export -hist.RLum.Results <- function(x, ...) plot_Histogram(data = x, ...) - -#' @rdname methods_RLum -#' @export -hist.RLum.Data.Image <- function(x, ...) hist(x = get_RLum(x), ...) - -#' @rdname methods_RLum -#' @export -hist.RLum.Data.Curve <- function(x, ...) hist(as(get_RLum(x),"matrix")[,2]) - -#' @rdname methods_RLum -#' @export -hist.RLum.Analysis <- function(x, ...) lapply(1:length_RLum(x), function(z){ - hist(as(get_RLum(x, record.id = z, ...),"matrix")[,2])}) - -#################################################################################################### -# methods for generic: summary() -# ################################################################################################## -# methods for generic: summary() -#' @rdname methods_RLum -#' @method summary RLum.Results -#' @export -summary.RLum.Results <- function(object, ...) get_RLum(object = object, ...) - -#' @rdname methods_RLum -#' @method summary RLum.Analysis -#' @export -summary.RLum.Analysis <- function(object, ...) lapply(object@records, function(x) summary(x@data)) - -#' @rdname methods_RLum -#' @method summary RLum.Data.Image -#' @export -summary.RLum.Data.Image <- function(object, ...) summary(object@data) - -# summary.RLum.Data.Spectrum <- function(object, ...) - -#' @rdname methods_RLum -#' @method summary RLum.Data.Curve -#' @export -summary.RLum.Data.Curve <- function(object, ...) summary(object@data, ...) - -#################################################################################################### -# methods for generic: subset() -# ################################################################################################## -#' @rdname methods_RLum -#' @method subset Risoe.BINfileData -#' -#' @param records.rm [subset] [logical] (*with default*): -#' remove records from data set, can be disabled, to just set the column `SET` to `TRUE` or `FALSE` -#' -#' @md -#' @export -subset.Risoe.BINfileData <- function(x, subset, records.rm = TRUE, ...) { - - if(length(list(...))) - warning(paste("Argument not supported and skipped:", names(list(...)))) - - - ##select relevant rows - sel <- tryCatch(eval( - expr = substitute(subset), - envir = x@METADATA, - enclos = parent.frame() - ), - error = function(e) { - stop("\n\nInvalid subset options. \nValid terms are: ", paste(names(x@METADATA), collapse = ", ")) - }) - - ##probably everything is FALSE now? - if (records.rm) { - if (any(sel)) { - x@METADATA <- x@METADATA[sel, ] - x@DATA <- x@DATA[sel] - x@METADATA[["ID"]] <- 1:length(x@METADATA[["ID"]]) - return(x) - - } else{ - return(NULL) - - } - }else{ - x@METADATA[["SEL"]] <- sel - return(x) - - } - -} - -#' @rdname methods_RLum -#' @method subset RLum.Analysis -#' @export -subset.RLum.Analysis <- function(x, subset = NULL, ...) { - do.call(get_RLum, list(object = x, drop = FALSE, subset = substitute(subset), env = parent.frame())) } - - -#################################################################################################### -# methods for generic: bin() -# ################################################################################################## - -#' @rdname methods_RLum -#' @export -bin <- function(x, ...) { - UseMethod("bin") -} - -#' @rdname methods_RLum -#' @export -bin.RLum.Data.Curve <- function(x, bin_size = 2, ...) bin_RLum.Data(x, bin_size = bin_size) - -#' @rdname methods_RLum -#' @export -bin.RLum.Data.Spectrum <- function(x, bin_size.row = 1, bin_size.col = 1, ...){ - bin_RLum.Data(x, bin_size.row = bin_size.row, bin_size.col = bin_size.col) -} - -#################################################################################################### -# methods for generic: length() -# ################################################################################################## -#' @rdname methods_RLum -#' @export -length.RLum.Results <- function(x, ...) length_RLum(x) - -#' @rdname methods_RLum -#' @export -length.RLum.Analysis <- function(x, ...) length_RLum(x) - -#' @rdname methods_RLum -#' @export -length.RLum.Data.Curve <- function(x, ...) length_RLum(x) - -#' @rdname methods_RLum -#' @export -length.Risoe.BINfileData <- function(x, ...) length(x@METADATA$ID) - -#################################################################################################### -# methods for generic: dim() -# ################################################################################################## -# methods for generic: dim() -#' @rdname methods_RLum -#' @export -dim.RLum.Data.Curve <- function(x) dim(as(x, "matrix")) - -#' @rdname methods_RLum -#' @export -dim.RLum.Data.Spectrum <- function(x) dim(as(x, "matrix")) - -#################################################################################################### -# methods for generic: rep() -# ################################################################################################## -#' @rdname methods_RLum -#' @export -rep.RLum <- function(x, ...) replicate_RLum(x, ...) - -#################################################################################################### -# methods for generic: names() -# ################################################################################################## -#' @rdname methods_RLum -#' @export -names.RLum.Data.Curve <- function(x, ...) names_RLum(x) - -#' @rdname methods_RLum -#' @export -names.RLum.Data.Spectrum <- function(x, ...) names_RLum(x) - -#' @rdname methods_RLum -#' @export -names.RLum.Data.Image <- function(x, ...) names_RLum(x) - -#' @rdname methods_RLum -#' @export -names.RLum.Analysis <- function(x, ...) names_RLum(x) - -#' @rdname methods_RLum -#' @export -names.RLum.Results <- function(x, ...) names_RLum(x) - -#' @rdname methods_RLum -#' @export -names.Risoe.BINfileData <- function(x) as.character(x@METADATA$LTYPE) - -#################################################################################################### -# methods for generic: row.name() -# ################################################################################################## -#' @rdname methods_RLum -#' @export -row.names.RLum.Data.Spectrum <- function(x, ...) rownames(as(x, "matrix")) - -#################################################################################################### -# methods for generic: as.data.frame() -# ################################################################################################## -#' @rdname methods_RLum -#' @export -as.data.frame.RLum.Data.Curve <- function(x, row.names = NULL, optional = FALSE, ...) as(x, "data.frame") - -#' @rdname methods_RLum -#' @export -as.data.frame.RLum.Data.Spectrum <- function(x, row.names = NULL, optional = FALSE, ...) as(x, "data.frame") -# for RLum.Results ... makes no sense and may yield in unpredictable behaviour - -#' @rdname methods_RLum -#' @export -as.data.frame.Risoe.BINfileData <- function(x, row.names = NULL, optional = FALSE, ...) { - - ## set matrix - m <- matrix(NA, ncol = max(sapply(x@DATA, length)), nrow = length(x@DATA)) - - ## rename columns - colnames(m) <- paste0("C",1:ncol(m)) - - ## fill matrix - for(i in 1:length(x@DATA)) m[i,1:length(x@DATA[[i]])] <- x@DATA[[i]] - - ##convert to data.frame and bind - cbind(x@METADATA, as.data.frame(m)) - -} - - -#################################################################################################### -# methods for generic: as.list() -# ################################################################################################## -#' @rdname methods_RLum -#' @export -as.list.RLum.Results <- function(x, ...) as(x, "list") - -#' @rdname methods_RLum -#' @export -as.list.RLum.Data.Curve <- function(x, ...) as(x, "list") - -#' @rdname methods_RLum -#' @export -as.list.RLum.Data.Image <- function(x, ...) as(x, "list") - -#' @rdname methods_RLum -#' @export -as.list.RLum.Analysis <- function(x, ...) as(x, "list") - -#################################################################################################### -# methods for generic: as.matrix() -# ################################################################################################## -#' @rdname methods_RLum -#' @export -as.matrix.RLum.Data.Curve <- function(x, ...) as(x, "matrix") - -#' @rdname methods_RLum -#' @export -as.matrix.RLum.Data.Spectrum <- function(x, ...) as(x, "matrix") - -#' @rdname methods_RLum -#' @export -as.matrix.RLum.Data.Image <- function(x, ...) as(x, "matrix") -# for RLum.Results ... makes no sense and may yield in unpredictable behaviour - -#################################################################################################### -# methods for generic: is() -#################################################################################################### -#For this function no S4 method was written, as this would come at the cost of performance and -#is totally unnecessary - -#' @rdname methods_RLum -#' @export -is.RLum <- function(x, ...) is(x, "RLum") - -#' @rdname methods_RLum -#' @export -is.RLum.Data <- function(x, ...) is(x, "RLum.Data") - -#' @rdname methods_RLum -#' @export -is.RLum.Data.Curve <- function(x, ...) is(x, "RLum.Data.Curve") - -#' @rdname methods_RLum -#' @export -is.RLum.Data.Spectrum <- function(x, ...) is(x, "RLum.Data.Spectrum") - -#' @rdname methods_RLum -#' @export -is.RLum.Data.Image <- function(x, ...) is(x, "RLum.Data.Image") - -#' @rdname methods_RLum -#' @export -is.RLum.Analysis <- function(x, ...) is(x, "RLum.Analysis") - -#' @rdname methods_RLum -#' @export -is.RLum.Results <- function(x, ...) is(x, "RLum.Results") - -#################################################################################################### -# methods for generic: merge() -#################################################################################################### -#' @rdname methods_RLum -#' @export -merge.RLum <- function(x, y, ...) merge_RLum(append(list(...), values = c(x, y))) - -#################################################################################################### -# methods for generic: unlist() -#################################################################################################### -#' @rdname methods_RLum -#' @method unlist RLum.Analysis -#' @export -unlist.RLum.Analysis <- function(x, recursive = TRUE, ...){ - - temp <- get_RLum(object = x, recursive = recursive, ... ) - if(recursive){ - unlist(lapply(1:length(temp), function(x){ - get_RLum(temp) - }), recursive = FALSE) - - }else{ - return(temp) - - } - -} - -#################################################################################################### -# methods for generic: `+` -#################################################################################################### -#' @rdname methods_RLum -#' -#' @examples -#' -#' ##combine curve is various ways -#' curve1 <- IRSAR.RF.Data[[1]] -#' curve2 <- IRSAR.RF.Data[[1]] -#' curve1 + curve2 -#' curve1 - curve2 -#' curve1 / curve2 -#' curve1 * curve2 -#' -#' @export -`+.RLum.Data.Curve` <- function(x, y) merge_RLum(list(x, y), merge.method = "sum") - -#################################################################################################### -# methods for generic: `-` -#################################################################################################### -#' @rdname methods_RLum -#' @export -`-.RLum.Data.Curve` <- function(x, y) merge_RLum(list(x, y), merge.method = "-") - -#################################################################################################### -# methods for generic: `*` -#################################################################################################### -#' @rdname methods_RLum -#' @export -`*.RLum.Data.Curve` <- function(x, y) merge_RLum(list(x, y), merge.method = "*") - -#################################################################################################### -# methods for generic: `/` -#################################################################################################### -#' @rdname methods_RLum -#' @export -`/.RLum.Data.Curve` <- function(x, y) merge_RLum(list(x, y), merge.method = "/") - -#################################################################################################### -# methods for generic: `[` -#################################################################################################### -#' @rdname methods_RLum -#' @export -`[.RLum.Data.Curve` <- function(x,y,z, drop = TRUE) {as(x, "matrix")[y,z, drop = drop]} - -#' @rdname methods_RLum -#' @export -`[.RLum.Data.Spectrum` <- function(x,y,z, drop = TRUE) {as(x, "matrix")[y,z, drop = drop]} - -#' @rdname methods_RLum -#' @export -`[.RLum.Data.Image` <- function(x,y,z, drop = TRUE) {as(x, "matrix")[y,z, drop = drop]} - -#' @rdname methods_RLum -#' @export -`[.RLum.Analysis` <- function(x, i, drop = FALSE) { - if (is(i, "character")) { - get_RLum(x, recordType = i, drop = drop) - - } else{ - get_RLum(x, record.id = i, drop = drop) - - } -} - -#' @rdname methods_RLum -#' @export -`[.RLum.Results` <- function(x, i, drop = TRUE) {get_RLum(x, data.object = i, drop = drop)} - - -#################################################################################################### -# methods for generic: `[<-` -#################################################################################################### -#' @rdname methods_RLum -#' @export -`[<-.RLum.Data.Curve` <- function(x, i, j, value){ - x@data[i,j] <- value #this is without any S4-method, but otherwise the overhead it too high - return(x) -} - -#################################################################################################### -# methods for generic: `[[` -#################################################################################################### -#' @rdname methods_RLum -#' @export -`[[.RLum.Analysis` <- function(x, i) { - if (is(i, "character")) { - get_RLum(x, recordType = i) - - } else{ - get_RLum(x, record.id = i) - - } -} - -#' @rdname methods_RLum -#' @export -`[[.RLum.Results` <- function(x, i) {get_RLum(x, data.object = i)} - -#################################################################################################### -# methods for generic: `$` -#################################################################################################### -#' @rdname methods_RLum -#' @export -`$.RLum.Data.Curve` <- function(x, i) {get_RLum(x, info.object = i)} - -#' @rdname methods_RLum -#' -#' @examples -#' -#' ##`$` access curves -#' IRSAR.RF.Data$RF -#' -#' @export -`$.RLum.Analysis` <- function(x, i) {get_RLum(x, recordType = i)} - -#' @rdname methods_RLum -#' @export -`$.RLum.Results` <- function(x, i) {get_RLum(x, data.object = i)} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/names_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/names_RLum.R deleted file mode 100644 index 123d1ce22..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/names_RLum.R +++ /dev/null @@ -1,54 +0,0 @@ -#' S4-names function for RLum S4 class objects -#' -#' Function calls object-specific names functions for RLum S4 class objects. -#' -#' The function provides a generalised access point for specific -#' [RLum-class] objects.\cr -#' Depending on the input object, the corresponding 'names' function will be -#' selected. Allowed arguments can be found in the documentations of the -#' corresponding [RLum-class] class. -#' -#' @param object [RLum-class] (**required**): -#' S4 object of class `RLum` -#' -#' @return Returns a [character] -#' -#' @section Function version: 0.1.0 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum.Data.Curve-class], [RLum.Data.Image-class], -#' [RLum.Data.Spectrum-class], [RLum.Analysis-class], [RLum.Results-class] -#' -#' @keywords utilities -#' -#' @aliases names_RLum -#' -#' @md -#' @export -setGeneric("names_RLum", function(object) { - standardGeneric("names_RLum") -}) - -# Method for names_RLum method for RLum objects in a list for a list of objects ------------- -#' @describeIn names_RLum -#' Returns a list of [RLum-class] objects that had been passed to [names_RLum] -#' -#' -#' @md -#' @export -setMethod("names_RLum", - signature = "list", - function(object) { - ##apply method in the objects and return the same - lapply(object, function(x) { - if (inherits(x, "RLum")) { - return(names_RLum(x)) - } else{ - return(x) - } - - }) - - }) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_AbanicoPlot.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_AbanicoPlot.R deleted file mode 100644 index 084a4b443..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_AbanicoPlot.R +++ /dev/null @@ -1,3742 +0,0 @@ -#' Function to create an Abanico Plot. -#' -#' A plot is produced which allows comprehensive presentation of data precision -#' and its dispersion around a central value as well as illustration of a -#' kernel density estimate, histogram and/or dot plot of the dose values. -#' -#' The Abanico Plot is a combination of the classic Radial Plot -#' (`plot_RadialPlot`) and a kernel density estimate plot (e.g -#' `plot_KDE`). It allows straightforward visualisation of data precision, -#' error scatter around a user-defined central value and the combined -#' distribution of the values, on the actual scale of the measured data (e.g. -#' seconds, equivalent dose, years). The principle of the plot is shown in -#' Galbraith & Green (1990). The function authors are thankful for the -#' thought-provoking figure in this article. -#' -#' The semi circle (z-axis) of the classic Radial Plot is bent to a straight -#' line here, which actually is the basis for combining this polar (radial) -#' part of the plot with any other Cartesian visualisation method -#' (KDE, histogram, PDF and so on). Note that the plot allows displaying -#' two measures of distribution. One is the 2-sigma -#' bar, which illustrates the spread in value errors, and the other is the -#' polygon, which stretches over both parts of the Abanico Plot (polar and -#' Cartesian) and illustrates the actual spread in the values themselves. -#' -#' Since the 2-sigma-bar is a polygon, it can be (and is) filled with shaded -#' lines. To change density (lines per inch, default is 15) and angle (default -#' is 45 degrees) of the shading lines, specify these parameters. See -#' `?polygon()` for further help. -#' -#' The Abanico Plot supports other than the weighted mean as measure of -#' centrality. When it is obvious that the data -#' is not (log-)normally distributed, the mean (weighted or not) cannot be a -#' valid measure of centrality and hence central dose. Accordingly, the median -#' and the weighted median can be chosen as well to represent a proper measure -#' of centrality (e.g. `centrality = "median.weighted"`). Also -#' user-defined numeric values (e.g. from the central age model) can be used if -#' this appears appropriate. -#' -#' The proportion of the polar part and the cartesian part of the Abanico Plot -#' can be modified for display reasons (`plot.ratio = 0.75`). By default, -#' the polar part spreads over 75 \% and leaves 25 \% for the part that -#' shows the KDE graph. -#' -#' -#' A statistic summary, i.e. a collection of statistic measures of -#' centrality and dispersion (and further measures) can be added by specifying -#' one or more of the following keywords: -#' -#' - `"n"` (number of samples) -#' - `"mean"` (mean De value) -#' - `"median"` (median of the De values) -#' - `"sd.rel"` (relative standard deviation in percent) -#' - `"sd.abs"` (absolute standard deviation) -#' - `"se.rel"` (relative standard error) -#' - `"se.abs"` (absolute standard error) -#' - `"in.2s"` (percent of samples in 2-sigma range) -#' - `"kurtosis"` (kurtosis) -#' - `"skewness"` (skewness) -#' -#' **Note** that the input data for the statistic summary is sent to the function -#' `calc_Statistics()` depending on the log-option for the z-scale. If -#' `"log.z = TRUE"`, the summary is based on the logarithms of the input -#' data. If `"log.z = FALSE"` the linearly scaled data is used. -#' -#' **Note** as well, that `"calc_Statistics()"` calculates these statistic -#' measures in three different ways: `unweighted`, `weighted` and -#' `MCM-based` (i.e., based on Monte Carlo Methods). By default, the -#' MCM-based version is used. If you wish to use another method, indicate this -#' with the appropriate keyword using the argument `summary.method`. -#' -#' The optional parameter `layout` allows more sophisticated ways to modify -#' the entire plot. Each element of the plot can be addressed and its properties -#' can be defined. This includes font type, size and decoration, colours and -#' sizes of all plot items. To infer the definition of a specific layout style -#' cf. `get_Layout()` or type e.g., for the layout type `"journal"` -#' `get_Layout("journal")`. A layout type can be modified by the user by -#' assigning new values to the list object. -#' -#' It is possible for the z-scale to specify where ticks are to be drawn -#' by using the parameter `at`, e.g. `at = seq(80, 200, 20)`, cf. function -#' documentation of `axis`. Specifying tick positions manually overrides a -#' `zlim`-definition. -#' -#' @param data [data.frame] or [RLum.Results-class] object (**required**): -#' for `data.frame` two columns: De (`data[,1]`) and De error (`data[,2]`). -#' To plot several data sets in one plot the data sets must be provided as -#' `list`, e.g. `list(data.1, data.2)`. -#' -#' @param na.rm [logical] (*with default*): -#' exclude NA values from the data set prior to any further operations. -#' -#' @param log.z [logical] (*with default*): -#' Option to display the z-axis in logarithmic scale. Default is `TRUE`. -#' -#' @param z.0 [character] or [numeric]: -#' User-defined central value, used for centring of data. One out of `"mean"`, -#' `"mean.weighted"` and `"median"` or a numeric value (not its logarithm). -#' Default is `"mean.weighted"`. -#' -#' @param dispersion [character] (*with default*): -#' measure of dispersion, used for drawing the scatter polygon. One out of -#' - `"qr"` (quartile range), -#' - `"pnn"` (symmetric percentile range with `nn` the lower percentile, e.g. -#' - `"p05"` depicting the range between 5 and 95 %), -#' - `"sd"` (standard deviation) and -#' - `"2sd"` (2 standard deviations), -#' -#' The default is `"qr"`. Note that `"sd"` and `"2sd"` are only meaningful in -#' combination with `"z.0 = 'mean'"` because the unweighted mean is used to -#' centre the polygon. -#' -#' @param plot.ratio [numeric]: -#' Relative space, given to the radial versus the cartesian plot part, -#' default is `0.75`. -#' -#' @param rotate [logical]: -#' Option to turn the plot by 90 degrees. -#' -#' @param mtext [character]: -#' additional text below the plot title. -#' -#' @param summary [character] (*optional*): -#' add statistic measures of centrality and dispersion to the plot. -#' Can be one or more of several keywords. See details for available keywords. -#' Results differ depending on the log-option for the z-scale (see details). -#' -#' @param summary.pos [numeric] or [character] (*with default*): -#' optional position coordinates or keyword (e.g. `"topright"`) for the -#' statistical summary. Alternatively, the keyword `"sub"` may be -#' specified to place the summary below the plot header. However, this latter -#' option in only possible if `mtext` is not used. -#' -#' @param summary.method [character] (*with default*): -#' keyword indicating the method used to calculate the statistic summary. -#' One out of -#' - `"unweighted"`, -#' - `"weighted"` and -#' - `"MCM"`. -#' -#' See [calc_Statistics] for details. -#' -#' @param legend [character] vector (*optional*): -#' legend content to be added to the plot. -#' -#' @param legend.pos [numeric] or [character] (*with default*): -#' optional position coordinates or keyword (e.g. `"topright"`) -#' for the legend to be plotted. -#' -#' @param stats [character]: -#' additional labels of statistically important values in the plot. -#' One or more out of the following: -#' - `"min"`, -#' - `"max"`, -#' - `"median"`. -#' -#' @param rug [logical]: -#' Option to add a rug to the KDE part, to indicate the location of individual values. -#' -#' @param kde [logical]: -#' Option to add a KDE plot to the dispersion part, default is `TRUE`. -#' -#' @param hist [logical]: -#' Option to add a histogram to the dispersion part. Only meaningful when not -#' more than one data set is plotted. -#' -#' @param dots [logical]: -#' Option to add a dot plot to the dispersion part. If number of dots exceeds -#' space in the dispersion part, a square indicates this. -#' -#' @param boxplot [logical]: -#' Option to add a boxplot to the dispersion part, default is `FALSE`. -#' -#' @param y.axis [logical]: Option to hide standard y-axis labels and show 0 only. -#' Useful for data with small scatter. If you want to suppress the y-axis entirely -#' please use `yaxt == 'n'` (the standard [graphics::par] setting) instead. -#' -#' @param error.bars [logical]: -#' Option to show De-errors as error bars on De-points. Useful in combination -#' with `y.axis = FALSE, bar.col = "none"`. -#' -#' @param bar [numeric] (*with default*): -#' option to add one or more dispersion bars (i.e., bar showing the 2-sigma range) -#' centred at the defined values. By default a bar is drawn according to `"z.0"`. -#' To omit the bar set `"bar = FALSE"`. -#' -#' @param bar.col [character] or [numeric] (*with default*): -#' colour of the dispersion bar. Default is `"grey60"`. -#' -#' @param polygon.col [character] or [numeric] (*with default*): -#' colour of the polygon showing the data scatter. Sometimes this -#' polygon may be omitted for clarity. To disable it use `FALSE` or -#' `polygon = FALSE`. Default is `"grey80"`. -#' -#' @param line [numeric]: -#' numeric values of the additional lines to be added. -#' -#' @param line.col [character] or [numeric]: -#' colour of the additional lines. -#' -#' @param line.lty [integer]: -#' line type of additional lines -#' -#' @param line.label [character]: -#' labels for the additional lines. -#' -#' @param grid.col [character] or [numeric] (*with default*): -#' colour of the grid lines (originating at `[0,0]` and stretching to -#' the z-scale). To disable grid lines use `FALSE`. Default is `"grey"`. -#' -#' @param frame [numeric] (*with default*): -#' option to modify the plot frame type. Can be one out of -#' - `0` (no frame), -#' - `1` (frame originates at 0,0 and runs along min/max isochrons), -#' - `2` (frame embraces the 2-sigma bar), -#' - `3` (frame embraces the entire plot as a rectangle). -#' -#' Default is `1`. -#' -#' @param bw [character] (*with default*): -#' bin-width for KDE, choose a numeric value for manual setting. -#' -#' @param interactive [logical] (*with default*): -#' create an interactive abanico plot (requires the `'plotly'` package) -#' -#' @param ... Further plot arguments to pass (see [graphics::plot.default]). -#' Supported are: `main`, `sub`, `ylab`, `xlab`, `zlab`, `zlim`, `ylim`, `cex`, -#' `lty`, `lwd`, `pch`, `col`, `tck`, `tcl`, `at`, `breaks`. `xlab` must be -#' a vector of length two, specifying the upper and lower x-axis labels. -#' -#' @return -#' returns a plot object and, optionally, a list with plot calculus data. -#' -#' @section Function version: 0.1.17 -#' -#' @author -#' Michael Dietze, GFZ Potsdam (Germany)\cr -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -#' Inspired by a plot introduced by Galbraith & Green (1990) -#' -#' @seealso [plot_RadialPlot], [plot_KDE], [plot_Histogram], [plot_ViolinPlot] -#' -#' @references -#' Galbraith, R. & Green, P., 1990. Estimating the component ages -#' in a finite mixture. International Journal of Radiation Applications and -#' Instrumentation. Part D. Nuclear Tracks and Radiation Measurements, 17 (3), -#' 197-206. -#' -#' Dietze, M., Kreutzer, S., Burow, C., Fuchs, M.C., Fischer, M., Schmidt, C., 2015. -#' The abanico plot: visualising chronometric data with individual standard errors. -#' Quaternary Geochronology. doi:10.1016/j.quageo.2015.09.003 -#' -#' @examples -#' -#' ## load example data and recalculate to Gray -#' data(ExampleData.DeValues, envir = environment()) -#' ExampleData.DeValues <- ExampleData.DeValues$CA1 -#' -#' ## plot the example data straightforward -#' plot_AbanicoPlot(data = ExampleData.DeValues) -#' -#' ## now with linear z-scale -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' log.z = FALSE) -#' -#' ## now with output of the plot parameters -#' plot1 <- plot_AbanicoPlot(data = ExampleData.DeValues, -#' output = TRUE) -#' str(plot1) -#' plot1$zlim -#' -#' ## now with adjusted z-scale limits -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' zlim = c(10, 200)) -#' -#' ## now with adjusted x-scale limits -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' xlim = c(0, 20)) -#' -#' ## now with rug to indicate individual values in KDE part -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' rug = TRUE) -#' -#' ## now with a smaller bandwidth for the KDE plot -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' bw = 0.04) -#' -#' ## now with a histogram instead of the KDE plot -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' hist = TRUE, -#' kde = FALSE) -#' -#' ## now with a KDE plot and histogram with manual number of bins -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' hist = TRUE, -#' breaks = 20) -#' -#' ## now with a KDE plot and a dot plot -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' dots = TRUE) -#' -#' ## now with user-defined plot ratio -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' plot.ratio = 0.5) - -#' ## now with user-defined central value -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' z.0 = 70) -#' -#' ## now with median as central value -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' z.0 = "median") -#' -#' ## now with the 17-83 percentile range as definition of scatter -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' z.0 = "median", -#' dispersion = "p17") -#' -#' ## now with user-defined green line for minimum age model -#' CAM <- calc_CentralDose(ExampleData.DeValues, -#' plot = FALSE) -#' -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' line = CAM, -#' line.col = "darkgreen", -#' line.label = "CAM") -#' -#' ## now create plot with legend, colour, different points and smaller scale -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' legend = "Sample 1", -#' col = "tomato4", -#' bar.col = "peachpuff", -#' pch = "R", -#' cex = 0.8) -#' -#' ## now without 2-sigma bar, polygon, grid lines and central value line -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' bar.col = FALSE, -#' polygon.col = FALSE, -#' grid.col = FALSE, -#' y.axis = FALSE, -#' lwd = 0) -#' -#' ## now with direct display of De errors, without 2-sigma bar -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' bar.col = FALSE, -#' ylab = "", -#' y.axis = FALSE, -#' error.bars = TRUE) -#' -#' ## now with user-defined axes labels -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' xlab = c("Data error (%)", -#' "Data precision"), -#' ylab = "Scatter", -#' zlab = "Equivalent dose [Gy]") -#' -#' ## now with minimum, maximum and median value indicated -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' stats = c("min", "max", "median")) -#' -#' ## now with a brief statistical summary as subheader -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' summary = c("n", "in.2s")) -#' -#' ## now with another statistical summary -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' summary = c("mean.weighted", "median"), -#' summary.pos = "topleft") -#' -#' ## now a plot with two 2-sigma bars for one data set -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' bar = c(30, 100)) -#' -#' ## now the data set is split into sub-groups, one is manipulated -#' data.1 <- ExampleData.DeValues[1:30,] -#' data.2 <- ExampleData.DeValues[31:62,] * 1.3 -#' -#' ## now a common dataset is created from the two subgroups -#' data.3 <- list(data.1, data.2) -#' -#' ## now the two data sets are plotted in one plot -#' plot_AbanicoPlot(data = data.3) -#' -#' ## now with some graphical modification -#' plot_AbanicoPlot(data = data.3, -#' z.0 = "median", -#' col = c("steelblue4", "orange4"), -#' bar.col = c("steelblue3", "orange3"), -#' polygon.col = c("steelblue1", "orange1"), -#' pch = c(2, 6), -#' angle = c(30, 50), -#' summary = c("n", "in.2s", "median")) -#' -#' ## create Abanico plot with predefined layout definition -#' plot_AbanicoPlot(data = ExampleData.DeValues, -#' layout = "journal") -#' -#' ## now with predefined layout definition and further modifications -#' plot_AbanicoPlot( -#' data = data.3, -#' z.0 = "median", -#' layout = "journal", -#' col = c("steelblue4", "orange4"), -#' bar.col = adjustcolor(c("steelblue3", "orange3"), -#' alpha.f = 0.5), -#' polygon.col = c("steelblue3", "orange3")) -#' -#' ## for further information on layout definitions see documentation -#' ## of function get_Layout() -#' -#' ## now with manually added plot content -#' ## create empty plot with numeric output -#' AP <- plot_AbanicoPlot(data = ExampleData.DeValues, -#' pch = NA, -#' output = TRUE) -#' -#' ## identify data in 2 sigma range -#' in_2sigma <- AP$data[[1]]$data.in.2s -#' -#' ## restore function-internal plot parameters -#' par(AP$par) -#' -#' ## add points inside 2-sigma range -#' points(x = AP$data[[1]]$precision[in_2sigma], -#' y = AP$data[[1]]$std.estimate.plot[in_2sigma], -#' pch = 16) -#' -#' ## add points outside 2-sigma range -#' points(x = AP$data[[1]]$precision[!in_2sigma], -#' y = AP$data[[1]]$std.estimate.plot[!in_2sigma], -#' pch = 1) -#' -#' @md -#' @export -plot_AbanicoPlot <- function( - data, - na.rm = TRUE, - log.z = TRUE, - z.0 = "mean.weighted", - dispersion = "qr", - plot.ratio = 0.75, - rotate = FALSE, - mtext, - summary, - summary.pos, - summary.method = "MCM", - legend, - legend.pos, - stats, - rug = FALSE, - kde = TRUE, - hist = FALSE, - dots = FALSE, - boxplot = FALSE, - y.axis = TRUE, - error.bars = FALSE, - bar, - bar.col, - polygon.col, - line, - line.col, - line.lty, - line.label, - grid.col, - frame = 1, - bw = "SJ", - interactive = FALSE, - ... -) { - ## check data and parameter consistency-------------------------------------- - - ## Homogenise input data format - if(is(data, "list") == FALSE) { - data <- list(data) - } - - ## Check input data - for(i in 1:length(data)) { - if(is(data[[i]], "RLum.Results") == FALSE & - is(data[[i]], "data.frame") == FALSE) { - .throw_error("Input data format must be 'data.frame' or 'RLum.Results'") - - } else { - if(is(data[[i]], "RLum.Results")) - data[[i]] <- get_RLum(data[[i]], "data") - - if (ncol(data[[i]]) < 2) { - .throw_error("Data set (", i, ") has fewer than 2 columns: data ", - "without errors cannot be displayed") - } - - data[[i]] <- data[[i]][,c(1:2)] - } - } - - ## optionally, remove NA-values - if(na.rm == TRUE) { - for(i in 1:length(data)) { - - n.NA <- sum(!complete.cases(data[[i]])) - - if (n.NA > 0) { - message("[plot_AbanicoPlot()] Data set (", i, "): ", n.NA, - " NA value", ifelse (n.NA > 1, "s", ""), " excluded") - data[[i]] <- na.exclude(data[[i]]) - } - } - } - - ##AFTER NA removal, we should check the data set carefully again ... - ##(1) - ##check if there is still data left in the entire set - if(all(sapply(data, nrow) == 0)){ - message("[plot_AbanicoPlot()] Error: Nothing plotted, your data set is empty") - return(NULL) - } - ##(2) - ##check for sets with only 1 row or 0 rows at all - else if(any(sapply(data, nrow) <= 1)){ - - ##select problematic sets and remove the entries from the list - NArm.id <- which(sapply(data, nrow) <= 1) - data[NArm.id] <- NULL - - .throw_warning("Data sets ", paste(NArm.id, collapse = ", "), - " are found to be empty or consisting of only 1 row. Sets removed!") - - rm(NArm.id) - - ##unfortunately, the data set might become now empty at all - if(length(data) == 0){ - message("[plot_AbanicoPlot()] Error: After removing invalid entries, ", - "nothing is plotted") - return(NULL) - } - } - - ## check for zero-error values - for(i in 1:length(data)) { - - if(sum(data[[i]][,2] == 0) > 0) { - data[[i]] <- data[[i]][data[[i]][,2] > 0,] - - if(nrow(data[[i]]) < 1) { - .throw_error("Data set contains only values with zero errors") - } - - .throw_warning("Values with zero errors cannot be displayed and were removed") - } - } - - ## plot.ratio must be numeric and positive - .validate_positive_scalar(plot.ratio) - - ## save original plot parameters and restore them upon end or stop - par.old.full <- par(no.readonly = TRUE) - cex_old <- par()$cex - - ## this ensures par() is respected for several plots on one page - if(sum(par()$mfrow) == 2 & sum(par()$mfcol) == 2){ - on.exit(par(par.old.full)) - } - - ## check/set layout definitions - if("layout" %in% names(list(...))) { - layout = get_Layout(layout = list(...)$layout) - } else { - layout <- get_Layout(layout = "default") - - } - - if(missing(stats) == TRUE) { - stats <- numeric(0) - } - - if(missing(bar) == TRUE) { - bar <- rep(TRUE, length(data)) - } - - if(missing(bar.col) == TRUE) { - bar.fill <- rep(x = rep(x = layout$abanico$colour$bar.fill, - length.out = length(data)), length(bar)) - bar.line <- rep(rep(layout$abanico$colour$bar.line, - length.out = length(data)), length(bar)) - } else { - bar.fill <- bar.col - bar.line <- NA - } - - if(missing(polygon.col) == TRUE) { - polygon.fill <- rep(layout$abanico$colour$poly.fill, - length.out = length(data)) - polygon.line <- rep(layout$abanico$colour$poly.line, - length.out = length(data)) - } else { - polygon.fill <- polygon.col - polygon.line <- NA - } - - if(missing(grid.col) == TRUE) { - grid.major <- layout$abanico$colour$grid.major - grid.minor <- layout$abanico$colour$grid.minor - } else { - if(length(grid.col) == 1) { - grid.major <- grid.col[1] - grid.minor <- grid.col[1] - } else { - grid.major <- grid.col[1] - grid.minor <- grid.col[2] - } - } - - if(missing(summary) == TRUE) { - summary <- c("n", "in.2s") - } - - if(missing(summary.pos) == TRUE) { - summary.pos <- "sub" - } - - if(missing(mtext) == TRUE) { - mtext <- "" - } - - ## create preliminary global data set - De.global <- data[[1]][,1] - if(length(data) > 1) { - for(i in 2:length(data)) { - De.global <- c(De.global, data[[i]][,1]) - } - } - - ## calculate major preliminary tick values and tick difference - extraArgs <- list(...) - if("zlim" %in% names(extraArgs)) { - limits.z <- extraArgs$zlim - } else { - z.span <- (mean(De.global) * 0.5) / (sd(De.global) * 100) - z.span <- ifelse(z.span > 1, 0.9, z.span) - limits.z <- c((ifelse(min(De.global) <= 0, 1.1, 0.9) - z.span) * - min(De.global), - (1.1 + z.span) * max(De.global)) - } - - if("at" %in% names(extraArgs)) { - ticks <- extraArgs$at - } else { - ticks <- round(pretty(limits.z, n = 5), 3) - } - - if("breaks" %in% names(extraArgs)) { - breaks <- extraArgs$breaks - } else { - breaks <- "Sturges" - } - - ## check/set bw-parameter - for(i in 1:length(data)) { - bw.test <- try(density(x = data[[i]][,1], - bw = bw), - silent = TRUE) - if(grepl(pattern = "Error", x = bw.test[1]) == TRUE) { - bw <- "nrd0" - .throw_warning("Option for bw not possible. Set to nrd0!") - } - } - - if ("fun" %in% names(extraArgs)) { - fun <- list(...)$fun # nocov - } else { - fun <- FALSE - } - - ## check for negative values, stop function, but do not stop - if(min(De.global) < 0) { - - if("zlim" %in% names(extraArgs)) { - - De.add <- abs(extraArgs$zlim[1]) - } else { - - ## estimate delta De to add to all data - De.add <- min(10^ceiling(log10(abs(De.global))) * 10) - - ## optionally readjust delta De for extreme values - if(De.add <= abs(min(De.global))) { - - De.add <- De.add * 10 - } - } - } else { - De.add <- 0 - } - - ## optionally add correction dose to data set and adjust error - if(log.z == TRUE) { - - for(i in 1:length(data)) { - data[[i]][,1] <- data[[i]][,1] + De.add - } - - De.global <- De.global + De.add - - } - - ## calculate and append statistical measures -------------------------------- - - ## z-values based on log-option - z <- lapply(1:length(data), function(x){ - if(log.z == TRUE) { - log(data[[x]][,1]) - } else { - data[[x]][,1] - } - }) - - if(is(z, "list") == FALSE) { - z <- list(z) - } - data <- lapply(1:length(data), function(x) { - cbind(data[[x]], z[[x]]) - }) - rm(z) - - ## calculate dispersion based on log-option - se <- lapply(1:length(data), function(x, De.add){ - if(log.z == TRUE) { - - if(De.add != 0) { - data[[x]][,2] <- data[[x]][,2] / (data[[x]][,1] + De.add) - } else { - data[[x]][,2] / data[[x]][,1] - } - } else { - data[[x]][,2] - }}, De.add = De.add) - - if(is(se, "list") == FALSE) { - se <- list(se) - } - - data <- lapply(1:length(data), function(x) { - cbind(data[[x]], se[[x]]) - }) - rm(se) - - ## calculate initial data statistics - stats.init <- list(NA) - for(i in 1:length(data)) { - stats.init[[length(stats.init) + 1]] <- - calc_Statistics(data = data[[i]][,3:4]) - } - stats.init[[1]] <- NULL - - ## calculate central values - if(z.0 == "mean") { - - z.central <- lapply(1:length(data), function(x){ - rep(stats.init[[x]]$unweighted$mean, - length(data[[x]][,3]))}) - - } else if(z.0 == "median") { - - z.central <- lapply(1:length(data), function(x){ - rep(stats.init[[x]]$unweighted$median, - length(data[[x]][,3]))}) - - } else if(z.0 == "mean.weighted") { - - z.central <- lapply(1:length(data), function(x){ - rep(stats.init[[x]]$weighted$mean, - length(data[[x]][,3]))}) - - } else if(is.numeric(z.0) == TRUE) { - - z.central <- lapply(1:length(data), function(x){ - rep(ifelse(log.z == TRUE, - log(z.0), - z.0), - length(data[[x]][,3]))}) - - } else { - - .throw_error("Value for 'z.0' not supported") - } - - data <- lapply(1:length(data), function(x) { - cbind(data[[x]], z.central[[x]])}) - rm(z.central) - - ## calculate precision - precision <- lapply(1:length(data), function(x){ - 1 / data[[x]][,4]}) - if(is(precision, "list") == FALSE) {precision <- list(precision)} - data <- lapply(1:length(data), function(x) { - cbind(data[[x]], precision[[x]])}) - rm(precision) - - ## calculate standardised estimate - std.estimate <- lapply(1:length(data), function(x){ - (data[[x]][,3] - data[[x]][,5]) / data[[x]][,4]}) - if(is(std.estimate, "list") == FALSE) {std.estimate <- list(std.estimate)} - data <- lapply(1:length(data), function(x) { - cbind(data[[x]], std.estimate[[x]])}) - - ## append empty standard estimate for plotting - data <- lapply(1:length(data), function(x) { - cbind(data[[x]], std.estimate[[x]])}) - rm(std.estimate) - - ## append optional weights for KDE curve - if("weights" %in% names(extraArgs)) { - if(extraArgs$weights == TRUE) { - wgt <- lapply(1:length(data), function(x){ - (1 / data[[x]][,2]) / sum(1 / data[[x]][,2]^2) - }) - - if(is(wgt, "list") == FALSE) { - wgt <- list(wgt) - } - - data <- lapply(1:length(data), function(x) { - cbind(data[[x]], wgt[[x]])}) - - rm(wgt) - } else { - wgt <- lapply(1:length(data), function(x){ - rep(x = 1, times = nrow(data[[x]])) / - sum(rep(x = 1, times = nrow(data[[x]]))) - }) - - if(is(wgt, "list") == FALSE) { - wgt <- list(wgt) - } - - data <- lapply(1:length(data), function(x) { - cbind(data[[x]], wgt[[x]])}) - - rm(wgt) - } - } else { - wgt <- lapply(1:length(data), function(x){ - rep(x = 1, times = nrow(data[[x]])) / - sum(rep(x = 1, times = nrow(data[[x]]))) - }) - - if(is(wgt, "list") == FALSE) { - wgt <- list(wgt) - } - - data <- lapply(1:length(data), function(x) { - cbind(data[[x]], wgt[[x]])}) - - rm(wgt) - } - - ## generate global data set - data.global <- cbind(data[[1]], - rep(x = 1, times = nrow(data[[1]]))) - colnames(data.global) <- rep("", 10) - - if(length(data) > 1) { - for(i in 2:length(data)) { - data.add <- cbind(data[[i]], - rep(x = i, times = nrow(data[[i]]))) - colnames(data.add) <- rep("", 10) - data.global <- rbind(data.global, - data.add) - } - } - - ## create column names - colnames(data.global) <- c("De", - "error", - "z", - "se", - "z.central", - "precision", - "std.estimate", - "std.estimate.plot", - "weights", - "data set") - - ## calculate global data statistics - stats.global <- calc_Statistics(data = data.global[,3:4]) - - ## calculate global central value - if(z.0 == "mean") { - z.central.global <- stats.global$unweighted$mean - } else if(z.0 == "median") { - z.central.global <- stats.global$unweighted$median - } else if(z.0 == "mean.weighted") { - z.central.global <- stats.global$weighted$mean - } else if(is.numeric(z.0) == TRUE) { - z.central.global <- ifelse(log.z == TRUE, - log(z.0), - z.0) - } - - ## create column names - for(i in 1:length(data)) { - colnames(data[[i]]) <- c("De", - "error", - "z", - "se", - "z.central", - "precision", - "std.estimate", - "std.estimate.plot", - "weights") - } - - ## re-calculate standardised estimate for plotting - for(i in 1:length(data)) { - data[[i]][,8] <- (data[[i]][,3] - z.central.global) / data[[i]][,4] - } - - data.global.plot <- data[[1]][,8] - if(length(data) > 1) { - for(i in 2:length(data)) { - data.global.plot <- c(data.global.plot, data[[i]][,8]) - } - } - data.global[,8] <- data.global.plot - - ## print message for too small scatter - if(max(abs(1 / data.global[6])) < 0.02) { - small.sigma <- TRUE - message("[plot_AbanicoPlot()] Attention, small standardised estimate scatter. Toggle off y.axis?") - } - - ## read out additional arguments--------------------------------------------- - extraArgs <- list(...) - - main <- if("main" %in% names(extraArgs)) { - extraArgs$main - } else { - expression(paste(D[e], " distribution")) - } - - sub <- if("sub" %in% names(extraArgs)) { - extraArgs$sub - } else { - "" - } - - if("xlab" %in% names(extraArgs)) { - if(length(extraArgs$xlab) != 2) { - if (length(extraArgs$xlab) == 3) { - xlab <- c(extraArgs$xlab[1:2], "Density") - } else { - .throw_error("'xlab' must have length 2") - } - } else {xlab <- c(extraArgs$xlab, "Density")} - } else { - xlab <- c(if(log.z == TRUE) { - "Relative standard error (%)" - } else { - "Standard error" - }, - "Precision", - "Density") - } - - ylab <- if("ylab" %in% names(extraArgs)) { - extraArgs$ylab - } else { - "Standardised estimate" - } - - zlab <- if("zlab" %in% names(extraArgs)) { - extraArgs$zlab - } else { - expression(paste(D[e], " [Gy]")) - } - - if("zlim" %in% names(extraArgs)) { - limits.z <- extraArgs$zlim - } else { - z.span <- (mean(data.global[,1]) * 0.5) / (sd(data.global[,1]) * 100) - z.span <- ifelse(z.span > 1, 0.9, z.span) - limits.z <- c((0.9 - z.span) * min(data.global[[1]]), - (1.1 + z.span) * max(data.global[[1]])) - } - - if("xlim" %in% names(extraArgs)) { - limits.x <- extraArgs$xlim - } else { - limits.x <- c(0, max(data.global[,6]) * 1.05) - } - - if(limits.x[1] != 0) { - limits.x[1] <- 0 - .throw_warning("Lower x-axis limit not set to zero, issue corrected!") - } - - if("ylim" %in% names(extraArgs)) { - limits.y <- extraArgs$ylim - } else { - y.span <- (mean(data.global[,1]) * 10) / (sd(data.global[,1]) * 100) - y.span <- ifelse(y.span > 1, 0.98, y.span) - limits.y <- c(-(1 + y.span) * max(abs(data.global[,7])), - (1 + y.span) * max(abs(data.global[,7]))) - } - - cex <- if("cex" %in% names(extraArgs)) { - extraArgs$cex - } else { - 1 - } - - lty <- if("lty" %in% names(extraArgs)) { - extraArgs$lty - } else { - rep(rep(2, length(data)), length(bar)) - } - - lwd <- if("lwd" %in% names(extraArgs)) { - extraArgs$lwd - } else { - rep(rep(1, length(data)), length(bar)) - } - - pch <- if("pch" %in% names(extraArgs)) { - extraArgs$pch - } else { - rep(20, length(data)) - } - - if("col" %in% names(extraArgs)) { - bar.col <- extraArgs$col - kde.line <- extraArgs$col - kde.fill <- NA - value.dot <- extraArgs$col - value.bar <- extraArgs$col - value.rug <- extraArgs$col - summary.col <- extraArgs$col - centrality.col <- extraArgs$col - } else { - if(length(layout$abanico$colour$bar) == 1) { - bar.col <- 1:length(data) - } else { - bar.col <- layout$abanico$colour$bar.col - } - - if(length(layout$abanico$colour$kde.line) == 1) { - kde.line <- 1:length(data) - } else { - kde.line <- layout$abanico$colour$kde.line - } - - if(length(layout$abanico$colour$kde.fill) == 1) { - kde.fill <- rep(layout$abanico$colour$kde.fill, length(data)) - } else { - kde.fill <- layout$abanico$colour$kde.fill - } - - if(length(layout$abanico$colour$value.dot) == 1) { - value.dot <- 1:length(data) - } else { - value.dot <- layout$abanico$colour$value.dot - } - - if(length(layout$abanico$colour$value.bar) == 1) { - value.bar <- 1:length(data) - } else { - value.bar <- layout$abanico$colour$value.bar - } - - if(length(layout$abanico$colour$value.rug) == 1) { - value.rug <- 1:length(data) - } else { - value.rug <- layout$abanico$colour$value.rug - } - - if(length(layout$abanico$colour$summary) == 1) { - summary.col <- 1:length(data) - } else { - summary.col <- layout$abanico$colour$summary - } - - if(length(layout$abanico$colour$centrality) == 1) { - centrality.col <- rep(x = 1:length(data), times = length(bar)) - } else { - centrality.col <- rep(x = layout$abanico$colour$centrality, - times = length(bar)) - } - } - - ## update central line colour - centrality.col <- rep(centrality.col, length(bar)) - - ## FIXME(mcol): tck seems completely unused - tck <- if("tck" %in% names(extraArgs)) { - extraArgs$tck - } else { - NA - } - - ## FIXME(mcol): tcl seems completely unused - tcl <- if("tcl" %in% names(extraArgs)) { - extraArgs$tcl - } else { - -0.5 - } - - ## define auxiliary plot parameters ----------------------------------------- - - ## set space between z-axis and baseline of cartesian part - if(boxplot == TRUE) { - - lostintranslation <- 1.03 - } else { - - lostintranslation <- 1.03 - plot.ratio <- plot.ratio * 1.05 - } - - ## create empty plot to update plot parameters - if(rotate == FALSE) { - plot(NA, - xlim = c(limits.x[1], limits.x[2] * (1 / plot.ratio)), - ylim = limits.y, - main = "", - sub = "", - xlab = "", - ylab = "", - xaxs = "i", - yaxs = "i", - frame.plot = FALSE, - axes = FALSE) - } else { - plot(NA, - xlim = limits.y, - ylim = c(limits.x[1], limits.x[2] * (1 / plot.ratio)), - main = "", - sub = "", - xlab = "", - ylab = "", - xaxs = "i", - yaxs = "i", - frame.plot = FALSE, - axes = FALSE) - } - - ## calculate conversion factor for plot coordinates - f <- 0 - - ## calculate major and minor z-tick values - if("at" %in% names(extraArgs)) { - tick.values.major <- extraArgs$at - tick.values.minor <- extraArgs$at - } else { - tick.values.major <- signif(pretty(limits.z, n = 5), 3) - tick.values.minor <- signif(pretty(limits.z, n = 25), 3) - } - - tick.values.major <- tick.values.major[tick.values.major >= - min(tick.values.minor)] - tick.values.major <- tick.values.major[tick.values.major <= - max(tick.values.minor)] - tick.values.major <- tick.values.major[tick.values.major >= - limits.z[1]] - tick.values.major <- tick.values.major[tick.values.major <= - limits.z[2]] - tick.values.minor <- tick.values.minor[tick.values.minor >= - limits.z[1]] - tick.values.minor <- tick.values.minor[tick.values.minor <= - limits.z[2]] - - - if(log.z == TRUE) { - - tick.values.major[which(tick.values.major==0)] <- 1 - tick.values.minor[which(tick.values.minor==0)] <- 1 - - tick.values.major <- log(tick.values.major) - tick.values.minor <- log(tick.values.minor) - } - - ## calculate z-axis radius - r <- max(sqrt((limits.x[2])^2 + (data.global[,7] * f)^2)) - - - ## create z-axes labels - if(log.z == TRUE) { - label.z.text <- signif(exp(tick.values.major), 3) - } else { - label.z.text <- signif(tick.values.major, 3) - } - - ## calculate node coordinates for semi-circle - ellipse.values <- c(min(ifelse(log.z == TRUE, - log(limits.z[1]), - limits.z[1]), - tick.values.major, - tick.values.minor), - max(ifelse(log.z == TRUE, - log(limits.z[2]), - limits.z[2]), - tick.values.major, - tick.values.minor)) - - ## correct for unpleasant value - ellipse.values[ellipse.values == -Inf] <- 0 - - if(rotate == FALSE) { - ellipse.x <- r / sqrt(1 + f^2 * (ellipse.values - z.central.global)^2) - ellipse.y <- (ellipse.values - z.central.global) * ellipse.x - } else { - ellipse.y <- r / sqrt(1 + f^2 * (ellipse.values - z.central.global)^2) - ellipse.x <- (ellipse.values - z.central.global) * ellipse.y - } - - ellipse <- cbind(ellipse.x, ellipse.y) - - ## calculate statistical labels - if(length(stats == 1)) {stats <- rep(stats, 2)} - stats.data <- matrix(nrow = 3, ncol = 3) - data.stats <- as.numeric(data.global[,1]) - - if("min" %in% stats == TRUE) { - stats.data[1, 3] <- data.stats[data.stats == min(data.stats)][1] - stats.data[1, 1] <- data.global[data.stats == stats.data[1, 3], 6][1] - stats.data[1, 2] <- data.global[data.stats == stats.data[1, 3], 8][1] - } - - if("max" %in% stats == TRUE) { - stats.data[2, 3] <- data.stats[data.stats == max(data.stats)][1] - stats.data[2, 1] <- data.global[data.stats == stats.data[2, 3], 6][1] - stats.data[2, 2] <- data.global[data.stats == stats.data[2, 3], 8][1] - } - - if("median" %in% stats == TRUE) { - stats.data[3, 3] <- data.stats[data.stats == quantile(data.stats, 0.5, type = 3)] - stats.data[3, 1] <- data.global[data.stats == stats.data[3, 3], 6][1] - stats.data[3, 2] <- data.global[data.stats == stats.data[3, 3], 8][1] - } - - ## re-calculate axes limits if necessary - if(rotate == FALSE) { - limits.z.x <- range(ellipse[,1]) - limits.z.y <- range(ellipse[,2]) - } else { - limits.z.x <- range(ellipse[,2]) - limits.z.y <- range(ellipse[,1]) - } - - if(!("ylim" %in% names(extraArgs))) { - if(limits.z.y[1] < 0.66 * limits.y[1]) { - limits.y[1] <- 1.8 * limits.z.y[1] - } - if(limits.z.y[2] > 0.77 * limits.y[2]) { - limits.y[2] <- 1.3 * limits.z.y[2] - } - - if(rotate == TRUE) { - limits.y <- c(-max(abs(limits.y)), max(abs(limits.y))) - } - - } - if(!("xlim" %in% names(extraArgs))) { - if(limits.z.x[2] > 1.1 * limits.x[2]) { - limits.x[2] <- limits.z.x[2] - } - } - - ## calculate and paste statistical summary - De.stats <- matrix(nrow = length(data), ncol = 12) - colnames(De.stats) <- c("n", - "mean", - "median", - "kde.max", - "sd.abs", - "sd.rel", - "se.abs", - "se.rel", - "q.25", - "q.75", - "skewness", - "kurtosis") - - for(i in 1:length(data)) { - statistics <- calc_Statistics(data[[i]])[[summary.method]] - statistics.2 <- calc_Statistics(data[[i]][,3:4])[[summary.method]] - - De.stats[i,1] <- statistics$n - De.stats[i,2] <- statistics.2$mean - De.stats[i,3] <- statistics.2$median - De.stats[i,5] <- statistics$sd.abs - De.stats[i,6] <- statistics$sd.rel - De.stats[i,7] <- statistics$se.abs - De.stats[i,8] <- statistics$se.rel - De.stats[i,9] <- quantile(data[[i]][,1], 0.25) - De.stats[i,10] <- quantile(data[[i]][,1], 0.75) - De.stats[i,11] <- statistics$skewness - De.stats[i,12] <- statistics$kurtosis - - ## account for log.z-option - if(log.z == TRUE) { - De.stats[i,2:4] <- exp(De.stats[i,2:4]) - } - - ## kdemax - here a little doubled as it appears below again - De.density <- try(density(x = data[[i]][,1], - kernel = "gaussian", - bw = bw, - from = limits.z[1], - to = limits.z[2]), - silent = TRUE) - - if(inherits(De.density, "try-error")) { - De.stats[i,4] <- NA - - } else { - De.stats[i,4] <- De.density$x[which.max(De.density$y)] - - } - } - - label.text = list(NA) - - if(summary.pos[1] != "sub") { - n.rows <- length(summary) - - for(i in 1:length(data)) { - stops <- paste(rep("\n", (i - 1) * n.rows), collapse = "") - - summary.text <- character(0) - - for(j in 1:length(summary)) { - summary.text <- c(summary.text, - paste( - "", - ifelse("n" %in% summary[j] == TRUE, - paste("n = ", - De.stats[i,1], - "\n", - sep = ""), - ""), - ifelse("mean" %in% summary[j] == TRUE, - paste("mean = ", - round(De.stats[i,2], 2), - "\n", - sep = ""), - ""), - ifelse("median" %in% summary[j] == TRUE, - paste("median = ", - round(De.stats[i,3], 2), - "\n", - sep = ""), - ""), - ifelse("kde.max" %in% summary[j] == TRUE, - paste("kdemax = ", - round(De.stats[i,4], 2), - " \n ", - sep = ""), - ""), - ifelse("sd.abs" %in% summary[j] == TRUE, - paste("abs. sd = ", - round(De.stats[i,5], 2), - "\n", - sep = ""), - ""), - ifelse("sd.rel" %in% summary[j] == TRUE, - paste("rel. sd = ", - round(De.stats[i,6], 2), " %", - "\n", - sep = ""), - ""), - ifelse("se.abs" %in% summary[j] == TRUE, - paste("se = ", - round(De.stats[i,7], 2), - "\n", - sep = ""), - ""), - ifelse("se.rel" %in% summary[j] == TRUE, - paste("rel. se = ", - round(De.stats[i,8], 2), " %", - "\n", - sep = ""), - ""), - ifelse("skewness" %in% summary[j] == TRUE, - paste("skewness = ", - round(De.stats[i,11], 2), - "\n", - sep = ""), - ""), - ifelse("kurtosis" %in% summary[j] == TRUE, - paste("kurtosis = ", - round(De.stats[i,12], 2), - "\n", - sep = ""), - ""), - ifelse("in.2s" %in% summary[j] == TRUE, - paste("in 2 sigma = ", - round(sum(data[[i]][,7] > -2 & - data[[i]][,7] < 2) / - nrow(data[[i]]) * 100 , 1), - " %", - sep = ""), - ""), - sep = "")) - } - - summary.text <- paste(summary.text, collapse = "") - - label.text[[length(label.text) + 1]] <- paste(stops, - summary.text, - stops, - sep = "") - } - } else { - for(i in 1:length(data)) { - - summary.text <- character(0) - - for(j in 1:length(summary)) { - summary.text <- c(summary.text, - ifelse("n" %in% summary[j] == TRUE, - paste("n = ", - De.stats[i,1], - " | ", - sep = ""), - ""), - ifelse("mean" %in% summary[j] == TRUE, - paste("mean = ", - round(De.stats[i,2], 2), - " | ", - sep = ""), - ""), - ifelse("median" %in% summary[j] == TRUE, - paste("median = ", - round(De.stats[i,3], 2), - " | ", - sep = ""), - ""), - ifelse("kde.max" %in% summary[j] == TRUE, - paste("kdemax = ", - round(De.stats[i,4], 2), - " | ", - sep = ""), - ""), - ifelse("sd.abs" %in% summary[j] == TRUE, - paste("abs. sd = ", - round(De.stats[i,5], 2), - " | ", - sep = ""), - ""), - ifelse("sd.rel" %in% summary[j] == TRUE, - paste("rel. sd = ", - round(De.stats[i,6], 2), " %", - " | ", - sep = ""), - ""), - ifelse("se.abs" %in% summary[j] == TRUE, - paste("abs. se = ", - round(De.stats[i,7], 2), - " | ", - sep = ""), - ""), - ifelse("se.rel" %in% summary[j] == TRUE, - paste("rel. se = ", - round(De.stats[i,8], 2), " %", - " | ", - sep = ""), - ""), - ifelse("skewness" %in% summary[j] == TRUE, - paste("skewness = ", - round(De.stats[i,11], 2), - " | ", - sep = ""), - ""), - ifelse("kurtosis" %in% summary[j] == TRUE, - paste("kurtosis = ", - round(De.stats[i,12], 2), - " | ", - sep = ""), - ""), - ifelse("in.2s" %in% summary[j] == TRUE, - paste("in 2 sigma = ", - round(sum(data[[i]][,7] > -2 & - data[[i]][,7] < 2) / - nrow(data[[i]]) * 100 , 1), - " % | ", - sep = ""), - "") - ) - } - - summary.text <- paste(summary.text, collapse = "") - - label.text[[length(label.text) + 1]] <- paste( - " ", - summary.text, - sep = "") - } - - ## remove outer vertical lines from string - for(i in 2:length(label.text)) { - label.text[[i]] <- substr(x = label.text[[i]], - start = 3, - stop = nchar(label.text[[i]]) - 3) - } - } - - ## remove dummy list element - label.text[[1]] <- NULL - - if(rotate == FALSE) { - ## convert keywords into summary placement coordinates - if(missing(summary.pos) == TRUE) { - summary.pos <- c(limits.x[1], limits.y[2]) - summary.adj <- c(0, 1) - } else if(length(summary.pos) == 2) { - summary.pos <- summary.pos - summary.adj <- c(0, 1) - } else if(summary.pos[1] == "topleft") { - summary.pos <- c(limits.x[1], limits.y[2] - par()$cxy[2] * 1) - summary.adj <- c(0, 1) - } else if(summary.pos[1] == "top") { - summary.pos <- c(mean(limits.x), limits.y[2] - par()$cxy[2] * 1) - summary.adj <- c(0.5, 1) - } else if(summary.pos[1] == "topright") { - summary.pos <- c(limits.x[2], limits.y[2] - par()$cxy[2] * 1) - summary.adj <- c(1, 1) - } else if(summary.pos[1] == "left") { - summary.pos <- c(limits.x[1], mean(limits.y)) - summary.adj <- c(0, 0.5) - } else if(summary.pos[1] == "center") { - summary.pos <- c(mean(limits.x), mean(limits.y)) - summary.adj <- c(0.5, 0.5) - } else if(summary.pos[1] == "right") { - summary.pos <- c(limits.x[2], mean(limits.y)) - summary.adj <- c(1, 0.5) - }else if(summary.pos[1] == "bottomleft") { - summary.pos <- c(limits.x[1], limits.y[1] + par()$cxy[2] * 3.5) - summary.adj <- c(0, 0) - } else if(summary.pos[1] == "bottom") { - summary.pos <- c(mean(limits.x), limits.y[1] + par()$cxy[2] * 3.5) - summary.adj <- c(0.5, 0) - } else if(summary.pos[1] == "bottomright") { - summary.pos <- c(limits.x[2], limits.y[1] + par()$cxy[2] * 3.5) - summary.adj <- c(1, 0) - } - - ## convert keywords into legend placement coordinates - if(missing(legend.pos) == TRUE) { - legend.pos <- c(limits.x[1], limits.y[2]) - legend.adj <- c(0, 1) - } else if(length(legend.pos) == 2) { - legend.pos <- legend.pos - legend.adj <- c(0, 1) - } else if(legend.pos[1] == "topleft") { - legend.pos <- c(limits.x[1], limits.y[2]) - legend.adj <- c(0, 1) - } else if(legend.pos[1] == "top") { - legend.pos <- c(mean(limits.x), limits.y[2]) - legend.adj <- c(0.5, 1) - } else if(legend.pos[1] == "topright") { - legend.pos <- c(limits.x[2], limits.y[2]) - legend.adj <- c(1, 1) - } else if(legend.pos[1] == "left") { - legend.pos <- c(limits.x[1], mean(limits.y)) - legend.adj <- c(0, 0.5) - } else if(legend.pos[1] == "center") { - legend.pos <- c(mean(limits.x), mean(limits.y)) - legend.adj <- c(0.5, 0.5) - } else if(legend.pos[1] == "right") { - legend.pos <- c(limits.x[2], mean(limits.y)) - legend.adj <- c(1, 0.5) - } else if(legend.pos[1] == "bottomleft") { - legend.pos <- c(limits.x[1], limits.y[1]) - legend.adj <- c(0, 0) - } else if(legend.pos[1] == "bottom") { - legend.pos <- c(mean(limits.x), limits.y[1]) - legend.adj <- c(0.5, 0) - } else if(legend.pos[1] == "bottomright") { - legend.pos <- c(limits.x[2], limits.y[1]) - legend.adj <- c(1, 0) - } - } else { - ## convert keywords into summary placement coordinates - if(missing(summary.pos) == TRUE) { - summary.pos <- c(limits.y[1] + par()$cxy[1] * 7.5, limits.x[1]) - summary.adj <- c(0, 0) - } else if(length(summary.pos) == 2) { - summary.pos <- summary.pos - summary.adj <- c(0, 1) - } else if(summary.pos[1] == "topleft") { - summary.pos <- c(limits.y[1] + par()$cxy[1] * 7.5, limits.x[2]) - summary.adj <- c(0, 1) - } else if(summary.pos[1] == "top") { - summary.pos <- c(mean(limits.y), limits.x[2]) - summary.adj <- c(0.5, 1) - } else if(summary.pos[1] == "topright") { - summary.pos <- c(limits.y[2], limits.x[2]) - summary.adj <- c(1, 1) - } else if(summary.pos[1] == "left") { - summary.pos <- c(limits.y[1] + par()$cxy[1] * 7.5, mean(limits.x)) - summary.adj <- c(0, 0.5) - } else if(summary.pos[1] == "center") { - summary.pos <- c(mean(limits.y), mean(limits.x)) - summary.adj <- c(0.5, 0.5) - } else if(summary.pos[1] == "right") { - summary.pos <- c(limits.y[2], mean(limits.x)) - summary.adj <- c(1, 0.5) - }else if(summary.pos[1] == "bottomleft") { - summary.pos <- c(limits.y[1] + par()$cxy[1] * 7.5, limits.x[1]) - summary.adj <- c(0, 0) - } else if(summary.pos[1] == "bottom") { - summary.pos <- c(mean(limits.y), limits.x[1]) - summary.adj <- c(0.5, 0) - } else if(summary.pos[1] == "bottomright") { - summary.pos <- c(limits.y[2], limits.x[1]) - summary.adj <- c(1, 0) - } - - ## convert keywords into legend placement coordinates - if(missing(legend.pos) == TRUE) { - legend.pos <- c(limits.y[1] + par()$cxy[1] * 7.5, limits.x[1]) - legend.adj <- c(0, 0) - } else if(length(legend.pos) == 2) { - legend.pos <- legend.pos - legend.adj <- c(1, 0) - } else if(legend.pos[1] == "topleft") { - legend.pos <- c(limits.y[1] + par()$cxy[1] * 11, limits.x[2]) - legend.adj <- c(1, 0) - } else if(legend.pos[1] == "top") { - legend.pos <- c(mean(limits.y), limits.x[2]) - legend.adj <- c(1, 0.5) - } else if(legend.pos[1] == "topright") { - legend.pos <- c(limits.y[2], limits.x[2]) - legend.adj <- c(1, 1) - } else if(legend.pos[1] == "left") { - legend.pos <- c(limits.y[1] + par()$cxy[1] * 7.5, mean(limits.x)) - legend.adj <- c(0.5, 0) - } else if(legend.pos[1] == "center") { - legend.pos <- c(mean(limits.y), mean(limits.x)) - legend.adj <- c(0.5, 0.5) - } else if(legend.pos[1] == "right") { - legend.pos <- c(limits.y[2], mean(limits.x)) - legend.adj <- c(0.5, 1) - } else if(legend.pos[1] == "bottomleft") { - legend.pos <- c(limits.y[1] + par()$cxy[1] * 7.5, limits.x[1]) - legend.adj <- c(0, 0) - } else if(legend.pos[1] == "bottom") { - legend.pos <- c(mean(limits.y), limits.x[1]) - legend.adj <- c(0, 0.5) - } else if(legend.pos[1] == "bottomright") { - legend.pos <- c(limits.y[2], limits.x[1]) - legend.adj <- c(0, 1) - } - } - - ## define cartesian plot origins - if(rotate == FALSE) { - xy.0 <- c(min(ellipse[,1]) * lostintranslation, min(ellipse[,2])) - } else { - xy.0 <- c(min(ellipse[,1]), min(ellipse[,2]) * lostintranslation) - } - - ## calculate coordinates for dispersion polygon overlay - y.max.x <- 2 * limits.x[2] / max(data.global[6]) - - polygons <- matrix(nrow = length(data), ncol = 14) - for(i in 1:length(data)) { - - if(dispersion == "qr") { - ci.lower <- quantile(data[[i]][,1], 0.25) - ci.upper <- quantile(data[[i]][,1], 0.75) - } else if(grepl(x = dispersion, pattern = "p") == TRUE) { - ci.plot <- as.numeric(strsplit(x = dispersion, - split = "p")[[1]][2]) - ci.plot <- (100 - ci.plot) / 100 - ci.lower <- quantile(data[[i]][,1], ci.plot) - ci.upper <- quantile(data[[i]][,1], 1 - ci.plot) - } else if(dispersion == "sd") { - if(log.z == TRUE) { - ci.lower <- exp(mean(log(data[[i]][,1])) - sd(log(data[[i]][,1]))) - ci.upper <- exp(mean(log(data[[i]][,1])) + sd(log(data[[i]][,1]))) - } else { - ci.lower <- mean(data[[i]][,1]) - sd(data[[i]][,1]) - ci.upper <- mean(data[[i]][,1]) + sd(data[[i]][,1]) - } - } else if(dispersion == "2sd") { - if(log.z == TRUE) { - ci.lower <- exp(mean(log(data[[i]][,1])) - 2 * sd(log(data[[i]][,1]))) - ci.upper <- exp(mean(log(data[[i]][,1])) + 2 * sd(log(data[[i]][,1]))) - } else { - ci.lower <- mean(data[[i]][,1]) - 2 * sd(data[[i]][,1]) - ci.upper <- mean(data[[i]][,1]) + 2 * sd(data[[i]][,1]) - } - } else { - .throw_error("Measure of dispersion not supported.") - } - - if(log.z == TRUE) { - ci.lower[which(ci.lower < 0)] <- 1 - y.lower <- log(ci.lower) - y.upper <- log(ci.upper) - } else { - y.lower <- ci.lower - y.upper <- ci.upper - } - - if(rotate == FALSE) { - polygons[i,1:7] <- c(limits.x[1], - limits.x[2], - xy.0[1], - par()$usr[2], - par()$usr[2], - xy.0[1], - limits.x[2]) - polygons[i,8:14] <- c(0, - (y.upper - z.central.global) * - limits.x[2], - (y.upper - z.central.global) * - xy.0[1], - (y.upper - z.central.global) * - xy.0[1], - (y.lower - z.central.global) * - xy.0[1], - (y.lower - z.central.global) * - xy.0[1], - (y.lower - z.central.global) * - limits.x[2] - ) - } else { - y.max <- par()$usr[4] - polygons[i,1:7] <- c(limits.x[1], - limits.x[2], - xy.0[2], - y.max, - y.max, - xy.0[2], - limits.x[2]) - polygons[i,8:14] <- c(0, - (y.upper - z.central.global) * - limits.x[2], - (y.upper - z.central.global) * - xy.0[2], - (y.upper - z.central.global) * - xy.0[2], - (y.lower - z.central.global) * - xy.0[2], - (y.lower - z.central.global) * - xy.0[2], - (y.lower - z.central.global) * - limits.x[2] - ) - } - } - - ## append information about data in confidence interval - for(i in 1:length(data)) { - data.in.2s <- rep(x = FALSE, times = nrow(data[[i]])) - data.in.2s[data[[i]][,8] > -2 & data[[i]][,8] < 2] <- TRUE - data[[i]] <- cbind(data[[i]], data.in.2s) - } - - ## calculate coordinates for 2-sigma bar overlay - if(bar[1] == TRUE) { - bars <- matrix(nrow = length(data), ncol = 8) - - for(i in 1:length(data)) { - bars[i,1:4] <- c(limits.x[1], - limits.x[1], - ifelse("xlim" %in% names(extraArgs), - extraArgs$xlim[2] * 0.95, - max(data.global$precision)), - ifelse("xlim" %in% names(extraArgs), - extraArgs$xlim[2] * 0.95, - max(data.global$precision))) - - bars[i,5:8] <- c(-2, - 2, - (data[[i]][1,5] - z.central.global) * - bars[i,3] + 2, - (data[[i]][1,5] - z.central.global) * - bars[i,3] - 2) - - } - } else { - bars <- matrix(nrow = length(bar), ncol = 8) - - if(is.numeric(bar) == TRUE & log.z == TRUE) { - bar <- log(bar) - } - - for(i in 1:length(bar)) { - bars[i,1:4] <- c(limits.x[1], - limits.x[1], - ifelse("xlim" %in% names(extraArgs), - extraArgs$xlim[2] * 0.95, - max(data.global$precision)), - ifelse("xlim" %in% names(extraArgs), - extraArgs$xlim[2] * 0.95, - max(data.global$precision))) - - bars[i,5:8] <- c(-2, - 2, - (bar[i] - z.central.global) * - bars[i,3] + 2, - (bar[i] - z.central.global) * - bars[i,3] - 2) - } - } - if (rotate == TRUE) { - bars <- matrix(bars[, rev(seq_len(ncol(bars)))], ncol = 8) - } - - ## calculate error bar coordinates - if(error.bars == TRUE) { - arrow.coords <- list(NA) - for(i in 1:length(data)) { - arrow.x1 <- data[[i]][,6] - arrow.x2 <- data[[i]][,6] - arrow.y1 <- data[[i]][,1] - data[[i]][,2] - arrow.y2 <- data[[i]][,1] + data[[i]][,2] - - if(log.z == TRUE) { - arrow.y1 <- log(arrow.y1) - arrow.y2 <- log(arrow.y2) - } - - arrow.coords[[length(arrow.coords) + 1]] <- cbind( - arrow.x1, - arrow.x2, - (arrow.y1 - z.central.global) * arrow.x1, - (arrow.y2 - z.central.global) * arrow.x1) - } - arrow.coords[[1]] <- NULL - } - - ## calculate KDE - KDE <- list(NA) - KDE.ext <- 0 - KDE.bw <- numeric(0) - - for(i in 1:length(data)) { - KDE.i <- density(x = data[[i]][,3], - kernel = "gaussian", - bw = bw, - from = ellipse.values[1], - to = ellipse.values[2], - weights = data[[i]]$weights) - KDE.xy <- cbind(KDE.i$x, KDE.i$y) - KDE.bw <- c(KDE.bw, KDE.i$bw) - KDE.ext <- ifelse(max(KDE.xy[,2]) < KDE.ext, KDE.ext, max(KDE.xy[,2])) - KDE.xy <- rbind(c(min(KDE.xy[,1]), 0), KDE.xy, c(max(KDE.xy[,1]), 0)) - KDE[[length(KDE) + 1]] <- cbind(KDE.xy[,1], KDE.xy[,2]) - } - KDE[1] <- NULL - - ## calculate mean KDE bandwidth - KDE.bw <- mean(KDE.bw, na.rm = TRUE) - - ## calculate max KDE value for labelling - KDE.max.plot <- numeric(length(data)) - - for(i in 1:length(data)) { - KDE.plot <- density(x = data[[i]][,1], - kernel = "gaussian", - bw = bw, - from = limits.z[1], - to = limits.z[2]) - KDE.max.plot[i] <- max(KDE.plot$y) - } - - KDE.max.plot <- max(KDE.max.plot, na.rm = TRUE) - - ## calculate histogram data without plotting - - ## create dummy list - hist.data <- list(NA) - - for(i in 1:length(data)) { - hist.i <- hist(x = data[[i]][,3], - plot = FALSE, - breaks = breaks) - hist.data[[length(hist.data) + 1]] <- hist.i - } - - ## remove dummy list object - hist.data[[1]] <- NULL - - ## calculate maximum histogram bar height for normalisation - hist.max.plot <- numeric(length(data)) - for(i in 1:length(data)) { - hist.max.plot <- ifelse(max(hist.data[[i]]$counts, na.rm = TRUE) > - hist.max.plot, max(hist.data[[i]]$counts, - na.rm = TRUE), hist.max.plot) - } - hist.max.plot <- max(hist.max.plot, na.rm = TRUE) - - ## normalise histogram bar height to KDE dimensions - for(i in 1:length(data)) { - hist.data[[i]]$density <- hist.data[[i]]$counts / hist.max.plot * - KDE.max.plot - } - - ## calculate boxplot data without plotting - - ## create dummy list - boxplot.data <- list(NA) - - for(i in 1:length(data)) { - boxplot.i <- boxplot(x = data[[i]][,3], - plot = FALSE) - boxplot.data[[length(boxplot.data) + 1]] <- boxplot.i - } - - ## remove dummy list object - boxplot.data[[1]] <- NULL - - ## calculate line coordinates and further parameters - if(missing(line) == FALSE) { - - ## check if line parameters are R.Lum-objects - for(i in 1:length(line)) { - if(is.list(line) == TRUE) { - if(is(line[[i]], "RLum.Results")) { - line[[i]] <- as.numeric(get_RLum(object = line[[i]], - data.object = "summary")$de) - } - } else if(is(object = line, class2 = "RLum.Results")) { - line <- as.numeric(get_RLum(object = line, - data.object = "summary")$de) - } - } - - ## convert list to vector - if(is.list(line) == TRUE) { - line <- unlist(line) - } - - if(log.z == TRUE) { - line <- log(line) - } - - line.coords <- list(NA) - - if(rotate == FALSE) { - for(i in 1:length(line)) { - line.x <- c(limits.x[1], min(ellipse[,1]), par()$usr[2]) - line.y <- c(0, - (line[i] - z.central.global) * min(ellipse[,1]), - (line[i] - z.central.global) * min(ellipse[,1])) - line.coords[[length(line.coords) + 1]] <- rbind(line.x, line.y) - } - } else { - for(i in 1:length(line)) { - line.x <- c(limits.x[1], min(ellipse[,2]),y.max) - line.y <- c(0, - (line[i] - z.central.global) * min(ellipse[,2]), - (line[i] - z.central.global) * min(ellipse[,2])) - line.coords[[length(line.coords) + 1]] <- rbind(line.x, line.y) - } - } - - line.coords[1] <- NULL - - if(missing(line.col) == TRUE) { - line.col <- seq(from = 1, to = length(line.coords)) - } - - if(missing(line.lty) == TRUE) { - line.lty <- rep(1, length(line.coords)) - } - - if(missing(line.label) == TRUE) { - line.label <- rep("", length(line.coords)) - } - } - - ## calculate rug coordinates - if(missing(rug) == FALSE) { - if(log.z == TRUE) { - rug.values <- log(De.global) - } else { - rug.values <- De.global - } - - rug.coords <- list(NA) - - if(rotate == FALSE) { - for(i in 1:length(rug.values)) { - rug.x <- c(xy.0[1] * (1 - 0.013 * (layout$abanico$dimension$rugl / 100)), - xy.0[1]) - rug.y <- c((rug.values[i] - z.central.global) * min(ellipse[,1]), - (rug.values[i] - z.central.global) * min(ellipse[,1])) - rug.coords[[length(rug.coords) + 1]] <- rbind(rug.x, rug.y) - } - } else { - for(i in 1:length(rug.values)) { - rug.x <- c(xy.0[2] * (1 - 0.013 * (layout$abanico$dimension$rugl / 100)), - xy.0[2]) - rug.y <- c((rug.values[i] - z.central.global) * min(ellipse[,2]), - (rug.values[i] - z.central.global) * min(ellipse[,2])) - rug.coords[[length(rug.coords) + 1]] <- rbind(rug.x, rug.y) - } - } - - rug.coords[1] <- NULL - } - - ## Generate plot ------------------------------------------------------------ - - ## determine number of subheader lines to shift the plot - if(length(summary) > 0 & summary.pos[1] == "sub") { - shift.lines <- (length(data) + 1) * layout$abanico$dimension$summary.line/100 - } else {shift.lines <- 1} - - ## extract original plot parameters - bg.original <- par()$bg - on.exit(par(bg = bg.original), add = TRUE) - par(bg = layout$abanico$colour$background) - - - if(rotate == FALSE) { - ## setup plot area - par(mar = c(4.5, 4.5, shift.lines + 1.5, 7), - xpd = TRUE, - cex = cex) - - if(layout$abanico$dimension$figure.width != "auto" | - layout$abanico$dimension$figure.height != "auto") { - par(mai = layout$abanico$dimension$margin / 25.4, - pin = c(layout$abanico$dimension$figure.width / 25.4 - - layout$abanico$dimension$margin[2] / 25.4 - - layout$abanico$dimension$margin[4] / 25.4, - layout$abanico$dimension$figure.height / 25.4 - - layout$abanico$dimension$margin[1] / 25.4 - - layout$abanico$dimension$margin[3]/25.4)) - } - - ## create empty plot - par(new = TRUE) - plot(NA, - xlim = c(limits.x[1], limits.x[2] * (1 / plot.ratio)), - ylim = limits.y, - main = "", - sub = sub, - xlab = "", - ylab = "", - xaxs = "i", - yaxs = "i", - frame.plot = FALSE, - axes = FALSE) - - ## add y-axis label - mtext(text = ylab, - at = mean(x = c(min(ellipse[,2]), - max(ellipse[,2])), - na.rm = TRUE), - # at = 0, ## BUG FROM VERSION 0.4.0, maybe removed in future - adj = 0.5, - side = 2, - line = 3 * layout$abanico$dimension$ylab.line / 100, - col = layout$abanico$colour$ylab, - family = layout$abanico$font.type$ylab, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$ylab)[1], - cex = cex * layout$abanico$font.size$ylab/12) - - ## calculate upper x-axis label values - label.x.upper <- if(log.z == TRUE) { - as.character(round(1/axTicks(side = 1)[-1] * 100, 1)) - } else { - as.character(round(1/axTicks(side = 1)[-1], 1)) - } - - # optionally, plot 2-sigma-bar - if(bar[1] != FALSE) { - for(i in 1:length(bar)) { - polygon(x = bars[i,1:4], - y = bars[i,5:8], - col = bar.fill[i], - border = bar.line[i]) - } - } - - ## remove unwanted parts - polygon(x = c(par()$usr[2], - par()$usr[2], - par()$usr[2] * 2, - par()$usr[2] * 2), - y = c(min(ellipse[,2]) * 2, - max(ellipse[,2]) * 2, - max(ellipse[,2]) * 2, - min(ellipse[,2]) * 2), - col = bg.original, - lty = 0) - - ## optionally, plot dispersion polygon - if(polygon.fill[1] != "none") { - for(i in 1:length(data)) { - polygon(x = polygons[i,1:7], - y = polygons[i,8:14], - col = polygon.fill[i], - border = polygon.line[i]) - } - } - - ## optionally, add minor grid lines - if(grid.minor != "none") { - - for(i in 1:length(tick.values.minor)) { - lines(x = c(limits.x[1], min(ellipse[,1])), - y = c(0, (tick.values.minor[i] - z.central.global) * - min(ellipse[,1])), - col = grid.minor, - lwd = 1) - } - - for(i in 1:length(tick.values.minor)) { - lines(x = c(xy.0[1], par()$usr[2]), - y = c((tick.values.minor[i] - z.central.global) * - min(ellipse[,1]), - (tick.values.minor[i] - z.central.global) * - min(ellipse[,1])), - col = grid.minor, - lwd = 1) - } - } - - ## optionally, add major grid lines - if(grid.major != "none") { - for(i in 1:length(tick.values.major)) { - lines(x = c(limits.x[1], min(ellipse[,1])), - y = c(0, (tick.values.major[i] - z.central.global) * - min(ellipse[,1])), - col = grid.major, - lwd = 1) - } - for(i in 1:length(tick.values.major)) { - lines(x = c(xy.0[1], par()$usr[2]), - y = c((tick.values.major[i] - z.central.global) * - min(ellipse[,1]), - (tick.values.major[i] - z.central.global) * - min(ellipse[,1])), - col = grid.major, - lwd = 1) - } - } - - ## optionally, plot lines for each bar - if(lwd[1] > 0 & lty[1] > 0 & bar[1] != FALSE & length(data) == 1) { - if(bar[1] == TRUE & length(bar) == 1) { - bar[1] <- z.central.global - } - for(i in 1:length(bar)) { - x2 <- r / sqrt(1 + f^2 * ( - bar[i] - z.central.global)^2) - y2 <- (bar[i] - z.central.global) * x2 - lines(x = c(limits.x[1], x2, xy.0[1], par()$usr[2]), - y = c(0, y2, y2, y2), - lty = lty[i], - lwd = lwd[i], - col = centrality.col[i]) - } - } else if(lwd[1] > 0 & lty[1] > 0 & bar[1] != FALSE) { - for(i in 1:length(data)) { - - z.line <- ifelse(test = is.numeric(bar[i]) == TRUE, - yes = bar[i], - no = data[[i]][1,5]) - - x2 <- r / sqrt(1 + f^2 * ( - z.line - z.central.global)^2) - y2 <- (z.line - z.central.global) * x2 - lines(x = c(limits.x[1], x2, xy.0[1], par()$usr[2]), - y = c(0, y2, y2, y2), - lty = lty[i], - lwd = lwd[i], - col = centrality.col[i]) - } - } - - ## optionally add further lines - if(missing(line) == FALSE) { - for(i in 1:length(line)) { - lines(x = line.coords[[i]][1,1:3], - y = line.coords[[i]][2,1:3], - col = line.col[i], - lty = line.lty[i] - ) - text(x = line.coords[[i]][1,3], - y = line.coords[[i]][2,3] + par()$cxy[2] * 0.3, - labels = line.label[i], - pos = 2, - col = line.col[i], - cex = cex * 0.9) - } - } - - ## add plot title - cex.old <- par()$cex - par(cex = layout$abanico$font.size$main / 12) - title(main = main, - family = layout$abanico$font.type$main, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$main)[1], - col.main = layout$abanico$colour$main, - line = shift.lines * layout$abanico$dimension$main / 100) - par(cex = cex.old) - - ## calculate lower x-axis (precision) - x.axis.ticks <- axTicks(side = 1) - x.axis.ticks <- x.axis.ticks[c(TRUE, x.axis.ticks <= limits.x[2])] - x.axis.ticks <- x.axis.ticks[x.axis.ticks <= max(ellipse[,1])] - - ## x-axis with lables and ticks - axis(side = 1, - at = x.axis.ticks, - col = layout$abanico$colour$xtck1, - col.axis = layout$abanico$colour$xtck1, - labels = NA, - tcl = -layout$abanico$dimension$xtcl1 / 200, - cex = cex) - axis(side = 1, - at = x.axis.ticks, - line = 2 * layout$abanico$dimension$xtck1.line / 100 - 2, - lwd = 0, - col = layout$abanico$colour$xtck1, - family = layout$abanico$font.type$xtck1, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$xtck1)[1], - col.axis = layout$abanico$colour$xtck1, - cex.axis = layout$abanico$font.size$xlab1/12) - - ## extend axis line to right side of the plot - lines(x = c(max(x.axis.ticks), max(ellipse[,1])), - y = c(limits.y[1], limits.y[1]), - col = layout$abanico$colour$xtck1) - - ## draw closing tick on right hand side - axis(side = 1, - tcl = -layout$abanico$dimension$xtcl1 / 200, - lwd = 0, - lwd.ticks = 1, - at = limits.x[2], - labels = FALSE, - col = layout$abanico$colour$xtck1) - - axis(side = 1, - tcl = layout$abanico$dimension$xtcl2 / 200, - lwd = 0, - lwd.ticks = 1, - at = limits.x[2], - labels = FALSE, - col = layout$abanico$colour$xtck2) - - ## add lower axis label - mtext(xlab[2], - at = (limits.x[1] + max(ellipse[,1])) / 2, - side = 1, - line = 2.5 * layout$abanico$dimension$xlab1.line / 100, - col = layout$abanico$colour$xlab1, - family = layout$abanico$font.type$xlab1, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$xlab1)[1], - cex = cex * layout$abanico$font.size$xlab1/12) - - ## add upper axis label - mtext(xlab[1], - at = (limits.x[1] + max(ellipse[,1])) / 2, - side = 1, - line = -3.5 * layout$abanico$dimension$xlab2.line / 100, - col = layout$abanico$colour$xlab2, - family = layout$abanico$font.type$xlab2, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$xlab2)[1], - cex = cex * layout$abanico$font.size$xlab2/12) - - ## plot upper x-axis - axis(side = 1, - at = x.axis.ticks[-1], - col = layout$abanico$colour$xtck2, - col.axis = layout$abanico$colour$xtck2, - labels = NA, - tcl = layout$abanico$dimension$xtcl2 / 200, - cex = cex) - - ## remove first tick label (infinity) - label.x.upper <- label.x.upper[1:(length(x.axis.ticks) - 1)] - - axis(side = 1, - at = x.axis.ticks[-1], - labels = label.x.upper, - line = -1 * layout$abanico$dimension$xtck2.line / 100 - 2, - lwd = 0, - col = layout$abanico$colour$xtck2, - family = layout$abanico$font.type$xtck2, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$xtck2)[1], - col.axis = layout$abanico$colour$xtck2, - cex.axis = layout$abanico$font.size$xlab2/12) - - ## plot y-axis - if(is.null(extraArgs$yaxt) || extraArgs$yaxt != "n"){ - if(y.axis) { - char.height <- par()$cxy[2] - tick.space <- axisTicks(usr = limits.y, log = FALSE) - tick.space <- (max(tick.space) - min(tick.space)) / length(tick.space) - if(tick.space < char.height * 1.7) { - axis(side = 2, - tcl = -layout$abanico$dimension$ytcl / 200, - lwd = 1, - lwd.ticks = 1, - at = c(-2, 2), - labels = c("", ""), - las = 1, - col = layout$abanico$colour$ytck) - - axis(side = 2, - at = 0, - tcl = 0, - line = 2 * layout$abanico$dimension$ytck.line / 100 - 2, - labels = paste("\u00B1", "2"), - las = 1, - family = layout$abanico$font.type$ytck, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$ytck)[1], - col.axis = layout$abanico$colour$ytck, - cex.axis = layout$abanico$font.size$ylab/12) - } else { - axis(side = 2, - at = seq(-2, 2, by = 2), - col = layout$abanico$colour$ytck, - col.axis = layout$abanico$colour$ytck, - labels = NA, - las = 1, - tcl = -layout$abanico$dimension$ytcl / 200, - cex = cex) - axis(side = 2, - at = seq(-2, 2, by = 2), - line = 2 * layout$abanico$dimension$ytck.line / 100 - 2, - lwd = 0, - las = 1, - col = layout$abanico$colour$ytck, - family = layout$abanico$font.type$ytck, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$ytck)[1], - col.axis = layout$abanico$colour$ytck, - cex.axis = layout$abanico$font.size$ylab/12) - } - } else { - axis(side = 2, - at = 0, - col = layout$abanico$colour$ytck, - col.axis = layout$abanico$colour$ytck, - labels = NA, - las = 1, - tcl = -layout$abanico$dimension$ytcl / 200, - cex = cex) - axis(side = 2, - at = 0, - line = 2 * layout$abanico$dimension$ytck.line / 100 - 2, - lwd = 0, - las = 1, - col = layout$abanico$colour$ytck, - family = layout$abanico$font.type$ytck, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$ytck)[1], - col.axis = layout$abanico$colour$ytck, - cex.axis = layout$abanico$font.size$ylab/12) - } - } - - ## plot minor z-ticks - for(i in 1:length(tick.values.minor)) { - lines(x = c(par()$usr[2], - (1 + 0.007 * cex * layout$abanico$dimension$ztcl / 100) * - par()$usr[2]), - y = c((tick.values.minor[i] - z.central.global) * - min(ellipse[,1]), - (tick.values.minor[i] - z.central.global) * - min(ellipse[,1])), - col = layout$abanico$colour$ztck) - } - - - ## plot major z-ticks - for(i in 1:length(tick.values.major)) { - lines(x = c(par()$usr[2], - (1 + 0.015 * cex * layout$abanico$dimension$ztcl / 100) * - par()$usr[2]), - y = c((tick.values.major[i] - z.central.global) * - min(ellipse[,1]), - (tick.values.major[i] - z.central.global) * - min(ellipse[,1])), - col = layout$abanico$colour$ztck) - } - - ## plot z-axes - lines(ellipse, col = layout$abanico$colour$border) - lines(rep(par()$usr[2], nrow(ellipse)), ellipse[,2], - col = layout$abanico$colour$ztck) - - - ## plot z-axis text - text(x = (1 + 0.04 * cex * layout$abanico$dimension$ztcl / 100) * - par()$usr[2], - y = (tick.values.major - z.central.global) * min(ellipse[,1]), - labels = label.z.text, - adj = 0, - family = layout$abanico$font.type$ztck, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$ztck)[1], - cex = cex * layout$abanico$font.size$ztck/12) - - - ## plot z-label - mtext(text = zlab, - at = mean(x = c(min(ellipse[,2]), - max(ellipse[,2])), - na.rm = TRUE), - # at = 0, ## BUG from version 0.4.0, maybe removed in future - side = 4, - las = 3, - adj = 0.5, - line = 5 * layout$abanico$dimension$zlab.line / 100, - col = layout$abanico$colour$zlab, - family = layout$abanico$font.type$zlab, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$zlab)[1], - cex = cex * layout$abanico$font.size$zlab/12) - - ## plot values and optionally error bars - if(error.bars == TRUE) { - for(i in 1:length(data)) { - arrows(x0 = arrow.coords[[i]][,1], - x1 = arrow.coords[[i]][,2], - y0 = arrow.coords[[i]][,3], - y1 = arrow.coords[[i]][,4], - length = 0, - angle = 90, - code = 3, - col = value.bar[i]) - } - } - - for(i in 1:length(data)) { - points(data[[i]][,6][data[[i]][,6] <= limits.x[2]], - data[[i]][,8][data[[i]][,6] <= limits.x[2]], - col = value.dot[i], - pch = pch[i], - cex = layout$abanico$dimension$pch / 100) - } - - ## calculate KDE width - KDE.max <- 0 - - for(i in 1:length(data)) { - KDE.max <- ifelse(test = KDE.max < max(KDE[[i]][,2]), - yes = max(KDE[[i]][,2]), - no = KDE.max) - - } - - ## optionally adjust KDE width for boxplot option - if(boxplot == TRUE) { - - KDE.max <- 1.25 * KDE.max - } - - KDE.scale <- (par()$usr[2] - xy.0[1]) / (KDE.max * 1.05) - - ## optionally add KDE plot - if(kde == TRUE) { - - ## plot KDE lines - for(i in 1:length(data)) { - polygon(x = xy.0[1] + KDE[[i]][,2] * KDE.scale, - y = (KDE[[i]][,1] - z.central.global) * min(ellipse[,1]), - col = kde.fill[i], - border = kde.line[i], - lwd = 1.7) - } - - ## plot KDE x-axis - axis(side = 1, - at = c(xy.0[1], par()$usr[2]), - col = layout$abanico$colour$xtck3, - col.axis = layout$abanico$colour$xtck3, - labels = NA, - tcl = -layout$abanico$dimension$xtcl3 / 200, - cex = cex) - - axis(side = 1, - at = c(xy.0[1], par()$usr[2]), - labels = as.character(round(c(0, KDE.max.plot), 3)), - line = 2 * layout$abanico$dimension$xtck3.line / 100 - 2, - lwd = 0, - col = layout$abanico$colour$xtck3, - family = layout$abanico$font.type$xtck3, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$xtck3)[1], - col.axis = layout$abanico$colour$xtck3, - cex.axis = layout$abanico$font.size$xtck3/12) - - mtext(text = paste(xlab[3], - " (bw ", - round(x = KDE.bw, - digits = 3), - ")", - sep = ""), - at = (xy.0[1] + par()$usr[2]) / 2, - side = 1, - line = 2.5 * layout$abanico$dimension$xlab3.line / 100, - col = layout$abanico$colour$xlab3, - family = layout$abanico$font.type$xlab3, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$xlab3)[1], - cex = cex * layout$abanico$font.size$xlab3/12) - } - - ## optionally add histogram or dot plot axis - if(hist == TRUE) { - axis(side = 1, - at = c(xy.0[1], par()$usr[2]), - labels = as.character(c(0, hist.max.plot)), - line = -1 * layout$abanico$dimension$xtck3.line / 100 - 2, - lwd = 0, - col = layout$abanico$colour$xtck3, - family = layout$abanico$font.type$xtck3, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$xtck3)[1], - col.axis = layout$abanico$colour$xtck3, - cex.axis = layout$abanico$font.size$xtck3/12) - - ## add label - mtext(text = "n", - at = (xy.0[1] + par()$usr[2]) / 2, - side = 1, - line = -3.5 * layout$abanico$dimension$xlab2.line / 100, - col = layout$abanico$colour$xlab2, - family = layout$abanico$font.type$xlab2, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$xlab2)[1], - cex = cex * layout$abanico$font.size$xlab2/12) - - ## plot ticks - axis(side = 1, - at = c(xy.0[1], par()$usr[2]), - col = layout$abanico$colour$xtck2, - col.axis = layout$abanico$colour$xtck2, - labels = NA, - tcl = layout$abanico$dimension$xtcl2 / 200, - cex = cex) - - ## calculate scaling factor for histogram bar heights - hist.scale <- (par()$usr[2] - xy.0[1]) / (KDE.max.plot * 1.05) - - ## draw each bar for each data set - for(i in 1:length(data)) { - for(j in 1:length(hist.data[[i]]$density)) { - ## calculate x-coordinates - hist.x.i <- c(xy.0[1], - xy.0[1], - xy.0[1] + hist.data[[i]]$density[j] * hist.scale, - xy.0[1] + hist.data[[i]]$density[j] * hist.scale) - - ## calculate y-coordinates - hist.y.i <- c((hist.data[[i]]$breaks[j] - z.central.global) * - min(ellipse[,1]), - (hist.data[[i]]$breaks[j + 1] - z.central.global) * - min(ellipse[,1]), - (hist.data[[i]]$breaks[j + 1] - z.central.global) * - min(ellipse[,1]), - (hist.data[[i]]$breaks[j] - z.central.global) * - min(ellipse[,1])) - - ## remove data out of z-axis range - hist.y.i <- ifelse(hist.y.i < min(ellipse[,2]), - min(ellipse[,2]), - hist.y.i) - hist.y.i <- ifelse(hist.y.i > max(ellipse[,2]), - max(ellipse[,2]), - hist.y.i) - - ## draw the bars - polygon(x = hist.x.i, - y = hist.y.i, - col = kde.fill[i], - border = kde.line[i]) - } - } - } - - ## optionally add dot plot - if(dots == TRUE) { - for(i in 1:length(data)) { - for(j in 1:length(hist.data[[i]]$counts)) { - - ## calculate scaling factor for histogram bar heights - dots.distance <- (par()$usr[2] - (xy.0[1] + par()$cxy[1] * 0.4)) / hist.max.plot - - dots.x.i <- seq(from = xy.0[1] + par()$cxy[1] * 0.4, - by = dots.distance, - length.out = hist.data[[i]]$counts[j]) - - dots.y.i <- rep((hist.data[[i]]$mids[j] - z.central.global) * - min(ellipse[,1]), length(dots.x.i)) - - ## remove data out of z-axis range - dots.x.i <- dots.x.i[dots.y.i >= min(ellipse[,2]) & - dots.y.i <= max(ellipse[,2])] - dots.y.i <- dots.y.i[dots.y.i >= min(ellipse[,2]) & - dots.y.i <= max(ellipse[,2])] - - if(max(c(0, dots.x.i), na.rm = TRUE) >= (par()$usr[2] - - par()$cxy[1] * 0.4)) { - dots.y.i <- dots.y.i[dots.x.i < (par()$usr[2] - par()$cxy[1] * 0.4)] - dots.x.i <- dots.x.i[dots.x.i < (par()$usr[2] - par()$cxy[1] * 0.4)] - pch.dots <- c(rep(20, max(length(dots.x.i) - 1),1), 15) - - } else { - pch.dots <- rep(20, length(dots.x.i)) - } - - ## plot points - points(x = dots.x.i, - y = dots.y.i, - pch = "|", - cex = 0.7 * cex, - col = kde.line[i]) - - } - } - } - - ## optionally add box plot - if(boxplot == TRUE) { - - for(i in 1:length(data)) { - - ## draw median line - lines(x = c(xy.0[1] + KDE.max * 0.85, xy.0[1] + KDE.max * 0.95), - y = c((boxplot.data[[i]]$stats[3,1] - z.central.global) * - min(ellipse[,1]), - (boxplot.data[[i]]$stats[3,1] - z.central.global) * - min(ellipse[,1])), - lwd = 2, - col = kde.line[i]) - - ## draw p25-p75-polygon - polygon(x = c(xy.0[1] + KDE.max * 0.85, - xy.0[1] + KDE.max * 0.85, - xy.0[1] + KDE.max * 0.95, - xy.0[1] + KDE.max * 0.95), - y = c((boxplot.data[[i]]$stats[2,1] - z.central.global) * - min(ellipse[,1]), - (boxplot.data[[i]]$stats[4,1] - z.central.global) * - min(ellipse[,1]), - (boxplot.data[[i]]$stats[4,1] - z.central.global) * - min(ellipse[,1]), - (boxplot.data[[i]]$stats[2,1] - z.central.global) * - min(ellipse[,1])), - border = kde.line[i]) - - ## draw whiskers - lines(x = c(xy.0[1] + KDE.max * 0.9, - xy.0[1] + KDE.max * 0.9), - y = c((boxplot.data[[i]]$stats[2,1] - z.central.global) * - min(ellipse[,1]), - (boxplot.data[[i]]$stats[1,1] - z.central.global) * - min(ellipse[,1])), - col = kde.line[i]) - - lines(x = c(xy.0[1] + KDE.max * 0.87, - xy.0[1] + KDE.max * 0.93), - y = rep((boxplot.data[[i]]$stats[1,1] - z.central.global) * - min(ellipse[,1]), 2), - col = kde.line[i]) - - lines(x = c(xy.0[1] + KDE.max * 0.9, - xy.0[1] + KDE.max * 0.9), - y = c((boxplot.data[[i]]$stats[4,1] - z.central.global) * - min(ellipse[,1]), - (boxplot.data[[i]]$stats[5,1] - z.central.global) * - min(ellipse[,1])), - col = kde.line[i]) - - lines(x = c(xy.0[1] + KDE.max * 0.87, - xy.0[1] + KDE.max * 0.93), - y = rep((boxplot.data[[i]]$stats[5,1] - z.central.global) * - min(ellipse[,1]), 2), - col = kde.line[i]) - - ## draw outlier points - points(x = rep(xy.0[1] + KDE.max * 0.9, - length(boxplot.data[[i]]$out)), - y = (boxplot.data[[i]]$out - z.central.global) * - min(ellipse[,1]), - cex = cex * 0.8, - col = kde.line[i]) - } - } - - ## optionally add stats, i.e. min, max, median sample text - if(length(stats) > 0) { - text(x = stats.data[,1], - y = stats.data[,2], - pos = 2, - labels = round(stats.data[,3], 1), - family = layout$abanico$font.type$stats, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$stats)[1], - cex = cex * layout$abanico$font.size$stats/12, - col = layout$abanico$colour$stats) - } - - ## optionally add rug - if(rug == TRUE) { - for(i in 1:length(rug.coords)) { - lines(x = rug.coords[[i]][1,], - y = rug.coords[[i]][2,], - col = value.rug[data.global[i,10]]) - } - } - - ## plot KDE base line - lines(x = c(xy.0[1], xy.0[1]), - y = c(min(ellipse[,2]), max(ellipse[,2])), - col = layout$abanico$colour$border) - - ## draw border around plot - if(frame == 1) { - polygon(x = c(limits.x[1], min(ellipse[,1]), par()$usr[2], - par()$usr[2], min(ellipse[,1])), - y = c(0, max(ellipse[,2]), max(ellipse[,2]), - min(ellipse[,2]), min(ellipse[,2])), - border = layout$abanico$colour$border, - lwd = 0.8) - } else if(frame == 2) { - polygon(x = c(limits.x[1], min(ellipse[,1]), par()$usr[2], - par()$usr[2], min(ellipse[,1]), limits.x[1]), - y = c(2, max(ellipse[,2]), max(ellipse[,2]), - min(ellipse[,2]), min(ellipse[,2]), -2), - border = layout$abanico$colour$border, - lwd = 0.8) - } else if(frame == 3) { - polygon(x = c(limits.x[1], par()$usr[2], - par()$usr[2], limits.x[1]), - y = c(max(ellipse[,2]), max(ellipse[,2]), - min(ellipse[,2]), min(ellipse[,2])), - border = layout$abanico$colour$border, - lwd = 0.8) - } - - ## optionally add legend content - if(!missing(legend)) { - ## store and change font family - par.family <- par()$family - par(family = layout$abanico$font.type$legend) - - legend(x = legend.pos[1], - y = 0.8 * legend.pos[2], - xjust = legend.adj[1], - yjust = legend.adj[2], - legend = legend, - pch = pch, - col = value.dot, - text.col = value.dot, - text.font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$legend)[1], - cex = cex * layout$abanico$font.size$legend/12, - bty = "n") - - ## restore font family - par(family = par.family) - } - - ## optionally add subheader text - mtext(text = mtext, - side = 3, - line = (shift.lines - 2) * layout$abanico$dimension$mtext / 100, - col = layout$abanico$colour$mtext, - family = layout$abanico$font.type$mtext, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$mtext)[1], - cex = cex * layout$abanico$font.size$mtext / 12) - - ## add summary content - for(i in 1:length(data)) { - if(summary.pos[1] != "sub") { - text(x = summary.pos[1], - y = summary.pos[2], - adj = summary.adj, - labels = label.text[[i]], - col = summary.col[i], - family = layout$abanico$font.type$summary, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$summary)[1], - cex = cex * layout$abanico$font.size$summary / 12) - } else { - if(mtext == "") { - mtext(side = 3, - line = (shift.lines- 1 - i) * - layout$abanico$dimension$summary / 100 , - text = label.text[[i]], - col = summary.col[i], - family = layout$abanico$font.type$summary, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$summary)[1], - cex = cex * layout$abanico$font.size$summary / 12) - } - } - } - } else { - ## setup plot area - par(mar = c(4, 4, shift.lines + 5, 4), - xpd = TRUE, - cex = cex) - - if(layout$abanico$dimension$figure.width != "auto" | - layout$abanico$dimension$figure.height != "auto") { - par(mai = layout$abanico$dimension$margin / 25.4, - pin = c(layout$abanico$dimension$figure.width / 25.4 - - layout$abanico$dimension$margin[2] / 25.4 - - layout$abanico$dimension$margin[4] / 25.4, - layout$abanico$dimension$figure.height / 25.4 - - layout$abanico$dimension$margin[1] / 25.4 - - layout$abanico$dimension$margin[3]/25.4)) - } - - ## create empty plot - par(new = TRUE) - plot(NA, - xlim = limits.y, - ylim = c(limits.x[1], limits.x[2] * (1 / plot.ratio)), - main = "", - sub = sub, - xlab = "", - ylab = "", - xaxs = "i", - yaxs = "i", - frame.plot = FALSE, - axes = FALSE) - - ## add y-axis label - mtext(text = ylab, - at = 0, - adj = 0.5, - side = 1, - line = 3 * layout$abanico$dimension$ylab.line / 100, - col = layout$abanico$colour$ylab, - family = layout$abanico$font.type$ylab, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$ylab)[1], - cex = cex * layout$abanico$font.size$ylab/12) - - ## calculate upper x-axis label values - label.x.upper <- if(log.z == TRUE) { - as.character(round(1/axTicks(side = 2)[-1] * 100, 1)) - } else { - as.character(round(1/axTicks(side = 2)[-1], 1)) - } - - # optionally, plot 2-sigma-bar - if(bar[1] != FALSE) { - for(i in 1:length(bar)) { - polygon(x = bars[i,1:4], - y = bars[i,5:8], - col = bar.fill[i], - border = bar.line[i]) - } - } - - ## remove unwanted parts - polygon(y = c(par()$usr[2], - par()$usr[2], - par()$usr[2] * 2, - par()$usr[2] * 2), - x = c(min(ellipse[,2]) * 2, - max(ellipse[,2]) * 2, - max(ellipse[,2]) * 2, - min(ellipse[,2]) * 2), - col = bg.original, - lty = 0) - - ## optionally, plot dispersion polygon - if(polygon.fill[1] != "none") { - for(i in 1:length(data)) { - polygon(x = polygons[i,8:14], - y = polygons[i,1:7], - col = polygon.fill[i], - border = polygon.line[i]) - } - } - - ## optionally, add minor grid lines - if(grid.minor != "none") { - for(i in 1:length(tick.values.minor)) { - lines(y = c(limits.x[1], min(ellipse[,1])), - x = c(0, (tick.values.minor[i] - z.central.global) * min(ellipse[,1])), - col = grid.minor, - lwd = 1) - } - for(i in 1:length(tick.values.minor)) { - lines(y = c(xy.0[2], par()$usr[2]), - x = c((tick.values.minor[i] - z.central.global) * min(ellipse[,1]), - (tick.values.minor[i] - z.central.global) * min(ellipse[,1])), - col = grid.minor, - lwd = 1) - } - } - - ## optionally, add major grid lines - if(grid.major != "none") { - for(i in 1:length(tick.values.major)) { - lines(y = c(limits.x[1], min(ellipse[,2])), - x = c(0, (tick.values.major[i] - z.central.global) * min(ellipse[,2])), - col = grid.major, - lwd = 1) - } - for(i in 1:length(tick.values.major)) { - lines(y = c(xy.0[2],y.max), - x = c((tick.values.major[i] - z.central.global) * min(ellipse[,2]), - (tick.values.major[i] - z.central.global) * min(ellipse[,2])), - col = grid.major, - lwd = 1) - } - } - - ## optionally, plot lines for each bar - if(lwd[1] > 0 & lty[1] > 0 & bar[1] != FALSE & length(data) == 1) { - if(bar[1] == TRUE & length(bar) == 1) { - bar[1] <- z.central.global - } - for(i in 1:length(bar)) { - x2 <- r / sqrt(1 + f^2 * ( - bar[i] - z.central.global)^2) - y2 <- (bar[i] - z.central.global) * x2 - lines(x = c(0, y2, y2, y2), - y = c(limits.x[1], x2, xy.0[2], par()$usr[4]), - lty = lty[i], - lwd = lwd[i], - col = centrality.col[i]) - } - } - - ## optionally add further lines - if(missing(line) == FALSE) { - for(i in 1:length(line)) { - lines(y = line.coords[[i]][1,1:3], - x = line.coords[[i]][2,1:3], - col = line.col[i], - lty = line.lty[i] - ) - text(y = line.coords[[i]][1,3], - x = line.coords[[i]][2,3] + par()$cxy[2] * 0.3, - labels = line.label[i], - pos = 2, - col = line.col[i], - cex = cex * 0.9) - } - } - - ## add plot title - cex.old <- par()$cex - par(cex = layout$abanico$font.size$main / 12) - title(main = main, - family = layout$abanico$font.type$main, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$main)[1], - col.main = layout$abanico$colour$main, - line = (shift.lines + 3.5) * layout$abanico$dimension$main / 100) - par(cex = cex.old) - - ## calculate lower x-axis (precision) - x.axis.ticks <- axTicks(side = 2) - x.axis.ticks <- x.axis.ticks[c(TRUE, x.axis.ticks <= limits.x[2])] - x.axis.ticks <- x.axis.ticks[x.axis.ticks <= max(ellipse[,2])] - - ## x-axis with lables and ticks - axis(side = 2, - at = x.axis.ticks, - col = layout$abanico$colour$xtck1, - col.axis = layout$abanico$colour$xtck1, - labels = NA, - tcl = -layout$abanico$dimension$xtcl1 / 200, - cex = cex) - axis(side = 2, - at = x.axis.ticks, - line = 2 * layout$abanico$dimension$xtck1.line / 100 - 2, - lwd = 0, - col = layout$abanico$colour$xtck1, - family = layout$abanico$font.type$xtck1, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$xtck1)[1], - col.axis = layout$abanico$colour$xtck1, - cex.axis = layout$abanico$font.size$xlab1/12) - - ## extend axis line to right side of the plot - lines(y = c(max(x.axis.ticks), max(ellipse[,2])), - x = c(limits.y[1], limits.y[1]), - col = layout$abanico$colour$xtck1) - - ## draw closing tick on right hand side - axis(side = 2, - tcl = -layout$abanico$dimension$xtcl1 / 200, - lwd = 0, - lwd.ticks = 1, - at = limits.x[2], - labels = FALSE, - col = layout$abanico$colour$xtck1) - - axis(side = 2, - tcl = layout$abanico$dimension$xtcl2 / 200, - lwd = 0, - lwd.ticks = 1, - at = limits.x[2], - labels = FALSE, - col = layout$abanico$colour$xtck2) - - ## add lower axis label - mtext(xlab[2], - at = (limits.x[1] + max(ellipse[,2])) / 2, - side = 2, - line = 2.5 * layout$abanico$dimension$xlab1.line / 100, - col = layout$abanico$colour$xlab1, - family = layout$abanico$font.type$xlab1, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$xlab1)[1], - cex = cex * layout$abanico$font.size$xlab1/12) - - ## add upper axis label - mtext(xlab[1], - at = (limits.x[1] + max(ellipse[,2])) / 2, - side = 2, - line = -3.5 * layout$abanico$dimension$xlab2.line / 100, - col = layout$abanico$colour$xlab2, - family = layout$abanico$font.type$xlab2, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$xlab2)[1], - cex = cex * layout$abanico$font.size$xlab2/12) - - ## plot upper x-axis - axis(side = 2, - at = x.axis.ticks[-1], - col = layout$abanico$colour$xtck2, - col.axis = layout$abanico$colour$xtck2, - labels = NA, - tcl = layout$abanico$dimension$xtcl2 / 200, - cex = cex) - - ## remove first tick label (infinity) - label.x.upper <- label.x.upper[1:(length(x.axis.ticks) - 1)] - - axis(side = 2, - at = x.axis.ticks[-1], - labels = label.x.upper, - line = -1 * layout$abanico$dimension$xtck2.line / 100 - 2, - lwd = 0, - col = layout$abanico$colour$xtck2, - family = layout$abanico$font.type$xtck2, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$xtck2)[1], - col.axis = layout$abanico$colour$xtck2, - cex.axis = layout$abanico$font.size$xlab2/12) - - ## plot y-axis - if(y.axis == TRUE) { - char.height <- par()$cxy[2] - tick.space <- axisTicks(usr = limits.y, log = FALSE) - tick.space <- (max(tick.space) - min(tick.space)) / length(tick.space) - if(tick.space < char.height * 1.7) { - axis(side = 1, - tcl = -layout$abanico$dimension$ytcl / 200, - lwd = 1, - lwd.ticks = 1, - at = c(-2, 2), - labels = c("", ""), - las = 1, - col = layout$abanico$colour$ytck) - - axis(side = 1, - at = 0, - tcl = 0, - line = 2 * layout$abanico$dimension$ytck.line / 100 - 2, - labels = paste("\u00B1", "2"), - las = 1, - family = layout$abanico$font.type$ytck, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$ytck)[1], - col.axis = layout$abanico$colour$ytck, - cex.axis = layout$abanico$font.size$ylab/12) - } else { - axis(side = 1, - at = seq(-2, 2, by = 2), - col = layout$abanico$colour$ytck, - col.axis = layout$abanico$colour$ytck, - labels = NA, - las = 1, - tcl = -layout$abanico$dimension$ytcl / 200, - cex = cex) - axis(side = 1, - at = seq(-2, 2, by = 2), - line = 2 * layout$abanico$dimension$ytck.line / 100 - 2, - lwd = 0, - las = 1, - col = layout$abanico$colour$ytck, - family = layout$abanico$font.type$ytck, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$ytck)[1], - col.axis = layout$abanico$colour$ytck, - cex.axis = layout$abanico$font.size$ylab/12) - } - } else { - axis(side = 1, - at = 0, - col = layout$abanico$colour$ytck, - col.axis = layout$abanico$colour$ytck, - labels = NA, - las = 1, - tcl = -layout$abanico$dimension$ytcl / 200, - cex = cex) - axis(side = 1, - at = 0, - line = 2 * layout$abanico$dimension$ytck.line / 100 - 2, - lwd = 0, - las = 1, - col = layout$abanico$colour$ytck, - family = layout$abanico$font.type$ytck, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$ytck)[1], - col.axis = layout$abanico$colour$ytck, - cex.axis = layout$abanico$font.size$ylab/12) - } - - ## plot minor z-ticks - for(i in 1:length(tick.values.minor)) { - lines(y = c(par()$usr[4], - (1 + 0.015 * cex * layout$abanico$dimension$ztcl / 100) * - y.max), - x = c((tick.values.minor[i] - z.central.global) * - min(ellipse[,2]), - (tick.values.minor[i] - z.central.global) * - min(ellipse[,2])), - col = layout$abanico$colour$ztck) - } - - ## plot major z-ticks - for(i in 1:length(tick.values.major)) { - lines(y = c(par()$usr[4], - (1 + 0.03 * cex * layout$abanico$dimension$ztcl / 100) * - y.max), - x = c((tick.values.major[i] - z.central.global) * - min(ellipse[,2]), - (tick.values.major[i] - z.central.global) * - min(ellipse[,2])), - col = layout$abanico$colour$ztck) - } - - ## plot z-axes - lines(ellipse, col = layout$abanico$colour$border) - lines(y = rep(par()$usr[4], nrow(ellipse)), - x = ellipse[,1], - col = layout$abanico$colour$ztck) - - ## plot z-axis text - text(y = (1 + 0.06 * cex * layout$abanico$dimension$ztcl / 100) * - y.max, - x = (tick.values.major - z.central.global) * min(ellipse[,2]), - labels = label.z.text, - adj = 0.5, - family = layout$abanico$font.type$ztck, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$ztck)[1], - cex = cex * layout$abanico$font.size$ztck/12) - - ## plot z-label - mtext(text = zlab, - at = 0, - side = 3, - las = 1, - adj = 0.5, - line = 2.5 * layout$abanico$dimension$zlab.line / 100, - col = layout$abanico$colour$zlab, - family = layout$abanico$font.type$zlab, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$zlab)[1], - cex = cex * layout$abanico$font.size$zlab/12) - - ## plot values and optionally error bars - if(error.bars == TRUE) { - for(i in 1:length(data)) { - arrows(y0 = arrow.coords[[i]][,1], - y1 = arrow.coords[[i]][,2], - x0 = arrow.coords[[i]][,3], - x1 = arrow.coords[[i]][,4], - length = 0, - angle = 90, - code = 3, - col = value.bar[i]) - } - } - - for(i in 1:length(data)) { - points(y = data[[i]][,6][data[[i]][,6] <= limits.x[2]], - x = data[[i]][,8][data[[i]][,6] <= limits.x[2]], - col = value.dot[i], - pch = pch[i], - cex = layout$abanico$dimension$pch / 100) - } - - ## calculate KDE width - KDE.max <- 0 - - for(i in 1:length(data)) { - KDE.max <- ifelse(test = KDE.max < max(KDE[[i]][,2]), - yes = max(KDE[[i]][,2]), - no = KDE.max) - } - - ## optionally adjust KDE width for boxplot option - if(boxplot == TRUE) { - - KDE.max <- 1.3 * KDE.max - } - - KDE.scale <- (par()$usr[4] - xy.0[2]) / (KDE.max * 1.05) - - ## optionally add KDE plot - if(kde == TRUE) { - - ## plot KDE lines - for(i in 1:length(data)) { - polygon(y = xy.0[2] + KDE[[i]][,2] * KDE.scale, - x = (KDE[[i]][,1] - z.central.global) * min(ellipse[,2]), - col = kde.fill[i], - border = kde.line[i], - lwd = 1.7) - } - - ## plot KDE x-axis - axis(side = 2, - at = c(xy.0[2], y.max), - col = layout$abanico$colour$xtck3, - col.axis = layout$abanico$colour$xtck3, - labels = NA, - tcl = -layout$abanico$dimension$xtcl3 / 200, - cex = cex) - - axis(side = 2, - at = c(xy.0[2], y.max), - labels = as.character(round(c(0, KDE.max.plot), 3)), - line = 2 * layout$abanico$dimension$xtck3.line / 100 - 2, - lwd = 0, - col = layout$abanico$colour$xtck3, - family = layout$abanico$font.type$xtck3, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$xtck3)[1], - col.axis = layout$abanico$colour$xtck3, - cex.axis = layout$abanico$font.size$xtck3/12) - - mtext(text = paste(xlab[3], - " (bw ", - round(x = KDE.bw, - digits = 3), - ")", - sep = ""), - at = (xy.0[2] + y.max) / 2, - side = 2, - line = 2.5 * layout$abanico$dimension$xlab3.line / 100, - col = layout$abanico$colour$xlab3, - family = layout$abanico$font.type$xlab3, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$xlab3)[1], - cex = cex * layout$abanico$font.size$xlab3/12) - } - - ## optionally add histogram or dot plot axis - if(hist == TRUE) { - axis(side = 2, - at = c(xy.0[2], y.max), - labels = as.character(c(0, hist.max.plot)), - line = -1 * layout$abanico$dimension$xtck3.line / 100 - 2, - lwd = 0, - col = layout$abanico$colour$xtck3, - family = layout$abanico$font.type$xtck3, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$xtck3)[1], - col.axis = layout$abanico$colour$xtck3, - cex.axis = layout$abanico$font.size$xtck3/12) - - ## add label - mtext(text = "n", - at = (xy.0[2] + y.max) / 2, - side = 2, - line = -3.5 * layout$abanico$dimension$xlab2.line / 100, - col = layout$abanico$colour$xlab2, - family = layout$abanico$font.type$xlab2, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$xlab2)[1], - cex = cex * layout$abanico$font.size$xlab2/12) - - ## plot ticks - axis(side = 2, - at = c(xy.0[2], y.max), - col = layout$abanico$colour$xtck2, - col.axis = layout$abanico$colour$xtck2, - labels = NA, - tcl = layout$abanico$dimension$xtcl2 / 200, - cex = cex) - - ## calculate scaling factor for histogram bar heights - hist.scale <- (par()$usr[4] - xy.0[2]) / (KDE.max.plot * 1.05) - - ## draw each bar for each data set - for(i in 1:length(data)) { - for(j in 1:length(hist.data[[i]]$density)) { - ## calculate x-coordinates - hist.x.i <- c(xy.0[2], - xy.0[2], - xy.0[2] + hist.data[[i]]$density[j] * hist.scale, - xy.0[2] + hist.data[[i]]$density[j] * hist.scale) - - ## calculate y-coordinates - hist.y.i <- c((hist.data[[i]]$breaks[j] - z.central.global) * - min(ellipse[,2]), - (hist.data[[i]]$breaks[j + 1] - z.central.global) * - min(ellipse[,2]), - (hist.data[[i]]$breaks[j + 1] - z.central.global) * - min(ellipse[,2]), - (hist.data[[i]]$breaks[j] - z.central.global) * - min(ellipse[,2])) - - ## remove data out of z-axis range - hist.y.i <- ifelse(hist.y.i < min(ellipse[,1]), - min(ellipse[,1]), - hist.y.i) - hist.y.i <- ifelse(hist.y.i > max(ellipse[,1]), - max(ellipse[,1]), - hist.y.i) - - ## draw the bars - polygon(y = hist.x.i, - x = hist.y.i, - col = kde.fill[i], - border = kde.line[i]) - } - } - } - - ## optionally add dot plot - if(dots == TRUE) { - for(i in 1:length(data)) { - for(j in 1:length(hist.data[[i]]$counts)) { - - ## calculate scaling factor for histogram bar heights - dots.distance <- (par()$usr[4] - (xy.0[2] + par()$cxy[1] * 0.4)) / hist.max.plot - - dots.x.i <- seq(from = xy.0[2] + par()$cxy[2] * 0.4, - by = dots.distance, - length.out = hist.data[[i]]$counts[j]) - - dots.y.i <- rep((hist.data[[i]]$mids[j] - z.central.global) * - min(ellipse[,2]), length(dots.x.i)) - - ## remove data out of z-axis range - dots.x.i <- dots.x.i[dots.y.i >= min(ellipse[,1]) & - dots.y.i <= max(ellipse[,1])] - dots.y.i <- dots.y.i[dots.y.i >= min(ellipse[,1]) & - dots.y.i <= max(ellipse[,1])] - - if(max(c(0, dots.x.i), na.rm = TRUE) >= (par()$usr[4] - - par()$cxy[2] * 0.4)) { - dots.y.i <- dots.y.i[dots.x.i < (par()$usr[4] - par()$cxy[2] * 0.4)] - dots.x.i <- dots.x.i[dots.x.i < (par()$usr[4] - par()$cxy[2] * 0.4)] - pch.dots <- c(rep(20, length(dots.x.i) - 1), 15) - } else { - pch.dots <- rep(20, length(dots.x.i)) - } - - ## plot points - points(y = dots.x.i, - x = dots.y.i, - pch = "-", - cex = 0.7 * cex, - col = kde.line[i]) - } - } - } - - ## optionally add box plot - if(boxplot == TRUE) { - - for(i in 1:length(data)) { - - ## draw median line - lines(x = c((boxplot.data[[i]]$stats[3,1] - z.central.global) * - min(ellipse[,2]), - (boxplot.data[[i]]$stats[3,1] - z.central.global) * - min(ellipse[,2])), - y = c(min(ellipse[,2]) + KDE.max * 0.91, - xy.0[2] + KDE.max * 0.96), - lwd = 2, - col = kde.line[i]) - - ## draw p25-p75-polygon - polygon(y = c(min(ellipse[,2]) + KDE.max * 0.91, - min(ellipse[,2]) + KDE.max * 0.91, - xy.0[2] + KDE.max * 0.96, - xy.0[2] + KDE.max * 0.96), - x = c((boxplot.data[[i]]$stats[2,1] - z.central.global) * - min(ellipse[,2]), - (boxplot.data[[i]]$stats[4,1] - z.central.global) * - min(ellipse[,2]), - (boxplot.data[[i]]$stats[4,1] - z.central.global) * - min(ellipse[,2]), - (boxplot.data[[i]]$stats[2,1] - z.central.global) * - min(ellipse[,2])), - border = kde.line[i]) - - ## draw whiskers - lines(y = rep(mean(c(min(ellipse[,2]) + KDE.max * 0.91, - xy.0[2] + KDE.max * 0.96)), 2), - x = c((boxplot.data[[i]]$stats[2,1] - z.central.global) * - min(ellipse[,2]), - (boxplot.data[[i]]$stats[1,1] - z.central.global) * - min(ellipse[,2])), - col = kde.line[i]) - - lines(y = c(min(ellipse[,2]) + KDE.max * 0.91, - xy.0[2] + KDE.max * 0.96), - x = rep((boxplot.data[[i]]$stats[1,1] - z.central.global) * - min(ellipse[,2]), 2), - col = kde.line[i]) - - lines(y = rep(mean(c(min(ellipse[,2]) + KDE.max * 0.91, - xy.0[2] + KDE.max * 0.96)), 2), - x = c((boxplot.data[[i]]$stats[4,1] - z.central.global) * - min(ellipse[,2]), - (boxplot.data[[i]]$stats[5,1] - z.central.global) * - min(ellipse[,2])), - col = kde.line[i]) - - lines(y = c(min(ellipse[,2]) + KDE.max * 0.91, - xy.0[2] + KDE.max * 0.96), - x = rep((boxplot.data[[i]]$stats[5,1] - z.central.global) * - min(ellipse[,2]), 2), - col = kde.line[i]) - - ## draw outlier points - points(y = rep(mean(c(min(ellipse[,2]) + KDE.max * 0.91, - xy.0[2] + KDE.max * 0.96)), - length(boxplot.data[[i]]$out)), - x = (boxplot.data[[i]]$out - z.central.global) * - min(ellipse[,2]), - cex = cex * 0.8, - col = kde.line[i]) - } - } - - ## optionally add stats, i.e. min, max, median sample text - if(length(stats) > 0) { - text(y = stats.data[,1], - x = stats.data[,2], - pos = 2, - labels = round(stats.data[,3], 1), - family = layout$abanico$font.type$stats, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$stats)[1], - cex = cex * layout$abanico$font.size$stats/12, - col = layout$abanico$colour$stats) - } - - ## optionally add rug - if(rug == TRUE) { - for(i in 1:length(rug.coords)) { - lines(y = rug.coords[[i]][1,], - x = rug.coords[[i]][2,], - col = value.rug[data.global[i,10]]) - } - } - - ## plot KDE base line - lines(y = c(xy.0[2], xy.0[2]), - x = c(min(ellipse[,1]), max(ellipse[,1])), - col = layout$abanico$colour$border) - - ## draw border around plot - polygon(y = c(limits.x[1], min(ellipse[,2]), y.max, - y.max, min(ellipse[,2])), - x = c(0, max(ellipse[,1]), max(ellipse[,1]), - min(ellipse[,1]), min(ellipse[,1])), - border = layout$abanico$colour$border, - lwd = 0.8) - - ## optionally add legend content - if(missing(legend) == FALSE) { - ## store and change font familiy - par.family <- par()$family - par(family = layout$abanico$font.type$legend) - - legend(y = legend.pos[2], - x = 0.8 * legend.pos[1], - xjust = legend.adj[2], - yjust = legend.adj[1], - legend = legend, - pch = pch, - col = value.dot, - text.col = value.dot, - text.font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$legend)[1], - cex = cex * layout$abanico$font.size$legend/12, - bty = "n") - - ## restore font family - par(family = par.family) - } - - ## optionally add subheader text - mtext(text = mtext, - side = 3, - line = (shift.lines - 2 + 3.5) * layout$abanico$dimension$mtext / 100, - col = layout$abanico$colour$mtext, - family = layout$abanico$font.type$mtext, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$mtext)[1], - cex = cex * layout$abanico$font.size$mtext / 12) - - ## add summary content - for(i in 1:length(data)) { - if(summary.pos[1] != "sub") { - text(x = summary.pos[1], - y = summary.pos[2], - adj = summary.adj, - labels = label.text[[i]], - col = summary.col[i], - family = layout$abanico$font.type$summary, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$summary)[1], - cex = cex * layout$abanico$font.size$summary / 12) - } else { - if(mtext == "") { - mtext(side = 3, - line = (shift.lines - 1 + 3.5 - i) * - layout$abanico$dimension$summary / 100 , - text = label.text[[i]], - col = summary.col[i], - family = layout$abanico$font.type$summary, - font = which(c("normal", "bold", "italic", "bold italic") == - layout$abanico$font.deco$summary)[1], - cex = cex * layout$abanico$font.size$summary / 12) - } - } - } - } - - ##sTeve - if (fun && !interactive) sTeve() # nocov - - ## create numeric output - plot.output <- list(xlim = limits.x, - ylim = limits.y, - zlim = limits.z, - polar.box = c(limits.x[1], - limits.x[2], - min(ellipse[,2]), - max(ellipse[,2])), - cartesian.box = c(xy.0[1], - par()$usr[2], - xy.0[2], - max(ellipse[,2])), - plot.ratio = plot.ratio, - data = data, - data.global = data.global, - KDE = KDE, - par = par(no.readonly = TRUE)) - - ## INTERACTIVE PLOT ---------------------------------------------------------- - if (interactive) { - if (!requireNamespace("plotly", quietly = TRUE)) - # nocov start - .throw_error("The interactive abanico plot requires the 'plotly' ", - "package. To install it, run 'install.packages('plotly')' ", - "in your R console.") - # nocov end - - ##cheat R check (global visible binding error) - x <- NA - y <- NA - - ## tidy data ---- - data <- plot.output - kde <- data.frame(x = data$KDE[[1]][ ,2], y = data$KDE[[1]][ ,1]) - - # radial scatter plot ---- - point.text <- paste0("Measured value:
", - data$data.global$De, " ± ", - data$data.global$error, "
", - "P(",format(data$data.global$precision, digits = 2, nsmall = 1),", ", - format(data$data.global$std.estimate, digits = 2, nsmall = 1),")") - IAP <- plotly::plot_ly(data = data$data.global, - x = data$data.global$precision, - y = data$data.global$std.estimate, - type = "scatter", mode = "markers", - hoverinfo = "text", text = point.text, - name = "Points", - yaxis = "y") - - ellipse <- as.data.frame(ellipse) - IAP <- plotly::add_trace(IAP, data = ellipse, - x = ~ellipse.x, y = ~ellipse.y, - type = "scatter", mode = "lines", - hoverinfo = "none", text = "", - name = "z-axis (left)", - line = list(color = "black", - width = 1), - yaxis = "y") - - ellipse.right <- ellipse - ellipse.right$ellipse.x <- ellipse.right$ellipse.x * 1/0.75 - - IAP <- plotly::add_trace(IAP, data = ellipse.right, - x = ~ellipse.x, y = ~ellipse.y, - type = "scatter", mode = "lines", - hoverinfo = "none", text = "", - name = "z-axis (right)", - line = list(color = "black", - width = 1), - yaxis = "y") - - # z-axis ticks - major.ticks.x <- c(data$xlim[2] * 1/0.75, - (1 + 0.015 * layout$abanico$dimension$ztcl / 100) * - data$xlim[2] * 1/0.75) - minor.ticks.x <- c(data$xlim[2] * 1/0.75, - (1 + 0.01 * layout$abanico$dimension$ztcl / 100) * - data$xlim[2] * 1/0.75) - major.ticks.y <- (tick.values.major - z.central.global) * min(ellipse[ ,1]) - minor.ticks.y <- (tick.values.minor - z.central.global) * min(ellipse[ ,1]) - - # major z-tick lines - for (i in 1:length(major.ticks.y)) { - major.tick <- data.frame(x = major.ticks.x, y = rep(major.ticks.y[i], 2)) - IAP <- plotly::add_trace(IAP, data = major.tick, - x = ~x, y = ~y, showlegend = FALSE, - type = "scatter", mode = "lines", - hoverinfo = "none", text = "", - line = list(color = "black", - width = 1), - yaxis = "y") - } - - # minor z-tick lines - for (i in 1:length(minor.ticks.y)) { - minor.tick <- data.frame(x = minor.ticks.x, y = rep(minor.ticks.y[i], 2)) - IAP <- plotly::add_trace(IAP, data = minor.tick, - x = ~x, y = ~y, showlegend = FALSE, - type = "scatter", mode = "lines", - hoverinfo = "none", text = "", - line = list(color = "black", - width = 1), - yaxis = "y") - } - - # z-tick label - tick.text <- paste(" ", exp(tick.values.major)) - tick.pos <- data.frame(x = major.ticks.x[2], - y = major.ticks.y) - - IAP <- plotly::add_trace(IAP, data = tick.pos, - x = ~x, y = ~y, showlegend = FALSE, - hoverinfo = "none", - text = tick.text, textposition = "right", - type = "scatter", mode = "text", - yaxis = "y") - - # Central Line ---- - central.line <- data.frame(x = c(-100, data$xlim[2]*1/0.75), y = c(0, 0)) - central.line.text <- paste0("Central value: ", - format(exp(z.central.global), digits = 2, nsmall = 1)) - - IAP <- plotly::add_trace(IAP, data = central.line, - x = ~x, y = ~y, name = "Central line", - type = "scatter", mode = "lines", - hoverinfo = "text", text = central.line.text, - yaxis = "y", - line = list(color = "black", - width = 0.5, - dash = 2)) - - # KDE plot ---- - KDE.x <- xy.0[1] + KDE[[1]][ ,2] * KDE.scale - KDE.y <- (KDE[[1]][ ,1] - z.central.global) * min(ellipse[,1]) - KDE.curve <- data.frame(x = KDE.x, y = KDE.y) - KDE.curve <- KDE.curve[KDE.curve$x != xy.0[1], ] - KDE.text <- paste0("Value:", - format(exp(KDE.curve$x), digits = 2, nsmall = 1), "
", - "Density:", - format(KDE.curve$y, digits = 2, nsmall = 1)) - - IAP <- plotly::add_trace(IAP, data = KDE.curve, - x = ~x, y = ~y, name = "KDE", - type = "scatter", mode = "lines", - hoverinfo = "text", - text = KDE.text, - line = list(color = "red"), - yaxis = "y") - - # set layout ---- - IAP <- plotly::layout(IAP, - hovermode = "closest", - dragmode = "pan", - xaxis = list(range = c(data$xlim[1], data$xlim[2] * 1/0.65), - zeroline = FALSE, - showgrid = FALSE, - tickmode = "array", - tickvals = x.axis.ticks), - yaxis = list(range = data$ylim, - zeroline = FALSE, - showline = FALSE, - showgrid = FALSE, - tickmode = "array", - tickvals = c(-2, 0, 2)), - shapes = list(list(type = "rect", # 2 sigma bar - x0 = 0, y0 = -2, - x1 = bars[1,3], y1 = 2, - xref = "x", yref = "y", - fillcolor = "grey", - opacity = 0.2)) - ) - - # show and return interactive plot ---- - #print(plotly::subplot(IAP, IAP.kde)) - print(IAP) - return(IAP) - } - - ## restore initial cex - par(cex = cex_old) - - ## create and return numeric output - invisible(plot.output) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_DRCSummary.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_DRCSummary.R deleted file mode 100644 index 4a076ac20..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_DRCSummary.R +++ /dev/null @@ -1,293 +0,0 @@ -#'Create a Dose-Response Curve Summary Plot -#' -#'While analysing OSL SAR or pIRIR-data the view on the data is limited usually to one -#'dose-response curve (DRC) at the time for one aliquot. This function overcomes this limitation -#'by plotting all DRC from an [RLum.Results-class] object created by the function [analyse_SAR.CWOSL] -#'in one single plot. -#' -#'If you want plot your DRC on an energy scale (dose in Gy), you can either use the option `source_dose_rate` provided -#'below or your can SAR analysis with the dose points in Gy (better axis scaling). -#' -#'@param object [RLum.Results-class] object (**required**): input object created by the function [analyse_SAR.CWOSL]. The input object can be provided as [list]. -#' -#'@param source_dose_rate [numeric] (*optional*): allows to modify the axis and show values in Gy, instead seconds. Only a single numerical value is allowed. -#' -#'@param sel_curves [numeric] (optional): id of the curves to be plotting in its occurring order. A sequence can -#'be provided for selecting, e.g., only every 2nd curve from the input object -#' -#'@param show_dose_points [logical] (with default): enable or disable plot of dose points in the graph -#' -#'@param show_natural [logical] (with default): enable or disable the plot of the natural `Lx/Tx` values -#' -#'@param n [integer] (with default): the number of x-values used to evaluate one curve object. Large numbers slow -#'down the plotting process and are usually not needed -#' -#'@param ... Further arguments and graphical parameters to be passed. In particular: `main`, `xlab`, `ylab`, `xlim`, `ylim`, `lty`, `lwd`, `pch`, `col.pch`, `col.lty`, `mtext` -#' -#'@section Function version: 0.2.3 -#' -#'@return An [RLum.Results-class] object is returned: -#' -#' Slot: **@data**\cr -#' -#' \tabular{lll}{ -#' **OBJECT** \tab **TYPE** \tab **COMMENT**\cr -#' `results` \tab [data.frame] \tab with dose and LxTx values \cr -#' `data` \tab [RLum.Results-class] \tab original input data \cr -#' } -#' -#' Slot: **@info**\cr -#' -#' \tabular{lll}{ -#' **OBJECT** \tab **TYPE** \tab **COMMENT** \cr -#' `call` \tab `call` \tab the original function call \cr -#' `args` \tab `list` \tab arguments of the original function call \cr -#' } -#' -#'*Note: If the input object is a [list] a list of [RLum.Results-class] objects is returned.* -#' -#'@author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) \cr -#' Christoph Burow, University of Cologne (Germany) -#' -#'@seealso [RLum.Results-class], [analyse_SAR.CWOSL] -#' -#'@examples -#' -#'#load data example data -#'data(ExampleData.BINfileData, envir = environment()) -#' -#'#transform the values from the first position in a RLum.Analysis object -#'object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) -#' -##perform SAR analysis -#' results <- analyse_SAR.CWOSL( -#' object = object, -#' signal.integral.min = 1, -#' signal.integral.max = 2, -#' background.integral.min = 900, -#' background.integral.max = 1000, -#' plot = FALSE -#' ) -#' -#'##plot only DRC -#'plot_DRCSummary(results) -#' -#'@md -#'@export -plot_DRCSummary <- function( - object, - source_dose_rate = NULL, - sel_curves = NULL, - show_dose_points = FALSE, - show_natural = FALSE, - n = 51L, - ... -){ - - -# Self-call ----------------------------------------------------------------------------------- -if(inherits(object, "list")){ - - ##catch ... arguments - plot_settings <- list(...) - - ##expand arguments - if("main" %in% names(list(...))){ - main <- as.list(rep(list(...)[["main"]], length(object))) - - ##filter main from the ... argument list otherwise we will have a collusion - plot_settings["main" %in% names(plot_settings)] <- NULL - - }else{ - main <- as.list(rep("DRC", length(object))) - } - - results <- lapply(1:length(object), function(o){ - plot_DRCSummary( - object = object[[o]], - source_dose_rate = source_dose_rate, - sel_curves = sel_curves, - show_dose_points = show_dose_points, - show_natural = show_natural, - n = n, - main = main[[o]], - ... = plot_settings - ) - }) - - ##return merged object - return(results) - -} - -# Check input --------------------------------------------------------------------------------- - if(!inherits(object, "RLum.Results")) - .throw_error("'object' is not of class 'RLum.Results'") - -# Extract data from object -------------------------------------------------------------------- - ##get data from RLum.Results object - if(object@originator %in% c("analyse_SAR.CWOSL", "analyse_pIRIRSequence")){ - ##set limit - if(is.null(sel_curves)){ - sel_curves <- 1:length(object@data$Formula) - - }else{ - if(min(sel_curves) < 1 || - max(sel_curves) > length(object@data$Formula) || - length(sel_curves) > length(object@data$Formula)){ - .throw_warning("'sel_curves' out of bounds, reset to full dataset") - sel_curves <- 1:length(object@data$Formula) - } - - } - - ## check the whether the fitting was all the same - if(length(unique(object@data[["data"]][["Fit"]])) != 1) - .throw_error("I can only visualise dose-response curves based ", - "on the same fitting equation") - - ##get DRC - DRC <- object@data$Formula[sel_curves] - - ## check for Lambert W function (we can only do all ) - if(all(object@data$data[["Fit"]] == "LambertW")) - W <- lamW::lambertW0 - - ##get limits for each set - dataset_limits <- matrix( - c(which(object@data$LnLxTnTx.table[["Name"]] == "Natural"), - which(object@data$LnLxTnTx.table[["Name"]] == "Natural")[-1] - 1, nrow(object@data$LnLxTnTx.table)), - ncol = 2) - - ##create list - LxTx <- lapply(1:nrow(dataset_limits), function(x){ - object@data$LnLxTnTx.table[dataset_limits[x,1]:dataset_limits[x,2],] - - })[sel_curves] - - }else{ - .throw_error("'object' was not created by a supported function, ", - "see the manual for allowed originators") - } - -# Plotting ------------------------------------------------------------------------------------ - ##set default - plot_settings <- modifyList(x = list( - xlab = if(is.null(source_dose_rate)) {"Dose [s]"} else {"Dose [Gy]"}, - ylab = expression(L[x]/T[x]), - xlim = c(0,max(vapply(LxTx, function(x){max(x[["Dose"]])}, numeric(1)))), - ylim = if(show_dose_points){ - c(0,max(vapply(LxTx, function(x){max(x[["LxTx"]] + x[["LxTx.Error"]])}, numeric(1)), na.rm = TRUE)) - }else{ - c(0,max(vapply(1:length(LxTx), function(y){ - x <- max(LxTx[[y]][["Dose"]], na.rm = TRUE) - eval(DRC[[y]]) - - },numeric(1)), na.rm = TRUE)) - }, - main = "DRC Summary", - mtext = paste0("n_curves: ",length(sel_curves)), - lty = 1, - lwd = 1, - pch = 20, - col.lty = rgb(0,0,0,0.5), - col.pch = rgb(0,0,0,0.5) - ), val = list(...), keep.null = TRUE) - - ## expand parameters - plot_settings$col.lty <- rep(plot_settings$col.lty, length(sel_curves)) - plot_settings$col.pch <- rep(plot_settings$col.pch, length(sel_curves)) - plot_settings$pch <- rep(plot_settings$pch, length(sel_curves)) - plot_settings$lty <- rep(plot_settings$lty, length(sel_curves)) - - ##create empty plot window - plot( - x = NA, - y = NA, - xlab = plot_settings$xlab, - ylab = plot_settings$ylab, - xlim = plot_settings$xlim, - ylim = plot_settings$ylim, - main = plot_settings$main, - xaxt = "n" - ) - - if(!is.null(plot_settings$mtext)) - mtext(side = 3, text = plot_settings$mtext, cex = 0.8) - - #exchange x-axis if source dose rate is set - if(!is.null(source_dose_rate)){ - axis(side = 1, at = axTicks(side = 1), labels = round(axTicks(side = 1) * source_dose_rate[1],0)) - - }else{ - axis(side = 1) - - } - - for(i in 1:length(sel_curves)){ - ##plot natural - if(show_natural){ - segments(x0 = LxTx[[i]]$Dose[1], x1 = LxTx[[i]]$Dose[1], - y0 = LxTx[[i]]$LxTx[1] - LxTx[[i]]$LxTx.Error[1], - y1 = LxTx[[i]]$LxTx[1] + LxTx[[i]]$LxTx.Error[1], - col = plot_settings$col.pch[[i]]) - points( - x = LxTx[[i]]$Dose[1], - y = LxTx[[i]]$LxTx[1], - col = plot_settings$col.pch[[i]], - pch = plot_settings$pch[[i]] - ) - } - - ##plot dose points - if(show_dose_points){ - segments(x0 = LxTx[[i]]$Dose[-1], x1 = LxTx[[i]]$Dose[-1], - y0 = LxTx[[i]]$LxTx[-1] - LxTx[[i]]$LxTx.Error[-1], - y1 = LxTx[[i]]$LxTx[-1] + LxTx[[i]]$LxTx.Error[-1], - col = plot_settings$col.pch[[i]]) - points( - x = LxTx[[i]]$Dose[-1], - y = LxTx[[i]]$LxTx[-1], - col = plot_settings$col.pch[[i]], - pch = plot_settings$pch[[i]] - ) - - } - - ##plot lines - x <- seq(min(plot_settings$xlim),max(plot_settings$xlim), length.out = n) - y <- eval(DRC[[i]]) - - if (any(is.na(y)) || any(is.nan(y))) { - .throw_warning("Dose response curve ", i, - " is NA/NaN and was removed before plotting") - next - } - - lines( - x = x, - y = eval(DRC[[i]]), - col = plot_settings$col.lty[[i]], - lwd = plot_settings$lwd, - lty = plot_settings$lty[[i]] - ) - } - - ## Results ------------------------------------------------------------------- - results <- set_RLum( - class = "RLum.Results", - data = list( - results = data.frame( - dose = x, - sapply(DRC, function(d, n) { eval(d) }, n) - ), - data = object - ), - info = list( - call = sys.call(), - args = as.list(sys.call())[-1]) - ) - - ## Return value -------------------------------------------------------------- - return(results) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_DRTResults.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_DRTResults.R deleted file mode 100644 index b59bdd923..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_DRTResults.R +++ /dev/null @@ -1,751 +0,0 @@ -#' @title Visualise dose recovery test results -#' -#' @description The function provides a standardised plot output for dose recovery test -#' measurements. -#' -#' @details Procedure to test the accuracy of a measurement protocol to reliably -#' determine the dose of a specific sample. Here, the natural signal is erased -#' and a known laboratory dose administered which is treated as unknown. Then -#' the De measurement is carried out and the degree of congruence between -#' administered and recovered dose is a measure of the protocol's accuracy for -#' this sample.\cr -#' In the plot the normalised De is shown on the y-axis, i.e. obtained De/Given Dose. -#' -#' @param values [RLum.Results-class] or [data.frame] (**required**): -#' input values containing at least De and De error. To plot -#' more than one data set in one figure, a `list` of the individual data -#' sets must be provided (e.g. `list(dataset.1, dataset.2)`). -#' -#' @param given.dose [numeric] (*optional*): -#' given dose used for the dose recovery test to normalise data. -#' If only one given dose is provided this given dose is valid for all input -#' data sets (i.e., `values` is a list). Otherwise a given dose for each input -#' data set has to be provided (e.g., `given.dose = c(100,200)`). -#' If `given.dose` in `NULL` the values are plotted without normalisation -#' (might be useful for preheat plateau tests). -#' **Note:** Unit has to be the same as from the input values (e.g., Seconds or -#' Gray). -#' -#' @param error.range [numeric]: -#' symmetric error range in percent will be shown as dashed lines in the plot. -#' Set `error.range` to 0 to void plotting of error ranges. -#' -#' @param preheat [numeric]: -#' optional vector of preheat temperatures to be used for grouping the De values. -#' If specified, the temperatures are assigned to the x-axis. -#' -#' @param boxplot [logical]: -#' optionally plot values, that are grouped by preheat temperature as boxplots. -#' Only possible when `preheat` vector is specified. -#' -#' @param mtext [character]: -#' additional text below the plot title. -#' -#' @param summary [character] (*optional*): -#' adds numerical output to the plot. Can be one or more out of: -#' - `"n"` (number of samples), -#' - `"mean"` (mean De value), -#' - `"weighted$mean"` (error-weighted mean), -#' - `"median"` (median of the De values), -#' - `"sd.rel"` (relative standard deviation in percent), -#' - `"sd.abs"` (absolute standard deviation), -#' - `"se.rel"` (relative standard error) and -#' - `"se.abs"` (absolute standard error) -#' -#' and all other measures returned by the function [calc_Statistics]. -#' -#' @param summary.pos [numeric] or [character] (*with default*): -#' optional position coordinates or keyword (e.g. `"topright"`) -#' for the statistical summary. Alternatively, the keyword `"sub"` may be -#' specified to place the summary below the plot header. However, this latter -#' option in only possible if `mtext` is not used. -#' -#' @param legend [character] vector (*optional*): -#' legend content to be added to the plot. -#' -#' @param legend.pos [numeric] or [character] (*with default*): -#' optional position coordinates or keyword (e.g. `"topright"`) for the -#' legend to be plotted. -#' -#' @param par.local [logical] (*with default*): -#' use local graphical parameters for plotting, e.g. the plot is shown in one -#' column and one row. If `par.local = FALSE`, global parameters are inherited, -#' i.e. parameters provided via `par()` work -#' -#' @param na.rm [logical]: indicating whether `NA` values are -#' removed before plotting from the input data set -#' -#' @param ... further arguments and graphical parameters passed to [plot], supported are: -#' `xlab`, `ylab`, `xlim`, `ylim`, `main`, `cex`, `las` and `pch`` -#' -#' @return A plot is returned. -#' -#' @note -#' Further data and plot arguments can be added by using the appropriate R -#' commands. -#' -#' @section Function version: 0.1.14 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -#' Michael Dietze, GFZ Potsdam (Germany) -#' -#' @seealso [plot] -#' -#' @references -#' Wintle, A.G., Murray, A.S., 2006. A review of quartz optically -#' stimulated luminescence characteristics and their relevance in -#' single-aliquot regeneration dating protocols. Radiation Measurements, 41, -#' 369-391. -#' -#' @keywords dplot -#' -#' @examples -#' -#' ## read example data set and misapply them for this plot type -#' data(ExampleData.DeValues, envir = environment()) -#' -#' ## plot values -#' plot_DRTResults( -#' values = ExampleData.DeValues$BT998[7:11,], -#' given.dose = 2800, -#' mtext = "Example data") -#' -#' ## plot values with legend -#' plot_DRTResults( -#' values = ExampleData.DeValues$BT998[7:11,], -#' given.dose = 2800, -#' legend = "Test data set") -#' -#' ## create and plot two subsets with randomised values -#' x.1 <- ExampleData.DeValues$BT998[7:11,] -#' x.2 <- ExampleData.DeValues$BT998[7:11,] * c(runif(5, 0.9, 1.1), 1) -#' -#' plot_DRTResults( -#' values = list(x.1, x.2), -#' given.dose = 2800) -#' -#' ## some more user-defined plot parameters -#' plot_DRTResults( -#' values = list(x.1, x.2), -#' given.dose = 2800, -#' pch = c(2, 5), -#' col = c("orange", "blue"), -#' xlim = c(0, 8), -#' ylim = c(0.85, 1.15), -#' xlab = "Sample aliquot") -#' -#' ## plot the data with user-defined statistical measures as legend -#' plot_DRTResults( -#' values = list(x.1, x.2), -#' given.dose = 2800, -#' summary = c("n", "weighted$mean", "sd.abs")) -#' -#' ## plot the data with user-defined statistical measures as sub-header -#' plot_DRTResults( -#' values = list(x.1, x.2), -#' given.dose = 2800, -#' summary = c("n", "weighted$mean", "sd.abs"), -#' summary.pos = "sub") -#' -#' ## plot the data grouped by preheat temperatures -#' plot_DRTResults( -#' values = ExampleData.DeValues$BT998[7:11,], -#' given.dose = 2800, -#' preheat = c(200, 200, 200, 240, 240)) -#' -#' ## read example data set and misapply them for this plot type -#' data(ExampleData.DeValues, envir = environment()) -#' -#' ## plot values -#' plot_DRTResults( -#' values = ExampleData.DeValues$BT998[7:11,], -#' given.dose = 2800, -#' mtext = "Example data") -#' -#' ## plot two data sets grouped by preheat temperatures -#' plot_DRTResults( -#' values = list(x.1, x.2), -#' given.dose = 2800, -#' preheat = c(200, 200, 200, 240, 240)) -#' -#' ## plot the data grouped by preheat temperatures as boxplots -#' plot_DRTResults( -#' values = ExampleData.DeValues$BT998[7:11,], -#' given.dose = 2800, -#' preheat = c(200, 200, 200, 240, 240), -#' boxplot = TRUE) -#' -#' @md -#' @export -plot_DRTResults <- function( - values, - given.dose = NULL, - error.range = 10, - preheat, - boxplot = FALSE, - mtext, - summary, - summary.pos, - legend, - legend.pos, - par.local = TRUE, - na.rm = FALSE, - ... -){ - - ## Validity checks ---------------------------------------------------------- - - ##avoid crash for wrongly set boxlot argument - if(missing(preheat) & boxplot == TRUE){ - boxplot <- FALSE - .throw_warning("Option 'boxplot' requires a value in 'preheat', ", - "reset to FALSE") - } - - if(missing(summary) == TRUE) {summary <- NULL} - if(missing(summary.pos) == TRUE) {summary.pos <- "topleft"} - if(missing(legend.pos) == TRUE) {legend.pos <- "topright"} - if(missing(mtext) == TRUE) {mtext <- ""} - - ## Homogenise and check input data - if(is(values, "list") == FALSE) {values <- list(values)} - - for(i in 1:length(values)) { - if(is(values[[i]], "RLum.Results")==FALSE & - is(values[[i]], "data.frame")==FALSE){ - .throw_error("Input data must be one of 'data.frame' or 'RLum.Results'") - } else { - if(is(values[[i]], "RLum.Results")==TRUE){ - values[[i]] <- get_RLum(values[[i]])[,1:2] - } - } - } - - ## Check input arguments ---------------------------------------------------- - for(i in 1:length(values)) { - - ##check for preheat temperature values - if(missing(preheat) == FALSE) { - if(length(preheat) != nrow(values[[i]])){ - .throw_error("Number of preheat temperatures != De values") - } - } - - ##remove NA values; yes Micha, it is not that simple - if(na.rm == TRUE){ - - ##currently we assume that all input data sets comprise a similar of data - if(!missing(preheat) & i == length(values)){ - - ## find and mark NA value indices - temp.NA.values <- unique(c(which(is.na(values[[i]][,1])), which(is.na(values[[i]][,2])))) - - ##remove preheat entries - preheat <- preheat[-temp.NA.values] - - } - - values[[i]] <- na.exclude(values[[i]]) - } - } - - ## create global data set - values.global <- NULL - n.values <- NULL - for(i in 1:length(values)) { - values.global <- rbind(values.global, values[[i]]) - n.values <- c(n.values, nrow(values[[i]])) - } - - ## Set plot format parameters ----------------------------------------------- - extraArgs <- list(...) # read out additional arguments list - - main <- if("main" %in% names(extraArgs)) {extraArgs$main} else - {"Dose recovery test"} - - xlab <- if("xlab" %in% names(extraArgs)) {extraArgs$xlab} else { - ifelse(missing(preheat) == TRUE, "# Aliquot", "Preheat temperature [\u00B0C]") - } - - ylab <- if("ylab" %in% names(extraArgs)) {extraArgs$ylab} else - {if(!is.null(given.dose)){ - expression(paste("Normalised ", D[e], sep="")) - }else{expression(paste(D[e], " [s]"), sep = "")}} - - xlim <- if("xlim" %in% names(extraArgs)) {extraArgs$xlim} else - {c(1, max(n.values) + 1)} - - ylim <- if("ylim" %in% names(extraArgs)) {extraArgs$ylim} else - {c(0.75, 1.25)} #check below for further corrections if boundaries exceed set range - - cex <- if("cex" %in% names(extraArgs)) {extraArgs$cex} else {1} - - pch <- if("pch" %in% names(extraArgs)) {extraArgs$pch} else { - abs(seq(from = 20, to = -100)) - } - - ##axis labels - las <- if("las" %in% names(extraArgs)) extraArgs$las else 0 - - fun <- if ("fun" %in% names(extraArgs)) extraArgs$fun else FALSE # nocov - - ## calculations and settings------------------------------------------------- - - ## normalise data if given.dose is given - if(!is.null(given.dose)){ - - if(length(given.dose) > 1){ - - if(length(values) < length(given.dose)){ - .throw_error("'given.dose' > number of input data sets") - - } - - for(i in 1:length(values)) { - values[[i]] <- values[[i]]/given.dose[i] - } - - }else{ - - for(i in 1:length(values)) { - values[[i]] <- values[[i]]/given.dose - } - - } - } - - ##correct ylim for data set which exceed boundaries - if((max(sapply(1:length(values), function(x){max(values[[x]][,1], na.rm = TRUE)}))>1.25 | - min(sapply(1:length(values), function(x){min(values[[x]][,1], na.rm = TRUE)}))<0.75) & - ("ylim" %in% names(extraArgs)) == FALSE){ - - ylim <- c( - min(sapply(1:length(values), function(x){ - min(values[[x]][,1], na.rm = TRUE) - max(values[[x]][,2], na.rm = TRUE)})), - max(sapply(1:length(values), function(x){ - max(values[[x]][,1], na.rm = TRUE) + max(values[[x]][,2], na.rm = TRUE)}))) - - } - - - ## optionally group data by preheat temperature - if(missing(preheat) == FALSE) { - modes <- as.numeric(rownames(as.matrix(table(preheat)))) - values.preheat <- list(NA) - values.boxplot <- list(NA) - for(i in 1:length(modes)) { - for(j in 1:length(values)) { - values.preheat[[length(values.preheat) + 1]] <- - cbind(values[[j]][preheat == modes[i],], - preheat[preheat == modes[i]]) - values.boxplot[[length(values.boxplot) + 1]] <- - values[[j]][preheat == modes[i],1] - } - j <- 1 - } - values.preheat[[1]] <- NULL - values.boxplot[[1]] <- NULL - modes.plot <- rep(modes, each = length(values)) - - } else { - modes <- 1 - - } - - ## assign colour indices - col <- if("col" %in% names(extraArgs)) {extraArgs$col} else { - if(missing(preheat) == TRUE) { - rep(seq(from = 1, to = length(values)), each = length(modes)) - } else { - rep(seq(from = 1, to = length(values)), length(modes)) - } - } - - ## calculate and paste statistical summary - if(summary.pos[1] != "sub") { - label.text <- lapply(1:length(values), function(i) { - .create_StatisticalSummaryText( - x = calc_Statistics(values[[i]]), - keywords = summary, - digits = 2, - sep = " \n", - prefix = paste(rep("\n", (i - 1) * length(summary)), collapse = "") - ) - }) - - }else{ - label.text <- lapply(1:length(values), function(i) { - .create_StatisticalSummaryText( - x = calc_Statistics(values[[i]]), - keywords = summary, - digits = 2, - sep = " | " - ) - }) - - } - - ## convert keywords into summary placement coordinates - if(missing(summary.pos) == TRUE) { - summary.pos <- c(xlim[1], ylim[2]) - summary.adj <- c(0, 1) - } else if(length(summary.pos) == 2) { - summary.pos <- summary.pos - summary.adj <- c(0, 1) - } else if(summary.pos[1] == "topleft") { - summary.pos <- c(xlim[1], ylim[2]) - summary.adj <- c(0, 1) - } else if(summary.pos[1] == "top") { - summary.pos <- c(mean(xlim), ylim[2]) - summary.adj <- c(0.5, 1) - } else if(summary.pos[1] == "topright") { - summary.pos <- c(xlim[2], ylim[2]) - summary.adj <- c(1, 1) - } else if(summary.pos[1] == "left") { - summary.pos <- c(xlim[1], mean(ylim)) - summary.adj <- c(0, 0.5) - } else if(summary.pos[1] == "center") { - summary.pos <- c(mean(xlim), mean(ylim)) - summary.adj <- c(0.5, 0.5) - } else if(summary.pos[1] == "right") { - summary.pos <- c(xlim[2], mean(ylim)) - summary.adj <- c(1, 0.5) - }else if(summary.pos[1] == "bottomleft") { - summary.pos <- c(xlim[1], ylim[1]) - summary.adj <- c(0, 0) - } else if(summary.pos[1] == "bottom") { - summary.pos <- c(mean(xlim), ylim[1]) - summary.adj <- c(0.5, 0) - } else if(summary.pos[1] == "bottomright") { - summary.pos <- c(xlim[2], ylim[1]) - summary.adj <- c(1, 0) - } - - ## convert keywords into legend placement coordinates - if(missing(legend.pos) == TRUE) { - legend.pos <- c(xlim[2], ylim[2]) - legend.adj <- c(1, 1) - } else if(length(legend.pos) == 2) { - legend.pos <- legend.pos - legend.adj <- c(0, 1) - } else if(legend.pos[1] == "topleft") { - legend.pos <- c(xlim[1], ylim[2]) - legend.adj <- c(0, 1) - } else if(legend.pos[1] == "top") { - legend.pos <- c(mean(xlim), ylim[2]) - legend.adj <- c(0.5, 1) - } else if(legend.pos[1] == "topright") { - legend.pos <- c(xlim[2], ylim[2]) - legend.adj <- c(1, 1) - } else if(legend.pos[1] == "left") { - legend.pos <- c(xlim[1], mean(ylim)) - legend.adj <- c(0, 0.5) - } else if(legend.pos[1] == "center") { - legend.pos <- c(mean(xlim), mean(ylim)) - legend.adj <- c(0.5, 0.5) - } else if(legend.pos[1] == "right") { - legend.pos <- c(xlim[2], mean(ylim)) - legend.adj <- c(1, 0.5) - } else if(legend.pos[1] == "bottomleft") { - legend.pos <- c(xlim[1], ylim[1]) - legend.adj <- c(0, 0) - } else if(legend.pos[1] == "bottom") { - legend.pos <- c(mean(xlim), ylim[1]) - legend.adj <- c(0.5, 0) - } else if(legend.pos[1] == "bottomright") { - legend.pos <- c(xlim[2], ylim[1]) - legend.adj <- c(1, 0) - } - - ## Plot output -------------------------------------------------------------- - - ## determine number of subheader lines to shif the plot - shift.lines <- if(summary.pos[1] == "sub" & mtext == "") { - length(label.text) - 1 - } else {1} - - ## setup plot area - if(par.local){ - if (shift.lines <= 0) - shift.lines <- 1 - par.default <- par(mfrow = c(1, 1), cex = cex, oma = c(0, 1, shift.lines - 1, 1)) - on.exit(par(par.default)) - } - - ## optionally plot values and error bars - if(boxplot == FALSE) { - ## plot data and error - if(missing(preheat) == TRUE) { - ## create empty plot - plot(NA,NA, - xlim = xlim, - ylim = ylim, - xlab = xlab, - ylab = ylab, - xaxt = "n", - las = las, - main = "") - - ##add x-axis ... this avoids digits in the axis labelling - axis(side = 1, at = 1:(nrow(values[[1]])+1), labels = 1:(nrow(values[[1]])+1), las = las) - - ## add title - title(main = main, - line = shift.lines + 2) - - ## add additional lines - if (!is.null(given.dose)) { - abline(h = 1) - - if (error.range > 0) { - ## error range lines - abline(h = 1 * (1 + error.range / 100), lty = 2) - abline(h = 1 * (1 - error.range / 100), lty = 2) - - ## error range labels - text( - par()$usr[2], - (1 + error.range / 100) + 0.02, - paste("+", error.range , " %", sep = ""), - pos = 2, - cex = 0.8 - ) - text( - par()$usr[2], - (1 - error.range / 100) - 0.02, - paste("-", error.range , "%", sep = ""), - pos = 2, - cex = 0.8 - ) - } - - } - - ## add data and error bars - for(i in 1:length(values)) { - - points(x = c(1:nrow(values[[i]])), - y = values[[i]][,1], - pch = if(nrow(values[[i]]) == length(pch)){ pch } else { pch[i] }, - col = if(nrow(values[[i]]) == length(col)){ col } else { col[i] }, - cex = 1.2 * cex) - - arrows(c(1:nrow(values[[i]])), - values[[i]][,1] + values[[i]][,2], - c(1:nrow(values[[i]])), - values[[i]][,1] - values[[i]][,2], - angle = 90, - length = 0.075, - code = 3, - col = if(nrow(values[[i]]) == length(col)){ col } else { col[i] }) - - ## add summary content - if(summary.pos[1] != "sub") { - text(x = summary.pos[1], - y = summary.pos[2], - adj = summary.adj, - labels = label.text[[i]], - cex = 0.8 * cex, - col = if(nrow(values[[i]]) == length(col)){ "black" } else { col[i] }) - } else { - if(mtext == "") { - mtext(side = 3, - line = - i + 2.5, - text = label.text[[i]], - col = if(nrow(values[[i]]) == length(col)){ "black" } else { col[i] }, - cex = cex * 0.8) - } - } - } - } else { - - ## option for provided preheat data - ## create empty plot - plot(NA,NA, - xlim = c(min(modes.plot) * 0.9, max(modes.plot) * 1.1), - ylim = ylim, - xlab = xlab, - ylab = ylab, - las = las, - main = "", - axes = FALSE, - frame.plot = TRUE) - - ## add axes - axis(1, - at = modes.plot, - labels = modes.plot) - axis(2) - - ## add title - title(main = main, - line = shift.lines + 2) - - ## add additional lines - if (!is.null(given.dose)) { - abline(h = 1) - - if (error.range > 0) { - ## error range lines - abline(h = 1 * (1 + error.range / 100), lty = 2) - abline(h = 1 * (1 - error.range / 100), lty = 2) - - ## error range labels - text( - par()$usr[2], - (1 + error.range / 100) + 0.02, - paste("+", error.range , " %", sep = ""), - pos = 2, - cex = 0.8 - ) - text( - par()$usr[2], - (1 - error.range / 100) - 0.02, - paste("-", error.range , "%", sep = ""), - pos = 2, - cex = 0.8 - ) - } - } - - ## plot values - for(i in 1:length(values.preheat)) { - points(x = values.preheat[[i]][,3], - y = values.preheat[[i]][,1], - pch = pch[i], - col = col[i], - cex = 1.2 * cex) - - arrows(values.preheat[[i]][,3], - values.preheat[[i]][,1] + values.preheat[[i]][,2], - values.preheat[[i]][,3], - values.preheat[[i]][,1] - values.preheat[[i]][,2], - angle = 90, - length = 0.075, - code = 3, - col = col[i]) - } - } - } - - ## optionally, plot boxplot - if(boxplot) { - ## create empty plot - boxplot(values.boxplot, - names = modes.plot, - ylim = ylim, - xlab = xlab, - ylab = ylab, - las = las, - xaxt = "n", - main = "", - border = col) - - ## add axis label, if necessary - if (length(modes.plot) == 1) { - axis(side = 1, at = 1, labels = modes.plot, las = las) - - } else if (length(modes.plot) > length(unique(modes.plot))){ - ticks <- seq(from = 1 + ((length(values.boxplot)/length(unique(modes.plot)) - 1)/2), - to = length(values.boxplot), - by = length(values.boxplot)/length(unique(modes.plot))) - - axis( - side = 1, - at = ticks, - las = las, - labels = unique(modes.plot)) - - ##polygon for a better graphical representation of the groups - polygon.x <- seq( - 1,length(values.boxplot), - by = length(values.boxplot) / length(unique(modes.plot)) - ) - - polygon.step <- unique(diff(polygon.x) - 1) - - for (x.plyg in polygon.x) { - polygon( - x = c(x.plyg,x.plyg,x.plyg + polygon.step, x.plyg + polygon.step), - y = c( - par()$usr[3], - ylim[1] - (ylim[1] - par()$usr[3]) / 2, - ylim[1] - (ylim[1] - par()$usr[3]) / 2, - par()$usr[3] - ), - col = "grey", - border = "grey") - - } - - }else{ - axis(side = 1, at = 1:length(unique(modes.plot)), labels = unique(modes.plot), las = las) - - } - - ## add title - title(main = main, - line = shift.lines + 2) - - ## add additional lines - if(!is.null(given.dose)){ - abline(h = 1) - - if(error.range > 0){ - ## error range lines - abline(h = 1 * (1 + error.range / 100), lty = 2) - abline(h = 1 * (1 - error.range / 100), lty = 2) - - ## error range labels - text(par()$usr[2], (1 + error.range / 100) + 0.02, - paste("+", error.range ," %", sep = ""), pos = 2, cex = 0.8) - text(par()$usr[2], (1 - error.range / 100) - 0.02, - paste("-", error.range ,"%", sep = ""), pos = 2, cex = 0.8) - } - } - - ## plot data and error - for(i in 1:length(values)) { - ## add summary content - if(summary.pos[1] != "sub") { - text(x = summary.pos[1], - y = summary.pos[2], - adj = summary.adj, - labels = label.text[[i]], - cex = 0.8 * cex, - col = if(nrow(values[[i]]) == length(col)){ "black" } else { col[i] }) - } else { - if(mtext == "") { - mtext(side = 3, - line = - i + 2.5, - text = label.text[[i]], - col = if(nrow(values[[i]]) == length(col)){ "black" } else { col[i] }, - cex = cex * 0.8) - } - } - } - } - - ## optionally add legend content - if(missing(legend) == FALSE) { - legend(x = legend.pos[1], - y = legend.pos[2], - xjust = legend.adj[1], - yjust = legend.adj[2], - legend = legend, - col = unique(col), - pch = unique(pch), - lty = 1, - cex = cex * 0.8) - } - - ## optionally add subheader text - mtext(side = 3, - line = shift.lines, - text = mtext, - cex = 0.8 * cex) - - ##FUN by R Luminescence Team - if (fun == TRUE) sTeve() # nocov -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_DetPlot.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_DetPlot.R deleted file mode 100644 index 1220cc989..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_DetPlot.R +++ /dev/null @@ -1,443 +0,0 @@ -#' @title Create De(t) plot -#' -#' @description Plots the equivalent dose (\eqn{D_e}) in dependency of the chosen signal integral -#' (cf. Bailey et al., 2003). The function is simply passing several arguments -#' to the function [plot] and the used analysis functions and runs it in a loop. -#' Example: `legend.pos` for legend position, `legend` for legend text. -#' -#' @details -#' -#' **method** -#' -#' The original method presented by Bailey et al., 2003 shifted the signal integrals and slightly -#' extended them accounting for changes in the counting statistics. Example: `c(1:3, 3:5, 5:7)`. -#' However, here also another method is provided allowing to expand the signal integral by -#' consecutively expanding the integral by its chosen length. Example: `c(1:3, 1:5, 1:7)` -#' -#' Note that in both cases the integral limits are overlap. The finally applied limits are part -#' of the function output. -#' -#' **analyse_function.control** -#' -#' The argument `analyse_function.control` currently supports the following arguments -#' `sequence.structure`, `dose.points`, `mtext.outer`, `fit.method`, `fit.force_through_origin`, `plot`, `plot.single` -#' -#' @param object [RLum.Analysis-class] (**required**): input object containing data for analysis -#' Can be provided as a [list] of such objects. -#' -#' @param signal.integral.min [integer] (**required**): -#' lower bound of the signal integral. -#' -#' @param signal.integral.max [integer] (**required**): -#' upper bound of the signal integral. Must be strictly greater than -#' `signal.integral.min`. -#' -#' @param background.integral.min [integer] (**required**): -#' lower bound of the background integral. -#' -#' @param background.integral.max [integer] (**required**): -#' upper bound of the background integral. -#' -#' @param method [character] (*with default*): -#' method applied for constructing the De(t) plot. -#' - `shift` (*the default*): the chosen signal integral is shifted the shine down curve, -#' - `expansion`: the chosen signal integral is expanded each time by its length -#' -#' @param signal_integral.seq [numeric] (*optional*): -#' argument to provide an own signal integral sequence for constructing the De(t) plot -#' -#' @param analyse_function [character] (*with default*): -#' name of the analyse function to be called. Supported functions are: -#' [analyse_SAR.CWOSL], [analyse_pIRIRSequence] -#' -#' @param analyse_function.control [list] (*optional*): -#' selected arguments to be passed to the supported analyse functions -#' ([analyse_SAR.CWOSL], [analyse_pIRIRSequence]). The arguments must be provided -#' as named [list], e.g., `list(dose.points = c(0,10,20,30,0,10)` will set the -#' regeneration dose points. -#' -#' @param n.channels [integer] (*optional*): -#' number of channels used for the De(t) plot. If nothing is provided all -#' De-values are calculated and plotted until the start of the background -#' integral. -#' -#' @param show_ShineDownCurve [logical] (*with default*): -#' enables or disables shine down curve in the plot output -#' -#' @param respect_RC.Status [logical] (*with default*): -#' remove De-values with 'FAILED' RC.Status from the plot -#' (cf. [analyse_SAR.CWOSL] and [analyse_pIRIRSequence]) -#' -#' @param verbose [logical] (*with default*): -#' enables or disables terminal feedback -#' -#' @param multicore [logical] (*with default*) : enables/disables multi core -#' calculation if `object` is a [list] of [RLum.Analysis-class] objects. Can be an -#' [integer] specifying the number of cores -#' -#' @param plot [logical] (*with default*): enables/disables plot output -#' Disabling the plot is useful in cases where the output need to be processed -#' differently. -#' -#' @param ... further arguments and graphical parameters passed to -#' [plot.default], [analyse_SAR.CWOSL] and [analyse_pIRIRSequence] (see details for further information). -#' Plot control parameters are: `ylim`, `xlim`, `ylab`, `xlab`, `main`, `pch`, `mtext`, `cex`, `legend`, -#' `legend.text`, `legend.pos` -#' -#' @return -#' A plot and an [RLum.Results-class] object with the produced \eqn{D_e} values -#' -#' `@data`: -#' -#' \tabular{lll}{ -#' **Object** \tab **Type** \tab **Description**\cr -#' `De.values` \tab `data.frame` \tab table with De values \cr -#' `signal_integral.seq` \tab `numeric` \tab integral sequence used for the calculation -#' } -#' -#' `@info`: -#' -#' \tabular{lll}{ -#' **Object** \tab **Type** \tab **Description**\cr -#' call \tab `call` \tab the original function call -#' } -#' -#' -#' @note -#' The entire analysis is based on the used analysis functions, namely -#' [analyse_SAR.CWOSL] and [analyse_pIRIRSequence]. However, the integrity -#' checks of this function are not that thoughtful as in these functions itself. -#' It means, that every sequence should be checked carefully before running long -#' calculations using several hundreds of channels. -#' -#' @section Function version: 0.1.7 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Ruprecht-Karl University of Heidelberg (Germany) -#' -#' @references -#' Bailey, R.M., Singarayer, J.S., Ward, S., Stokes, S., 2003. Identification of partial resetting -#' using De as a function of illumination time. Radiation Measurements 37, 511-518. -#' doi:10.1016/S1350-4487(03)00063-5 -#' -#' @seealso [plot], [analyse_SAR.CWOSL], [analyse_pIRIRSequence] -#' -#' @examples -#' -#' \dontrun{ -#' ##load data -#' ##ExampleData.BINfileData contains two BINfileData objects -#' ##CWOSL.SAR.Data and TL.SAR.Data -#' data(ExampleData.BINfileData, envir = environment()) -#' -#' ##transform the values from the first position in a RLum.Analysis object -#' object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) -#' -#' plot_DetPlot( -#' object, -#' signal.integral.min = 1, -#' signal.integral.max = 3, -#' background.integral.min = 900, -#' background.integral.max = 1000, -#' n.channels = 5) -#' } -#' -#' @md -#' @export -plot_DetPlot <- function( - object, - signal.integral.min, - signal.integral.max, - background.integral.min, - background.integral.max, - method = "shift", - signal_integral.seq = NULL, - analyse_function = "analyse_SAR.CWOSL", - analyse_function.control = list(), - n.channels = NULL, - show_ShineDownCurve = TRUE, - respect_RC.Status = FALSE, - multicore = TRUE, - verbose = TRUE, - plot = TRUE, - ... -) { - - -# SELF CALL --------------------------------------------------------------- - if(inherits(object, "list")) { - ## remove all RLum.Analysis objects - object <- .rm_nonRLum(x = object, class = "RLum.Analysis") - - ## get parameters to be passed on - f_def <- sys.call(sys.parent(n = -1)) - args_default <- as.list(f_def)[-(1:2)] - - ## detect cores - cores <- if(inherits(multicore[1], "logical") && multicore[1]) { - parallel::detectCores() - } else { - max(c(as.numeric(multicore[1])), 1) - } - - cl <- parallel::makeCluster(cores) - on.exit(parallel::stopCluster(cl), add = TRUE) - - if(!multicore) { - cores <- parallel::detectCores() - cl <- parallel::makeCluster(cores) - } - - ##terminal return - if(verbose) cat("\n[plot_DetPlot()] Running mulitcore session with", cores, "core(s) ...") - - ## run in parallel - return_list <- parallel::parLapply( - cl = cl, - X = object, - fun = function(x, arg = args_default) do.call(plot_DetPlot, c(list(object = x), arg))) - - return(merge_RLum(return_list)) - - } - -# Integrity Tests ----------------------------------------------------------------------------- - ##check input - if(!inherits(object, "RLum.Analysis")) - .throw_error("Input must be an 'RLum.Analysis' object") - - ##get structure - object.structure <- structure_RLum(object) - - ## signal.integral - .validate_positive_scalar(signal.integral.min, int = TRUE) - .validate_positive_scalar(signal.integral.max, int = TRUE) - if (signal.integral.min >= signal.integral.max) { - .throw_error("'signal.integral.max' must be greater than 'signal.integral.min'") - } - - ## background.integral - .validate_positive_scalar(background.integral.min, int = TRUE) - .validate_positive_scalar(background.integral.min, int = TRUE) - -# Set parameters ------------------------------------------------------------------------------ - ##set n.channels - if(is.null(n.channels)){ - n.channels <- ceiling( - (background.integral.min - 1 - signal.integral.max) / (signal.integral.max - signal.integral.min) - ) - if (verbose) { - message("'n.channels' not specified, set to ", n.channels) - } - } - - analyse_function.settings <- list( - sequence.structure = c("TL", "IR50", "pIRIR225"), - dose.points = NULL, - mtext.outer = "", - fit.method = "EXP", - fit.force_through_origin = FALSE, - trim_channels = FALSE, - plot = FALSE, - plot.single = FALSE - ) - - analyse_function.settings <- modifyList(analyse_function.settings, analyse_function.control) - -# Analyse ------------------------------------------------------------------------------------- - ##set integral sequence - if (is.null(signal_integral.seq)) { - signal_integral.seq <- seq(signal.integral.min, - background.integral.min - 1, - by = signal.integral.max - signal.integral.min) - } - - if(analyse_function == "analyse_SAR.CWOSL"){ - results <- merge_RLum(lapply(1:n.channels, function(x){ - analyse_SAR.CWOSL( - object = object, - signal.integral.min = if(method == "shift"){signal_integral.seq[x]}else{signal_integral.seq[1]}, - signal.integral.max = signal_integral.seq[x+1], - background.integral.min = background.integral.min, - background.integral.max = background.integral.max, - dose.points = analyse_function.settings$dose.points, - mtext.outer = analyse_function.settings$mtext.outer, - fit.force_through_origin = analyse_function.settings$fit.force_through_origin, - fit.method = analyse_function.settings$fit.method, - trim_channels = analyse_function.settings$trim_channels, - plot = analyse_function.settings$plot, - plot.single = analyse_function.settings$plot.single, - verbose = verbose - ) - })) - - } - else if(analyse_function == "analyse_pIRIRSequence"){ - result.temp.list <- lapply(1:n.channels, function(x) { - analyse_pIRIRSequence( - object = object, - signal.integral.min = if(method == "shift"){signal_integral.seq[x]}else{signal_integral.seq[1]}, - signal.integral.max = signal_integral.seq[x+1], - background.integral.min = background.integral.min, - background.integral.max = background.integral.max, - dose.points = analyse_function.settings$dose.points, - mtext.outer = analyse_function.settings$mtext.outer, - plot = analyse_function.settings$plot, - plot.single = analyse_function.settings$plot.single, - sequence.structure = analyse_function.settings$sequence.structure, - verbose = verbose - ) - }) - - ## as the analyse_pIRIRSequence() may fail, we see how many results - ## we've actually managed to produce - num.valid.results <- sum(!sapply(result.temp.list, is.null)) - if (num.valid.results == 0) { - .throw_error("No valid results produced") - } - if (num.valid.results == 1) { - results <- result.temp.list - } else { - results <- merge_RLum(result.temp.list) - } - rm(result.temp.list) - } - else{ - .throw_error("Unknown 'analyse_function'") - } - - -# Plot ---------------------------------------------------------------------------------------- - ##get De results - if(analyse_function == "analyse_pIRIRSequence"){ - pIRIR_signals <- unique(get_RLum(results)$Signal) - - }else{ - pIRIR_signals <- NA - - } - - ##run this in a loop to account for pIRIR data - df_final <- lapply(1:length(pIRIR_signals), function(i){ - ##get data.frame - df <- get_RLum(results) - - ##further limit - if(!is.na(pIRIR_signals[1])) - df <- df[df$Signal == pIRIR_signals[i],] - - ##add shine down curve, which is by definition the first IRSL/OSL curve - ##and normalise on the highest De value - OSL_curve <- - as(get_RLum(object, recordType = "SL")[[i]], "matrix") - - ##limit to what we see - OSL_curve <- OSL_curve[1:signal_integral.seq[n.channels + 1],] - - m <- - ((min(df$De - df$De.Error, na.rm = TRUE)) - - (max(df$De, na.rm = TRUE) + - max(df$De.Error, na.rm = TRUE))) / - (min(OSL_curve[, 2], na.rm = TRUE) - - max(OSL_curve[, 2], na.rm = TRUE)) - n <- (max(df$De, na.rm = TRUE) + - max(df$De.Error, na.rm = TRUE)) - m * max(OSL_curve[, 2]) - - OSL_curve[, 2] <- m * OSL_curve[, 2] + n - rm(n, m) - - ##set plot setting - plot.settings <- modifyList(list( - ylim = c( - min(df$De - df$De.Error, na.rm = TRUE), - (max(df$De, na.rm = TRUE) + max(df$De.Error, na.rm = TRUE))), - xlim = c(min(OSL_curve[, 1]), max(OSL_curve[, 1])), - ylab = if(show_ShineDownCurve[1]) - expression(paste(D[e], " [s] and ", L[n], " [a.u.]")) - else - expression(paste(D[e], " [s]")), - xlab = "Stimulation time [s]", - main = "De(t) plot", - pch = 1, - mtext = ifelse(is.na(pIRIR_signals[1]), "", paste0("Signal: ",pIRIR_signals[i])), - cex = 1, - legend = if(show_ShineDownCurve[1]) TRUE else FALSE, - legend.text = if(show_ShineDownCurve[1]) - c(expression(D[e]), expression(L[n]-signal)) - else - expression(D[e]), - legend.pos = "bottomleft" - ), list(...)) - - ##set x-axis - df_x <- - OSL_curve[seq(signal.integral.max, signal_integral.seq[n.channels+1], length.out = nrow(df)),1] - - #combine everything to allow excluding unwanted values - df_final <- cbind(df, df_x) - - if (respect_RC.Status) - df_final <- df_final[df_final$RC.Status != "FAILED", ] - - if(plot[1]) { - ##general settings - old_par <- par(no.readonly = TRUE) - par(cex = plot.settings$cex) - on.exit(par(old_par), add = TRUE) - - ##open plot area - plot( - NA, - NA, - xlim = plot.settings$xlim, - ylim = if(any(is.infinite(plot.settings$ylim))) c(-1,1) else plot.settings$ylim , - xlab = plot.settings$xlab, - ylab = plot.settings$ylab, - main = plot.settings$main - ) - - if (show_ShineDownCurve) - lines(OSL_curve, type = "b", pch = 20) - - ##ToDo:color failed points red - ##plot points and error bars - points(df_final[, c("df_x", "De")], pch = plot.settings$pch) - segments( - x0 = df_final$df_x, - y0 = df_final$De + df_final$De.Error, - x1 = df_final$df_x, - y1 = df_final$De - df_final$De.Error - ) - - ##set mtext - mtext(side = 3, plot.settings$mtext) - - ##legend - if(plot.settings$legend){ - legend( - plot.settings$legend.pos, - legend = plot.settings$legend.text, - pch = c(plot.settings$pch, 20), - bty = "n" - ) - } - } ## end plot - ##set return - return(df_final) - - }) - - - -# Return ------------------------------------------------------------------ - ##merge results - return(set_RLum( - class = "RLum.Results", - data = list( - De.values = as.data.frame(data.table::rbindlist(df_final)), - signal_integral.seq = signal_integral.seq - ), - info = list( - call = sys.call()) - )) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_FilterCombinations.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_FilterCombinations.R deleted file mode 100644 index 7fa9fc7e0..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_FilterCombinations.R +++ /dev/null @@ -1,400 +0,0 @@ -#' Plot filter combinations along with the (optional) net transmission window -#' -#' The function allows to plot transmission windows for different filters. Missing data for specific -#' wavelengths are automatically interpolated for the given filter data using the function [approx]. -#' With that a standardised output is reached and a net transmission window can be shown. -#' -#' **Calculations** -#' -#' **Net transmission window** -#' -#' The net transmission window of two filters is approximated by -#' -#' \deqn{T_{final} = T_{1} * T_{2}} -#' -#' **Optical density** -#' -#' \deqn{OD = -log10(T)} -#' -#' **Total optical density** -#' -#' \deqn{OD_{total} = OD_{1} + OD_{2}} -#' -#' Please consider using own calculations for more precise values. -#' -#' **How to provide input data?** -#' -#' *CASE 1* -#' -#' The function expects that all filter values are either of type `matrix` or `data.frame` -#' with two columns. The first columns contains the wavelength, the second the relative transmission -#' (but not in percentage, i.e. the maximum transmission can be only become 1). -#' -#' In this case only the transmission window is show as provided. Changes in filter thickness and -#' reflection factor are not considered. -#' -#' *CASE 2* -#' -#' The filter data itself are provided as list element containing a `matrix` or -#' `data.frame` and additional information on the thickness of the filter, e.g., -#' `list(filter1 = list(filter_matrix, d = 2))`. -#' The given filter data are always considered as standard input and the filter thickness value -#' is taken into account by -#' -#' \deqn{Transmission = Transmission^(d)} -#' -#' with d given in the same dimension as the original filter data. -#' -#' *CASE 3* -#' -#' Same as CASE 2 but additionally a reflection factor P is provided, e.g., -#' `list(filter1 = list(filter_matrix, d = 2, P = 0.9))`. -#' The final transmission becomes: -#' -#' \deqn{Transmission = Transmission^(d) * P} -#' -#' **Advanced plotting parameters** -#' -#' The following further non-common plotting parameters can be passed to the function: -#' -#' \tabular{lll}{ -#' **`Argument`** \tab **`Datatype`** \tab **`Description`**\cr -#' `legend` \tab `logical` \tab enable/disable legend \cr -#' `legend.pos` \tab `character` \tab change legend position ([graphics::legend]) \cr -#' `legend.text` \tab `character` \tab same as the argument `legend` in ([graphics::legend]) \cr -#' `net_transmission.col` \tab `col` \tab colour of net transmission window polygon \cr -#' `net_transmission.col_lines` \tab `col` \tab colour of net transmission window polygon lines \cr -#' `net_transmission.density` \tab `numeric` \tab specify line density in the transmission polygon \cr -#' `grid` \tab `list` \tab full list of arguments that can be passed to the function [graphics::grid] -#' } -#' -#' For further modifications standard additional R plot functions are recommend, e.g., the legend -#' can be fully customised by disabling the standard legend and use the function [graphics::legend] -#' instead. -#' -#' -#' @param filters [list] (**required**): -#' a named list of filter data for each filter to be shown. -#' The filter data itself should be either provided as [data.frame] or [matrix]. -#' (for more options s. Details) -#' -#' @param wavelength_range [numeric] (*with default*): -#' wavelength range used for the interpolation -#' -#' @param show_net_transmission [logical] (*with default*): -#' show net transmission window as polygon. -#' -#' @param interactive [logical] (*with default*): -#' enable/disable interactive plot -#' -#' @param plot [logical] (*with default*): -#' enables or disables the plot output -#' -#' @param ... further arguments that can be passed to control the plot output. -#' Supported are `main`, `xlab`, `ylab`, `xlim`, `ylim`, `type`, `lty`, `lwd`. -#' For non common plotting parameters see the details section. -#' -#' @return Returns an S4 object of type [RLum.Results-class]. -#' -#' **@data** -#' -#' \tabular{lll}{ -#' **`Object`** \tab **`Type`** **`Description`** \cr -#' `net_transmission_window` \tab `matrix` \tab the resulting net transmission window \cr -#' `OD_total` \tab `matrix` \tab the total optical density\cr -#' `filter_matrix` \tab `matrix` \tab the filter matrix used for plotting -#' } -#' -#' **@info** -#' -#' \tabular{lll}{ -#' **Object** \tab **Type** **Description** \cr -#' `call` \tab [call] \tab the original function call -#' } -#' -#' @section Function version: 0.3.2 -#' -#' @author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum.Results-class], [approx] -#' -#' @keywords datagen aplot -#' -#' @examples -#' -#' ## (For legal reasons no real filter data are provided) -#' -#' ## Create filter sets -#' filter1 <- density(rnorm(100, mean = 450, sd = 20)) -#' filter1 <- matrix(c(filter1$x, filter1$y/max(filter1$y)), ncol = 2) -#' filter2 <- matrix(c(200:799,rep(c(0,0.8,0),each = 200)), ncol = 2) -#' -#' ## Example 1 (standard) -#' plot_FilterCombinations(filters = list(filter1, filter2)) -#' -#' ## Example 2 (with d and P value and name for filter 2) -#' results <- plot_FilterCombinations( -#' filters = list(filter_1 = filter1, Rectangle = list(filter2, d = 2, P = 0.6))) -#' results -#' -#' ## Example 3 show optical density -#' plot(results$OD_total) -#' -#' \dontrun{ -#' ##Example 4 -#' ##show the filters using the interactive mode -#' plot_FilterCombinations(filters = list(filter1, filter2), interactive = TRUE) -#' -#' } -#' -#' -#' @md -#' @export -plot_FilterCombinations <- function( - filters, - wavelength_range = 200:1000, - show_net_transmission = TRUE, - interactive = FALSE, - plot = TRUE, - ...) { - # Integrity tests ----------------------------------------------------------------------------- - - #check filters - if (!is(filters, "list")) { - .throw_error("'filters' should be of type 'list'") - } - - #input should either data.frame or matrix - lapply(filters, function(x) { - if (!is(x, "data.frame") & !is(x, "matrix") & !is(x, "list")) { - .throw_error("All elements of 'filter' must be of type ", - "'matrix', 'data.frame' or 'list'") - } - }) - - #check for named list, if not set names - if (is.null(names(filters))) { - names(filters) <- paste("Filter ", 1:length(filters)) - - } - - - # Data Preparation ---------------------------------------------------------------------------- - - ## check if filters are provided with their thickness, if so correct - ## transmission for this ... relevant for glass filters - filters <- lapply(filters, function(x) { - if (is(x, "list")) { - - ## correction for the transmission accounting for filter thickness, - ## the provided thickness is always assumed to be 1 - if(length(x) > 1){ - x[[1]][, 2] <- x[[1]][, 2] ^ (x[[2]]) - - }else{ - return(x[[1]]) - } - - ## account for potentially provided transmission reflection factor - if(length(x) > 2){ - x[[1]][,2] <- x[[1]][,2] * x[[3]] - return(x[[1]]) - - }else{ - return(x[[1]]) - } - - } else{ - return(x) - } - }) - - #check if there are transmission values greater than one, this is not possible - lapply(filters, function(x) { - if (max(x[, 2], na.rm = TRUE) > 1.01) { - .throw_error("Transmission values > 1 found, check your data") - } - }) - - ##combine everything in a matrix using approx for interpolation - filter_matrix <- vapply(filters, function(x) { - approx(x = x[, 1], y = x[, 2], xout = wavelength_range)$y - - }, FUN.VALUE = vector(mode = "numeric", length = length(wavelength_range))) - - ##calculate transmission window - filter_matrix <- cbind(filter_matrix) - net_transmission_window <- matrix( - c(wavelength_range, matrixStats::rowProds(filter_matrix)), - ncol = 2) - - ##add optical density to filter matrix - - ##calculate OD - OD <- -log10(filter_matrix) - - ##calculate total OD - OD_total <- cbind(wavelength_range, matrixStats::rowSums2(OD)) - - ##add to matrix - filter_matrix <- cbind(filter_matrix, OD) - - ##set rownames of filter matrix - rownames(filter_matrix) <- wavelength_range - - ##set column names for filter matrix - colnames(filter_matrix) <- c(names(filters), paste0(names(filters), "_OD")) - - - # Plotting ------------------------------------------------------------------------------------ - if (plot) { - - ##(1) ... select transmission values - filter_matrix_transmisison <- filter_matrix[,!grepl(pattern = "OD", x = colnames(filter_matrix)), drop = FALSE] - - ##set plot settings - plot_settings <- list( - main = "Filter Combination", - xlab = "Wavelength [nm]", - ylab = "Transmission [a.u.]", - xlim = range(wavelength_range), - ylim = c(0, 1), - legend.pos = "topleft", - lty = 1, - lwd = 1, - col = 1:length(filters), - grid = expression(nx = 10, ny = 10), - legend = TRUE, - legend.text = colnames(filter_matrix_transmisison), - net_transmission.col = rgb(0,0.7,0,.2), - net_transmission.col_lines = "grey", - net_transmission.density = 20 - ) - - ##modify settings on request - plot_settings <- modifyList(plot_settings, list(...)) - - if(interactive){ - - ##check for plotly - if (!requireNamespace("plotly", quietly = TRUE)) { - # nocov start - .throw_error("Package 'plotly' is required for interactive plots") - # nocov end - } - - ##create basic plot - p <- - plotly::plot_ly(x = wavelength_range, - y = filter_matrix[,1], - type = "scatter", - name = colnames(filter_matrix_transmisison)[1], - mode = "lines") - - ##add further filters - if (ncol(filter_matrix_transmisison) > 1) { - for (i in 2:ncol(filter_matrix_transmisison)) { - p <- plotly::add_trace(p, - y = filter_matrix[, i], - name = colnames(filter_matrix_transmisison)[i], - mode = 'lines') - } - } - - - ##add polygon - ##replace all NA vaules with 0, otherwise it looks odd - net_transmission_window[is.na(net_transmission_window)] <- 0 - - p <- plotly::add_polygons(p, - x = c(wavelength_range, rev(wavelength_range)), - y = c(net_transmission_window[, 2], rep(0, length(wavelength_range))), - name = "net transmission" - ) - - ##change graphical parameters - p <- plotly::layout( - p = p, - xaxis = list( - title = plot_settings$xlab - ), - yaxis = list( - title = plot_settings$ylab - ), - title = plot_settings$main - ) - - print(p) - on.exit(return(p)) - - - }else{ - ##plot induvidal filters - graphics::matplot( - x = wavelength_range, - y = filter_matrix_transmisison, - type = "l", - main = plot_settings$main, - xlab = plot_settings$xlab, - ylab = plot_settings$ylab, - xlim = plot_settings$xlim, - ylim = plot_settings$ylim, - lty = plot_settings$lty, - lwd = plot_settings$lwd, - col = plot_settings$col - ) - - if (!is.null(plot_settings$grid)) { - graphics::grid(eval(plot_settings$grid)) - } - - ##show effective transmission, which is the minimum for each row - if (show_net_transmission) { - - ##replace all NA vaules with 0, otherwise it looks odd - net_transmission_window[is.na(net_transmission_window)] <- 0 - - polygon( - x = c(wavelength_range, rev(wavelength_range)), - y = c(net_transmission_window[, 2], - rep(0, length(wavelength_range))), - col = plot_settings$net_transmission.col, - border = NA, - ) - polygon( - x = c(wavelength_range, rev(wavelength_range)), - y = c(net_transmission_window[, 2], - rep(0, length(wavelength_range))), - col = plot_settings$net_transmission.col_lines, - border = NA, - density = plot_settings$net_transmission.density - ) - - } - - #legend - if (plot_settings$legend) { - legend( - plot_settings$legend.pos, - legend = plot_settings$legend.text, - col = plot_settings$col, - lty = plot_settings$lty, - bty = "n" - ) - } - } - } - - - # Produce output object ----------------------------------------------------------------------- - invisible(set_RLum( - class = "RLum.Results", - data = list( - net_transmission_window = net_transmission_window, - OD_total = OD_total, - filter_matrix = filter_matrix - - ), - info = list(call = sys.call()) - )) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_GrowthCurve.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_GrowthCurve.R deleted file mode 100644 index ec681c6ff..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_GrowthCurve.R +++ /dev/null @@ -1,2355 +0,0 @@ -#' @title Fit and plot a dose-response curve for luminescence data (Lx/Tx against dose) -#' -#' @description -#' -#' A dose-response curve is produced for luminescence measurements using a -#' regenerative or additive protocol. The function supports interpolation and -#' extrapolation to calculate the equivalent dose. -#' -#' @details -#' -#' **Fitting methods** -#' -#' For all options (except for the `LIN`, `QDR` and the `EXP OR LIN`), -#' the [minpack.lm::nlsLM] function with the `LM` (Levenberg-Marquardt algorithm) -#' algorithm is used. Note: For historical reasons for the Monte Carlo -#' simulations partly the function [nls] using the `port` algorithm. -#' -#' The solution is found by transforming the function or using [uniroot]. -#' -#' `LIN`: fits a linear function to the data using -#' [lm]: \deqn{y = mx + n} -#' -#' `QDR`: fits a linear function to the data using -#' [lm]: \deqn{y = a + bx + cx^2} -#' -#' `EXP`: tries to fit a function of the form -#' \deqn{y = a(1 - exp(-\frac{(x+c)}{b}))} -#' Parameters b and c are approximated by a linear fit using [lm]. Note: b = D0 -#' -#' `EXP OR LIN`: works for some cases where an `EXP` fit fails. -#' If the `EXP` fit fails, a `LIN` fit is done instead. -#' -#' `EXP+LIN`: tries to fit an exponential plus linear function of the -#' form: -#' \deqn{y = a(1-exp(-\frac{x+c}{b}) + (gx))} -#' The \eqn{D_e} is calculated by iteration. -#' -#' **Note:** In the context of luminescence dating, this -#' function has no physical meaning. Therefore, no D0 value is returned. -#' -#' `EXP+EXP`: tries to fit a double exponential function of the form -#' \deqn{y = (a_1 (1-exp(-\frac{x}{b_1}))) + (a_2 (1 - exp(-\frac{x}{b_2})))} -#' This fitting procedure is not robust against wrong start parameters and -#' should be further improved. -#' -#' `GOK`: tries to fit the general-order kinetics function after -#' Guralnik et al. (2015) of the form of -#' -#' \deqn{y = a (d - (1 + (\frac{1}{b}) x c)^{(-1/c)})} -#' -#' where **c > 0** is a kinetic order modifier -#' (not to be confused with **c** in `EXP` or `EXP+LIN`!). -#' -#' `LambertW`: tries to fit a dose-response curve based on the Lambert W function -#' according to Pagonis et al. (2020). The function has the form -#' -#' \deqn{y ~ (1 + (W((R - 1) * exp(R - 1 - ((x + D_{int}) / D_{c}))) / (1 - R))) * N} -#' -#' with \eqn{W} the Lambert W function, calculated using the package [lamW::lambertW0], -#' \eqn{R} the dimensionless retrapping ratio, \eqn{N} the total concentration -#' of trappings states in cm^-3 and \eqn{D_{c} = N/R} a constant. \eqn{D_{int}} is -#' the offset on the x-axis. Please not that finding the root in `mode = "extrapolation"` -#' is a non-easy task due to the shape of the function and the results might be -#' unexpected. -#' -#' **Fit weighting** -#' -#' If the option `fit.weights = TRUE` is chosen, weights are calculated using -#' provided signal errors (Lx/Tx error): -#' \deqn{fit.weights = \frac{\frac{1}{error}}{\Sigma{\frac{1}{error}}}} -#' -#' **Error estimation using Monte Carlo simulation** -#' -#' Error estimation is done using a parametric bootstrapping approach. A set of -#' `Lx/Tx` values is constructed by randomly drawing curve data sampled from normal -#' distributions. The normal distribution is defined by the input values (`mean -#' = value`, `sd = value.error`). Then, a dose-response curve fit is attempted for each -#' dataset resulting in a new distribution of single `De` values. The standard -#' deviation of this distribution is becomes then the error of the `De`. With increasing -#' iterations, the error value becomes more stable. However, naturally the error -#' will not decrease with more MC runs. -#' -#' Alternatively, the function returns highest probability density interval -#' estimates as output, users may find more useful under certain circumstances. -#' -#' **Note:** It may take some calculation time with increasing MC runs, -#' especially for the composed functions (`EXP+LIN` and `EXP+EXP`).\cr -#' Each error estimation is done with the function of the chosen fitting method. -#' -#' **Subtitle information** -#' -#' To avoid plotting the subtitle information, provide an empty user `mtext` -#' `mtext = ""`. To plot any other subtitle text, use `mtext`. -#' -#' @param sample [data.frame] (**required**): -#' data frame with three columns for `x = Dose`,`y = LxTx`,`z = LxTx.Error`, `y1 = TnTx`. -#' The column for the test dose response is optional, but requires `'TnTx'` as -#' column name if used. For exponential fits at least three dose points -#' (including the natural) should be provided. -#' -#' @param mode [character] (*with default*): -#' selects calculation mode of the function. -#' - `"interpolation"` (default) calculates the De by interpolation, -#' - `"extrapolation"` calculates the equivalent dose by extrapolation (useful for MAAD measurements) and -#' - `"alternate"` calculates no equivalent dose and just fits the data points. -#' -#' Please note that for option `"regenerative"` the first point is considered -#' as natural dose -#' -#' @param fit.method [character] (*with default*): -#' function used for fitting. Possible options are: -#' - `LIN`, -#' - `QDR`, -#' - `EXP`, -#' - `EXP OR LIN`, -#' - `EXP+LIN`, -#' - `EXP+EXP`, -#' - `GOK`, -#' - `LambertW` -#' -#' See details. -#' -#' @param fit.force_through_origin [logical] (*with default*) -#' allow to force the fitted function through the origin. -#' For `method = "EXP+EXP"` the function will be fixed through -#' the origin in either case, so this option will have no effect. -#' -#' @param fit.weights [logical] (*with default*): -#' option whether the fitting is done with or without weights. See details. -#' -#' @param fit.includingRepeatedRegPoints [logical] (*with default*): -#' includes repeated points for fitting (`TRUE`/`FALSE`). -#' -#' @param fit.NumberRegPoints [integer] (*optional*): -#' set number of regeneration points manually. By default the number of all (!) -#' regeneration points is used automatically. -#' -#' @param fit.NumberRegPointsReal [integer] (*optional*): -#' if the number of regeneration points is provided manually, the value of the -#' real, regeneration points = all points (repeated points) including reg 0, -#' has to be inserted. -#' -#' @param fit.bounds [logical] (*with default*): -#' set lower fit bounds for all fitting parameters to 0. Limited for the use -#' with the fit methods `EXP`, `EXP+LIN`, `EXP OR LIN`, `GOK`, `LambertW` -#' Argument to be inserted for experimental application only! -#' -#' @param NumberIterations.MC [integer] (*with default*): -#' number of Monte Carlo simulations for error estimation. See details. -#' -#' @param output.plot [logical] (*with default*): -#' plot output (`TRUE/FALSE`). -#' -#' @param output.plotExtended [logical] (*with default*): -#' If' `TRUE`, 3 plots on one plot area are provided: -#' 1. growth curve, -#' 2. histogram from Monte Carlo error simulation and -#' 3. a test dose response plot. -#' -#' If `FALSE`, just the growth curve will be plotted. -#' **Requires:** `output.plot = TRUE`. -#' -#' @param output.plotExtended.single [logical] (*with default*): -#' single plot output (`TRUE/FALSE`) to allow for plotting the results in -#' single plot windows. Requires `output.plot = TRUE` and -#' `output.plotExtended = TRUE`. -#' -#' @param cex.global [numeric] (*with default*): -#' global scaling factor. -#' -#' @param txtProgressBar [logical] (*with default*): -#' enables or disables `txtProgressBar`. If `verbose = FALSE` also no -#' `txtProgressBar` is shown. -#' -#' @param verbose [logical] (*with default*): -#' enables or disables terminal feedback. -#' -#' @param ... Further arguments and graphical parameters to be passed. Note: -#' Standard arguments will only be passed to the growth curve plot. Supported: -#' `xlim`, `ylim`, `main`, `xlab`, `ylab` -#' -#' @return -#' Along with a plot (so far wanted) an `RLum.Results` object is returned containing, -#' the slot `data` contains the following elements: -#' -#' \tabular{lll}{ -#' **DATA.OBJECT** \tab **TYPE** \tab **DESCRIPTION** \cr -#' `..$De` : \tab `data.frame` \tab Table with De values \cr -#' `..$De.MC` : \tab `numeric` \tab Table with De values from MC runs \cr -#' `..$Fit` : \tab [nls] or [lm] \tab object from the fitting for `EXP`, `EXP+LIN` and `EXP+EXP`. -#' In case of a resulting linear fit when using `LIN`, `QDR` or `EXP OR LIN` \cr -#' `..$Formula` : \tab [expression] \tab Fitting formula as R expression \cr -#' `..$call` : \tab `call` \tab The original function call\cr -#' } -#' -#' @section Function version: 1.11.13 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -#' Michael Dietze, GFZ Potsdam (Germany) -#' -#' @references -#' -#' Berger, G.W., Huntley, D.J., 1989. Test data for exponential fits. Ancient TL 7, 43-46. -#' -#' Guralnik, B., Li, B., Jain, M., Chen, R., Paris, R.B., Murray, A.S., Li, S.-H., Pagonis, P., -#' Herman, F., 2015. Radiation-induced growth and isothermal decay of infrared-stimulated luminescence -#' from feldspar. Radiation Measurements 81, 224-231. -#' -#' Pagonis, V., Kitis, G., Chen, R., 2020. A new analytical equation for the dose response of dosimetric materials, -#' based on the Lambert W function. Journal of Luminescence 225, 117333. \doi{10.1016/j.jlumin.2020.117333} -#' -#' @seealso [nls], [RLum.Results-class], [get_RLum], [minpack.lm::nlsLM], -#' [lm], [uniroot], [lamW::lambertW0] -#' -#' @examples -#' -#' ##(1) plot growth curve for a dummy data.set and show De value -#' data(ExampleData.LxTxData, envir = environment()) -#' temp <- plot_GrowthCurve(LxTxData) -#' get_RLum(temp) -#' -#' ##(1b) horizontal plot arrangement -#' layout(mat = matrix(c(1,1,2,3), ncol = 2)) -#' plot_GrowthCurve(LxTxData, output.plotExtended.single = TRUE) -#' -#' ##(1c) to access the fitting value try -#' get_RLum(temp, data.object = "Fit") -#' -#' ##(2) plot the growth curve only - uncomment to use -#' ##pdf(file = "~/Desktop/Growth_Curve_Dummy.pdf", paper = "special") -#' plot_GrowthCurve(LxTxData) -#' ##dev.off() -#' -#' ##(3) plot growth curve with pdf output - uncomment to use, single output -#' ##pdf(file = "~/Desktop/Growth_Curve_Dummy.pdf", paper = "special") -#' plot_GrowthCurve(LxTxData, output.plotExtended.single = TRUE) -#' ##dev.off() -#' -#' ##(4) plot resulting function for given interval x -#' x <- seq(1,10000, by = 100) -#' plot( -#' x = x, -#' y = eval(temp$Formula), -#' type = "l" -#' ) -#' -#' ##(5) plot using the 'extrapolation' mode -#' LxTxData[1,2:3] <- c(0.5, 0.001) -#' print(plot_GrowthCurve(LxTxData,mode = "extrapolation")) -#' -#' ##(6) plot using the 'alternate' mode -#' LxTxData[1,2:3] <- c(0.5, 0.001) -#' print(plot_GrowthCurve(LxTxData,mode = "alternate")) -#' -#' ##(7) import and fit test data set by Berger & Huntley 1989 -#' QNL84_2_unbleached <- -#' read.table(system.file("extdata/QNL84_2_unbleached.txt", package = "Luminescence")) -#' -#' results <- plot_GrowthCurve( -#' QNL84_2_unbleached, -#' mode = "extrapolation", -#' plot = FALSE, -#' verbose = FALSE) -#' -#' #calculate confidence interval for the parameters -#' #as alternative error estimation -#' confint(results$Fit, level = 0.68) -#' -#' -#' \dontrun{ -#' QNL84_2_bleached <- -#' read.table(system.file("extdata/QNL84_2_bleached.txt", package = "Luminescence")) -#' STRB87_1_unbleached <- -#' read.table(system.file("extdata/STRB87_1_unbleached.txt", package = "Luminescence")) -#' STRB87_1_bleached <- -#' read.table(system.file("extdata/STRB87_1_bleached.txt", package = "Luminescence")) -#' -#' print( -#' plot_GrowthCurve( -#' QNL84_2_bleached, -#' mode = "alternate", -#' plot = FALSE, -#' verbose = FALSE)$Fit) -#' -#' print( -#' plot_GrowthCurve( -#' STRB87_1_unbleached, -#' mode = "alternate", -#' plot = FALSE, -#' verbose = FALSE)$Fit) -#' -#' print( -#' plot_GrowthCurve( -#' STRB87_1_bleached, -#' mode = "alternate", -#' plot = FALSE, -#' verbose = FALSE)$Fit) -#' } -#' -#' @md -#' @export -plot_GrowthCurve <- function( - sample, - mode = "interpolation", - fit.method = "EXP", - fit.force_through_origin = FALSE, - fit.weights = TRUE, - fit.includingRepeatedRegPoints = TRUE, - fit.NumberRegPoints = NULL, - fit.NumberRegPointsReal = NULL, - fit.bounds = TRUE, - NumberIterations.MC = 100, - output.plot = TRUE, - output.plotExtended = TRUE, - output.plotExtended.single = FALSE, - cex.global = 1, - txtProgressBar = TRUE, - verbose = TRUE, - ... -) { - - ##1. Check input variable - switch( - class(sample)[1], - data.frame = sample, - matrix = sample <- as.data.frame(sample), - list = sample <- as.data.frame(sample), - stop( - "[plot_GrowthCurve()] Argument 'sample' needs to be of type 'data.frame'!", - call. = FALSE) - ) - - ##2. Check supported fit methods - fit.method_supported <- c("LIN", "QDR", "EXP", "EXP OR LIN", "EXP+LIN", "EXP+EXP", "GOK", "LambertW") - if (!fit.method[1] %in% fit.method_supported) { - stop(paste0( - "[plot_GrowthCurve()] Fit method not supported, supported methods are: ", - paste(fit.method_supported, collapse = ", ") - ), - call. = FALSE) - } - - ##2. check if sample contains a least three rows - if(length(sample[[1]]) < 3 && fit.method != "LIN") - stop("\n [plot_GrowthCurve()] At least three regeneration points are required!", call. = FALSE) - - ##2.1 check column numbers; we assume that in this particular case no error value - ##was provided, e.g., set all errors to 0 - if(ncol(sample) == 2) - sample <- cbind(sample, 0) - - ##2.2 check for inf data in the data.frame - if(any(is.infinite(unlist(sample)))){ - #https://stackoverflow.com/questions/12188509/cleaning-inf-values-from-an-r-dataframe - #This is slow, but it does not break with previous code - sample <- do.call(data.frame, lapply(sample, function(x) replace(x, is.infinite(x),NA))) - .throw_warning("Inf values found, replaced by NA") - } - - ##2.3 check whether the dose value is equal all the time - if(sum(abs(diff(sample[[1]])), na.rm = TRUE) == 0){ - message("[plot_GrowthCurve()] Error: All points have the same dose, ", - "NULL returned") - return(NULL) - } - - ## count and exclude NA values and print result - if (sum(!complete.cases(sample)) > 0) - .throw_warning(sum(!complete.cases(sample)), - " NA values removed") - - ## exclude NA - sample <- na.exclude(sample) - - ## Check if anything is left after removal - if (nrow(sample) == 0) { - message("[plot_GrowthCurve()] Error: After NA removal, nothing is left ", - "from the data set, NULL returned") - return(NULL) - } - - ##3. verbose mode - if(!verbose) - txtProgressBar <- FALSE - - ##remove rownames from data.frame, as this could causes errors for the reg point calculation - rownames(sample) <- NULL - - ##zero values in the data.frame are not allowed for the y-column - if(length(sample[sample[,2]==0,2])>0){ - warning( - paste("[plot_GrowthCurve()]", - length(sample[sample[,2]==0,2]), "values with 0 for Lx/Tx detected; replaced by ", - .Machine$double.eps), - call. = FALSE) - sample[sample[, 2] == 0, 2] <- .Machine$double.eps - } - - ##1. INPUT - #1.0.1 calculate number of reg points if not set - if(is.null(fit.NumberRegPoints)) - fit.NumberRegPoints <- length(sample[-1,1]) - - if(is.null(fit.NumberRegPointsReal)){ - fit.RegPointsReal <- which(!duplicated(sample[,1]) | sample[,1] != 0) - fit.NumberRegPointsReal <- length(fit.RegPointsReal) - } - - #1.1 Produce data.frame from input values, two options for different modes - if(mode[1] == "interpolation"){ - xy <- data.frame(x=sample[2:(fit.NumberRegPoints+1),1],y=sample[2:(fit.NumberRegPoints+1),2]) - y.Error <- sample[2:(fit.NumberRegPoints+1),3] - - } else if (mode[1] == "extrapolation" || mode[1] == "alternate") { - xy <- data.frame( - x = sample[1:(fit.NumberRegPoints+1),1], - y = sample[1:(fit.NumberRegPoints+1),2]) - y.Error <- sample[1:(fit.NumberRegPoints+1),3] - - }else{ - stop("[plot_GrowthCurve()] Unknown input for argument 'mode'", call. = FALSE) - - } - - ##1.1.1 produce weights for weighted fitting - if(fit.weights){ - fit.weights <- 1 / abs(y.Error) / sum(1 / abs(y.Error)) - - if(any(is.na(fit.weights))){ - fit.weights <- rep(1, length(y.Error)) - warning( - "[plot_GrowthCurve()] 'fit.weights' ignored since the error column is invalid or 0.", - call. = FALSE) - } - }else{ - fit.weights <- rep(1, length(y.Error)) - - } - - #1.2 Prepare data sets regeneration points for MC Simulation - if (mode[1] == "interpolation") { - data.MC <- t(vapply( - X = seq(2, fit.NumberRegPoints + 1, by = 1), - FUN = function(x) { - sample(rnorm( - n = 10000, - mean = sample[x, 2], - sd = abs(sample[x, 3]) - ), - size = NumberIterations.MC, - replace = TRUE) - }, - FUN.VALUE = vector("numeric", length = NumberIterations.MC) - )) - - #1.3 Do the same for the natural signal - data.MC.De <- numeric(NumberIterations.MC) - data.MC.De <- - sample(rnorm(10000, mean = sample[1, 2], sd = abs(sample[1, 3])), - NumberIterations.MC, - replace = TRUE) - - }else{ - data.MC <- t(vapply( - X = seq(1, fit.NumberRegPoints + 1, by = 1), - FUN = function(x) { - sample(rnorm( - n = 10000, - mean = sample[x, 2], - sd = abs(sample[x, 3]) - ), - size = NumberIterations.MC, - replace = TRUE) - }, - FUN.VALUE = vector("numeric", length = NumberIterations.MC) - )) - - } - - #1.3 set x.natural - x.natural <- vector("numeric", length = NumberIterations.MC) - x.natural <- NA - - ##1.4 set initialise variables - De <- De.Error <- D01 <- R <- Dc <- N <- NA - - # FITTING ---------------------------------------------------------------------- - ##3. Fitting values with nonlinear least-squares estimation of the parameters - ## set functions for fitting - ## REMINDER: DO NOT ADD {} brackets, otherwise the formula construction will not - ## work - - ## get current environment, we need that later - currn_env <- environment() - - ## Define functions --------- - ### EXP ------- - fit.functionEXP <- function(a,b,c,x) a*(1-exp(-(x+c)/b)) - - ### EXP+LIN ----------- - fit.functionEXPLIN <- function(a,b,c,g,x) a*(1-exp(-(x+c)/b)+(g*x)) - - ### EXP+EXP ---------- - fit.functionEXPEXP <- function(a1,a2,b1,b2,x) (a1*(1-exp(-(x)/b1)))+(a2*(1-exp(-(x)/b2))) - - ### GOK ---------------- - fit.functionGOK <- function(a,b,c,d,x) a*(d-(1+(1/b)*x*c)^(-1/c)) - - ### Lambert W ------------- - fit.functionLambertW <- function(R, Dc, N, Dint, x) (1 + (lamW::lambertW0((R - 1) * exp(R - 1 - ((x + Dint) / Dc ))) / (1 - R))) * N - - ##input data for fitting; exclude repeated RegPoints - if (!fit.includingRepeatedRegPoints[1]) { - data <- - data.frame(x = xy[[1]][!duplicated(xy[[1]])], y = xy[[2]][!duplicated(xy[[1]])]) - fit.weights <- fit.weights[!duplicated(xy[[1]])] - data.MC <- data.MC[!duplicated(xy[[1]]),,drop = FALSE] - y.Error <- y.Error[!duplicated(xy[[1]])] - xy <- xy[!duplicated(xy[[1]]),,drop = FALSE] - - }else{ - data <- data.frame(xy) - } - - ## for unknown reasons with only two points the nls() function is trapped in - ## an endless mode, therefore the minimum length for data is 3 - ## (2016-05-17) - if(any(fit.method %in% c("EXP", "EXP+LIN", "EXP+EXP", "EXP OR LIN")) && length(data[,1])<=2) { - ##set to LIN - fit.method <- "LIN" - - warning("[plot_GrowthCurve()] Fitting using an exponential term requires at - least 3 dose points! fit.method set to 'LIN'", call. = FALSE) - - if(verbose) - message("[plot_GrowthCurve()] fit.method set to 'LIN', see warnings()") - - } - - ##START PARAMETER ESTIMATION - ##general setting of start parameters for fitting - - ##a - estimation for a a the maximum of the y-values (Lx/Tx) - a <- max(data[,2]) - - ##b - get start parameters from a linear fit of the log(y) data - ## (suppress the warning in case one parameter is negative) - fit.lm <- try(lm(suppressWarnings(log(data$y))~data$x)) - - b <- 1 - if (!inherits(fit.lm, "try-error")) - b <- as.numeric(1/fit.lm$coefficients[2]) - - ##c - get start parameters from a linear fit - offset on x-axis - fit.lm<-lm(data$y~data$x) - c <- as.numeric(abs(fit.lm$coefficients[1]/fit.lm$coefficients[2])) - - #take slope from x - y scaling - g <- max(data[,2]/max(data[,1])) - - #set D01 and D02 (in case of EXp+EXP) - D01 <- NA - D01.ERROR <- NA - D02 <- NA - D02.ERROR <- NA - - ##--------------------------------------------------------------------------## - ##to be a little bit more flexible the start parameters varries within a normal distribution - - ##draw 50 start values from a normal distribution a start values - if (fit.method != "LIN") { - a.MC <- suppressWarnings(rnorm(50, mean = a, sd = a / 100)) - - if (!is.na(b)) { - b.MC <- suppressWarnings(rnorm(50, mean = b, sd = b / 100)) - } - - c.MC <- suppressWarnings(rnorm(50, mean = c, sd = c / 100)) - g.MC <- suppressWarnings(rnorm(50, mean = g, sd = g / 1)) - - ##set start vector (to avoid errors within the loop) - a.start <- NA - b.start <- NA - c.start <- NA - g.start <- NA - } - - # QDR ------------------------------------------------------------------------ - if (fit.method == "QDR"){ - ##Do fitting with option to force curve through the origin - if(fit.force_through_origin){ - ##linear fitting ... polynomial - fit <- lm(data$y ~ 0 + I(data$x) + I(data$x^2), weights = fit.weights) - - ##give function for uniroot - De.fs <- function(x, y) { - 0 + coef(fit)[1] * x + coef(fit)[2] * x ^ 2 - y - - } - - }else{ - ##linear fitting ... polynomial - fit <- lm(data$y ~ I(data$x) + I(data$x^2), weights = fit.weights) - - ##give function for uniroot - De.fs <- function(x, y) { - coef(fit)[1] + coef(fit)[2] * x + coef(fit)[3] * x ^ 2 - y - - } - - } - - ##solve and get De - De <- NA - if (mode == "interpolation") { - De.uniroot <- try(uniroot(De.fs, - y = sample[1, 2], - lower = 0, - upper = max(sample[, 1]) * 1.5), silent = TRUE) - - if (!inherits(De.uniroot, "try-error")) { - De <- De.uniroot$root - if (verbose) { - if (mode != "alternate") { - writeLines(paste0("[plot_GrowthCurve()] Fit: ", fit.method, - " (", mode,") ", "| De = ", round(De,2))) - - } - } - - } else{ - if (verbose) - writeLines("[plot_GrowthCurve()] no solution found for QDR fit") - } - }else if (mode == "extrapolation"){ - De.uniroot <- try(uniroot(De.fs, - y = 0, - lower = -1e06, - upper = max(sample[, 1]) * 1.5), silent = TRUE) - - if (!inherits(De.uniroot, "try-error")) { - De <- De.uniroot$root - if (verbose) { - if (mode != "alternate") { - writeLines(paste0("[plot_GrowthCurve()] Fit: ", fit.method, - " (", mode,") ", "| De = ", round(abs(De), 2))) - - } - } - - } else{ - if (verbose) - writeLines("[plot_GrowthCurve()] no solution found for QDR fit") - } - } - - ##set progressbar - if(txtProgressBar){ - cat("\n\t Run Monte Carlo loops for error estimation of the QDR fit\n") - pb<-txtProgressBar(min=0,max=NumberIterations.MC, char="=", style=3) - } - - #start loop for Monte Carlo Error estimation - fit.MC <- sapply(1:NumberIterations.MC, function(i){ - data <- data.frame(x = xy$x, y = data.MC[,i]) - - if(fit.force_through_origin){ - ##linear fitting ... polynomial - fit.MC <- lm(data$y ~ 0 + I(data$x) + I(data$x^2), weights = fit.weights) - - ##give function for uniroot - De.fs.MC <- function(x, y) { - 0 + coef(fit.MC)[1] * x + coef(fit.MC)[2] * x ^ 2 - y - 0 + coef(fit.MC)[1] * x + coef(fit.MC)[2] * x ^ 2 - y - - } - - }else{ - ##linear fitting ... polynomial - fit.MC <- lm(data$y ~ I(data$x) + I(data$x^2), weights = fit.weights) - - ##give function for uniroot - De.fs.MC <- function(x, y) { - coef(fit.MC)[1] + coef(fit.MC)[2] * x + coef(fit.MC)[3] * x ^ 2 - y - - } - - } - - De.MC <- NA - if (mode == "interpolation") { - ##solve and get De - De.uniroot.MC <- try(uniroot( - De.fs.MC, - y = data.MC.De[i], - lower = 0, - upper = max(sample[, 1]) * 1.5 - ), - silent = TRUE) - - if (!inherits(De.uniroot.MC, "try-error")) { - De.MC <- De.uniroot.MC$root - } - - }else if (mode == "extrapolation"){ - ##solve and get De - De.uniroot.MC <- try(uniroot( - De.fs.MC, - y = 0, - lower = -1e6, - upper = max(sample[, 1]) * 1.5 - ), - silent = TRUE) - - if (!inherits(De.uniroot.MC, "try-error")) { - De.MC <- De.uniroot.MC$root - } - } - - ##update progress bar - if(txtProgressBar) setTxtProgressBar(pb, i) - - return(De.MC) - - }) - - if(txtProgressBar) close(pb) - - x.natural<- fit.MC - } - #===========================================================================## - #EXP --------------- - if (fit.method=="EXP" | fit.method=="EXP OR LIN" | fit.method=="LIN"){ - if((is.na(a) | is.na(b) | is.na(c)) && fit.method != "LIN"){ - message("[plot_GrowthCurve()] Error: Fit could not be applied ", - "for this data set, NULL returned") - return(NULL) - } - - if(fit.method != "LIN"){ - ##FITTING on GIVEN VALUES## - # --use classic R fitting routine to fit the curve - - ##try to create some start parameters from the input values to make - ## the fitting more stable - for(i in 1:50){ - a <- a.MC[i] - b <- b.MC[i] - c <- c.MC[i] - fit.initial <- suppressWarnings(try(nls( - formula = .toFormula(fit.functionEXP, env = currn_env), - data = data, - start = c(a = a, b = b, c = c), - trace = FALSE, - algorithm = "port", - lower = c(a = 0, b > 0, c = 0), - nls.control( - maxiter = 100, - warnOnly = TRUE, - minFactor = 1 / 2048 - ) - ), - silent = TRUE - )) - - if(!inherits(fit.initial, "try-error")){ - #get parameters out of it - parameters<-(coef(fit.initial)) - b.start[i] <- as.vector((parameters["b"])) - a.start[i] <- as.vector((parameters["a"])) - c.start[i] <- as.vector((parameters["c"])) - } - } - - ##used median as start parameters for the final fitting - a <- median(na.exclude(a.start)) - b <- median(na.exclude(b.start)) - c <- median(na.exclude(c.start)) - - ##exception for b: if b is 1 it is likely to b wrong and should be reset - if(!is.na(b) && b == 1) - b <- mean(b.MC) - - #FINAL Fit curve on given values - fit <- try(minpack.lm::nlsLM( - formula = .toFormula(fit.functionEXP, env = currn_env), - data = data, - start = list(a = a, b = b,c = 0), - weights = fit.weights, - trace = FALSE, - algorithm = "LM", - lower = if (fit.bounds) { - c(0,0,0) - }else{ - c(-Inf,-Inf,-Inf) - }, - upper = if (fit.force_through_origin) { - c(Inf, Inf, 0) - }else{ - c(Inf, Inf, Inf) - }, - control = minpack.lm::nls.lm.control(maxiter = 500) - ), silent = TRUE - ) - - if (inherits(fit, "try-error") & inherits(fit.initial, "try-error")){ - if(verbose) writeLines("[plot_GrowthCurve()] try-error for EXP fit") - - }else{ - ##this is to avoid the singular convergence failure due to a perfect fit at the beginning - ##this may happen especially for simulated data - if(inherits(fit, "try-error") & !inherits(fit.initial, "try-error")){ - fit <- fit.initial - rm(fit.initial) - - } - - #get parameters out of it - parameters <- (coef(fit)) - b <- as.vector((parameters["b"])) - a <- as.vector((parameters["a"])) - c <- as.vector((parameters["c"])) - - #calculate De - De <- NA - if(mode == "interpolation"){ - De <- suppressWarnings(-c-b*log(1-sample[1,2]/a)) - - ## account for the fact that we can still calculate a De that is negative - ## even it does not make sense - if(!is.na(De) && De < 0) - De <- NA - - }else if (mode == "extrapolation"){ - De <- suppressWarnings(-c-b*log(1-0/a)) - } - - #print D01 value - D01 <- b - if (verbose) { - if (mode != "alternate") { - writeLines(paste0( - "[plot_GrowthCurve()] Fit: ", - fit.method, - " (", - mode, - ")", - " | De = ", - round(abs(De), digits = 2), - " | D01 = ", - round(D01, 2) - )) - } - } - - #EXP MC ----- - ##Monte Carlo Simulation - # --Fit many curves and calculate a new De +/- De_Error - # --take De_Error - - #set variables - var.b<-vector(mode="numeric", length=NumberIterations.MC) - var.a<-vector(mode="numeric", length=NumberIterations.MC) - var.c<-vector(mode="numeric", length=NumberIterations.MC) - - #start loop - for (i in 1:NumberIterations.MC) { - ##set data set - data <- data.frame(x = xy$x,y = data.MC[,i]) - - fit.MC <- try(minpack.lm::nlsLM( - formula = .toFormula(fit.functionEXP, env = currn_env), - data = data, - start = list(a = a, b = b, c = c), - weights = fit.weights, - trace = FALSE, - algorithm = "LM", - lower = if (fit.bounds) { - c(0,0,0) - }else{ - c(-Inf,-Inf,-Inf) - }, - upper = if (fit.force_through_origin) { - c(Inf, Inf, 0) - }else{ - c(Inf, Inf, Inf) - }, - control = minpack.lm::nls.lm.control(maxiter = 500) - ), silent = TRUE - ) - - #get parameters out of it including error handling - if (inherits(fit.MC, "try-error")) { - x.natural[i] <- NA - - }else { - #get parameters out - parameters<-coef(fit.MC) - var.b[i]<-as.vector((parameters["b"])) #D0 - var.a[i]<-as.vector((parameters["a"])) #Imax - var.c[i]<-as.vector((parameters["c"])) - - #calculate x.natural for error calculation - if(mode == "interpolation"){ - x.natural[i]<-suppressWarnings( - -var.c[i]-var.b[i]*log(1-data.MC.De[i]/var.a[i])) - - }else if(mode == "extrapolation"){ - x.natural[i]<-suppressWarnings( - abs(-var.c[i]-var.b[i]*log(1-0/var.a[i]))) - - }else{ - x.natural[i] <- NA - - } - } - - }#end for loop - - - ##write D01.ERROR - D01.ERROR <- sd(var.b, na.rm = TRUE) - - ##remove values - rm(var.b, var.a, var.c) - - }#endif::try-error fit - - }#endif:fit.method!="LIN" - ##LIN ----- - ##two options: just linear fit or LIN fit after the EXP fit failed - - #set fit object, if fit object was not set before - if(exists("fit")==FALSE){fit<-NA} - - if ((fit.method=="EXP OR LIN" & inherits(fit, "try-error")) | - fit.method=="LIN" | length(data[,1])<2) { - - ##Do fitting again as just allows fitting through the origin - if(fit.force_through_origin){ - fit.lm<-lm(data$y ~ 0 + data$x, weights = fit.weights) - - #calculate De - De <- 0 - if(mode == "interpolation"){ - De <- sample[1,2]/fit.lm$coefficients[1] - } - - }else{ - fit.lm<-lm(data$y ~ data$x, weights = fit.weights) - - #calculate De - if(mode == "interpolation"){ - De <- (sample[1,2]-fit.lm$coefficients[1])/fit.lm$coefficients[2] - - }else if(mode == "extrapolation"){ - De <- (0-fit.lm$coefficients[1])/fit.lm$coefficients[2] - - } - - } - - ##remove vector labels - De <- as.numeric(as.character(De)) - - if (verbose) { - if (mode != "alternate") { - writeLines(paste0( - "[plot_GrowthCurve()] Fit: ", - fit.method, - " (", - mode, - ") ", - "| De = ", - round(abs(De), 2) - )) - - } - - } - - #start loop for Monte Carlo Error estimation - #LIN MC --------- - for (i in 1:NumberIterations.MC) { - data <- data.frame(x = xy$x, y = data.MC[, i]) - if(fit.force_through_origin){ - ##do fitting - fit.lmMC <- lm(data$y ~ 0 + data$x, weights=fit.weights) - - #calculate x.natural - if(mode == "interpolation"){ - x.natural[i] <- data.MC.De[i]/fit.lmMC$coefficients[1] - - }else if (mode == "extrapolation"){ - x.natural[i] <- 0 - - } - - }else{ - ##do fitting - fit.lmMC <- lm(data$y~ data$x, weights=fit.weights) - - #calculate x.natural - if(mode == "interpolation"){ - x.natural[i] <- (data.MC.De[i]-fit.lmMC$coefficients[1])/ - fit.lmMC$coefficients[2] - - }else if (mode == "extrapolation"){ - x.natural[i] <- abs((0-fit.lmMC$coefficients[1])/ - fit.lmMC$coefficients[2]) - - } - - } - - }#endfor::loop for MC - - #correct for fit.method - fit.method <- "LIN" - - ##set fit object - if(fit.method=="LIN"){fit<-fit.lm} - - }else{fit.method<-"EXP"}#endif::LIN - }#end if EXP (this includes the LIN fit option) - #=========================================================================== # - #=========================================================================== # - # EXP+LIN ---- - else if (fit.method=="EXP+LIN") { - ##try some start parameters from the input values to makes the fitting more stable - for(i in 1:length(a.MC)){ - a<-a.MC[i];b<-b.MC[i];c<-c.MC[i];g<-g.MC[i] - - ##---------------------------------------------------------## - ##start: with EXP function - fit.EXP <- try({ - nls( - formula = .toFormula(fit.functionEXP, env = currn_env), - data = data, - start = c(a=a,b=b,c=c), - trace = FALSE, - algorithm = "port", - lower = c(a=0, b>10, c = 0), - control = nls.control(maxiter=100,warnOnly=FALSE,minFactor=1/1024) - )}, - silent=TRUE) - - if(!inherits(fit.EXP, "try-error")){ - #get parameters out of it - parameters<-(coef(fit.EXP)) - b<-as.vector((parameters["b"])) - a<-as.vector((parameters["a"])) - c<-as.vector((parameters["c"])) - - ##end: with EXP function - ##---------------------------------------------------------## - - - } - - fit<-try({ - nls( - formula = .toFormula(fit.functionEXPLIN, env = currn_env), - data = data, - start = c(a=a,b=b,c=c,g=g), - trace = FALSE, - algorithm = "port", - lower = if(fit.bounds){ - c(a=0,b>10,c=0,g=0)} - else{c(a = -Inf,b = -Inf,c = -Inf,g = -Inf) - }, - control = nls.control( - maxiter = 500, - warnOnly = FALSE, - minFactor = 1/2048) #increase max. iterations - )}, silent=TRUE) - - if(!inherits(fit, "try-error")){ - #get parameters out of it - parameters<-(coef(fit)) - b.start[i] <- as.vector((parameters["b"])) - a.start[i] <- as.vector((parameters["a"])) - c.start[i] <- as.vector((parameters["c"])) - g.start[i] <- as.vector((parameters["g"])) - } - - }##end for loop - ##used mean as start parameters for the final fitting - a <- median(na.exclude(a.start)) - b <- median(na.exclude(b.start)) - c <- median(na.exclude(c.start)) - g <- median(na.exclude(g.start)) - - ##perform final fitting - fit <- try(minpack.lm::nlsLM( - formula = .toFormula(fit.functionEXPLIN, env = currn_env), - data = data, - start = list(a = a, b = b,c = c, g = g), - weights = fit.weights, - trace = FALSE, - algorithm = "LM", - lower = if (fit.bounds) { - c(0,10,0,0) - }else{ - c(-Inf,-Inf,-Inf,-Inf) - }, - upper = if (fit.force_through_origin) { - c(Inf, Inf, 0, Inf) - }else{ - c(Inf, Inf, Inf, Inf) - }, - control = minpack.lm::nls.lm.control(maxiter = 500) - ), silent = TRUE - ) - - - #if try error stop calculation - if(!inherits(fit, "try-error")){ - #get parameters out of it - parameters <- coef(fit) - b <- as.vector((parameters["b"])) - a <- as.vector((parameters["a"])) - c <- as.vector((parameters["c"])) - g <- as.vector((parameters["g"])) - - #problem: analytically it is not easy to calculate x, - #use uniroot to solve that problem ... readjust function first - De <- NA - if (mode == "interpolation") { - f.unirootEXPLIN <- - function(a, b, c, g, x, LnTn) { - fit.functionEXPLIN(a, b, c, g, x) - LnTn - } - - temp.De <- try(uniroot( - f = f.unirootEXPLIN, - interval = c(0, max(xy$x) * 1.5), - tol = 0.001, - a = a, - b = b, - c = c, - g = g, - LnTn = sample[1, 2], - extendInt = "yes", - maxiter = 3000 - ), - silent = TRUE) - - if (!inherits(temp.De, "try-error")) { - De <- temp.De$root - } - }else if(mode == "extrapolation"){ - f.unirootEXPLIN <- - function(a, b, c, g, x, LnTn) { - fit.functionEXPLIN(a, b, c, g, x) - LnTn - } - - temp.De <- try(uniroot( - f = f.unirootEXPLIN, - interval = c(-1e06, max(xy$x) * 1.5), - tol = 0.001, - a = a, - b = b, - c = c, - g = g, - LnTn = 0, - extendInt = "yes", - maxiter = 3000 - ), - silent = TRUE) - - if (!inherits(temp.De, "try-error")) { - De <- temp.De$root - } - } - - if (verbose) { - if (mode != "alternate") { - writeLines(paste0( - "[plot_GrowthCurve()] Fit: ", - fit.method, - " (", - mode, - ")" - , - " | De = ", - round(abs(De),2) - )) - } - } - - ##Monte Carlo Simulation for error estimation - # --Fit many curves and calculate a new De +/- De_Error - # --take De_Error - - #set variables - var.b <- vector(mode="numeric", length=NumberIterations.MC) - var.a <- vector(mode="numeric", length=NumberIterations.MC) - var.c <- vector(mode="numeric", length=NumberIterations.MC) - var.g <- vector(mode="numeric", length=NumberIterations.MC) - - ##set progressbar - if(txtProgressBar){ - cat("\n\t Run Monte Carlo loops for error estimation of the EXP+LIN fit\n") - pb <- txtProgressBar(min=0,max=NumberIterations.MC, char="=", style=3) - } - - #start Monto Carlo loops - for(i in 1:NumberIterations.MC){ - data <- data.frame(x=xy$x,y=data.MC[,i]) - - ##perform MC fitting - fit.MC <- try(minpack.lm::nlsLM( - formula = .toFormula(fit.functionEXPLIN, env = currn_env), - data = data, - start = list(a = a, b = b,c = c, g = g), - weights = fit.weights, - trace = FALSE, - algorithm = "LM", - lower = if (fit.bounds) { - c(0,10,0,0) - }else{ - c(-Inf,-Inf,-Inf, -Inf) - }, - control = minpack.lm::nls.lm.control(maxiter = 500) - ), silent = TRUE - ) - - #get parameters out of it including error handling - if (inherits(fit.MC, "try-error")) { - x.natural[i] <- NA - - }else { - parameters <- coef(fit.MC) - var.b[i] <- as.vector((parameters["b"])) - var.a[i] <- as.vector((parameters["a"])) - var.c[i] <- as.vector((parameters["c"])) - var.g[i] <- as.vector((parameters["g"])) - - #problem: analytical it is not easy to calculate x, - #use uniroot to solve this problem - if (mode == "interpolation") { - temp.De.MC <- try(uniroot( - f = f.unirootEXPLIN, - interval = c(0, max(xy$x) * 1.5), - tol = 0.001, - a = var.a[i], - b = var.b[i], - c = var.c[i], - g = var.g[i], - LnTn = data.MC.De[i] - ), - silent = TRUE) - - if (!inherits(temp.De.MC, "try-error")) { - x.natural[i] <- temp.De.MC$root - } else{ - x.natural[i] <- NA - } - - } else if (mode == "extrapolation"){ - temp.De.MC <- try(uniroot( - f = f.unirootEXPLIN, - interval = c(-1e6, max(xy$x) * 1.5), - tol = 0.001, - a = var.a[i], - b = var.b[i], - c = var.c[i], - g = var.g[i], - LnTn = 0 - ), - silent = TRUE) - - if (!inherits(temp.De.MC, "try-error")) { - x.natural[i] <- abs(temp.De.MC$root) - } else{ - x.natural[i] <- NA - } - - }else{ - x.natural[i] <- NA - - } - - } - ##update progress bar - if(txtProgressBar) setTxtProgressBar(pb, i) - - }#end for loop - - ##close - if(txtProgressBar) close(pb) - - ##remove objects - rm(var.b, var.a, var.c, var.g) - - }else{ - #print message - if (verbose) { - if (mode != "alternate") { - writeLines(paste0( - "[plot_GrowthCurve()] Fit: ", - fit.method, - " | De = NA (fitting FAILED)" - )) - - } - } - - - } #end if "try-error" Fit Method - - } #End if EXP+LIN - #EXP+EXP --------------------------------------------------------------------- - else if (fit.method == "EXP+EXP") { - a1.start <- NA - a2.start <- NA - b1.start <- NA - b2.start <- NA - - ## try to create some start parameters from the input values to make the fitting more stable - for(i in 1:50) { - a1 <- a.MC[i];b1 <- b.MC[i]; - a2 <- a.MC[i] / 2; b2 <- b.MC[i] / 2 - - fit.start <- try({ - nls(formula = .toFormula(fit.functionEXPEXP, env = currn_env), - data = data, - start = c( - a1 = a1,a2 = a2,b1 = b1,b2 = b2 - ), - trace = FALSE, - algorithm = "port", - lower = c(a1 > 0,a2 > 0,b1 > 0,b2 > 0), - nls.control( - maxiter = 500,warnOnly = FALSE,minFactor = 1 / 2048 - ) #increase max. iterations - )}, - silent = TRUE) - - if (!inherits(fit.start, "try-error")) { - #get parameters out of it - parameters <- coef(fit.start) - a1.start[i] <- as.vector((parameters["a1"])) - b1.start[i] <- as.vector((parameters["b1"])) - a2.start[i] <- as.vector((parameters["a2"])) - b2.start[i] <- as.vector((parameters["b2"])) - } - } - - ##use obtained parameters for fit input - a1.start <- median(a1.start, na.rm = TRUE) - b1.start <- median(b1.start, na.rm = TRUE) - a2.start <- median(a2.start, na.rm = TRUE) - b2.start <- median(b2.start, na.rm = TRUE) - - ##perform final fitting - fit <- try(minpack.lm::nlsLM( - formula = .toFormula(fit.functionEXPEXP, env = currn_env), - data = data, - start = list(a1 = a1, b1 = b1, a2 = a2, b2 = b2), - weights = fit.weights, - trace = FALSE, - algorithm = "LM", - lower = if (fit.bounds) { - c(0,0,0,0) - }else{ - c(-Inf,-Inf,-Inf, -Inf) - }, - control = minpack.lm::nls.lm.control(maxiter = 500) - ), silent = TRUE - ) - - ##insert if for try-error - if (!inherits(fit, "try-error")) { - #get parameters out of it - parameters <- coef(fit) - b1 <- as.vector((parameters["b1"])) - b2 <- as.vector((parameters["b2"])) - a1 <- as.vector((parameters["a1"])) - a2 <- as.vector((parameters["a2"])) - - ##set D0 values - D01 <- round(b1,digits = 2) - D02 <- round(b2,digits = 2) - - #problem: analytically it is not easy to calculate x, use uniroot - De <- NA - if (mode == "interpolation") { - f.unirootEXPEXP <- - function(a1, a2, b1, b2, x, LnTn) { - fit.functionEXPEXP(a1, a2, b1, b2, x) - LnTn - } - - temp.De <- try(uniroot( - f = f.unirootEXPEXP, - interval = c(0, max(xy$x) * 1.5), - tol = 0.001, - a1 = a1, - a2 = a2, - b1 = b1, - b2 = b2, - LnTn = sample[1, 2], - extendInt = "yes", - maxiter = 3000 - ), - silent = TRUE) - - if (!inherits(temp.De, "try-error")) { - De <- temp.De$root - } - - ##remove object - rm(temp.De) - - }else if (mode == "extrapolation"){ - .throw_error("mode 'extrapolation' for fitting method 'EXP+EXP' ", - "currently not supported") - } - - #print D0 and De value values - if(verbose){ - if(mode != "alternate"){ - writeLines(paste0("[plot_GrowthCurve()] Fit: ", fit.method, " | De = ", De, "| D01 = ",D01, " | D02 = ",D02)) - } - } - - ##Monte Carlo Simulation for error estimation - # --Fit many curves and calculate a new De +/- De_Error - # --take De_Error from the simulation - # --comparison of De from the MC and original fitted De gives a value for quality - - #set variables - var.b1 <- vector(mode="numeric", length=NumberIterations.MC) - var.b2 <- vector(mode="numeric", length=NumberIterations.MC) - var.a1 <- vector(mode="numeric", length=NumberIterations.MC) - var.a2 <- vector(mode="numeric", length=NumberIterations.MC) - - ##progress bar - if(txtProgressBar){ - cat("\n\t Run Monte Carlo loops for error estimation of the EXP+EXP fit\n") - pb<-txtProgressBar(min=0,max=NumberIterations.MC, initial=0, char="=", style=3) - } - - #start Monto Carlo loops - for (i in 1:NumberIterations.MC) { - #update progress bar - if(txtProgressBar) setTxtProgressBar(pb,i) - - data<-data.frame(x=xy$x,y=data.MC[,i]) - - ##perform final fitting - fit.MC <- try(minpack.lm::nlsLM( - formula = .toFormula(fit.functionEXPEXP, env = currn_env), - data = data, - start = list(a1 = a1, b1 = b1, a2 = a2, b2 = b2), - weights = fit.weights, - trace = FALSE, - algorithm = "LM", - lower = if (fit.bounds) { - c(0,0,0,0) - }else{ - c(-Inf,-Inf,-Inf, -Inf) - }, - control = minpack.lm::nls.lm.control(maxiter = 500) - ), silent = TRUE - ) - - #get parameters out of it including error handling - if (inherits(fit.MC, "try-error")) { - x.natural[i]<-NA - - }else { - parameters <- (coef(fit.MC)) - var.b1[i] <- as.vector((parameters["b1"])) - var.b2[i] <- as.vector((parameters["b2"])) - var.a1[i] <- as.vector((parameters["a1"])) - var.a2[i] <- as.vector((parameters["a2"])) - - #problem: analytically it is not easy to calculate x, here an simple approximation is made - - temp.De.MC <- try(uniroot( - f = f.unirootEXPEXP, - interval = c(0,max(xy$x) * 1.5), - tol = 0.001, - a1 = var.a1[i], - a2 = var.a2[i], - b1 = var.b1[i], - b2 = var.b2[i], - LnTn = data.MC.De[i] - ), silent = TRUE) - - if (!inherits(temp.De.MC, "try-error")) { - x.natural[i] <- temp.De.MC$root - }else{ - x.natural[i] <- NA - } - - } #end if "try-error" MC simulation - - } #end for loop - - ##write D01.ERROR - D01.ERROR <- sd(var.b1, na.rm = TRUE) - D02.ERROR <- sd(var.b2, na.rm = TRUE) - - ##remove values - rm(var.b1, var.b2, var.a1, var.a2) - - }else{ - #print message - if(verbose){ - writeLines(paste0("[plot_GrowthCurve()] Fit: ", fit.method, " | De = NA (fitting FAILED)")) - - } - - } #end if "try-error" Fit Method - - ##close - if(txtProgressBar) if(exists("pb")){close(pb)} - - } - else if (fit.method[1] == "GOK") { - # GOK ----- - fit <- try(minpack.lm::nlsLM( - formula = .toFormula(fit.functionGOK, env = currn_env), - data = data, - start = list(a = a, b = b, c = 1, d = 1), - weights = fit.weights, - trace = FALSE, - algorithm = "LM", - lower = if (fit.bounds) c(0,0,0,0) else c(-Inf,-Inf,-Inf,-Inf), - upper = if(fit.force_through_origin) c(Inf, Inf, Inf, 1) else c(Inf, Inf, Inf, Inf), - control = minpack.lm::nls.lm.control(maxiter = 500) - ), silent = TRUE) - - if (inherits(fit, "try-error")){ - if(verbose) writeLines("[plot_GrowthCurve()] try-error for GOK fit") - - }else{ - #get parameters out of it - parameters <- (coef(fit)) - b <- as.vector((parameters["b"])) - a <- as.vector((parameters["a"])) - c <- as.vector((parameters["c"])) - d <- as.vector((parameters["d"])) - - #calculate De - y <- sample[1,2] - De <- switch( - mode, - "interpolation" = suppressWarnings(-(b * (( (a * d - y)/a)^c - 1) * ( ((a * d - y)/a)^-c )) / c), - "extrapolation" = suppressWarnings(-(b * (( (a * d - 0)/a)^c - 1) * ( ((a * d - 0)/a)^-c )) / c), - NA) - - #print D01 value - D01 <- b - - if (verbose) { - if (mode != "alternate") { - writeLines(paste0( - "[plot_GrowthCurve()] Fit: ", - fit.method, - " (", - mode, - ")", - " | De = ", - round(abs(De), digits = 2), - " | D01 = ", - round(D01,2), - " | c = ", - round(c, digits = 2) - )) - } - } - - #EXP MC ----- - ##Monte Carlo Simulation - # --Fit many curves and calculate a new De +/- De_Error - # --take De_Error - - #set variables - var.b <- vector(mode = "numeric", length = NumberIterations.MC) - var.a <- vector(mode = "numeric", length = NumberIterations.MC) - var.c <- vector(mode = "numeric", length = NumberIterations.MC) - var.d <- vector(mode = "numeric", length = NumberIterations.MC) - - #start loop - for (i in 1:NumberIterations.MC) { - ##set data set - data <- data.frame(x = xy$x,y = data.MC[,i]) - - fit.MC <- try({ - minpack.lm::nlsLM( - formula = .toFormula(fit.functionGOK, env = currn_env), - data = data, - start = list(a = a, b = b, c = 1, d = 1), - weights = fit.weights, - trace = FALSE, - algorithm = "LM", - lower = if (fit.bounds) { - c(0,0,0,0) - }else{ - c(-Inf,-Inf,-Inf, -Inf) - }, - upper = if(fit.force_through_origin) c(Inf, Inf, Inf, 1) else c(Inf, Inf, Inf, Inf), - control = minpack.lm::nls.lm.control(maxiter = 500) - )}, silent = TRUE) - - # get parameters out of it including error handling - if (inherits(fit.MC, "try-error")) { - x.natural[i] <- NA - - } else { - # get parameters out - parameters<-coef(fit.MC) - var.b[i] <- as.vector((parameters["b"])) #D0 - var.a[i] <- as.vector((parameters["a"])) #Imax - var.c[i] <- as.vector((parameters["c"])) #kinetic order modifier - var.d[i] <- as.vector((parameters["d"])) #origin - - # calculate x.natural for error calculation - x.natural[i] <- switch( - mode, - "interpolation" = suppressWarnings(-(var.b[i] * (( (var.a[i] * var.d[i] - data.MC.De[i])/var.a[i])^var.c[i] - 1) * - (((var.a[i] * var.d[i] - data.MC.De[i])/var.a[i])^-var.c[i] )) / var.c[i]), - "extrapolation" = suppressWarnings(abs(-(var.b[i] * (( (var.a[i] * var.d[i] - 0)/var.a[i])^var.c[i] - 1) * - ( ((var.a[i] * var.d[i] - 0)/var.a[i])^-var.c[i] )) / var.c[i])), - NA) - - } - - }#end for loop - - ##write D01.ERROR - D01.ERROR <- sd(var.b, na.rm = TRUE) - - ##remove values - rm(var.b, var.a, var.c) - } - } else if (fit.method == "LambertW") { - # LambertW ----- - if(mode == "extrapolation"){ - Dint_lower <- 50 ##TODO - fragile ... however it is only used by a few - - } else{ - Dint_lower <- 0.01 - - } - - fit <- try(minpack.lm::nlsLM( - formula = .toFormula(fit.functionLambertW, env = currn_env), - data = data, - start = list(R = 0, Dc = b, N = b, Dint = 0), - weights = fit.weights, - trace = FALSE, - algorithm = "LM", - lower = if (fit.bounds) c(0, 0, 0, Dint_lower) else c(-Inf,-Inf,-Inf, -Inf), - upper = if(fit.force_through_origin) c(10, Inf, Inf, 0) else c(10, Inf, Inf, Inf), - control = minpack.lm::nls.lm.control(maxiter = 500) - ), silent = TRUE) - - if (inherits(fit, "try-error")){ - if(verbose) writeLines("[plot_GrowthCurve()] try-error for LambertW fit") - - }else{ - #get parameters out of it - parameters <- coef(fit) - R <- as.vector((parameters["R"])) - Dc <- as.vector((parameters["Dc"])) - N <- as.vector((parameters["N"])) - Dint <- as.vector((parameters["Dint"])) - - #calculate De - if(mode == "interpolation"){ - De <- try(suppressWarnings(stats::uniroot( - f = function(x, R, Dc, N, Dint, LnTn) { - fit.functionLambertW(R, Dc, N, Dint, x) - LnTn}, - interval = c(0, max(sample[[1]]) * 1.2), - R = R, - Dc = Dc, - N = N, - Dint = Dint, - LnTn = sample[1,2])$root), silent = TRUE) - - }else if (mode == "extrapolation"){ - De <- try(suppressWarnings(stats::uniroot( - f = function(x, R, Dc, N, Dint) { - fit.functionLambertW(R, Dc, N, Dint, x)}, - interval = c(-max(sample[[1]]),0), - R = R, - Dc = Dc, - N = N, - Dint = Dint)$root), silent = TRUE) - - ## there are cases where the function cannot calculate the root - ## due to its shape, here we have to use the minimum - if(inherits(De, "try-error")){ - warning( - "[plot_GrowthCurve()] Standard root estimation using stats::uniroot() failed. - Using stats::optimize() instead, which may lead, however, to unexpected and - inconclusive results for fit.method = 'LambertW'!", - call. = FALSE) - - De <- try(suppressWarnings(stats::optimize( - f = function(x, R, Dc, N, Dint) { - fit.functionLambertW(R, Dc, N, Dint, x)}, - interval = c(-max(sample[[1]]),0), - R = R, - Dc = Dc, - N = N, - Dint = Dint)$minimum), silent = TRUE) - } - - } - - if(inherits(De, "try-error")) De <- NA - if (verbose) { - if (mode != "alternate") { - writeLines(paste0( - "[plot_GrowthCurve()] Fit: ", - fit.method, - " (", - mode, - ")", - " | De = ", - round(abs(De), digits = 2), - " | R = ", - round(R,2), - " | Dc = ", - round(Dc, digits = 2) - )) - } - } - - #LambertW MC ----- - ##Monte Carlo Simulation - # --Fit many curves and calculate a new De +/- De_Error - # --take De_Error - #set variables - var.R <- var.Dc <- var.N <- var.Dint <- vector( - mode = "numeric", length = NumberIterations.MC) - - #start loop - for (i in 1:NumberIterations.MC) { - ##set data set - data <- data.frame(x = xy$x,y = data.MC[,i]) - fit.MC <- try(minpack.lm::nlsLM( - formula = .toFormula(fit.functionLambertW, env = currn_env), - data = data, - start = list(R = 0, Dc = b, N = 0, Dint = 0), - weights = fit.weights, - trace = FALSE, - algorithm = "LM", - lower = if (fit.bounds) c(0, 0, 0, Dint*runif(1,0,2)) else c(-Inf,-Inf,-Inf, -Inf), - upper = if(fit.force_through_origin) c(10, Inf, Inf, 0) else c(10, Inf, Inf, Inf), - control = minpack.lm::nls.lm.control(maxiter = 500) - ), silent = TRUE) - - # get parameters out of it including error handling - x.natural[i] <- NA - if (!inherits(fit.MC, "try-error")) { - # get parameters out - parameters<-coef(fit.MC) - var.R[i] <- as.vector((parameters["R"])) - var.Dc[i] <- as.vector((parameters["Dc"])) - var.N[i] <- as.vector((parameters["N"])) - var.Dint[i] <- as.vector((parameters["Dint"])) - - # calculate x.natural for error calculation - if(mode == "interpolation"){ - try <- try( - {suppressWarnings(stats::uniroot( - f = function(x, R, Dc, N, Dint, LnTn) { - fit.functionLambertW(R, Dc, N, Dint, x) - LnTn}, - interval = c(0, max(sample[[1]]) * 1.2), - R = var.R[i], - Dc = var.Dc[i], - N = var.N[i], - Dint = var.Dint[i], - LnTn = data.MC.De[i])$root) - }, silent = TRUE) - - }else if(mode == "extrapolation"){ - try <- try( - suppressWarnings(stats::uniroot( - f = function(x, R, Dc, N, Dint) { - fit.functionLambertW(R, Dc, N, Dint, x)}, - interval = c(-max(sample[[1]]), 0), - R = var.R[i], - Dc = var.Dc[i], - N = var.N[i], - Dint = var.Dint[i])$root), - silent = TRUE) - - if(inherits(try, "try-error")){ - try <- try(suppressWarnings(stats::optimize( - f = function(x, R, Dc, N, Dint) { - fit.functionLambertW(R, Dc, N, Dint, x)}, - interval = c(-max(sample[[1]]),0), - R = var.R[i], - Dc = var.Dc[i], - N = var.N[i], - Dint = var.Dint[i])$minimum), - silent = TRUE) - } - }##endif extrapolation - if(!inherits(try, "try-error") && !inherits(try, "function")) - x.natural[i] <- try - - } - - }#end for loop - - ##we need absolute numbers - x.natural <- abs(x.natural) - - ##write Dc.ERROR - Dc.ERROR <- sd(var.Dc, na.rm = TRUE) - - ##remove values - rm(var.R, var.Dc, var.N, var.Dint) - - }#endif::try-error fit - }#End if Fit Method - - #Get De values from Monte Carlo simulation - - #calculate mean and sd (ignore NaN values) - De.MonteCarlo <- mean(na.exclude(x.natural)) - - #De.Error is Error of the whole De (ignore NaN values) - De.Error <- sd(na.exclude(x.natural)) - - # Formula creation -------------------------------------------------------- - - ## This information is part of the fit object output anyway, but - ## we keep it here for legacy reasons - fit_formula <- NA - if(!inherits(fit, "try-error") && !is.na(fit[1])) - fit_formula <- .replace_coef(fit) - -# Plotting ------------------------------------------------------------------------------------ - ##5. Plotting if plotOutput==TRUE - if(output.plot) { - ## Deal with extra arguments -------------------------- - extraArgs <- list(...) - - main <- if("main" %in% names(extraArgs)) {extraArgs$main} else - {"Dose-response curve"} - - xlab <- if("xlab" %in% names(extraArgs)) {extraArgs$xlab} else - {"Dose [s]"} - - ylab <- if("ylab" %in% names(extraArgs)) {extraArgs$ylab} else - { - if(mode == "regenration"){ - expression(L[x]/T[x]) - - }else{ - "Luminescence [a.u.]" - } - - } - - if("cex" %in% names(extraArgs)) {cex.global <- extraArgs$cex} - - ylim <- if("ylim" %in% names(extraArgs)) { - extraArgs$ylim - } else { - if(fit.force_through_origin | mode == "extrapolation"){ - c(0-max(y.Error),(max(xy$y)+if(max(xy$y)*0.1>1.5){1.5}else{max(xy$y)*0.2})) - - }else{ - c(0,(max(xy$y)+if(max(xy$y)*0.1>1.5){1.5}else{max(xy$y)*0.2})) - } - - } - - xlim <- if("xlim" %in% names(extraArgs)) {extraArgs$xlim} else - { - if(mode != "extrapolation"){ - c(0,(max(xy$x)+if(max(xy$x)*0.4>50){50}else{max(xy$x)*0.4})) - - }else{ - if(!is.na(De)){ - if(De > 0){ - c(0,(max(xy$x)+if(max(xy$x)*0.4>50){50}else{max(xy$x)*0.4})) - - }else{ - c(De * 2,(max(xy$x)+if(max(xy$x)*0.4>50){50}else{max(xy$x)*0.4})) - - } - - }else{ - c(-min(xy$x) * 2,(max(xy$x)+if(max(xy$x)*0.4>50){50}else{max(xy$x)*0.4})) - - } - } - } - - fun <- if ("fun" %in% names(extraArgs)) extraArgs$fun else FALSE # nocov - - ##set plot check - plot_check <- NULL - - ##cheat the R check - x <- NULL; rm(x) - - #PAR #open plot area - if(output.plot == TRUE & - output.plotExtended == TRUE & - output.plotExtended.single == FALSE){ - - ## safe par settings - par.old.full <- par(no.readonly = TRUE) - on.exit(par(par.old.full)) - - ##set new parameter - layout(matrix(c(1, 1, 1, 1, 2, 3), 3, 2, byrow = TRUE), respect = TRUE) - par(cex = 0.8 * cex.global) - - } else { - par(cex = cex.global) - - } - - #PLOT #Plot input values - ##Make selection to support manual number of reg points input - if(exists("fit.RegPointsReal")){ - ##here the object sample has to be used otherwise the first regeneration point is not plotted. - temp.xy.plot <- sample[fit.RegPointsReal,] - - } else { - temp.xy.plot <- xy[1:fit.NumberRegPointsReal,] - - } - - plot_check <- try(plot( - temp.xy.plot[, 1:2], - ylim = ylim, - xlim = xlim, - pch = 19, - xlab = xlab, - ylab = ylab - ), - silent = TRUE) - - if (!is(plot_check, "try-error")) { - if(mode == "extrapolation"){ - abline(v = 0, lty = 1, col = "grey") - abline(h = 0, lty = 1, col = "grey") - - } - - ### add header -------- - title(main = main, line = NA) - - ## add curve ------- - if(inherits(fit_formula, "expression")) { - x <- seq(par()$usr[1], par()$usr[2], length.out = 100) - lines(x, eval(fit_formula)) - } - - ## add points ------- - ##POINTS #Plot Reg0 and Repeated Points - - #Natural value - if(mode == "interpolation"){ - points(sample[1, 1:2], col = "red") - segments(sample[1, 1], sample[1, 2] - sample[1, 3], - sample[1, 1], sample[1, 2] + sample[1, 3], col = "red") - - }else if (mode == "extrapolation"){ - points(x = De, y = 0, col = "red") - - } - - #repeated Point - points( - x = xy[which(duplicated(xy[, 1])), 1], - y = xy[which(duplicated(xy[, 1])), 2], - pch = 2) - - #reg Point 0 - points( - x = xy[which(xy == 0), 1], - y = xy[which(xy == 0), 2], - pch = 1, - cex = 1.5 * cex.global) - - ##ARROWS #y-error Bar - segments(xy$x, xy$y - y.Error, xy$x, xy$y + y.Error) - - ##LINES #Insert Ln/Tn - if (mode == "interpolation") { - if (is.na(De)) { - lines( - c(par()$usr[1], max(sample[, 1]) * 2), - c(sample[1, 2], sample[1, 2]), - col = "red", - lty = 2, - lwd = 1.25) - - } else { - try(lines( - c(par()$usr[1], De), - c(sample[1, 2], sample[1, 2]), - col = "red", - lty = 2, - lwd = 1.25 - ), silent = TRUE) - - } - try(lines( - c(De, De), - c(par()$usr[3], sample[1, 2]), - col = "red", - lty = 2, - lwd = 1.25), silent = TRUE) - try(points(De, sample[1, 2], col = "red", pch = 19), silent = TRUE) - - } else if (mode == "extrapolation"){ - if(!is.na(De)){ - abline(v = De, lty = 2, col = "red") - lines(x = c(0,De), y = c(0,0), lty = 2, col = "red") - - } - - } - - ## check/set mtext - mtext <- if ("mtext" %in% names(list(...))) { - list(...)$mtext - } else { - if(mode != "alternate"){ - substitute(D[e] == De, - list(De = paste( - round(abs(De), digits = 2), "\u00B1", format(De.Error, scientific = TRUE, digits = 2), " | fit: ", fit.method - ))) - }else{ - "" - } - } - - ##TEXT #Insert fit and result - try(mtext(side = 3, - mtext, - line = 0, - cex = 0.8 * cex.global), silent = TRUE) - - #write error message in plot if De is NaN - try(if (De == "NaN") { - text( - sample[2, 1], - 0, - "Error: De could not be calculated!", - adj = c(0, 0), - cex = 0.8, - col = "red" - ) - }, silent = TRUE) - - ##LEGEND #plot legend - if (mode == "interpolation") { - legend( - "topleft", - c("REG point", "REG point repeated", "REG point 0"), - pch = c(19, 2, 1), - cex = 0.8 * cex.global, - bty = "n" - ) - }else{ - legend( - "bottomright", - c("Dose point", "Dose point rep.", "Dose point 0"), - pch = c(19, 2, 1), - cex = 0.8 * cex.global, - bty = "n" - ) - - } - - ##plot only if wanted - if (output.plot == TRUE & output.plotExtended == TRUE) { - ##HIST #try to plot histogram of De values from the Monte Carlo simulation - - if (output.plotExtended.single != TRUE) { - par(cex = 0.7 * cex.global) - - } - - ##(A) Calculate histogram data - try(histogram <- hist(x.natural, plot = FALSE), silent = TRUE) - - #to avoid errors plot only if histogram exists - if (exists("histogram") && length(histogram$counts) > 2) { - ##calculate normal distribution curves for overlay - norm.curve.x <- seq(min(x.natural, na.rm = TRUE), - max(x.natural, na.rm = TRUE), - length = 101) - - norm.curve.y <- dnorm( - norm.curve.x, - mean = mean(x.natural, na.rm = TRUE), - sd = sd(x.natural, na.rm = TRUE) - ) - - ##plot histogram - histogram <- try(hist( - x.natural, - xlab = xlab, - ylab = "Frequency", - main = "MC runs", - freq = FALSE, - border = "white", - axes = FALSE, - ylim = c(0, max(norm.curve.y)), - sub = paste0("valid fits = ", length(na.exclude(x.natural)), "/",NumberIterations.MC), - col = "grey" - ), silent = TRUE) - - if (!is(histogram, "try-error")) { - ##add axes - axis(side = 1) - axis( - side = 2, - at = seq(min(histogram$density), - max(histogram$density), - length = 5), - labels = round(seq( - min(histogram$counts), max(histogram$counts), length = 5 - ), - digits = 0) - ) - - ##add norm curve - lines(norm.curve.x, norm.curve.y, col = "red") - - ##add rug - rug(x.natural) - - ##write De + Error from Monte Carlo simulation + write quality of error estimation - try(mtext(side = 3, - substitute(D[e[MC]] == De, - list( - De = paste( - abs(round(De.MonteCarlo, 2)), - "\u00B1", - format(De.Error, scientific = TRUE, digits = 2), - " | diff. = ", - abs(round((abs(abs(De) - De.MonteCarlo) / abs(De)) * 100,1)), - "%" - ) - )), - cex = 0.6 * cex.global), silent = TRUE) - - }else{ - plot_check <- histogram - } - - } else { - plot_check <- try(plot( - NA, - NA, - xlim = c(0, 10), - ylim = c(0, 10), - main = expression(paste(D[e], " from MC runs"))), - silent = TRUE - ) - - if(!is(plot_check,"try-error")) - text(5, 5, "not available") - - }#end ifelse - - ##PLOT #PLOT test dose response curve if available if not plot not available - #plot Tx/Tn value for sensitvity change - if (!is(plot_check, "try-error")) { - if ("TnTx" %in% colnames(sample) == TRUE) { - plot( - 1:length(sample[, "TnTx"]), - sample[1:(length(sample[, "TnTx"])), "TnTx"] / sample[1, "TnTx"], - xlab = "SAR cycle", - ylab = expression(paste(T[x] / T[n])), - main = "Test-dose response", - type = "o", - pch = 20, - ) - - ##LINES #plot 1 line - lines(c(1, length(sample[, "TnTx"])), c(1, 1), lty = 2, col = "gray") - } else { - plot( - NA, - NA, - xlim = c(0, 10), - ylim = c(0, 10), - main = "Test-dose response" - ) - text(5, 5, "not available\n no TnTx column") - }#end if else - } - - ## FUN by R Luminescence Team - if (fun == TRUE) sTeve() # nocov - - }#endif::output.plotExtended - - }#end if plotOutput - - ##reset graphic device if the plotting failed! - if(is(plot_check, "try-error")){ - message("[plot_GrowthCurve()] Error: Figure margins too large, ", - "nothing plotted, but results returned!") - dev.off() - } - } - -# Output ------------------------------------------------------------------ - ##calculate HPDI - HPDI <- matrix(c(NA,NA,NA,NA), ncol = 4) - if(!any(is.na(x.natural))){ - HPDI <- cbind( - .calc_HPDI(x.natural, prob = 0.68)[1, ,drop = FALSE], - .calc_HPDI(x.natural, prob = 0.95)[1, ,drop = FALSE]) - - } - - ## calculate the n/N value (the relative saturation level) - ## the absolute intensity is the integral of curve - ## define the function - f_int <- function(x) eval(fit_formula) - - ## run integrations (they may fail; so we have to check) - N <- try({ - suppressWarnings( - stats::integrate(f_int, lower = 0, upper = max(xy$x, na.rm = TRUE))$value) - }, silent = TRUE) - n <- try({ - suppressWarnings( - stats::integrate(f_int, lower = 0, upper = max(De, na.rm = TRUE))$value) - }, silent = TRUE) - - if(inherits(N, "try-error") || inherits(n, "try-error")) - n_N <- NA - else - n_N <- n/N - - output <- try(data.frame( - De = abs(De), - De.Error = De.Error, - D01 = D01, - D01.ERROR = D01.ERROR, - D02 = D02, - D02.ERROR = D02.ERROR, - Dc = Dc, - n_N = n_N, - De.MC = De.MonteCarlo, - Fit = fit.method, - HPDI68_L = HPDI[1,1], - HPDI68_U = HPDI[1,2], - HPDI95_L = HPDI[1,3], - HPDI95_U = HPDI[1,4], - row.names = NULL - ), - silent = TRUE - ) - - ##make RLum.Results object - output.final <- set_RLum( - class = "RLum.Results", - data = list( - De = output, - De.MC = x.natural, - Fit = fit, - Formula = fit_formula - ), - info = list( - call = sys.call() - ) - ) - invisible(output.final) - -} - -# Helper functions in plot_GrowthCurve() -------------------------------------- -#'@title Replace coefficients in formula -#' -#'@description -#' -#'Replace the parameters in a fitting function by the true, fitted values. -#'This way the results can be easily used by the other functions -#' -#'@param f [nls] or [lm] (**required**): the output object of the fitting -#' -#'@returns Returns an [expression] -#' -#'@md -#'@noRd -.replace_coef <- function(f) { - ## get formula as character string - if(inherits(f, "nls")) { - str <- as.character(f$m$formula())[3] - param <- coef(f) - - } else { - str <- "a * x + b * x^2 + n" - param <- c(n = 0, a = 0, b = 0) - if(!"(Intercept)" %in% names(coef(f))) - param[2:(length(coef(f))+1)] <- coef(f) - else - param[1:length(coef(f))] <- coef(f) - - } - - ## replace - for(i in 1:length(param)) - str <- gsub( - pattern = names(param)[i], - replacement = format(param[i], digits = 3, scientific = TRUE), - x = str, - fixed = TRUE) - - ## return - return(parse(text = str)) -} - -#'@title Convert function to formula -#' -#'@description The fitting functions are provided as functions, however, later is -#'easer to work with them as expressions, this functions converts to formula -#' -#'@param f [function] (**required**): function to be converted -#' -#'@param env [environment] (*with default*): environment for the formula -#'creation. This argument is required otherwise it can cause all kind of -#'very complicated to-track-down errors when R tries to access the function -#'stack -#' -#'@md -#'@noRd -.toFormula <- function(f, env) { - ## deparse - tmp <- deparse(f) - - ## set formula - ## this is very fragile and works only if the functions are constructed - ## without {} brackets, otherwise it will not work in combination - ## of covr and testthat - tmp_formula <- as.formula(paste0("y ~ ", paste(tmp[-1], collapse = "")), env = env) - - return(tmp_formula) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_Histogram.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_Histogram.R deleted file mode 100644 index f2249e224..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_Histogram.R +++ /dev/null @@ -1,784 +0,0 @@ -#' Plot a histogram with separate error plot -#' -#' Function plots a predefined histogram with an accompanying error plot as -#' suggested by Rex Galbraith at the UK LED in Oxford 2010. -#' -#' If the normal curve is added, the y-axis in the histogram will show the -#' probability density. -#' -#' -#' A statistic summary, i.e. a collection of statistic measures of -#' centrality and dispersion (and further measures) can be added by specifying -#' one or more of the following keywords: -#' - `"n"` (number of samples), -#' - `"mean"` (mean De value), -#' - `"mean.weighted"` (error-weighted mean), -#' - `"median"` (median of the De values), -#' - `"sdrel"` (relative standard deviation in percent), -#' - `"sdrel.weighted"` (error-weighted relative standard deviation in percent), -#' - `"sdabs"` (absolute standard deviation), -#' - `"sdabs.weighted"` (error-weighted absolute standard deviation), -#' - `"serel"` (relative standard error), -#' - `"serel.weighted"` (error-weighted relative standard error), -#' - `"seabs"` (absolute standard error), -#' - `"seabs.weighted"` (error-weighted absolute standard error), -#' - `"kurtosis"` (kurtosis) and -#' - `"skewness"` (skewness). -#' -#' @param data [data.frame] or [RLum.Results-class] object (**required**): -#' for `data.frame`: two columns: De (`data[,1]`) and De error (`data[,2]`) -#' -#' @param na.rm [logical] (*with default*): -#' excludes `NA` values from the data set prior to any further operations. -#' -#' @param mtext [character] (*optional*): -#' further sample information ([mtext]). -#' -#' @param cex.global [numeric] (*with default*): -#' global scaling factor. -#' -#' @param se [logical] (*optional*): -#' plots standard error points over the histogram, default is `FALSE`. -#' -#' @param rug [logical] (*optional*): -#' adds rugs to the histogram, default is `TRUE`. -#' -#' @param normal_curve [logical] (*with default*): -#' adds a normal curve to the histogram. Mean and standard deviation are calculated from the -#' input data. More see details section. -#' -#' @param summary [character] (*optional*): -#' add statistic measures of centrality and dispersion to the plot. -#' Can be one or more of several keywords. See details for available keywords. -#' -#' @param summary.pos [numeric] or [character] (*with default*): -#' optional position coordinates or keyword (e.g. `"topright"`) -#' for the statistical summary. Alternatively, the keyword `"sub"` may be -#' specified to place the summary below the plot header. However, this latter -#' option in only possible if `mtext` is not used. In case of coordinate -#' specification, y-coordinate refers to the right y-axis. -#' -#' @param colour [numeric] or [character] (*with default*): -#' optional vector of length 4 which specifies the colours of the following -#' plot items in exactly this order: histogram bars, rug lines, normal -#' distribution curve and standard error points -#' (e.g., `c("grey", "black", "red", "grey")`). -#' -#' @param interactive [logical] (*with default*): -#' create an interactive histogram plot (requires the 'plotly' package) -#' -#' @param ... further arguments and graphical parameters passed to [plot] or -#' [hist]. If y-axis labels are provided, these must be specified as a vector -#' of length 2 since the plot features two axes -#' (e.g. `ylab = c("axis label 1", "axis label 2")`). Y-axes limits -#' (`ylim`) must be provided as vector of length four, with the first two -#' elements specifying the left axes limits and the latter two elements giving -#' the right axis limits. -#' -#' @note The input data is not restricted to a special type. -#' -#' @section Function version: 0.4.5 -#' -#' @author -#' Michael Dietze, GFZ Potsdam (Germany)\cr -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [hist], [plot] -#' -#' @examples -#' -#' ## load data -#' data(ExampleData.DeValues, envir = environment()) -#' ExampleData.DeValues <- -#' Second2Gray(ExampleData.DeValues$BT998, dose.rate = c(0.0438,0.0019)) -#' -#' ## plot histogram the easiest way -#' plot_Histogram(ExampleData.DeValues) -#' -#' ## plot histogram with some more modifications -#' plot_Histogram(ExampleData.DeValues, -#' rug = TRUE, -#' normal_curve = TRUE, -#' cex.global = 0.9, -#' pch = 2, -#' colour = c("grey", "black", "blue", "green"), -#' summary = c("n", "mean", "sdrel"), -#' summary.pos = "topleft", -#' main = "Histogram of De-values", -#' mtext = "Example data set", -#' ylab = c(expression(paste(D[e], " distribution")), -#' "Standard error"), -#' xlim = c(100, 250), -#' ylim = c(0, 0.1, 5, 20)) -#' -#' -#' @md -#' @export -plot_Histogram <- function( - data, - na.rm = TRUE, - mtext, - cex.global, - se, - rug, - normal_curve, - summary, - summary.pos, - colour, - interactive = FALSE, - ... -) { - - # Integrity tests --------------------------------------------------------- - ## check/adjust input data structure - if (!is(data, "RLum.Results") && !is.data.frame(data)) { - .throw_error("Input data format is neither 'data.frame' nor 'RLum.Results'") - } - if (is(data, "RLum.Results")) { - data <- get_RLum(data)[,1:2] - } - - ## handle error-free data sets - if(length(data) < 2) { - data <- cbind(data, rep(NA, length(data))) - } - - ## Set general parameters --------------------------------------------------- - ## Check/set default parameters - if(missing(cex.global) == TRUE) { - cex.global <- 1 - } - - if(missing(mtext) == TRUE) { - mtext <- "" - } - - if(missing(se) == TRUE) { - se = TRUE - } - - if(missing(rug) == TRUE) { - rug = TRUE - } - - if(missing(colour) == TRUE) { - colour = c("white", "black", "red", "black") - } - - if(missing(summary) == TRUE) { - summary <- "" - } - - if(missing(summary.pos) == TRUE) { - summary.pos <- "sub" - } - - if(missing(normal_curve) == TRUE) { - normal_curve = FALSE - } - - ## read out additional arguments list - extraArgs <- list(...) - - ## define fun - if("fun" %in% names(extraArgs)) { - fun <- extraArgs$fun # nocov - } else { - fun <- FALSE - } - - ## optionally, count and exclude NA values and print result - if(na.rm == TRUE) { - n.NA <- sum(is.na(data[,1])) - if(n.NA == 1) { - print("1 NA value excluded.") - } else if(n.NA > 1) { - print(paste(n.NA, "NA values excluded.")) - } - data <- data[!is.na(data[,1]),] - } - - if("main" %in% names(extraArgs)) { - main.plot <- extraArgs$main - } else { - main.plot <- "Histogram" - } - - if("xlab" %in% names(extraArgs)) { - xlab.plot <- extraArgs$xlab - } else { - xlab.plot <- expression(paste(D[e], " [Gy]")) - } - - if("ylab" %in% names(extraArgs)) { - ylab.plot <- extraArgs$ylab - } else { - ylab.plot <- c("Frequency", - "Standard error") - } - - if("breaks" %in% names(extraArgs)) { - breaks.plot <- extraArgs$breaks - - breaks_calc <- hist(x = data[,1], - breaks = breaks.plot, - plot = FALSE)$breaks - } else { - breaks.plot <- hist(x = data[,1], - plot = FALSE)$breaks - - breaks_calc <- breaks.plot - } - - if("xlim" %in% names(extraArgs)) { - xlim.plot <- extraArgs$xlim - } else { - xlim.plot <- range(breaks_calc) - } - - if("ylim" %in% names(extraArgs)) { - ylim.plot <- extraArgs$ylim - if (length(ylim.plot) < 4) { - .throw_error("'ylim' must be a vector of length 4") - } - } else { - H.lim <- hist(data[,1], - breaks = breaks.plot, - plot = FALSE) - if(normal_curve == TRUE) { - left.ylim <- c(0, max(H.lim$density)) - } else { - left.ylim <- c(0, max(H.lim$counts)) - } - range.error <- try(expr = range(data[,2], na.rm = TRUE), - silent = TRUE) - range.error[1] <- ifelse(is.infinite(range.error[1]), 0, range.error[1]) - range.error[2] <- ifelse(is.infinite(range.error[2]), 0, range.error[2]) - ylim.plot <- c(left.ylim, range.error) - } - - if("pch" %in% names(extraArgs)) { - pch.plot <- extraArgs$pch - } else { - pch.plot <- 1 - } - ## Set plot area format - par(mar = c(4.5, 4.5, 4.5, 4.5), - cex = cex.global) - - ## Plot histogram ----------------------------------------------------------- - HIST <- hist(data[,1], - main = "", - xlab = xlab.plot, - ylab = ylab.plot[1], - xlim = xlim.plot, - ylim = ylim.plot[1:2], - breaks = breaks.plot, - freq = !normal_curve, - col = colour[1] - ) - - ## add title - title(line = 2, - main = main.plot) - - ## Optionally, add rug ------------------------------------------------------ - if(rug == TRUE) {rug(data[,1], col = colour[2])} - - ## Optionally, add a normal curve based on the data ------------------------- - if(normal_curve == TRUE){ - ## cheat the R check routine, tztztz how neat - x <- NULL - rm(x) - - ## add normal distribution curve - curve(dnorm(x, - mean = mean(na.exclude(data[,1])), - sd = sd(na.exclude(data[,1]))), - col = colour[3], - add = TRUE, - lwd = 1.2 * cex.global) - } - - ## calculate and paste statistical summary - data.stats <- list(data = data) - - ## calculate and paste statistical summary - De.stats <- matrix(nrow = length(data), ncol = 18) - colnames(De.stats) <- c("n", - "mean", - "mean.weighted", - "median", - "median.weighted", - "kde.max", - "sd.abs", - "sd.rel", - "se.abs", - "se.rel", - "q25", - "q75", - "skewness", - "kurtosis", - "sd.abs.weighted", - "sd.rel.weighted", - "se.abs.weighted", - "se.rel.weighted") - - for(i in 1:length(data)) { - statistics <- calc_Statistics(data) - De.stats[i,1] <- statistics$weighted$n - De.stats[i,2] <- statistics$unweighted$mean - De.stats[i,3] <- statistics$weighted$mean - De.stats[i,4] <- statistics$unweighted$median - De.stats[i,5] <- statistics$unweighted$median - De.stats[i,7] <- statistics$unweighted$sd.abs - De.stats[i,8] <- statistics$unweighted$sd.rel - De.stats[i,9] <- statistics$unweighted$se.abs - De.stats[i,10] <- statistics$weighted$se.rel - De.stats[i,11] <- quantile(data[,1], 0.25) - De.stats[i,12] <- quantile(data[,1], 0.75) - De.stats[i,13] <- statistics$unweighted$skewness - De.stats[i,14] <- statistics$unweighted$kurtosis - De.stats[i,15] <- statistics$weighted$sd.abs - De.stats[i,16] <- statistics$weighted$sd.rel - De.stats[i,17] <- statistics$weighted$se.abs - De.stats[i,18] <- statistics$weighted$se.rel - - ##kdemax - here a little doubled as it appears below again - De.denisty <- NA - De.stats[i,6] <- NA - if(nrow(data) >= 2){ - De.density <-density(x = data[,1], - kernel = "gaussian", - from = xlim.plot[1], - to = xlim.plot[2]) - - De.stats[i,6] <- De.density$x[which.max(De.density$y)] - } - } - - label.text = list(NA) - - if(summary.pos[1] != "sub") { - n.rows <- length(summary) - - for(i in 1:length(data)) { - stops <- paste(rep("\n", (i - 1) * n.rows), collapse = "") - - summary.text <- character(0) - - for(j in 1:length(summary)) { - summary.text <- c(summary.text, - paste( - "", - ifelse("n" %in% summary[j] == TRUE, - paste("n = ", - De.stats[i,1], - "\n", - sep = ""), - ""), - ifelse("mean" %in% summary[j] == TRUE, - paste("mean = ", - round(De.stats[i,2], 2), - "\n", - sep = ""), - ""), - ifelse("mean.weighted" %in% summary[j] == TRUE, - paste("weighted mean = ", - round(De.stats[i,3], 2), - "\n", - sep = ""), - ""), - ifelse("median" %in% summary[j] == TRUE, - paste("median = ", - round(De.stats[i,4], 2), - "\n", - sep = ""), - ""), - ifelse("median.weighted" %in% summary[j] == TRUE, - paste("weighted median = ", - round(De.stats[i,5], 2), - "\n", - sep = ""), - ""), - ifelse("kdemax" %in% summary[j] == TRUE, - paste("kdemax = ", - round(De.stats[i,6], 2), - " \n ", - sep = ""), - ""), - ifelse("sdabs" %in% summary[j] == TRUE, - paste("sd = ", - round(De.stats[i,7], 2), - "\n", - sep = ""), - ""), - ifelse("sdrel" %in% summary[j] == TRUE, - paste("rel. sd = ", - round(De.stats[i,8], 2), " %", - "\n", - sep = ""), - ""), - ifelse("seabs" %in% summary[j] == TRUE, - paste("se = ", - round(De.stats[i,9], 2), - "\n", - sep = ""), - ""), - ifelse("serel" %in% summary[j] == TRUE, - paste("rel. se = ", - round(De.stats[i,10], 2), " %", - "\n", - sep = ""), - ""), - ifelse("skewness" %in% summary[j] == TRUE, - paste("skewness = ", - round(De.stats[i,13], 2), - "\n", - sep = ""), - ""), - ifelse("kurtosis" %in% summary[j] == TRUE, - paste("kurtosis = ", - round(De.stats[i,14], 2), - "\n", - sep = ""), - ""), - ifelse("sdabs.weighted" %in% summary[j] == TRUE, - paste("abs. weighted sd = ", - round(De.stats[i,15], 2), - "\n", - sep = ""), - ""), - ifelse("sdrel.weighted" %in% summary[j] == TRUE, - paste("rel. weighted sd = ", - round(De.stats[i,16], 2), - "\n", - sep = ""), - ""), - ifelse("seabs.weighted" %in% summary[j] == TRUE, - paste("abs. weighted se = ", - round(De.stats[i,17], 2), - "\n", - sep = ""), - ""), - ifelse("serel.weighted" %in% summary[j] == TRUE, - paste("rel. weighted se = ", - round(De.stats[i,18], 2), - "\n", - sep = ""), - ""), - sep = "")) - } - - summary.text <- paste(summary.text, collapse = "") - - label.text[[length(label.text) + 1]] <- paste(stops, - summary.text, - stops, - sep = "") - } - } else { - for(i in 1:length(data)) { - - summary.text <- character(0) - - for(j in 1:length(summary)) { - summary.text <- c(summary.text, - ifelse("n" %in% summary[j] == TRUE, - paste("n = ", - De.stats[i,1], - " | ", - sep = ""), - ""), - ifelse("mean" %in% summary[j] == TRUE, - paste("mean = ", - round(De.stats[i,2], 2), - " | ", - sep = ""), - ""), - ifelse("mean.weighted" %in% summary[j] == TRUE, - paste("weighted mean = ", - round(De.stats[i,3], 2), - " | ", - sep = ""), - ""), - ifelse("median" %in% summary[j] == TRUE, - paste("median = ", - round(De.stats[i,4], 2), - " | ", - sep = ""), - ""), - ifelse("median.weighted" %in% summary[j] == TRUE, - paste("weighted median = ", - round(De.stats[i,5], 2), - " | ", - sep = ""), - ""), - ifelse("kdemax" %in% summary[j] == TRUE, - paste("kdemax = ", - round(De.stats[i,6], 2), - " | ", - sep = ""), - ""), - ifelse("sdrel" %in% summary[j] == TRUE, - paste("rel. sd = ", - round(De.stats[i,8], 2), " %", - " | ", - sep = ""), - ""), - ifelse("sdabs" %in% summary[j] == TRUE, - paste("abs. sd = ", - round(De.stats[i,7], 2), - " | ", - sep = ""), - ""), - ifelse("serel" %in% summary[j] == TRUE, - paste("rel. se = ", - round(De.stats[i,10], 2), " %", - " | ", - sep = ""), - ""), - ifelse("seabs" %in% summary[j] == TRUE, - paste("abs. se = ", - round(De.stats[i,9], 2), - " | ", - sep = ""), - ""), - ifelse("skewness" %in% summary[j] == TRUE, - paste("skewness = ", - round(De.stats[i,13], 2), - " | ", - sep = ""), - ""), - ifelse("kurtosis" %in% summary[j] == TRUE, - paste("kurtosis = ", - round(De.stats[i,14], 2), - " | ", - sep = ""), - ""), - ifelse("sdabs.weighted" %in% summary[j] == TRUE, - paste("abs. weighted sd = ", - round(De.stats[i,15], 2), " %", - " | ", - sep = ""), - ""), - ifelse("sdrel.weighted" %in% summary[j] == TRUE, - paste("rel. weighted sd = ", - round(De.stats[i,16], 2), " %", - " | ", - sep = ""), - ""), - ifelse("seabs.weighted" %in% summary[j] == TRUE, - paste("abs. weighted se = ", - round(De.stats[i,17], 2), " %", - " | ", - sep = ""), - ""), - ifelse("serel.weighted" %in% summary[j] == TRUE, - paste("rel. weighted se = ", - round(De.stats[i,18], 2), " %", - " | ", - sep = ""), - "") - ) - } - - summary.text <- paste(summary.text, collapse = "") - - label.text[[length(label.text) + 1]] <- paste( - " ", - summary.text, - sep = "") - } - - ## remove outer vertical lines from string - for(i in 2:length(label.text)) { - label.text[[i]] <- substr(x = label.text[[i]], - start = 3, - stop = nchar(label.text[[i]]) - 3) - } - } - - ## remove dummy list element - label.text[[1]] <- NULL - - ## convert keywords into summary placement coordinates - if(missing(summary.pos) == TRUE) { - summary.pos <- c(xlim.plot[1], ylim.plot[2]) - summary.adj <- c(0, 1) - } else if(length(summary.pos) == 2) { - summary.pos <- summary.pos - summary.adj <- c(0, 1) - } else if(summary.pos[1] == "topleft") { - summary.pos <- c(xlim.plot[1], ylim.plot[2]) - summary.adj <- c(0, 1) - } else if(summary.pos[1] == "top") { - summary.pos <- c(mean(xlim.plot), ylim.plot[2]) - summary.adj <- c(0.5, 1) - } else if(summary.pos[1] == "topright") { - summary.pos <- c(xlim.plot[2], ylim.plot[2]) - summary.adj <- c(1, 1) - } else if(summary.pos[1] == "left") { - summary.pos <- c(xlim.plot[1], mean(ylim.plot[1:2])) - summary.adj <- c(0, 0.5) - } else if(summary.pos[1] == "center") { - summary.pos <- c(mean(xlim.plot), mean(ylim.plot[1:2])) - summary.adj <- c(0.5, 0.5) - } else if(summary.pos[1] == "right") { - summary.pos <- c(xlim.plot[2], mean(ylim.plot[1:2])) - summary.adj <- c(1, 0.5) - }else if(summary.pos[1] == "bottomleft") { - summary.pos <- c(xlim.plot[1], ylim.plot[1]) - summary.adj <- c(0, 0) - } else if(summary.pos[1] == "bottom") { - summary.pos <- c(mean(xlim.plot), ylim.plot[1]) - summary.adj <- c(0.5, 0) - } else if(summary.pos[1] == "bottomright") { - summary.pos <- c(xlim.plot[2], ylim.plot[1]) - summary.adj <- c(1, 0) - } - - ## add summary content - for(i in 1:length(data.stats)) { - if(summary.pos[1] != "sub") { - text(x = summary.pos[1], - y = summary.pos[2], - adj = summary.adj, - labels = label.text[[i]], - col = colour[2], - cex = cex.global * 0.8) - } else { - if(mtext == "") { - mtext(side = 3, - line = 1 - i, - text = label.text[[i]], - col = colour[2], - cex = cex.global * 0.8) - } - } - } - - ## Optionally, add standard error plot -------------------------------------- - if(sum(is.na(data[,2])) == length(data[,2])) { - se <- FALSE - } - - if(se == TRUE) { - par(new = TRUE) - plot.data <- data[!is.na(data[,2]),] - - plot(x = plot.data[,1], - y = plot.data[,2], - xlim = xlim.plot, - ylim = ylim.plot[3:4], - pch = pch.plot, - col = colour[4], - main = "", - xlab = "", - ylab = "", - axes = FALSE, - frame.plot = FALSE - ) - axis(side = 4, - labels = TRUE, - cex = cex.global - ) - mtext(ylab.plot[2], - side = 4, - line = 3, - cex = cex.global) - - # par(new = FALSE) - } - - ## Optionally add user-defined mtext - mtext(side = 3, - line = 0.5, - text = mtext, - cex = 0.8 * cex.global) - - ## FUN by R Luminescence Team - if (fun && !interactive) sTeve() # nocov - - ## Optionally: Interactive Plot ---------------------------------------------- - if (interactive) { - - if (!requireNamespace("plotly", quietly = TRUE)) - # nocov start - stop("The interactive histogram requires the 'plotly' package. To install", - " this package run 'install.packages('plotly')' in your R console.", - call. = FALSE) - # nocov end - - ## tidy data ---- - data <- as.data.frame(data) - colnames(data) <- c("x", "y") - x <- y <- NULL # suffice CRAN check for no visible binding - if (length(grep("paste", as.character(xlab.plot))) > 0) - xlab.plot <- "Equivalent dose [Gy]" - - ## create plots ---- - - # histogram - hist <- plotly::plot_ly(data = data, x = ~x, - type = "histogram", - showlegend = FALSE, - name = "Bin", opacity = 0.75, - marker = list(color = "#428BCA", - line = list(width = 1.0, - color = "white")), - histnorm = ifelse(normal_curve, "probability density", ""), - yaxis = "y" - ) - - # normal curve ---- - if (normal_curve) { - - density.curve <- density(data$x) - normal.curve <- data.frame(x = density.curve$x, y = density.curve$y) - - hist <- plotly::add_trace(hist, data = normal.curve, x = ~x, y = ~y, - inherit = FALSE, - type = "scatter", mode = "lines", - line = list(color = "red"), - name = "Normal curve", - yaxis = "y") - } - - # scatter plot of individual errors - if (se) { - yaxis2 <- list(overlaying = "y", side = "right", - showgrid = FALSE, title = ylab.plot[2], - ticks = "", showline = FALSE) - - se.text <- paste0("Measured value:
", - data$x, " ± ", data$y,"
") - - hist <- plotly::add_trace(hist, data = data, x = ~x, y = ~y, - inherit = FALSE, - type = "scatter", mode = "markers", - name = "Error", hoverinfo = "text", - text = se.text, - marker = list(color = "black"), - yaxis = "y2") - - hist <- plotly::layout(hist, yaxis2 = yaxis2) - } - - # set layout ---- - hist <- plotly::layout(hist, hovermode = "closest", - title = paste("", main.plot, ""), - margin = list(r = 90), - xaxis = list(title = xlab.plot, - ticks = ""), - yaxis = list(title = ylab.plot[1], - ticks = "", - showline = FALSE, - showgrid = FALSE) - ) - - ## show and return plot ---- - print(hist) - return(hist) - } -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_KDE.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_KDE.R deleted file mode 100644 index cfecdb98e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_KDE.R +++ /dev/null @@ -1,1265 +0,0 @@ -#' Plot kernel density estimate with statistics -#' -#' Plot a kernel density estimate of measurement values in combination with the -#' actual values and associated error bars in ascending order. If enabled, the -#' boxplot will show the usual distribution parameters (median as -#' bold line, box delimited by the first and third quartile, whiskers defined -#' by the extremes and outliers shown as points) and also the mean and -#' standard deviation as pale bold line and pale polygon, respectively. -#' -#' The function allows passing several plot arguments, such as `main`, -#' `xlab`, `cex`. However, as the figure is an overlay of two -#' separate plots, `ylim` must be specified in the order: c(ymin_axis1, -#' ymax_axis1, ymin_axis2, ymax_axis2) when using the cumulative values plot -#' option. See examples for some further explanations. For details on the -#' calculation of the bin-width (parameter `bw`) see -#' [density]. -#' -#' -#' A statistic summary, i.e. a collection of statistic measures of -#' centrality and dispersion (and further measures) can be added by specifying -#' one or more of the following keywords: -#' - `"n"` (number of samples) -#' - `"mean"` (mean De value) -#' - `"median"` (median of the De values) -#' - `"sd.rel"` (relative standard deviation in percent) -#' - `"sd.abs"` (absolute standard deviation) -#' - `"se.rel"` (relative standard error) -#' - `"se.abs"` (absolute standard error) -#' - `"in.2s"` (percent of samples in 2-sigma range) -#' - `"kurtosis"` (kurtosis) -#' - `"skewness"` (skewness) -#' -#' -#' **Note** that the input data for the statistic summary is sent to the function -#' `calc_Statistics()` depending on the log-option for the z-scale. If -#' `"log.z = TRUE"`, the summary is based on the logarithms of the input -#' data. If `"log.z = FALSE"` the linearly scaled data is used. -#' -#' **Note** as well, that `"calc_Statistics()"` calculates these statistic -#' measures in three different ways: `unweighted`, `weighted` and -#' `MCM-based` (i.e., based on Monte Carlo Methods). By default, the -#' MCM-based version is used. If you wish to use another method, indicate this -#' with the appropriate keyword using the argument `summary.method`. -#' -#' -#' @param data [data.frame], [vector] or [RLum.Results-class] object (**required**): -#' for `data.frame`: either two columns: De (`values[,1]`) and De error -#' (`values[,2]`), or one: De (`values[,1]`). If a numeric vector or a -#' single-column data frame is provided, De error is assumed to be 10^-9 -#' for all measurements and error bars are not drawn. -#' For plotting multiple data sets, these must be provided as -#' `list` (e.g. `list(dataset1, dataset2)`). -#' -#' @param na.rm [logical] (*with default*): -#' exclude NA values from the data set prior to any further operation. -#' -#' @param values.cumulative [logical] (*with default*): -#' show cumulative individual data. -#' -#' @param order [logical]: -#' Order data in ascending order. -#' -#' @param boxplot [logical] (*with default*): -#' optionally show a boxplot (depicting median as thick central line, -#' first and third quartile as box limits, whiskers denoting +/- 1.5 -#' interquartile ranges and dots further outliers). -#' -#' @param rug [logical] (*with default*): -#' optionally add rug. -#' -#' @param summary [character] (*optional*): -#' add statistic measures of centrality and dispersion to the plot. Can be one -#' or more of several keywords. See details for available keywords. -#' -#' @param summary.pos [numeric] or [character] (*with default*): -#' optional position coordinates or keyword (e.g. `"topright"`) -#' for the statistical summary. Alternatively, the keyword `"sub"` may be -#' specified to place the summary below the plot header. However, this latter -#' option in only possible if `mtext` is not used. In case of coordinate -#' specification, y-coordinate refers to the right y-axis. -#' -#' @param summary.method [character] (*with default*): -#' keyword indicating the method used to calculate the statistic summary. -#' One out of `"unweighted"`, `"weighted"` and `"MCM"`. -#' See [calc_Statistics] for details. -#' -#' @param bw [character] (*with default*): -#' bin-width, chose a numeric value for manual setting. -#' -#' @param output [logical]: -#' Optional output of numerical plot parameters. These can be useful to -#' reproduce similar plots. Default is `TRUE`. -#' -#' @param ... further arguments and graphical parameters passed to [plot]. -#' -#' @note -#' The plot output is no 'probability density' plot (cf. the discussion -#' of Berger and Galbraith in Ancient TL; see references)! -#' -#' @section Function version: 3.6.0 -#' -#' @author -#' Michael Dietze, GFZ Potsdam (Germany)\cr -#' Geography & Earth Sciences, Aberystwyth University (United Kingdom) -#' -#' @seealso [density], [plot] -#' -#' @examples -#' -#' ## read example data set -#' data(ExampleData.DeValues, envir = environment()) -#' ExampleData.DeValues <- -#' Second2Gray(ExampleData.DeValues$BT998, c(0.0438,0.0019)) -#' -#' ## create plot straightforward -#' plot_KDE(data = ExampleData.DeValues) -#' -#' ## create plot with logarithmic x-axis -#' plot_KDE(data = ExampleData.DeValues, -#' log = "x") -#' -#' ## create plot with user-defined labels and axes limits -#' plot_KDE(data = ExampleData.DeValues, -#' main = "Dose distribution", -#' xlab = "Dose (s)", -#' ylab = c("KDE estimate", "Cumulative dose value"), -#' xlim = c(100, 250), -#' ylim = c(0, 0.08, 0, 30)) -#' -#' ## create plot with boxplot option -#' plot_KDE(data = ExampleData.DeValues, -#' boxplot = TRUE) -#' -#' ## create plot with statistical summary below header -#' plot_KDE(data = ExampleData.DeValues, -#' summary = c("n", "median", "skewness", "in.2s")) -#' -#' ## create plot with statistical summary as legend -#' plot_KDE(data = ExampleData.DeValues, -#' summary = c("n", "mean", "sd.rel", "se.abs"), -#' summary.pos = "topleft") -#' -#' ## split data set into sub-groups, one is manipulated, and merge again -#' data.1 <- ExampleData.DeValues[1:15,] -#' data.2 <- ExampleData.DeValues[16:25,] * 1.3 -#' data.3 <- list(data.1, data.2) -#' -#' ## create plot with two subsets straightforward -#' plot_KDE(data = data.3) -#' -#' ## create plot with two subsets and summary legend at user coordinates -#' plot_KDE(data = data.3, -#' summary = c("n", "median", "skewness"), -#' summary.pos = c(110, 0.07), -#' col = c("blue", "orange")) -#' -#' ## example of how to use the numerical output of the function -#' ## return plot output to draw a thicker KDE line -#' KDE_out <- plot_KDE(data = ExampleData.DeValues, -#' output = TRUE) -#' -#' @md -#' @export -plot_KDE <- function( - data, - na.rm = TRUE, - values.cumulative = TRUE, - order = TRUE, - boxplot = TRUE, - rug = TRUE, - summary, - summary.pos, - summary.method = "MCM", - bw = "nrd0", - output = TRUE, - ... -) { - - ## check data and parameter consistency ------------------------------------- - - ## account for depreciated arguments - if("centrality" %in% names(list(...))) { - boxplot <- TRUE - .throw_warning("Argument 'centrality' no longer supported. ", - "Replaced by 'boxplot = TRUE'.") - } - - if("dispersion" %in% names(list(...))) { - boxplot <- TRUE - .throw_warning("Argument 'dispersion' no longer supported. ", - "Replaced by 'boxplot = TRUE'.") - } - - if("polygon.col" %in% names(list(...))) { - boxplot <- TRUE - .throw_warning("Argument 'polygon.col' no longer supported. ", - "Replaced by 'boxplot = TRUE'.") - } - - if("weights" %in% names(list(...))) { - .throw_warning("Argument 'weights' no longer supported. ", - "Weights are omitted.") - } - - if (is(data, "list") && length(data) == 0) { - .throw_error("'data' is an empty list") - } - - ## Homogenise input data format - if(is(data, "list") == FALSE) { - data <- list(data) - } - - ## check/adjust input data structure - for(i in 1:length(data)) { - if(is(data[[i]], "RLum.Results") == FALSE & - is(data[[i]], "data.frame") == FALSE & - is.numeric(data[[i]]) == FALSE) { - .throw_error("Input data must be one of 'data.frame', ", - "'RLum.Results' or 'numeric'") - } else { - - ##extract RLum.Results - if(is(data[[i]], "RLum.Results") == TRUE) { - data[[i]] <- get_RLum(data[[i]], "data")[,1:2] - } - - ## ensure that the dataset it not degenerate - if (NROW(data[[i]]) == 0) { - .throw_error("Input data ", i, " has 0 rows") - } - - ## if `data[[i]]` is a numeric vector or a single-column data frame, - ## append a second column with a small non-zero value (10^-9 for - ## consistency with what `calc_Statistics() does) - if (NCOL(data[[i]]) < 2) { - data[[i]] <- data.frame(data[[i]], 10^-9) - attr(data[[i]], "De.errors.available") <- FALSE - } else { - ## keep only the first two columns - data[[i]] <- data[[i]][, 1:2] - attr(data[[i]], "De.errors.available") <- TRUE - } - } - - ## find the index Inf values in each of the two columns and remove the - ## corresponding rows if needed - inf.idx <- unlist(lapply(data[[i]], function(x) which(is.infinite(x)))) - if (length(inf.idx) > 0) { - inf.row <- sort(unique(inf.idx)) - .throw_warning("Inf values removed in rows: ", - paste(inf.row, collapse = ", "), " in data.frame ", i) - data[[i]] <- data[[i]][-inf.row, ] - rm(inf.idx, inf.row) - - ##check if empty - if(nrow(data[[i]]) == 0){ - data[i] <- NULL - } - } - } - - ##check if list is empty - if(length(data) == 0) - .throw_error("Your input is empty due to Inf removal") - - ## check/set function parameters - if(missing(summary) == TRUE) { - summary <- "" - } - - if(missing(summary.pos) == TRUE) { - summary.pos <- "sub" - } - - ## set mtext output - if("mtext" %in% names(list(...))) { - mtext <- list(...)$mtext - } else { - mtext <- "" - } - - ## check/set layout definitions - if("layout" %in% names(list(...))) { - layout <- get_Layout(layout = list(...)$layout) - } else { - layout <- get_Layout(layout = "default") - } - - ## data preparation steps --------------------------------------------------- - - ## optionally, count and exclude NA values and print result - if(na.rm == TRUE) { - for(i in 1:length(data)) { - na.idx <- which(is.na(data[[i]][, 1])) - n.NA <- length(na.idx) - if(n.NA == 1) { - message(paste("1 NA value excluded from data set", i, ".")) - } else if(n.NA > 1) { - message(paste(n.NA, "NA values excluded from data set", i, ".")) - } - if (n.NA > 0) { - data[[i]] <- data[[i]][-na.idx, ] - } - } - } - - ## optionally, order data set - if(order == TRUE) { - for(i in 1:length(data)) { - data[[i]] <- data[[i]][order(data[[i]][,1]),] - } - } - - ## calculate and paste statistical summary - De.stats <- matrix(nrow = length(data), ncol = 12) - colnames(De.stats) <- c("n", - "mean", - "median", - "kde.max", - "sd.abs", - "sd.rel", - "se.abs", - "se.rel", - "q.25", - "q.75", - "skewness", - "kurtosis") - De.density <- list(NA) - - ## loop through all data sets - for(i in 1:length(data)) { - statistics <- calc_Statistics(data[[i]], na.rm = na.rm)[[summary.method]] - - De.stats[i,1] <- statistics$n - De.stats[i,2] <- statistics$mean - De.stats[i,3] <- statistics$median - De.stats[i,5] <- statistics$sd.abs - De.stats[i,6] <- statistics$sd.rel - De.stats[i,7] <- statistics$se.abs - De.stats[i,8] <- statistics$se.rel - De.stats[i,9] <- quantile(data[[i]][,1], 0.25) - De.stats[i,10] <- quantile(data[[i]][,1], 0.75) - De.stats[i,11] <- statistics$skewness - De.stats[i,12] <- statistics$kurtosis - - if(nrow(data[[i]]) >= 2){ - De.density[[length(De.density) + 1]] <- density(data[[i]][,1], - kernel = "gaussian", - bw = bw) - - }else{ - De.density[[length(De.density) + 1]] <- NA - .throw_warning("Single data point found, no density calculated") - } - } - - ## remove dummy list element - De.density[[1]] <- NULL - - ## create global data set - De.global <- data[[1]][,1] - De.error.global <- data[[1]][,2] - De.density.range <- matrix(nrow = length(data), - ncol = 4) - - for(i in 1:length(data)) { - ##global De and De.error vector - De.global <- c(De.global, data[[i]][,1]) - De.error.global <- c(De.error.global, data[[i]][,2]) - - ## density range - if(!all(is.na(De.density[[i]]))){ - De.density.range[i,1] <- min(De.density[[i]]$x) - De.density.range[i,2] <- max(De.density[[i]]$x) - De.density.range[i,3] <- min(De.density[[i]]$y) - De.density.range[i,4] <- max(De.density[[i]]$y) - - ## position of maximum KDE value - De.stats[i,4] <- De.density[[i]]$x[which.max(De.density[[i]]$y)] - - }else{ - De.density.range[i,1:4] <- NA - De.stats[i,4] <- NA - } - } - - ## Get global range of densities - De.density.range <- c(min(De.density.range[,1]), - max(De.density.range[,2]), - min(De.density.range[,3]), - max(De.density.range[,4])) - - label.text = list(NA) - - if(summary.pos[1] != "sub") { - n.rows <- length(summary) - - for(i in 1:length(data)) { - stops <- paste(rep("\n", (i - 1) * n.rows), collapse = "") - - summary.text <- character(0) - - for(j in 1:length(summary)) { - summary.text <- c(summary.text, - paste( - "", - ifelse("n" %in% summary[j] == TRUE, - paste("n = ", - De.stats[i,1], - "\n", - sep = ""), - ""), - ifelse("mean" %in% summary[j] == TRUE, - paste("mean = ", - round(De.stats[i,2], 2), - "\n", - sep = ""), - ""), - ifelse("median" %in% summary[j] == TRUE, - paste("median = ", - round(De.stats[i,3], 2), - "\n", - sep = ""), - ""), - ifelse("kde.max" %in% summary[j] == TRUE, - paste("kdemax = ", - round(De.stats[i,4], 2), - " \n ", - sep = ""), - ""), - ifelse("sd.abs" %in% summary[j] == TRUE, - paste("sd = ", - round(De.stats[i,5], 2), - "\n", - sep = ""), - ""), - ifelse("sd.rel" %in% summary[j] == TRUE, - paste("rel. sd = ", - round(De.stats[i,6], 2), " %", - "\n", - sep = ""), - ""), - ifelse("se.abs" %in% summary[j] == TRUE, - paste("se = ", - round(De.stats[i,7], 2), - "\n", - sep = ""), - ""), - ifelse("se.rel" %in% summary[j] == TRUE, - paste("rel. se = ", - round(De.stats[i,8], 2), " %", - "\n", - sep = ""), - ""), - ifelse("skewness" %in% summary[j] == TRUE, - paste("skewness = ", - round(De.stats[i,11], 2), - "\n", - sep = ""), - ""), - ifelse("kurtosis" %in% summary[j] == TRUE, - paste("kurtosis = ", - round(De.stats[i,12], 2), - "\n", - sep = ""), - ""), - ifelse("in.2s" %in% summary[j] == TRUE, - paste("in 2 sigma = ", - round(sum(data[[i]][,1] > - (De.stats[i,2] - 2 * - De.stats[i,5]) & - data[[i]][,1] < - (De.stats[i,2] + 2 * - De.stats[i,5])) / - nrow(data[[i]]) * 100 , 1), - " %", - sep = ""), - ""), - sep = "")) - } - - summary.text <- paste(summary.text, collapse = "") - - label.text[[length(label.text) + 1]] <- paste(stops, - summary.text, - stops, - sep = "") - } - } else { - for(i in 1:length(data)) { - - summary.text <- character(0) - - for(j in 1:length(summary)) { - summary.text <- c(summary.text, - ifelse("n" %in% summary[j] == TRUE, - paste("n = ", - De.stats[i,1], - " | ", - sep = ""), - ""), - ifelse("mean" %in% summary[j] == TRUE, - paste("mean = ", - round(De.stats[i,2], 2), - " | ", - sep = ""), - ""), - ifelse("median" %in% summary[j] == TRUE, - paste("median = ", - round(De.stats[i,3], 2), - " | ", - sep = ""), - ""), - ifelse("kde.max" %in% summary[j] == TRUE, - paste("kdemax = ", - round(De.stats[i,4], 2), - " | ", - sep = ""), - ""), - ifelse("sd.rel" %in% summary[j] == TRUE, - paste("rel. sd = ", - round(De.stats[i,6], 2), " %", - " | ", - sep = ""), - ""), - ifelse("sd.abs" %in% summary[j] == TRUE, - paste("abs. sd = ", - round(De.stats[i,5], 2), - " | ", - sep = ""), - ""), - ifelse("se.rel" %in% summary[j] == TRUE, - paste("rel. se = ", - round(De.stats[i,8], 2), " %", - " | ", - sep = ""), - ""), - ifelse("se.abs" %in% summary[j] == TRUE, - paste("abs. se = ", - round(De.stats[i,7], 2), - " | ", - sep = ""), - ""), - ifelse("skewness" %in% summary[j] == TRUE, - paste("skewness = ", - round(De.stats[i,11], 2), - " | ", - sep = ""), - ""), - ifelse("kurtosis" %in% summary[j] == TRUE, - paste("kurtosis = ", - round(De.stats[i,12], 2), - " | ", - sep = ""), - ""), - ifelse("in.2s" %in% summary[j] == TRUE, - paste("in 2 sigma = ", - round(sum(data[[i]][,1] > - (De.stats[i,2] - 2 * - De.stats[i,5]) & - data[[i]][,1] < - (De.stats[i,2] + 2 * - De.stats[i,5])) / - nrow(data[[i]]) * 100 , 1), - " % ", - sep = ""), - "") - ) - } - - summary.text <- paste(summary.text, collapse = "") - - label.text[[length(label.text) + 1]] <- paste( - " ", - summary.text, - sep = "") - } - - ## remove outer vertical lines from string - for(i in 2:length(label.text)) { - label.text[[i]] <- substr(x = label.text[[i]], - start = 3, - stop = nchar(label.text[[i]]) - 3) - } - } - - ## remove dummy list element - label.text[[1]] <- NULL - - ## read out additional parameters ------------------------------------------- - if("main" %in% names(list(...))) { - main <- list(...)$main - } else { - main <- expression(bold(paste(D[e], " distribution"))) - } - - if("sub" %in% names(list(...))) { - sub <- list(...)$sub - } else { - sub <- NULL - } - - if("xlab" %in% names(list(...))) { - xlab <- list(...)$xlab - } else { - xlab <- expression(paste(D[e], " [Gy]")) - } - - if("ylab" %in% names(list(...))) { - ylab <- list(...)$ylab - } else { - ylab <- c("Density", "Cumulative frequency") - } - - if("xlim" %in% names(list(...))) { - xlim.plot <- list(...)$xlim - } else { - xlim.plot <- c(min(c(De.global - De.error.global), - De.density.range[1], - na.rm = TRUE), - max(c(De.global + De.error.global), - De.density.range[2], - na.rm = TRUE)) - } - - if("ylim" %in% names(list(...))) { - ylim.plot <- list(...)$ylim - if (length(ylim.plot) < 4) { - .throw_error("'ylim' must be a vector of length 4") - } - } else { - if(!is.na(De.density.range[1])){ - ylim.plot <- c(De.density.range[3], - De.density.range[4], - 0, - max(De.stats[,1])) - - }else{ - ylim.plot <- c(0, - max(De.stats[,1]), - 0, - max(De.stats[,1])) - - } - - } - - if("log" %in% names(list(...))) { - log.option <- list(...)$log - } else { - log.option <- "" - } - - if("col" %in% names(list(...))) { - - col.main <- list(...)$col - col.xlab <- 1 - col.ylab1 <- 1 - col.ylab2 <- 1 - col.xtck <- 1 - col.ytck1 <- 1 - col.ytck2 <- 1 - col.box <- 1 - col.mtext <- 1 - col.stats <- list(...)$col - col.kde.line <- list(...)$col - col.kde.fill <- NA - col.value.dot <- list(...)$col - col.value.bar <- list(...)$col - col.value.rug <- list(...)$col - col.boxplot <- list(...)$col - col.boxplot.line <- list(...)$col - col.boxplot.fill <- NA - col.mean.line <- adjustcolor(col = list(...)$col, - alpha.f = 0.4) - col.sd.bar <- adjustcolor(col = list(...)$col, - alpha.f = 0.4) - col.background <- NA - } else { - - if(length(layout$kde$colour$main) == 1) { - col.main <- c(layout$kde$colour$main, 2:length(data)) - } else { - col.main <- layout$kde$colour$main - } - - if(length(layout$kde$colour$xlab) == 1) { - col.xlab <- c(layout$kde$colour$xlab, 2:length(data)) - } else { - col.xlab <- layout$kde$colour$xlab - } - - if(length(layout$kde$colour$ylab1) == 1) { - col.ylab1 <- c(layout$kde$colour$ylab1, 2:length(data)) - } else { - col.ylab1 <- layout$kde$colour$ylab1 - } - - if(length(layout$kde$colour$ylab2) == 1) { - col.ylab2 <- c(layout$kde$colour$ylab2, 2:length(data)) - } else { - col.ylab2 <- layout$kde$colour$ylab2 - } - - if(length(layout$kde$colour$xtck) == 1) { - col.xtck <- c(layout$kde$colour$xtck, 2:length(data)) - } else { - col.xtck <- layout$kde$colour$xtck - } - - if(length(layout$kde$colour$ytck1) == 1) { - col.ytck1 <- c(layout$kde$colour$ytck1, 2:length(data)) - } else { - col.ytck1 <- layout$kde$colour$ytck1 - } - - if(length(layout$kde$colour$ytck2) == 1) { - col.ytck2 <- c(layout$kde$colour$ytck2, 2:length(data)) - } else { - col.ytck2 <- layout$kde$colour$ytck2 - } - - if(length(layout$kde$colour$box) == 1) { - col.box <- c(layout$kde$colour$box, 2:length(data)) - } else { - col.box <- layout$kde$colour$box - } - - if(length(layout$kde$colour$mtext) == 1) { - col.mtext <- c(layout$kde$colour$mtext, 2:length(data)) - } else { - col.mtext <- layout$kde$colour$mtext - } - - if(length(layout$kde$colour$stats) == 1) { - col.stats <- c(layout$kde$colour$stats, 2:length(data)) - } else { - col.stats <- layout$kde$colour$stats - } - - if(length(layout$kde$colour$kde.line) == 1) { - col.kde.line <- c(layout$kde$colour$kde.line, 2:length(data)) - } else { - col.kde.line <- layout$kde$colour$kde.line - } - - if(length(layout$kde$colour$kde.fill) == 1) { - col.kde.fill <- c(layout$kde$colour$kde.fill, 2:length(data)) - } else { - col.kde.fill <- layout$kde$colour$kde.fill - } - - if(length(layout$kde$colour$value.dot) == 1) { - col.value.dot <- c(layout$kde$colour$value.dot, 2:length(data)) - } else { - col.value.dot <- layout$kde$colour$value.dot - } - - if(length(layout$kde$colour$value.bar) == 1) { - col.value.bar <- c(layout$kde$colour$value.bar, 2:length(data)) - } else { - col.value.bar <- layout$kde$colour$value.bar - } - - if(length(layout$kde$colour$value.rug) == 1) { - col.value.rug <- c(layout$kde$colour$value.rug, 2:length(data)) - } else { - col.value.rug <- layout$kde$colour$value.rug - } - - if(length(layout$kde$colour$boxplot.line) == 1) { - col.boxplot.line <- c(layout$kde$colour$boxplot.line, 2:length(data)) - } else { - col.boxplot.line <- layout$kde$colour$boxplot.line - } - - if(length(layout$kde$colour$boxplot.fill) == 1) { - col.boxplot.fill <- c(layout$kde$colour$boxplot.fill, 2:length(data)) - } else { - col.boxplot.fill <- layout$kde$colour$boxplot.fill - } - - if(length(layout$kde$colour$mean.line) == 1) { - col.mean.line <- adjustcolor(col = 1:length(data), - alpha.f = 0.4) - } else { - col.mean.line <- layout$kde$colour$mean.point - } - - if(length(layout$kde$colour$sd.bar) == 1) { - col.sd.bar <- c(layout$kde$colour$sd.bar, 2:length(data)) - } else { - col.sd.bar <- layout$kde$colour$sd.line - } - - if(length(layout$kde$colour$background) == 1) { - col.background <- c(layout$kde$colour$background, 2:length(data)) - } else { - col.background <- layout$kde$colour$background - } - - } - - if("lty" %in% names(list(...))) { - lty <- list(...)$lty - } else { - lty <- rep(1, length(data)) - } - - if("lwd" %in% names(list(...))) { - lwd <- list(...)$lwd - } else { - lwd <- rep(1, length(data)) - } - - if("cex" %in% names(list(...))) { - cex <- list(...)$cex - } else { - cex <- 1 - } - - if("fun" %in% names(list(...))) { - fun <- list(...)$fun # nocov - } else { - fun <- FALSE - } - - ## convert keywords into summary placement coordinates - if(missing(summary.pos) == TRUE) { - summary.pos <- c(xlim.plot[1], ylim.plot[2]) - summary.adj <- c(0, 1) - } else if(length(summary.pos) == 2) { - summary.pos <- summary.pos - summary.adj <- c(0, 1) - } else if(summary.pos[1] == "topleft") { - summary.pos <- c(xlim.plot[1], ylim.plot[2]) - summary.adj <- c(0, 1) - } else if(summary.pos[1] == "top") { - summary.pos <- c(mean(xlim.plot), ylim.plot[2]) - summary.adj <- c(0.5, 1) - } else if(summary.pos[1] == "topright") { - summary.pos <- c(xlim.plot[2], ylim.plot[2]) - summary.adj <- c(1, 1) - } else if(summary.pos[1] == "left") { - summary.pos <- c(xlim.plot[1], mean(ylim.plot[1:2])) - summary.adj <- c(0, 0.5) - } else if(summary.pos[1] == "center") { - summary.pos <- c(mean(xlim.plot), mean(ylim.plot[1:2])) - summary.adj <- c(0.5, 0.5) - } else if(summary.pos[1] == "right") { - summary.pos <- c(xlim.plot[2], mean(ylim.plot[1:2])) - summary.adj <- c(1, 0.5) - }else if(summary.pos[1] == "bottomleft") { - summary.pos <- c(xlim.plot[1], ylim.plot[1]) - summary.adj <- c(0, 0) - } else if(summary.pos[1] == "bottom") { - summary.pos <- c(mean(xlim.plot), ylim.plot[1]) - summary.adj <- c(0.5, 0) - } else if(summary.pos[1] == "bottomright") { - summary.pos <- c(xlim.plot[2], ylim.plot[1]) - summary.adj <- c(1, 0) - } - - ## plot data sets ----------------------------------------------------------- - - ## setup plot area - if(length(summary) >= 1 & summary.pos[1] == "sub") { - - toplines <- length(data) - } else { - - toplines <- 1 - } - - ## extract original plot parameters - par(bg = layout$kde$colour$background) - bg.original <- par()$bg - - par(mar = c(5, 5.5, 2.5 + toplines, 4.5), - xpd = FALSE, - cex = cex) - - if(layout$kde$dimension$figure.width != "auto" | - layout$kde$dimension$figure.height != "auto") { - par(mai = layout$kde$dimension$margin / 25.4, - pin = c(layout$kde$dimension$figure.width / 25.4 - - layout$kde$dimension$margin[2] / 25.4 - - layout$kde$dimension$margin[4] / 25.4, - layout$kde$dimension$figure.height / 25.4 - - layout$kde$dimension$margin[1] / 25.4 - - layout$kde$dimension$margin[3]/25.4)) - } - - ## create empty plot to get plot dimensions - plot(NA, - xlim = xlim.plot, - ylim = ylim.plot[1:2], - sub = sub, - log = log.option, - axes = FALSE, - ann = FALSE) - - ## get line height in xy coordinates - l_height <- par()$cxy[2] - - ## optionally update ylim - if(boxplot == TRUE) { - - ylim.plot[1] <- ylim.plot[1] - 1.4 * l_height - } - - ## create empty plot to set adjusted plot dimensions - par(new = TRUE) - plot(NA, - xlim = xlim.plot, - ylim = ylim.plot[1:2], - log = log.option, - cex = cex, - axes = FALSE, - ann = FALSE) - - ## add box - box(which = "plot", - col = layout$kde$colour$box) - - ## add x-axis - axis(side = 1, - col = layout$kde$colour$xtck, - col.axis = layout$kde$colour$xtck, - labels = NA, - tcl = -layout$kde$dimension$xtcl / 200, - cex = cex) - - axis(side = 1, - line = 2 * layout$kde$dimension$xtck.line / 100 - 2, - lwd = 0, - col = layout$kde$colour$xtck, - family = layout$kde$font.type$xtck, - font = (1:4)[c("plain", "bold", "italic", "bold italic") == - layout$kde$font.deco$xtck], - col.axis = layout$kde$colour$xtck, - cex.axis = layout$kde$font.size$xlab/12) - - mtext(text = xlab, - side = 1, - line = 3 * layout$kde$dimension$xlab.line / 100, - col = layout$kde$colour$xlab, - family = layout$kde$font.type$xlab, - font = (1:4)[c("plain", "bold", "italic", "bold italic") == - layout$kde$font.deco$xlab], - cex = cex * layout$kde$font.size$xlab/12) - - ## add left y-axis - axis(side = 2, - at = pretty(x = range(De.density.range[3:4])), - col = layout$kde$colour$ytck1, - col.axis = layout$kde$colour$ytck1, - labels = NA, - tcl = -layout$kde$dimension$ytck1 / 200, - cex = cex) - - axis(side = 2, - at = pretty(x = range(De.density.range[3:4])), - line = 2 * layout$kde$dimension$ytck1.line / 100 - 2, - lwd = 0, - col = layout$kde$colour$ytck1, - family = layout$kde$font.type$ytck1, - font = (1:4)[c("plain", "bold", "italic", "bold italic") == - layout$kde$font.deco$ytck1], - col.axis = layout$kde$colour$ytck1, - cex.axis = layout$kde$font.size$ylab1/12) - - mtext(text = ylab[1], - side = 2, - line = 3 * layout$kde$dimension$ylab1.line / 100, - col = layout$kde$colour$ylab1, - family = layout$kde$font.type$ylab1, - font = (1:4)[c("plain", "bold", "italic", "bold italic") == - layout$kde$font.deco$ylab1], - cex = cex * layout$kde$font.size$ylab1/12) - - for(i in 1:length(data)) { - if(!all(is.na(De.density[[i]]))){ - polygon(x = c(par()$usr[1], De.density[[i]]$x, par()$usr[2]), - y = c(min(De.density[[i]]$y),De.density[[i]]$y, min(De.density[[i]]$y)), - border = col.kde.line[i], - col = col.kde.fill[i], - lty = lty[i], - lwd = lwd[i]) - - } - - } - - ## add plot title - cex.old <- par()$cex - par(cex = layout$kde$font.size$main / 12) - title(main = main, - family = layout$kde$font.type$main, - font = (1:4)[c("plain", "bold", "italic", "bold italic") == - layout$kde$font.deco$main], - col.main = layout$kde$colour$main, - line = (toplines + 1.2) * layout$kde$dimension$main / 100) - par(cex = cex.old) - - ## optionally add mtext line - if(mtext != "") { - - mtext(text = mtext, - side = 3, - line = 0.5, - family = layout$kde$font.type$mtext, - font = (1:4)[c("plain", "bold", "italic", "bold italic") == - layout$kde$font.deco$mtext], - col.main = layout$kde$colour$mtext, - cex = layout$kde$font.size$mtext / 12) - } - - ## add summary content - for(i in 1:length(data)) { - - if(summary.pos[1] != "sub") { - - text(x = summary.pos[1], - y = summary.pos[2], - adj = summary.adj, - labels = label.text[[i]], - col = col.stats[i], - cex = layout$kde$font.size$stats / 12) - } else { - - if(mtext == "") { - - mtext(side = 3, - line = (toplines + 0.3 - i) * layout$kde$dimension$stats.line / 100, - text = label.text[[i]], - col = col.stats[i], - cex = layout$kde$font.size$stats / 12) - } - } - } - - if(values.cumulative == TRUE) { - - ## create empty overlay plot - par(new = TRUE) # adjust plot options - - ## add empty plot, scaled to preliminary secondary plot content - plot(x = NA, - xlim = xlim.plot, - ylim = ylim.plot[3:4], - log = log.option, - ann = FALSE, - axes = FALSE - ) - - ## get line height in xy coordinates - l_height <- par()$cxy[2] - - ## optionally update ylim - if(boxplot == TRUE) { - - ylim.plot[3] <- ylim.plot[3] - 1.4 * l_height - } - - ## create correctly scaled empty overlay plot - par(new = TRUE) # adjust plot options - - ## add empty plot, scaled to secondary plot content - plot(NA, - xlim = xlim.plot, - ylim = ylim.plot[3:4], - log = log.option, - ann = FALSE, - axes = FALSE) - - ## optionally add boxplot - if(boxplot == TRUE) { - - ## add zero line - abline(h = 0) - - ## get extended boxplot data - boxplot.data <- list(NA) - - for(i in 1:length(data)) { - boxplot.i <- boxplot(x = data[[i]][,1], - plot = FALSE) - boxplot.i$group <- mean(x = data[[i]][,1], - na.rm = TRUE) - boxplot.i$names <- sd(x = data[[i]][,1], - na.rm = TRUE) - boxplot.data[[length(boxplot.data) + 1]] <- boxplot.i - } - - ## remove dummy list object - boxplot.data[[1]] <- NULL - - ## get new line hights - l_height <- par()$cxy[2] - - for(i in 1:length(data)) { - - # ## draw sd line - # lines(x = c(boxplot.data[[i]]$group[1] - boxplot.data[[i]]$names[1], - # boxplot.data[[i]]$group[1] + boxplot.data[[i]]$names[1]), - # y = c(-5/8 * l_height, - # -5/8 * l_height), - # col = col.mean.line[i]) - # - # ## draw mean line - # points(x = boxplot.data[[i]]$group[1], - # y = -5/8 * l_height, - # pch = 18, - # col = col.mean.line[i]) - - ## draw median line - lines(x = c(boxplot.data[[i]]$stats[3,1], - boxplot.data[[i]]$stats[3,1]), - y = c(-11/8 * l_height, - -7/8 * l_height), - lwd = 2, - col = col.boxplot.line[i]) - - ## draw q25-q75-polygon - polygon(x = c(boxplot.data[[i]]$stats[2,1], - boxplot.data[[i]]$stats[2,1], - boxplot.data[[i]]$stats[4,1], - boxplot.data[[i]]$stats[4,1]), - y = c(-11/8 * l_height, - -7/8 * l_height, - -7/8 * l_height, - -11/8 * l_height), - col = col.boxplot.fill[i], - border = col.boxplot.line[i]) - - ## draw whiskers - lines(x = c(boxplot.data[[i]]$stats[2,1], - boxplot.data[[i]]$stats[1,1]), - y = c(-9/8 * l_height, - -9/8 * l_height), - col = col.boxplot.line[i]) - - lines(x = c(boxplot.data[[i]]$stats[1,1], - boxplot.data[[i]]$stats[1,1]), - y = c(-10/8 * l_height, - -8/8 * l_height), - col = col.boxplot.line[i]) - - lines(x = c(boxplot.data[[i]]$stats[4,1], - boxplot.data[[i]]$stats[5,1]), - y = c(-9/8 * l_height, - -9/8 * l_height), - col = col.boxplot.line[i]) - - lines(x = c(boxplot.data[[i]]$stats[5,1], - boxplot.data[[i]]$stats[5,1]), - y = c(-10/8 * l_height, - -8/8 * l_height), - col = col.boxplot.line[i]) - - ## draw outliers - points(x = boxplot.data[[i]]$out, - y = rep(-9/8 * l_height, - length(boxplot.data[[i]]$out)), - col = col.boxplot.line[i], - cex = cex * 0.8) - } - - } - - ## optionally add rug - if(rug == TRUE) { - - for(i in 1:length(data)) { - - for(j in 1:nrow(data[[i]])) { - - lines(x = c(data[[i]][j,1], - data[[i]][j,1]), - y = c(0, - -2/8 * l_height), - col = col.value.rug[i]) - } - } - } - - ## add secondary y-axis - ticks_axis <- pretty(x = c(1, ylim.plot[4])) - ticks_axis <- ifelse(test = ticks_axis == 0, - yes = NA, - no = ticks_axis) - - ## add right y-axis - axis(side = 4, - at = ticks_axis, - col = layout$kde$colour$ytck2, - col.axis = layout$kde$colour$ytck2, - labels = NA, - tcl = -layout$kde$dimension$ytck2 / 200, - cex = cex) - - axis(side = 4, - at = ticks_axis, - line = 2 * layout$kde$dimension$ytck2.line / 100 - 2, - lwd = 0, - col = layout$kde$colour$ytck2, - family = layout$kde$font.type$ytck2, - font = (1:4)[c("plain", "bold", "italic", "bold italic") == - layout$kde$font.deco$ytck2], - col.axis = layout$kde$colour$ytck2, - cex.axis = layout$kde$font.size$ylab2/12) - - mtext(text = ylab[2], - side = 4, - line = 3 * layout$kde$dimension$ylab2.line / 100, - col = layout$kde$colour$ylab2, - family = layout$kde$font.type$ylab2, - font = (1:4)[c("plain", "bold", "italic", "bold italic") == - layout$kde$font.deco$ylab2], - cex = cex * layout$kde$font.size$ylab2/12) - - ## add De error bars - for(i in 1:length(data)) { - if (attr(data[[i]], "De.errors.available")) { - arrows(data[[i]][, 1] - data[[i]][, 2], - 1:length(data[[i]][,1]), - data[[i]][, 1] + data[[i]][, 2], - 1:length(data[[i]][, 1]), - code = 3, - angle = 90, - length = 0.05, - col = col.value.bar[i]) - } - ## add De measurements - points(data[[i]][,1], 1:De.stats[i,1], - col = col.value.dot[i], - pch = 20) - } - } - - ## add empty plot - par(new = TRUE) - plot(NA, - ann = FALSE, - axes = FALSE, - xlim = xlim.plot, - ylim = ylim.plot[1:2], - log = log.option, - cex = cex, - cex.lab = cex, - cex.main = cex, - cex.axis = cex) - - ## FUN by R Luminescence Team - if (fun == TRUE) sTeve() # nocov - - if(output == TRUE) { - return(invisible(list(De.stats = De.stats, - summary.pos = summary.pos, - De.density = De.density))) - } - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_NRt.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_NRt.R deleted file mode 100644 index da97dda8e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_NRt.R +++ /dev/null @@ -1,247 +0,0 @@ -#' Visualise natural/regenerated signal ratios -#' -#' This function creates a Natural/Regenerated signal vs. time (NR(t)) plot -#' as shown in Steffen et al. 2009 -#' -#' This function accepts the individual curve data in many different formats. If -#' `data` is a `list`, each element of the list must contain a two -#' column `data.frame` or `matrix` containing the `XY` data of the curves -#' (time and counts). Alternatively, the elements can be objects of class -#' [RLum.Data.Curve-class]. -#' -#' Input values can also be provided as a `data.frame` or `matrix` where -#' the first column contains the time values and each following column contains -#' the counts of each curve. -#' -#' @param data [list], [data.frame], [matrix] or [RLum.Analysis-class] (**required**): -#' X,Y data of measured values (time and counts). See details on individual data structure. -#' -#' @param log [character] (*optional*): -#' logarithmic axes (`c("x", "y", "xy")`). -#' -#' @param smooth [character] (*optional*): -#' apply data smoothing. Use `"rmean"` to calculate the rolling where `k` -#' determines the width of the rolling window (see [zoo::rollmean]). `"spline"` -#' applies a smoothing spline to each curve (see [stats::smooth.spline]) -#' -#' @param k [integer] (*with default*): -#' integer width of the rolling window. -#' -#' @param legend [logical] (*with default*): -#' show or hide the plot legend. -#' -#' @param legend.pos [character] (*with default*): -#' keyword specifying the position of the legend (see [legend]). -#' -#' @param ... further parameters passed to [plot] (also see [par]). -#' -#' -#' @author Christoph Burow, University of Cologne (Germany) -#' -#' @seealso [plot] -#' -#' @return Returns a plot and [RLum.Analysis-class] object. -#' -#' @references -#' Steffen, D., Preusser, F., Schlunegger, F., 2009. OSL quartz underestimation due to -#' unstable signal components. Quaternary Geochronology, 4, 353-362. -#' -#' @examples -#' -#' ## load example data -#' data("ExampleData.BINfileData", envir = environment()) -#' -#' ## EXAMPLE 1 -#' -#' ## convert Risoe.BINfileData object to RLum.Analysis object -#' data <- Risoe.BINfileData2RLum.Analysis(object = CWOSL.SAR.Data, pos = 8, ltype = "OSL") -#' -#' ## extract all OSL curves -#' allCurves <- get_RLum(data) -#' -#' ## keep only the natural and regenerated signal curves -#' pos <- seq(1, 9, 2) -#' curves <- allCurves[pos] -#' -#' ## plot a standard NR(t) plot -#' plot_NRt(curves) -#' -#' ## re-plot with rolling mean data smoothing -#' plot_NRt(curves, smooth = "rmean", k = 10) -#' -#' ## re-plot with a logarithmic x-axis -#' plot_NRt(curves, log = "x", smooth = "rmean", k = 5) -#' -#' ## re-plot with custom axes ranges -#' plot_NRt(curves, smooth = "rmean", k = 5, -#' xlim = c(0.1, 5), ylim = c(0.4, 1.6), -#' legend.pos = "bottomleft") -#' -#' ## re-plot with smoothing spline on log scale -#' plot_NRt(curves, smooth = "spline", log = "x", -#' legend.pos = "top") -#' -#' ## EXAMPLE 2 -#' -#' # you may also use this function to check whether all -#' # TD curves follow the same shape (making it a TnTx(t) plot). -#' posTD <- seq(2, 14, 2) -#' curves <- allCurves[posTD] -#' -#' plot_NRt(curves, main = "TnTx(t) Plot", -#' smooth = "rmean", k = 20, -#' ylab = "TD natural / TD regenerated", -#' xlim = c(0, 20), legend = FALSE) -#' -#' ## EXAMPLE 3 -#' -#' # extract data from all positions -#' data <- lapply(1:24, FUN = function(pos) { -#' Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = pos, ltype = "OSL") -#' }) -#' -#' # get individual curve data from each aliquot -#' aliquot <- lapply(data, get_RLum) -#' -#' # set graphical parameters -#' par(mfrow = c(2, 2)) -#' -#' # create NR(t) plots for all aliquots -#' for (i in 1:length(aliquot)) { -#' plot_NRt(aliquot[[i]][pos], -#' main = paste0("Aliquot #", i), -#' smooth = "rmean", k = 20, -#' xlim = c(0, 10), -#' cex = 0.6, legend.pos = "bottomleft") -#' } -#' -#' # reset graphical parameters -#' par(mfrow = c(1, 1)) -#' -#' -#' @md -#' @export -plot_NRt <- function(data, log = FALSE, smooth = c("none", "spline", "rmean"), k = 3, - legend = TRUE, legend.pos = "topright", ...) { - - ## DATA INPUT EVALUATION ----- - if (inherits(data, "list")) { - if (length(data) < 2) - .throw_error("The provided list only contains curve data ", - "of the natural signal") - if (all(sapply(data, class) == "RLum.Data.Curve")) - curves <- lapply(data, get_RLum) - } - else if (inherits(data, "data.frame") || inherits(data, "matrix")) { - if (ncol(data) < 3) - .throw_error("The provided ", class(data)[1], - " only contains curve data of the natural signal") - if (is.matrix(data)) - data <- as.data.frame(data) - curves <- apply(data[2:ncol(data)], MARGIN = 2, function(curve) { - data.frame(data[ ,1], curve) - }) - } - else if (inherits(data, "RLum.Analysis")) { - RLum.objects <- get_RLum(data) - if (any(sapply(RLum.objects, class) != "RLum.Data.Curve")) - .throw_error("The provided 'RLum.Analysis' object ", - "must exclusively contain 'RLum.Data.Curve' objects") - curves <- lapply(RLum.objects, get_RLum) - if (length(curves) < 2) - .throw_error("The provided 'RLum.Analysis' object ", - "only contains curve data of the natural signal") - } else { - .throw_error("'data' is expected to be a list, matrix, data.frame or ", - "'RLum.Analysis' object") - } - - ## BASIC SETTINGS ------ - natural <- curves[[1]] - regCurves <- curves[2:length(curves)] - time <- curves[[1]][ ,1] - - if (any(sapply(regCurves, nrow) != nrow(natural))) { - .throw_error("The time values for the natural signal don't match ", - "those for the regenerated signal") - } - - ## DATA TRANSFORMATION ----- - - # calculate ratios - NR <- lapply(regCurves, FUN = function(reg, nat) { nat[ ,2] / reg[ ,2] }, natural) - - # smooth spline - if (smooth[1] == "spline") { - NR <- lapply(NR, function(nr) { smooth.spline(nr)$y }) - } - if (smooth[1] == "rmean") { - NR <- lapply(NR, function(nr) { zoo::rollmean(nr, k) }) - time <- zoo::rollmean(time, k) - } - - # normalise data - NRnorm <- lapply(NR, FUN = function(nr) { nr / nr[1] }) - - - ## EXTRA ARGUMENTS ----- - - # default values - settings <- list( - xlim = if (log == "x" || log == "xy") c(0.1, max(time)) else c(0, max(time)), - ylim = range(pretty(c(min(sapply(NRnorm, min)), max(sapply(NRnorm, max))))), - xlab = "Time [s]", - ylab = "Natural signal / Regenerated signal", - cex = 1L, - main = "NR(t) Plot") - - # override defaults with user settings - settings <- modifyList(settings, list(...)) - - - - ## PLOTTING ---------- - - # set graphical parameter - par(cex = settings$cex) - - # empty plot - if (is.na(pmatch(log, c("x", "y", "xy")))) - log <- "" - - do.call(plot, modifyList(list(x = NA, y = NA, log = log, xaxs = "i", yaxs = "i"), - settings)) - - # horizontal line - abline(h = 1, lty = 3, col = "grey") - - col <- 1:length(NRnorm) - - # add N/R lines - mapply(FUN = function(curve, col) { - points(time, curve, type = "l", col = col) - }, NRnorm, col) - - # add legend - if (legend) { - labels <- paste0("N/R", 1:length(NRnorm)) - ncol <- ifelse(length(NRnorm) > 4, ceiling(length(NRnorm) / 4) , 1) - legend(legend.pos, legend = labels, col = col, lty = 1, ncol = ncol, cex = 0.8, bty = "n") - } - - ## RETURN VALUES ---- - obj <- set_RLum("RLum.Analysis", protocol = "UNKNOWN", - records = mapply(FUN = function(curve, id) { - set_RLum("RLum.Data.Curve", - recordType = paste0("N/R", id), - curveType = "NRt", - data = matrix(c(time, curve), ncol = 2), - info = list( - data = curves, - call = sys.call(-6L), - args = as.list(sys.call(-6L)[-1]) - )) - }, NRnorm, seq_len(length(NRnorm))) - ) - invisible(obj) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_OSLAgeSummary.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_OSLAgeSummary.R deleted file mode 100644 index 5f92ffa82..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_OSLAgeSummary.R +++ /dev/null @@ -1,158 +0,0 @@ -#'@title Plot Posterior OSL-Age Summary -#' -#'@description A graphical summary of the statistical inference of an OSL age -#' -#'@details The function is called automatically by [combine_De_Dr] -#' -#'@param object [RLum.Results-class], [numeric] (**required**): an object produced -#' by [combine_De_Dr]. Alternatively, a [numeric] vector of a parameter from an MCMC process -#' -#'@param level [numeric] (*with default*): probability of shown credible interval -#' -#'@param digits [integer] (*with default*): number of digits considered for the calculation -#' -#'@param verbose [logical] (*with default*): enable/disable additional terminal output -#' -#'@param ... further arguments to modify the plot, supported: `xlim`, `ylim`, `xlab`, `ylab`, -#' `main`, `lwd`, `lty`, `col`, `polygon_col`, `polygon_density`, `rug` -#' -#'@return A posterior distribution plot and an [RLum.Results-class] -#' object with the credible interval. -#' -#'@author Anne Philippe, Université de Nantes (France), -#' Jean-Michel Galharret, Université de Nantes (France), -#' Norbert Mercier, IRAMAT-CRP2A, Université Bordeaux Montaigne (France), -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#'@section Function version: 0.1.0 -#' -#'@seealso [combine_De_Dr], [plot.default], [rjags::rjags] -#' -#'@keywords hplot dplot -#' -#'@examples -#'##generate random data -#'set.seed(1234) -#'object <- rnorm(1000, 100, 10) -#'plot_OSLAgeSummary(object) -#' -#'@md -#'@export -plot_OSLAgeSummary <- function( - object, - level = 0.95, - digits = 1L, - verbose = TRUE, - ... -){ -# Integrity tests --------------------------------------------------------- - if(is(object, "RLum.Results") && - object@originator %in% c(".calc_BayesianCentralAgeModel", ".calc_IndividualAgeModel")) - object <- get_RLum(object, data.object = "A") - - if(is(object, "RLum.Results") && object@originator == "combine_De_Dr") - object <- get_RLum(object, data.object = "Ages") - - - if(!is(object, "numeric")) { - stop(paste0("[plot_OSLAgeSummary()] class ", class(object)[1], - " not supported as input for object!"),call. = FALSE) - } - - ## A should be a matrix - A <- as.matrix(object, ncol = 1) - -# Run calculations -------------------------------------------------------- - ## use our internal function instead of Archaeophase to avoid the decency hell - CI <- round(.calc_HPDI(A, prob = level[1]), digits[1]) - Bayes_est_mean <- round(mean(A), digits = digits) - Bayes_est_sd <- round(sd(A), digits = digits) - -# Terminal output --------------------------------------------------------- - if(verbose){ - cat("\n[plot_OSLAgeSummary()]\n") - cat(paste0(" Credible Interval (", level * 100 ),"%): ",paste(CI[1,], collapse = " : "), "\n") - cat(paste0(" Bayes estimate (posterior mean \u00b1 sd): ", Bayes_est_mean[1], " \u00b1 ", Bayes_est_sd[1]),"\n") - - } - -# Plot output ------------------------------------------------------------- - density_A <- density(A) - - plot_settings <- modifyList(x = list( - xlim = range(A), - ylim = range(density_A$y), - main = "Posterior distr. of A", - xlab = "Age [ka]", - ylab = "Density", - lwd = 1, - lty = 1, - col = "black", - polygon_col = rgb(1,0,0,0.3), - polygon_density = 20, - rug = FALSE - - ), val = list(...)) - - plot( - x = density_A$x, - y = density_A$y, - xlim = plot_settings$xlim, - ylim = plot_settings$ylim * 1.07, - xlab = plot_settings$xlab, - ylab = plot_settings$ylab, - main = plot_settings$main, - type = "l", - lwd = plot_settings$lwd, - lty = plot_settings$lty, - col = plot_settings$col - ) - - ## add lines on the top for the CI - lines(x = c(CI[1,]), y = rep(par()$usr[4] * 0.92, 2)) - lines(x = rep(CI[1,1], 2), y = c(par()$usr[4] * 0.91, par()$usr[4] * 0.92)) - lines(x = rep(CI[1,2], 2), y = c(par()$usr[4] * 0.91, par()$usr[4] * 0.92)) - - ## add polygon fill - polygon( - x = c(density_A$x, rev(density_A$x)), - y = c(density_A$y, rep(0, length(density_A$y))), - col = plot_settings$polygon_col, - lty = 0, - density = NULL - ) - - ## add CI - xy_id <- density_A$x >= CI[1,1] & density_A$x <= CI[1,2] - polygon( - x = c(density_A$x[xy_id], rev(density_A$x[xy_id])), - y = c(density_A$y[xy_id], rep(0, length(density_A$y[xy_id]))), - col = "black", - lwd = 0.5, - border = TRUE, - density = plot_settings$polygon_density - ) - - ##add rug - if(plot_settings$rug) rug(A) - - ## add text - text(x = density_A$x[xy_id][1], y = density_A$y[xy_id][2], CI[1,1], pos = 2, cex = 0.6) - text(x = max(density_A$x[xy_id]), y = rev(density_A$y[xy_id])[1], CI[1,2], pos = 4, cex = 0.6) - text( - x = median(density_A$x[xy_id]), - y = par()$usr[4] * 0.91, - labels = paste0("CI: ", level[1] * 100, "%"), - pos = 3, - cex = 0.6 - ) - -# Return ------------------------------------------------------------------ - return(set_RLum("RLum.Results", - data = list( - Estimate = Bayes_est_mean, - Credible_Interval = CI, - level = level), - info = list(call = sys.call()))) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_RLum.Analysis.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_RLum.Analysis.R deleted file mode 100644 index a1a7d38e3..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_RLum.Analysis.R +++ /dev/null @@ -1,821 +0,0 @@ -#' @title Plot function for an RLum.Analysis S4 class object -#' -#' @description The function provides a standardised plot output for curve data of an -#' RLum.Analysis S4 class object -#' -#' The function produces a multiple plot output. A file output is recommended -#' (e.g., [pdf]). -#' -#' **curve.transformation** -#' -#' This argument allows transforming continuous wave (CW) curves to pseudo -#' (linear) modulated curves. For the transformation, the functions of the -#' package are used. Currently, it is not possible to pass further arguments to -#' the transformation functions. The argument works only for `ltype` -#' `OSL` and `IRSL`. -#' -#' Please note: The curve transformation within this functions works roughly, -#' i.e. every IRSL or OSL curve is transformed, without considering whether it -#' is measured with the PMT or not! However, for a fast look it might be -#' helpful. -#' -#' @param object [RLum.Analysis-class] (**required**): -#' S4 object of class `RLum.Analysis` -#' -#' @param subset named [list] (*optional*): -#' subsets elements for plotting. The arguments in the named [list] will be -#' directly passed to the function [get_RLum] -#' (e.g., `subset = list(curveType = "measured")`) -#' -#' @param nrows [integer] (*optional*): -#' sets number of rows for plot output, if nothing is set the function -#' tries to find a value. -#' -#' @param ncols [integer] (*optional*): -#' sets number of columns for plot output, if nothing is set the function -#' tries to find a value. -#' -#' @param abline [list] (*optional*): -#' allows to add ab-lines to the plot. Argument are provided -#' in a list and will be forward to the function [abline], -#' e.g., `list(v = c(10, 100))` adds two vertical lines add 10 and 100 to all -#' plots. In contrast `list(v = c(10), v = c(100)` adds a vertical at 10 to -#' the first and a vertical line at 100 to the 2nd plot. -#' -#' @param combine [logical] (*with default*): -#' allows to combine all [RLum.Data.Curve-class] objects in one single plot. -#' -#' @param records_max [numeric] (*optional*): limits number of records -#' shown if `combine = TRUE`. Shown are always the first and the last curve, -#' the other number of curves to be shown a distributed evenly, this may result -#' in fewer curves plotted as specified. This parameter has only -#' an effect for n > 2. -#' -#' @param curve.transformation [character] (*optional*): -#' allows transforming CW-OSL and CW-IRSL curves to pseudo-LM curves via -#' transformation functions. Allowed values are: `CW2pLM`, `CW2pLMi`, -#' `CW2pHMi` and `CW2pPMi`. See details. -#' -#' @param plot.single [logical] (*with default*): -#' global par settings are considered, normally this should end in one plot per page -#' -#' @param ... further arguments and graphical parameters will be passed to -#' the `plot` function. -#' -#' Supported arguments: `main`, `mtext`, `log`, `lwd`, `lty` `type`, `pch`, `col`, -#' `norm` (see [plot_RLum.Data.Curve]), `xlim`,`ylim`, `xlab`, `ylab`, ... -#' -#' and for `combine = TRUE` also: `sub_title`, `legend`, `legend.text`, `legend.pos` -#' (typical plus 'outside'), `legend.col`, `smooth`. -#' -#' All arguments can be provided as `vector` or `list` to gain in full control -#' of all plot settings. -#' -#' @return Returns multiple plots. -#' -#' @note -#' Not all arguments available for [plot] will be passed and they partly do not behave in the -#' way you might expect them to work. This function was designed to serve as an overview -#' plot, if you want to have more control, extract the objects and plot them individually. -#' -#' @section Function version: 0.3.15 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [plot], [plot_RLum], [plot_RLum.Data.Curve] -#' -#' @keywords aplot -#' -#' @examples -#' -#'##load data -#'data(ExampleData.BINfileData, envir = environment()) -#' -#'##convert values for position 1 -#'temp <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) -#' -#'##(1) plot (combine) TL curves in one plot -#'plot_RLum.Analysis( -#' temp, -#' subset = list(recordType = "TL"), -#' combine = TRUE, -#' norm = TRUE, -#' abline = list(v = c(110)) -#' ) -#' -#'##(2) same as example (1) but using -#'## the argument smooth = TRUE -#'plot_RLum.Analysis( -#' temp, -#' subset = list(recordType = "TL"), -#' combine = TRUE, -#' norm = TRUE, -#' smooth = TRUE, -#' abline = list(v = c(110)) -#' ) -#' -#' @md -#' @export -plot_RLum.Analysis <- function( - object, - subset = NULL, - nrows, - ncols, - abline = NULL, - combine = FALSE, - records_max = NULL, - curve.transformation, - plot.single = FALSE, - ... -){ - - # Integrity check ---------------------------------------------------------------------------- - - ##check if object is of class RLum.Analysis (lists are handled via plot_RLum()) - if (!is(object, "RLum.Analysis")) - .throw_error("Input object is not of type 'RLum.Analysis'") - - # Make selection if wanted ------------------------------------------------------------------- - - if(!is.null(subset)){ - ##check whether the user set the drop option and remove it, as we cannot work with it - subset <- subset[!sapply(names(subset), function(x){"drop" %in% x})] - object <- do.call(get_RLum, c(object = object, subset, drop = FALSE)) - - } - - # Deal with additional arguments. ------------------------------------------------------------ - - ##create plot settings list - plot.settings <- list( - main = NULL, - mtext = NULL, - log = "", - lwd = 1, - lty = 1, - type = "l", - xlab = NULL, - ylab = NULL, - xlim = NULL, - ylim = NULL, - pch = 1, - col = "auto", - norm = FALSE, - sub_title = NULL, - cex = 1, - legend = TRUE, - legend.text = NULL, - legend.pos = NULL, - legend.col = NULL, - smooth = FALSE - ) - - plot.settings <- modifyList(x = plot.settings, val = list(...), keep.null = TRUE) - - ##try to find optimal parameters, this is however, a little bit stupid, but - ##better than without any presetting - if(combine) - n.plots <- length(unique(as.character(structure_RLum(object)$recordType))) - else - n.plots <- length_RLum(object) - - if (!missing(nrows)) .validate_positive_scalar(nrows) - if (!missing(ncols)) .validate_positive_scalar(ncols) - - ## set appropriate values for nrows and ncols if not both specified - if (missing(ncols) | missing(nrows)) { - if (missing(ncols) & !missing(nrows)) { - if (n.plots == 1) { - ncols <- 1 - - } else{ - ncols <- 2 - } - } - else if (!missing(ncols) & missing(nrows)) { - if (n.plots == 1) { - nrows <- 1 - - } - else if (n.plots > 1 & n.plots <= 4) { - nrows <- 2 - - } else{ - nrows <- 3 - } - - } else{ - - if (n.plots == 1) { - nrows <- 1 - ncols <- 1 - - } - else if (n.plots > 1 & n.plots <= 2) { - nrows <- 1 - ncols <- 2 - - } else if (n.plots > 2 & n.plots <= 4) { - nrows <- 2 - ncols <- 2 - - } - else{ - nrows <- 3 - ncols <- 2 - - } - } - } - - - # Plotting ------------------------------------------------------------------ - ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ## (1) NORMAL (combine == FALSE) -------- - ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - if(!combine || length(object@records) == 1){ - - ##show warning message - if(combine & length(object@records) == 1){ - .throw_warning("Nothing to combine, object contains a single curve") - } - - ##grep RLum.Data.Curve or RLum.Data.Spectrum objects - temp <- lapply(1:length(object@records), function(x){ - if(is(object@records[[x]], "RLum.Data.Curve") || - is(object@records[[x]], "RLum.Data.Spectrum")){ - - object@records[[x]] - - }}) - - ##calculate number of pages for mtext - if (length(temp) %% (nrows * ncols) > 0) { - n.pages <- round(length(temp) / (nrows * ncols), digits = 0) + 1 - - } else{ - n.pages <- length(temp) / (nrows * ncols) - - } - - ##set par - par.default <- par("mfrow") - if(!plot.single){on.exit(par(mfrow = par.default))} - if(!plot.single) { - par(mfrow = c(nrows, ncols)) - } - - - ##expand plot settings list - plot.settings <- lapply(setNames(1:length(plot.settings), names(plot.settings)), - function(x) { - if (!is.null(plot.settings[[x]])) { - if(length(plot.settings[[x]]) > 1){ - - if(is(plot.settings[[x]], "list")){ - rep_len(plot.settings[[x]], length.out = length(temp)) - - }else{ - rep_len(list(plot.settings[[x]]), length.out = length(temp)) - - } - - }else{ - rep_len(plot.settings[[x]], length.out = length(temp)) - - } - - } else{ - plot.settings[[x]] - - } - }) - - ##expand abline - if(!is.null(abline)){ - abline.names <- rep_len(names(abline), length.out = length(temp)) - abline <- rep_len(abline, length.out = length(temp)) - names(abline) <- abline.names - - } - - ##apply curve transformation - for(i in 1:length(temp)){ - - if(is(temp[[i]], "RLum.Data.Curve") == TRUE){ - - ##set curve transformation if wanted - if((grepl("IRSL", temp[[i]]@recordType) | grepl("OSL", temp[[i]]@recordType)) & - !missing(curve.transformation)){ - - if(curve.transformation=="CW2pLM"){ - temp[[i]] <- CW2pLM(temp[[i]]) - - }else if(curve.transformation=="CW2pLMi"){ - temp[[i]] <- CW2pLMi(temp[[i]]) - - }else if(curve.transformation=="CW2pHMi"){ - temp[[i]]<- CW2pHMi(temp[[i]]) - - }else if(curve.transformation=="CW2pPMi"){ - temp[[i]] <- CW2pPMi(temp[[i]]) - - }else{ - .throw_warning("Function for 'curve.transformation' is unknown, ", - "no transformation performed") - } - } - - ##check plot settings and adjust - ##xlim - if (!is.null(plot.settings$xlim)) { - xlim.set <- plot.settings$xlim[[i]] - if (plot.settings$xlim[[i]][1] < min(temp[[i]]@data[,1])) { - .throw_warning("min('xlim') < x-value range for curve #", i, - ", reset to minimum") - xlim.set[1] <- min(temp[[i]]@data[,1]) - } - if (plot.settings$xlim[[i]][2] > max(temp[[i]]@data[,1])) { - .throw_warning("max('xlim') > x-value range for curve #", i, - ", reset to maximum") - xlim.set[2] <- max(temp[[i]]@data[,1]) - } - - }else{ - xlim.set <- plot.settings$xlim[[i]] - } - - ##ylim - if (!is.null(plot.settings$ylim)) { - ylim.set <- plot.settings$ylim[[i]] - if (plot.settings$ylim[[i]][1] < min(temp[[i]]@data[,2])) { - .throw_warning("min('ylim') < y-value range for curve #", i, - ", reset to minimum") - ylim.set[1] <- min(temp[[i]]@data[,2]) - } - if (plot.settings$ylim[[i]][2] > max(temp[[i]]@data[,2])) { - .throw_warning("max('ylim') > y-value range for curve #", i, - ", reset to maximum") - ylim.set[2] <- max(temp[[i]]@data[,2]) - } - - }else{ - ylim.set <- plot.settings$ylim[[i]] - - } - - ##col - if (unique(plot.settings$col) != "auto") { - col <- plot.settings$col[i] - - } else{ - if (grepl("IRSL", temp[[i]]@recordType)) { - col <- "red" - } else - if (grepl("OSL", temp[[i]]@recordType)) { - col <- "blue" - } else - { - col <- "black" - } - } - - ##main - main <- if (is.null(plot.settings$main[[i]])) { - temp[[i]]@recordType - } else{ - plot.settings$main[[i]] - } - - ##++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ##PLOT - ##++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ##plot RLum.Data.Curve curve - ##we have to do this via this way, otherwise we run into a duplicated arguments - ##problem - ##check and remove duplicated arguments - arguments <- c( - list( - object = temp[[i]], - col = col, - mtext = if (!is.null(plot.settings$mtext[[i]])) { - plot.settings$mtext[[i]] - } else{ - paste("#", i, sep = "") - }, - par.local = FALSE, - main = main, - log = plot.settings$log[[i]], - lwd = plot.settings$lwd[[i]], - type = plot.settings$type[[i]], - lty = plot.settings$lty[[i]], - xlim = xlim.set, - ylim = ylim.set, - norm = plot.settings$norm, - pch = plot.settings$pch[[i]], - cex = plot.settings$cex[[i]], - smooth = plot.settings$smooth[[i]] - ), - list(...) - ) - - arguments[duplicated(names(arguments))] <- NULL - - ##call the function plot_RLum.Data.Curve - do.call(what = "plot_RLum.Data.Curve", args = arguments) - rm(arguments) - - ##add abline - if(!is.null(abline[[i]])){ - do.call(what = "abline", args = abline[i]) - - } - - } else if(inherits(temp[[i]], "RLum.Data.Spectrum")) { - ## remove already provided arguments - args <- list(...)[!names(list(...)) %in% c("object", "mtext", "par.local", "main")] - - do.call(what = "plot_RLum.Data.Spectrum", args = c(list( - object = temp[[i]], - mtext = if(!is.null(plot.settings$mtext[[i]])) plot.settings$mtext[[i]] else paste("#", i, sep = ""), - par.local = FALSE, - main = if(!is.null(plot.settings$main)) plot.settings$main else temp[[i]]@recordType - ), args)) - - } - - }#end for loop - - }else{ - - ##++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ## (2) NORMAL (combine == TRUE) --------- - ##++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ##(1) check RLum objects in the set - object.list <- object@records - - sapply(object.list, function(o){ - if(!inherits(o, "RLum.Data.Curve")){ - .throw_error("Using 'combine' is limited to 'RLum.Data.Curve' objects") - } - }) - - ##account for different curve types, combine similar - temp.object.structure <- structure_RLum(object) - temp.recordType <- as.character(unique(temp.object.structure$recordType)) - - ##change graphic settings - if(!plot.single){ - par.default <- par()[c("cex", "mfrow")] - - if(!missing(ncols) & !missing(nrows)){ - par(mfrow = c(nrows, ncols)) - } - - ##this 2nd par request is needed as setting mfrow resets the par settings ... this might - ##not be wanted - par(cex = plot.settings$cex[1]) - - }else{ - par.default <- par()[c("cex")] - par(cex = plot.settings$cex) - } - - ##expand plot settings list - ##expand list - plot.settings <- lapply(setNames(1:length(plot.settings), names(plot.settings)), function(x) { - if (!is.null(plot.settings[[x]])) { - if(is.list(plot.settings[[x]])){ - rep_len(plot.settings[[x]], length.out = length(temp.recordType)) - - }else{ - rep_len(list(plot.settings[[x]]), length.out = length(temp.recordType)) - } - - } else{ - plot.settings[[x]] - - } - }) - - ##expand abline - if(!is.null(abline)){ - abline.names <- rep_len(names(abline), length.out = length(temp.recordType)) - abline <- rep_len(abline, length.out = length(temp.recordType)) - names(abline) <- abline.names - - } - - - ##(2) PLOT values - for(k in 1:length(temp.recordType)) { - - ###get type of curves - temp.object <- - get_RLum(object, recordType = temp.recordType[k], drop = FALSE) - - ##get structure - object.structure <- structure_RLum(temp.object) - - ##now get the real list object (note the argument recursive = FALSE) - object.list <- - get_RLum(object, recordType = temp.recordType[k], recursive = FALSE) - - ## limit number of records shown ... show always first and last; - ## distribute the rest - if(!is.null(records_max) && records_max[1] > 2){ - records_show <- ceiling(seq(1,length(object.list), length.out = records_max)) - object.list[(1:length(object.list))[-records_show]] <- NULL - - } - - ##prevent problems for non set argument - if (missing(curve.transformation)) { - curve.transformation <- "None" - } - - ##transform values to data.frame and norm values - temp.data.list <- lapply(1:length(object.list), function(x) { - ##set curve transformation if wanted - - if (grepl("IRSL", object.list[[x]]@recordType) | - grepl("OSL", object.list[[x]]@recordType)) { - if (curve.transformation == "CW2pLM") { - object.list[[x]] <- CW2pLM(object.list[[x]]) - - }else if (curve.transformation == "CW2pLMi") { - object.list[[x]] <- CW2pLMi(object.list[[x]]) - - }else if (curve.transformation == "CW2pHMi") { - object.list[[x]] <- CW2pHMi(object.list[[x]]) - - }else if (curve.transformation == "CW2pPMi") { - object.list[[x]] <- CW2pPMi(object.list[[x]]) - } - } - - temp.data <- as(object.list[[x]], "data.frame") - - ##normalise curves if argument has been set - if(plot.settings$norm[[k]][1] %in% c('max', 'last', 'huot') || plot.settings$norm[[k]][1] == TRUE){ - if (plot.settings$norm[[k]] == "max" || plot.settings$norm[[k]] == TRUE) { - temp.data[[2]] <- temp.data[[2]] / max(temp.data[[2]]) - - } else if (plot.settings$norm[[k]] == "last") { - temp.data[[2]] <- temp.data[[2]] / temp.data[[2]][length(temp.data[[2]])] - - - } else if (plot.settings$norm[[k]] == "huot") { - bg <- median(temp.data[[2]][floor(nrow(temp.data)*0.8):nrow(temp.data)]) - temp.data[[2]] <- (temp.data[[2]] - bg) / max(temp.data[[2]] - bg) - - } - - ##check for Inf and NA - if(any(is.infinite(temp.data[[2]])) || anyNA(temp.data[[2]])){ - temp.data[[2]][is.infinite(temp.data[[2]]) | is.na(temp.data[[2]])] <- 0 - .throw_warning("Normalisation led to Inf or NaN values, ", - "values replaced by 0", nframe = 3) - } - } - - return(temp.data) - - }) - - ##set plot parameters - ##main - main <- if (!is.null(plot.settings$main[[k]])) { - plot.settings$main[[k]] - } else{ - paste0(temp.recordType[[k]], " combined") - } - - ##xlab - xlab <- if(!is.null(plot.settings$xlab[[k]])){ - plot.settings$xlab[[k]] - }else{ - switch(temp.recordType[[k]], - "TL" = "Temperature [\u00B0C]", - "IRSL" = "Time [s]", - "OSL" = "Time [s]", - "RF" = "Time [s]", - "RBR" = "Time [s]", - "LM-OSL" = "Time [s]" - ) - } - - ##ylab - ylab <- if(!is.null(plot.settings$ylab[[k]])){ - plot.settings$ylab[[k]] - }else{ - paste0(temp.recordType[[k]], " [a.u.]") - } - - ##xlim - xlim <- if (!is.null(plot.settings$xlim[[k]]) & length(plot.settings$xlim[[k]]) >1) { - plot.settings$xlim[[k]] - } else { - c(min(object.structure$x.min), max(object.structure$x.max)) - } - if (grepl("x", plot.settings$log[[k]], ignore.case = TRUE)) - xlim[which(xlim == 0)] <- 1 - - ##ylim - ylim <- if (!is.null(plot.settings$ylim[[k]]) & length(plot.settings$ylim[[k]]) > 1) { - plot.settings$ylim[[k]] - } else { - range(unlist(lapply(X = temp.data.list, FUN = function(x){ - range(x[,2]) - }))) - - } - - if (grepl("y", plot.settings$log[[k]], ignore.case = TRUE)) - ylim[which(ylim == 0)] <- 1 - - ##col (again) - col <- if(length(plot.settings$col[[k]]) > 1 || plot.settings$col[[k]][1] != "auto"){ - plot.settings$col[[k]] - - }else{ - col <- get("col", pos = .LuminescenceEnv) - - } - - ##if length of provided colours is < the number of objects, just one colour is supported - if (length(col) < length(object.list)) { - col <- rep_len(col, length(object.list)) - - } - - ##lty - if (length(plot.settings$lty[[k]]) < length(object.list)) { - lty <- rep(plot.settings$lty[[k]], times = length(object.list)) - - }else{ - lty <- plot.settings$lty[[k]] - - } - - ##pch - if (length(plot.settings$pch[[k]]) < length(object.list)) { - pch <- rep(plot.settings$pch[[k]], times = length(object.list)) - - }else{ - pch <- plot.settings$pch[[k]] - - } - - ##legend.text - legend.text <- if(!is.null(plot.settings$legend.text[[k]])){ - plot.settings$legend.text[[k]] - - }else{ - if(!is.null(records_max) && records_max[1] > 2) { - paste("Curve", records_show) - - } else { - paste("Curve", 1:length(object.list)) - - } - - } - - ##legend.col - legend.col <- if(!is.null(plot.settings$legend.col[[k]])){ - plot.settings$legend.col[[k]] - - }else{ - NULL - - } - - ##legend.pos - legend.pos <- if(!is.null(plot.settings$legend.pos[[k]])){ - plot.settings$legend.pos[[k]] - - }else{ - "topright" - - } - - if (legend.pos == "outside") { - par.default.outside <- par()[c("mar", "xpd")] - par(mar = c(5.1, 4.1, 4.1, 8.1)) - } - - ##open plot area - plot( - NA,NA, - xlim = xlim, - ylim = ylim, - main = main, - xlab = xlab, - ylab = ylab, - log = plot.settings$log[[k]], - sub = plot.settings$sub_title[[k]] - ) - - ##plot single curve values - ## ...?Why using matplot is a bad idea: The channel resolution might be different - for (n in 1:length(temp.data.list)) { - - ##smooth - ##Why here again ... because the call differs from the one before, where the argument - ##is passed to plot_RLum.Data.Curve() - if(plot.settings$smooth[[k]]){ - k_factor <- ceiling(length(temp.data.list[[n]][, 2])/100) - temp.data.list[[n]][, 2] <- zoo::rollmean(temp.data.list[[n]][, 2], - k = k_factor, fill = NA) - } - - ##remove 0 values if plotted on a log-scale - # y-Axis - if (grepl("y", plot.settings$log[[k]], ignore.case = TRUE)) - temp.data.list[[n]] <- temp.data.list[[n]][which(temp.data.list[[n]]$y > 0), ] - # x-Axis - if (grepl("x", plot.settings$log[[k]], ignore.case = TRUE)) - temp.data.list[[n]] <- temp.data.list[[n]][which(temp.data.list[[n]]$x > 0), ] - - ##print lines - if (plot.settings$type[[k]] == "l" | plot.settings$type[[k]] == "b" ) { - lines( - temp.data.list[[n]], - col = col[n], - lty = lty[n], - lwd = plot.settings$lwd[[k]] - ) - - } - - ##add points if requested - if (plot.settings$type[[k]] == "p" | plot.settings$type[[k]] == "b" ) { - points( - temp.data.list[[n]], - col = col[n], - pch = pch[n], - ) - } - } - - ##add abline - if(!is.null(abline[[k]])){ - do.call(what = "abline", args = abline[k]) - - } - - ##mtext - mtext(plot.settings$mtext[[k]], side = 3, cex = .8 * plot.settings$cex[[k]]) - - ##if legend is outside of the plotting area we need to allow overplotting - ##AFTER all lines have been drawn - if (legend.pos == "outside") { - par(xpd = TRUE) - - # determine legend position on log(y) scale - if (grepl("y", plot.settings$log[[k]], ignore.case = TRUE)) - ypos <- 10^par()$usr[4] - else - ypos <- par()$usr[4] - - # determine position on log(x) scale - if (grepl("x", plot.settings$log[[k]], ignore.case = TRUE)) - xpos <- 10^par()$usr[2] - else - xpos <- par()$usr[2] - } - - ##legend - if (plot.settings$legend[[k]]) { - legend( - x = ifelse(legend.pos == "outside", xpos, legend.pos), - y = ifelse(legend.pos == "outside", ypos, NULL), - legend = legend.text, - lwd = plot.settings$lwd[[k]], - lty = plot.settings$lty[[k]], - col = if (is.null(legend.col)) { - col[1:length(object.list)] - } else{ - legend.col - }, - bty = "n", - cex = 0.8 * plot.settings$cex[[k]] - ) - - # revert the over plotting - if (legend.pos == "outside") - par(xpd = FALSE) - } - } - - ##reset graphic settings - if (exists("par.default.outside")) { - par(par.default.outside) - rm(par.default.outside) - } - par(par.default) - rm(par.default) - } -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_RLum.Data.Curve.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_RLum.Data.Curve.R deleted file mode 100644 index 8e7cc0ad7..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_RLum.Data.Curve.R +++ /dev/null @@ -1,230 +0,0 @@ -#' @title Plot function for an RLum.Data.Curve S4 class object -#' -#' @description The function provides a standardised plot output for curve data of an -#' `RLum.Data.Curve` S4-class object. -#' -#' @details Only single curve data can be plotted with this function. Arguments -#' according to [plot]. -#' -#' **Curve normalisation** -#' -#' The argument `norm` normalises all count values. To date the following -#' options are supported: -#' -#' `norm = TRUE` or `norm = "max"`: Curve values are normalised to the highest -#' count value in the curve -#' -#' `norm = "last"`: Curves values are normalised to the last count value -#' (this can be useful in particular for radiofluorescence curves) -#' -#' `norm = "huot"`: Curve values are normalised as suggested by Sébastien Huot -#' via GitHub: -#' \deqn{ -#' y = (observed - median(background)) / (max(observed) - median(background)) -#' } -#' -#' The background of the curve is defined as the last 20% of the count values -#' of a curve. -#' -#' @param object [RLum.Data.Curve-class] (**required**): -#' S4 object of class `RLum.Data.Curve` -#' -#' @param par.local [logical] (*with default*): -#' use local graphical parameters for plotting, e.g. the plot is shown in one -#' column and one row. If `par.local = FALSE`, global parameters are inherited. -#' -#' @param norm [logical] [character] (*with default*): allows curve normalisation to the -#' highest count value ('default'). Alternatively, the function offers the -#' modes `"max"`, `"min"` and `"huot"` for a background corrected normalisation, see details. -#' -#' @param smooth [logical] (*with default*): -#' provides an automatic curve smoothing based on [zoo::rollmean] -#' -#' @param ... further arguments and graphical parameters that will be passed -#' to the `plot` function -#' -#' @return Returns a plot. -#' -#' @note Not all arguments of [plot] will be passed! -#' -#' @section Function version: 0.2.6 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [plot], [plot_RLum] -#' -#' @keywords aplot -#' -#' @examples -#' -#' ##plot curve data -#' -#' #load Example data -#' data(ExampleData.CW_OSL_Curve, envir = environment()) -#' -#' #transform data.frame to RLum.Data.Curve object -#' temp <- as(ExampleData.CW_OSL_Curve, "RLum.Data.Curve") -#' -#' #plot RLum.Data.Curve object -#' plot_RLum.Data.Curve(temp) -#' -#' -#' @md -#' @export -plot_RLum.Data.Curve<- function( - object, - par.local = TRUE, - norm = FALSE, - smooth = FALSE, - ... -){ - -# Integrity check ------------------------------------------------------------- - - ##check if object is of class RLum.Data.Curve - if(!inherits(object, "RLum.Data.Curve")) - stop("[plot_RLum.Data.Curve()] Input object is not of type RLum.Data.Curve", call. = FALSE) - - ## check for NA values - if(all(is.na(object@data))){ - warning("[plot_RLum.Data.Curve()] Curve contains only NA-values, nothing plotted.", call. = FALSE) - return(NULL) - - } - - -# Preset plot ------------------------------------------------------------- - ## preset - lab.unit <- "Unknown" - lab.xlab <- "Independent" - xlab.xsyg <- ylab.xsyg <- NA - - ##set labelling unit - if(!is.na(object@recordType)){ - if(object@recordType[1] %in% c("OSL", "IRSL", "RL", "RF", "LM-OSL", "RBR")){ - lab.unit <- "s" - lab.xlab <- "Stimulation time" - - } else if(object@recordType[1] == "TL") { - lab.unit <- "\u00B0C" - lab.xlab <- "Temperature" - - } - } - - ##XSYG - ##check for curveDescripter - if ("curveDescripter" %in% names(object@info)) { - temp.lab <- - strsplit(object@info$curveDescripter, - split = ";", - fixed = TRUE)[[1]] - - xlab.xsyg <- temp.lab[1] - ylab.xsyg <- temp.lab[2] - - } - - ##normalise curves if argument has been set - if(norm[1] %in% c('max', 'last', 'huot') || norm[1] == TRUE){ - if (norm[1] == "max" || norm[1] == TRUE) { - object@data[,2] <- object@data[,2] / max(object@data[,2]) - - } else if (norm[1] == "last") { - object@data[,2] <- object@data[,2] / object@data[nrow(object@data),2] - - } else if (norm[1] == "huot") { - bg <- median(object@data[floor(nrow(object@data)*0.8):nrow(object@data),2]) - object@data[,2] <- (object@data[,2] - bg) / max(object@data[,2] - bg) - - } - - ##check for Inf and NA - if(any(is.infinite(object@data[,2])) || anyNA(object@data[,2])){ - object@data[,2][is.infinite(object@data[,2]) | is.na(object@data[,2])] <- 0 - warning("[plot_RLum.Data.Curve()] Normalisation led to Inf or NaN values. Values replaced by 0.", call. = FALSE) - - } - - } - - - ylab <- if (!is.na(ylab.xsyg)) { - ylab.xsyg - } else if (lab.xlab == "Independent") { - "Dependent [unknown]" - - } else { - paste( - object@recordType, - " [cts/", round(max(object@data[,1]) / length(object@data[,1]),digits = - 2) - , " ", lab.unit,"]", sep = "" - ) - } - - sub <- if ((grepl("TL", object@recordType) == TRUE) & - "RATE" %in% names(object@info)) { - paste("(",object@info$RATE," K/s)", sep = "") - } else if ((grepl("OSL", object@recordType) | - grepl("IRSL", object@recordType)) & - "interval" %in% names(object@info)) { - paste("(resolution: ",object@info$interval," s)", sep = "") - } - - - ##deal with additional arguments - plot_settings <- modifyList(x = list( - main = object@recordType[1], - xlab = if (!is.na(xlab.xsyg)) xlab.xsyg else paste0(lab.xlab, " [", lab.unit, "]"), - ylab = ylab, - sub = sub, - cex = 1, - type = "l", - las = NULL, - lwd = 1, - lty = 1, - pch = 1, - col = 1, - axes = TRUE, - xlim = range(object@data[,1], na.rm = TRUE), - ylim = range(object@data[,2], na.rm = TRUE), - log = "", - mtext = "" - - ), val = list(...), keep.null = TRUE) - - - ##par setting for possible combination with plot method for RLum.Analysis objects - if (par.local) - par(mfrow = c(1,1), cex = plot_settings$cex) - - ##smooth - if(smooth){ - k <- ceiling(length(object@data[, 2])/100) - object@data[, 2] <- zoo::rollmean(object@data[, 2], - k = k, fill = NA) - } - - ##plot curve - plot( - object@data[,1], object@data[,2], - main = plot_settings$main, - xlim = plot_settings$xlim, - ylim = plot_settings$ylim, - xlab = plot_settings$xlab, - ylab = plot_settings$ylab, - sub = plot_settings$sub, - type = plot_settings$type, - log = plot_settings$log, - col = plot_settings$col, - lwd = plot_settings$lwd, - pch = plot_settings$pch, - lty = plot_settings$lty, - axes = plot_settings$axes, - las = plot_settings$las) - - ##plot additional mtext - mtext(plot_settings$mtext, side = 3, cex = plot_settings$cex * 0.8) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_RLum.Data.Image.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_RLum.Data.Image.R deleted file mode 100644 index d802cfaac..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_RLum.Data.Image.R +++ /dev/null @@ -1,255 +0,0 @@ -#' @title Plot function for an `RLum.Data.Image` S4 class object -#' -#' @description The function provides very basic plot functionality for image data of an -#' [RLum.Data.Image-class] object. For more sophisticated plotting it is recommended -#' to use other very powerful packages for image processing. -#' -#' -#' **Details on the plot functions** -#' -#' Supported plot types: -#' -#' **`plot.type = "plot.raster"`** -#' -#' Uses the standard plot function of R [graphics::image]. If wanted, the image -#' is enhanced, using the argument `stretch`. Possible values are `hist`, `lin`, and -#' `NULL`. The latter does nothing. The argument `useRaster = TRUE` is used by default, but -#' can be set to `FALSE`. -#' -#' **`plot.type = "contour"`** -#' -#' This uses the function [graphics::contour] -#' -#' @param object [RLum.Data.Image-class] (**required**): S4 -#' object of class `RLum.Data.Image` -#' -#' @param par.local [logical] (*with default*): use local graphical -#' parameters for plotting, e.g. the plot is shown in one column and one row. -#' If `par.local = FALSE` global parameters are inherited. -#' -#' @param frames [numeric] (*optional*): sets the frames to be set, by default all -#' frames are plotted. Can be sequence of numbers, as long as the frame number is valid. -#' -#' @param plot.type [character] (*with default*): plot types. -#' Supported types are `plot.raster`, `contour` -#' -#' @param ... further arguments and graphical parameters that will be passed -#' to the specific plot functions. Standard supported parameters are `xlim`, `ylim`, `zlim`, -#' `xlab`, `ylab`, `main`, `legend` (`TRUE` or `FALSE`), `col`, `cex`, `axes` (`TRUE` or `FALSE`), -#' `zlim_image` (adjust the z-scale over different images), `stretch` -#' -#' @return Returns a plot -#' -#' @note The axes limitations (`xlim`, `zlim`, `zlim`) work directly on the object, -#' so that regardless of the chosen limits the image parameters can be adjusted for -#' best visibility. However, in particular for z-scale limitations this is not always -#' wanted, please use `zlim_image` to maintain a particular value range over a -#' series of images. -#' -#' @section Function version: 0.2.1 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum.Data.Image-class], [plot], [plot_RLum], [graphics::image], [graphics::contour] -#' -#' @keywords aplot -#' -#' @examples -#' -#' ##load data -#' data(ExampleData.RLum.Data.Image, envir = environment()) -#' -#' ##plot data -#' plot_RLum.Data.Image(ExampleData.RLum.Data.Image) -#' -#' @md -#' @export -plot_RLum.Data.Image <- function( - object, - frames = NULL, - par.local = TRUE, - plot.type = "plot.raster", - ... -){ - -# Integrity check ----------------------------------------------------------- - ##check if object is of class RLum.Data.Image - if(!inherits(object, "RLum.Data.Image")) - stop("[plot_RLum.Data.Image()] Input object is not of type RLum.Data.Image.", call. = FALSE) - - ## extract object - object <- object@data - -# Define additional functions --------------------------------------------- -.stretch <- function(x, type = "lin"){ - if(is.null(type[1])) return(x[,,1]) - - if(type[1] == "lin") { - x <- x[,,1] - r <- range(x) - q <- stats::quantile(x, c(0.05, 0.95), na.rm = TRUE) - - ## consider special case for q == 0 - if(sum(q) > 0) { - x <- (r[2] * (x - q[1])) / (q[2] - q[1]) - x[x < 0] <- r[1] - x[x > r[2]] <- r[2] - } - - } - - if(type[1] == "hist") - x <- matrix(stats::ecdf(x)(x) * 255, ncol = ncol(x)) - - return(x) -} - -# Plot settings ----------------------------------------------------------- -plot_settings <- modifyList(x = list( - main = "RLum.Data.Image", - axes = TRUE, - xlab = "Length [px]", - ylab = "Height [px]", - xlim = c(1,dim(object)[1]), - ylim = c(1,dim(object)[2]), - zlim = range(object), - zlim_image = NULL, - legend = TRUE, - useRaster = TRUE, - stretch = "hist", - col = c(grDevices::hcl.colors(50, palette = "Inferno")), - cex = 1 - ), val = list(...), keep.null = TRUE) - - ## set frames - if(!is.null(frames)) { - frames[1] <- max(1,min(frames)) - frames[length(frames)] <- min(dim(object)[3],max(frames)) - object <- object[,,frames,drop = FALSE] - - } - - ## enforce xlim, ylim and zlim directly here - ## xlim, ylim - object[] <- object[ - max(plot_settings$xlim[1], 1):min(plot_settings$xlim[2], dim(object)[1]), - max(plot_settings$ylim[1], 1):min(plot_settings$ylim[2], dim(object)[2]),, - drop = FALSE] - - ## zlim - object[object <= plot_settings$zlim[1]] <- max(0,plot_settings$zlim[1]) - object[object >= plot_settings$zlim[2]] <- min(max(object),plot_settings$zlim[2]) - - ##par setting for possible combination with plot method for RLum.Analysis objects - if(par.local) par(mfrow=c(1,1), cex = plot_settings$cex) - - if (plot.type == "plot.raster") { -# plot.raster ------------------------------------------------------------- - for(i in 1:dim(object)[3]) { - par.default <- par(mar = c(4.5,4.5,4,3)) - on.exit(par(par.default)) - x <- object[, , i, drop = FALSE] - image <-.stretch(x, type = plot_settings$stretch) - - graphics::image( - x = image, - useRaster = plot_settings$useRaster, - axes = FALSE, - zlim = if(is.null(plot_settings$zlim_image)) range(image) else plot_settings$zlim_image, - xlab = plot_settings$xlab, - ylab = plot_settings$ylab, - main = paste0(plot_settings$main, " #",i), - col = plot_settings$col) - graphics::box() - - ## axes - if(plot_settings$axes) { - xlab <- pretty(1:dim(x)[1]) - xlab[c(1,length(xlab))] <- c(0,dim(x)[1]) - xat <- seq(0,1,length.out = length(xlab)) - graphics::axis(side = 1, at = xat, labels = xlab) - - ylab <- pretty(1:dim(x)[2]) - ylab[c(1,length(ylab))] <- c(0,dim(x)[2]) - yat <- seq(0,1,length.out = length(ylab)) - graphics::axis(side = 2, at = yat, labels = ylab) - - } - - ## add legend - if(plot_settings$legend) { - par.default <- c(par.default, par(xpd = TRUE)) - on.exit(par(par.default)) - col_grad <- plot_settings$col[seq(1, length(plot_settings$col), length.out = 14)] - slices <- seq(0,1,length.out = 15) - for(s in 1:(length(slices) - 1)){ - graphics::rect( - xleft = par()$usr[4] * 1.01, - xright = par()$usr[4] * 1.03, - ybottom = slices[s], - ytop = slices[s + 1], - col = col_grad[s], - border = TRUE) - } - - text( - x = par()$usr[4] * 1.04, - y = par()$usr[2], - labels = if(is.null(plot_settings$zlim_image)) { - format(max(x), digits = 1, scientific = TRUE) - } else { - format(plot_settings$zlim_image[2], digits = 1, scientific = TRUE) - }, - cex = 0.7, - srt = 270, - pos = 3) - text( - x = par()$usr[4] * 1.04, - y = par()$usr[3], - labels = if(is.null(plot_settings$zlim_image)) { - format(min(x), digits = 1, scientific = TRUE) - } else { - format(plot_settings$zlim_image[1], digits = 1, scientific = TRUE) - }, - cex = 0.7, - pos = 3, - srt = 270) - } - } - - }else if(plot.type == "contour"){ - for(i in 1:dim(object)[3]) { - x <- object[, , i, drop = FALSE] - graphics::contour( - x = x[,,1], - axes = FALSE, - zlim = if(is.null(plot_settings$zlim_image)) range(x) else plot_settings$zlim_image, - xlab = plot_settings$xlab, - ylab = plot_settings$ylab, - main = paste0(plot_settings$main, " #",i), - col = plot_settings$col) - graphics::box() - - } - - ## axes - if(plot_settings$axes) { - xlab <- pretty(1:dim(x)[1]) - xlab[c(1,length(xlab))] <- c(0,dim(x)[1]) - xat <- seq(0,1,length.out = length(xlab)) - graphics::axis(side = 1, at = xat, labels = xlab) - - ylab <- pretty(1:dim(x)[2]) - ylab[c(1,length(ylab))] <- c(0,dim(x)[1]) - yat <- seq(0,1,length.out = length(ylab)) - graphics::axis(side = 2, at = yat, labels = ylab) - - } - - }else{ - stop("[plot_RLum.Data.Image()] Unknown plot type.", call. = FALSE) - - } - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_RLum.Data.Spectrum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_RLum.Data.Spectrum.R deleted file mode 100644 index 297eabf26..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_RLum.Data.Spectrum.R +++ /dev/null @@ -1,1134 +0,0 @@ -#' @title Plot function for an RLum.Data.Spectrum S4 class object -#' -#' @description The function provides a standardised plot output for spectrum data of an -#' [RLum.Data.Spectrum-class] class object. The purpose of this function is to provide -#' easy and straight-forward spectra plotting, not provide a full customised access to -#' all plot parameters. If this is wanted, standard R plot functionality should be used -#' instead. -#' -#' **Matrix structure** \cr (cf. [RLum.Data.Spectrum-class]) -#' -#' - `rows` (x-values): wavelengths/channels (`xlim`, `xlab`) -#' - `columns` (y-values): time/temperature (`ylim`, `ylab`) -#' - `cells` (z-values): count values (`zlim`, `zlab`) -#' -#' *Note: This nomenclature is valid for all plot types of this function!* -#' -#' **Nomenclature for value limiting** -#' -#' - `xlim`: Limits values along the wavelength axis -#' - `ylim`: Limits values along the time/temperature axis -#' - `zlim`: Limits values along the count value axis -#' -#' **Details on the plot functions** -#' -#' Spectrum is visualised as 3D or 2D plot. Both plot types are based on -#' internal R plot functions. -#' -#'**`plot.type = "persp"`** -#' -#' Arguments that will be passed to [graphics::persp]: -#' -#' - `shade`: default is `0.4` -#' - `phi`: default is `15` -#' - `theta`: default is `-30` -#' - `expand`: default is `1` -#' - `axes`: default is `TRUE` -#' - `box`: default is `TRUE`; accepts `"alternate"` for a custom plot design -#' - `ticktype`: default is `detailed`, `r`: default is `10` -#' -#' **Note:** Further parameters can be adjusted via `par`. For example -#' to set the background transparent and reduce the thickness of the lines use: -#' `par(bg = NA, lwd = 0.7)` previous the function call. -#' -#'**`plot.type = "single"`** -#' -#' Per frame a single curve is returned. Frames are time or temperature -#' steps. -#' -#' -`frames`: pick the frames to be plotted (depends on the binning!). Check without -#' this setting before plotting. -#' -#'**`plot.type = "multiple.lines"`** -#' -#' All frames plotted in one frame. -#' -#'-`frames`: pick the frames to be plotted (depends on the binning!). Check without -#' this setting before plotting. -#' -#' '**`plot.type = "image"` or `plot.type = "contour" ** -#' -#' These plot types use the R functions [graphics::image] or [graphics::contour]. -#' The advantage is that many plots can be arranged conveniently using standard -#' R plot functionality. If `plot.type = "image"` a contour is added by default, -#' which can be disabled using the argument `contour = FALSE` to add own contour -#' lines of choice. -#' -#'**`plot.type = "transect"`** -#' -#' Depending on the selected wavelength/channel range a transect over the -#' time/temperature (y-axis) will be plotted along the wavelength/channels -#' (x-axis). If the range contains more than one channel, values (z-values) are -#' summed up. To select a transect use the `xlim` argument, e.g. -#' `xlim = c(300,310)` plot along the summed up count values of channel -#' 300 to 310. -#' -#' **Further arguments that will be passed (depending on the plot type)** -#' -#' `xlab`, `ylab`, `zlab`, `xlim`, `ylim`, `box`, -#' `zlim`, `main`, `mtext`, `pch`, `type` (`"single"`, `"multiple.lines"`, `"interactive"`), -#' `col`, `border`, `lwd`, `bty`, `showscale` (`"interactive"`, `"image"`) -#' `contour`, `contour.col` (`"image"`) -#' -#' @param object [RLum.Data.Spectrum-class] or [matrix] (**required**): -#' S4 object of class `RLum.Data.Spectrum` or a `matrix` containing count -#' values of the spectrum.\cr -#' Please note that in case of a matrix row names and col names are set -#' automatically if not provided. -#' -#' @param par.local [logical] (*with default*): -#' use local graphical parameters for plotting, e.g. the plot is shown in one column and one row. -#' If `par.local = FALSE` global parameters are inherited. -#' -#' @param plot.type [character] (*with default*): plot type, for -#' 3D-plot use `persp`, or `interactive`, for a 2D-plot `image`, `contour`, -#' `single` or `multiple.lines` (along the time or temperature axis) -#' or `transect` (along the wavelength axis) \cr -#' -#' @param optical.wavelength.colours [logical] (*with default*): -#' use optical wavelength colour palette. Note: For this, the spectrum range is -#' limited: `c(350,750)`. Own colours can be set with the argument `col`. If you provide already -#' binned spectra, the colour assignment is likely to be wrong, since the colour gradients are calculated -#' using the bin number. -#' -#' @param bg.spectrum [RLum.Data.Spectrum-class] or [matrix] (*optional*): Spectrum -#' used for the background subtraction. By definition, the background spectrum should have been -#' measured with the same setting as the signal spectrum. If a spectrum is provided, the -#' argument `bg.channels` works only on the provided background spectrum. -#' -#' @param bg.channels [vector] (*optional*): -#' defines channel for background subtraction If a vector is provided the mean -#' of the channels is used for subtraction. If a spectrum is provided via `bg.spectrum`, this -#' argument only works on the `bg.spectrum`. -#' -#' **Note:** Background subtraction is applied prior to channel binning -#' -#' @param bin.rows [integer] (*with default*): -#' allow summing-up wavelength channels (horizontal binning), -#' e.g. `bin.rows = 2` two channels are summed up. -#' Binning is applied after the background subtraction. -#' -#' @param bin.cols [integer] (*with default*): -#' allow summing-up channel counts (vertical binning) for plotting, -#' e.g. `bin.cols = 2` two channels are summed up. -#' Binning is applied after the background subtraction. -#' -#' @param norm [character] (*optional*): Normalise data to the maximum (`norm = "max"`) or -#' minimum (`norm = "min"`) count values. The normalisation is applied after the binning. -#' -#' @param rug [logical] (*with default*): -#' enables or disables colour rug. Currently only implemented for plot -#' type `multiple.lines` and `single` -#' -#' @param limit_counts [numeric] (*optional*): -#' value to limit all count values to this value, i.e. all count values above -#' this threshold will be replaced by this threshold. This is helpful -#' especially in case of TL-spectra. -#' -#' @param xaxis.energy [logical] (*with default*): enables or disables energy instead of -#' wavelength axis. For the conversion the function [convert_Wavelength2Energy] is used. -#' -#' **Note:** This option means not only simply redrawing the axis, -#' instead the spectrum in terms of intensity is recalculated, s. details. -#' -#' @param legend.text [character] (*with default*): -#' possibility to provide own legend text. This argument is only considered for -#' plot types providing a legend, e.g. `plot.type="transect"` -#' -#' @param plot [logical] (*with default*): enables/disables plot output. If the plot -#' output is disabled, the [matrix] used for the plotting and the calculated colour values -#' (as attributes) are returned. This way, the (binned, transformed etc.) output can -#' be used in other functions and packages, such as plotting with the package `'plot3D'` -#' -#' @param ... further arguments and graphical parameters that will be passed -#' to the `plot` function. -#' -#' @return Returns a plot and the transformed `matrix` used for plotting with some useful -#' attributes such as the `colour` and `pmat` (the transpose matrix from [graphics::persp]) -#' -#' @note Not all additional arguments (`...`) will be passed similarly! -#' -#' @section Function version: 0.6.8 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum.Data.Spectrum-class], [convert_Wavelength2Energy], [plot], [plot_RLum], [graphics::persp], [plotly::plot_ly], [graphics::contour], [graphics::image] -#' -#' @keywords aplot -#' -#' @examples -#' -#' ##load example data -#' data(ExampleData.XSYG, envir = environment()) -#' -#' ##(1)plot simple spectrum (2D) - image -#' plot_RLum.Data.Spectrum( -#' TL.Spectrum, -#' plot.type="image", -#' xlim = c(310,750), -#' ylim = c(0,300), -#' bin.rows=10, -#' bin.cols = 1) -#' -#' ##(2) plot spectrum (3D) -#' plot_RLum.Data.Spectrum( -#' TL.Spectrum, -#' plot.type="persp", -#' xlim = c(310,750), -#' ylim = c(0,100), -#' bin.rows=10, -#' bin.cols = 1) -#' -#'##(3) plot spectrum on energy axis -#'##please note the background subtraction -#'plot_RLum.Data.Spectrum(TL.Spectrum, -#' plot.type="persp", -#' ylim = c(0,200), -#' bin.rows=10, -#' bg.channels = 10, -#' bin.cols = 1, -#' xaxis.energy = TRUE) -#' -#' ##(4) plot multiple lines (2D) - multiple.lines (with ylim) -#' plot_RLum.Data.Spectrum( -#' TL.Spectrum, -#' plot.type="multiple.lines", -#' xlim = c(310,750), -#' ylim = c(0,100), -#' bin.rows=10, -#' bin.cols = 1) -#' -#' \dontrun{ -#' ##(4) interactive plot using the package plotly ("surface") -#' plot_RLum.Data.Spectrum(TL.Spectrum, plot.type="interactive", -#' xlim = c(310,750), ylim = c(0,300), bin.rows=10, -#' bin.cols = 1) -#' -#' ##(5) interactive plot using the package plotly ("contour") -#' plot_RLum.Data.Spectrum(TL.Spectrum, plot.type="interactive", -#' xlim = c(310,750), ylim = c(0,300), bin.rows=10, -#' bin.cols = 1, -#' type = "contour", -#' showscale = TRUE) -#' -#' ##(6) interactive plot using the package plotly ("heatmap") -#' plot_RLum.Data.Spectrum(TL.Spectrum, plot.type="interactive", -#' xlim = c(310,750), ylim = c(0,300), bin.rows=10, -#' bin.cols = 1, -#' type = "heatmap", -#' showscale = TRUE) -#' -#' } -#' -#' @md -#' @export -plot_RLum.Data.Spectrum <- function( - object, - par.local = TRUE, - plot.type = "contour", - optical.wavelength.colours = TRUE, - bg.spectrum = NULL, - bg.channels = NULL, - bin.rows = 1, - bin.cols = 1, - norm = NULL, - rug = TRUE, - limit_counts = NULL, - xaxis.energy = FALSE, - legend.text, - plot = TRUE, - ... -){ - - # Integrity check ----------------------------------------------------------- - - ##check if object is of class RLum.Data.Spectrum - if(!inherits(object, "RLum.Data.Spectrum")){ - if(inherits(object, "matrix")){ - if(is.null(colnames(object))){ - colnames(object) <- 1:ncol(object) - - } - if(is.null(rownames(object))){ - rownames(object) <- 1:nrow(object) - } - - object <- set_RLum(class = "RLum.Data.Spectrum", - data = object) - - message("[plot_RLum.Data.Spectrum()] Input has been converted to a RLum.Data.Spectrum object using set_RLum()") - - }else{ - .throw_error("'object' must be of type 'RLum.Data.Spectrum' or 'matrix'") - } - } - - ##XSYG - ##check for curveDescripter - if("curveDescripter" %in% names(object@info) == TRUE){ - - temp.lab <- strsplit(object@info$curveDescripter, split = ";")[[1]] - xlab <- if(xaxis.energy == FALSE){ - temp.lab[2]}else{"Energy [eV]"} - ylab <- temp.lab[1] - zlab <- temp.lab[3] - - }else{ - - xlab <- if(xaxis.energy == FALSE){ - "Row values [a.u.]"}else{"Energy [eV]"} - ylab <- "Column values [a.u.]" - zlab <- "Cell values [a.u.]" - } - - # Do energy axis conversion ------------------------------------------------------------------- - if (xaxis.energy){ - ##conversion - object <- convert_Wavelength2Energy(object, digits = 5) - - ##modify row order (otherwise subsequent functions, like persp, have a problem) - object@data[] <- object@data[order(as.numeric(rownames(object@data))),] - rownames(object@data) <- sort(as.numeric(rownames(object@data))) - } - - ## check for duplicated column names (e.g., temperature not increasing) - if(any(duplicated(colnames(object@data)))) { - .throw_warning("Duplicated column names found, replaced by index") - colnames(object@data) <- 1:ncol(object@data[]) - } - - ##deal with addition arguments - extraArgs <- list(...) - - main <- if("main" %in% names(extraArgs)) {extraArgs$main} else - {"RLum.Data.Spectrum"} - - zlab <- if("zlab" %in% names(extraArgs)) {extraArgs$zlab} else - {ifelse(plot.type == "multiple.lines", ylab, zlab)} - - xlab <- if("xlab" %in% names(extraArgs)) {extraArgs$xlab} else - {xlab} - - ylab <- if("ylab" %in% names(extraArgs)) {extraArgs$ylab} else - {ifelse(plot.type == "single" | plot.type == "multiple.lines", - "Luminescence [cts/channel]", ylab)} - - xlim <- if("xlim" %in% names(extraArgs)) {extraArgs$xlim} else - {c(min(as.numeric(rownames(object@data))), - max(as.numeric(rownames(object@data))))} - - ylim <- if("ylim" %in% names(extraArgs)) {extraArgs$ylim} else - {c(min(as.numeric(colnames(object@data))), - max(as.numeric(colnames(object@data))))} - - #for zlim see below - - mtext <- if("mtext" %in% names(extraArgs)) {extraArgs$mtext} else - {""} - - cex <- if("cex" %in% names(extraArgs)) {extraArgs$cex} else - {1} - - phi <- if("phi" %in% names(extraArgs)) {extraArgs$phi} else - {15} - - theta <- if("theta" %in% names(extraArgs)) {extraArgs$theta} else - {-30} - - r <- if("r" %in% names(extraArgs)) {extraArgs$r} else - {10} - - shade <- if("shade" %in% names(extraArgs)) {extraArgs$shade} else - {0.4} - - expand <- if("expand" %in% names(extraArgs)) {extraArgs$expand} else - {0.6} - - border <- if("border" %in% names(extraArgs)) {extraArgs$border} else - {NULL} - - box <- if("box" %in% names(extraArgs)) {extraArgs$box} else - {TRUE} - - axes <- if("axes" %in% names(extraArgs)) {extraArgs$axes} else - {TRUE} - - ticktype <- if("ticktype" %in% names(extraArgs)) {extraArgs$ticktype} else - {"detailed"} - - log<- if("log" %in% names(extraArgs)) {extraArgs$log} else - {""} - - type<- if("type" %in% names(extraArgs)) {extraArgs$type} else - { - if (plot.type == "interactive") { - "surface" - - } else{ - "l" - } - } - - pch<- if("pch" %in% names(extraArgs)) {extraArgs$pch} else - {1} - - lwd<- if("lwd" %in% names(extraArgs)) {extraArgs$lwd} else - {1} - - bty <- if("bty" %in% names(extraArgs)) {extraArgs$bty} else - {NULL} - - sub<- if("sub" %in% names(extraArgs)) {extraArgs$sub} else - {""} - - #for plotly::plot_ly - showscale<- if("showscale" %in% names(extraArgs)) {extraArgs$showscale} else - {FALSE} - - - # prepare values for plot --------------------------------------------------- - ##copy data - temp.xyz <- object@data - - ##check for NULL column names - if(is.null(colnames(temp.xyz))) - colnames(temp.xyz) <- 1:ncol(temp.xyz) - - if(is.null(rownames(temp.xyz))) - rownames(temp.xyz) <- 1:nrow(temp.xyz) - - ##check for the case of a single column matrix - if(ncol(temp.xyz)>1){ - ##reduce for xlim - temp.xyz <- temp.xyz[as.numeric(rownames(temp.xyz)) >= xlim[1] & - as.numeric(rownames(temp.xyz)) <= xlim[2],] - - ##reduce for ylim - temp.xyz <- temp.xyz[, as.numeric(colnames(temp.xyz)) >= ylim[1] & - as.numeric(colnames(temp.xyz)) <= ylim[2]] - } - - ## wavelength - x <- as.numeric(rownames(temp.xyz)) - - ## time/temp - y <- as.numeric(colnames(temp.xyz)) - - # Background spectrum ------------------------------------------------------------------------- - if(!is.null(bg.spectrum)){ - if(inherits(bg.spectrum, "RLum.Data.Spectrum") || inherits(bg.spectrum, "matrix")){ - ##case RLum - if(inherits(bg.spectrum, "RLum.Data.Spectrum")) bg.xyz <- bg.spectrum@data - - ##case matrix - if(inherits(bg.spectrum, "matrix")) bg.xyz <- bg.spectrum - - ##take care of channel settings, otherwise set bg.channels - if(is.null(bg.channels)) - bg.channels <- c(1:ncol(bg.xyz)) - - ##set rownames - if(is.null(rownames(bg.xyz))) - rownames(bg.xyz) <- 1:nrow(bg.xyz) - - ##convert to energy scale if needed - if(xaxis.energy){ - - #conversion - bg.xyz <- convert_Wavelength2Energy(cbind(as.numeric(rownames(bg.xyz)), bg.xyz), digits = 5) - rownames(bg.xyz) <- bg.xyz[,1] - bg.xyz <- bg.xyz[,-1, drop = FALSE] - - ##modify row order (otherwise subsequent functions, like persp, have a problem) - bg.xyz <- bg.xyz[order(as.numeric(rownames(bg.xyz))),,drop = FALSE] - rownames(bg.xyz) <- sort(as.numeric(rownames(bg.xyz))) - } - - ##reduce for xlim - bg.xyz <- bg.xyz[as.numeric(rownames(bg.xyz)) >= xlim[1] & - as.numeric(rownames(bg.xyz)) <= xlim[2],,drop = FALSE] - - }else{ - .throw_error("Input for 'bg.spectrum' not supported") - } - } - - # Background subtraction --------------------------------------------------- - if(!is.null(bg.channels)){ - ##set background object if not available - if(is.null(bg.spectrum)) bg.xyz <- temp.xyz - - if(max(bg.channels) > ncol(bg.xyz) || any(bg.channels <= 0)){ - ##correct the mess - bg.channels <- sort(unique(bg.channels)) - bg.channels[bg.channels <= 0] <- 1 - bg.channels[bg.channels >= ncol(bg.xyz)] <- ncol(bg.xyz) - - .throw_warning("'bg.channels' out of range, corrected to: ", - min(bg.channels), ":", max(bg.channels)) - } - - if(length(bg.channels) > 1){ - temp.bg.signal <- rowMeans(bg.xyz[,bg.channels]) - temp.xyz <- temp.xyz - temp.bg.signal - - }else{ - temp.xyz <- temp.xyz - bg.xyz[,bg.channels] - } - - ##set values < 0 to 0 - temp.xyz[temp.xyz < 0] <- 0 - - ##check worst case - if(sum(temp.xyz) == 0){ - message("[plot_RLum.Data.Spectrum()] After background subtraction all counts < 0. Nothing plotted, NULL returned!") - return(NULL) - } - } - - # Channel binning --------------------------------------------------------- - ##rewrite arguments; makes things easier - bin.cols <- bin.cols[1] - bin.rows <- bin.rows[1] - - ##fatal check (not needed anymore, but never change running code) - if(bin.cols < 1 | bin.rows < 1) - .throw_error("'bin.cols' and 'bin.rows' have to be > 1!") - - if(bin.rows > 1){ - temp.xyz <- .matrix_binning(temp.xyz, bin_size = bin.rows, bin_col = FALSE, names = "mean") - x <- as.numeric(rownames(temp.xyz)) - - ##remove last channel (this is the channel that included less data) - if(length(x)%%bin.rows != 0){ - .throw_warning(length(x) %% bin.rows, - " channels removed due to row (wavelength) binning") - - ##do it - temp.xyz <- temp.xyz[-length(x),] - x <- x[-length(x)] - } - } - - if(bin.cols > 1){ - temp.xyz <- .matrix_binning(temp.xyz, bin_size = bin.cols, bin_col = TRUE, names = "groups") - y <- as.numeric(colnames(temp.xyz)) - - ##remove last channel (this is the channel that included less data) - if(length(y)%%bin.cols != 0){ - .throw_warning(length(y) %% bin.cols, - " channels removed due to column (frame) binning") - - ##do it - temp.xyz <- temp.xyz[,-length(y)] - y <- y[-length(y)] - } - } - - ##limit z-values if requested, this idea was taken from the Diss. by Thomas Schilles, 2002 - if(!is.null(limit_counts[1])) - temp.xyz[temp.xyz[] > max(min(temp.xyz), limit_counts[1])] <- limit_counts[1] - - # Normalise if wanted ------------------------------------------------------------------------- - if(!is.null(norm)){ - if(norm == "min") - temp.xyz <- temp.xyz/min(temp.xyz) - - if(norm == "max") - temp.xyz <- temp.xyz/max(temp.xyz) - } - - ##check for zlim - zlim <- if("zlim" %in% names(extraArgs)) {extraArgs$zlim} else - {range(temp.xyz)} - - # set colour values -------------------------------------------------------- - if("col" %in% names(extraArgs) == FALSE | plot.type == "single" | plot.type == "multiple.lines"){ - if(optical.wavelength.colours == TRUE | (rug == TRUE & (plot.type != "persp" & plot.type != "interactive"))){ - - ##make different colour palette for energy values - if (xaxis.energy) { - col.violet <- c(2.76, ifelse(max(xlim) <= 4.13, max(xlim), 4.13)) - col.blue <- c(2.52, 2.76) - col.green <- c(2.18, 2.52) - col.yellow <- c(2.10, 2.18) - col.orange <- c(2.00, 2.10) - col.red <- c(1.57, 2.00) - col.infrared <- - c(1.55, ifelse(min(xlim) >= 1.55, min(xlim), 1.57)) - - #set colour palette - col <- unlist(sapply(1:length(x), function(i){ - - if(x[i] >= col.violet[1] & x[i] < col.violet[2]){"#EE82EE"} - else if(x[i] >= col.blue[1] & x[i] < col.blue[2]){"#0000FF"} - else if(x[i] >= col.green[1] & x[i] < col.green[2]){"#00FF00"} - else if(x[i] >= col.yellow[1] & x[i] < col.yellow[2]){"#FFFF00"} - else if(x[i] >= col.orange[1] & x[i] < col.orange[2]){"#FFA500"} - else if(x[i] >= col.red[1] & x[i] < col.red[2]){"#FF0000"} - else if(x[i] <= col.infrared[2]){"#BEBEBE"} - })) - - }else{ - ##wavelength colours for wavelength axis - col.violet <- c(ifelse(min(xlim) <= 300, min(xlim), 300),450) - col.blue <- c(450,495) - col.green <- c(495,570) - col.yellow <- c(570,590) - col.orange <- c(590,620) - col.red <- c(620,790) - col.infrared <- - c(790, ifelse(max(xlim) >= 800, max(xlim), 800)) - - #set colour palette - col <- unlist(sapply(1:length(x), function(i){ - - if(x[i] >= col.violet[1] & x[i] < col.violet[2]){"#EE82EE"} - else if(x[i] >= col.blue[1] & x[i] < col.blue[2]){"#0000FF"} - else if(x[i] >= col.green[1] & x[i] < col.green[2]){"#00FF00"} - else if(x[i] >= col.yellow[1] & x[i] < col.yellow[2]){"#FFFF00"} - else if(x[i] >= col.orange[1] & x[i] < col.orange[2]){"#FFA500"} - else if(x[i] >= col.red[1] & x[i] < col.red[2]){"#FF0000"} - else if(x[i] >= col.infrared[1]){"#BEBEBE"} - })) - } - - ##find unique colours - col.unique <- unique(col) - - ##if only one colour value, then skip gradient calculation as it causes - ##an error - if(length(col.unique) > 1){ - - ##set colour function for replacement - colfunc <- colorRampPalette(col.unique) - - ##get index for colour values to be cut from the current palette - col.unique.index <- - vapply(col.unique, function(i) { - max(which(col == i)) - - }, numeric(1)) - - ##remove last index (no colour gradient needed), for energy axis use the first value - col.unique.index <- col.unique.index[-length(col.unique.index)] - - ##set borders for colour gradient recalculation - col.unique.index.min <- col.unique.index - (50/bin.rows) - col.unique.index.max <- col.unique.index + (50/bin.rows) - - ##set negative values to the lowest index - col.unique.index.min[col.unique.index.min<=0] <- 1 - - ##build up new index sequence (might be better) - col.gradient.index <- as.vector(unlist(( - sapply(1:length(col.unique.index.min), function(j){ - - seq(col.unique.index.min[j],col.unique.index.max[j], by = 1) - - })))) - - - ##generate colour ramp and replace values - col.new <- colfunc(length(col.gradient.index)) - col[col.gradient.index] <- col.new - - ##correct for overcharged colour values (causes zebra colour pattern) - if (diff(c(length(col), nrow(temp.xyz))) < 0) { - col <- col[1:c(length(col) - diff(c(length(col), nrow(temp.xyz))))] - - }else if(diff(c(length(col), nrow(temp.xyz))) > 0){ - col <- col[1:c(length(col) + diff(c(length(col), nrow(temp.xyz))))] - } - } - - }else{ - col <- "black" - } - - }else{ - col <- extraArgs$col - } - - # Do log scaling if needed ------------------------------------------------- - ##x - if(grepl("x", log)==TRUE){x <- log10(x)} - - ##y - if(grepl("y", log)==TRUE){y <- log10(y)} - - ##z - if(grepl("z", log)==TRUE){temp.xyz <- log10(temp.xyz)} - -# PLOT -------------------------------------------------------------------- - -## set variables we need later -pmat <- NA - -if(plot){ - ##par setting for possible combination with plot method for RLum.Analysis objects - if(par.local) par(mfrow=c(1,1), cex = cex) - - ##rest plot type for 1 column matrix - if(ncol(temp.xyz) == 1 && plot.type != "single"){ - plot.type <- "single" - .throw_warning("Single column matrix: plot.type has been automatically ", - "reset to 'single'") - } - - ##do not let old code break down ... - if(plot.type == "persp3d"){ - plot.type <- "interactive" - .throw_warning("'plot.type' has been automatically reset to interactive") - } - - if(plot.type == "persp" && ncol(temp.xyz) > 1){ - - ## Plot: perspective plot ---- - ## ==========================================================================# - pmat <- persp( - x, y, temp.xyz, - shade = shade, - axes = if(box[1] == "alternate") FALSE else axes, - phi = phi, - theta = theta, - xlab = xlab, - ylab = ylab, - zlab = zlab, - zlim = zlim, - scale = TRUE, - col = col[1:(length(x)-1)], ##needed due to recycling of the colours - main = main, - expand = expand, - border = border, - box = if(box[1] == "alternate") FALSE else box, - r = r, - ticktype = ticktype) - - ## this is custom plot output that might come in handy from time to time - if(axes & box[1] == "alternate") { - ## add axes manually - x_axis <- seq(min(x), max(x), length.out = 20) - y_axis <- seq(min(y), max(y), length.out = 20) - z_axis <- seq(min(temp.xyz), max(temp.xyz), length.out = 20) - - lines(grDevices::trans3d(x_axis,min(y) - 5, min(temp.xyz),pmat)) - lines(grDevices::trans3d(min(x) - 5,y_axis, min(temp.xyz),pmat)) - lines(grDevices::trans3d(min(x) - 5,max(y), z_axis,pmat)) - - ## x-axis - px_axis <- pretty(x_axis) - px_axis <- px_axis[(px_axis) > min(x_axis) & px_axis < max(x_axis)] - - tick_start <- grDevices::trans3d(px_axis, min(y_axis), min(z_axis), pmat) - tick_end <- grDevices::trans3d( - px_axis, min(y_axis) - max(y_axis) * 0.05, min(z_axis), pmat) - - ## calculate slope angle for xlab and ticks - m <- (tick_start$y[2] - tick_start$y[1]) / (tick_start$x[2] - tick_start$x[1]) - m <- atan(m) * 360 / (2 * pi) - - segments(tick_start$x, tick_start$y, tick_end$x, tick_end$y) - text( - tick_end$x, - tick_end$y, - adj = c(0.5,1.2), - px_axis, - xpd = TRUE, - cex = 0.85, - srt = m) - - ## x-axis label - text( - mean(tick_end$x), - min(tick_end$y), - adj = c(0.5, 1), - xlab, - srt = m, - xpd = TRUE) - - ## y-axis - py_axis <- pretty(y_axis) - py_axis <- py_axis[(py_axis) > min(y_axis) & py_axis < max(y_axis)] - - tick_start <- grDevices::trans3d(min(x_axis), py_axis, min(z_axis), pmat) - tick_end <- grDevices::trans3d( - min(x_axis) - max(x_axis) * 0.025, py_axis, min(z_axis), pmat) - segments(tick_start$x, tick_start$y, tick_end$x, tick_end$y) - - ## calculate slope angle for xlab and ticks - m <- (tick_start$y[2] - tick_start$y[1]) / (tick_start$x[2] - tick_start$x[1]) - m <- atan(m) * 360 / (2 * pi) - - text( - tick_end$x, - tick_end$y, - py_axis, - adj = c(0.6,1.2), - srt = m, - cex = 0.85, - xpd = TRUE) - - ## y-axis label - text( - min(tick_end$x), - mean(tick_end$y), - adj = c(0.5, 1), - ylab, - srt = m, - xpd = TRUE) - - ## z-axis - pz_axis <- pretty(z_axis) - pz_axis <- pz_axis[(pz_axis) > min(z_axis) & pz_axis < max(z_axis)] - - tick_start <- grDevices::trans3d(min(x_axis), max(y_axis), pz_axis, pmat) - tick_end <- grDevices::trans3d( - min(x_axis) - max(x_axis) * 0.015, max(y_axis), pz_axis, pmat) - segments(tick_start$x, tick_start$y, tick_end$x, tick_end$y) - - ## calculate slope angle for xlab and ticks - m <- (tick_start$y[2] - tick_start$y[1]) / (tick_start$x[2] - tick_start$x[1]) - m <- atan(m) * 360 / (2 * pi) - - text( - tick_end$x, - tick_end$y, - format(pz_axis, scientific = TRUE, digits = 1), - adj = c(0.5,1.2), - srt = m, - xpd = TRUE, - cex = 0.85) - - ## z-axis label - text( - min(tick_end$x), - mean(tick_end$y), - adj = c(0.5, 2.5), - zlab, - srt = m, - xpd = TRUE) - - } - - ##plot additional mtext - mtext(mtext, side = 3, cex = cex * 0.8) - - }else if(plot.type == "interactive" && ncol(temp.xyz) > 1) { - ## ==========================================================================# - ##interactive plot and former persp3d - ## ==========================================================================# - - ## Plot: interactive ---- - ##http://r-pkgs.had.co.nz/description.html - if (!requireNamespace("plotly", quietly = TRUE)) { - # nocov start - .throw_error("Package 'plotly' needed for this plot type. Please install it.") - # nocov end - } - - ##set up plot - p <- plotly::plot_ly( - z = temp.xyz, - x = as.numeric(colnames(temp.xyz)), - y = as.numeric(rownames(temp.xyz)), - type = type, - showscale = showscale - #colors = col[1:(length(col)-1)], - ) - - - ##change graphical parameters - p <- plotly::layout( - p = p, - scene = list( - xaxis = list( - title = ylab - - ), - yaxis = list( - title = xlab - ), - zaxis = list(title = zlab) - - ), - title = main - ) - - print(p) - on.exit(return(p)) - - - }else if(plot.type == "contour" && ncol(temp.xyz) > 1) { - ## Plot: contour plot ---- - ## ==========================================================================# - contour(x,y,temp.xyz, - xlab = xlab, - ylab = ylab, - main = main, - labcex = 0.6 * cex, - col = "black" - ) - - ##plot additional mtext - mtext(mtext, side = 3, cex = cex*0.8) - - }else if(plot.type == "image" && ncol(temp.xyz) > 1) { - ## Plot: image plot ---- - ## ==========================================================================# - graphics::image(x,y,temp.xyz, - xlab = xlab, - ylab = ylab, - main = main, - col = if(is.null(list(...)$col)) grDevices::hcl.colors(50, palette = "Inferno") else - list(...)$col - ) - - if(is.null(list(...)$contour) || list(...)$contour != FALSE) { - contour(x, y, temp.xyz, - col = if(is.null(list(...)$contour.col)) rgb(1,1,1,0.8) else list(...)$contour.col, - labcex = 0.6 * cex, - add = TRUE) - } - - ##plot additional mtext - mtext(mtext, side = 3, cex = cex*0.8) - - } else if(plot.type == "single") { - ## Plot: single plot ---- - ## ==========================================================================# - - ## set colour rug - col.rug <- col - col <- if("col" %in% names(extraArgs)) {extraArgs$col} else {"black"} - box <- if("box" %in% names(extraArgs)) extraArgs$box[1] else TRUE - frames <- if("frames" %in% names(extraArgs)) extraArgs$frames else 1:length(y) - - for(i in frames) { - if("zlim" %in% names(extraArgs) == FALSE){zlim <- range(temp.xyz[,i])} - plot(x, temp.xyz[,i], - xlab = xlab, - ylab = ylab, - main = main, - xlim = xlim, - ylim = zlim, - frame = box, - xaxt = "n", - col = col, - sub = paste( - "(frame ",i, " | ", - ifelse(i==1, - paste("0.0 :", round(y[i], digits = 1)), - paste(round(y[i-1], digits = 1),":", - round(y[i], digits =1))),")", - sep = ""), - type = type, - pch = pch) - - ## add colour rug - if(rug){ - ##rug as continuous rectangle - i <- floor(seq(1,length(x), length.out = 300)) - graphics::rect( - xleft = x[i[-length(i)]], - xright = x[i[-1]], - ytop = par("usr")[3] + diff(c(par("usr")[3], min(zlim))) * 0.9, - ybottom = par("usr")[3], - col = col.rug[i], - border = NA, - lwd = 1) - - ## add rectangle from zero to first value - graphics::rect( - xleft = par()$usr[1], - xright = x[i[1]], - ytop = par("usr")[3] + diff(c(par("usr")[3], min(zlim))) * 0.9, - ybottom = par("usr")[3], - col = col.rug[1], - density = 50, - border = NA, - lwd = 1) - - ## add rectangle from the last value to end of plot - graphics::rect( - xleft = x[i[length(i)]], - xright = par()$usr[2], - ytop = par("usr")[3] + diff(c(par("usr")[3], min(zlim))) * 0.9, - ybottom = par("usr")[3], - col = col.rug[length(col.rug)], - density = 50, - border = NA, - lwd = 1) - } - - ## add y axis to prevent overplotting - graphics::axis(side = 1) - - ## add box if needed - if(box) graphics::box() - - } - - ##plot additional mtext - mtext(mtext, side = 3, cex = cex*0.8) - - }else if(plot.type == "multiple.lines" && ncol(temp.xyz) > 1) { - ## Plot: multiple.lines ---- - ## ========================================================================# - col.rug <- col - col<- if("col" %in% names(extraArgs)) {extraArgs$col} else {"black"} - box <- if("box" %in% names(extraArgs)) extraArgs$box else TRUE - frames <- if("frames" %in% names(extraArgs)) extraArgs$frames else 1:length(y) - - ##change graphic settings - par.default <- par()[c("mfrow", "mar", "xpd")] - par(mfrow = c(1,1), mar=c(5.1, 4.1, 4.1, 8.1), xpd = TRUE) - - ##grep zlim - if("zlim" %in% names(extraArgs) == FALSE){zlim <- range(temp.xyz)} - - ##open plot area - plot(NA, NA, - xlab = xlab, - ylab = ylab, - main = main, - xlim = xlim, - ylim = zlim, - frame = box, - xaxt = "n", - sub = sub, - bty = bty) - - ## add colour rug - if(rug){ - ##rug as continuous rectangle - i <- floor(seq(1,length(x), length.out = 300)) - graphics::rect( - xleft = x[i[-length(i)]], - xright = x[i[-1]], - ytop = par("usr")[3] + diff(c(par("usr")[3], min(zlim))) * 0.9, - ybottom = par("usr")[3], - col = col.rug[i], - border = NA, - lwd = NA) - - - ## add rectangle from zero to first value - graphics::rect( - xleft = par()$usr[1], - xright = x[i[1]], - ytop = par("usr")[3] + diff(c(par("usr")[3], min(zlim))) * 0.9, - ybottom = par("usr")[3], - col = col.rug[1], - density = 50, - border = NA, - lwd = 1) - - ## add rectangle from the last value to end of plot - graphics::rect( - xleft = x[i[length(i)]], - xright = par()$usr[2], - ytop = par("usr")[3] + diff(c(par("usr")[3], min(zlim))) * 0.9, - ybottom = par("usr")[3], - col = col.rug[length(col.rug)], - density = 50, - border = NA, - lwd = 1) - } - - ##add lines - for(i in frames){ - lines(x, - temp.xyz[,i], - lty = i, - lwd = lwd, - type = type, - col = col) - } - - ## add y axis to prevent overplotting - graphics::axis(side = 1) - - ## add box if needed - if(box) graphics::box() - - ##for missing values - legend.text - if(missing(legend.text)) - legend.text <- as.character(paste(round(y[frames],digits=1), zlab)) - - ##legend - legend(x = par()$usr[2], - y = par()$usr[4], - - legend = legend.text, - - lwd= lwd, - lty = frames, - bty = "n", - cex = 0.6*cex) - - ##plot additional mtext - mtext(mtext, side = 3, cex = cex*0.8) - - ##reset graphic settings - par(par.default) - rm(par.default) - - }else if(plot.type == "transect" && ncol(temp.xyz) > 1) { - ## Plot: transect plot ---- - ## ========================================================================# - - ##sum up rows (column sum) - temp.xyz <- colSums(temp.xyz) - - ##consider differences within the arguments - #check for zlim - zlim <- if("zlim" %in% names(extraArgs)) {extraArgs$zlim} else - {c(0,max(temp.xyz))} - - #check for zlim - zlab <- if("ylab" %in% names(extraArgs)) {extraArgs$ylab} else - {paste("Counts [1/summed channels]")} - - plot(y, temp.xyz, - xlab = ylab, - ylab = zlab, - main = main, - xlim = ylim, - ylim = zlim, - col = col, - sub = paste("(channel range: ", min(xlim), " : ", max(xlim), ")", sep=""), - type = type, - pch = pch) - - ##plot additional mtext - mtext(mtext, side = 3, cex = cex*0.8) - - }else{ - .throw_error("Unknown plot type") - } - -## option for plotting nothing -} - -# Return ------------------------------------------------------------------ - -## add some attributes -attr(temp.xyz, "colour") <- col -attr(temp.xyz, "pmat") <- pmat - -## return visible or not -if(plot) invisible(temp.xyz) else return(temp.xyz) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_RLum.R deleted file mode 100644 index 46afd5d94..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_RLum.R +++ /dev/null @@ -1,150 +0,0 @@ -#' General plot function for RLum S4 class objects -#' -#' Function calls object specific plot functions for RLum S4 class objects. -#' -#' The function provides a generalised access point for plotting specific -#' [RLum-class] objects.\cr -#' Depending on the input object, the -#' corresponding plot function will be selected. Allowed arguments can be -#' found in the documentations of each plot function. -#' -#' \tabular{lll}{ -#' **object** \tab \tab **corresponding plot function** \cr -#' [RLum.Data.Curve-class] \tab : \tab [plot_RLum.Data.Curve] \cr -#' [RLum.Data.Spectrum-class] \tab : \tab [plot_RLum.Data.Spectrum]\cr -#' [RLum.Data.Image-class] \tab : \tab [plot_RLum.Data.Image]\cr -#' [RLum.Analysis-class] \tab : \tab [plot_RLum.Analysis]\cr -#' [RLum.Results-class] \tab : \tab [plot_RLum.Results] -#' } -#' -#' @param object [RLum-class] (**required**): -#' S4 object of class `RLum`. Optional a [list] containing objects of -#' class [RLum-class] can be provided. In this case the function tries to plot -#' every object in this list according to its `RLum` class. Non-RLum objects are -#' removed. -#' -#' @param ... further arguments and graphical parameters that will be passed -#' to the specific plot functions. The only argument that is supported directly is `main` -#' (setting the plot title). In contrast to the normal behaviour `main` can be here provided as -#' [list] and the arguments in the list will dispatched to the plots if the `object` -#' is of type `list` as well. -#' -#' @return Returns a plot. -#' -#' @note The provided plot output depends on the input object. -#' -#' @section Function version: 0.4.4 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [plot_RLum.Data.Curve], [RLum.Data.Curve-class], [plot_RLum.Data.Spectrum], -#' [RLum.Data.Spectrum-class], [plot_RLum.Data.Image], [RLum.Data.Image-class], -#' [plot_RLum.Analysis], [RLum.Analysis-class], [plot_RLum.Results], -#' [RLum.Results-class] -#' -#' -#' @keywords dplot -#' -#' @examples -#' #load Example data -#' data(ExampleData.CW_OSL_Curve, envir = environment()) -#' -#' #transform data.frame to RLum.Data.Curve object -#' temp <- as(ExampleData.CW_OSL_Curve, "RLum.Data.Curve") -#' -#' #plot RLum object -#' plot_RLum(temp) -#' -#' @md -#' @export -plot_RLum<- function( - object, - ... -){ -# Define dispatcher function ---------------------------------------------------------- -##check if object is of class RLum - RLum.dispatcher <- function(object, ...) { - if (inherits(object, "RLum")) { - ##grep object class - object.class <- is(object)[1] - - ##select which plot function should be used and call it - switch ( - object.class, - RLum.Data.Curve = plot_RLum.Data.Curve(object = object, ...), - RLum.Data.Spectrum = plot_RLum.Data.Spectrum(object = object, ...), - RLum.Data.Image = plot_RLum.Data.Image(object = object, ...), - - ##here we have to do prevent the partial matching with 'sub' by 'subset' - RLum.Analysis = - if(!grepl(pattern = "subset", x = paste(deparse(match.call()), collapse = " "), fixed = TRUE)){ - plot_RLum.Analysis(object = object, subset = NULL, ...) - - }else{ - plot_RLum.Analysis(object = object, ...) - - }, - - RLum.Results = plot_RLum.Results(object = object, ...)) - }else{ - stop(paste0( - "[plot_RLum()] Sorry, I don't know what to do for object of type '", is(object)[1], "'." - ), call. = FALSE) - - } - } - - # Run dispatcher ------------------------------------------------------------------------------ - ##call for the list, if not just proceed as normal - if(inherits(object, "list")) { - ##(0) we might have plenty of sublists before we have the list containing only - ##RLum-objects - object <- .unlist_RLum(object) - object <- .rm_nonRLum(object) - - ##(2) check if empty, if empty do nothing ... - if (length(object) != 0) { - ## If we iterate over a list, this might be extremely useful to have different plot titles - if("main" %in% names(list(...))){ - if(is(list(...)$main,"list")){ - main.list <- rep(list(...)$main, length = length(object)) - - } - } - - ##set also mtext, but in a different way - if(!"mtext" %in% names(list(...))){ - if(is(object[[1]], "RLum.Analysis")){ - mtext <- paste("Record:", 1:length(object)) - - }else{ - mtext <- NULL - - } - }else{ - mtext <- rep(list(...)$mtext, length.out = length(object)) - - } - if(exists("main.list")){ - ##dispatch objects - for (i in 1:length(object)) { - RLum.dispatcher(object = object[[i]], - main = main.list[[i]], - mtext = mtext[[i]], - ...) - } - }else{ - for (i in 1:length(object)) { - RLum.dispatcher(object = object[[i]], - mtext = mtext[[i]], - ...) - } - } - } - }else{ - ##dispatch object - RLum.dispatcher(object = object, ...) - - } -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_RLum.Results.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_RLum.Results.R deleted file mode 100644 index b79764895..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_RLum.Results.R +++ /dev/null @@ -1,1178 +0,0 @@ -#' Plot function for an RLum.Results S4 class object -#' -#' The function provides a standardised plot output for data of an RLum.Results -#' S4 class object -#' -#' The function produces a multiple plot output. A file output is recommended -#' (e.g., [pdf]). -#' -#' @param object [RLum.Results-class] (**required**): -#' S4 object of class `RLum.Results` -#' -#' @param single [logical] (*with default*): -#' single plot output (`TRUE/FALSE`) to allow for plotting the results in as -#' few plot windows as possible. -#' -#' @param ... further arguments and graphical parameters will be passed to -#' the `plot` function. -#' -#' @return Returns multiple plots. -#' -#' @note -#' Not all arguments available for [plot] will be passed! -#' Only plotting of `RLum.Results` objects are supported. -#' -#' @section Function version: 0.2.1 -#' -#' @author -#' Christoph Burow, University of Cologne (Germany) \cr -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [plot], [plot_RLum] -#' -#' @keywords aplot -#' -#' @examples -#' -#' -#' ###load data -#' data(ExampleData.DeValues, envir = environment()) -#' -#' # apply the un-logged minimum age model -#' mam <- calc_MinDose(data = ExampleData.DeValues$CA1, sigmab = 0.2, log = TRUE, plot = FALSE) -#' -#' ##plot -#' plot_RLum.Results(mam) -#' -#' # estimate the number of grains on an aliquot -#' grains<- calc_AliquotSize(grain.size = c(100,150), sample.diameter = 1, plot = FALSE, MC.iter = 100) -#' -#' ##plot -#' plot_RLum.Results(grains) -#' -#' -#' @md -#' @export -plot_RLum.Results<- function( - object, - single = TRUE, - ... -){ - - ##============================================================================## - ## CONSISTENCY CHECK OF INPUT DATA - ##============================================================================## - - ##check if object is of class RLum.Data.Curve - if(!is(object,"RLum.Results")){ - .throw_error("Input object is not of type 'RLum.Results'") - } - - ##============================================================================## - ## SAFE AND RESTORE PLOT PARAMETERS ON EXIT - ##============================================================================## - par.old <- par(no.readonly = TRUE) - on.exit(suppressWarnings(par(par.old))) - - ##============================================================================## - ## ... ARGUMENTS - ##============================================================================## - - ##deal with addition arguments - extraArgs <- list(...) - - ##main - main <- if("main" %in% names(extraArgs)) {extraArgs$main} else - {""} - ##mtext - mtext <- if("mtext" %in% names(extraArgs)) {extraArgs$mtext} else - {""} - ##log - log <- if("log" %in% names(extraArgs)) {extraArgs$log} else - {""} - ##lwd - lwd <- if("lwd" %in% names(extraArgs)) {extraArgs$lwd} else - {1} - ##lty - lty <- if("lty" %in% names(extraArgs)) {extraArgs$lty} else - {1} - ##type - type <- if("type" %in% names(extraArgs)) {extraArgs$type} else - {"l"} - ##pch - pch <- if("pch" %in% names(extraArgs)) {extraArgs$pch} else - {1} - ##col - col <- if("col" %in% names(extraArgs)) {extraArgs$col} else - {"black"} - - ##============================================================================## - ## PLOTTING - ##============================================================================## - - #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~# - ## CASE 0: General plot dispatcher ---------- - switch(object@originator, - "analyse_SAR.CWOSL" = plot_AbanicoPlot(object), - "analyse_pIRIRSequence" = plot_AbanicoPlot(object), - "analyse_IRSARRF" = plot_AbanicoPlot(object), - NULL - ) - - ## CASE 1: Minimum Age Model / Maximum Age Model ------- - if(object@originator=="calc_MinDose" || object@originator=="calc_MaxDose") { - - ## single MAM estimate - # plot profile log likelihood - - profiles <- object@data$profile - if (object@data$args$log) { - profiles@profile$gamma$par.vals[ ,"gamma"] <- exp(profiles@profile$gamma$par.vals[ ,"gamma"]) - profiles@profile$sigma$par.vals[ ,"sigma"] <- exp(profiles@profile$sigma$par.vals[ ,"sigma"]) - - if (object@data$args$par == 4) - profiles@profile$mu$par.vals[ ,"mu"] <- exp(profiles@profile$mu$par.vals[ ,"mu"]) - } - - if (single) - par(mfrow=c(2, 2)) - - param <- c("gamma", "sigma", "p0", "mu") - - for (i in param) { - if (object@data$summary$par == 3 && i == "mu") - break - - tryCatch({ - - xvals <- as.data.frame(profiles@profile[[i]]$par.vals)[[i]] - xlim <- range(xvals[xvals > 0]) - suppressWarnings( - bbmle::plot(profiles, which = i, xlab = "", xaxt = "n", xlim = xlim) - ) - - axis(1, mgp = c(3, 0.5, 0)) - title(xlab = i, line = 1.2) - - if (i %in% c("gamma", "sigma", "mu") && object@data$args$log && object@data$args$log.output) { - axis(1, at = axTicks(1), - labels = format(round(log(axTicks(1)), 2), nsmall = 2), - line = 2.5, mgp = c(3, 0.5, 0)) - title(xlab = paste0("log(", i, ")"), line = 4) - } - - }, error = function(e) { - message("Unable to plot the likelihood profile for: ", i, - " (likelihood probably infinite)") - }) - } - par(mfrow=c(1,1)) - - - # }) - - ## bootstrap MAM estimates - if(object@data$args$bootstrap==TRUE) { - - # save previous plot parameter and set new ones - .pardefault<- par(no.readonly = TRUE) - - # get De-llik pairs - pairs<- object@data$bootstrap$pairs$gamma - - # get polynomial fit objects - poly.lines<- list(poly.three=object@data$bootstrap$poly.fits$poly.three, - poly.four=object@data$bootstrap$poly.fits$poly.four, - poly.five=object@data$bootstrap$poly.fits$poly.five, - poly.six=object@data$bootstrap$poly.fits$poly.six) - - # define polynomial curve functions for plotting - poly.curves<- list(poly.three.curve=function(x) { poly.lines$poly.three$coefficient[4]*x^3 + poly.lines$poly.three$coefficient[3]*x^2 + poly.lines$poly.three$coefficient[2]*x + poly.lines$poly.three$coefficient[1] }, - poly.four.curve=function(x) { poly.lines$poly.four$coefficient[5]*x^4 + poly.lines$poly.four$coefficient[4]*x^3 + poly.lines$poly.four$coefficient[3]*x^2 + poly.lines$poly.four$coefficient[2]*x + poly.lines$poly.four$coefficient[1] }, - poly.five.curve=function(x) { poly.lines$poly.five$coefficient[6]*x^5 + poly.lines$poly.five$coefficient[5]*x^4 + poly.lines$poly.five$coefficient[4]*x^3 + poly.lines$poly.five$coefficient[3]*x^2 + poly.lines$poly.five$coefficient[2]*x + poly.lines$poly.five$coefficient[1] }, - poly.six.curve=function(x) { poly.lines$poly.six$coefficient[7]*x^6 + poly.lines$poly.six$coefficient[6]*x^5 + poly.lines$poly.six$coefficient[5]*x^4 + poly.lines$poly.six$coefficient[4]*x^3 + poly.lines$poly.six$coefficient[3]*x^2 + poly.lines$poly.six$coefficient[2]*x + poly.lines$poly.six$coefficient[1] }) - - ## --------- PLOT "RECYCLE" BOOTSTRAP RESULTS ------------ ## - - if(single==TRUE) { - layout(cbind(c(1,1,2, 5,5,6), c(3,3,4, 7,7,8))) - par(cex = 0.6) - } else { - layout(matrix(c(1,1,2)),2,1) - par(cex = 0.8) - } - - for(i in 1:4) { - ## ----- LIKELIHOODS - - # set margins (bottom, left, top, right) - par(mar=c(0,5,5,3)) - - # sort De and likelihoods by De (increasing) - pairs<- pairs[order(pairs[,1]),] - - # remove invalid NA values - pairs<- na.omit(pairs) - - plot(x=pairs[,1], - y=pairs[,2], - xlab="Equivalent Dose [Gy]", - ylab="Likelihood", - xlim=range(pretty(pairs[,1])), - ylim=range(pretty(c(0, as.double(quantile(pairs[,2],probs=0.98))))), - xaxt = "n", - xaxs = "i", - yaxs = "i", - bty = "l", - main="Recycled bootstrap MAM-3") - - axis(side = 1, labels = FALSE, tick = FALSE) - - # add subtitle - mtext(as.expression(bquote(italic(M) == .(object@data$args$bs.M) ~ "|" ~ - italic(N) == .(object@data$args$bs.N) ~ "|" ~ - italic(sigma[b]) == .(object@data$args$sigmab) ~ - "\u00B1" ~ .(object@data$args$sigmab.sd) ~ "|" ~ - italic(h) == .(round(object@data$args$bs.h,1)) - ) - ), - side = 3, line = 0.3, adj = 0.5, - cex = if(single){0.5}else{0.8}) - - # add points - points(x=pairs[,1], y=pairs[,2], pch=1, col = "grey80") - - # get polynomial function - poly.curve<- poly.curves[[i]] - - # add curve to plot - curve(poly.curve, from = min(pairs[,1]), to = (max(pairs[,1])), - col = "black", add = TRUE, type = "l") - - # add legend - legend<- c("Third degree", "Fourth degree", "Fifth degree", "Sixth degree") - legend("topright", xjust = 0, - legend = legend[i], - y.intersp = 1.2, - bty = "n", - title = "Polynomial Fit", - lty = 1, - lwd= 1.5) - - ## ----- RESIDUALS - - # set margins (bottom, left, top, right) - par(mar=c(5,5,0,3)) - - plot(x = pairs[,1], - y = residuals(poly.lines[[i]]), - ylim = c(min(residuals(poly.lines[[i]]))*1.2, - as.double(quantile(residuals(poly.lines[[i]]),probs=0.99))), - xlim=range(pretty(pairs[,1])), - xaxt = "n", - bty = "l", - xaxs = "i", - col = "grey80", - ylab = "Fit residual", - xlab = "Equivalent dose [Gy]") - - axis(side = 1, labels = TRUE, tick = TRUE) - - # add horizontal line - abline(h = 0, lty=2) - - # calculate residual sum of squares (RSS) and add to plot - rss<- sum(residuals(poly.lines[[i]])^2) - mtext(text = paste("RSS =",round(rss,3)), adj = 1, - side = 3, line = -2, - cex = if(single){0.6}else{0.8}) - - ## ----- PROPORTIONS - - }##EndOf::Plot_loop - - # restore previous plot parameters - par(.pardefault) - - ### TODO: plotting of the LOESS fit needs to be fleshed out - ### possibly integrate this in the prior polynomial plot loop - - ### LOESS PLOT - pairs<- object@data$bootstrap$pairs$gamma - pred<- predict(object@data$bootstrap$loess.fit) - loess<- cbind(pairs[,1], pred) - loess<- loess[order(loess[,1]),] - - # plot gamma-llik pairs - plot(pairs, - ylim = c(0, as.double(quantile( pairs[,2],probs=0.99))), - ylab = "Likelihood", - xlab = "Equivalent dose [Gy]", - col = "gray80") - - # add LOESS line - lines(loess, type = "l", col = "black") - - ### ------ PLOT BOOTSTRAP LIKELIHOOD FIT - - par(mar=c(5,4,4,4)) - - xlim<- range(pretty(object@data$data[,1])) - xlim[1]<- xlim[1]-object@data$data[which.min(object@data$data[,1]),2] - xlim[2]<- xlim[2]+object@data$data[which.max(object@data$data[,1]),2] - xlim<- range(pretty(xlim)) - - # empty plot - plot(NA,NA, - xlim=xlim, - ylim=c(0,2), - xlab="Equivalent dose [Gy]", - ylab="", - bty="l", - axes=FALSE, - xaxs="i", - yaxs="i", - yaxt="n") - - axis(side = 1) - axis(side = 2, at = c(0,0.5,1)) - - mtext(text = "Normalised likelihood / density", side = 2, line = 2.5, adj = 0) - - # set the polynomial to plot - poly.curve<- poly.curves[[1]] # three degree poly - - # plot a nice grey polygon as in the publication - step<- 0.1 - x<- seq(min(pairs[,1]), max(pairs[,1]), step) - y<- poly.curve(x) - # normalise y-values - y<- y/max(y) - - x<- c(min(pairs[,1]), x, max(pairs[,1])) - y<- c(0, y, 0) - - # cutoff negative y values - neg<- which(y<0) - if (length(neg) != 0) { - y<- y[-neg] - x<- x[-neg] - } - - # add bootstrap likelihood polygon to plot - polygon(x, y, col = "grey80", border = NA) - - if (all(x > max(xlim)) || all(x < min(xlim))) - .throw_warning("Bootstrap estimates out of x-axis range") - - - ### ----- PLOT MAM SINGLE ESTIMATE - - # symmetric errors, might not be appropriate - mean<- object@data$summary$de - sd<- object@data$summary$de_err - - - if (any(is.na(c(mean, sd)))) { - .throw_warning("Unable to plot the MAM single estimate (NA value)") - - } else { - - x<- seq(mean-5*sd, mean+5*sd, 0.001) - y<- dnorm(seq(mean-5*sd, mean+5*sd, 0.001), mean, sd) - # normalise y-values - y<- y/max(y) - - points(x, y, - type="l", - col="red") - - ## asymmetric errors - x<- unlist(object@data$profile@profile$gamma$par.vals[,1]) - y<- abs(unlist(object@data$profile@profile$gamma$z)) - - if(object@data$args$log == TRUE) { - x<- exp(x) - } - - # now invert the data by shifting - y<- -y - y<- y-min(y) - y<- y/max(y) - - # fit a smoothing spline - l<- spline(x = x, y = y, method = "n", n = 1000) - - # make the endpoints zero - l$y[1]<- l$y[length(l$y)]<- 0 - - # add profile log likelihood curve to plot - lines(l, col="blue", lwd=1) - - # add vertical lines of the mean values - #points(x = 80, y = 100,type = "l") - - } - - #### ------ PLOT DE - par(new = TRUE) - - # sort the data in ascending order - dat<- object@data$data[order(object@data$data[,1]),] - - x<- dat[,1] - y<- 1:length(object@data$data[,1]) - - plot(x = x, y = y, - xlim=xlim, - ylim=c(0, max(y)+1), - axes = FALSE, - pch = 16, - xlab = "", - ylab="", - xaxs="i", - yaxs="i") - - axis(side = 4) - mtext(text = "# Grain / aliquot", side = 4, line = 2.5) - - # get sorted errors - err<- object@data$data[order(object@data$data[,1]),2] - - # fancy error bars - arrows(x0 = x-err, y0 = y, - x1 = x+err, y1 = y, - code = 3, angle = 90, length = 0.05) - - ### ---- AUXILLARY - - # add legend - legend("bottomright", - bty = "n", - col = c("grey80", "red", "blue", "black"), - pch = c(NA,NA,NA,16), - lty = c(1,1,1,1), - lwd=c(10,2,2,2), - legend = c("Bootstrap likelihood", "Profile likelihood (gaussian fit)","Profile likelihood", "Grain / aliquot"), - ) - - }##EndOf::Bootstrap_plotting - }#EndOf::CASE1_MinimumAgeModel-3 - - - #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~# - ## CASE 2: Central Age Model --------- - if(object@originator=="calc_CentralDose") { - - # get profile log likelihood data - sig<- object@data$profile$sig*100 - llik<- object@data$profile$llik - - # save previous plot parameter and set new ones - .pardefault<- par(no.readonly = TRUE) - - # plot the profile log likeihood - par(oma=c(2,1,2,1),las=1,cex.axis=1.2, cex.lab=1.2) - plot(sig,llik,type="l",xlab=as.expression(bquote(sigma[OD]~"[%]")),ylab="Log likelihood",lwd=1.5) - abline(h=0,lty=3) - abline(h=-1.92,lty=3) - title(as.expression(bquote("Profile log likelihood for" ~ sigma[OD]))) - - # find upper and lower confidence limits for sigma - sigmax<- sig[which.max(llik)] - tf<- abs(llik+1.92) < 0.05 - sig95<- sig[tf] - ntf<- length(sig95) - sigL<- sig95[1] - sigU<- sig95[ntf] - - # put them on the graph - abline(v=sigL) - abline(v=sigmax) - abline(v=sigU) - dx<- 0.006 - dy<- 0.2 - ytext<- min(llik) + dy - res<- c(sigL,sigmax,sigU) - text(res+dx,rep(ytext,3),round(res,2),adj=0) - - # restore previous plot parameters - par(.pardefault) - rm(.pardefault) - }##EndOf::Case 2 - calc_CentralDose() - - - #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~# - ## CASE 3: Fuchs & Lang 2001 -------- - if(object@originator=="calc_FuchsLang2001") { - - ##deal with addition arguments - extraArgs <- list(...) - - main <- if("main" %in% names(extraArgs)) {extraArgs$main} else {"Fuchs & Lang (2001)"} - xlab <- if("xlab" %in% names(extraArgs)) {extraArgs$xlab} else {expression(paste(D[e]," [s]"))} - ylab <- if("ylab" %in% names(extraArgs)) {extraArgs$ylab} else {"# Aliquots"} - sub <- if("sub" %in% names(extraArgs)) {extraArgs$sub} else {""} - cex <- if("cex" %in% names(extraArgs)) {extraArgs$cex} else {1} - lwd <- if("lwd" %in% names(extraArgs)) {extraArgs$lwd} else {1} - pch <- if("pch" %in% names(extraArgs)) {extraArgs$pch} else {19} - ylim <- if("ylim" %in% names(extraArgs)) {extraArgs$ylim} else {c(1,length(object@data$data[,1])+3)} - xlim <- if("xlim" %in% names(extraArgs)) {extraArgs$xlim} else {c(min(object@data$data[,1])-max(object@data$data[,2]), max(object@data$data[,1])+max(object@data$data[,2]))} - mtext <- if("mtext" %in% names(extraArgs)) {extraArgs$mtext} else {"unknown sample"} - - # extract relevant plotting parameters - o<- order(object@data$data[[1]]) - data_ordered<- object@data$data[o,] - usedDeValues<- object@data$usedDeValues - n.usedDeValues<- object@data$summary$n.usedDeValues - - par(cex = cex, mfrow=c(1,1)) - - ##PLOT - counter<-seq(1,max(o)) - - plot(NA,NA, - ylim = ylim, - xlim = xlim, - xlab = xlab, - ylab = ylab, - main = main, - sub = sub) - - ##SEGMENTS - segments(data_ordered[,1]-data_ordered[,2],1:length(data_ordered[,1]), - data_ordered[,1]+data_ordered[,2],1:length(data_ordered[,1]), - col="gray") - - - ##POINTS - points(data_ordered[,1], counter,pch=pch) - - ##LINES - ##BOUNDARY INFORMATION - ##lower boundary - lines(c( - usedDeValues[length(usedDeValues[,1])-n.usedDeValues+1,1], #boundary_counter for incorporate skipped values - usedDeValues[length(usedDeValues[,1])-n.usedDeValues+1,1]), - c(min(o)-0.5,max(o)+0.5), - col="red", - lty="dashed", lwd = lwd) - - - #upper boundary - lines(c(max(usedDeValues[,1]),max(usedDeValues[,1])),c(min(o)-0.5,max(o)+0.5), - col="red",lty="dashed", lwd = lwd) - - #plot some further informations into the grafik - arrows( - usedDeValues[length(usedDeValues[,1])-n.usedDeValues+1,1]+usedDeValues[length(usedDeValues[,1])-n.usedDeValues+1,1]*0.02, #x1 - max(o)+0.5, #y1 - max(usedDeValues[,1]-usedDeValues[,1]*0.02), #x2 - max(o)+0.5, #y2, - code=3, - length=0.03) - - text( - c( - usedDeValues[length(usedDeValues[,1])-n.usedDeValues+1,1], - usedDeValues[length(usedDeValues[,1])-n.usedDeValues+1,1]), - c(max(o)+2,max(o)+2), - labels=paste("used values = ", n.usedDeValues), - cex=0.6*cex, - adj=0) - - ##MTEXT - mtext(side=3,mtext,cex=cex) - } - - - #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~# - ## CASE 4: Finite Mixture Model -------- - if(object@originator == "calc_FiniteMixture") { - if(length(object@data$args$n.components) > 1) { - ##deal with addition arguments - extraArgs <- list(...) - - main <- if("main" %in% names(extraArgs)) {extraArgs$main} else {"Finite Mixture Model"} - plot.proportions<- if("plot.proportions" %in% names(extraArgs)) {extraArgs$plot.proportions} else {TRUE} - pdf.colors<- if("pdf.colors" %in% names(extraArgs)) {extraArgs$pdf.colors} else {"gray"} - pdf.weight<- if("pdf.weight" %in% names(extraArgs)) {extraArgs$pdf.weight} else {TRUE} - pdf.sigma<- if("pdf.sigma" %in% names(extraArgs)) {extraArgs$pdf.sigma} else {"sigmab"} - - # extract relevant data from object - n.components <- object@data$args$n.components - comp.n <- object@data$components - sigmab <- object@data$args$sigmab - BIC.n <- object@data$BIC$BIC - LLIK.n <- object@data$llik$llik - - # save previous plot parameter and set new ones - .pardefault<- par(no.readonly = TRUE) - - ## DEVICE AND PLOT LAYOUT - n.plots<- length(n.components) #number of PDF plots in plot area #1 - seq.vertical.plots<- seq(from = 1, to = n.plots, by = 1) #indices - ID.plot.two<- n.plots+if(plot.proportions==TRUE){1}else{0} #ID of second plot area - ID.plot.three<- n.plots+if(plot.proportions==TRUE){2}else{1} #ID of third plot area - - #empty vector for plot indices - seq.matrix<- vector(mode="integer", length=4*n.plots) - - #fill vector with plot indices in correct order - cnt<- 1 - seq<- seq(1,length(seq.matrix),4) - for(i in seq) { - seq.matrix[i]<- cnt - seq.matrix[i+1]<- cnt - seq.matrix[i+2]<- if(plot.proportions==TRUE){ID.plot.two}else{cnt} - seq.matrix[i+3]<- ID.plot.three - - cnt<- cnt+1 - } - - # create device layout - layout(matrix(c(seq.matrix),4,n.plots)) - - # outer margins (bottom, left, top, right) - par(oma=c(2.5,5,3,5)) - - # general plot parameters (global scaling, allow overplotting) - par(cex = 0.8, xpd = NA) - - # define colour palette for prettier output - if(pdf.colors == "colors") { - col.n<- c("red3", "slateblue3", "seagreen", "tan3", "yellow3", - "burlywood4", "magenta4", "mediumpurple3", "brown4","grey", - "aquamarine") - poly.border<- FALSE - } - if(pdf.colors == "gray" || pdf.colors == "grey") { - col.n<- gray.colors(length(n.components)*2) - poly.border<- FALSE - } - if(pdf.colors == "none") { - col.n<- NULL - poly.border<- TRUE - } - - ##-------------------------------------------------------------------------- - ## PLOT 1: EQUIVALENT DOSES OF COMPONENTS - - ## create empty plot without x-axis - for(i in 1:n.plots) { - pos.n<- seq(from = 1, to = n.components[i]*3, by = 3) - - # set margins (bottom, left, top, right) - par(mar=c(1,0,2,0)) - - # empty plot area - plot(NA, NA, - xlim=c(min(n.components)-0.2, max(n.components)+0.2), - ylim=c(min(comp.n[pos.n,]-comp.n[pos.n+1,], na.rm = TRUE), - max((comp.n[pos.n,]+comp.n[pos.n+1,])*1.1, na.rm = TRUE)), - ylab="", - xaxt="n", - yaxt="n", - xlab="") - - # add text in upper part of the plot ("k = 1,2..n") - mtext(bquote(italic(k) == .(n.components[i])), - side = 3, line = -2, cex=0.8) - - # add y-axis label (only for the first plot) - if(i==1) { - mtext(expression(paste("D"[e]," [Gy]")), side=2,line=2.7, cex=1) - } - - # empty list to store normal distribution densities - sapply.storage<- list() - - ## NORMAL DISTR. OF EACH COMPONENT - - # LOOP - iterate over number of components - for(j in 1:max(n.components)) { - # draw random values of the ND to check for NA values - suppressWarnings( - comp.nd.n<- sort(rnorm(n = length(object@data$data[,1]), - mean = comp.n[pos.n[j],i], - sd = comp.n[pos.n[j]+1,i])) - ) - # proceed if no NA values occurred - if(length(comp.nd.n)!=0) { - - # weight - proportion of the component - wi<- comp.n[pos.n[j]+2,i] - - # calculate density values with(out) weights - fooX<- function(x) { - dnorm(x, mean = comp.n[pos.n[j],i], - sd = if(pdf.sigma=="se"){comp.n[pos.n[j]+1,i]} - else{if(pdf.sigma=="sigmab"){comp.n[pos.n[j],i]*sigmab}} - )* - if(pdf.weight==TRUE){wi}else{1} - } - - # x-axis scaling - determine highest dose in first cycle - if(i==1 && j==1){ - max.dose<- max(object@data$data[,1])+sd(object@data$data[,1])/2 - min.dose<- min(object@data$data[,1])-sd(object@data$data[,1])/2 - - # density function to determine y-scaling if no weights are used - fooY<- function(x) { - dnorm(x, mean = na.exclude(comp.n[pos.n,]), - sd = na.exclude(comp.n[pos.n+1,])) - } - # set y-axis scaling - dens.max<-max(sapply(0:max.dose, fooY)) - }##EndOfIf::first cycle settings - - # override y-axis scaling if weights are used - if(pdf.weight==TRUE){ - sapply.temp<- list() - for(b in 1:max(n.components)){ - - # draw random values of the ND to check for NA values - suppressWarnings( - comp.nd.n<- sort(rnorm(n = length(object@data$data[,1]), - mean = comp.n[pos.n[b],i], - sd = comp.n[pos.n[b]+1,i])) - ) - # proceed if no NA values occurred - if(length(comp.nd.n)!=0) { - - # weight - proportion of the component - wi.temp<- comp.n[pos.n[b]+2,i] - - fooT<- function(x) { - dnorm(x, mean = comp.n[pos.n[b],i], - sd = if(pdf.sigma=="se"){comp.n[pos.n[b]+1,i]} - else{if(pdf.sigma=="sigmab"){comp.n[pos.n[b],i]*sigmab}} - )*wi.temp - } - sapply.temp[[b]]<- sapply(0:max.dose, fooT) - } - } - dens.max<- max(Reduce('+', sapply.temp)) - } - - # calculate density values for 0 to maximum dose - sapply<- sapply(0:max.dose, fooX) - - # save density values in list for sum curve of gaussians - sapply.storage[[j]]<- sapply - - ## determine axis scaling - # x-axis (dose) - if("dose.scale" %in% names(extraArgs)) { - y.scale<- extraArgs$dose.scale - } else { - y.scale<- c(min.dose,max.dose) - } - # y-axis (density) - if("pdf.scale" %in% names(extraArgs)) { - x.scale<- extraArgs$pdf.scale - } else { - x.scale<- dens.max*1.1 - } - - ## PLOT Normal Distributions - par(new=TRUE) - plot(sapply, 1:length(sapply)-1, - type="l", yaxt="n", xaxt="n", col=col.n[j], lwd=1, - ylim=y.scale, - xlim=c(0,x.scale), - xaxs="i", yaxs="i", - ann=FALSE, xpd = FALSE) - - # draw coloured polygons under curve - polygon(x=c(min(sapply), sapply, min(sapply)), - y=c(0, 0:max.dose, 0), - col = adjustcolor(col.n[j], alpha.f = 0.66), - yaxt="n", border=poly.border, xpd = FALSE, lty = 2, lwd = 1.5) - - } - }##EndOf::Component loop - - # Add sum of Gaussian curve - par(new = TRUE) - - plot(Reduce('+', sapply.storage),1:length(sapply)-1, - type="l", yaxt="n", xaxt="n", col="black", - lwd=1.5, lty = 1, - ylim=y.scale, - xlim=c(0,x.scale), - xaxs="i", yaxs="i", ann=FALSE, xpd = FALSE) - - # draw additional info during first k-cycle - if(i == 1) { - - # plot title - mtext("Normal distributions", - side = 3, font = 2, line = 0, adj = 0, cex = 0.8) - - # main title - mtext(main, - side = 3, font = 2, line = 3.5, adj = 0.5, - at = grconvertX(0.5, from = "ndc", to = "user")) - - # subtitle - mtext(as.expression(bquote(italic(sigma[b]) == .(sigmab) ~ - "|" ~ n == .(length(object@data$data[,1])))), - side = 3, font = 1, line = 2.2, adj = 0.5, - at = grconvertX(0.5, from = "ndc", to = "user"), cex = 0.9) - - # x-axis label - mtext("Density [a.u.]", - side = 1, line = 0.5, adj = 0.5, - at = grconvertX(0.5, from = "ndc", to = "user")) - - # draw y-axis with proper labels - axis(side=2, labels = TRUE) - } - - if(pdf.colors == "colors") { - # create legend labels - dose.lab.legend<- paste("c", 1:n.components[length(n.components)], sep="") - - if(max(n.components)>8) { - ncol.temp<- 8 - yadj<- 1.025 - } else { - ncol.temp<- max(n.components) - yadj<- 0.93 - } - - # add legend - if(i==n.plots) { - legend(grconvertX(0.55, from = "ndc", to = "user"), - grconvertY(yadj, from = "ndc", to = "user"), - legend = dose.lab.legend, - col = col.n[1:max(n.components)], - pch = 15, adj = c(0,0.2), pt.cex=1.4, - bty = "n", ncol=ncol.temp, x.intersp=0.4) - - mtext("Components: ", cex = 0.8, - at = grconvertX(0.5, from = "ndc", to = "user")) - } - } - - }##EndOf::k-loop and Plot 1 - - ##-------------------------------------------------------------------------- - ## PLOT 2: PROPORTION OF COMPONENTS - if(plot.proportions==TRUE) { - # margins for second plot - par(mar=c(2,0,2,0)) - - # create matrix with proportions from a subset of the summary matrix - prop.matrix<- comp.n[pos.n+2,]*100 - - # stacked barplot of proportions without x-axis - barplot(prop.matrix, - width=1, - xlim=c(0.2, length(n.components)-0.2), - ylim=c(0,100), - axes=TRUE, - space=0, - col=col.n, - xpd=FALSE, - xaxt="n") - - # y-axis label - mtext("Proportion [%]", - side=2,line=3, cex=1) - - - # add x-axis with corrected tick positions - axis(side = 1, labels = n.components, at = n.components+0.5-n.components[1]) - - # draw a box (not possible with barplot()) - box(lty=1, col="black") - - # add subtitle - mtext("Proportion of components", - side = 3, font = 2, line = 0, adj = 0, cex = 0.8) - } - ##-------------------------------------------------------------------------- - ## PLOT 3: BIC & LLIK - - # margins for third plot - par(mar=c(2,0,2,0)) - - # prepare scaling for both y-axes - BIC.scale<- c(min(BIC.n)*if(min(BIC.n)<0){1.2}else{0.8}, - max(BIC.n)*if(max(BIC.n)<0){0.8}else{1.2}) - LLIK.scale<- c(min(LLIK.n)*if(min(LLIK.n)<0){1.2}else{0.8}, - max(LLIK.n)*if(max(LLIK.n)<0){0.8}else{1.2}) - - # plot BIC scores - plot(n.components, BIC.n, - main= "", - type="b", - pch=22, - cex=1.5, - xlim=c(min(n.components)-0.2, max(n.components)+0.2), - ylim=BIC.scale, - xaxp=c(min(n.components), max(n.components), length(n.components)-1), - xlab=expression(paste(italic(k), " Components")), - ylab=expression(paste("BIC")), - cex.lab=1.25) - - # following plot should be added to previous - par(new = TRUE) - - # plot LLIK estimates - plot(n.components, LLIK.n, - xlim=c(min(n.components)-0.2, max(n.components)+0.2), - xaxp=c(min(n.components), max(n.components), length(n.components)-1), - ylim=LLIK.scale, - yaxt="n", type="b", pch=16, xlab="", ylab="", lty=2, cex = 1.5) - - # subtitle - mtext("Statistical criteria", - side = 3, font = 2, line = 0, adj = 0, cex = 0.8) - - # second y-axis with proper scaling - axis(side = 4, ylim=c(0,100)) - - # LLIK axis label - mtext(bquote(italic(L)[max]), - side=4,line=3, cex=1.3) - - # legend - legend(grconvertX(0.75, from = "nfc", to = "user"), - grconvertY(0.96, from = "nfc", to = "user"), - legend = c("BIC", as.expression(bquote(italic(L)[max]))), - pch = c(22,16), pt.bg=c("white","black"), - adj = 0, pt.cex=1.3, lty=c(1,2), - bty = "n", horiz = TRUE, x.intersp=0.5) - - - ## restore previous plot parameters - par(.pardefault) - } - - }##EndOf::Case 4 - Finite Mixture Model - - #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~# - ## CASE 5: Aliquot Size --------- - if(object@originator=="calc_AliquotSize") { - if(!is.null(object@data$MC$estimates)) { - extraArgs <- list(...) - - main <- if("main" %in% names(extraArgs)) { extraArgs$main } else { "Monte Carlo Simulation" } - xlab <- if("xlab" %in% names(extraArgs)) { extraArgs$xlab } else { "Amount of grains on aliquot" } - - # extract relevant data - MC.n<- object@data$MC$estimates - MC.n.kde<- object@data$MC$kde - MC.stats<- object@data$MC$statistics - MC.q<- object@data$MC$quantile - MC.iter<- object@data$args$MC.iter - - # set layout of plotting device - layout(matrix(c(1,1,2)),2,1) - par(cex = 0.8) - - ## plot MC estimate distribution - - # set margins (bottom, left, top, right) - par(mar=c(2,5,5,3)) - - # plot histogram - hist(MC.n, freq=FALSE, col = "gray90", - main="", xlab=xlab, - xlim = c(min(MC.n)*0.95, max(MC.n)*1.05), - ylim = c(0, max(MC.n.kde$y)*1.1)) - - # add rugs to histogram - rug(MC.n) - - # add KDE curve - lines(MC.n.kde, col = "black", lwd = 1) - - # add mean, median and quantils (0.05,0.95) - abline(v=c(MC.stats$mean, MC.stats$median, MC.q), - lty=c(2, 4, 3,3), lwd = 1) - - # add main- and subtitle - mtext(main, side = 3, adj = 0.5, - line = 3, cex = 1) - mtext(as.expression(bquote(italic(n) == .(MC.iter) ~ "|" ~ - italic(hat(mu)) == .(round(MC.stats$mean)) ~ "|" ~ - italic(hat(sigma)) == .(round(MC.stats$sd.abs)) ~ "|" ~ - italic(frac(hat(sigma),sqrt(n))) == .(round(MC.stats$se.abs)) ~ "|" ~ - italic(v) == .(round(MC.stats$skewness, 2)) - ) - ), - side = 3, line = 0.3, adj = 0.5, - cex = 0.9) - - # add legend - legend("topright", legend = c("mean","median", "0.05 / 0.95 quantile"), - lty = c(2, 4, 3), bg = "white", box.col = "white", cex = 0.9) - - ## BOXPLOT - # set margins (bottom, left, top, right) - par(mar=c(5,5,0,3)) - - plot(NA, type="n", xlim=c(min(MC.n)*0.95, max(MC.n)*1.05), - xlab=xlab, ylim=c(0.5,1.5), - xaxt="n", yaxt="n", ylab="") - par(bty="n") - boxplot(MC.n, horizontal = TRUE, add = TRUE, bty="n") - } else { - on.exit(NULL) - } - }#EndOf::Case 5 - calc_AliqoutSize() - - #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~# - ## CASE 6: calc_SourceDoseRate() ---------- - if(object@originator=="calc_SourceDoseRate") { - - ##prepare data - ##get data - df <- get_RLum(object = object, data.object = "dose.rate") - - ##reduce the size for plotting, more than 100 points makes no sense - if(nrow(df)>100) { - df <- df[seq(1,nrow(df), length = 100),] - } - - ##plot settings - plot.settings <- list( - main = "Source Dose Rate Prediction", - xlab = "Date", - ylab = paste0( - "Dose rate/(",get_RLum(object = object, data.object = "parameters")$dose.rate.unit,")"), - log = "", - cex = 1, - xlim = NULL, - ylim = c(min(df[,1]) - max(df[,2]), max(df[,1]) + max(df[,2])), - pch = 1, - mtext = paste0( - "source type: ", get_RLum(object = object, data.object = "parameters")$source.type, - " | ", - "half-life: ", get_RLum(object = object, data.object = "parameters")$halflife, - " a" - ), - grid = expression(nx = 10, ny = 10), - col = 1, - type = "b", - lty = 1, - lwd = 1, - segments = "" - ) - - ##modify list if something was set - plot.settings <- modifyList(plot.settings, list(...)) - - - ##plot - plot( - df[,3], df[,1], - main = plot.settings$main, - xlab = plot.settings$xlab, - ylab = plot.settings$ylab, - xlim = plot.settings$xlim, - ylim = plot.settings$ylim, - log = plot.settings$log, - pch = plot.settings$pch, - col = plot.settings$pch, - type = plot.settings$type, - lty = plot.settings$lty, - lwd = plot.settings$lwd - ) - - if(!is.null(plot.settings$segments)){ - segments( - x0 = df[,3], y0 = df[,1] + df[,2], - x1 = df[,3], y1 = df[,1] - df[,2] - ) - } - - mtext(side = 3, plot.settings$mtext) - - if(!is.null(plot.settings$grid)){ - grid(eval(plot.settings$grid)) - } - - }#EndOf::Case 6 - calc_SourceDoseRate() - - #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~# - ## CASE 7: Fast Ratio ---------- - if (object@originator=="calc_FastRatio") { - - # graphical settings - settings <- list(main = "Fast Ratio", - xlab = "t/s", - ylab = "Signal/cts", - type = "b", - log = "", - pch = 16, - cex = 1.0, - col = "black") - settings <- modifyList(settings, list(...)) - - par(cex = settings$cex) - - # fetch data from RLum.Results object - curve <- get_RLum(object, "data") - if (inherits(curve, "RLum.Data.Curve")) - curve <- get_RLum(curve) - res <- get_RLum(object, "summary") - fit <- get_RLum(object, "fit") - - # calculate the dead channel time offset - offset <- res$dead.channels.start * res$channel.width - - # plot the OSL curve - plot(curve, type = "n", main = settings$main, - xlab = settings$xlab, ylab = settings$ylab, log = settings$log) - - # plot points to show measured data points (i.e., the channels) - if (settings$type == "p" || settings$type == "b") - points(curve[(res$dead.channels.start + 1):(nrow(curve) - res$dead.channels.end), ], - pch = settings$pch, col = settings$col) - - # plot dead channels as empty circles - if (res$dead.channels.start > 0) - points(curve[1:res$dead.channels.start,]) - if (res$dead.channels.end > 0) - points(curve[(nrow(curve) - res$dead.channels.end):nrow(curve), ]) - - if (settings$type == "l" || settings$type == "b") - lines(curve, col = settings$col) - - # optional: plot fitted CW curve - if (!is.null(fit)) { - nls.fit <- get_RLum(fit, "fit") - if (!inherits(fit, "try-error") & "fitCW.curve" %in% names(object@data$args)) { - if (object@data$args$fitCW.curve == "T" | object@data$args$fitCW.curve == TRUE) { - lines(curve[(res$dead.channels.start + 1):(nrow(curve) - res$dead.channels.end), 1], - predict(nls.fit), col = "red", lty = 1) - - ##plot curve for additional parameters - col_components <- c("red", "green", "blue") - for (i in 1:3) { - if (!is.na(fit@data$data[[paste0("I0", i)]])) - curve(fit@data$data[[paste0("I0", i)]] * fit@data$data[[paste0("lambda", i)]] * exp(-fit@data$data[[paste0("lambda", i)]] * x), - lwd = 1, lty = 4, add = TRUE, col = col_components[i]) - } - - } - } - } - - # add vertical lines and labels for L1, L2, L3 - L_times <- c(curve[res$Ch_L1, 1], - curve[res$Ch_L2, 1], - curve[res$Ch_L3_start, 1], - curve[res$Ch_L3_end, 1]) + offset - abline(v = L_times, - lty = 2) - text(L_times, max(curve[ ,2]) * 0.95, pos = c(4,4,2,2), - labels = expression('L'[1], 'L'[2], 'L'[3['start']], 'L'[3['end']])) - - }#EndOf::Case7 - calc_FastRatio() -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_ROI.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_ROI.R deleted file mode 100644 index fa43691a7..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_ROI.R +++ /dev/null @@ -1,270 +0,0 @@ -#'@title Create Regions of Interest (ROI) Graphic -#' -#'@description Create ROI graphic with data extracted from the data imported -#'via [read_RF2R]. This function is used internally by [analyse_IRSAR.RF] but -#'might be of use to work with reduced data from spatially resolved measurements. -#'The plot dimensions mimic the original image dimensions -#' -#'@param object [RLum.Analysis-class], [RLum.Results-class] or a [list] of such objects (**required**): -#'data input. Please note that to avoid function errors, only input created -#'by the functions [read_RF2R] or [extract_ROI] is accepted -#' -#'@param exclude_ROI [numeric] (*with default*): option to remove particular ROIs from the -#'analysis. Those ROIs are plotted but not coloured and not taken into account -#'in distance analysis. `NULL` excludes nothing. -#' -#'@param dist_thre [numeric] (*optional*): euclidean distance threshold in pixel -#'distance. All ROI for which the euclidean distance is smaller are marked. This -#'helps to identify ROIs that might be affected by signal cross-talk. Note: -#'the distance is calculated from the centre of an ROI, e.g., the threshold -#'should include consider the ROIs or grain radius. -#' -#'@param dim.CCD [numeric] (*optional*): metric x and y for the recorded (chip) -#'surface in µm. For instance `c(8192,8192)`, if set additional x and y-axes are shown -#' -#'@param bg_image [RLum.Data.Image-class] (*optional*): background image object -#'please note that the dimensions are not checked. -#' -#'@param plot [logical] (*with default*): enable or disable plot output to use -#'the function only to extract the ROI data -#' -#'@param ... further parameters to manipulate the plot. On top of all arguments of -#'[graphics::plot.default] the following arguments are supported: `lwd.ROI`, `lty.ROI`, -#'`col.ROI`, `col.pixel`, `text.labels`, `text.offset`, `grid` (`TRUE/FALSE`), `legend` (`TRUE/FALSE`), -#'`legend.text`, `legend.pos` -#' -#'@return An ROI plot and an [RLum.Results-class] object with a matrix containing -#'the extracted ROI data and a object produced by [stats::dist] containing -#'the euclidean distance between the ROIs. -#' -#'@section Function version: 0.2.0 -#' -#'@author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#'@seealso [read_RF2R], [analyse_IRSAR.RF] -#' -#'@keywords datagen plot -#' -#'@examples -#' -#'## simple example -#'file <- system.file("extdata", "RF_file.rf", package = "Luminescence") -#'temp <- read_RF2R(file) -#'plot_ROI(temp) -#' -#'## in combination with extract_ROI() -#'m <- matrix(runif(100,0,255), ncol = 10, nrow = 10) -#'roi <- matrix(c(2.,4,2,5,6,7,3,1,1), ncol = 3) -#'t <- extract_ROI(object = m, roi = roi) -#'plot_ROI(t, bg_image = m) -#' -#'@md -#'@export -plot_ROI <- function( - object, - exclude_ROI = c(1), - dist_thre = -Inf, - dim.CCD = NULL, - bg_image = NULL, - plot = TRUE, - ...) { - ##helper function to extract content - .spatial_data <- function(x) { - ##ignore all none RLum.Analysis - if (!inherits(x, "RLum.Analysis") || x@originator != "read_RF2R") - stop("[plot_ROI()] Input for 'object' not supported, please check documentation!", call. = FALSE) - - ##extract some of the elements - info <- x@info - info$ROI <- strsplit(split = " ", info$ROI, fixed = TRUE)[[1]][2] - - c(ROI = info$ROI, - x = info$x, - y = info$y, - area = info$area, - width = info$width, - height = info$height, - img_width = info$image_width, - img_height = info$image_height, - grain_d = info$grain_d) - - } - - if(is(object, "RLum.Results") && object@originator == "extract_ROI") { - m <- object@data$roi_coord - - } else { - ## make sure the object is a list - if(!is.list(object)) object <- list(object) - - ##extract values and convert to numeric matrix - m <- t(vapply(object, .spatial_data, character(length = 9))) - - ##make numeric - storage.mode(m) <- "numeric" - - ## correct coordinates (they come in odd from the file) - m[,"x"] <- m[,"x"] + m[,"width"] / 2 - m[,"y"] <- m[,"y"] + m[,"height"] / 2 - } - - ##make sure the ROI selection works - if(is.null(exclude_ROI[1]) || exclude_ROI[1] <= 0) - exclude_ROI <- nrow(m) + 1 - - ## add mid_x and mid_y - m <- cbind(m, mid_x = c(m[,"x"] + m[,"width"] / 2), mid_y = c(m[,"y"] + m[,"height"] / 2)) - rownames(m) <- m[,"ROI"] - - ## distance calculation - euc_dist <- sel_euc_dist <- stats::dist(m[-exclude_ROI,c("mid_x","mid_y")]) - - ## distance threshold selector - sel_euc_dist[sel_euc_dist < dist_thre[1]] <- NA - sel_euc_dist <- suppressWarnings(as.numeric(rownames(na.exclude(as.matrix(sel_euc_dist))))) - - ## add information to matrix - m <- cbind(m, dist_sel = FALSE) - m[m[,"ROI"]%in%sel_euc_dist,"dist_sel"] <- TRUE - - ## --- Plotting --- - if(plot) { - plot_settings <- modifyList(x = list( - xlim = c(0, max(m[, "img_width"])), - ylim = c(max(m[, "img_height"]), 0), - xlab = "width [px]", - ylab = "height [px]", - main = "Spatial ROI Distribution", - frame.plot = FALSE, - lwd.ROI = 0.75, - lty.ROI = 2, - col.ROI = "black", - col.pixel = rgb(0,1,0,0.6), - text.labels = m[,"ROI"], - text.offset = 0.3, - grid = FALSE, - legend = TRUE, - legend.text = c("ROI", "sel. pixel", "> dist_thre"), - legend.pos = "topright" - ), val = list(...)) - - - ## set plot area - do.call( - what = plot.default, - args = c(x = NA, y = NA, - plot_settings[names(plot_settings) %in% methods::formalArgs(plot.default)]) - ) - - ## add background image if available - if(!is.null(bg_image)){ - a <- try({ - as(bg_image, "RLum.Data.Image") - }, silent = TRUE) - if(inherits(a, "try-error")) { - warning("[plot_ROI()] 'bg_image' is not of type RLum.Data.Image and cannot be converted into such; background image plot skipped!") - } else { - a <- a@data - graphics::image( - x = 1:nrow(a[, , 1]), - y = 1:ncol(a[, , 1]), - z = a[,order(1:dim(a)[2], decreasing = TRUE),1], - add = TRUE, - col = grDevices::hcl.colors(20, "inferno", rev = FALSE), - useRaster = TRUE) - } - } - - if (plot_settings$grid) grid(nx = max(m[,"img_width"]), ny = max(m[,"img_height"])) - - ## plot metric scale - if (!is.null(dim.CCD)) { - axis( - side = 1, - at = axTicks(1), - labels = paste(floor(dim.CCD[1] / max(m[,"img_width"]) * axTicks(1)), "\u00b5m"), - lwd = -1, - lwd.ticks = -1, - line = -2.2, - cex.axis = 0.8 - ) - axis( - side = 2, - at = axTicks(2)[-1], - labels = paste(floor(dim.CCD[2] / max(m[,"img_height"]) * axTicks(2)), "\u00b5m")[-1], - lwd = -1, - lwd.ticks = -1, - line = -2.2, - cex.axis = 0.8 - ) - } - - ## add circles and rectangles - for (i in 1:nrow(m)) { - if (!i%in%exclude_ROI) { - ## mark selected pixels - polygon( - x = c(m[i, "x"] - m[i, "width"]/ 2, m[i, "x"] - m[i, "width"]/ 2, m[i, "x"] + m[i, "width"]/2, m[i, "x"] + m[i, "width"]/2), - y = c(m[i, "y"] - m[i, "height"]/ 2, m[i, "y"] + m[i, "height"]/ 2, m[i, "y"] + m[i, "height"]/ 2, m[i, "y"] - m[i, "height"]/ 2), - col = plot_settings$col.pixel - ) - } - - ## add ROIs - shape::plotellipse( - rx = m[i, "width"] / 2, - ry = m[i, "width"] / 2, - mid = c(m[i, "x"], m[i, "y"]), - lcol = plot_settings$col.ROI, - lty = plot_settings$lty.ROI, - lwd = plot_settings$lwd.ROI) - - } - - ## add distance marker - points( - x = m[!m[,"ROI"]%in%sel_euc_dist & !m[,"ROI"]%in%exclude_ROI, "x"], - y = m[!m[,"ROI"]%in%sel_euc_dist & !m[,"ROI"]%in%exclude_ROI, "y"], - pch = 4, - col = "red") - - ## add text - if(length(m[-exclude_ROI,"x"]) > 0) { - graphics::text( - x = m[-exclude_ROI, "x"], - y = m[-exclude_ROI, "y"], - labels = plot_settings$text.labels[-exclude_ROI], - cex = 0.6, - col = if(!is.null(bg_image)) "white" else "black", - pos = 1, - offset = plot_settings$text.offset - ) - } - - ##add legend - if(plot_settings$legend) { - legend( - plot_settings$legend.pos, - bty = "", - pch = c(1, 15, 4), - box.lty = 0, - bg = rgb(1,1,1,0.7), - legend = plot_settings$legend.text, - col = c(plot_settings$col.ROI, plot_settings$col.pixel, "red") - ) - - } - - }##end if plot - - ## return results - invisible(set_RLum( - class = "RLum.Results", - data = list( - ROI = m, - euc_dist = euc_dist), - info = list( - call = sys.call() - ))) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_RadialPlot.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_RadialPlot.R deleted file mode 100644 index 113e9cc74..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_RadialPlot.R +++ /dev/null @@ -1,1613 +0,0 @@ -#' @title Function to create a Radial Plot -#' -#' @description A Galbraith's radial plot is produced on a logarithmic or a linear scale. -#' -#' @details Details and the theoretical background of the radial plot are given in the -#' cited literature. This function is based on an S script of Rex Galbraith. To -#' reduce the manual adjustments, the function has been rewritten. Thanks to -#' Rex Galbraith for useful comments on this function. \cr -#' Plotting can be disabled by adding the argument `plot = "FALSE"`, e.g. -#' to return only numeric plot output. -#' -#' Earlier versions of the Radial Plot in this package had the 2-sigma-bar -#' drawn onto the z-axis. However, this might have caused misunderstanding in -#' that the 2-sigma range may also refer to the z-scale, which it does not! -#' Rather it applies only to the x-y-coordinate system (standardised error vs. -#' precision). A spread in doses or ages must be drawn as lines originating at -#' zero precision (x0) and zero standardised estimate (y0). Such a range may be -#' drawn by adding lines to the radial plot ( `line`, `line.col`, -#' `line.label`, cf. examples). -#' -#' A statistic summary, i.e. a collection of statistic measures of -#' centrality and dispersion (and further measures) can be added by specifying -#' one or more of the following keywords: -#' - `"n"` (number of samples), -#' - `"mean"` (mean De value), -#' - `"mean.weighted"` (error-weighted mean), -#' - `"median"` (median of the De values), -#' - `"sdrel"` (relative standard deviation in percent), -#' - `"sdrel.weighted"` (error-weighted relative standard deviation in percent), -#' - `"sdabs"` (absolute standard deviation), -#' - `"sdabs.weighted"` (error-weighted absolute standard deviation), -#' - `"serel"` (relative standard error), -#' - `"serel.weighted"` (error-weighted relative standard error), -#' - `"seabs"` (absolute standard error), -#' - `"seabs.weighted"` (error-weighted absolute standard error), -#' - `"in.2s"` (percent of samples in 2-sigma range), -#' - `"kurtosis"` (kurtosis) and -#' - `"skewness"` (skewness). -#' -#' @param data [data.frame] or [RLum.Results-class] object (**required**): -#' for `data.frame`: either two columns: De (`data[,1]`) and De error -#' (`data[,2]`), or one: De (`values[,1]`). If a single-column data frame -#' is provided, De error is assumed to be 10^-9 for all measurements. -#' To plot several data sets in one plot, the data sets must be provided as -#' `list`, e.g. `list(data.1, data.2)`. -#' -#' @param na.rm [logical] (*with default*): -#' excludes `NA` values from the data set prior to any further operations. -#' -#' @param log.z [logical] (*with default*): -#' Option to display the z-axis in logarithmic scale. Default is `TRUE`. -#' -#' @param central.value [numeric]: -#' User-defined central value, primarily used for horizontal centring -#' of the z-axis. -#' -#' @param centrality [character] or [numeric] (*with default*): -#' measure of centrality, used for automatically centring the plot and drawing -#' the central line. Can either be one out of -#' - `"mean"`, -#' - `"median"`, -#' - `"mean.weighted"` and -#' - `"median.weighted"` or a -#' - numeric value used for the standardisation. -#' -#' @param mtext [character]: -#' additional text below the plot title. -#' -#' @param summary [character] (*optional*): -#' add statistic measures of centrality and dispersion to the plot. -#' Can be one or more of several keywords. See details for available keywords. -#' -#' @param summary.pos [numeric] or [character] (*with default*): -#' optional position coordinates or keyword (e.g. `"topright"`) -#' for the statistical summary. Alternatively, the keyword `"sub"` may be -#' specified to place the summary below the plot header. However, this latter -#' option is only possible if `mtext` is not used. -#' -#' @param legend [character] vector (*optional*): -#' legend content to be added to the plot. -#' -#' @param legend.pos [numeric] or [character] (with -#' default): optional position coordinates or keyword (e.g. `"topright"`) -#' for the legend to be plotted. -#' -#' @param stats [character]: additional labels of statistically -#' important values in the plot. One or more out of the following: -#' - `"min"`, -#' - `"max"`, -#' - `"median"`. -#' -#' @param rug [logical]: -#' Option to add a rug to the z-scale, to indicate the location of individual values -#' -#' @param plot.ratio [numeric]: -#' User-defined plot area ratio (i.e. curvature of the z-axis). If omitted, -#' the default value (`4.5/5.5`) is used and modified automatically to optimise -#' the z-axis curvature. The parameter should be decreased when data points -#' are plotted outside the z-axis or when the z-axis gets too elliptic. -#' -#' @param bar.col [character] or [numeric] (*with default*): -#' colour of the bar showing the 2-sigma range around the central -#' value. To disable the bar, use `"none"`. Default is `"grey"`. -#' -#' @param y.ticks [logical]: -#' Option to hide y-axis labels. Useful for data with small scatter. -#' -#' @param grid.col [character] or [numeric] (*with default*): -#' colour of the grid lines (originating at `[0,0]` and stretching to -#' the z-scale). To disable grid lines, use `"none"`. Default is `"grey"`. -#' -#' @param line [numeric]: -#' numeric values of the additional lines to be added. -#' -#' @param line.col [character] or [numeric]: -#' colour of the additional lines. -#' -#' @param line.label [character]: -#' labels for the additional lines. -#' -#' @param output [logical]: -#' Optional output of numerical plot parameters. These can be useful to -#' reproduce similar plots. Default is `FALSE`. -#' -#' @param ... Further plot arguments to pass. `xlab` must be a vector of -#' length 2, specifying the upper and lower x-axes labels. -#' -#' @return Returns a plot object. -#' -#' @section Function version: 0.5.9 -#' -#' @author -#' Michael Dietze, GFZ Potsdam (Germany)\cr -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -#' Based on a rewritten S script of Rex Galbraith, 2010 -#' -#' @seealso [plot], [plot_KDE], [plot_Histogram], [plot_AbanicoPlot] -#' -#' @references -#' Galbraith, R.F., 1988. Graphical Display of Estimates Having -#' Differing Standard Errors. Technometrics, 30 (3), 271-281. -#' -#' Galbraith, R.F., 1990. The radial plot: Graphical assessment of spread in -#' ages. International Journal of Radiation Applications and Instrumentation. -#' Part D. Nuclear Tracks and Radiation Measurements, 17 (3), 207-214. -#' -#' Galbraith, R. & Green, P., 1990. Estimating the component ages in a finite -#' mixture. International Journal of Radiation Applications and -#' Instrumentation. Part D. Nuclear Tracks and Radiation Measurements, 17 (3) -#' 197-206. -#' -#' Galbraith, R.F. & Laslett, G.M., 1993. Statistical models for mixed fission -#' track ages. Nuclear Tracks And Radiation Measurements, 21 (4), 459-470. -#' -#' Galbraith, R.F., 1994. Some Applications of Radial Plots. Journal of the -#' American Statistical Association, 89 (428), 1232-1242. -#' -#' Galbraith, R.F., 2010. On plotting OSL equivalent doses. Ancient TL, 28 (1), -#' 1-10. -#' -#' Galbraith, R.F. & Roberts, R.G., 2012. Statistical aspects of equivalent -#' dose and error calculation and display in OSL dating: An overview and some -#' recommendations. Quaternary Geochronology, 11, 1-27. -#' -#' @examples -#' -#' ## load example data -#' data(ExampleData.DeValues, envir = environment()) -#' ExampleData.DeValues <- Second2Gray( -#' ExampleData.DeValues$BT998, c(0.0438,0.0019)) -#' -#' ## plot the example data straightforward -#' plot_RadialPlot(data = ExampleData.DeValues) -#' -#' ## now with linear z-scale -#' plot_RadialPlot( -#' data = ExampleData.DeValues, -#' log.z = FALSE) -#' -#' ## now with output of the plot parameters -#' plot1 <- plot_RadialPlot( -#' data = ExampleData.DeValues, -#' log.z = FALSE, -#' output = TRUE) -#' plot1 -#' plot1$zlim -#' -#' ## now with adjusted z-scale limits -#' plot_RadialPlot( -#' data = ExampleData.DeValues, -#' log.z = FALSE, -#' xlim = c(0, 5), -#' zlim = c(100, 200)) -#' -#' ## now the two plots with serious but seasonally changing fun -#' #plot_RadialPlot(data = data.3, fun = TRUE) -#' -#' ## now with user-defined central value, in log-scale again -#' plot_RadialPlot( -#' data = ExampleData.DeValues, -#' central.value = 150) -#' -#' ## now with a rug, indicating individual De values at the z-scale -#' plot_RadialPlot( -#' data = ExampleData.DeValues, -#' rug = TRUE) -#' -#' ## now with legend, colour, different points and smaller scale -#' plot_RadialPlot( -#' data = ExampleData.DeValues, -#' legend.text = "Sample 1", -#' col = "tomato4", -#' bar.col = "peachpuff", -#' pch = "R", -#' cex = 0.8) -#' -#' ## now without 2-sigma bar, y-axis, grid lines and central value line -#' plot_RadialPlot( -#' data = ExampleData.DeValues, -#' bar.col = "none", -#' grid.col = "none", -#' y.ticks = FALSE, -#' lwd = 0) -#' -#' ## now with user-defined axes labels -#' plot_RadialPlot( -#' data = ExampleData.DeValues, -#' xlab = c("Data error (%)", "Data precision"), -#' ylab = "Scatter", -#' zlab = "Equivalent dose [Gy]") -#' -#' ## now with minimum, maximum and median value indicated -#' plot_RadialPlot( -#' data = ExampleData.DeValues, -#' central.value = 150, -#' stats = c("min", "max", "median")) -#' -#' ## now with a brief statistical summary -#' plot_RadialPlot( -#' data = ExampleData.DeValues, -#' summary = c("n", "in.2s")) -#' -#' ## now with another statistical summary as subheader -#' plot_RadialPlot( -#' data = ExampleData.DeValues, -#' summary = c("mean.weighted", "median"), -#' summary.pos = "sub") -#' -#' ## now the data set is split into sub-groups, one is manipulated -#' data.1 <- ExampleData.DeValues[1:15,] -#' data.2 <- ExampleData.DeValues[16:25,] * 1.3 -#' -#' ## now a common dataset is created from the two subgroups -#' data.3 <- list(data.1, data.2) -#' -#' ## now the two data sets are plotted in one plot -#' plot_RadialPlot(data = data.3) -#' -#' ## now with some graphical modification -#' plot_RadialPlot( -#' data = data.3, -#' col = c("darkblue", "darkgreen"), -#' bar.col = c("lightblue", "lightgreen"), -#' pch = c(2, 6), -#' summary = c("n", "in.2s"), -#' summary.pos = "sub", -#' legend = c("Sample 1", "Sample 2")) -#' -#' @md -#' @export -plot_RadialPlot <- function( - data, - na.rm = TRUE, - log.z = TRUE, - central.value, - centrality = "mean.weighted", - mtext, - summary, - summary.pos, - legend, - legend.pos, - stats, - rug = FALSE, - plot.ratio, - bar.col, - y.ticks = TRUE, - grid.col, - line, - line.col, - line.label, - output = FALSE, - ... -) { - if (is(data, "list") && length(data) == 0) { - .throw_error("'data' is an empty list") - } - - ## Homogenise input data format - if(is(data, "list") == FALSE) {data <- list(data)} - - ## Check input data - for(i in 1:length(data)) { - if(is(data[[i]], "RLum.Results") == FALSE & - is(data[[i]], "data.frame") == FALSE) { - .throw_error("Error: Input data must be 'data.frame' or 'RLum.Results'") - } else { - if(is(data[[i]], "RLum.Results") == TRUE) { - data[[i]] <- get_RLum(data[[i]], "data") - } - - ## ensure that the dataset it not degenerate - if (nrow(data[[i]]) == 0) { - .throw_error("Input data ", i, " has 0 rows") - } - - ## if `data[[i]]` is a single-column data frame, append a second - ## column with a small non-zero value (10^-9 for consistency with - ## what `calc_Statistics() does) - if (ncol(data[[i]]) < 2) { - data[[i]] <- data.frame(data[[i]], 10^-9) - } else if (ncol(data[[i]]) > 2) { - ## keep only the first two columns - data[[i]] <- data[[i]][, 1:2] - } - } - } - - ## check data and parameter consistency-------------------------------------- - if(missing(stats) == TRUE) {stats <- numeric(0)} - if(missing(summary) == TRUE) { - summary <- c("n", "in.2s") - } - - if(missing(summary.pos) == TRUE) { - summary.pos <- "sub" - } - if(missing(bar.col) == TRUE) { - bar.col <- rep("grey80", length(data)) - } - - if(missing(grid.col) == TRUE) { - grid.col <- rep("grey70", length(data)) - } - - if(missing(mtext) == TRUE) { - mtext <- "" - } - - ## check z-axis log-option for grouped data sets - if(is(data, "list") == TRUE & length(data) > 1 & log.z == FALSE) { - .throw_warning("Option 'log.z' is not set to 'TRUE' altough ", - "more than one data set (group) is provided.") - } - - ## optionally, remove NA-values - if(na.rm == TRUE) { - for(i in 1:length(data)) { - data[[i]] <- na.exclude(data[[i]]) - } - } - - ## create preliminary global data set - De.global <- data[[1]][,1] - if(length(data) > 1) { - for(i in 2:length(data)) { - De.global <- c(De.global, data[[i]][,1]) - } - } - - ## calculate major preliminary tick values and tick difference - extraArgs <- list(...) - if("zlim" %in% names(extraArgs)) { - limits.z <- extraArgs$zlim - } else { - z.span <- (mean(De.global) * 0.5) / (sd(De.global) * 100) - z.span <- ifelse(z.span > 1, 0.9, z.span) - limits.z <- c((ifelse(test = min(De.global) <= 0, - yes = 1.1, - no = 0.9) - z.span) * min(De.global), - (1.1 + z.span) * max(De.global)) - } - - ## calculate correction dose to shift negative values - if(min(De.global) < 0 && log.z) { - if("zlim" %in% names(extraArgs)) { - De.add <- abs(extraArgs$zlim[1]) - } else { - ## estimate delta De to add to all data - De.add <- min(10^ceiling(log10(abs(De.global))) * 10) - - ## optionally readjust delta De for extreme values - if(De.add <= abs(min(De.global))) { - De.add <- De.add * 10 - } - } - } else { - De.add <- 0 - } - - ticks <- round(pretty(limits.z, n = 5), 3) - De.delta <- ticks[2] - ticks[1] - - ## optionally add correction dose to data set and adjust error - if(log.z) { - for(i in 1:length(data)) - data[[i]][,1] <- data[[i]][,1] + De.add - - De.global <- De.global + De.add - - } - - ## calculate major preliminary tick values and tick difference - extraArgs <- list(...) - if("zlim" %in% names(extraArgs)) { - limits.z <- extraArgs$zlim - } else { - z.span <- (mean(De.global) * 0.5) / (sd(De.global) * 100) - z.span <- ifelse(z.span > 1, 0.9, z.span) - limits.z <- c((ifelse(min(De.global) <= 0, 1.1, 0.9) - z.span) * min(De.global), - (1.1 + z.span) * max(De.global)) - - } - ticks <- round(pretty(limits.z, n = 5), 3) - De.delta <- ticks[2] - ticks[1] - - ## calculate and append statistical measures -------------------------------- - ## z-values based on log-option - z <- lapply(1:length(data), function(x){ - if(log.z == TRUE) {log(data[[x]][,1])} else {data[[x]][,1]}}) - - data <- lapply(1:length(data), function(x) { - cbind(data[[x]], z[[x]])}) - rm(z) - - ## calculate se-values based on log-option - se <- lapply(1:length(data), function(x, De.add){ - if(log.z == TRUE) { - if(De.add != 0) { - data[[x]][,2] <- data[[x]][,2] / (data[[x]][,1] + De.add) - } else { - data[[x]][,2] / data[[x]][,1] - } - } else { - data[[x]][,2] - }}, De.add = De.add) - - data <- lapply(1:length(data), function(x) { - cbind(data[[x]], se[[x]])}) - rm(se) - - ## calculate central values - if(centrality[1] == "mean") { - z.central <- lapply(1:length(data), function(x){ - rep(mean(data[[x]][,3], na.rm = TRUE), length(data[[x]][,3]))}) - } else if(centrality[1] == "median") { - z.central <- lapply(1:length(data), function(x){ - rep(median(data[[x]][,3], na.rm = TRUE), length(data[[x]][,3]))}) - } else if(centrality[1] == "mean.weighted") { - z.central <- lapply(1:length(data), function(x){ - sum(data[[x]][,3] / data[[x]][,4]^2) / - sum(1 / data[[x]][,4]^2)}) - } else if(centrality[1] == "median.weighted") { - ## define function after isotone::weighted.median - median.w <- function (y, w) - { - ox <- order(y) - y <- y[ox] - w <- w[ox] - k <- 1 - low <- cumsum(c(0, w)) - up <- sum(w) - low - df <- low - up - repeat { - if (df[k] < 0) - k <- k + 1 - else if (df[k] == 0) - return((w[k] * y[k] + w[k - 1] * y[k - 1]) / (w[k] + w[k - 1])) - else return(y[k - 1]) - } - } - z.central <- lapply(1:length(data), function(x){ - rep(median.w(y = data[[x]][,3], - w = data[[x]][,4]), length(data[[x]][,3]))}) - } else if(is.numeric(centrality) & length(centrality) == length(data)) { - z.central.raw <- if(log.z == TRUE) { - log(centrality + De.add) - } else { - centrality + De.add - } - z.central <- lapply(1:length(data), function(x){ - rep(z.central.raw[x], length(data[[x]][,3]))}) - } else if(is.numeric(centrality) == TRUE & - length(centrality) > length(data)) { - z.central <- lapply(1:length(data), function(x){ - rep(median(data[[x]][,3], na.rm = TRUE), length(data[[x]][,3]))}) - } else { - .throw_error("Measure of centrality not supported") - } - - data <- lapply(1:length(data), function(x) { - cbind(data[[x]], z.central[[x]])}) - rm(z.central) - - ## calculate precision - precision <- lapply(1:length(data), function(x){ - 1 / data[[x]][,4]}) - data <- lapply(1:length(data), function(x) { - cbind(data[[x]], precision[[x]])}) - rm(precision) - - ## calculate standard estimate - std.estimate <- lapply(1:length(data), function(x){ - (data[[x]][,3] - data[[x]][,5]) / data[[x]][,4]}) - data <- lapply(1:length(data), function(x) { - cbind(data[[x]], std.estimate[[x]])}) - - ## append empty standard estimate for plotting - data <- lapply(1:length(data), function(x) { - cbind(data[[x]], std.estimate[[x]])}) - rm(std.estimate) - - ## generate global data set - data.global <- cbind(data[[1]], - rep(x = 1, - times = nrow(data[[1]]))) - - colnames(data.global) <- rep("", 9) - - if(length(data) > 1) { - for(i in 2:length(data)) { - data.add <- cbind(data[[i]], - rep(x = i, times = nrow(data[[i]]))) - colnames(data.add) <- rep("", 9) - data.global <- rbind(data.global, - data.add) - } - } - - ## create column names - colnames(data.global) <- c( - "De", "error", "z", "se", "z.central", "precision", "std.estimate", - "std.estimate.plot") - -## calculate global central value -if(centrality[1] == "mean") { - z.central.global <- mean(data.global[,3], na.rm = TRUE) -} else if(centrality[1] == "median") { - z.central.global <- median(data.global[,3], na.rm = TRUE) -} else if(centrality[1] == "mean.weighted") { - z.central.global <- sum(data.global[,3] / data.global[,4]^2) / - sum(1 / data.global[,4]^2) -} else if(centrality[1] == "median.weighted") { - ## define function after isotone::weighted.mean - median.w <- function (y, w) - { - ox <- order(y) - y <- y[ox] - w <- w[ox] - k <- 1 - low <- cumsum(c(0, w)) - up <- sum(w) - low - df <- low - up - repeat { - if (df[k] < 0) - k <- k + 1 - else if (df[k] == 0) - return((w[k] * y[k] + w[k - 1] * y[k - 1])/(w[k] + w[k - 1])) - - else return(y[k - 1]) - } - } - z.central.global <- median.w(y = data.global[,3], w = data.global[,4]) -} else if(is.numeric(centrality) == TRUE & - length(centrality == length(data))) { - z.central.global <- mean(data.global[,3], na.rm = TRUE) -} - - ## optionally adjust central value by user-defined value - if(missing(central.value) == FALSE) { - # ## adjust central value for De.add - central.value <- central.value + De.add - - z.central.global <- ifelse(log.z == TRUE, - log(central.value), - central.value) - } - - ## create column names - for(i in 1:length(data)) { - colnames(data[[i]]) <- c("De", - "error", - "z", - "se", - "z.central", - "precision", - "std.estimate", - "std.estimate.plot") - } - - ## re-calculate standardised estimate for plotting - for(i in 1:length(data)) { - data[[i]][,8] <- (data[[i]][,3] - z.central.global) / data[[i]][,4] - } - - data.global.plot <- data[[1]][,8] - if(length(data) > 1) { - for(i in 2:length(data)) { - data.global.plot <- c(data.global.plot, data[[i]][,8]) - } - } - data.global[,8] <- data.global.plot - - ## print warning for too small scatter - if(max(abs(1 / data.global[6])) < 0.02) { - small.sigma <- TRUE - message("Attention, small standardised estimate scatter. ", - "Toggle off y.ticks?") - } - - ## read out additional arguments--------------------------------------------- - extraArgs <- list(...) - - main <- if("main" %in% names(extraArgs)) {extraArgs$main} else - {expression(paste(D[e], " distribution"))} - - sub <- if("sub" %in% names(extraArgs)) {extraArgs$sub} else {""} - - if("xlab" %in% names(extraArgs)) { - if(length(extraArgs$xlab) != 2) { - .throw_error("'xlab' must have length 2") - } else {xlab <- extraArgs$xlab} - } else { - xlab <- c(if(log.z == TRUE) { - "Relative standard error (%)" - } else { - "Standard error" - }, - "Precision") - } - - ylab <- if("ylab" %in% names(extraArgs)) { - extraArgs$ylab - } else { - "Standardised estimate" - } - - zlab <- if("zlab" %in% names(extraArgs)) { - extraArgs$zlab - } else { - expression(paste(D[e], " [Gy]")) - } - - if("zlim" %in% names(extraArgs)) { - limits.z <- extraArgs$zlim - } else { - z.span <- (mean(data.global[,1]) * 0.5) / (sd(data.global[,1]) * 100) - z.span <- ifelse(z.span > 1, 0.9, z.span) - limits.z <- c((0.9 - z.span) * min(data.global[[1]]), - (1.1 + z.span) * max(data.global[[1]])) - - } - - if("xlim" %in% names(extraArgs)) { - limits.x <- extraArgs$xlim - } else { - limits.x <- c(0, max(data.global[,6])) - } - - if(limits.x[1] != 0) { - limits.x[1] <- 0 - .throw_warning("Lower x-axis limit not set to zero, corrected") - } - - if("ylim" %in% names(extraArgs)) { - limits.y <- extraArgs$ylim - } else { - y.span <- (mean(data.global[,1]) * 10) / (sd(data.global[,1]) * 100) - y.span <- ifelse(y.span > 1, 0.98, y.span) - limits.y <- c(-(1 + y.span) * max(abs(data.global[,7])), - (0.8 + y.span) * max(abs(data.global[,7]))) - } - - cex <- if("cex" %in% names(extraArgs)) { - extraArgs$cex - } else { - 1 - } - - lty <- if("lty" %in% names(extraArgs)) { - extraArgs$lty - } else { - rep(2, length(data)) - } - - lwd <- if("lwd" %in% names(extraArgs)) { - extraArgs$lwd - } else { - rep(1, length(data)) - } - - pch <- if("pch" %in% names(extraArgs)) { - extraArgs$pch - } else { - rep(1, length(data)) - } - - col <- if("col" %in% names(extraArgs)) { - extraArgs$col - } else { - 1:length(data) - } - - tck <- if("tck" %in% names(extraArgs)) { - extraArgs$tck - } else { - NA - } - - tcl <- if("tcl" %in% names(extraArgs)) { - extraArgs$tcl - } else { - -0.5 - } - - show <- if("show" %in% names(extraArgs)) {extraArgs$show} else {TRUE} - if(show != TRUE) {show <- FALSE} - - fun <- if ("fun" %in% names(extraArgs)) extraArgs$fun else FALSE # nocov - - ## define auxiliary plot parameters ----------------------------------------- - - ## optionally adjust plot ratio - if(missing(plot.ratio)) { - if(log.z) { - plot.ratio <- 1 / (1 * ((max(data.global[,6]) - min(data.global[,6])) / - (max(data.global[,7]) - min(data.global[,7])))) - } else { - plot.ratio <- 4.5 / 5.5 - } - } - - ##limit plot ratio - plot.ratio <- min(c(1e+06, plot.ratio)) - - ## calculate conversion factor for plot coordinates - f <- (max(data.global[,6]) - min(data.global[,6])) / - (max(data.global[,7]) - min(data.global[,7])) * plot.ratio - - ## calculate major and minor z-tick values - tick.values.major <- signif(c(limits.z, pretty(limits.z, n = 5))) - tick.values.minor <- signif(pretty(limits.z, n = 25), 3) - - tick.values.major <- tick.values.major[tick.values.major >= - min(tick.values.minor)] - tick.values.major <- tick.values.major[tick.values.major <= - max(tick.values.minor)] - tick.values.major <- tick.values.major[tick.values.major >= - limits.z[1]] - tick.values.major <- tick.values.major[tick.values.major <= - limits.z[2]] - tick.values.minor <- tick.values.minor[tick.values.minor >= - limits.z[1]] - tick.values.minor <- tick.values.minor[tick.values.minor <= - limits.z[2]] - - if(log.z == TRUE) { - tick.values.major <- log(tick.values.major) - tick.values.minor <- log(tick.values.minor) - } - - ## calculate z-axis radius - r.x <- limits.x[2] / max(data.global[,6]) + 0.05 - r <- max(sqrt((data.global[,6])^2+(data.global[,7] * f)^2)) * r.x - - ## calculate major z-tick coordinates - tick.x1.major <- r / sqrt(1 + f^2 * ( - tick.values.major - z.central.global)^2) - - tick.y1.major <- (tick.values.major - z.central.global) * tick.x1.major - tick.x2.major <- (1 + 0.015 * cex) * r / sqrt( - 1 + f^2 * (tick.values.major - z.central.global)^2) - tick.y2.major <- (tick.values.major - z.central.global) * tick.x2.major - ticks.major <- cbind(0, - tick.x1.major, tick.x2.major, tick.y1.major, tick.y2.major) - - - ## calculate minor z-tick coordinates - tick.x1.minor <- r / sqrt(1 + f^2 * ( - tick.values.minor - z.central.global)^2) - tick.y1.minor <- (tick.values.minor - z.central.global) * tick.x1.minor - tick.x2.minor <- (1 + 0.007 * cex) * r / sqrt( - 1 + f^2 * (tick.values.minor - z.central.global)^2) - tick.y2.minor <- (tick.values.minor - z.central.global) * tick.x2.minor - ticks.minor <- cbind(tick.x1.minor, - tick.x2.minor, - tick.y1.minor, - tick.y2.minor) - - ## calculate z-label positions - label.x <- 1.03 * r / sqrt(1 + f^2 * - (tick.values.major - z.central.global)^2) - label.y <- (tick.values.major - z.central.global) * tick.x2.major - - ## create z-axes labels - if(log.z) { - label.z.text <- signif(exp(tick.values.major), 3) - - } else { - label.z.text <- signif(tick.values.major, 3) - - } - - ## subtract De.add from label values - if(De.add != 0) - label.z.text <- label.z.text - De.add - - labels <- cbind(label.x, label.y, label.z.text) - - ## calculate coordinates for 2-sigma-polygon overlay - polygons <- matrix(nrow = length(data), ncol = 8) - - for(i in 1:length(data)) { - polygons[i,1:4] <- c(limits.x[1], - limits.x[1], - max(data.global[,6]), - max(data.global[,6])) - polygons[i,5:8] <- c(-2, - 2, - (data[[i]][1,5] - z.central.global) * - polygons[i,3] + 2, - (data[[i]][1,5] - z.central.global) * - polygons[i,4] - 2) - } - - ## calculate node coordinates for semi-circle - user.limits <- if(log.z) log(limits.z) else limits.z - - ellipse.values <- seq( - from = min(c(tick.values.major, tick.values.minor, user.limits[1])), - to = max(c(tick.values.major,tick.values.minor, user.limits[2])), - length.out = 500) - ellipse.x <- r / sqrt(1 + f^2 * (ellipse.values - z.central.global)^2) - ellipse.y <- (ellipse.values - z.central.global) * ellipse.x - ellipse <- cbind(ellipse.x, ellipse.y) - ellipse.lims <- rbind(range(ellipse[,1]), range(ellipse[,2])) - - ## check if z-axis overlaps with 2s-polygon - polygon_y_max <- max(polygons[,7]) - polygon_y_min <- min(polygons[,7]) - - z_2s_upper <- ellipse.x[abs(ellipse.y - polygon_y_max) == - min(abs(ellipse.y - polygon_y_max))] - - z_2s_lower <- ellipse.x[abs(ellipse.y - polygon_y_min) == - min(abs(ellipse.y - polygon_y_min))] - - if(max(polygons[,3]) >= z_2s_upper | max(polygons[,3]) >= z_2s_lower) { - .throw_warning("z-scale touches 2s-polygon. Decrease plot ratio.") - } - - ## calculate statistical labels - if(length(stats == 1)) {stats <- rep(stats, 2)} - stats.data <- matrix(nrow = 3, ncol = 3) - data.stats <- as.numeric(data.global[,1]) - - if("min" %in% stats == TRUE) { - stats.data[1, 3] <- data.stats[data.stats == min(data.stats)][1] - stats.data[1, 1] <- data.global[data.stats == stats.data[1, 3], 6][1] - stats.data[1, 2] <- data.global[data.stats == stats.data[1, 3], 8][1] - } - - if("max" %in% stats == TRUE) { - stats.data[2, 3] <- data.stats[data.stats == max(data.stats)][1] - stats.data[2, 1] <- data.global[data.stats == stats.data[2, 3], 6][1] - stats.data[2, 2] <- data.global[data.stats == stats.data[2, 3], 8][1] - } - - if("median" %in% stats == TRUE) { - stats.data[3, 3] <- data.stats[data.stats == quantile(data.stats, 0.5, type = 3)] - stats.data[3, 1] <- data.global[data.stats == stats.data[3, 3], 6][1] - stats.data[3, 2] <- data.global[data.stats == stats.data[3, 3], 8][1] - } - - ## recalculate axes limits if necessary - limits.z.x <- range(ellipse[,1]) - limits.z.y <- range(ellipse[,2]) - if(!("ylim" %in% names(extraArgs))) { - if(limits.z.y[1] < 0.66 * limits.y[1]) { - limits.y[1] <- 1.8 * limits.z.y[1] - } - if(limits.z.y[2] > 0.77 * limits.y[2]) { - limits.y[2] <- 1.3 * limits.z.y[2] - } - } - if(!("xlim" %in% names(extraArgs))) { - if(limits.z.x[2] > 1.1 * limits.x[2]) { - limits.x[2] <- limits.z.x[2] - } - } - - ## calculate and paste statistical summary - De.stats <- matrix(nrow = length(data), ncol = 18) - colnames(De.stats) <- c("n", "mean", "mean.weighted", "median", "median.weighted", - "kde.max", "sd.abs", "sd.rel", "se.abs", "se.rel", "q25", "q75", "skewness", - "kurtosis", "sd.abs.weighted", "sd.rel.weighted", "se.abs.weighted", - "se.rel.weighted") - - for(i in 1:length(data)) { - data_to_stats <- data[[i]][,1:2] - - ## remove added De - if(log.z) data_to_stats$De <- data_to_stats$De - De.add - - statistics <- calc_Statistics(data = data_to_stats) - De.stats[i,1] <- statistics$weighted$n - De.stats[i,2] <- statistics$unweighted$mean - De.stats[i,3] <- statistics$weighted$mean - De.stats[i,4] <- statistics$unweighted$median - De.stats[i,5] <- statistics$unweighted$median - De.stats[i,7] <- statistics$unweighted$sd.abs - De.stats[i,8] <- statistics$unweighted$sd.rel - De.stats[i,9] <- statistics$unweighted$se.abs - De.stats[i,10] <- statistics$weighted$se.rel - De.stats[i,11] <- quantile(data[[i]][,1], 0.25) - De.stats[i,12] <- quantile(data[[i]][,1], 0.75) - De.stats[i,13] <- statistics$unweighted$skewness - De.stats[i,14] <- statistics$unweighted$kurtosis - De.stats[i,15] <- statistics$weighted$sd.abs - De.stats[i,16] <- statistics$weighted$sd.rel - De.stats[i,17] <- statistics$weighted$se.abs - De.stats[i,18] <- statistics$weighted$se.rel - - ## kdemax - here a little doubled as it appears below again - De.density <- try(density(x = data[[i]][,1], - kernel = "gaussian", - from = limits.z[1], - to = limits.z[2]), - silent = TRUE) - - if(!inherits(De.density, "try-error")) { - De.stats[i,6] <- NA - - } else { - De.stats[i,6] <- De.density$x[which.max(De.density$y)] - } - } - - label.text = list(NA) - - if(summary.pos[1] != "sub") { - n.rows <- length(summary) - - for(i in 1:length(data)) { - stops <- paste(rep("\n", (i - 1) * n.rows), collapse = "") - - summary.text <- character(0) - - for(j in 1:length(summary)) { - summary.text <- c(summary.text, - paste( - "", - ifelse("n" %in% summary[j] == TRUE, - paste("n = ", - De.stats[i,1], - "\n", - sep = ""), - ""), - ifelse("mean" %in% summary[j] == TRUE, - paste("mean = ", - round(De.stats[i,2], 2), - "\n", - sep = ""), - ""), - ifelse("mean.weighted" %in% summary[j] == TRUE, - paste("weighted mean = ", - round(De.stats[i,3], 2), - "\n", - sep = ""), - ""), - ifelse("median" %in% summary[j] == TRUE, - paste("median = ", - round(De.stats[i,4], 2), - "\n", - sep = ""), - ""), - ifelse("median.weighted" %in% summary[j] == TRUE, - paste("weighted median = ", - round(De.stats[i,5], 2), - "\n", - sep = ""), - ""), - ifelse("kdemax" %in% summary[j] == TRUE, - paste("kdemax = ", - round(De.stats[i,6], 2), - " \n ", - sep = ""), - ""), - ifelse("sdabs" %in% summary[j] == TRUE, - paste("sd = ", - round(De.stats[i,7], 2), - "\n", - sep = ""), - ""), - ifelse("sdrel" %in% summary[j] == TRUE, - paste("rel. sd = ", - round(De.stats[i,8], 2), " %", - "\n", - sep = ""), - ""), - ifelse("seabs" %in% summary[j] == TRUE, - paste("se = ", - round(De.stats[i,9], 2), - "\n", - sep = ""), - ""), - ifelse("serel" %in% summary[j] == TRUE, - paste("rel. se = ", - round(De.stats[i,10], 2), " %", - "\n", - sep = ""), - ""), - ifelse("skewness" %in% summary[j] == TRUE, - paste("skewness = ", - round(De.stats[i,13], 2), - "\n", - sep = ""), - ""), - ifelse("kurtosis" %in% summary[j] == TRUE, - paste("kurtosis = ", - round(De.stats[i,14], 2), - "\n", - sep = ""), - ""), - ifelse("in.2s" %in% summary[j] == TRUE, - paste("in 2 sigma = ", - round(sum(data[[i]][,7] > -2 & - data[[i]][,7] < 2) / - nrow(data[[i]]) * 100 , 1), - " %", - sep = ""), - ""), - ifelse("sdabs.weighted" %in% summary[j] == TRUE, - paste("abs. weighted sd = ", - round(De.stats[i,15], 2), - "\n", - sep = ""), - ""), - ifelse("sdrel.weighted" %in% summary[j] == TRUE, - paste("rel. weighted sd = ", - round(De.stats[i,16], 2), - "\n", - sep = ""), - ""), - ifelse("seabs.weighted" %in% summary[j] == TRUE, - paste("abs. weighted se = ", - round(De.stats[i,17], 2), - "\n", - sep = ""), - ""), - ifelse("serel.weighted" %in% summary[j] == TRUE, - paste("rel. weighted se = ", - round(De.stats[i,18], 2), - "\n", - sep = ""), - ""), - sep = "")) - } - - summary.text <- paste(summary.text, collapse = "") - - label.text[[length(label.text) + 1]] <- paste(stops, - summary.text, - stops, - sep = "") - } - } else { - for(i in 1:length(data)) { - - summary.text <- character(0) - - for(j in 1:length(summary)) { - summary.text <- c(summary.text, - ifelse("n" %in% summary[j] == TRUE, - paste("n = ", - De.stats[i,1], - " | ", - sep = ""), - ""), - ifelse("mean" %in% summary[j] == TRUE, - paste("mean = ", - round(De.stats[i,2], 2), - " | ", - sep = ""), - ""), - ifelse("mean.weighted" %in% summary[j] == TRUE, - paste("weighted mean = ", - round(De.stats[i,3], 2), - " | ", - sep = ""), - ""), - ifelse("median" %in% summary[j] == TRUE, - paste("median = ", - round(De.stats[i,4], 2), - " | ", - sep = ""), - ""), - ifelse("median.weighted" %in% summary[j] == TRUE, - paste("weighted median = ", - round(De.stats[i,5], 2), - " | ", - sep = ""), - ""), - ifelse("kdemax" %in% summary[j] == TRUE, - paste("kdemax = ", - round(De.stats[i,6], 2), - " | ", - sep = ""), - ""), - ifelse("sdrel" %in% summary[j] == TRUE, - paste("rel. sd = ", - round(De.stats[i,8], 2), " %", - " | ", - sep = ""), - ""), - ifelse("sdabs" %in% summary[j] == TRUE, - paste("abs. sd = ", - round(De.stats[i,7], 2), - " | ", - sep = ""), - ""), - ifelse("serel" %in% summary[j] == TRUE, - paste("rel. se = ", - round(De.stats[i,10], 2), " %", - " | ", - sep = ""), - ""), - ifelse("seabs" %in% summary[j] == TRUE, - paste("abs. se = ", - round(De.stats[i,9], 2), - " | ", - sep = ""), - ""), - ifelse("skewness" %in% summary[j] == TRUE, - paste("skewness = ", - round(De.stats[i,13], 2), - " | ", - sep = ""), - ""), - ifelse("kurtosis" %in% summary[j] == TRUE, - paste("kurtosis = ", - round(De.stats[i,14], 2), - " | ", - sep = ""), - ""), - ifelse("in.2s" %in% summary[j] == TRUE, - paste("in 2 sigma = ", - round(sum(data[[i]][,7] > -2 & - data[[i]][,7] < 2) / - nrow(data[[i]]) * 100 , 1), - " % ", - sep = ""), - ""), - ifelse("sdabs.weighted" %in% summary[j] == TRUE, - paste("abs. weighted sd = ", - round(De.stats[i,15], 2), " %", - " | ", - sep = ""), - ""), - ifelse("sdrel.weighted" %in% summary[j] == TRUE, - paste("rel. weighted sd = ", - round(De.stats[i,16], 2), " %", - " | ", - sep = ""), - ""), - ifelse("seabs.weighted" %in% summary[j] == TRUE, - paste("abs. weighted se = ", - round(De.stats[i,17], 2), " %", - " | ", - sep = ""), - ""), - ifelse("serel.weighted" %in% summary[j] == TRUE, - paste("rel. weighted se = ", - round(De.stats[i,18], 2), " %", - " | ", - sep = ""), - "") - ) - } - - summary.text <- paste(summary.text, collapse = "") - - label.text[[length(label.text) + 1]] <- paste( - " ", - summary.text, - sep = "") - } - - ## remove outer vertical lines from string - for(i in 2:length(label.text)) { - label.text[[i]] <- substr(x = label.text[[i]], - start = 3, - stop = nchar(label.text[[i]]) - 3) - } - } - -## remove dummy list element -label.text[[1]] <- NULL - ## convert keywords into summary placement coordinates - if(missing(summary.pos) == TRUE) { - summary.pos <- c(limits.x[1], limits.y[2]) - summary.adj <- c(0, 1) - } else if(length(summary.pos) == 2) { - summary.pos <- summary.pos - summary.adj <- c(0, 1) - } else if(summary.pos[1] == "topleft") { - summary.pos <- c(limits.x[1], limits.y[2]) - summary.adj <- c(0, 1) - } else if(summary.pos[1] == "top") { - summary.pos <- c(mean(limits.x), limits.y[2]) - summary.adj <- c(0.5, 1) - } else if(summary.pos[1] == "topright") { - summary.pos <- c(limits.x[2], limits.y[2]) - summary.adj <- c(1, 1) - } else if(summary.pos[1] == "left") { - summary.pos <- c(limits.x[1], mean(limits.y)) - summary.adj <- c(0, 0.5) - } else if(summary.pos[1] == "center") { - summary.pos <- c(mean(limits.x), mean(limits.y)) - summary.adj <- c(0.5, 0.5) - } else if(summary.pos[1] == "right") { - summary.pos <- c(limits.x[2], mean(limits.y)) - summary.adj <- c(1, 0.5) - }else if(summary.pos[1] == "bottomleft") { - summary.pos <- c(limits.x[1], limits.y[1]) - summary.adj <- c(0, 0) - } else if(summary.pos[1] == "bottom") { - summary.pos <- c(mean(limits.x), limits.y[1]) - summary.adj <- c(0.5, 0) - } else if(summary.pos[1] == "bottomright") { - summary.pos <- c(limits.x[2], limits.y[1]) - summary.adj <- c(1, 0) - } - - ## convert keywords into legend placement coordinates - if(missing(legend.pos) == TRUE) { - legend.pos <- c(limits.x[1], limits.y[2]) - legend.adj <- c(0, 1) - } else if(length(legend.pos) == 2) { - legend.pos <- legend.pos - legend.adj <- c(0, 1) - } else if(legend.pos[1] == "topleft") { - legend.pos <- c(limits.x[1], limits.y[2]) - legend.adj <- c(0, 1) - } else if(legend.pos[1] == "top") { - legend.pos <- c(mean(limits.x), limits.y[2]) - legend.adj <- c(0.5, 1) - } else if(legend.pos[1] == "topright") { - legend.pos <- c(limits.x[2], limits.y[2]) - legend.adj <- c(1, 1) - } else if(legend.pos[1] == "left") { - legend.pos <- c(limits.x[1], mean(limits.y)) - legend.adj <- c(0, 0.5) - } else if(legend.pos[1] == "center") { - legend.pos <- c(mean(limits.x), mean(limits.y)) - legend.adj <- c(0.5, 0.5) - } else if(legend.pos[1] == "right") { - legend.pos <- c(limits.x[2], mean(limits.y)) - legend.adj <- c(1, 0.5) - } else if(legend.pos[1] == "bottomleft") { - legend.pos <- c(limits.x[1], limits.y[1]) - legend.adj <- c(0, 0) - } else if(legend.pos[1] == "bottom") { - legend.pos <- c(mean(limits.x), limits.y[1]) - legend.adj <- c(0.5, 0) - } else if(legend.pos[1] == "bottomright") { - legend.pos <- c(limits.x[2], limits.y[1]) - legend.adj <- c(1, 0) - } - - ## calculate line coordinates and further parameters - if(!missing(line)) { - #line = line + De.add - - if(log.z == TRUE) {line <- log(line)} - - line.coords <- list(NA) - - for(i in 1:length(line)) { - line.x <- c(limits.x[1], - r / sqrt(1 + f^2 * (line[i] - z.central.global)^2)) - line.y <- c(0, (line[i] - z.central.global) * line.x[2]) - - line.coords[[length(line.coords) + 1]] <- rbind(line.x, line.y) - } - - line.coords[1] <- NULL - - if(missing(line.col) == TRUE) { - line.col <- seq(from = 1, to = length(line.coords)) - } - - if(missing(line.label) == TRUE) { - line.label <- rep("", length(line.coords)) - } - } - - ## calculate rug coordinates - if(missing(rug) == FALSE) { - if(log.z == TRUE) { - rug.values <- log(De.global) - } else { - rug.values <- De.global - } - - rug.coords <- list(NA) - - for(i in 1:length(rug.values)) { - rug.x <- c(r / sqrt(1 + f^2 * (rug.values[i] - z.central.global)^2) * 0.988, - r / sqrt(1 + f^2 * (rug.values[i] - z.central.global)^2) * 0.995) - rug.y <- c((rug.values[i] - z.central.global) * rug.x[1], - (rug.values[i] - z.central.global) * rug.x[2]) - rug.coords[[length(rug.coords) + 1]] <- rbind(rug.x, rug.y) - } - - rug.coords[1] <- NULL - } - - ## Generate plot ------------------------------------------------------------ - - ## check if plotting is enabled - if(show) { - - ## determine number of subheader lines to shift the plot - if(length(summary) > 0 & summary.pos[1] == "sub") { - shift.lines <- length(data) + 1 - } else {shift.lines <- 1} - - ## setup plot area - default <- par(mar = c(4, 4, shift.lines + 1.5, 7), - xpd = TRUE, - cex = cex) - - ## reset on exit - on.exit(par(default)) - - ## create empty plot - plot(NA, - xlim = limits.x, - ylim = limits.y, - main = "", - sub = sub, - xlab = "", - ylab = "", - xaxs = "i", - yaxs = "i", - frame.plot = FALSE, - axes = FALSE) - - ## add y-axis label - mtext(side = 2, - line = 2.5, - at = 0, - adj = 0.5, - cex = cex, - text = ylab) - - ## calculate upper x-axis label values - label.x.upper <- if(log.z == TRUE) { - as.character(round(1/axTicks(side = 1)[-1] * 100, 1)) - } else { - as.character(round(1/axTicks(side = 1)[-1], 1)) - } - - ## optionally, plot 2-sigma-bar - if(bar.col[1] != "none") { - for(i in 1:length(data)) { - polygon(x = polygons[i,1:4], - y = polygons[i,5:8], - lty = "blank", - col = bar.col[i]) - } - } - - ## optionally, add grid lines - if(grid.col[1] != "none") { - for(i in 1:length(tick.x1.major)) { - lines(x = c(limits.x[1], tick.x1.major[i]), - y = c(0, tick.y1.major[i]), - col = grid.col) - } - } - - ## optionally, plot central value lines - if(lwd[1] > 0 & lty[1] > 0) { - for(i in 1:length(data)) { - x2 <- r / sqrt(1 + f^2 * ( - data[[i]][1,5] - z.central.global)^2) - y2 <- (data[[i]][1,5] - z.central.global) * x2 - lines(x = c(limits.x[1], x2), - y = c(0, y2), - lty = lty[i], - lwd = lwd[i], - col = col[i]) - } - } - - ## optionally add further lines - if(missing(line) == FALSE) { - for(i in 1:length(line)) { - lines(x = line.coords[[i]][1,], - y = line.coords[[i]][2,], - col = line.col[i]) - text(x = line.coords[[i]][1,2], - y = line.coords[[i]][2,2] + par()$cxy[2] * 0.3, - labels = line.label[i], - pos = 2, - col = line.col[i], - cex = cex * 0.9) - } - } - - ## overplot unwanted parts - polygon(x = c(ellipse[,1], limits.x[2] * 2, limits.x[2] * 2), - y = c(ellipse[,2], max(ellipse[,2]), min(ellipse[,2])), - col = "white", - lty = 0) - - ## add plot title - title(main = main, line = shift.lines, font = 2) - - ## plot lower x-axis (precision) - x.axis.ticks <- axTicks(side = 1) - x.axis.ticks <- x.axis.ticks[c(TRUE, x.axis.ticks <= limits.x[2])] - x.axis.ticks <- x.axis.ticks[x.axis.ticks <= limits.x[2]] - - ## axis with lables and ticks - axis(side = 1, - at = x.axis.ticks, - lwd = 1, - xlab = "") - - ## extend axis line to right side of the plot - lines(x = c(max(x.axis.ticks, na.rm = TRUE), limits.x[2]), - y = c(limits.y[1], limits.y[1])) - - ## draw closing tick on right hand side - axis(side = 1, tcl = 0.5, lwd = 0, lwd.ticks = 1, at = limits.x[2], - labels = FALSE) - axis(side = 1, tcl = -0.5, lwd = 0, lwd.ticks = 1, at = limits.x[2], - labels = FALSE) - - ## add upper axis label - mtext(text = xlab[1], - at = (limits.x[1] + limits.x[2]) / 2, - side = 1, - line = -3.5, - cex = cex) - - ## add lower axis label - mtext(text = xlab[2], - at = (limits.x[1] + limits.x[2]) / 2, - side = 1, - line = 2.5, - cex = cex) - - ## plot upper x-axis - axis(side = 1, - tcl = 0.5, - lwd = 0, - lwd.ticks = 1, - at = x.axis.ticks[-1], - labels = FALSE) - - ## remove first tick label (infinity) - label.x.upper <- label.x.upper[1:(length(x.axis.ticks) - 1)] - - ## add tick labels - axis(side = 1, - lwd = 0, - labels = label.x.upper, - at = x.axis.ticks[-1], - line = -3) - - ## plot minor z-ticks - for(i in 1:length(tick.values.minor)) { - lines(x = c(tick.x1.minor[i], tick.x2.minor[i]), - y = c(tick.y1.minor[i], tick.y2.minor[i])) - } - - ## plot major z-ticks - for(i in 1:length(tick.values.major)) { - lines(x = c(tick.x1.major[i], tick.x2.major[i]), - y = c(tick.y1.major[i], tick.y2.major[i])) - } - - ## plot z-axis - lines(ellipse) - - ## plot z-values - text(x = label.x, - y = label.y, - label = label.z.text, 0) - - ## plot z-label - mtext(side = 4, - at = 0, - line = 5, - las = 3, - adj = 0.5, - cex = cex, - text = zlab) - - ## optionally add rug - if(rug == TRUE) { - for(i in 1:length(rug.coords)) { - lines(x = rug.coords[[i]][1,], - y = rug.coords[[i]][2,], - col = col[data.global[i,9]]) - } - } - - ## plot values - for(i in 1:length(data)) { - points(data[[i]][,6][data[[i]][,6] <= limits.x[2]], - data[[i]][,8][data[[i]][,6] <= limits.x[2]], - col = col[i], - pch = pch[i]) - } - - ## optionally add min, max, median sample text - if(length(stats) > 0) { - text(x = stats.data[,1], - y = stats.data[,2], - labels = round(stats.data[,3], 1), - pos = 2, - cex = 0.85) - } - - ## optionally add legend content - if(missing(legend) == FALSE) { - legend(x = legend.pos[1], - y = 0.8 * legend.pos[2], - xjust = legend.adj[1], - yjust = legend.adj[2], - legend = legend, - pch = pch, - col = col, - text.col = col, - cex = 0.8 * cex, - bty = "n") - } - - ## plot y-axis - if(y.ticks == TRUE) { - char.height <- par()$cxy[2] - tick.space <- axisTicks(usr = limits.y, log = FALSE) - tick.space <- (max(tick.space) - min(tick.space)) / length(tick.space) - if(tick.space < char.height * 1.5) { - axis(side = 2, at = c(-2, 2), labels = c("", ""), las = 1) - axis(side = 2, at = 0, tcl = 0, labels = paste("\u00B1", "2"), las = 1) - } else { - axis(side = 2, at = seq(-2, 2, by = 2), las = 2) - } - } else { - axis(side = 2, at = 0) - } - - ## optionally add subheader text - mtext(side = 3, - line = shift.lines - 2, - text = mtext, - cex = 0.8 * cex) - - ## add summary content - for(i in 1:length(data)) { - if(summary.pos[1] != "sub") { - text(x = summary.pos[1], - y = 0.8 * summary.pos[2], - adj = summary.adj, - labels = label.text[[i]], - cex = 0.8 * cex, - col = col[i]) - } else { - if(mtext == "") { - mtext(side = 3, - line = shift.lines - 1 - i, - text = label.text[[i]], - col = col[i], - cex = 0.8 * cex) - } - } - } - - ##FUN by R Luminescence Team - if (fun == TRUE) sTeve() # nocov - } - - if(output) { - return(list(data = data, - data.global = data.global, - xlim = limits.x, - ylim = limits.y, - zlim = limits.z, - r = r, - plot.ratio = plot.ratio, - ticks.major = ticks.major, - ticks.minor = ticks.minor, - labels = labels, - polygons = polygons, - ellipse.lims = ellipse.lims)) - } - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_Risoe.BINfileData.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_Risoe.BINfileData.R deleted file mode 100644 index aedde9475..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_Risoe.BINfileData.R +++ /dev/null @@ -1,259 +0,0 @@ -#' Plot single luminescence curves from a BIN file object -#' -#' Plots single luminescence curves from an object returned by the -#' [read_BIN2R] function. -#' -#' **Nomenclature** -#' -#' See [Risoe.BINfileData-class] -#' -#' **curve.transformation** -#' -#' This argument allows transforming continuous wave (CW) curves to pseudo -#' (linear) modulated curves. For the transformation, the functions of the -#' package are used. Currently, it is not possible to pass further arguments -#' to the transformation functions. The argument works only for `ltype` -#' `OSL` and `IRSL`. -#' -#' **Irradiation time** -#' -#' Plotting the irradiation time (s) or the given dose (Gy) requires that the -#' variable `IRR_TIME` has been set within the BIN-file. This is normally -#' done by using the 'Run Info' option within the Sequence Editor or by editing -#' in R. -#' -#' @param BINfileData [Risoe.BINfileData-class] (**required**): -#' requires an S4 object returned by the [read_BIN2R] function. -#' -#' @param position [vector] (*optional*): -#' option to limit the plotted curves by position -#' (e.g. `position = 1`, `position = c(1,3,5)`). -#' -#' @param run [vector] (*optional*): -#' option to limit the plotted curves by run -#' (e.g., `run = 1`, `run = c(1,3,5)`). -#' -#' @param set [vector] (*optional*): -#' option to limit the plotted curves by set -#' (e.g., `set = 1`, `set = c(1,3,5)`). -#' -#' @param sorter [character] (*with default*): -#' the plot output can be ordered by "POSITION","SET" or "RUN". -#' POSITION, SET and RUN are options defined in the Risoe Sequence Editor. -#' -#' @param ltype [character] (*with default*): -#' option to limit the plotted curves by the type of luminescence stimulation. -#' Allowed values: `"IRSL"`, `"OSL"`,`"TL"`, `"RIR"`, `"RBR"` -#' (corresponds to LM-OSL), `"RL"`. All type of curves are plotted by -#' default. -#' -#' @param curve.transformation [character] (*optional*): -#' allows transforming CW-OSL and CW-IRSL curves to pseudo-LM curves via -#' transformation functions. Allowed values are: `CW2pLM`, `CW2pLMi`, `CW2pHMi` and -#' `CW2pPMi`. See details. -#' -#' @param dose_rate [numeric] (*optional*): -#' dose rate of the irradiation source at the measurement date. -#' If set, the given irradiation dose will be shown in Gy. See details. -#' -#' @param temp.lab [character] (*optional*): -#' option to allow for different temperature units. If no value is set deg. C is chosen. -#' -#' @param cex.global [numeric] (*with default*): -#' global scaling factor. -#' -#' @param ... further undocumented plot arguments. -#' -#' @return Returns a plot. -#' -#' @note -#' The function has been successfully tested for the Sequence Editor file -#' output version 3 and 4. -#' -#' @section Function version: 0.4.1 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -#' Michael Dietze, GFZ Potsdam (Germany) -#' -#' @seealso [Risoe.BINfileData-class],[read_BIN2R], [CW2pLM], [CW2pLMi], -#' [CW2pPMi], [CW2pHMi] -#' -#' @references -#' Duller, G., 2007. Analyst. pp. 1-45. -#' -#' @keywords dplot -#' -#' @examples -#' -#' ##load data -#' data(ExampleData.BINfileData, envir = environment()) -#' -#' ##plot all curves from the first position to the desktop -#' #pdf(file = "~/Desktop/CurveOutput.pdf", paper = "a4", height = 11, onefile = TRUE) -#' -#' ##example - load from *.bin file -#' #BINfile<- file.choose() -#' #BINfileData<-read_BIN2R(BINfile) -#' -#' #par(mfrow = c(4,3), oma = c(0.5,1,0.5,1)) -#' #plot_Risoe.BINfileData(CWOSL.SAR.Data,position = 1) -#' #mtext(side = 4, BINfile, outer = TRUE, col = "blue", cex = .7) -#' #dev.off() -#' -#' @md -#' @export -plot_Risoe.BINfileData<- function( - BINfileData, - position, - run, - set, - sorter = "POSITION", - ltype = c("IRSL","OSL","TL","RIR","RBR","RL"), - curve.transformation, - dose_rate, - temp.lab, - cex.global = 1, - ... -){ - - ##check if the object is of type Risoe.BINfileData - if(!inherits(BINfileData, "Risoe.BINfileData")) - .throw_error("'object' is expected to be of type 'Risoe.BINfileData'") - - temp<-BINfileData - - # Missing check ---------------------------------------------------------------- - - ##set plot position if missing - if(missing(position)==TRUE){position<-c(min(temp@METADATA[,"POSITION"]):max(temp@METADATA[,"POSITION"]))} - if(missing(run)==TRUE){run<-c(min(temp@METADATA[,"RUN"]):max(temp@METADATA[,"RUN"]))} - if(missing(set)==TRUE){set<-c(min(temp@METADATA[,"SET"]):max(temp@METADATA[,"SET"]))} - - ##temp.lab - if(missing(temp.lab) == TRUE){temp.lab <- "\u00B0C"} - - - ##fun - extraArgs <- list(...) # read out additional arguments list - fun <- if ("fun" %in% names(extraArgs)) extraArgs$fun else FALSE # nocov - - # Ordering -------------------------------------------------------------------- - - ##(1) order by RUN, SET OR BY POSITION - if(sorter=="RUN"){ - temp@METADATA<-temp@METADATA[order(temp@METADATA[,"RUN"]),] - }else if(sorter=="SET"){ - temp@METADATA<-temp@METADATA[order(temp@METADATA[,"SET"]),] - }else { - temp@METADATA<-temp@METADATA[order(temp@METADATA[,"POSITION"]),] - } - - - - # Select values for plotting ------------------------------------------------------------------ - - ##(2) set SEL for selected position - - ##set all to FALSE - temp@METADATA[,"SEL"]<-FALSE - - ##set TRUE - temp@METADATA[(temp@METADATA[,"POSITION"] %in% position)==TRUE & - (temp@METADATA[,"RUN"] %in% run)==TRUE & - (temp@METADATA[,"SET"] %in% set)==TRUE & - (temp@METADATA[,"LTYPE"] %in% ltype)==TRUE,"SEL"]<-TRUE - - ##------------------------------------------------------------------------## - ##PLOTTING - ##------------------------------------------------------------------------## - ##(3) plot curves - for(i in 1:length(temp@METADATA[,"ID"])){ - - ##print only if SEL == TRUE - if(temp@METADATA[i,"SEL"]==TRUE) - { - - ##find measured unit - measured_unit<-if(temp@METADATA[i,"LTYPE"]=="TL"){" \u00B0C"}else{"s"} - - ##set x and y values - values.x <- seq(temp@METADATA[i,"HIGH"]/temp@METADATA[i,"NPOINTS"], - temp@METADATA[i,"HIGH"],by=temp@METADATA[i,"HIGH"]/temp@METADATA[i,"NPOINTS"]) - values.y <- unlist(temp@DATA[temp@METADATA[i,"ID"]]) - values.xy <- data.frame(values.x, values.y) - - ##set curve transformation if wanted - if((temp@METADATA[i,"LTYPE"] == "OSL" | temp@METADATA[i,"LTYPE"] == "IRSL") & - missing(curve.transformation) == FALSE){ - - if(curve.transformation=="CW2pLM"){ - - values.xy <- CW2pLM(values.xy) - - }else if(curve.transformation=="CW2pLMi"){ - - values.xy <- CW2pLMi(values.xy)[,1:2] - - }else if(curve.transformation=="CW2pHMi"){ - - values.xy <- CW2pHMi(values.xy)[,1:2] - - }else if(curve.transformation=="CW2pPMi"){ - - values.xy <- CW2pPMi(values.xy)[,1:2] - - }else{ - .throw_warning("Unknown 'curve.transformation', ", - "no transformation performed") - } - } - - ##plot graph - plot(values.xy, - main=paste("pos=", temp@METADATA[i,"POSITION"],", run=", temp@METADATA[i,"RUN"], - ", set=", temp@METADATA[i,"SET"],sep="" - ), - type="l", - ylab=paste(temp@METADATA[i,"LTYPE"]," [cts/",round(temp@METADATA[i,"HIGH"]/temp@METADATA[i,"NPOINTS"],digits=3)," ", - measured_unit,"]",sep=""), - xlab=if(measured_unit=="\u00B0C"){paste("temp. [",temp.lab,"]",sep="")}else{"time [s]"}, - col=if(temp@METADATA[i,"LTYPE"]=="IRSL" | temp@METADATA[i,"LTYPE"]=="RIR"){"red"} - else if(temp@METADATA[i,"LTYPE"]=="OSL" | temp@METADATA[i,"LTYPE"]=="RBR"){"blue"} - else{"black"}, - sub=if(temp@METADATA[i,"LTYPE"]=="TL"){paste("(",temp@METADATA[i,"RATE"]," K/s)",sep="")}else{}, - lwd=1.2*cex.global, - cex=0.9*cex.global - ) - - ##add mtext for temperature - - ##grep temperature (different for different verions) - - temperature<-if(temp@METADATA[i,"VERSION"]=="03"){temp@METADATA[i,"AN_TEMP"]} - else{temp@METADATA[i,"TEMPERATURE"]} - - ##mtext - mtext(side=3, - if(temp@METADATA[i,"LTYPE"]=="TL"){paste("TL to ",temp@METADATA[i,"HIGH"], " ",temp.lab,sep="")} - else{paste(temp@METADATA[i,"LTYPE"],"@",temperature," ",temp.lab ,sep="")}, - cex=0.9*cex.global) - - ##add mtext for irradiation - mtext(side=4,cex=0.8*cex.global, line=0.5, - if(temp@METADATA[i, "IRR_TIME"]!=0){ - - if(missing("dose_rate")==TRUE){ - paste("dose = ",temp@METADATA[i, "IRR_TIME"], " s", sep="") - }else{ - paste("dose = ",temp@METADATA[i, "IRR_TIME"]*dose_rate, " Gy", sep="") - } - } - )#end mtext - - }#endif::selection - - }#endforloop - - if (fun == TRUE) sTeve() # nocov -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_ViolinPlot.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_ViolinPlot.R deleted file mode 100644 index de3b8c4ef..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/plot_ViolinPlot.R +++ /dev/null @@ -1,264 +0,0 @@ -#' @title Create a violin plot -#' -#' @description -#' Draws a kernel density plot in combination with a boxplot in its middle. The shape of the violin -#' is constructed using a mirrored density curve. This plot is especially designed for cases -#' where the individual errors are zero or too small to be visualised. The idea for this plot is -#' based on the the 'volcano plot' in the ggplot2 package by Hadley Wickham and Winston Chang. -#' The general idea for the violin plot seems to have been introduced by -#' Hintze and Nelson (1998). -#' -#' The function is passing several arguments to the functions [plot], -#' [stats::density], [graphics::boxplot]: -#' -#' Supported arguments are: -#' `xlim`, `main`, `xlab`, `ylab`, `col.violin`, `col.boxplot`, `mtext`, `cex`, `mtext` -#' -#' **`Valid summary keywords`** -#' -#' `'n'`, `'mean'`, `'median'`, `'sd.abs'`, `'sd.rel'`, `'se.abs'`, `'se.rel'`. -#' `'skewness'`, `'kurtosis'` -#' -#' @param data [numeric] or [RLum.Results-class] (**required**): -#' input data for plotting. Alternatively a [data.frame] or a [matrix] can -#' be provided, but only the first column will be considered by the -#' function -#' -#' @param boxplot [logical] (*with default*): -#' enable or disable boxplot -#' -#' @param rug [logical] (*with default*): -#' enable or disable rug -#' -#' @param summary [character] (*optional*): -#' add statistic measures of centrality and dispersion to the plot. -#' Can be one or more of several keywords. See details for available keywords. -#' -#' @param summary.pos [numeric] or [character] (*with default*): -#' optional position keywords (cf. [legend]) for the statistical summary. -#' Alternatively, the keyword `"sub"` may be specified to place the summary -#' below the plot header. However, this latter option in only possible if -#' `mtext` is not used. -#' -#' @param na.rm [logical] (*with default*): -#' exclude NA values from the data set prior to any further operations. -#' -#' @param ... further arguments and graphical parameters passed to -#' [plot.default], [stats::density] and [boxplot]. See details for further information -#' -#' @note -#' Although the code for this function was developed independently and just the idea for the plot -#' was based on the 'ggplot2' package plot type 'volcano', it should be mentioned that, beyond this, -#' two other R packages exist providing a possibility to produces this kind of plot, namely: -#' `'vioplot'` and `'violinmplot'` (see references for details). -#' -#' @section Function version: 0.1.4 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @references -#' Daniel Adler (2005). vioplot: A violin plot is a combination of a box plot and a kernel density plot. -#' R package version 0.2 http://CRAN.R-project.org/package=violplot -#' -#' Hintze, J.L., Nelson, R.D., 1998. A Box Plot-Density Trace Synergism. The American Statistician 52, 181-184. -#' -#' Raphael W. Majeed (2012). violinmplot: Combination of violin plot with mean and standard deviation. -#' R package version 0.2.1. http://CRAN.R-project.org/package=violinmplot -#' -#' Wickham. H (2009). ggplot2: elegant graphics for data analysis. Springer New York. -#' -#' @seealso [stats::density], [plot], [boxplot], [rug], [calc_Statistics] -#' -#' @examples -#' -#' ## read example data set -#' data(ExampleData.DeValues, envir = environment()) -#' ExampleData.DeValues <- Second2Gray(ExampleData.DeValues$BT998, c(0.0438,0.0019)) -#' -#' ## create plot straightforward -#' plot_ViolinPlot(data = ExampleData.DeValues) -#' -#' @md -#' @export -plot_ViolinPlot <- function( - data, - boxplot = TRUE, - rug = TRUE, - summary = NULL, - summary.pos = "sub", - na.rm = TRUE, - ... -) { - - - # Integrity tests and conversion -------------------------------------------------------------- - - ##Prechecks - - if(missing(data)){ - .throw_error("I don't know what to do, data input needed.") - - }else{ - - ##check for RLum.Results object - if(is(data, "RLum.Results")){ - data <- get_RLum(data, "data") - } - - ##if data.frame or matrix - if(is(data, "data.frame") | is(data, "matrix")){ - data <- data[,1] - } - } - - ##Remove NA values - if(na.rm){ - data <- na.exclude(data) - - if(length(attr(data, "na.action")) > 0){ - .throw_warning(length(attr(data, "na.action")), " NA values removed") - } - } - - #Further checks - if(!is(summary.pos, "character")){ - .throw_error("'summary.pos' needs to be of type character") - } - - ##stop if only one or 0 values are left in data - if(length(data) == 0){ - .throw_warning("Actually it is rather hard to plot 0 values, returning") - return() - } - - # Pre-calculations ---------------------------------------------------------------------------- - - - ##density for the violin - if(length(data)>1){ - density <- - density(x = data, - bw = ifelse("bw" %in% names(list(...)),list(...)$bw,"nrd0")) - - }else{ - density <- NULL - .throw_warning("Single data point found, no density calculated") - } - - - ##some statistical parameter, get rid of the weighted statistics - stat.summary <- list(suppressWarnings(calc_Statistics(as.data.frame(data), digits = 2)[["unweighted"]])) - names(stat.summary) <- "unweighted" - - ##make valid summary string - if(is.null(summary)){ - summary <- c("n","median") - - } - - ##at least show a warning for invalid keywords - if(!all(summary %in% names(stat.summary[[1]]))){ - .throw_warning("Only keywords for weighted statistical measures ", - "are supported. Valid keywords are: ", - paste(names(stat.summary[[1]]), collapse = ", ")) - } - - ##make sure that only valid keywords make it - summary <- summary[(summary %in% names(stat.summary[[1]]))] - - stat.text <- .create_StatisticalSummaryText(stat.summary, keywords = summary, sep = " \n ") - stat.mtext <- .create_StatisticalSummaryText(stat.summary, keywords = summary, sep = " | ") - - - # Plot settings ------------------------------------------------------------------------------- - - ##set default values - plot.settings <- list( - xlim = if(!is.null(density)){range(density$x)}else{c(data[1]*0.9, data[1]*1.1)}, - main = "Violin Plot", - xlab = expression(paste(D[e], " [a.u.]")), - ylab = if(!is.null(density)){"Density"}else{" "}, - col.violin = rgb(0,0,0,0.2), - col.boxplot = NULL, - mtext = ifelse(summary.pos != 'sub', "", stat.mtext), - cex = 1 - ) - - ##modify list accordingly - plot.settings <- modifyList(plot.settings, val = list(...)) - - - # Plot ---------------------------------------------------------------------------------------- - - ##open empty plot area - plot( - NA,NA, - xlim = plot.settings$xlim, - ylim = c(0.2,1.8), - xlab = plot.settings$xlab, - ylab = plot.settings$ylab, - yaxt = "n", - main = plot.settings$main, - cex = plot.settings$cex - ) - - ##add polygon ... the violin - if(!is.null(density)){ - polygon( - x = c(density$x, rev(density$x)), - y = c(1 + density$y / max(density$y) * 0.5, - rev(1 - density$y / max(density$y) * 0.5)), - col = plot.settings$col.violin, - border = plot.settings$col.violin - ) - - - } - - ##add the boxplot - if(boxplot){ - boxplot( - data, - outline = TRUE, - boxwex = 0.4, - horizontal = TRUE, - axes = FALSE, - add = TRUE, - col = plot.settings$col.boxplot - ) - - } - - ##add rug - if(rug){ - rug(x = data) - - } - - ##add mtext - if(!is.null(plot.settings$mtext)){ - mtext(side = 3, text = plot.settings$mtext) - - } - - ##add stat.text - if (summary.pos != "sub") { - - valid_keywords <- - c( - "bottomright", "bottom", "bottomleft", "left", "topleft", "top", "topright", "right", "center" - ) - - if (any( - summary.pos %in% valid_keywords - )) { - legend(summary.pos, legend = stat.text, bty = "n") - - }else{ - .throw_warning("Value provided for 'summary.pos' is not ", - "a valid keyword, valid keywords are:", - paste(valid_keywords, collapse = ", ")) - } - } -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_BIN2R.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_BIN2R.R deleted file mode 100644 index c4aa9ae77..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_BIN2R.R +++ /dev/null @@ -1,1470 +0,0 @@ -#' @title Import Risø BIN/BINX-files into R -#' -#' @description Import a `*.bin` or a `*.binx` file produced by a Risø DA15 and DA20 TL/OSL -#' reader into R. -#' -#' @details -#' -#' The binary data file is parsed byte by byte following the data structure -#' published in the Appendices of the Analyst manual p. 42. -#' -#' For the general BIN/BINX-file structure, the reader is referred to the -#' Risø website: [https://www.fysik.dtu.dk]() -#' -#' @param file [character] or [list] (**required**): path and file name of the -#' BIN/BINX file (URLs are supported). If input is a `list` it should comprise -#' only `character`s representing each valid path and BIN/BINX-file names. -#' Alternatively the input character can be just a directory (path), in this case the -#' the function tries to detect and import all BIN/BINX files found in the directory. -#' -#' @param show.raw.values [logical] (*with default*): -#' shows raw values from BIN-file for `LTYPE`, `DTYPE` and `LIGHTSOURCE` without -#' translation in characters. Can be provided as `list` if `file` is a `list`. -#' -#' @param n.records [numeric] (*optional*): limits the number of imported records -#' to the provided record id (e.g., `n.records = 1:10` imports the first ten records, -#' while `n.records = 3` imports only record number 3. Can be used in combination with -#' `show.record.number` for debugging purposes, e.g. corrupt BIN-files. -#' Can be provided as `list` if `file` is a `list`. -#' -#' @param zero_data.rm [logical] (*with default*): -#' remove erroneous data with no count values. As such data are usually not -#' needed for the subsequent data analysis they will be removed by default. -#' Can be provided as `list` if `file` is a `list`. -#' -#' @param duplicated.rm [logical] (*with default*): -#' remove duplicated entries if `TRUE`. This may happen due to an erroneous -#' produced BIN/BINX-file. This option compares only predecessor and successor. -#' Can be provided as `list` if `file` is a `list`. -#' -#' @param position [numeric] (*optional*): -#' imports only the selected position. Note: the import performance will not -#' benefit by any selection made here. -#' Can be provided as `list` if `file` is a `list`. -#' -#' @param fastForward [logical] (*with default*): -#' if `TRUE` for a more efficient data processing only a list of `RLum.Analysis` -#' objects is returned instead of a [Risoe.BINfileData-class] object. -#' Can be provided as `list` if `file` is a `list`. -#' -#' @param show.record.number [logical] (*with default*): -#' shows record number of the imported record, for debugging usage only. -#' Can be provided as `list` if `file` is a `list`. -#' -#' @param txtProgressBar [logical] (*with default*): -#' enables or disables [txtProgressBar]. -#' -#' @param forced.VersionNumber [integer] (*optional*): -#' allows to cheat the version number check in the function by own values for -#' cases where the BIN-file version is not supported. -#' Can be provided as `list` if `file` is a `list`. -#' -#' **Note:** The usage is at own risk, only supported BIN-file versions have been tested. -#' -#' @param ignore.RECTYPE [logical] or [numeric] (*with default*): -#' this argument allows to ignore values in the byte 'RECTYPE' (BIN-file version 08), -#' in case there are not documented or faulty set. In this case the corrupted records are skipped. -#' If the setting is [numeric] (e.g., `ignore.RECTYPE = 128`), records of those type are ignored -#' for import. -#' -#' @param pattern [character] (*optional*): -#' argument that is used if only a path is provided. The argument will than be -#' passed to the function [list.files] used internally to construct a `list` -#' of wanted files -#' -#' @param verbose [logical] (*with default*): -#' enables or disables verbose mode -#' -#' @param ... further arguments that will be passed to the function -#' [Risoe.BINfileData2RLum.Analysis]. Please note that any matching argument -#' automatically sets `fastForward = TRUE` -#' -#' @return -#' Returns an S4 [Risoe.BINfileData-class] object containing two -#' slots: -#' -#' \item{METADATA}{A [data.frame] containing all variables stored in the BIN-file.} -#' \item{DATA}{A [list] containing a numeric [vector] of the measured data. -#' The ID corresponds to the record ID in METADATA.} -#' -#' If `fastForward = TRUE` a list of [RLum.Analysis-class] object is returned. The -#' internal coercing is done using the function [Risoe.BINfileData2RLum.Analysis] -#' -#' @note -#' The function works for BIN/BINX-format versions 03, 04, 05, 06, 07 and 08. The -#' version number depends on the used Sequence Editor. -#' -#' @section Function version: 0.17.3 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -#' Margret C. Fuchs, HZDR Freiberg, (Germany) \cr -#' based on information provided by Torben Lapp and Karsten Bracht Nielsen (Risø DTU, Denmark) -#' -#' -#' @seealso [write_R2BIN], [Risoe.BINfileData-class], -#' [base::readBin], [merge_Risoe.BINfileData], [RLum.Analysis-class] -#' [utils::txtProgressBar], [list.files] -#' -#' -#'@references -#'DTU Nutech, 2016. The Sequence Editor, Users Manual, February, 2016. -#'[https://www.fysik.dtu.dk]() -#' -#' -#'@keywords IO -#' -#'@examples -#' -#'file <- system.file("extdata/BINfile_V8.binx", package = "Luminescence") -#'temp <- read_BIN2R(file) -#'temp -#' -#' @md -#' @export -read_BIN2R <- function( - file, - show.raw.values = FALSE, - position = NULL, - n.records = NULL, - zero_data.rm = TRUE, - duplicated.rm = FALSE, - fastForward = FALSE, - show.record.number = FALSE, - txtProgressBar = TRUE, - forced.VersionNumber = NULL, - ignore.RECTYPE = FALSE, - pattern = NULL, - verbose = TRUE, - ... -){ - - # Self Call ----------------------------------------------------------------------------------- - # Option (a): Input is a list, every element in the list will be treated as file connection - # with that many file can be read in at the same time - # Option (b): The input is just a path, the function tries to grep ALL BIN/BINX files in the - # directory and import them, if this is detected, we proceed as list - if (is.character(file)) { - if (is.null(pattern)) { - ##If this is not really a path we skip this here - if (all(dir.exists(file)) & length(dir(file)) > 0) { - if (verbose) - message("[read_BIN2R()] Directory detected, trying to extract ", - "'*.bin'/'*.binx' files ...\n") - - ##get files - file <- as.list(list.files( - path = file, - recursive = FALSE, - pattern = "\\.bin*", - full.names = TRUE, - ignore.case = TRUE)) - } - - }else if(dir.exists(file)){ - file <- as.list(list.files(file, pattern = pattern, full.names = TRUE, recursive = TRUE)) - } - } - - if (is.list(file)) { - ##extend list of parameters - - ##position - position <- if(is.list(position)){ - rep(position, length = length(file)) - - }else{ - rep(list(position), length = length(file)) - } - - ##n.records - n.records <- if(is.list(n.records)){ - rep(n.records, length = length(file)) - - }else{ - rep(list(n.records), length = length(file)) - } - - ##zero_data.rm - zero_data.rm<- if(is.list(zero_data.rm)){ - rep(zero_data.rm, length = length(file)) - - }else{ - rep(list(zero_data.rm), length = length(file)) - } - - ##duplicated.rm - duplicated.rm <- if(is.list(duplicated.rm)){ - rep(duplicated.rm, length = length(file)) - - }else{ - rep(list(duplicated.rm), length = length(file)) - } - - ## show.raw.values - show.raw.values <- if(is.list(show.raw.values)){ - rep( show.raw.values, length = length(file)) - - }else{ - rep(list( show.raw.values), length = length(file)) - } - - ## show.record.number - show.record.number <- if(is.list(show.record.number)){ - rep(show.record.number, length = length(file)) - - }else{ - rep(list(show.record.number), length = length(file)) - } - - ##forced.VersionNumber - forced.VersionNumber <- if(is.list(forced.VersionNumber)){ - rep(forced.VersionNumber, length = length(file)) - - }else{ - rep(list(forced.VersionNumber), length = length(file)) - } - - temp.return <- lapply(1:length(file), function(x) { - temp <- read_BIN2R( - file = file[[x]], - fastForward = fastForward, - position = position[[x]], - n.records = n.records[[x]], - duplicated.rm = duplicated.rm[[x]], - show.raw.values = show.raw.values[[x]], - show.record.number = show.record.number[[x]], - txtProgressBar = txtProgressBar, - forced.VersionNumber = forced.VersionNumber[[x]], - ignore.RECTYPE = ignore.RECTYPE, - verbose = verbose, - ... - ) - }) - - ##return - if (fastForward) { - return(unlist(temp.return, recursive = FALSE)) - - }else{ - return(temp.return) - } - } - - # Config -------------------------------------------------------------------------------------- - ##set file_link for internet downloads - url_file <- NULL - on_exit <- function(){ - ##unlink internet connection - if(!is.null(url_file)){ - unlink(url_file) - } - - ##close connection - if(exists("con") && !is.null(con)){ - close(con) - } - } - on.exit(expr = on_exit()) - - ## check for URL and attempt download - if(verbose) - url_file <- .download_file(file, tempfile("read_BIN22R_FILE", fileext = ".binx")) - else - url_file <- suppressMessages(.download_file(file, tempfile("read_BIN22R_FILE", fileext = ".binx"))) - - if(!is.null(url_file)) - file <- url_file - - ## normalise path, just in case - file <- suppressWarnings(normalizePath(file)) - - ## check whether file exists - if(!file.exists(file)) - .throw_error("File does not exist") - - ## check if file is a BIN or BINX file - if(!any(tolower(tools::file_ext(file)) %in% c("bin", "binx"))) { - message("[read_BIN2R()] '", file, "' is not a file of type ", - "'BIN' or 'BINX', skipped and NULL returned") - con <- NULL - return(NULL) - } - - # Config ------------------------------------------------------------------ - ##set supported BIN format version - VERSIONS.supported <- as.raw(c(03, 04, 05, 06, 07, 08)) - - # Short file parsing to get number of records ------------------------------------------------- - #open connection - con <- file(file, "rb") - - ##get information about file size - file.size <- file.info(file) - - ##skip if zero-byte - if(file.size$size == 0){ - message("[read_BIN2R()] ", basename(file), " is a zero-byte file, ", - "NULL returned") - return(NULL) - } - - ##read data up to the end of con - ##set ID - temp.ID <- 0 - - ##start for BIN-file check up - while(length(temp.VERSION <- readBin(con, what="raw", 1, size=1, endian="little"))>0) { - ##force version number - if(!is.null(forced.VersionNumber)){ - temp.VERSION <- as.raw(forced.VersionNumber) - if (verbose) - message("[read_BIN2R()] 'forced.VersionNumber' set to ", temp.VERSION, - ", but this version may not match your input file") - } - - ##stop input if wrong VERSION - if (!temp.VERSION %in% VERSIONS.supported) { - if(temp.ID > 0){ - if(is.null(n.records)){ - .throw_warning("BIN-file appears to be corrupt, import limited ", - "to the first ", temp.ID, " records") - }else{ - .throw_warning("BIN-file appears to be corrupt, 'n.records' ", - "reset to ", temp.ID) - } - - ##set or reset n.records - n.records <- seq_len(temp.ID) - break() - - }else{ - .throw_error("BIN/BINX format version (", temp.VERSION, ") ", - "is not supported or file is broken. ", - "Supported version numbers are: ", - paste(VERSIONS.supported, collapse = ", ")) - } - } - - #empty byte position - EMPTY <- readBin(con, what = "raw", 1, size = 1, endian = "little") - - ## get record LENGTH - if(temp.VERSION == 06 | temp.VERSION == 07 | temp.VERSION == 08){ - temp.LENGTH <- readBin(con, what = "int", 1, size = 4, endian = "little") - STEPPING <- readBin(con, what = "raw", n = max(0, temp.LENGTH - 6), - size = 1, endian = "little") - }else{ - temp.LENGTH <- readBin(con, what = "int", 1, size = 2, endian = "little") - STEPPING <- readBin(con, what = "raw", n = max(0, temp.LENGTH - 4), - size = 1, endian = "little") - } - - ## STEPPING has 0 length when we have read for a length n = 0 - if (length(STEPPING) == 0) { - if (verbose) - message("\n[read_BIN2R()] Record #", temp.ID + 1, - " skipped due to wrong record length") - next() - } - temp.ID <- temp.ID + 1 - } - - ##set n.length we will need it later - n.length <- temp.ID - if (n.length == 0) { - .throw_warning("0 records read, NULL returned") - return(NULL) - } - - rm(temp.ID) - close(con) ##we have to close the connection here - -# Set Lookup tables -------------------------------------------------------------------------- - - ##LTYPE - LTYPE.lookup <- c( - "0" = "TL", - "1" = "OSL", - "2" = "IRSL", - "3" = "M-IR", - "4" = "M-VIS", - "5" = "TOL", - "6" = "TRPOSL", - "7" = "RIR", - "8" = "RBR", - "9" = "USER", - "10" = "POSL", - "11" = "SGOSL", - "12" = "RL", - "13" = "XRF" - ) - - ##DTYPE - DTYPE.lookup <- - c( - "0" = "Natural", - "1" = "N+dose", - "2" = "Bleach", - "3" = "Bleach+dose", - "4" = "Natural (Bleach)", - "5" = "N+dose (Bleach)", - "6" = "Dose", - "7" = "Background" - ) - - ##LIGHTSOURCE - LIGHTSOURCE.lookup <- c( - "0" = "None", - "1" = "Lamp", - "2" = "IR diodes/IR Laser", - "3" = "Calibration LED", - "4" = "Blue Diodes", - "5" = "White light", - "6" = "Green laser (single grain)", - "7" = "IR laser (single grain)" - ) - - - ##PRESET VALUES - temp.CURVENO <- NA - temp.FNAME <- NA - temp.MEASTEMP <- NA - temp.IRR_UNIT <- NA - temp.IRR_DOSERATE <- NA - temp.IRR_DOSERATEERR <- NA - temp.TIMESINCEIRR <- NA - temp.TIMETICK <- NA - temp.ONTIME <- NA - temp.OFFTIME <- NA - temp.STIMPERIOD <- NA - temp.GATE_ENABLED <- raw(length = 1) - temp.ENABLE_FLAGS <- raw(length = 1) - temp.GATE_START <- NA - temp.GATE_STOP <- NA - temp.GATE_END <- NA - temp.PTENABLED <- raw(length = 1) - temp.DTENABLED <- raw(length = 1) - temp.DEADTIME <- NA - temp.MAXLPOWER <- NA - temp.XRF_ACQTIME <- NA - temp.XRF_HV <- NA - temp.XRF_CURR <- NA - temp.XRF_DEADTIMEF <- NA - temp.DETECTOR_ID <- NA - temp.LOWERFILTER_ID <- NA - temp.UPPERFILTER_ID <- NA - temp.ENOISEFACTOR <- NA - temp.SEQUENCE <- NA - temp.GRAIN <- NA - temp.GRAINNUMBER <- NA - temp.LIGHTPOWER <- NA - temp.LPOWER <- NA - temp.RECTYPE <- 0 - temp.MARKPOS_X1 <- NA - temp.MARKPOS_Y1 <- NA - temp.MARKPOS_X2 <- NA - temp.MARKPOS_Y2 <- NA - temp.MARKPOS_X3 <- NA - temp.MARKPOS_Y3 <- NA - temp.EXTR_START <- NA - temp.EXTR_END <- NA - - ## set TIME_SIZE - TIME_SIZE <- 0 - - ##overwrite length if required - if(!is.null(n.records)) - n.length <- length(n.records) - - ## set index for entry row in table - id_row <- 1 - - ##initialise data.frame - results.METADATA <- data.table::data.table( - ##1 to 7 - ID = integer(length = n.length), - SEL = logical(length = n.length), - VERSION = numeric(length = n.length), - LENGTH = integer(length = n.length), - PREVIOUS = integer(length = n.length), - NPOINTS = integer(length = n.length), - RECTYPE = integer(length = n.length), - - #8 to 17 - RUN = integer(length = n.length), - SET = integer(length = n.length), - POSITION = integer(length = n.length), - GRAIN = integer(length = n.length), - GRAINNUMBER = integer(length = n.length), - CURVENO = integer(length = n.length), - XCOORD = integer(length = n.length), - YCOORD = integer(length = n.length), - SAMPLE = character(length = n.length), - COMMENT = character(length = n.length), - - #18 to 22 - SYSTEMID = integer(length = n.length), - FNAME = character(length = n.length), - USER = character(length = n.length), - TIME = character(length = n.length), - DATE = character(length = n.length), - - ##23 to 31 - DTYPE = character(length = n.length), - BL_TIME = numeric(length = n.length), - BL_UNIT = integer(length = n.length), - NORM1 = numeric(length = n.length), - NORM2 = numeric(length = n.length), - NORM3 = numeric(length = n.length), - BG = numeric(length = n.length), - SHIFT = integer(length = n.length), - TAG = integer(length = n.length), - - ##32 to 67 - LTYPE = character(length = n.length), - LIGHTSOURCE = character(length = n.length), - LPOWER = numeric(length = n.length), - LIGHTPOWER = numeric(length = n.length), - LOW = numeric(length = n.length), - HIGH = numeric(length = n.length), - RATE = numeric(length = n.length), - TEMPERATURE = numeric(length = n.length), - MEASTEMP = numeric(length = n.length), - AN_TEMP = numeric(length = n.length), - AN_TIME = numeric(length = n.length), - TOLDELAY = integer(length = n.length), - TOLON = integer(length = n.length), - TOLOFF = integer(length = n.length), - IRR_TIME = numeric(length = n.length), - IRR_TYPE = integer(length = n.length), - IRR_UNIT = integer(length = n.length), - IRR_DOSERATE = numeric(length = n.length), - IRR_DOSERATEERR = numeric(length = n.length), - TIMESINCEIRR = numeric(length = n.length), - TIMETICK = numeric(length = n.length), - ONTIME = numeric(length = n.length), - OFFTIME = numeric(length = n.length), - STIMPERIOD = integer(length = n.length), - GATE_ENABLED = numeric(length = n.length), - ENABLE_FLAGS = numeric(length = n.length), - GATE_START = numeric(length = n.length), - GATE_STOP = numeric(length = n.length), - PTENABLED = numeric(length = n.length), - DTENABLED = numeric(length = n.length), - DEADTIME = numeric(length = n.length), - MAXLPOWER = numeric(length = n.length), - XRF_ACQTIME = numeric(length = n.length), - XRF_HV = numeric(length = n.length), - XRF_CURR = numeric(length = n.length), - XRF_DEADTIMEF = numeric(length = n.length), - - #68 to 79 - DETECTOR_ID = integer(length = n.length), - LOWERFILTER_ID = integer(length = n.length), - UPPERFILTER_ID = integer(length = n.length), - ENOISEFACTOR = numeric(length = n.length), - MARKPOS_X1 = numeric(length = n.length), - MARKPOS_Y1 = numeric(length = n.length), - MARKPOS_X2 = numeric(length = n.length), - MARKPOS_Y2 = numeric(length = n.length), - MARKPOS_X3 = numeric(length = n.length), - MARKPOS_Y3 = numeric(length = n.length), - EXTR_START = numeric(length = n.length), - EXTR_END = numeric(length = n.length), - - ##80 - SEQUENCE = character(length = n.length) - - ) #end set data table - - - #set variable for DPOINTS handling - results.DATA <- list() - - ##set list for RESERVED values - results.RESERVED <- rep(list(list()), n.length) - - # Open Connection --------------------------------------------------------- - - #open connection - con <- file(file, "rb") - - ##get information about file size - file.size <- file.info(file) - - ##output - if(verbose) { - file_name <- file - len_str <- nchar(basename(file_name)) - if(len_str > 50) - file_name <- paste0( - substr(basename(file_name), start = 1, stop = 10), - "...", - substr(basename(file_name), start = len_str - 40, stop = len_str)) - - cat("\n[read_BIN2R()]\n path: ", dirname(file)) - cat("\n file: ", file_name) - cat("\n n_rec:", n.length, fill = TRUE) - } - - ##set progress bar - if(txtProgressBar & verbose){ - pb <- txtProgressBar(min=0 ,max = file.size$size, char="=", style=3) - } - - ##read data up to the end of con - - ##set ID - temp.ID <- 0 - - # LOOP -------------------------------------------------------------------- - ##start loop for import BIN data - while(length(temp.VERSION <- readBin(con, what="raw", 1, size=1, endian="little"))>0) { - - ##force version number - if(!is.null(forced.VersionNumber)){ - temp.VERSION <- as.raw(forced.VersionNumber) - } - - ##print record ID for debugging purposes - if(verbose){ - if(show.record.number == TRUE){ - cat(temp.ID,",", sep = "") - if(temp.ID%%10==0){ - cat("\n") - } - } - } - - #empty byte position - EMPTY <- readBin(con, what="raw", 1, size=1, endian="little") - - # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - # BINX FORMAT SUPPORT ----------------------------------------------------- - if(temp.VERSION == 05 | temp.VERSION == 06 | temp.VERSION == 07 | temp.VERSION == 08){ - ##(1) Header size and structure - ##LENGTH, PREVIOUS, NPOINTS, LTYPE - temp <- readBin(con, what = "int", 3, size = 4, endian = "little") - temp.LENGTH <- temp[1] - temp.PREVIOUS <- temp[2] - temp.NPOINTS <- temp[3] - - ## skip record if not selected - ## the first condition boosts the speed of reading if n.records is not - ## used; otherwise for each record the condition is checked whether - ## used or not. - if(!is.null(n.records) && !(temp.ID + 1) %in% n.records) { - temp.ID <- temp.ID + 1 - readBin(con, what = "raw", n = temp.LENGTH - 14, size = 1, endian = "little") - next() - } - - #for temp.VERSION == 08 - #RECTYPE - if(temp.VERSION == 08){ - temp.RECTYPE <- readBin(con, what = "int", 1, size = 1, endian = "little", signed = FALSE) - - ## we can check for a specific value for temp.RECTYPE - if(inherits(ignore.RECTYPE[1], "numeric") && temp.RECTYPE == ignore.RECTYPE[1]) { - STEPPING <- readBin(con, what = "raw", size = 1, n = temp.LENGTH - 15) - if(verbose) - message("\n[read_BIN2R()] Record #", temp.ID + 1, - " skipped due to ignore.RECTYPE setting") - next() - } - - if(temp.RECTYPE != 0 & temp.RECTYPE != 1 & temp.RECTYPE != 128) { - ##jump to the next record by stepping the record length minus the already read bytes - STEPPING <- readBin(con, what = "raw", size = 1, n = temp.LENGTH - 15) - if(!ignore.RECTYPE){ - .throw_error("Byte RECTYPE = ", temp.RECTYPE, - " is not supported in record #", temp.ID + 1, ", ", - "check your BIN/BINX file") - } else { - if(verbose) - message("\n[read_BIN2R()] Byte RECTYPE = ", temp.RECTYPE, - " is not supported in record #", temp.ID + 1, - ", record skipped") - - ## update and jump to next record, to avoid further trouble - ## we set the VERSION to NA and remove it later, otherwise we - ## break expected functionality - temp.ID <- temp.ID + 1 - results.METADATA[temp.ID,`:=` (VERSION = NA)] - next() - } - } - } - - ## RECTYPE == 128 - ## If the RECTYPE is 128, only the the header bytes until here make any sense, - ## the rest are just random bytes (e-mail K.B., 2024-07-04) - ## the header length is 507, hence we have to jump 507 - 15 to get - ## the data - ## This is a very ugly construction and the function should be refactored - if (temp.RECTYPE == 128){ - readBin(con, what = "raw", size = 1, n = 492) - - } else { - ##(2) Sample characteristics - ##RUN, SET, POSITION, GRAINNUMBER, CURVENO, XCOORD, YCOORD - temp <- readBin(con, what = "int", 7, size = 2, endian = "little") - temp.RUN <- temp[1] - temp.SET <- temp[2] - temp.POSITION <- temp[3] - temp.GRAINNUMBER <- temp[4] - temp.CURVENO <- temp[5] - temp.XCOORD <- temp[6] - temp.YCOORD <- temp[7] - - ##SAMPLE, COMMENT - ##SAMPLE - SAMPLE_SIZE <- readBin(con, what="int", 1, size=1, endian="little") - temp.SAMPLE <- readChar(con, SAMPLE_SIZE, useBytes = TRUE) - - #however it should be set to 20 - - #step forward in con - if(20-c(SAMPLE_SIZE)>0){ - STEPPING<-readBin(con, what="raw", (20-c(SAMPLE_SIZE)), - size=1, endian="little") - } - - ##COMMENT - COMMENT_SIZE<-readBin(con, what="int", 1, size=1, endian="little") - temp.COMMENT <- suppressWarnings( - readChar(con, COMMENT_SIZE, useBytes=TRUE)) #set to 80 (manual) - - #step forward in con - if(80-c(COMMENT_SIZE)>0){ - STEPPING<-readBin(con, what="raw", (80-c(COMMENT_SIZE)), - size=1, endian="little") - } - - ##(3) Instrument and sequence characteristic - ##SYSTEMID - temp.SYSTEMID <- readBin(con, what="int", 1, size=2, endian="little") - - ##FNAME - FNAME_SIZE <- readBin(con, what="int", 1, size=1, endian="little") - - ##correct for 0 file name length - if(length(FNAME_SIZE)>0){ - temp.FNAME<-readChar(con, FNAME_SIZE, useBytes=TRUE) #set to 100 (manual) - }else{ - FNAME_SIZE <- 0 - } - - #step forward in con - if(100-c(FNAME_SIZE)>0){ - STEPPING<-readBin(con, what="raw", (100-c(FNAME_SIZE)), - size=1, endian="little") - } - - ##USER - USER_SIZE<-readBin(con, what="int", 1, size=1, endian="little") - - ##correct for 0 user size length - if (length(USER_SIZE) > 0) { - temp.USER <- - suppressWarnings(readChar(con, USER_SIZE, useBytes = TRUE)) #set to 30 (manual) - }else{ - USER_SIZE <- 0 - - } - - #step forward in con - if(30-c(USER_SIZE)>0){ - STEPPING<-readBin(con, what="raw", (30-c(USER_SIZE)), - size=1, endian="little") - } - - ##TIME - TIME_SIZE <- readBin(con, what="int", 1, size=1, endian="little") - - ##time size corrections for wrong time formats; set n to 6 for all values - ##according to the handbook by Geoff Duller, 2007 - if(length(TIME_SIZE)>0){ - temp.TIME<-readChar(con, TIME_SIZE, useBytes=TRUE) - - ##correct the mess by others - if(nchar(temp.TIME) == 5) - temp.TIME <- paste(c("0", temp.TIME), collapse = "") - - }else{ - TIME_SIZE <- 0 - } - - if(6-TIME_SIZE>0){ - STEPPING<-readBin(con, what="raw", (6-TIME_SIZE), - size=1, endian="little") - } - - - ##DATE - DATE_SIZE<-readBin(con, what="int", 1, size=1, endian="little") - - ##date size corrections for wrong date formats; set n to 6 for all values - ##according to the handbook of Geoff Duller, 2007 - DATE_SIZE<-6 - temp.DATE <- suppressWarnings(readChar(con, DATE_SIZE, useBytes = TRUE)) - - ##(4) Analysis - ##DTYPE - temp.DTYPE<-readBin(con, what="int", 1, size=1, endian="little") - - ##BL_TIME - temp.BL_TIME<-readBin(con, what="double", 1, size=4, endian="little") - - ##BL_UNIT - temp.BL_UNIT<-readBin(con, what="int", 1, size=1, endian="little") - - ##NORM1, NORM2, NORM3, BG - temp <- readBin(con, what="double", 4, size=4, endian="little") - - temp.NORM1 <- temp[1] - temp.NORM2 <- temp[2] - temp.NORM3 <- temp[3] - temp.BG <- temp[4] - - ##SHIFT - temp.SHIFT<- readBin(con, what="integer", 1, size=2, endian="little") - - ##TAG - temp.TAG <- readBin(con, what="int", 1, size=1, endian="little") - - ##RESERVED - temp.RESERVED1 <-readBin(con, what="raw", 20, size=1, endian="little") - - ##(5) Measurement characteristics - - ##LTYPE - temp.LTYPE <- readBin(con, what="int", 1, size=1, endian="little") - - ##LTYPESOURCE - temp.LIGHTSOURCE <- readBin(con, what="int", 1, size=1, endian="little") - - ##LIGHTPOWER, LOW, HIGH, RATE - temp <- readBin(con, what="double", 4, size=4, endian="little") - - temp.LIGHTPOWER <- temp[1] - temp.LOW <- temp[2] - temp.HIGH <- temp[3] - temp.RATE <- temp[4] - - ##TEMPERATURE - temp.TEMPERATURE <- readBin(con, what="int", 1, size=2, endian="little") - - ##MEASTEMP - temp.MEASTEMP <- readBin(con, what="integer", 1, size=2, endian="little") - - ##AN_TEMP - temp.AN_TEMP <- readBin(con, what="double", 1, size=4, endian="little") - - ##AN_TIME - temp.AN_TIME <- readBin(con, what="double", 1, size=4, endian="little") - - ##DELAY, ON, OFF - temp <- readBin(con, what="int", 3, size=2, endian="little") - - temp.TOLDELAY <- temp[1] - temp.TOLON <- temp[2] - temp.TOLOFF <- temp[3] - - ##IRR_TIME - temp.IRR_TIME <- readBin(con, what="double", 1, size=4, endian="little") - - ##IRR_TYPE - temp.IRR_TYPE <- readBin(con, what="int", 1, size=1, endian="little") - - ##IRR_DOSERATE - temp.IRR_DOSERATE <- readBin(con, what="double", 1, size=4, endian="little") - - ##IRR_DOSERATEERR - if(temp.VERSION != 05) - temp.IRR_DOSERATEERR <- readBin(con, what="double", 1, size=4, endian="little") - - ##TIMESINCEIRR - temp.TIMESINCEIRR <- readBin(con, what="integer", 1, size=4, endian="little") - - ##TIMETICK - temp.TIMETICK <- readBin(con, what="double", 1, size=4, endian="little") - - ##ONTIME - temp.ONTIME <- readBin(con, what="integer", 1, size=4, endian="little") - - ##STIMPERIOD - temp.STIMPERIOD <- readBin(con, what="integer", 1, size=4, endian="little") - - ##GATE_ENABLED - temp.GATE_ENABLED <- readBin(con, what="raw", 1, size=1, endian="little") - - ##GATE_START - temp.GATE_START <- readBin(con, what="integer", 1, size=4, endian="little") - - ##GATE_STOP - temp.GATE_STOP <- readBin(con, what="integer", 1, size=4, endian="little") - - ##PTENABLED - temp.PTENABLED <- readBin(con, what="raw", 1, size=1, endian="little") - - ##DTENABLED - temp.DTENABLED <- readBin(con, what="raw", 1, size=1, endian="little") - - ##DEADTIME, MAXLPOWER, XRF_ACQTIME, XRF_HV - temp <- readBin(con, what="double", 4, size=4, endian="little") - temp.DEADTIME <- temp[1] - temp.MAXLPOWER <- temp[2] - temp.XRF_ACQTIME <- temp[3] - temp.XRF_HV <- temp[4] - - ##XRF_CURR - temp.XRF_CURR <- readBin(con, what="integer", 1, size=4, endian="little") - - ##XRF_DEADTIMEF - temp.XRF_DEADTIMEF <- readBin(con, what="double", 1, size=4, endian="little") - - ###Account for differences between V5, V6 and V7 - if(temp.VERSION == 06){ - ##RESERVED - temp.RESERVED2<-readBin(con, what="raw", 24, size=1, endian="little") - - }else if(temp.VERSION == 05){ - ##RESERVED - temp.RESERVED2<-readBin(con, what="raw", 4, size=1, endian="little") - - }else{ - - ##DETECTOR_ID - temp.DETECTOR_ID <- readBin(con, what="int", 1, size=1, endian="little") - - ##LOWERFILTER_ID, UPPERFILTER_ID - temp <- readBin(con, what="int", 2, size=2, endian="little") - temp.LOWERFILTER_ID <- temp[1] - temp.UPPERFILTER_ID <- temp[2] - - ##ENOISEFACTOR - temp.ENOISEFACTOR <- readBin(con, what="double", 1, size=4, endian="little") - - ##CHECK FOR VERSION 08 - if(temp.VERSION == 07){ - ##RESERVED for version 07 - temp.RESERVED2<-readBin(con, what="raw", 15, size=1, endian="little") - - }else { - ##MARKER_POSITION - temp <- readBin(con, what="double", 6, size=4, endian="little") - temp.MARPOS_X1 <- temp[1] - temp.MARPOS_Y1 <- temp[2] - temp.MARPOS_X2 <- temp[3] - temp.MARPOS_Y2 <- temp[4] - temp.MARPOS_X3 <- temp[5] - temp.MARPOS_Y3 <- temp[6] - - ###EXTR_START, EXTR_END - temp <- readBin(con, what="double", 2, size=4, endian="little") - temp.EXTR_START <- temp[1] - temp.EXTR_END <- temp[2] - - temp.RESERVED2<-readBin(con, what="raw", 42, size=1, endian="little") - - } - }# end RECTYPE 128 - } - }else if(temp.VERSION == 04 | temp.VERSION == 03){ - ## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - ##START BIN FILE FORMAT SUPPORT (vers. 03 and 04) - ##LENGTH, PREVIOUS, NPOINTS, LTYPE - - temp <- readBin(con, what="int", 3, size=2, endian="little") - temp.LENGTH <- temp[1] - temp.PREVIOUS <- temp[2] - temp.NPOINTS <- temp[3] - - ## set temp ID if within select - if(!is.null(n.records) && !(temp.ID + 1) %in% n.records) { - readBin(con, what = "raw", n = temp.LENGTH - 8, size = 1, endian = "little") - next() - } - - ##LTYPE - temp.LTYPE<-readBin(con, what="int", 1, size=1, endian="little") - - ##LOW, HIGH, RATE - temp <- readBin(con, what="double", 3, size=4, endian="little") - temp.LOW <- temp[1] - temp.HIGH <- temp[2] - temp.RATE <- temp[3] - - temp.TEMPERATURE<-readBin(con, what="integer", 1, size=2, endian="little") - - ##XCOORD, YCOORD, TOLDELAY, TOLON, TOLOFF - temp <- readBin(con, what="integer", 5, size=2, endian="little") - temp.XCOORD <- temp[1] - temp.YCOORD <- temp[2] - temp.TOLDELAY <- temp[3] - temp.TOLON <- temp[4] - temp.TOLOFF <- temp[5] - - ##POSITION - temp.POSITION <- readBin( - con, what="int", 1, size=1, endian="little", signed = FALSE) - - ##RUN - temp.RUN <- readBin( - con, what="int", 1, size=1, endian="little", signed = FALSE) - - ##TIME - TIME_SIZE <- readBin( - con, what="int", 1, size=1, endian="little") - - ##time size corrections for wrong time formats; set n to 6 for all values - ##according to the handbook of Geoff Duller, 2007 - TIME_SIZE<-6 - temp.TIME<-readChar(con, TIME_SIZE, useBytes=TRUE) - - ##DATE - DATE_SIZE<-readBin(con, what="int", 1, size=1, endian="little") - - ##date size corrections for wrong date formats; set n to 6 for all values - ##according to the handbook of Geoff Duller, 2007 - DATE_SIZE<-6 - temp.DATE<-readChar(con, DATE_SIZE, useBytes=TRUE) - - - ##SEQUENCE - SEQUENCE_SIZE<-readBin(con, what="int", 1, size=1, endian="little") - temp.SEQUENCE<-readChar(con, SEQUENCE_SIZE, useBytes=TRUE) - - #step forward in con - if(8-SEQUENCE_SIZE>0){ - STEPPING<-readBin(con, what="raw", (8-c(SEQUENCE_SIZE)),size=1, endian="little") - } - - ##USER - USER_SIZE<-readBin(con, what="int", 1, size=1, endian="little") - temp.USER<-readChar(con, USER_SIZE, useBytes=FALSE) - - #step forward in con - if(8-c(USER_SIZE)>0){ - STEPPING<-readBin(con, what="raw", (8-c(USER_SIZE)), size=1, endian="little") - } - - ##DTYPE - temp.DTYPE <- readBin(con, what="int", 1, size=1, endian="little") - - ##IRR_TIME - temp.IRR_TIME <- readBin(con, what="double", 1, size=4, endian="little") - - ##IRR_TYPE - temp.IRR_TYPE<-readBin(con, what="int", 1, size=1, endian="little") - - ##IRR_UNIT - temp.IRR_UNIT<-readBin(con, what="int", 1, size=1, endian="little") - - ##BL_TIME - temp.BL_TIME<-readBin(con, what="double", 1, size=4, endian="little") - - ##BL_UNIT - temp.BL_UNIT<-readBin(con, what="int", 1, size=1, endian="little") - - ##AN_TEMP, AN_TIME, NORM1, NORM2, NORM3, BG - temp <- readBin(con, what="double", 6, size=4, endian="little") - - temp.AN_TEMP <- temp[1] - temp.AN_TIME <- temp[2] - temp.NORM1 <- temp[3] - temp.NORM2 <- temp[4] - temp.NORM3 <- temp[5] - temp.BG <- temp[6] - - ##SHIFT - temp.SHIFT<-readBin(con, what="integer", 1, size=2, endian="little") - - ##SAMPLE - SAMPLE_SIZE<-readBin(con, what="int", 1, size=1, endian="little") - temp.SAMPLE<-readChar(con, SAMPLE_SIZE, useBytes=TRUE) #however it should be set to 20 - - #step forward in con - if(20-c(SAMPLE_SIZE)>0){ - STEPPING<-readBin(con, what="raw", (20-c(SAMPLE_SIZE)), size=1, endian="little") - } - - ##COMMENT - COMMENT_SIZE <- readBin(con, what="int", 1, size=1, endian="little") - temp.COMMENT <- readChar(con, COMMENT_SIZE, useBytes=TRUE) #set to 80 (manual) - - #step forward in con - if(80-c(COMMENT_SIZE)>0){ - STEPPING<-readBin(con, what="raw", (80-c(COMMENT_SIZE)), size=1, endian="little") - } - - ##LIGHTSOURCE, SET, TAG - temp <- readBin(con, what="int", 3, size=1, endian="little") - temp.LIGHTSOURCE <- temp[1] - temp.SET <- temp[2] - temp.TAG <- temp[3] - - ##GRAIN - temp.GRAIN<-readBin(con, what="integer", 1, size=2, endian="little") - - ##LPOWER - temp.LPOWER<-readBin(con, what="double", 1, size=4, endian="little") - - ##SYSTEMID - temp.SYSTEMID<-readBin(con, what="integer", 1, size=2, endian="little") - - ##Unfortunately an inconsitent BIN-file structure forces a differenciation ... - if(temp.VERSION == 03){ - ##RESERVED - temp.RESERVED1<-readBin(con, what="raw", 36, size=1, endian="little") - - ##ONTIME, OFFTIME - temp <- readBin(con, what="double", 2, size=4, endian="little") - - temp.ONTIME <- temp[1] - temp.OFFTIME <- temp[2] - - ##Enable flags #GateEnabled for v 06 - temp.ENABLE_FLAGS <- readBin(con, what="raw", 1, size=1, endian="little") - temp.GATE_ENABLED <- temp.ENABLE_FLAGS - - ##ONGATEDELAY, OFFGATEDELAY - temp <- readBin(con, what="double", 2, size=4, endian="little") - - temp.GATE_START <- temp[1] - temp.GATE_STOP <- temp[2] - - ##RESERVED - temp.RESERVED2<-readBin(con, what="raw", 1, size=1, endian="little") - - }else{ - ##RESERVED - temp.RESERVED1<-readBin(con, what="raw", 20, size=1, endian="little") - - ##CURVENO - temp.CURVENO <- readBin(con, what="integer", 1, size=2, endian="little") - - ##TIMETICK - temp.TIMETICK <- readBin(con, what="double", 1, size=4, endian="little") - - ##ONTIME, STIMPERIOD - temp <- readBin(con, what="integer", 2, size=4, endian="little") - - temp.ONTIME <- temp[1] - temp.STIMPERIOD <- temp[2] - - ##GATE_ENABLED - temp.GATE_ENABLED <- readBin(con, what="raw", 1, size=1, endian="little") - - ##ONGATEDELAY, OFFGATEDELAY - temp <- readBin(con, what="double", 2, size=4, endian="little") - - temp.GATE_START <- temp[1] - temp.GATE_END <- temp[2] - temp.GATE_STOP <- temp.GATE_END - - ##PTENABLED - temp.PTENABLED <- readBin(con, what="raw", 1, size=1, endian="little") - - ##RESERVED - temp.RESERVED2 <- readBin(con, what="raw", 10, size=1, endian="little") - } - } - - #DPOINTS - if(temp.RECTYPE != 128) { - temp.DPOINTS <- readBin(con, what = "integer", temp.NPOINTS, size = 4, endian = "little") - - } else { - temp.DPOINTS <- lapply(1:temp.NPOINTS, function(x) { - list( - NOFPOINTS = readBin(con, what = "int", 1, size = 4, endian = "little"), - USEDFOR = as.logical(readBin(con, what = "raw", 48, size = 1, endian = "little")), - SHOWFOR = as.logical(readBin(con, what = "raw", 48, size = 1, endian = "little")), - ROICOLOR = readBin(con, what = "integer", 1, size = 4, endian = "little"), - X = readBin(con, what = "double", 50, size = 4, endian = "little"), - Y = readBin(con, what = "double", 50, size = 4, endian = "little")) - }) - } - - #endif:format support - ##END BIN FILE FORMAT SUPPORT - ## ==========================================================================# - #SET UNIQUE ID - temp.ID <- temp.ID + 1 - - ##update progress bar - if(txtProgressBar & verbose){ - setTxtProgressBar(pb, seek(con,origin="current")) - } - - ##set for equal values with different names - if(!is.na(temp.GRAINNUMBER)){temp.GRAIN <- temp.GRAINNUMBER} - if(!is.na(temp.GRAIN)){temp.GRAINNUMBER <- temp.GRAIN} - - if(!is.na(temp.LIGHTPOWER)){temp.LPOWER <- temp.LIGHTPOWER} - if(!is.na(temp.LPOWER)){temp.LIGHTPOWER <- temp.LPOWER} - - temp.SEL <- if(temp.TAG == 1) TRUE else FALSE - - ##replace values in the data.table with values - results.METADATA[id_row, `:=` ( - ID = temp.ID, - SEL = temp.SEL, - VERSION = as.numeric(temp.VERSION), - LENGTH = temp.LENGTH, - PREVIOUS = temp.PREVIOUS, - NPOINTS = temp.NPOINTS, - RECTYPE = temp.RECTYPE, - RUN = temp.RUN, - SET = temp.SET, - POSITION = temp.POSITION, - GRAIN = temp.GRAIN, - GRAINNUMBER = temp.GRAINNUMBER, - CURVENO = temp.CURVENO, - XCOORD = temp.XCOORD, - YCOORD = temp.YCOORD, - SAMPLE = temp.SAMPLE, - COMMENT = temp.COMMENT, - SYSTEMID = temp.SYSTEMID, - FNAME = temp.FNAME, - USER = temp.USER, - TIME = temp.TIME, - DATE = temp.DATE, - DTYPE = as.character(temp.DTYPE), - BL_TIME = temp.BL_TIME, - BL_UNIT = temp.BL_UNIT, - NORM1 = temp.NORM1, - NORM2 = temp.NORM2, - NORM3 = temp.NORM3, - BG = temp.BG, - SHIFT = temp.SHIFT, - TAG = temp.TAG, - LTYPE = as.character(temp.LTYPE), - LIGHTSOURCE = as.character(temp.LIGHTSOURCE), - LPOWER = temp.LPOWER, - LIGHTPOWER = temp.LIGHTPOWER, - LOW = temp.LOW, - HIGH = temp.HIGH, - RATE = temp.RATE, - TEMPERATURE = temp.TEMPERATURE, - MEASTEMP = temp.MEASTEMP, - AN_TEMP = temp.AN_TEMP, - AN_TIME = temp.AN_TIME, - TOLDELAY = temp.TOLDELAY, - TOLON = temp.TOLON, - TOLOFF = temp.TOLOFF, - IRR_TIME = temp.IRR_TIME, - IRR_TYPE = temp.IRR_TYPE, - IRR_UNIT = temp.IRR_UNIT, - IRR_DOSERATE = temp.IRR_DOSERATE, - IRR_DOSERATEERR = temp.IRR_DOSERATEERR, - TIMESINCEIRR = temp.TIMESINCEIRR, - TIMETICK = temp.TIMETICK, - ONTIME = temp.ONTIME, - OFFTIME = temp.OFFTIME, - STIMPERIOD = temp.STIMPERIOD, - GATE_ENABLED = as.numeric(temp.GATE_ENABLED), - ENABLE_FLAGS = as.numeric(temp.ENABLE_FLAGS), - GATE_START = temp.GATE_START, - GATE_STOP = temp.GATE_STOP, - PTENABLED = as.numeric(temp.PTENABLED), - DTENABLED = as.numeric(temp.DTENABLED), - DEADTIME = temp.DEADTIME, - MAXLPOWER = temp.MAXLPOWER, - XRF_ACQTIME = temp.XRF_ACQTIME, - XRF_HV = temp.XRF_HV, - XRF_CURR = temp.XRF_CURR, - XRF_DEADTIMEF = temp.XRF_DEADTIMEF, - DETECTOR_ID = temp.DETECTOR_ID, - LOWERFILTER_ID = temp.LOWERFILTER_ID, - UPPERFILTER_ID = temp.UPPERFILTER_ID, - ENOISEFACTOR = temp.ENOISEFACTOR, - MARKPOS_X1 = temp.MARKPOS_X1, - MARKPOS_Y1 = temp.MARKPOS_Y1, - MARKPOS_X2 = temp.MARKPOS_X2, - MARKPOS_Y2 = temp.MARKPOS_Y2, - MARKPOS_X3 = temp.MARKPOS_X3, - MARKPOS_Y3 = temp.MARKPOS_Y3, - SEQUENCE = temp.SEQUENCE - )] - - results.DATA[[id_row]] <- temp.DPOINTS - - results.RESERVED[[id_row]][[1]] <- temp.RESERVED1 - results.RESERVED[[id_row]][[2]] <- temp.RESERVED2 - - ##reset values - temp.GRAINNUMBER <- NA - temp.GRAIN <- NA - - ## update id row - id_row <- id_row + 1 - - }#endwhile::end loop - - ##close - if(txtProgressBar & verbose){close(pb)} - - ## remove NA values created by skipping records - results.METADATA <- na.omit(results.METADATA, cols = "VERSION") - - ##output - if(verbose) - message("\t >> ", length(results.DATA), " records read successfully\n") - - # Further limitation -------------------------------------------------------------------------- - if(!is.null(position)){ - ##check whether the position is valid at all - if (all(position %in% results.METADATA[["POSITION"]])) { - results.METADATA <- results.METADATA[which(results.METADATA[["POSITION"]] %in% position),] - results.DATA <- results.DATA[results.METADATA[["ID"]]] - - ##re-calculate ID ... otherwise it will not match - results.METADATA[["ID"]] <- 1:length(results.DATA ) - - ##show a message - message("[read_BIN2R()] The record index has been recalculated") - - }else{ - valid.position <- - paste(unique(results.METADATA[["POSITION"]]), collapse = ", ") - .throw_warning("At least one position number is not valid, ", - "valid position numbers are: ", valid.position) - } - } - - ##check for position that have no data at all (error during the measurement) - if(zero_data.rm){ - zero_data.check <- which(vapply(results.DATA, length, numeric(1)) == 0) - - ##remove records if there is something to remove - if(length(zero_data.check) != 0){ - results.METADATA <- results.METADATA[-zero_data.check, ] - results.DATA[zero_data.check] <- NULL - - ## if nothing is left, remove empty record - if(nrow(results.METADATA) == 0) - return(set_Risoe.BINfileData()) - - ##recalculate record index - results.METADATA[["ID"]] <- 1:nrow(results.METADATA) - - .throw_warning("\n", length(zero_data.check), - " zero data records detected and removed. ", - "\n >> Record index re-calculated.") - } - } - - ##check for duplicated entries and remove them if wanted, but only if we have more than 2 records - ##this check is skipped for results with a RECTYPE 128, which stems from camera measurements - if (n.length >= 2 && length(results.DATA) >= 2 && all(results.METADATA[["RECTYPE"]] != 128)) { - duplication.check <- suppressWarnings(which(c( - 0, vapply( - 2:length(results.DATA), - FUN = function(x) { - all(results.DATA[[x - 1]] == results.DATA[[x]]) - }, - FUN.VALUE = 1 - ) - ) == 1)) - if (length(duplication.check) != 0) { - if (duplicated.rm) { - ##remove records - results.METADATA <- results.METADATA[-duplication.check, ] - results.DATA[duplication.check] <- NULL - - ##recalculate record index - results.METADATA[["ID"]] <- 1:nrow(results.METADATA) - - ##message - if(verbose) { - message("[read_BIN2R()] duplicated records detected and removed: ", - paste(duplication.check, collapse = ", "), - ", record index re-calculated") - } - - } else{ - .throw_warning("Duplicated records detected: ", - paste(duplication.check, collapse = ", "), - "\n\n >> You should consider 'duplicated.rm = TRUE'.") - } - } - } - - ##produce S4 object for output - object <- set_Risoe.BINfileData( - METADATA = results.METADATA, - DATA = results.DATA, - .RESERVED = results.RESERVED) - - if (length(object) == 0) { - if (verbose) { - message("[read_BIN2R()] Empty object returned") - } - return(object) - } - - # Convert Translation Matrix Values --------------------------------------- - if (!show.raw.values) { - ##LIGHTSOURCE CONVERSION - object@METADATA[["LIGHTSOURCE"]] <- - unname(LIGHTSOURCE.lookup[object@METADATA[["LIGHTSOURCE"]]]) - - ##LTYPE CONVERSION - object@METADATA[["LTYPE"]] <- - unname(LTYPE.lookup[object@METADATA[["LTYPE"]]]) - - ##DTYPE CONVERSION - object@METADATA[["DTYPE"]] <- - unname(DTYPE.lookup[object@METADATA[["DTYPE"]]]) - - ##CHECK for oddly set LTYPES, this may happen in old BIN-file versions - if (object@METADATA[["VERSION"]][1] == 3) { - object@METADATA[["LTYPE"]] <- - sapply(1:length(object@METADATA[["LTYPE"]]), function(x) { - if (object@METADATA[["LTYPE"]][x] == "OSL" & - object@METADATA[["LIGHTSOURCE"]][x] == "IR diodes/IR Laser") { - return("IRSL") - - } else{ - return(object@METADATA[["LTYPE"]][x]) - } - }) - } - - ##TIME CONVERSION, do not do for odd time formats as this could cause problems during export - if (TIME_SIZE == 6) { - object@METADATA[["TIME"]] <- - format(strptime(as.character(object@METADATA[["TIME"]]), "%H%M%S"), "%H:%M:%S") - } - } - - ## check for empty BIN-files names ... if so, set the name of the file as BIN-file name - ## This can happen if the user uses different equipment - if(all(is.na(object@METADATA[["FNAME"]]))){ - object@METADATA[["FNAME"]] <- strsplit(x = basename(file), split = ".", fixed = TRUE)[[1]][1] - } - - # Fast Forward -------------------------------------------------------------------------------- - ## set fastForward to TRUE if one of this arguments is used - if(any(names(list(...)) %in% names(formals(Risoe.BINfileData2RLum.Analysis))[-1]) & - fastForward == FALSE) { - fastForward <- TRUE - .throw_warning("Automatically reset 'fastForward = TRUE'") - } - - ##return values - ##with fast fastForward they will be converted directly to a list of RLum.Analysis objects - if(fastForward){ - object <- Risoe.BINfileData2RLum.Analysis(object, ...) - - ##because we expect a list - if(!inherits(object, "list")) - object <- list(object) - } - - return(object) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_Daybreak2R.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_Daybreak2R.R deleted file mode 100644 index c288aa002..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_Daybreak2R.R +++ /dev/null @@ -1,490 +0,0 @@ -#' Import measurement data produced by a Daybreak TL/OSL reader into R -#' -#' Import a TXT-file (ASCII file) or a DAT-file (binary file) produced by a -#' Daybreak reader into R. The import of the DAT-files is limited to the file -#' format described for the software TLAPLLIC v.3.2 used for a Daybreak, model 1100. -#' -#' @param file [character] or [list] (**required**): -#' path and file name of the file to be imported. Alternatively a list of file -#' names can be provided or just the path a folder containing measurement data. -#' Please note that the specific, common, file extension (txt) is likely -#' leading to function failures during import when just a path is provided. -#' -#' @param raw [logical] (*with default*): -#' if the input is a DAT-file (binary) a [data.table::data.table] instead of -#' the [RLum.Analysis-class] object can be returned for debugging purposes. -#' -#' @param verbose [logical] (*with default*): -#' enables or disables terminal feedback -#' -#' @param txtProgressBar [logical] (*with default*): -#' enables or disables [txtProgressBar]. -#' -#' @param ... not in use, for compatibility reasons only -#' -#' @return -#' A list of [RLum.Analysis-class] objects (each per position) is provided. -#' -#' @note -#' **`[BETA VERSION]`** -#' This function still needs to be tested properly. In particular -#' the function has underwent only very rough rests using a few files. -#' -#' @section Function version: 0.3.2 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -#' Antoine Zink, C2RMF, Palais du Louvre, Paris (France) -#' -#' The ASCII-file import is based on a suggestion by Willian Amidon and Andrew Louis Gorin -#' -#' @seealso [RLum.Analysis-class], [RLum.Data.Curve-class], [data.table::data.table] -#' -#' @keywords IO -#' -#' @examples -#' -#' \dontrun{ -#' file <- system.file("extdata/Daybreak_TestFile.txt", package = "Luminescence") -#' temp <- read_Daybreak2R(file) -#' } -#' -#' @md -#' @export -read_Daybreak2R <- function( - file, - raw = FALSE, - verbose = TRUE, - txtProgressBar = TRUE, - ... -){ - - ##TODO - ## - run tests - ## - check where the warning messages are coming from - ## - implement further integrity tests (ASCII import) - - # Self Call ----------------------------------------------------------------------------------- - # Option (a): Input is a list, every element in the list will be treated as file connection - # with that many file can be read in at the same time - # Option (b): The input is just a path, the function tries to grep ALL Daybreaks-txt files in the - # directory and import them, if this is detected, we proceed as list - - if(is(file, "character")) { - ##If this is not really a path we skip this here - if (dir.exists(file) & length(dir(file)) > 0) { - if(verbose){ - cat("[read_Daybreak2R()] Directory detected, trying to extract '*.txt' files ...\n") - } - - file <- - as.list(paste0(file,dir( - file, recursive = FALSE, pattern = ".txt" - ))) - - } - - } - - ##if the input is already a list - if (is(file, "list")) { - temp.return <- lapply(1:length(file), function(x) { - read_Daybreak2R( - file = file[[x]], - txtProgressBar = txtProgressBar - ) - }) - - ##return - return(temp.return) - - } - - - # Integrity checks ---------------------------------------------------------------------------- - - ##check if file exists - if(!file.exists(file)){ - stop("[read_Daybreak2R()] file name does not seem to exist.", call. = FALSE) - - } - - - ##check for file extension ... distinguish between TXT and DAT - if(substr(file, start = nchar(file) - 3, stop = nchar(file)) == ".DAT"){ - - # Read DAT-file ------------------------------------------------------------------------------ - on.exit(close(con)) - - ##screen file to get information on the number of stored records - con<-file(file,"rb") - file.data <- file.info(file) - max.pt<-readBin(con,what="int",6,size=2,endian="little")[6] - file.size<-file.data$size - n.length<-file.size/(190+8*(max.pt+1)) ##190 is is size of the header for each data set - close(con) - - ##import data - con <- file(file, "rb") - - ##pre-define data.table - results.DATA <- - data.table::data.table( - ID = integer(length = n.length), - MAXPT = integer(length = n.length), - SPACING = integer(length = n.length), - NDISK = integer(length = n.length), - NRUN = integer(length = n.length), - D1 = integer(length = n.length), - NPT = integer(length = n.length), - NATL = logical(length = n.length), - TLRUN = logical(length = n.length), - BEFORE_IRRAD = logical(length = n.length), - SHIFT = double(length = n.length), - RAMPRATE = double(length = n.length), - GRATE = double(length = n.length), - BRATE = double(length = n.length), - ARATE = double(length = n.length), - GAMMADOSE = double(length = n.length), - BETADOSE = double(length = n.length), - ALPHADOSE = double(length = n.length), - BLEACHINGTIME = double(length = n.length), - GRUNIT = character(length = n.length), - BRUNIT = character(length = n.length), - ARUNIT = character(length = n.length), - BFILTER = character(length = n.length), - GSOURCE = character(length = n.length), - BSOURCE = character(length = n.length), - ASOURCE = character(length = n.length), - IRRAD_DATE = character(length = n.length), - RUNREMARK = character(length = n.length), - DATA = list() - ) - - ##TERMINAL FEEDBACK - if(verbose){ - cat("\n[read_Daybreak2R()]") - cat(paste("\n >> Importing:", file[1],"\n")) - } - - ##PROGRESS BAR - if(txtProgressBar & verbose){ - pb <- txtProgressBar(min=0,max=n.length, char = "=", style=3) - } - - ##LOOP over file - i <- 1 - while (i> Importing:", file[1],"\n")) - } - - ##PROGRESS BAR - if(txtProgressBar & verbose){ - pb <- txtProgressBar(min=0,max=length(data.list), char = "=", style=3) - } - - ##(2) - ##Loop over the list to create RLum.Data.Curve objects - RLum.Data.Curve.list <- lapply(1:length(data.list), function(x){ - - - ##get length of record - record.length <- length(data.list[[x]]) - - ##get header length until the argument 'Points' - header.length <- grep(pattern = "Points", x = data.list[[x]]) - - if(length(header.length)>0){ - temp.meta_data <- unlist(strsplit(data.list[[x]][2:header.length], split = "=", fixed = TRUE)) - - }else{ - temp.meta_data <- unlist(strsplit(data.list[[x]][2:length(data.list[[x]])], split = "=", fixed = TRUE)) - - } - - ##get list names for the info element list - info.names <- temp.meta_data[seq(1,length(temp.meta_data), by = 2)] - - ##info elements - info <- as.list(temp.meta_data[seq(2,length(temp.meta_data), by = 2)]) - names(info) <- info.names - - ##add position, which is 'Disk' - info <- c(info, position = as.integer(info$Disk)) - - if(length(header.length)>0){ - ##get measurement data - temp.data <- unlist(strsplit(unlist(strsplit( - data.list[[x]][12:length(data.list[[x]])], split = "=" - )), split = ";")) - - ##grep only data of interest - point.x <- - suppressWarnings(as.numeric(gsub("^\\s+|\\s+$", "", temp.data[seq(2, length(temp.data), by = 4)]))) - point.y <- - suppressWarnings(as.numeric(gsub("^\\s+|\\s+$", "", temp.data[seq(3,length(temp.data), by = 4)]))) - - - ##combine it into a matrix - data <- matrix(c(point.x,point.y), ncol = 2) - - }else{ - - ##we presume this should be irradiation ... - if ("IrradTime" %in% names(info)) { - - point.x <- 1:as.numeric(info$IrradTime) - point.y <- rep(1, length(point.x)) - - data <- matrix(c(point.x,point.y), ncol = 2) - - } - - } - - ##update progress bar - if (txtProgressBar & verbose) { - setTxtProgressBar(pb, x) - } - - ##return RLum object - return( - set_RLum( - class = "RLum.Data.Curve", - originator = "read_Daybreak2R", - recordType = sub(" ", replacement = "_", x = info$DataType), - curveType = "measured", - data = data, - info = info - ) - ) - - }) - - ##close ProgressBar - if(txtProgressBar & verbose){close(pb)} - - ##(3) - ##Now we have to find out how many aliquots we do have - positions.id <- sapply(RLum.Data.Curve.list, function(x){ - - get_RLum(x, info.object = "position") - - }) - - ##(4) - ##now combine everyting in an RLum.Analysis object in accordance to the position number - RLum.Analysis.list <- lapply(unique(positions.id), function(x){ - - ##get list ids for position number - n <- which(positions.id == x) - - ##make list - temp.list <- lapply(n, function(x){ - RLum.Data.Curve.list[[x]] - - }) - - ##put in RLum.Analysis object - object <- set_RLum( - class = "RLum.Analysis", - originator = "read_Daybreak2R", - protocol = "Custom", - records = temp.list - ) - - ##set parent id of records - object <- .set_pid(object) - - return(object) - - - }) - - ##TERMINAL FEEDBACK - if(verbose){ - cat("\n ", length(unlist(get_RLum(RLum.Analysis.list))), - "records have been read successfully!\n") - } - - return(RLum.Analysis.list) - } -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_HeliosOSL2R.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_HeliosOSL2R.R deleted file mode 100644 index d7b91839f..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_HeliosOSL2R.R +++ /dev/null @@ -1,144 +0,0 @@ -#'@title Import Luminescence Data from Helios Luminescence Reader -#' -#'@description Straightforward import of files with the ending `.osl` produced -#'by the zero rad Helios luminescence reader and conversion to [RLum.Analysis-class] objects. -#' -#'@param file [character] (**required**): path to file to be imported. Can be a [list] -#'for further processing -#' -#'@param verbose [logical]: enable/disable terminal feedback -#' -#'@param ... not in use, for compatibility reasons only -#' -#'@note Thanks to Krzysztof Maternicki for providing example data. -#' -#'@return [RLum.Analysis-class] object -#' -#'@author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#'@section Function version: 0.1.0 -#' -#'@seealso [RLum.Data.Curve-class], [RLum.Analysis-class] -#' -#'@keywords IO -#' -#'@examples -#'file <- system.file("extdata/HeliosOSL_Example.osl", package = "Luminescence") -#'read_HeliosOSL2R(file) -#' -#'@md -#'@export -read_HeliosOSL2R <- function( - file, - verbose = TRUE, - ... -) { - -# Self-call --------------------------------------------------------------- - if(inherits(file, "list")) { - out <- lapply(file, function(x) { - read_HeliosOSL2R(x) - - }) - - return(out) - } - - -# Incoming ---------------------------------------------------------------- - ## check file format - if (tolower(ext <- tools::file_ext(file)) != "osl") - stop(paste0("[read_HeliosOSL2R()] File extension <", ext, "> unsupported!"), - call. = FALSE) - - ## fix path - file <- normalizePath(file) - -# Import ------------------------------------------------------------------ - if(verbose) { - file_name <- basename(file) - len_str <- nchar(basename(file_name)) - if(len_str > 50) - file_name <- paste0( - substr(file_name, start = 1, stop = 10), - "...", - substr(file_name, start = len_str - 40, stop = len_str)) - - cat("\n[read_HeliosOSL2R()] \n -> Importing ... \n -> path: ", dirname(file)) - cat("\n -> file: ", file_name, "\n") - - } - - ## read entire file - lines <- readLines(file) - - ## get footer lines id, which is printed in quotes but not the first - footer_id <- which(grepl(pattern = '\\"', x = lines, fixed = FALSE))[2] - - ## import data measurement data - df <- read.table( - file = textConnection(lines[1:(footer_id - 1)]), - header = TRUE, - sep = ",") - - ## extract metadata - ## remove quotes and split at : + whitespace - meta <- strsplit(x = gsub( - pattern = '\\"', - replacement = "", - x = lines[footer_id:length(lines)]), - split = ": ", - fixed = TRUE) - - ## drop lines object - rm(lines) - - ## create info object - ## extract names - info_names <- vapply(seq_along(meta), function(x){ - if(length(meta[[x]]) == 2) - meta[[x]][1] - else - paste0("unnamed_", x) - - }, character(1)) - info_names <- gsub(pattern = " ", "_", x = info_names, fixed = TRUE) - - ## extra elements - info <- lapply(meta, function(x){ - if(length(x) == 2) - x[2] - else - x[1] - - }) - names(info) <- info_names - -# Create object ----------------------------------------------------------- - ## this needs to be checked for the moment - ## we extract only three curves - pid <- create_UID() - - ## get records - records <- lapply(3:ncol(df), function(x){ - set_RLum( - class = "RLum.Data.Curve", - originator = "read_HeliosOSL2R", - curveType = "measured", - recordType = paste0("OSL (", colnames(df)[x], ")"), - data = as.matrix(df[,c(2,x)]), - info = c( - xlab = colnames(df)[2], - ylab = colnames(df)[x], - parentID = pid, - info)) - }) - - ## create RLum.Analysis as output - object <- set_RLum( - class = "RLum.Analysis", - originator = "read_HeliosOSL2R", - records = records) - - return(object) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_PSL2R.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_PSL2R.R deleted file mode 100644 index 8f915e67d..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_PSL2R.R +++ /dev/null @@ -1,337 +0,0 @@ -#' @title Import PSL files to R -#' -#' @description Imports PSL files produced by a SUERC portable OSL reader into R. -#' -#' @details This function provides an import routine for the SUERC portable OSL Reader PSL -#' format (measurement data and sequence). PSL files are just plain text and can be -#' viewed with any text editor. Due to the formatting of PSL files this import -#' function relies heavily on regular expression to find and extract all relevant information. See **note**. -#' -#' @param file [character] (**required**): -#' path and file name of the PSL file. If input is a `vector` it should comprise -#' only `character`s representing valid paths and PSL file names. -#' Alternatively the input character can be just a directory (path). In this case the -#' the function tries to detect and import all PSL files found in the directory. -#' -#' @param drop_bg [logical] (*with default*): -#' `TRUE` to automatically remove all non-OSL/IRSL curves. -#' -#' @param as_decay_curve [logical] (*with default*): -#' Portable OSL Reader curves are often given as cumulative light sum curves. -#' Use `TRUE` (default) to convert the curves to the more usual decay form. -#' -#' @param smooth [logical] (*with default*): -#' `TRUE` to apply Tukey's Running Median Smoothing for OSL and IRSL decay curves. -#' Smoothing is encouraged if you see random signal drops within the decay curves related -#' to hardware errors. -#' -#' @param merge [logical] (*with default*): -#' `TRUE` to merge all `RLum.Analysis` objects. Only applicable if multiple -#' files are imported. -#' -#' @param ... currently not used. -#' -#' @return -#' Returns an S4 [RLum.Analysis-class] object containing -#' [RLum.Data.Curve-class] objects for each curve. -#' -#' @seealso [RLum.Analysis-class], [RLum.Data.Curve-class], [RLum.Data.Curve-class] -#' -#' @author Christoph Burow, University of Cologne (Germany), -#' Sebastian Kreutzer, Institut of Geography, Heidelberg University (Germany) -#' -#' @section Function version: 0.1.1 -#' -#' @note -#' Because this function relies heavily on regular expressions to parse -#' PSL files it is currently only in beta status. If the routine fails to import -#' a specific PSL file please report to `` so the -#' function can be updated. -#' -#' @keywords IO -#' -#' @examples -#' -#' # (1) Import PSL file to R -#' -#' file <- system.file("extdata", "DorNie_0016.psl", package = "Luminescence") -#' psl <- read_PSL2R(file, drop_bg = FALSE, as_decay_curve = TRUE, smooth = TRUE, merge = FALSE) -#' print(str(psl, max.level = 3)) -#' plot(psl, combine = TRUE) -#' -#' @md -#' @export -read_PSL2R <- function(file, drop_bg = FALSE, as_decay_curve = TRUE, smooth = FALSE, merge = FALSE, ...) { - ## INPUT VALIDATION ---- - if (length(file) == 1) { - if (!grepl(".psl$", file, ignore.case = TRUE)) { - file <- list.files(file, pattern = ".psl$", full.names = TRUE, ignore.case = TRUE) - if (length(file) == 0) - stop("[read_PSL2R()]: No .psl files found", call. = FALSE) - message("[read_PSL2R()]: The following files were found and imported: \n", paste(" ..", file, collapse = "\n")) - } - } - if (!all(file.exists(file))) - stop("The following files do not exist, please check: \n", - paste(file[!file.exists(file)], collapse = "\n"), call. = FALSE) - - ## MAIN ---- - results <- vector("list", length(file)) - for (i in 1:length(file)) { - ## Read in file ---- - doc <- readLines(file[i]) - - ## Document formatting ---- - # remove lines with i) blanks only, ii) dashes, iii) equal signs - doc <- gsub("^[ ]*$", "", doc) - doc <- gsub("^[ -]*$", "", doc) - doc <- gsub("^[ =]*$", "", doc) - - # the header ends with date and time with the previous line starting with a single slash - lines_with_slashes <- doc[grepl("\\", doc, fixed = TRUE)] - - ## OFFENDING LINE: this deletes the line with sample name and time and date - sample_and_date <- lines_with_slashes[length(lines_with_slashes)] - sample <- trimws(gsub("\\\\", "", strsplit(sample_and_date, "@")[[1]][1])) - date_and_time <- strsplit(strsplit(sample_and_date, "@")[[1]][2], " ")[[1]] - date_and_time_clean <- date_and_time[date_and_time != "" & date_and_time != "/" & date_and_time != "PM" & date_and_time != "AM"] - date <- as.Date(date_and_time_clean[1], "%m/%d/%Y") - time <- format(date_and_time_clean[2], format = "%h:%M:%S") - doc <- gsub(lines_with_slashes[length(lines_with_slashes)], - "", fixed = TRUE, doc) - - # last delimiting line before measurements are only apostrophes and dashes - lines_with_apostrophes <-doc[grepl("'", doc, fixed = TRUE)] - doc <- gsub(lines_with_apostrophes[length(lines_with_apostrophes)], - "", fixed = TRUE, doc) - - # finally remove all empty lines - doc <- doc[doc != ""] - - ## Split document ---- - begin_of_measurements <- grep("Measurement :", doc, fixed = TRUE) - number_of_measurements <- length(begin_of_measurements) - - # Parse and format header - header <- doc[1:(begin_of_measurements[1]-1)] - header <- format_Header(header) - - # add sample name, date and time to header list - header$Date <- date - header$Time <- time - header$Sample <- sample - - # Parse and format the measurement values - measurements_split <- vector("list", number_of_measurements) - - # save lines of each measurement to individual list elements - for (j in seq_len(number_of_measurements)) { - if (j != max(number_of_measurements)) - measurements_split[[j]] <- doc[begin_of_measurements[j]:(begin_of_measurements[j+1] - 1)] - else - measurements_split[[j]] <- doc[begin_of_measurements[j]:length(doc)] - } - - # format each measurement; this will return a list of RLum.Data.Curve objects - measurements_formatted <- lapply(measurements_split, function(x) { - format_Measurements(x, convert = as_decay_curve, header = header) - }) - - # drop dark count measurements if needed - if (drop_bg) { - measurements_formatted <- lapply(measurements_formatted, function(x) { - if (x@recordType != "USER") - return(x) - }) - measurements_formatted <- measurements_formatted[!sapply(measurements_formatted, is.null)] - } - - # decay curve smoothing using Tukey's Running Median Smoothing (?smooth) - if (smooth) { - measurements_formatted <- lapply(measurements_formatted, function(x) { - if (x@recordType != "USER") - x@data[,2] <- smooth(x@data[ ,2]) - return(x) - }) - } - - ## get measurement sequence - measurement_sequence <- data.table::rbindlist( - lapply(seq_along(measurements_split), function(x) { - ## remove measurement - tmp <- gsub( - pattern = "Measurement : ", - replacement = "", - x = measurements_split[[x]][1], - fixed = TRUE) - - ## split entries - tmp <- strsplit(x = tmp, split = " | ", fixed = TRUE)[[1]] - - ## data.frame - data.frame( - RUN = x, - NAME = trimws(tmp[1]), - STIM = strsplit(tmp[2], split = " ", fixed = TRUE)[[1]][2], - ON_OFF = strsplit(tmp[3], split = "(us)", fixed = TRUE)[[1]][2], - CYCLE = strsplit(tmp[4], split = "(ms),", fixed = TRUE)[[1]][2]) - - })) - - ## RETURN ---- - results[[i]] <- set_RLum( - "RLum.Analysis", - protocol = "portable OSL", - info = c( - header, - list(Sequence = measurement_sequence)), - records = measurements_formatted) - }#Eof::Loop - - ## MERGE ---- - if (length(results) > 1 && merge) - results <- merge_RLum(results) - - ## RETURN ---- - if (length(results) == 1) - results <- results[[1]] - - return(results) -} - -################################################################################ -## HELPER FUNCTIONS -################################################################################ - - -## ------------------------- FORMAT MEASUREMENT ----------------------------- ## -format_Measurements <- function(x, convert, header) { - ## measurement parameters are given in the first line - settings <- x[1] - - settings_split <- unlist(strsplit(settings, "|", fixed = TRUE)) - - # welcome to regex/strsplit hell - settings_measurement <- trimws(gsub(".*: ", "", settings_split[which(grepl("Measure", settings_split))])) - settings_stimulation_unit <- gsub("[^0-9]", "", settings_split[which(grepl("Stim", settings_split))]) - settings_on_time <- as.integer(unlist(strsplit(gsub("[^0-9,]", "", settings_split[which(grepl("Off", settings_split))]), ","))[1]) - settings_off_time <- as.integer(unlist(strsplit(gsub("[^0-9,]", "", settings_split[which(grepl("Off", settings_split))]), ","))[2]) - settings_cycle <- na.omit(as.integer(unlist(strsplit(gsub("[^0-9,]", "", settings_split[which(grepl("No", settings_split))]), ","))))[1] - settings_stimulation_time <- na.omit(as.integer(unlist(strsplit(gsub("[^0-9,]", "", settings_split[which(grepl("No", settings_split))]), ","))))[2] - - settings_list <- list("measurement" = settings_measurement, - "stimulation_unit" = switch(settings_stimulation_unit, "0" = "USER", "1" = "IRSL", "2" = "OSL"), - "on_time" = settings_on_time, - "off_time" = settings_off_time, - "cycle" = settings_cycle, - "stimulation_time" = settings_stimulation_time) - - ## terminal counts are given in the last line - terminal_count_text <- x[length(x)] - - terminal_count_text_formatted <- gsub("[^0-9]", "", - unlist(strsplit(terminal_count_text, "/"))) - - terminal_count <- as.numeric(terminal_count_text_formatted[1]) - terminal_count_error <- as.numeric(terminal_count_text_formatted[2]) - - - ## parse values and create a data frame - x_stripped <- x[-c(1, 2, length(x))] - - df <- data.frame(matrix(NA, ncol = 5, nrow = length(x_stripped))) - - for (i in 1:length(x_stripped)) { - x_split <- unlist(strsplit(x_stripped[i], " ")) - x_split <- x_split[x_split != ""] - x_split_clean <- gsub("[^0-9\\-]", "", x_split) - x_split_cleaner <- x_split_clean[x_split_clean != "-"] - - df[i, ] <- as.numeric(x_split_cleaner) - } - - names(df) <- c("time", "counts", "counts_error", - "counts_per_cycle", "counts_per_cycle_error") - - - # shape of the curve: decay or cumulative - if (convert) - data <- matrix(c(df$time, df$counts_per_cycle), ncol = 2) - else - data <- matrix(c(df$time, df$counts), ncol = 2) - - # determine the stimulation type - if (grepl("Stim 0", settings)) { - recordType <- "USER" - } - if (grepl("Stim 1", settings)) { - recordType <- "IRSL" - } - if (grepl("Stim 2", settings)) { - recordType <- "OSL" - } - - object <- set_RLum( - class = "RLum.Data.Curve", - originator = "read_PSL2R", - recordType = recordType, - curveType = "measured", - data = data, - info = list(settings = c(settings_list, header), - raw_data = df)) - - return(object) - -} - -## ---------------------------- FORMAT HEADER ------------------------------- ## -format_Header <- function(x) { - header_formatted <- list() - - # split by double blanks - header_split <- strsplit(x, " ", fixed = TRUE) - - # check whether there are twice as many values - # as colons; if there is an equal amount, the previous split was not sufficient - # and we need to further split by a colon (that is followed by a blank) - header_split_clean <- lapply(header_split, function(x) { - x <- x[x != ""] - n_elements <- length(x) - n_properties <- length(grep(":", x, fixed = TRUE)) - - if (n_elements / n_properties == 1) - x <- unlist(strsplit(x, ": ", fixed = TRUE)) - - return(x) - }) - - # format parameter/settings names and corresponding values - values <- vector(mode = "character") - names <- vector(mode = "character") - - for (i in 1:length(header_split_clean)) { - for (j in seq(1, length(header_split_clean[[i]]), 2)) { - names <- c(names, header_split_clean[[i]][j]) - values <- c(values, header_split_clean[[i]][j + 1]) - } - } - - # some RegExing for nice reading - names <- gsub("[: ]$", "", names, perl = TRUE) - names <- gsub("^ ", "", names) - names <- gsub(" $", "", names) - # for some weird reason "offset subtract" starts with '256 ' - names <- gsub("256 ", "", names) - # finally, replace all blanks with underscores - names <- gsub(" ", "_", names) - - values <- gsub("[: ]$", "", values, perl = TRUE) - values <- gsub("^ ", "", values) - values <- gsub(" $", "", values) - - # return header as list - header <- as.list(values) - names(header) <- names - - return(header) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_RF2R.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_RF2R.R deleted file mode 100644 index f211e03aa..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_RF2R.R +++ /dev/null @@ -1,236 +0,0 @@ -#' @title Import RF-files to R -#' -#' @description Import files produced by the IR-RF 'ImageJ' macro (`SR-RF.ijm`; Mittelstraß and Kreutzer, 2021) into R and create a list of [RLum.Analysis-class] -#' objects -#' -#' @details The results of spatially resolved IR-RF data are summarised in so-called RF-files ((Mittelstraß and Kreutzer, 2021). -#' This functions provides an easy import to process the data seamlessly with the R package 'Luminescence'. -#' The output of the function can be passed to the function [analyse_IRSAR.RF] -#' -#' @param file [character] (**required**): path and file name of the RF file. Alternatively a list of file -#' names can be provided. -#' -#' @param ... not used, only for compatible reasons -#' -#' @return Returns an S4 [RLum.Analysis-class] object containing -#' [RLum.Data.Curve-class] objects for each curve. -#' -#' @seealso [RLum.Analysis-class], [RLum.Data.Curve-class], [analyse_IRSAR.RF] -#' -#' @author Sebastian Kreutzer, Geography & Earth Science, Aberystwyth University (United Kingdom) -#' -#' @section Function version: 0.1.1 -#' -#' @keywords IO -#' -#' @references Mittelstraß, D., Kreutzer, S., 2021. Spatially resolved infrared radiofluorescence: -#' single-grain K-feldspar dating using CCD imaging. Geochronology 3, 299–319. \doi{10.5194/gchron-3-299-2021} -#' -#' @examples -#' -#' ##Import -#' file <- system.file("extdata", "RF_file.rf", package = "Luminescence") -#' temp <- read_RF2R(file) -#' -#' @md -#' @export -read_RF2R <- function( - file, - ... -) { - -# Self-call ----------------------------------------------------------------------------------- - if(inherits(file, "list")){ - results_list <- lapply(file, function(f){ - temp <- try(read_RF2R(file = f), silent = TRUE) - - ##check whether it worked - if(inherits(temp, "try-error")){ - message("[read_RF2R()] Error: Import for file '", f, - "' failed, NULL returned") - return(NULL) - }else{ - return(temp) - } - - }) - - return(unlist(results_list, recursive = FALSE)) - - } - - -# Integrity check ----------------------------------------------------------------------------- - ##throw warning if we have a vector - if(length(file) > 1){ - warning("[read_RF2R()] 'file' has a length > 1. Only the first element was taken! - If you want to import multiple files, 'file' has to be of type 'list'.", call. = TRUE) - file <- file[1] - } - - ##check input - if(!inherits(file, "character")) - stop("[read_RF2R()] 'file' needs to be of type character!", call. = FALSE) - - ##check whether file is available - if(!file.exists(file)) - stop("[read_RF2R()] File '", file, "' does not exist!", call. = FALSE) - - ##read first line to ensure the format - vers_str <- readLines(file, 1) - version_supported <- c("17-10-2018", "27-11-2018", "0.1.0") - version_found <- regmatches(vers_str, - regexpr("(?<=macro\\_version=)[0-9-.]+", vers_str, perl = TRUE)) - - if (!any(version_found %in% version_supported)) - stop("[read_RF2R()] File format not supported!", call. = FALSE) - -# Import -------------------------------------------------------------------------------------- - - ##import the entire file - temp <- readLines(file, warn = FALSE) - -# Extract information ------------------------------------------------------------------------- - - ##extract header (here as function; that might be useful in future) - .extract_header <- function(x){ - x <- gsub(pattern = "<", replacement = "", fixed = TRUE, x = x) - x <- gsub(pattern = ">", replacement = "", fixed = TRUE, x = x) - header <- strsplit(x = x, split = " ", fixed = TRUE)[[1]] - header <- unlist(strsplit(x = header, split = "=", fixed = TRUE)) - - header_names <- header[seq(1, length(header), by = 2)] - header <- as.list(header[seq(2, length(header), by = 2)]) - names(header) <- header_names - return(header) - } - - header <- try(.extract_header(temp[1]), silent = TRUE) - - ##test the header - if(inherits(header, 'try-error')){ - message("[read_RF2R()] Error: Header extraction failed, ", - "trying to continue without ... ") - header <- NA - } - - ##extract tag boundaries framed by tags +++++++++++++++++++ - ##the 2nd line corrects the inner boundaries - ##(1) statistics - id_statistics <- grep(pattern = "Statistics>", x = temp, fixed = TRUE) - id_statistics <- c(id_statistics[1] + 1, id_statistics[2] - 1) - - ##(2) Natural (henceforth: RF_nat) - id_RF_nat <- grep(pattern = "Natural>", x = temp, fixed = TRUE) - id_RF_nat <- c(id_RF_nat[1] + 1, id_RF_nat[2] - 1) - - ##(3) Bleached (henceforth: RF_reg) - id_RF_reg <- grep(pattern = "Bleached>", x = temp, fixed = TRUE) - id_RF_reg <- c(id_RF_reg[1] + 1, id_RF_reg[2] - 1) - - ##extract content within the tags +++++++++++++++++++ - ##(1) statistics - ## - ####header - statistics_header <- strsplit(x = temp[id_statistics[1]], split = "\t", fixed = TRUE)[[1]][-1] - - ##data - m_statistics <- as.data.frame(lapply((id_statistics[1]+1):(id_statistics[2]), function(x){ - strsplit(x = temp[x], split = "\t", fixed = TRUE)[[1]] - - }), stringsAsFactors = FALSE) - - ##extract colnames - colnames(m_statistics) <- - unlist(strsplit( - x = as.character(m_statistics[1, ]), - split = ":", - fixed = TRUE - )) - - ##remove first - df_statistics <- - cbind(ROI = statistics_header, m_statistics[-1, ], stringsAsFactors = FALSE) - - - ##(2) RF_nat - ## - ####header - RF_nat_header <- - strsplit(x = temp[id_RF_nat[1]], split = "\t", fixed = TRUE)[[1]] - - ##data - m_RF_nat <- matrix( - data = as.numeric(strsplit( - x = paste(temp[(id_RF_nat[1] + 1):(id_RF_nat[2])], collapse = "\t"), - split = "\t", - fixed = TRUE - )[[1]]), - ncol = length(RF_nat_header), - byrow = TRUE - ) - - ##set colnames - colnames(m_RF_nat) <- RF_nat_header - - ##(3) RF_reg - ## - ####header - RF_reg_header <- - strsplit(x = temp[id_RF_reg[1]], split = "\t", fixed = TRUE)[[1]] - - ##data - m_RF_reg <- matrix( - data = as.numeric(strsplit( - x = paste(temp[(id_RF_reg[1] + 1):(id_RF_reg[2])], collapse = "\t"), - split = "\t", - fixed = TRUE - )[[1]]), - ncol = length(RF_reg_header), - byrow = TRUE - ) - - ##set colnames - colnames(m_RF_reg) <- RF_reg_header - - -# Create RLum.Analysis objects ---------------------------------------------------------------- - object_list <- lapply(1:nrow(df_statistics), function(a){ - - ##set records - records <- lapply(1:2, function(o) { - if(o == 1){ - temp_curve <- m_RF_nat[,c(2,2 + a)] - - }else{ - temp_curve <- m_RF_reg[,c(2,2 + a)] - - } - - ##write curve - set_RLum( - class = "RLum.Data.Curve", - originator = "read_RF2R", - curveType = "measured", - recordType = "RF", - data = temp_curve - ) - - - }) - - ##create RLum.Analysis object - set_RLum(class = "RLum.Analysis", - originator = "read_RF2R", - records = records, - info = c( - as.list(df_statistics[a,]), - header - )) - - }) - -# Return -------------------------------------------------------------------------------------- -return(object_list) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_SPE2R.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_SPE2R.R deleted file mode 100644 index d5c67261c..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_SPE2R.R +++ /dev/null @@ -1,433 +0,0 @@ -#' @title Import Princeton Instruments (TM) SPE-file into R -#' -#' @description Function imports Princeton Instruments (TM) SPE-files into R environment and -#' provides [RLum.Data.Image-class] objects as output. -#' -#' @details Function provides an R only import routine for the Princeton Instruments -#' SPE format. Import functionality is based on the file format description provided by -#' Princeton Instruments and a MatLab script written by Carl Hall (see -#' references). -#' -#' @param file [character] (**required**): -#' SPE-file name (including path), e.g. -#' - `[WIN]`: `read_SPE2R("C:/Desktop/test.spe")` -#' - `[MAC/LINUX]`: `read_SPE2R("/User/test/Desktop/test.spe")`. -#' Additionally, it can be a URL starting with http:// or https://. -#' -#' @param output.object [character] (*with default*): -#' set `RLum` output object. Allowed types are `"RLum.Data.Spectrum"`, -#' `"RLum.Data.Image"` or `"matrix"` -#' -#' @param frame.range [vector] (*optional*): -#' limit frame range, e.g. select first 100 frames by `frame.range = c(1,100)` -#' -#' @param txtProgressBar [logical] (*with default*): -#' enables or disables [txtProgressBar]. -#' -#' @param verbose [logical] (*with default*): enables or disables verbose mode -#' -#' @param ... not used, for compatibility reasons only -#' -#' @return -#' Depending on the chosen option the functions returns three different -#' type of objects: -#' -#' `output.object` -#' -#' `RLum.Data.Spectrum` -#' -#' An object of type [RLum.Data.Spectrum-class] is returned. Row -#' sums are used to integrate all counts over one channel. -#' -#' `RLum.Data.Image` -#' -#' An object of type [RLum.Data.Image-class] is returned. Due to -#' performance reasons the import is aborted for files containing more than 100 -#' frames. This limitation can be overwritten manually by using the argument -#' `frame.range`. -#' -#' `matrix` -#' -#' Returns a matrix of the form: Rows = Channels, columns = Frames. For the -#' transformation the function [get_RLum] is used, -#' meaning that the same results can be obtained by using the function -#' [get_RLum] on an `RLum.Data.Spectrum` or `RLum.Data.Image` object. -#' -#' @note -#' **The function does not test whether the input data are spectra or pictures for spatial resolved analysis!** -#' -#' The function has been successfully tested for SPE format versions 2.x. -#' -#' *Currently not all information provided by the SPE format are supported.* -#' -#' @section Function version: 0.1.5 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [readBin], [RLum.Data.Spectrum-class] -#' -#' @references -#' Princeton Instruments, 2014. Princeton Instruments SPE 3.0 File -#' Format Specification, Version 1.A (for document URL please use an internet search machine) -#' -#' Hall, C., 2012: readSPE.m. -#' `https://www.mathworks.com/matlabcentral/fileexchange/35940-readspe` -#' -#' @keywords IO -#' -#' @examples -#' -#' ## to run examples uncomment lines and run the code -#' -#' ##(1) Import data as RLum.Data.Spectrum object -#' #file <- file.choose() -#' #temp <- read_SPE2R(file) -#' #temp -#' -#' ##(2) Import data as RLum.Data.Image object -#' #file <- file.choose() -#' #temp <- read_SPE2R(file, output.object = "RLum.Data.Image") -#' #temp -#' -#' ##(3) Import data as matrix object -#' #file <- file.choose() -#' #temp <- read_SPE2R(file, output.object = "matrix") -#' #temp -#' -#' ##(4) Export raw data to csv, if temp is a RLum.Data.Spectrum object -#' # write.table(x = get_RLum(temp), -#' # file = "[your path and filename]", -#' # sep = ";", row.names = FALSE) -#' -#' -#' @md -#' @export -read_SPE2R <- function( - file, - output.object = "RLum.Data.Image", - frame.range, - txtProgressBar = TRUE, - verbose = TRUE, - ... -){ - - # Consistency check ------------------------------------------------------- - - valid.output.object <- c("RLum.Data.Image", "RLum.Data.Spectrum", "matrix") - if (!output.object %in% valid.output.object) { - .throw_error("'output.object' not supported, valid options are ", - paste(valid.output.object, collapse = ", ")) - } - - ##check if file exists - if(!file.exists(file)){ - - ## check if the file is an URL ... you never know - if (grepl(pattern = "^https?://", x = file)) { - if(verbose){ - cat("[read_SPE2R()] URL detected, checking connection ... ") - } - - ##check URL - if(!httr::http_error(file)){ - if (verbose) cat("OK\n") - - ##download file - file_link <- tempfile("read_SPE2R_FILE", fileext = ".SPE") - download.file(file, destfile = file_link, quiet = !verbose, mode = "wb") - file <- file_link - - }else{ - if (verbose) cat("FAILED\n") - message("[read_SPE2R()] Error: File does not exist, NULL returned") - return(NULL) - } - - }else{ - message("[read_SPE2R()] Error: File does not exist, NULL returned") - return(NULL) - } - - } - - ##check file extension - if(!grepl(basename(file), pattern = "SPE$", ignore.case = TRUE)){ - if(strsplit(file, split = "\\.")[[1]][2] != "SPE"){ - .throw_error("Unsupported file format: *.", - strsplit(file, split = "\\.")[[1]][2], sep = "") - }} - - - # Open Connection --------------------------------------------------------- - - con <- file(file, "rb") - - # read header ------------------------------------------------------------- - - temp <- readBin(con, what="int", 2, size=2, endian="little", signed = TRUE) - ControllerVersion <- temp[1] #Hardware version - LogicOutput <- temp[2] #Definition of Output BNC - - temp <- readBin(con, what="int", 2, size=2, endian="little", signed = FALSE) - AmpHiCapLowNoise <- temp[1] #Amp Switching Mode - xDimDet <- temp[2] #Detector x dimension of chip. - - #timing mode - mode <- readBin(con, what="int", 1, size=2, endian="little", signed = TRUE) - - #alternative exposure, in sec. - exp_sec <- readBin(con, what="double", 1, size=4, endian="little") - - temp <- readBin(con, what="int", 2, size=2, endian="little", signed = TRUE) - VChipXdim <- temp[1] # Virtual Chip X dim - VChipYdim <- temp[2] # Virtual Chip Y dim - - #y dimension of CCD or detector. - yDimDet <- readBin(con, what="int", 1, size=2, endian="little", signed = TRUE) - - #Date - Date <- suppressWarnings(readChar(con, 10, useBytes=TRUE)) - - ##jump - stepping <- readBin(con, what="raw", 4, size=1, endian="little", signed = TRUE) - - #Old number of scans - should always be -1 - noscan <- readBin(con, what="int", 1, size=2, endian="little", signed = TRUE) - - #Detector Temperature Set - DetTemperature <- readBin(con, what="double", 1, size=4, endian="little") - - # CCD/DiodeArray type - DetType <- readBin(con, what="int", 1, size=2, endian="little", signed = TRUE) - - #actual # of pixels on x axis - xdim <- readBin(con, what="int", 1, size=2, endian="little", signed = FALSE) - - ##jump - stepping <- readBin(con, what="raw", 64, size=1, endian="little", signed = TRUE) - - ##experiment data type - ##0 = 32f (4 bytes) - ##1 = 32s (4 bytes) - ##3 = 16u (2 bytes) - ##8 = 32u (4 bytes) - datatype <- readBin(con, what="int", 1, size=2, endian="little", signed = TRUE) - - ##jump - stepping <- readBin(con, what="raw", 546, size=1, endian="little") - - #y dimension of raw data. - ydim <- readBin(con, what="int", 1, size=2, endian="little", signed = FALSE) - - ##0=scrambled,1=unscrambled - scramble <- readBin(con, what="int", 1, size=2, endian="little", signed = FALSE) - - ##jump - stepping <- readBin(con, what="raw", 4, size=1, endian="little") - - #Number of scans (Early WinX) - lnoscan <- readBin(con, what="int", 1, size=4, endian="little", signed = TRUE) - - #Number of Accumulations - lavgexp <- readBin(con, what="int", 1, size=4, endian="little", signed = TRUE) - - ##Experiment readout time - ReadoutTime <- readBin(con, what="double", 1, size=4, endian="little") - - #T/F Triggered Timing Option - TriggeredModeFlag <- readBin(con, what="int", 1, size=2, endian="little", signed = TRUE) - - ##jump - stepping <- readBin(con, what="raw", 768, size=1, endian="little") - - ##number of frames in file. - NumFrames <- readBin(con, what="int", 1, size=4, endian="little", signed = TRUE) - - if(NumFrames > 100 & missing(frame.range) & output.object == "RLum.Data.Image"){ - .throw_error("Import aborted: this file containes > 100 frames (", - NumFrames, "). Use argument 'frame.range' to force import.") - } - - ##set frame.range - if(missing(frame.range) == TRUE){frame.range <- c(1,NumFrames)} - - ##jump - stepping <- readBin(con, what="raw", 542, size=1, endian="little") - - #file_header_ver - file_header_ver <- readBin(con, what="double", 1, size=4, endian="little") - - ##jump - stepping <- readBin(con, what="raw", 1000, size=1, endian="little") - - ##WinView_id - set to 19,088,743 (or 1234567 hex) (required for legacy reasons) - WinView_id <- readBin(con, what="integer", 1, size=4, endian="little", signed = TRUE) - - ##jump - stepping <- readBin(con, what="raw", 1098, size=1, endian="little") - - ##lastvalue - set to 21,845 (or 5555 hex) (required for legacy reasons) - lastvalue <- readBin(con, what="integer", 1, size=2, endian="little", signed = TRUE) - - - ##end header - ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - ##create info element list from data - temp.info <- list(ControllerVersion, - LogicOutput, - AmpHiCapLowNoise, - xDimDet, yDimDet, - xdim, ydim, - VChipXdim, VChipYdim, - Date, - noscan, - mode, exp_sec, - DetTemperature, - DetType, - datatype, - scramble, - lnoscan, - lavgexp, - ReadoutTime, - TriggeredModeFlag, - NumFrames, - file_header_ver) - - ##set name for list elements - names(temp.info) <- c("ControllerVersion", "LogicOutput", "AmpHiCapLowNoise", "xDimDet", "yDimDet", - "xdim", "ydim", "VChipXdim", "VChipYdim", "Date", "noscan", "mode", "exp_sec", - "DetTemperature", "DetType", "datatype", "scramble", "lnoscan", "lavgexp", - "ReadoutTime", "TriggeredModeFlag", "NumFrames", "file_header_ver") - - # read count value data --------------------------------------------------- - ##set functions - - if(datatype == 0){ - read.data <- function(n.counts){ - readBin(con, what="double", n.counts, size=4, endian="little") - } - - }else if(datatype == 1){ - - read.data <- function(n.counts){ - readBin(con, what="integer", n.counts, size=4, endian="little", signed = TRUE) - } - - }else if(datatype == 2){ - - read.data <- function(n.counts){ - readBin(con, what="integer", n.counts, size=2, endian="little", signed = TRUE) - } - - }else if(datatype == 3){ - read.data <- function(n.counts){ - readBin(con, what="int", n.counts, size=2, endian="little", signed = FALSE) - - } - - }else if(datatype == 8){ - - read.data <- function(n.counts){ - readBin(con, what="integer", n.counts, size=4, endian="little", signed = FALSE) - } - - }else{ - .throw_error("Unknown 'datatype'") - } - - - ##loop over all frames - ##output - if(verbose) - cat("\n[read_SPE2R()]\n\t >>", file) - - ##set progressbar - if(txtProgressBar & verbose){ - pb<-txtProgressBar(min=0,max=diff(frame.range)+1, char="=", style=3) - } - - ##stepping for frame range - temp <- readBin(con, what = "raw", (min(frame.range)-1)*2, size = 1, endian = "little") - - for(i in 1:(diff(frame.range)+1)){#NumFrames - temp.data <- matrix(read.data(n.counts = (xdim * ydim)), - ncol = ydim, - nrow = xdim) - - if(exists("data.list") == FALSE){ - - data.list <- list(temp.data) - - }else{ - - data.list <- c(data.list, list(temp.data)) - - } - - ##update progress bar - if(txtProgressBar & verbose){ - setTxtProgressBar(pb, i) - } - - } - - ##close - if(txtProgressBar & verbose){ - close(pb) - cat("\t >>", i,"records have been read successfully!\n\n") - } - - # Output ------------------------------------------------------------------ - - if(output.object == "RLum.Data.Spectrum" | output.object == "matrix"){ - ##to create a spectrum object the matrix has to transposed and - ##the row sums are needed - - data.spectrum.vector <- sapply(1:length(data.list), function(x){ - rowSums(data.list[[x]]) - - }) - - ##split vector to matrix - data.spectrum.matrix <- matrix(data.spectrum.vector, - nrow = xdim, - ncol = length(data.list)) - - ##set column and row names - colnames(data.spectrum.matrix) <- as.character(1:ncol(data.spectrum.matrix)) - rownames(data.spectrum.matrix) <- as.character(1:nrow(data.spectrum.matrix)) - - - ##set output object - object <- set_RLum( - class = "RLum.Data.Spectrum", - originator = "read_SPE2R", - recordType = "Spectrum", - curveType = "measured", - data = data.spectrum.matrix, - info = temp.info) - - ##optional matrix object - if (output.object == "matrix") { - object <- get_RLum(object) - } - - - }else if(output.object == "RLum.Data.Image"){ - object <- as(data.list, "RLum.Data.Image") - object@originator <- "read_SPE2R" - object@recordType = "Image" - object@curveType <- "measured" - object@info <- temp.info - - } - - ##close con - close(con) - - ##return values - return(object) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_TIFF2R.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_TIFF2R.R deleted file mode 100644 index 5945130dc..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_TIFF2R.R +++ /dev/null @@ -1,57 +0,0 @@ -#'@title Import TIFF Image Data into R -#' -#'@description Simple wrapper around [tiff::readTIFF] to import TIFF images -#'and TIFF image stacks to be further processed within the package `'Luminescence'` -#' -#'@param file [character] (**required**): file name -#' -#'@param ... not in use, for compatibility reasons only -#' -#'@return [RLum.Data.Image-class] object -#' -#'@author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#'@section Function version: 0.1.2 -#' -#'@seealso [tiff::readTIFF], [RLum.Data.Image-class] -#' -#'@keywords IO -#' -#'@examples -#' -#'\dontrun{ -#'file <- file.choose() -#'image <- read_TIFF2R(file) -#' -#'} -#' -#'@md -#'@export -read_TIFF2R <- function( - file, - ... -){ -# Integrity --------------------------------------------------------------- - ## most of the users don't need this import, no need to bother them - ## with required libraries - if (!requireNamespace("tiff", quietly = TRUE)) - # nocov start - stop("Importing TIFF files requires the package tiff.\n", - "To install this package run 'install.packages('tiff')' in your R console.", - call. = FALSE) - # nocov end - - if(!file.exists(file)) - stop("[read_TIFF2R()] File does not exist or is not readable!", call. = FALSE) - -# Import ------------------------------------------------------------------ - ## import - temp <- tiff::readTIFF(file, all = TRUE, as.is = TRUE) - - if(is(temp, "list")) - temp <- as(temp, "RLum.Data.Image") - -# Return ------------------------------------------------------------------ - set_RLum(class = "RLum.Data.Image", data = temp@data) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_XSYG2R.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_XSYG2R.R deleted file mode 100644 index 8f8e56333..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/read_XSYG2R.R +++ /dev/null @@ -1,732 +0,0 @@ -#' @title Import XSYG files to R -#' -#' @description Imports XSYG-files produced by a Freiberg Instruments lexsyg reader into R. -#' -#' @details -#' **How does the import function work?** -#' -#' The function uses the `'XML'` package to parse the file structure. Each -#' sequence is subsequently translated into an [RLum.Analysis-class] object. -#' -#' **General structure XSYG format** -#' -#' ``` -#' -#' -#' -#' -#' -#' x0 , y0 ; x1 , y1 ; x2 , y2 ; x3 , y3 -#' -#' -#' -#' ``` -#' -#' So far, each -#' XSYG file can only contain one ``, but multiple -#' sequences. -#' -#' Each record may comprise several curves. -#' -#' **TL curve recalculation** -#' -#' On the FI lexsyg device TL curves are recorded as time against count values. -#' Temperature values are monitored on the heating plate and stored in a -#' separate curve (time vs. temperature). If the option -#' `recalculate.TL.curves = TRUE` is chosen, the time values for each TL -#' curve are replaced by temperature values. -#' -#' Practically, this means combining two matrices (Time vs. Counts and Time vs. -#' Temperature) with different row numbers by their time values. Three cases -#' are considered: -#' -#' 1. HE: Heating element -#' 2. PMT: Photomultiplier tube -#' 3. Interpolation is done using the function [approx] -#' -#' CASE (1): `nrow(matrix(PMT))` > `nrow(matrix(HE))` -#' -#' Missing temperature values from the heating element are calculated using -#' time values from the PMT measurement. -#' -#' CASE (2): `nrow(matrix(PMT))` < `nrow(matrix(HE))` -#' -#' Missing count values from the PMT are calculated using time values from the -#' heating element measurement. -#' -#' CASE (3): `nrow(matrix(PMT))` == `nrow(matrix(HE))` -#' -#' A new matrix is produced using temperature values from the heating element -#' and count values from the PMT. -#' -#' **Note:** -#' Please note that due to the recalculation of the temperature -#' values based on values delivered by the heating element, it may happen that -#' multiple count values exists for each temperature value and temperature -#' values may also decrease during heating, not only increase. -#' -#' **Advanced file import** -#' -#' To allow for a more efficient usage of the function, instead of single path -#' to a file just a directory can be passed as input. In this particular case -#' the function tries to extract all XSYG-files found in the directory and import -#' them all. Using this option internally the function constructs as list of -#' the XSYG-files found in the directory. Please note no recursive detection -#' is supported as this may lead to endless loops. -#' -#' @param file [character] or [list] (**required**): -#' path and file name of the XSYG file. If input is a `list` it should comprise -#' only `character`s representing each valid path and XSYG-file names. -#' Alternatively the input character can be just a directory (path), in this case the -#' the function tries to detect and import all XSYG-files found in the directory. -#' -#' @param recalculate.TL.curves [logical] (*with default*): -#' if set to `TRUE`, TL curves are returned as temperature against count values -#' (see details for more information) Note: The option overwrites the time vs. -#' count TL curve. Select `FALSE` to import the raw data delivered by the -#' lexsyg. Works for TL curves and spectra. -#' -#' @param fastForward [logical] (*with default*): -#' if `TRUE` for a more efficient data processing only a list of [RLum.Analysis-class] -#' objects is returned. -#' -#' @param import [logical] (*with default*): -#' if set to `FALSE`, only the XSYG file structure is shown. -#' -#' @param pattern [regex] (*with default*): -#' optional regular expression if `file` is a link to a folder, to select just -#' specific XSYG-files -#' -#' @param verbose [logical] (*with default*): enable or disable verbose mode. If verbose is `FALSE` -#' the `txtProgressBar` is also switched off -#' -#' @param txtProgressBar [logical] (*with default*): -#' enables `TRUE` or disables `FALSE` the progress bar during import -#' -#' @return -#' **Using the option `import = FALSE`** -#' -#' A list consisting of two elements is shown: -#' - [data.frame] with information on file. -#' - [data.frame] with information on the sequences stored in the XSYG file. -#' -#' **Using the option `import = TRUE` (default)** -#' -#' A list is provided, the list elements -#' contain: \item{Sequence.Header}{[data.frame] with information on the -#' sequence.} \item{Sequence.Object}{[RLum.Analysis-class] -#' containing the curves.} -#' -#' @note -#' This function is a beta version as the XSYG file format is not yet -#' fully specified. Thus, further file operations (merge, export, write) should -#' be done using the functions provided with the package `'XML'`. -#' -#' **So far, no image data import is provided!** \cr -#' Corresponding values in the XSXG file are skipped. -#' -#' -#' @section Function version: 0.6.12 -#' -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' -#' @seealso `'XML'`, [RLum.Analysis-class], [RLum.Data.Curve-class], [approx] -#' -#' -#' @references -#' Grehl, S., Kreutzer, S., Hoehne, M., 2013. Documentation of the -#' XSYG file format. Unpublished Technical Note. Freiberg, Germany -#' -#' **Further reading** -#' -#' XML: [https://en.wikipedia.org/wiki/XML]() -#' -#' @keywords IO -#' -#' @examples -#' -#' ##(1) import XSYG file to R (uncomment for usage) -#' -#' #FILE <- file.choose() -#' #temp <- read_XSYG2R(FILE) -#' -#' ##(2) additional examples for pure XML import using the package XML -#' ## (uncomment for usage) -#' -#' ##import entire XML file -#' #FILE <- file.choose() -#' #temp <- XML::xmlRoot(XML::xmlTreeParse(FILE)) -#' -#' ##search for specific subnodes with curves containing 'OSL' -#' #getNodeSet(temp, "//Sample/Sequence/Record[@@recordType = 'OSL']/Curve") -#' -#' ##(2) How to extract single curves ... after import -#' data(ExampleData.XSYG, envir = environment()) -#' -#' ##grep one OSL curves and plot the first curve -#' OSLcurve <- get_RLum(OSL.SARMeasurement$Sequence.Object, recordType="OSL")[[1]] -#' -#' ##(3) How to see the structure of an object? -#' structure_RLum(OSL.SARMeasurement$Sequence.Object) -#' -#' @md -#' @export -read_XSYG2R <- function( - file, - recalculate.TL.curves = TRUE, - fastForward = FALSE, - import = TRUE, - pattern = ".xsyg", - verbose = TRUE, - txtProgressBar = TRUE -){ - - ##TODO: this function should be reshaped: - ## - metadata from the sequence should go into the info slot of the RLum.Analysis object - ## >> however, the question is whether this works with subsequent functions - ## - currently not all metadata are supported, it should be extended - ## - the should be a mode importing ALL metadata - ## - xlum should be general, xsyg should take care about subsequent details - - # Self Call ----------------------------------------------------------------------------------- - # Option (a): Input is a list, every element in the list will be treated as file connection - # with that many file can be read in at the same time - # Option (b): The input is just a path, the function tries to grep ALL xsyg/XSYG files in the - # directory and import them, if this is detected, we proceed as list - if(is(file, "character")) { - ##If this is not really a path we skip this here - if (dir.exists(file) & length(dir(file)) > 0) { - if (verbose) - message("\n[read_XSYG2R()] Directory detected, trying to extract ", - "'*.xsyg' files ...\n") - file <- as.list(dir(file, recursive = TRUE, pattern = pattern)) - if (length(file) == 0) { - if (verbose) - message("[read_XSYG2R()] No files matching the given pattern ", - "found in directory, NULL returned") - return(NULL) - } - } - } - - if (is(file, "list")) { - temp.return <- lapply(1:length(file), function(x) { - read_XSYG2R( - file = file[[x]], - recalculate.TL.curves = recalculate.TL.curves, - fastForward = fastForward, - import = import, - verbose = verbose, - txtProgressBar = txtProgressBar - ) - }) - - ##return - if (fastForward) { - if(import){ - return(unlist(temp.return, recursive = FALSE)) - - } else{ - return(as.data.frame(data.table::rbindlist(temp.return))) - } - - } else{ - return(temp.return) - - } - - } - -# Consistency check ----------------------------------------------------------- - ## check for URL and attempt download - if(verbose) - url_file <- .download_file(file, tempfile("read_XSYG2R_FILE")) - else - url_file <- suppressMessages(.download_file(file, tempfile("read_XSYG2R_FILE"))) - - if(!is.null(url_file)) - file <- url_file - - ## normalise path, just in case - file <- suppressWarnings(normalizePath(file)) - - # (0) config -------------------------------------------------------------- - #version.supported <- c("1.0") - - #additional functions - #get spectrum values - # TODO: This function could be written also in C++, however, not necessary due to a low demand - get_XSYG.spectrum.values <- function(curve.node){ - ##1st grep wavelength table - wavelength <- XML::xmlAttrs(curve.node)["wavelengthTable"] - - ##string split - wavelength <- as.numeric(unlist(strsplit(wavelength, split = ";", fixed = TRUE))) - - ##2nd grep time values - curve.node <- unlist(strsplit(XML::xmlValue(curve.node), split = ";", fixed = TRUE)) - curve.node <- strsplit(curve.node, split = ",", fixed = TRUE) - curve.node.time <- as.numeric(vapply(curve.node, function(x) x[1], character(1))) - - curve.node.time <- as.numeric(vapply(curve.node, function(x) x[1], character(1))) - - ##3rd grep count values - curve.node.count <- vapply(curve.node, function(x) { - if(length(x) == 2) - x[2] - else - x[3] - }, character(1)) - - ##remove from pattern... - curve.node.count <- do.call("gsub", list(pattern="[[]|[]]", replacement=" ", - x=curve.node.count)) - - ##4th combine to spectrum matrix - spectrum.matrix <- matrix(NA, nrow = length(wavelength), ncol = length(curve.node.time)) - for(i in 1:length(curve.node.time)) { - tmp <- as.numeric(unlist(strsplit(curve.node.count[i], "[|]"))) - if(length(tmp) == length(wavelength)) - spectrum.matrix[,i] <- tmp - - } - - ## remove NA values from matrix - id_NA <- colSums(is.na(spectrum.matrix)) != nrow(spectrum.matrix) - spectrum.matrix <- spectrum.matrix[, id_NA] - - ##change row names (rows are wavelength) - rownames(spectrum.matrix) <- round(wavelength, digits = 3) - - ##change column names (columns are time/temp values) - colnames(spectrum.matrix) <- round(curve.node.time[id_NA], digits=3) - - return(spectrum.matrix) - } - - # (1) Integrity tests ----------------------------------------------------- - - ##set HUGE for larger nodes - HUGE <- 524288 - - ##parse XML tree using the package XML - temp <- try( - XML::xmlRoot(XML::xmlTreeParse(file, useInternalNodes = TRUE, options = HUGE, error = NULL)), - silent = TRUE) - - ##show error - if(is(temp, "try-error") == TRUE){ - if(verbose) message("[read_XSYG2R()] XML file not readable, nothing imported!") - return(NULL) - } - - # (2) Further file processing --------------------------------------------- - - ##==========================================================================## - ##SHOW STRUCTURE - if(import == FALSE){ - ##sample information - temp.sample <- as.data.frame(XML::xmlAttrs(temp), stringsAsFactors = FALSE) - - ##grep sequences files - - ##set data.frame - temp.sequence.header <- data.frame(t(1:length(names(XML::xmlAttrs(temp[[1]])))), - stringsAsFactors = FALSE) - - colnames(temp.sequence.header) <- names(XML::xmlAttrs(temp[[1]])) - - ##fill information in data.frame - for(i in 1:XML::xmlSize(temp)){ - temp.sequence.header[i,] <- t(XML::xmlAttrs(temp[[i]])) - - } - - ##additional option for fastForward == TRUE - if(fastForward){ - - ##change column header - temp.sample <- t(temp.sample) - colnames(temp.sample) <- paste0("sample::", colnames(temp.sample)) - output <- cbind(temp.sequence.header, temp.sample) - - }else{ - output <- list(Sample = temp.sample, Sequences = temp.sequence.header) - } - - return(output) - - } else { - ##==========================================================================## - ##IMPORT XSYG FILE - - ##Display output - if(verbose) - cat("[read_XSYG2R()]\n Importing: ", file) - - ##PROGRESS BAR - if(verbose && txtProgressBar){ - pb <- txtProgressBar(min=0,max=XML::xmlSize(temp), char = "=", style=3) - } - - ##loop over the entire sequence by sequence - output <- lapply(1:XML::xmlSize(temp), function(x){ - - ##read sequence header - temp.sequence.header <- as.data.frame(XML::xmlAttrs(temp[[x]]), stringsAsFactors = FALSE) - - ##account for non set value - if(length(temp.sequence.header)!= 0) - colnames(temp.sequence.header) <- "" - - ###----------------------------------------------------------------------- - ##LOOP - ##read records >> records are combined to one RLum.Analysis object - temp.sequence.object <- unlist(lapply(1:XML::xmlSize(temp[[x]]), function(i){ - - ##get recordType - temp.sequence.object.recordType <- try(XML::xmlAttrs(temp[[x]][[i]])["recordType"], - silent = TRUE) - - - ##the XSYG file might be broken due to a machine error during the measurement, this - ##control flow helps; if a try-error is observed NULL is returned - if(!inherits(temp.sequence.object.recordType, "try-error")){ - - ##create a fallback, the function should not fail - if(is.null(temp.sequence.object.recordType) || is.na(temp.sequence.object.recordType)){ - temp.sequence.object.recordType <- "not_set" - } - - ##correct record type in depending on the stimulator - if(temp.sequence.object.recordType == "OSL"){ - - if(XML::xmlAttrs(temp[[x]][[i]][[ - XML::xmlSize(temp[[x]][[i]])]])["stimulator"] == "ir_LED_850" | - XML::xmlAttrs(temp[[x]][[i]][[ - XML::xmlSize(temp[[x]][[i]])]])["stimulator"] == "ir_LD_850"){ - - temp.sequence.object.recordType <- "IRSL" - } - } - - ##loop 3rd level - lapply(1:XML::xmlSize(temp[[x]][[i]]), function(j){ - - ##get values - temp.sequence.object.curveValue <- temp[[x]][[i]][[j]] - - ##get curveType - temp.sequence.object.curveType <- as.character( - XML::xmlAttrs(temp[[x]][[i]][[j]])["curveType"]) - - ##get detector - temp.sequence.object.detector <- as.character( - XML::xmlAttrs(temp[[x]][[i]][[j]])["detector"]) - - ##get stimulator - temp.sequence.object.stimulator <- as.character( - XML::xmlAttrs(temp[[x]][[i]][[j]])["stimulator"]) - - ##get additional information - temp.sequence.object.info <- as.list(XML::xmlAttrs(temp.sequence.object.curveValue)) - - ##add stimulator and detector and so on - temp.sequence.object.info <- c(temp.sequence.object.info, - position = as.integer(as.character(temp.sequence.header["position",])), - name = as.character(temp.sequence.header["name",])) - - - ## TL curve recalculation ============================================ - if(recalculate.TL.curves){ - - ##TL curve heating values is stored in the 3rd curve of every set - if(temp.sequence.object.recordType == "TL" && j == 1){ - - #grep values from PMT measurement or spectrometer - if("Spectrometer" %in% temp.sequence.object.detector == FALSE){ - - temp.sequence.object.curveValue.PMT <- src_get_XSYG_curve_values(XML::xmlValue( - temp[[x]][[i]][[j]])) - - ##round values (1 digit is the technical resolution of the heating element) - temp.sequence.object.curveValue.PMT[,1] <- round( - temp.sequence.object.curveValue.PMT[,1], digits = 1) - - #grep values from heating element - temp.sequence.object.curveValue.heating.element <- src_get_XSYG_curve_values(XML::xmlValue( - temp[[x]][[i]][[3]])) - - }else{ - - temp.sequence.object.curveValue.spectrum <- get_XSYG.spectrum.values( - temp.sequence.object.curveValue) - - ##get time values which are stored in the row labels - temp.sequence.object.curveValue.spectrum.time <- as.numeric( - colnames(temp.sequence.object.curveValue.spectrum)) - - ##round values (1 digit is technical resolution of the heating element) - temp.sequence.object.curveValue.spectrum.time <- round( - temp.sequence.object.curveValue.spectrum.time, digits = 1) - } - - #grep values from heating element - temp.sequence.object.curveValue.heating.element <- src_get_XSYG_curve_values(XML::xmlValue( - temp[[x]][[i]][[3]])) - - - if("Spectrometer" %in% temp.sequence.object.detector == FALSE){ - - #reduce matrix values to values of the detection - temp.sequence.object.curveValue.heating.element <- - temp.sequence.object.curveValue.heating.element[ - temp.sequence.object.curveValue.heating.element[,1] >= - min(temp.sequence.object.curveValue.PMT[,1]) & - temp.sequence.object.curveValue.heating.element[,1] <= - max(temp.sequence.object.curveValue.PMT[,1]), ,drop = FALSE] - }else{ - - #reduce matrix values to values of the detection - temp.sequence.object.curveValue.heating.element <- - temp.sequence.object.curveValue.heating.element[ - temp.sequence.object.curveValue.heating.element[,1] >= - min(temp.sequence.object.curveValue.spectrum.time) & - temp.sequence.object.curveValue.heating.element[,1] <= - max(temp.sequence.object.curveValue.spectrum.time),] - } - - ## calculate corresponding heating rate, this makes only sense - ## for linear heating, therefore is has to be the maximum value - - ##remove 0 values (not measured) and limit to peak - heating.rate.values <- temp.sequence.object.curveValue.heating.element[ - temp.sequence.object.curveValue.heating.element[,2] > 0 & - temp.sequence.object.curveValue.heating.element[,2] <= - max(temp.sequence.object.curveValue.heating.element[,2]),,drop = FALSE] - - heating.rate <- (heating.rate.values[length(heating.rate.values[,2]), 2] - - heating.rate.values[1,2])/ - (heating.rate.values[length(heating.rate.values[,1]), 1] - - heating.rate.values[1,1]) - - ##round values - heating.rate <- round(heating.rate, digits=1) - - ##add to info element - temp.sequence.object.info <- c(temp.sequence.object.info, - RATE = heating.rate) - - ##PERFORM RECALCULATION - ##check which object contains more data - if("Spectrometer" %in% temp.sequence.object.detector == FALSE){ - ##CASE (1) - if(nrow(temp.sequence.object.curveValue.PMT) > - nrow(temp.sequence.object.curveValue.heating.element)){ - temp.sequence.object.curveValue.heating.element.i <- approx( - x = temp.sequence.object.curveValue.heating.element[,1], - y = temp.sequence.object.curveValue.heating.element[,2], - xout = temp.sequence.object.curveValue.PMT[,1], - rule = 2) - - temperature.values <- - temp.sequence.object.curveValue.heating.element.i$y - - count.values <- - temp.sequence.object.curveValue.PMT[,2] - - ##CASE (2) - }else if((nrow(temp.sequence.object.curveValue.PMT) < - nrow(temp.sequence.object.curveValue.heating.element))){ - - temp.sequence.object.curveValue.PMT.i <- approx( - x = temp.sequence.object.curveValue.PMT[,1], - y = temp.sequence.object.curveValue.PMT[,2], - xout = temp.sequence.object.curveValue.heating.element[,1], - rule = 2) - - temperature.values <- - temp.sequence.object.curveValue.heating.element[,2] - - count.values <- temp.sequence.object.curveValue.PMT.i$y - - ##CASE (3) - }else{ - - temperature.values <- - temp.sequence.object.curveValue.heating.element[,2] - - count.values <- temp.sequence.object.curveValue.PMT[,2] - } - - ##combine as matrix - temp.sequence.object.curveValue <- as.matrix(cbind( - temperature.values, - count.values)) - - ##set curve identifier - temp.sequence.object.info$curveDescripter <- "Temperature [\u00B0C]; Counts [a.u.]" - - }else{ - ##CASE (1) here different approach. in contrast to the PMT measurements, as - ## usually the resolution should be much, much lower for such measurements - ## Otherwise we would introduce some pseudo signals, as we have to - ## take care of noise later one - - if(length(temp.sequence.object.curveValue.spectrum.time) != - nrow(temp.sequence.object.curveValue.heating.element)){ - - temp.sequence.object.curveValue.heating.element.i <- approx( - x = temp.sequence.object.curveValue.heating.element[,1], - y = temp.sequence.object.curveValue.heating.element[,2], - xout = temp.sequence.object.curveValue.spectrum.time, - rule = 2, - ties = mean, - na.rm = FALSE) - - temperature.values <- - temp.sequence.object.curveValue.heating.element.i$y - - ##check for duplicated values and if so, increase this values - if(anyDuplicated(temperature.values)>0){ - - temperature.values[which(duplicated(temperature.values))] <- - temperature.values[which(duplicated(temperature.values))]+1 - .throw_warning("Temperature values are found to be ", - "duplicated and increased by 1 K") - } - - ##CASE (2) (equal) - }else{ - temperature.values <- - temp.sequence.object.curveValue.heating.element[,2] - } - - ##reset values of the matrix - colnames(temp.sequence.object.curveValue.spectrum) <- temperature.values - temp.sequence.object.curveValue <- temp.sequence.object.curveValue.spectrum - - ##change curve descriptor - temp.sequence.object.info$curveDescripter <- "Temperature [\u00B0C]; Wavelength [nm]; Counts [1/ch]" - } - - }##endif - }##endif recalculate.TL.curves == TRUE - - - # Cleanup info objects ------------------------------------------------------------------------ - if("curveType" %in% names(temp.sequence.object.info)) - temp.sequence.object.info[["curveType"]] <- NULL - - # Set RLum.Data-objects ----------------------------------------------------------------------- - if("Spectrometer" %in% temp.sequence.object.detector == FALSE){ - - if(is(temp.sequence.object.curveValue, "matrix") == FALSE){ - - temp.sequence.object.curveValue <- - src_get_XSYG_curve_values(XML::xmlValue(temp.sequence.object.curveValue)) - } - - set_RLum( - class = "RLum.Data.Curve", - originator = "read_XSYG2R", - recordType = paste(temp.sequence.object.recordType, - " (", temp.sequence.object.detector,")", - sep = ""), - curveType = temp.sequence.object.curveType, - data = temp.sequence.object.curveValue, - info = temp.sequence.object.info) - - }else if("Spectrometer" %in% temp.sequence.object.detector == TRUE) { - - - if(is(temp.sequence.object.curveValue, "matrix") == FALSE){ - - temp.sequence.object.curveValue <- - get_XSYG.spectrum.values(temp.sequence.object.curveValue) - } - - set_RLum( - class = "RLum.Data.Spectrum", - originator = "read_XSYG2R", - recordType = paste(temp.sequence.object.recordType, - " (",temp.sequence.object.detector,")", - sep = ""), - curveType = temp.sequence.object.curveType, - data = temp.sequence.object.curveValue, - info = temp.sequence.object.info) - } - }) - - }else{ - - return(NULL) - - }##if-try condition - - }), - use.names = FALSE) - - ##if the XSYG file is broken we get NULL as list element - if (!is.null(temp.sequence.object)) { - ##set RLum.Analysis object - temp.sequence.object <- set_RLum( - originator = "read_XSYG2R", - class = "RLum.Analysis", - records = temp.sequence.object, - protocol = as.character(temp.sequence.header["protocol",1]), - info = list(file = file) - ) - - ##set parent uid of RLum.Anlaysis as parent ID of the records - temp.sequence.object <- .set_pid(temp.sequence.object) - - ##update progress bar - if (verbose && txtProgressBar) { - setTxtProgressBar(pb, x) - } - - ##merge output and return values - if(fastForward){ - return(temp.sequence.object) - - }else{ - return(list(Sequence.Header = temp.sequence.header, Sequence.Object = temp.sequence.object)) - } - - }else{ - return(temp.sequence.object) - } - - })##end loop for sequence list - - ##close ProgressBar - if(verbose && txtProgressBar ){close(pb)} - - ##show output information - if(length(output[sapply(output, is.null)]) == 0){ - - if(verbose) - paste("\t >>",XML::xmlSize(temp), " sequence(s) loaded successfully.\n") - - }else{ - - if(verbose){ - paste("\t >>",XML::xmlSize(temp), " sequence(s) in file.", XML::xmlSize(temp)-length(output[sapply(output, is.null)]), "sequence(s) loaded successfully. \n") - } - - .throw_warning(length(output[sapply(output, is.null)]), - " incomplete sequence(s) removed.") - } - - ##output - invisible(output) - - }#end if - - ##get rid of the NULL elements (as stated before ... invalid files) - return(output[!sapply(output,is.null)]) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/replicate_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/replicate_RLum.R deleted file mode 100644 index 230eb9ea8..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/replicate_RLum.R +++ /dev/null @@ -1,27 +0,0 @@ -#' General replication function for RLum S4 class objects -#' -#' Function replicates RLum S4 class objects and returns a list for this objects -#' -#' @param object [RLum-class] (**required**): -#' an [RLum-class] object -#' -#' @param times [integer] (*optional*): -#' number for times each element is repeated element -#' -#' @return Returns a [list] of the object to be repeated -#' -#' @section Function version: 0.1.0 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum-class] -#' -#' @keywords utilities -#' -#' @md -#' @export -setGeneric("replicate_RLum", function (object, times = NULL) { - standardGeneric("replicate_RLum") -}) - diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/report_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/report_RLum.R deleted file mode 100644 index 8f424644c..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/report_RLum.R +++ /dev/null @@ -1,753 +0,0 @@ -#' @title Create a HTML-report for (RLum) objects -#' -#' @details This function creates a HTML-report for a given object, listing its complete -#' structure and content. The object itself is saved as a serialised .Rds file. -#' The report file serves both as a convenient way of browsing through objects with -#' complex data structures as well as a mean of properly documenting and saving -#' objects. -#' -#' The HTML report is created with [rmarkdown::render] and has the -#' following structure: -#' -#' \tabular{ll}{ -#' **Section** \tab **Description** \cr -#' `Header` \tab A summary of general characteristics of the object \cr -#' `Object content` \tab A comprehensive list of the complete structure and content of the provided object. \cr -#' `Object structure` \tab Summary of the objects structure given as a table \cr -#' `File` \tab Information on the saved RDS file \cr -#' `Session Info` \tab Captured output from `sessionInfo()` \cr -#' `Plots` \tab (*optional*) For `RLum-class` objects a variable number of plots \cr -#' } -#' -#' The structure of the report can be controlled individually by providing one or more of the -#' following arguments (all `logical`): -#' -#' \tabular{ll}{ -#' **Argument** \tab **Description** \cr -#' `header` \tab Hide or show general information on the object \cr -#' `main` \tab Hide or show the object's content \cr -#' `structure` \tab Hide or show object's structure \cr -#' `rds` \tab Hide or show information on the saved RDS file \cr -#' `session` \tab Hide or show the session info \cr -#' `plot` \tab Hide or show the plots (depending on object) \cr -#' } -#' -#' Note that these arguments have higher precedence than `compact`. -#' -#' Further options that can be provided via the `...` argument: -#' -#' \tabular{ll}{ -#' **Argument** \tab **Description** \cr -#' `short_table` \tab If `TRUE` only show the first and last 5 rows of long tables. \cr -#' `theme` \tab Specifies the Bootstrap -#' theme to use for the report. Valid themes include `"default"`, `"cerulean"`, `"journal"`, `"flatly"`, -#' `"readable"`, `"spacelab"`, `"united"`, `"cosmo"`, `"lumen"`, `"paper"`, `"sandstone"`, -#' `"simplex"`, and `"yeti"`. \cr -#' `highlight` \tab Specifies the syntax highlighting style. -#' Supported styles include `"default"`, `"tango"`, `"pygments"`, `"kate"`, `"monochrome"`, -#' `"espresso"`, `"zenburn"`, `"haddock"`, and `"textmate"`. \cr -#' `css` \tab `TRUE` or `FALSE` to enable/disable custom CSS styling \cr -#' } -#' -#' The following arguments can be used to customise the report via CSS (Cascading Style Sheets): -#' -#' \tabular{ll}{ -#' **Argument** \tab **Description** \cr -#' `font_family` \tab Define the font family of the HTML document (default: `"arial"`) \cr -#' `headings_size` \tab Size of the `

` to `

` tags used to define HTML headings (default: 166%). \cr -#' `content_color` \tab Colour of the object's content (default: #a72925). \cr -#' } -#' -#' Note that these arguments must all be of class [character] and follow standard CSS syntax. -#' For exhaustive CSS styling you can provide a custom CSS file for argument `css.file`. -#' CSS styling can be turned of using `css = FALSE`. -#' -#' @param object (**required**): -#' The object to be reported on, preferably of any `RLum`-class. -#' -#' @param file [character] (*with default*): -#' A character string naming the output file. If no filename is provided a -#' temporary file is created. -#' -#' @param title [character] (*with default*): -#' A character string specifying the title of the document. -#' -#' @param compact [logical] (*with default*): -#' When `TRUE` the following report components are hidden: -#' `@@.pid`, `@@.uid`, `'Object structure'`, `'Session Info'` -#' and only the first and last 5 rows of long matrices and data frames are shown. -#' See details. -#' -#' @param timestamp [logical] (*with default*): -#' `TRUE` to add a timestamp to the filename (suffix). -#' -#' @param show_report [logical] (*with default*): If set to `TRUE` the function tries to display -#' the report output in the local viewer, e.g., within *RStudio* after rendering. -#' -#' @param launch.browser [logical] (*with default*): -#' `TRUE` to open the HTML file in the system's default web browser after -#' it has been rendered. -#' -#' @param css.file [character] (*optional*): -#' Path to a CSS file to change the default styling of the HTML document. -#' -#' @param quiet [logical] (*with default*): -#' `TRUE` to suppress printing of the pandoc command line. -#' -#' @param clean [logical] (*with default*): -#' `TRUE` to clean intermediate files created during rendering. -#' -#' @param ... further arguments passed to or from other methods and to control -#' the document's structure (see details). -#' -#' @section Function version: 0.1.5 -#' -#' @author -#' Christoph Burow, University of Cologne (Germany), -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) \cr -#' -#' @note -#' This function requires the R packages 'rmarkdown', 'pander' and 'rstudioapi'. -#' -#' @seealso [rmarkdown::render], [pander::pander_return], -#' [pander::openFileInOS], [rstudioapi::viewer], -#' [browseURL] -#' -#' @return -#' Writes a HTML and .Rds file. -#' -#' @examples -#' -#' \dontrun{ -#' ## Example: RLum.Results ---- -#' -#' # load example data -#' data("ExampleData.DeValues") -#' -#' # apply the MAM-3 age model and save results -#' mam <- calc_MinDose(ExampleData.DeValues$CA1, sigmab = 0.2) -#' -#' # create the HTML report -#' report_RLum(object = mam, file = "~/CA1_MAM.Rmd", -#' timestamp = FALSE, -#' title = "MAM-3 for sample CA1") -#' -#' # when creating a report the input file is automatically saved to a -#' # .Rds file (see saveRDS()). -#' mam_report <- readRDS("~/CA1_MAM.Rds") -#' all.equal(mam, mam_report) -#' -#' -#' ## Example: Temporary file & Viewer/Browser ---- -#' -#' # (a) -#' # Specifying a filename is not necessarily required. If no filename is provided, -#' # the report is rendered in a temporary file. If you use the RStudio IDE, the -#' # temporary report is shown in the interactive Viewer pane. -#' report_RLum(object = mam) -#' -#' # (b) -#' # Additionally, you can view the HTML report in your system's default web browser. -#' report_RLum(object = mam, launch.browser = TRUE) -#' -#' -#' ## Example: RLum.Analysis ---- -#' -#' data("ExampleData.RLum.Analysis") -#' -#' # create the HTML report (note that specifying a file -#' # extension is not necessary) -#' report_RLum(object = IRSAR.RF.Data, file = "~/IRSAR_RF") -#' -#' -#' ## Example: RLum.Data.Curve ---- -#' -#' data.curve <- get_RLum(IRSAR.RF.Data)[[1]] -#' -#' # create the HTML report -#' report_RLum(object = data.curve, file = "~/Data_Curve") -#' -#' ## Example: Any other object ---- -#' x <- list(x = 1:10, -#' y = runif(10, -5, 5), -#' z = data.frame(a = LETTERS[1:20], b = dnorm(0:9)), -#' NA) -#' -#' report_RLum(object = x, file = "~/arbitray_list") -#' } -#' -#' @md -#' @export -report_RLum <- function( - object, - file = tempfile(), - title = "RLum.Report", - compact = TRUE, - timestamp = TRUE, - show_report = TRUE, - launch.browser = FALSE, - css.file = NULL, - quiet = TRUE, - clean = TRUE, - ...) { - - ## ------------------------------------------------------------------------ ## - ## PRE-CHECKS ---- - - # check if required namespace(s) are available - # nocov start - for (package.name in c("rmarkdown", "pander")) { - if (!requireNamespace(package.name, quietly = TRUE)) - .throw_error("Creating object reports requires the '", package.name, - "' package. To install it, run 'install.packages('", - package.name, "')' in your R console.") - } - if (!requireNamespace("rstudioapi", quietly = TRUE)) { - .throw_warning("Creating object reports requires the 'rstudioapi' ", - "package. To install it, run 'install.packages('rstudioapi')' ", - "in your R console.") - isRStudio <- FALSE - } else { - isRStudio <- rstudioapi::isAvailable() - } - # nocov end - - # check if files exist - if (!is.null(css.file)) - if(!file.exists(css.file)) - .throw_error("Couldn't find the specified CSS file at '", css.file, "'") - - ## ------------------------------------------------------------------------ ## - ## STRUCTURE ---- - structure <- list(header = TRUE, - main = TRUE, - structure = ifelse(compact, FALSE, TRUE), - rds = TRUE, - session = ifelse(compact, FALSE, TRUE), - plot = TRUE) - - # specifying report components has higher precedence than the 'compact' arg - structure <- modifyList(structure, list(...)) - - - ## OPTIONS ---- - options <- list(short_table = ifelse(compact, TRUE, FALSE), - theme = "cerulean", - highlight = "haddock", - css = TRUE) - - options <- modifyList(options, list(...)) - - ## CSS DEFAULTS ---- - css <- list(font_family = "arial", - headings_size = "166%", - content_color = "#a72925") - - css <- modifyList(css, list(...)) - - ## ------------------------------------------------------------------------ ## - ## CREATE FILE ---- - - isTemp <- missing(file) - - # make sure the filename ends with .Rmd extension - if (!grepl(".rmd$", file, ignore.case = TRUE)) - file <- paste0(file, ".Rmd") - - # Timestamp: currently added as a suffix to the filename - # if we were to change it to a prefix, we need to first figure out the filename - # (i.e., separate it from the possible path) using the following regular - # expression strsplit(string, "\\\\|\\\\\\\\|\\/|\\/\\/"). This looks for - # \, \\, /, // and the last element is the filename. - if (timestamp) - file <- gsub(".rmd$", paste0(format(Sys.time(), "_%Y%b%d"), ".Rmd"), file, - ignore.case = TRUE) - - # sanitize file name - file <- gsub("\\\\", "\\/", file) - file.html <- gsub(".rmd$", ".html", file, ignore.case = TRUE) - file.rds <- gsub(".rmd$", ".Rds", file, ignore.case = TRUE) - - # Create and open the file - file.create(file) - tmp <- file(file, open = "wt", blocking = TRUE) - - # save RDS file - saveRDS(object, file.rds) - - # get object - elements <- .struct_RLum(object, root = deparse(substitute(object))) - - ## ------------------------------------------------------------------------ ## - ## WRITE CONTENT ---- - - # HEADER ---- - writeLines("---", tmp) - writeLines("title: RLum.Report", tmp) - writeLines("output:", tmp) - writeLines(" html_document:", tmp) - writeLines(" mathjax: null", tmp) - writeLines(" title: RLum.Report", tmp) - writeLines(paste(" theme:", options$theme), tmp) - writeLines(paste(" highlight:", options$highlight), tmp) - writeLines(" toc: true", tmp) - writeLines(" toc_float: true", tmp) - writeLines(" toc_depth: 6", tmp) - if (!is.null(css.file)) - writeLines(paste(" css:", css.file), tmp) - writeLines(" md_extensions: -autolink_bare_uris", tmp) - writeLines("---", tmp) - - # CASCADING STYLE SHEETS ---- - if (options$css) { - writeLines(paste0( - "" - ), - tmp) - } - - # INFO ---- - # check if Luminescence package is installed and get details - pkg <- as.data.frame(installed.packages(), row.names = FALSE) - if ("Luminescence" %in% pkg$Package) - pkg <- pkg[which(pkg$Package == "Luminescence"), ] - else - pkg <- data.frame(LibPath = "-", Version = "not installed", Built = "-") - - # Title - writeLines(paste("

", title, "

\n\n
"), tmp) - - # write information on R, Luminescence package, Object - if (structure$header) { - writeLines(paste("**Date:**", Sys.time(), "\n\n", - "**R version:**", R.version.string, "\n\n", - "**Luminescence package** \n\n", - "**  » Path:**", pkg$LibPath, "\n\n", - "**  » Version:**", pkg$Version, "\n\n", - "**  » Built:**", pkg$Built, "\n\n", - "**Object** \n\n", - "**  » Created:**", - tryCatch(paste(paste(strsplit(object@.uid, '-|\\.')[[1]][1:3], collapse = "-"), - strsplit(object@.uid, '-|\\.')[[1]][4]), - error = function(e) "-"), "\n\n", - "**  » Class:**", class(object), "\n\n", - "**  » Originator:**", - tryCatch(object@originator, error = function(e) "-"), "\n\n", - "**  » Name:**", deparse(substitute(object)), "\n\n", - "**  » Parent ID:**", - tryCatch(object@.pid, error = function(e) "-"), "\n\n", - "**  » Unique ID:**", - tryCatch(object@.uid, error = function(e) "-"), "\n\n", - "
"), - tmp) - - if (isTemp) { - writeLines(paste("Save report"), tmp) - writeLines(paste("Save data \n\n"), tmp) - } - - }#EndOf::Header - - - # OBJECT ---- - if (structure$main) { - for (i in 1:nrow(elements)) { - # SKIP ELEMENT? - # hide @.pid and @.uid if this is a shortened report (default) - if (elements$bud[i] %in% c(".uid", ".pid") && compact == TRUE) - next(); - - - # HEADER - short.name <- elements$bud[i] - links <- gsub("[^@$\\[]", "", as.character(elements$branch[i])) - type <- ifelse(nchar(links) == 0, "", substr(links, nchar(links), nchar(links))) - if (type == "[") - type = "" - - # HTML header level is determined by the elements depth in the object - # exception: first row is always the object's name and has depth zero - if (i == 1) - hlevel <- "#" - else - hlevel <- paste(rep("#", elements$depth[i]), collapse = "") - - # write header; number of dots represents depth in the object. because there - # may be duplicate header names, for each further occurrence of a name - # Zero-width non-joiner entities are added to the name (non visible) - writeLines(paste0(hlevel, " ", - "", - paste(rep("..", elements$depth[i]), collapse = ""), - type, - "", - paste(rep("‌", elements$bud.freq[i]), collapse = ""), - short.name[length(short.name)], - ifelse(elements$endpoint[i], "", paste0("{#root",i,"}")), - ##ifelse(elements$endpoint[i], "", "{#root}"), - "\n\n"), - tmp) - - # SUBHEADER - # contains information on Class, Length, Dimensions, Path - writeLines(paste0("
",
-                        "",
-                        " Class: ", elements$class[i],
-                        "",
-                        "   Length: ", elements$length[i],
-                        "",
-                        "   Dimensions: ",
-                        ifelse(elements$row[i] != 0, paste0(elements$row[i], ", ", elements$col[i]), "-"),
-                        "",
-                        "\n Path: ", gsub("@", "@", elements$branch[i]),
-                        "
", - "\n\n"), - tmp) - - # TABLE CONTENT - # the content of a branch is only printed if it was determined an endpoint - # in the objects structure - if (elements$endpoint[i]) { - table <- tryCatch(eval(parse(text = elements$branch[i])), - error = function(e) { - return(NULL) - }) - # exceptions: content may be NULL; convert raw to character to stay - # compatible with pander::pander - if (is.null(table) | length(table) == 0) - table <- "NULL" - if (any(class(table) == "raw")) - table <- as.character(table) - - # exception: surround objects of class "call" with
 tags to prevent
-        # HTML auto formatting
-        if (elements$class[i] == "call") {
-          table <- capture.output(table)
-          writeLines("
", tmp)
-          for (i in 1:length(table))
-            writeLines(table[i], tmp)
-          writeLines("
", tmp) - table <- NULL - } - - # shorten the table if it has more than 15 rows - if (options$short_table) { - if (is.matrix(table) || is.data.frame(table)) { - if (nrow(table) > 15) { - text <- pander::pander_return( - rbind(head(table, 5), tail(table, 5)), - caption = "shortened (only first and last five rows shown)") - - writeLines(text, tmp) - next - } - } - } - - # write table using pander and end each table with a horizontal line - writeLines(suppressWarnings(pander::pander_return(table)), tmp) - writeLines("\n\n
", tmp) - - } - } - }#EndOf::Main - - # OBJECT STRUCTURE ---- - if (structure$structure) { - writeLines(paste("\n\n# Object structure\n\n"), tmp) - - elements.html <- elements - elements.html$branch <- gsub("\\$", "$", elements$branch) - writeLines(pander::pander_return(elements.html, - justify = paste(rep("l", ncol(elements)), collapse = "")), - tmp) - writeLines("\n\n", tmp) - }#EndOf::Structure - - if (structure$rds) { - # SAVE SERIALISED OBJECT (.rds file) ---- - writeLines(paste("
# File \n\n"), tmp) - - writeLines(paste0("", - "", - "Click here to access the data file", "", - ""), tmp) - - writeLines(paste("\nThe R object was saved to ", normalizePath(file.rds), - ".", - "To import the object into your R session with the following command:", - paste0("
",
-                            "x <- readRDS('", normalizePath(file.rds), "')",
-                            "
"), - "**NOTE:** If you moved the file to another directory or", - "renamed the file you need to change the path/filename in the", - "code above accordingly!"), - tmp) - }#EndOf::File - - # SESSION INFO ---- - if (structure$session) { - writeLines(paste("\n\n
# Session Info\n\n"), tmp) - sessionInfo <- capture.output(sessionInfo()) - writeLines(paste(sessionInfo, collapse = "\n\n"), - tmp) - } - - # PLOTTING ---- - if (structure$plot) { - isRLumObject <- length(grep("RLum", class(object))) - - if (is.list(object)) - isRLumList <- all(sapply(object, function(x) inherits(x, "RLum.Data.Curve"))) - else - isRLumList <- FALSE - - if (isRLumObject | isRLumList) { - - # mutual exclusivity: it is either a list or an RLum-Object - if (isRLumList) - plotCommand <- "invisible(sapply(x, plot)) \n" - else - plotCommand <- "plot(x) \n" - - writeLines(paste("\n\n
# Plots\n\n"), tmp) - writeLines(paste0( - "```{r}\n", - "library(Luminescence) \n", - "x <- readRDS('", normalizePath(file.rds),"') \n", - plotCommand, - "```"), - tmp) - - if (inherits(object, "RLum.Results")) { - # AGE MODELS ---- - models <- c("calc_AverageDose", - "calc_CommonDose", - "calc_CentralDose", - "calc_FiniteMixture", - "calc_MinDose", - "calc_MaxDose", - "calc_IEU", - "calc_FuchsLang2001") - - if (object@originator %in% models) { - writeLines(paste0( - "```{r}\n", - "plot_AbanicoPlot(x) \n", - "plot_Histogram(x) \n", - "plot_KDE(x) \n", - "plot_ViolinPlot(x) \n", - "```"), - tmp) - } - } - - } - }#EndOf::Plot - - close(tmp) - ## ------------------------------------------------------------------------ ## - ## CLOSE & RENDER ---- - rmarkdown::render(file, clean = clean, quiet = quiet) - - ## ------------------------------------------------------------------------ ## - ## SHOW FILE ----- - - # SHOW REPORT IN RSTUDIOS VIEWER PANE ---- - # nocov start - if (isRStudio && show_report) { - if (isTemp) { - try(rstudioapi::viewer(file.html)) - } else { - # The Viewer Pane only works for files in a sessions temp directory - # see: https://support.rstudio.com/hc/en-us/articles/202133558-Extending-RStudio-with-the-Viewer-Pane - file.copy(file.html, file.path(tempdir(), "report.html"), overwrite = TRUE) - try(rstudioapi::viewer(file.path(tempdir(), "report.html"))) - } - } - - # launch browser if desired - # browseURL() listens on localhost to show the file with the problem that - # the download links dont work anymore. hence, we try to open the file - # with pander::openFileInOS and use browseURL() only as fallback - if (launch.browser) { - opened <- tryCatch(pander::openFileInOS(file.html), error = function(e) "error") - if (!is.null(opened)) - try(browseURL(file.html)) - } - # nocov end - - ## ------------------------------------------------------------------------ ## - ## CLEANUP ---- - - # note that 'clean' as also passed to rmarkdown::render - if (clean) - file.remove(file) - - invisible() -} - - -################################################################################ -## ## -## HELPER FUNCTIONS ## -## ## -################################################################################ - -# ---------------------------------------------------------------------------- # -# This is a recursive function that goes the objects structure and prints -# all slots/elements along with their class, length, depth. -# ---------------------------------------------------------------------------- # -.tree_RLum <- function(x, root) { - - if (missing(root)) - root <- deparse(substitute(x)) - - ## S4 object ----- - if (isS4(x)) { - - # print ----- - cat(c(root, .class(x), base::length(x), .depth(root), FALSE, .dimension(x), "\n"), sep = "|") - - for (slot in slotNames(x)) { - s4.root <- paste0(root, "@", slot) - .tree_RLum(slot(x, slot), root = s4.root) - } - invisible() - - ## List objects ----- - } else if (inherits(x, "list") | typeof(x) == "list" & !inherits(x, "data.frame")) { - - if (!is.null(names(x)) && length(x) != 0) { - - # print ----- - cat(c(root, .class(x), base::length(x), .depth(root), FALSE, .dimension(x), "\n"), sep = "|") - - element <- names(x) - - for (i in 1:length(x)) { - - if (grepl(" ", element[i])) - element[i] <- paste0("`", element[i], "`") - - if (element[i] == "") - list.root <- paste0(root, "[[", i, "]]") - else - list.root <- paste0(root, "$", element[i]) - - .tree_RLum(x[[i]], root = list.root) - } - } else if (length(x) != 0) { - - # print ----- - cat(c(root, .class(x), base::length(x), .depth(root), FALSE, .dimension(x), "\n"), sep = "|") - - element <- paste0("[[", seq(1, length(x),1), "]]") - - for (i in 1:length(x)) { - if (grepl(" ", element[i])) - element[i] <- paste0("`", element[i], "`") - - list.root <- paste0(root, element[i]) - .tree_RLum(x[[i]], root = list.root) - } - } else if (length(x) == 0) { - - cat(c(root, .class(x), base::length(x), .depth(root), FALSE, .dimension(x), "\n"), sep = "|") - - } - - invisible() - - ## Data frames ----- - } else if (inherits(x, "data.frame")) { - - if (any(sapply(x, function(col) { inherits(col, "matrix") } ))) { - - element <- names(x) - - for (i in 1:length(x)) { - if (grepl(" ", element[i])) - element[i] <- paste0("`", element[i], "`") - - list.root <- paste0(root, "$", element[[i]]) - .tree_RLum(x[[i]], root = list.root) - } - } else { - # print ---- - cat(c(root, .class(x), base::length(x), .depth(root), TRUE, .dimension(x), "\n"), sep = "|") - } - invisible() - - ## Last elements ----- - } else { - - # print ---- - cat(c(root, .class(x), base::length(x), .depth(root), TRUE, .dimension(x), "\n"), sep = "|") - - invisible() - } -} - -# ---------------------------------------------------------------------------- # -# a) Derive depth in the structure tree by splitting the directory by -# indicative accessors @, $, [[ -# b) Wrapper for dim() to cope with NULL values -# c) Wrapper for class() that collapses the classes of an object -# ---------------------------------------------------------------------------- # -.depth <- function(x) { - length(strsplit(x, split = "\\$|@|\\[\\[")[[1]]) - 1 -} -.dimension <- function(x) { - if (!is.null(dim(x))) - dim <- paste(dim(x), collapse = "|") - else - dim <- c(0, 0) -} -.class <- function(x) { - paste(class(x), collapse = "/") -} - -# ---------------------------------------------------------------------------- # -# This function captures the output of the real worker .tree_RLum and returns -# the structure of the object as a data.frame -# ---------------------------------------------------------------------------- # -.struct_RLum <- function(x, root) { - if (missing(root)) - root <- deparse(substitute(x)) - s <- capture.output(.tree_RLum(x, root = root)) - df <- as.data.frame(do.call(rbind, strsplit(s, "|", fixed = TRUE)), stringsAsFactors = FALSE) - names(df) <- c("branch", "class", "length", "depth", "endpoint", "row", "col") - df$depth <- as.integer(df$depth) - df$length <- as.numeric(df$length) - df$endpoint <- as.logical(df$endpoint) - df$row <- as.integer(df$row) - df$col <- as.integer(df$col) - df$bud <- do.call(c, lapply(strsplit(df$branch, "\\$|@|\\[\\["), - function(x) x[length(x)])) - if (length(grep("]", df$bud)) != 0) - df$bud[grep("]", df$bud)] <- paste0("[[", df$bud[grep("]", df$bud)]) - df$bud.freq <- NA # 1:nrow(df) - - # reorder data.frame - df <- df[ ,c("branch", "bud", "bud.freq", "class", - "length", "depth", "row", "col", "endpoint")] - - # for the report we must not have the same last element names of same - # depth (HTML cannot discriminate between #links of headers) - ## TODO: this is highly inefficient for unnamed list due to recurrent indices - dlevel <- max(table(df$bud)) - - for (i in 1:dlevel) { - unique.bud <- unique(df[is.na(df$bud.freq), ]$bud) - df[is.na(df$bud.freq), ][match(unique.bud, df[is.na(df$bud.freq), ]$bud), ]$bud.freq <- i - 1 - } - - invisible(df) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/scale_GammaDose.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/scale_GammaDose.R deleted file mode 100644 index b5c67692b..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/scale_GammaDose.R +++ /dev/null @@ -1,786 +0,0 @@ -#' Calculate the gamma dose deposited within a sample taking layer-to-layer -#' variations in radioactivity into account (according to Aitken, 1985) -#' -#' This function calculates the gamma dose deposited in a luminescence sample -#' taking into account layer-to-layer variations in sediment radioactivity. -#' The function scales user inputs of uranium, thorium and potassium based on -#' input parameters for sediment density, water content and given layer -#' thicknesses and distances to the sample. -#' -#' **User Input** -#' -#' To calculate the gamma dose which is deposited in a sample, the user needs -#' to provide information on those samples influencing the luminescence sample. -#' As a rule of thumb, all sediment layers within at least 30 cm radius from -#' the luminescence sample taken should be taken into account when calculating -#' the gamma dose rate. However, the actual range of gamma radiation might be -#' different, depending on the emitting radioelement, the water content and the -#' sediment density of each layer (Aitken, 1985). Therefore the user is -#' advised to provide as much detail as possible and physically sensible. -#' -#' The function requires a [data.frame] that is to be structured -#' in columns and rows, with samples listed in rows. The first column contains -#' information on the layer/sample ID, the second on the thickness (in cm) of -#' each layer, whilst column 3 should contain `NA` for all layers that are not -#' sampled for OSL/TL. For the layer the OSL/TL sample was taken from a numerical -#' value must be provided, which is the distance (in cm) measured from **bottom** -#' of the layer of interest. If the whole layer was sampled insert `0`. If the -#' sample was taken from *within* the layer, insert a numerical value `>0`, -#' which describes the distance from the middle of the sample to the bottom of -#' the layer in cm. Columns 4 to 9 should contain radionuclide concentrations -#' and their standard errors for -#' potassium (in %), thorium (in ppm) and uranium (in ppm). Columns 10 and 11 -#' give information on the water content and its uncertainty (standard error) -#' in %. The layer density (in g/cm3) should be given in column 12. No cell -#' should be left blank. Please ensure to keep the column titles as given in -#' the example dataset (`data('ExampleData.ScaleGammaDose')`, see examples). -#' -#' The user can decide which dose rate -#' conversion factors should be used to calculate the gamma dose rates. -#' The options are: -#' - `"Cresswelletal2018"` (Cresswell et al., 2018) -#' - `"Liritzisetal2013"` (Liritzis et al., 2013) -#' - `"Guerinetal2011"` (Guerin et al., 2011) -#' - `"AdamiecAitken1998"` (Adamiec and Aitken, 1998) -#' -#' -#' **Water content** -#' -#' The water content provided by the user should be calculated according to: -#' -#' \deqn{ ( Wet weight [g] - Dry weight [g] ) / Dry weight [g] * 100 } -#' -#' -#' **Calculations** -#' -#' After converting the radionuclide concentrations into dose rates, the -#' function will scale the dose rates based on the thickness of the layers, -#' the distances to the sample, the water content and the density of the sediment. -#' The calculations are based on Aitken (1985, Appendix H). As an example -#' (equivalent to Aitken, 1985), assuming three layers of sediment, where **L** is -#' inert and positioned in between the infinite thick and equally active -#' layers **A** and **B**, the dose in **L** and **B** due to **A** is given by -#' -#' \deqn{ {1-f(x)}D_A } -#' -#' Where `x` is the distance into the inert medium, so `f(x)` is the weighted -#' average fractional dose at `x` and `D_A` denotes that the dose is delivered by **A**. -#' `f(x)` is derived from table H1 (Aitken, 1985), when setting `z = x`. -#' Consequently, the dose in **A** and **L** due to **B** is given by -#' -#' \deqn{ {1 - f(t-x)}D_B } -#' -#' Here `t` is the thickness of **L** and the other parameters are denoted as above, -#' just for the dose being delivered by B. `f(t-x)` is derived from table H1 -#' (Aitken, 1985), when setting `z` equal to `t-x`. Following this, the dose in **L** -#' delivered by **A** and **B** is given by -#' -#' \deqn{ {2 - f(x) - f(t-x)}D_{AB} } -#' -#' Since **A** and **B** are equally active `D_{AB} = D_A = D_B`. -#' -#' The function uses the value of the fractional dose rate at the layer -#' boundary to start the calculation for the next layer. This way, the function -#' is able to scale the gamma dose rate accurately for distant layers when the -#' density and water content is not constant for the entire section. -#' -#' @param data [data.frame] (**required**): -#' A table containing all relevant information for each individual layer. The -#' table must have the following named columns: -#' -#' - `id` ([character]): an arbitrary id or name of each layer -#' - `thickness` ([numeric]): vertical extent of each layer in cm -#' - `sample_offset` ([logical]): distance of the sample in cm, -#' **measured from the BOTTOM OF THE TARGET LAYER**. Except for the target layer -#' all values must be `NA`. -#' - `K` ([numeric]): K nuclide content in % -#' - `K_se` ([numeric]): error on the K content -#' - `Th` ([numeric]): Th nuclide content in ppm -#' - `Th_se` ([numeric]): error on the Th content -#' - `U` ([numeric]): U nuclide content in ppm -#' - `U_se` ([numeric]): error on the U content -#' - `water_content` ([numeric]): water content of each layer in % -#' - `water_content_se` ([numeric]): error on the water content -#' - `density` ([numeric]): bulk density of each layer in g/cm^-3 -#' -#' @param conversion_factors [character] (*optional*): -#' The conversion factors used to calculate the dose rate from sediment -#' nuclide contents. Valid options are: -#' -#' - `"Cresswelletal2018"` (default) -#' - `"Liritzisetal2013"` -#' - `"Guerinetal2011"` -#' - `"AdamiecAitken1998"` -#' -#' @param fractional_gamma_dose [character] (*optional*): -#' Factors to scale gamma dose rate values. Valid options are: -#' -#' - `"Aitken1985"` (default): Table H1 in the appendix -#' -#' @param verbose [logical] (*optional*): -#' Show or hide console output (defaults to `TRUE`). -#' -#' @param plot [logical] (*optional*): -#' Show or hide the plot (defaults to `TRUE`). -#' -#' @param plot_single [logical] (*optional*): -#' Show all plots in one panel (defaults to `TRUE`). -#' -#' @param ... Further parameters passed to [barplot]. -#' -#' @return -#' -#' After performing the calculations the user is provided with different outputs. -#' 1. The total gamma dose rate received by the sample (+/- uncertainties) as a -#' print in the console. -#' 2. A plot showing the sediment sequence, the user input sample information -#' and the contribution to total gamma dose rate. -#' 3. RLum Results. If the user wishes to save these results, writing a script -#' to run the function and to save the results would look like this: -#' -#' ``` -#' mydata <- read.table("c:/path/to/input/file.txt") -#' results <- scale_GammaDose(mydata) -#' table <- get_RLum(results) -#' write.csv(table, "c:/path/to/results.csv") -#' ``` -#' -#' -----------------------------------\cr -#' `[ NUMERICAL OUTPUT ]`\cr -#' -----------------------------------\cr -#' -#' **`RLum.Results`**-object -#' -#' **slot:** **`@data`** -#' -#' \tabular{lll}{ -#' **Element** \tab **Type** \tab **Description**\cr -#' `$summary` \tab `data.frame` \tab summary of the model results \cr -#' `$data` \tab `data.frame` \tab the original input data \cr -#' `$dose_rates` \tab `list` \tab two `data.frames` for the scaled and infinite matrix dose rates \cr -#' `$tables` \tab `list` \tab several `data.frames` containing intermediate results \cr -#' `$args` \tab `character` \tab arguments of the call \cr -#' `$call` \tab `call` \tab the original function call \cr -#' } -#' -#' **slot:** **`@info`** -#' -#' Currently unused. -#' -#' ------------------------\cr -#' `[ PLOT OUTPUT ]`\cr -#' ------------------------\cr -#' -#' Three plots are produced: -#' -#' - A visualisation of the provided sediment layer structure to quickly -#' assess whether the data was provided and interpreted correctly. -#' - A scatter plot of the nuclide contents per layer (K, Th, U) as well as the -#' water content. This may help to correlate the dose rate contribution of -#' specific layers to the layer of interest. -#' - A barplot visualising the contribution of each layer to the total dose rate -#' received by the sample in the target layer. -#' -#' @section Function version: 0.1.2 -#' -#' @keywords datagen -#' -#' @note -#' **This function has BETA status. If possible, results should be** -#' **cross-checked.** -#' -#' @author Svenja Riedesel, Aberystwyth University (United Kingdom) \cr -#' Martin Autzen, DTU NUTECH Center for Nuclear Technologies (Denmark) \cr -#' Christoph Burow, University of Cologne (Germany) \cr -#' Based on an excel spreadsheet and accompanying macro written by Ian Bailiff. -#' -#' @seealso [ExampleData.ScaleGammaDose], -#' [BaseDataSet.ConversionFactors], [approx], [barplot] -#' -#' @references -#' -#' Aitken, M.J., 1985. Thermoluminescence Dating. Academic Press, London. -#' -#' Adamiec, G., Aitken, M.J., 1998. Dose-rate conversion factors: update. -#' Ancient TL 16, 37-46. -#' -#' Cresswell., A.J., Carter, J., Sanderson, D.C.W., 2018. -#' Dose rate conversion parameters: Assessment of nuclear data. -#' Radiation Measurements 120, 195-201. -#' -#' Guerin, G., Mercier, N., Adamiec, G., 2011. Dose-rate conversion -#' factors: update. Ancient TL, 29, 5-8. -#' -#' Liritzis, I., Stamoulis, K., Papachristodoulou, C., Ioannides, K., 2013. -#' A re-evaluation of radiation dose-rate conversion factors. Mediterranean -#' Archaeology and Archaeometry 13, 1-15. -#' -#' -#' @section Acknowledgements: -#' -#' We thank Dr Ian Bailiff for the provision of an excel spreadsheet, which has -#' been very helpful when writing this function. -#' -#' @examples -#' -#' # Load example data -#' data("ExampleData.ScaleGammaDose", envir = environment()) -#' x <- ExampleData.ScaleGammaDose -#' -#' # Scale gamma dose rate -#' results <- scale_GammaDose(data = x, -#' conversion_factors = "Cresswelletal2018", -#' fractional_gamma_dose = "Aitken1985", -#' verbose = TRUE, -#' plot = TRUE) -#' -#' get_RLum(results) -#' -#' @md -#' @export -scale_GammaDose <- function( - data, - conversion_factors = c("Cresswelletal2018", "Guerinetal2011", "AdamiecAitken1998", "Liritzisetal2013")[1], - fractional_gamma_dose = c("Aitken1985")[1], - verbose = TRUE, - plot = TRUE, - plot_single = TRUE, - ...) { - - ## HELPER FUNCTION ---- - # Wrapper for formatC to enforce precise digit printing - f <- function(x, d = 3) formatC(x, digits = d, format = "f") - - ## ------------------------------------------------------------------------ ## - ## LOAD TABLES - ## ------------------------------------------------------------------------ ## - - # To satisfy CRAN check ('no visible global binding') - BaseDataSet.ConversionFactors <- BaseDataSet.FractionalGammaDose <- NA - - load(system.file("data", "BaseDataSet.ConversionFactors.rda", - package = "Luminescence")) - load(system.file("data", "BaseDataSet.FractionalGammaDose.rda", - package = "Luminescence")) - - - ## ------------------------------------------------------------------------ ## - ## DEFAULT SETTINGS - ## ------------------------------------------------------------------------ ## - settings <- list( - main = "Contributions of each layer to the total \n gamma dose rate received by the sample", - xlab = "Contribution to total gamma dose rate (%) received by the sample", - cex = 1.0, - col = "grey", - info = list() - ) - # overwrite and append default values - settings <- modifyList(settings, list(...)) - - - ## ------------------------------------------------------------------------ ## - ## CHECK INPUT - ## ------------------------------------------------------------------------ ## - - ## Input data - # basic class and length check - if (!is.data.frame(data)) - stop("'data' must be a data frame.", call. = FALSE) - if (ncol(data) != 12) - stop("'data' must have 12 columns (currently ", ncol(data), ").", call. = FALSE) - - # make sure that it has the correct column names - colnames_expected <- c("id","thickness","sample_offset","K","K_se","Th","Th_se","U","U_se", - "water_content","water_content_se", "density") - if (is.null(names(data)) || any(names(data) != colnames_expected)) { - if (verbose) - warning("Unexpected column names for 'data'. New names were automatically assigned. ", - "Please make sure that columns are in proper order. See documentation.", call. = FALSE) - colnames(data) <- colnames_expected - } - # check if there is only one target layer - if (sum(!is.na(data$sample_offset)) != 1) - stop("Only one layer must be contain a numeric value in column 'sample_offset', all other rows must be `NA`.", call. = FALSE) - if (!is.numeric(data$sample_offset[which(!is.na(data$sample_offset))])) - stop("Non-numeric value in the the row of the target layer.", call. = FALSE) - if (data$sample_offset[which(!is.na(data$sample_offset))] < 0) - stop("The numeric value in 'sample_offset' must be positive.", call. = FALSE) - if (data$sample_offset[which(!is.na(data$sample_offset))] > data$thickness[which(!is.na(data$sample_offset))]) - stop("Impossible! Sample offset larger than the target-layer's thickness!", call. = FALSE) - - # conversion factors - if (length(conversion_factors) != 1 || !is.character(conversion_factors)) - stop("'conversion_factors' must be an object of length 1 and of class 'character'.", - call. = FALSE) - if (!conversion_factors %in% names(BaseDataSet.ConversionFactors)) - stop("Invalid 'conversion_factors'. Valid options: ", - paste(names(BaseDataSet.ConversionFactors), collapse = ", "), ".", - call. = FALSE) - - # tables for gamma dose fractions - if (length(fractional_gamma_dose) != 1 || !is.character(fractional_gamma_dose)) - stop("'fractional_gamma_dose' must be an object of length 1 and of class 'character'.", - call. = FALSE) - if (!fractional_gamma_dose %in% names(BaseDataSet.FractionalGammaDose)) - stop("Invalid 'fractional_gamma_dose'. Valid options: ", - paste(names(BaseDataSet.FractionalGammaDose), collapse = ", "), ".", - call. = FALSE) - - ## ------------------------------------------------------------------------ ## - ## Select tables - ## ------------------------------------------------------------------------ ## - conv_fac <- BaseDataSet.ConversionFactors[[conversion_factors]]$gamma - frac_dose <- BaseDataSet.FractionalGammaDose[[fractional_gamma_dose]] - - ## ------------------------------------------------------------------------ ## - ## CALCULATION - ## ------------------------------------------------------------------------ ## - dose_rate <- data.frame( - K = data$K * conv_fac$K[1], - K_re = sqrt( (data$K_se / data$K)^2 + conv_fac$K[2]^2 ), - Th = data$Th * conv_fac$Th[1], - Th_re = sqrt( (data$Th_se / data$Th)^2 + conv_fac$Th[2]^2 ), - U = data$U * conv_fac$U[1], - U_re = sqrt( (data$U_se / data$U)^2 + conv_fac$U[2]^2 ) - ) - - dose_rate$sum <- dose_rate$K + dose_rate$Th + dose_rate$U - dose_rate$sum_re <- sqrt(dose_rate$K_re^2 + dose_rate$Th_re^2 + dose_rate$U_re^2) - dose_rate$K_frac <- dose_rate$K / dose_rate$sum - dose_rate$K_frac_re <- sqrt(dose_rate$K_re^2 + dose_rate$sum_re^2 ) - dose_rate$Th_frac <- dose_rate$Th / dose_rate$sum - dose_rate$Th_frac_re <- sqrt(dose_rate$Th_re^2 + dose_rate$sum_re^2 ) - dose_rate$U_frac <- dose_rate$U / dose_rate$sum - dose_rate$U_frac_re <- sqrt(dose_rate$U_re^2 + dose_rate$sum_re^2 ) - - ## weighted fractional dose - z_scale <- do.call(cbind, Map(function(d, wc) { - (frac_dose$z * 2) / (d + ( (wc / 100) * d)) - }, data$density, data$water_content)) - - layer_fracDoseRate <- do.call(cbind, Map(function(K, Th, U, K_re, Th_re, U_re) { - data.frame( - val = frac_dose$K * K + frac_dose$Th * Th + frac_dose$U * U, - err = sqrt( K_re^2 + Th_re^2 + U_re^2 ) - ) - }, dose_rate$K_frac, dose_rate$Th_frac, dose_rate$U_frac, - dose_rate$K_frac_re, dose_rate$Th_frac_re, dose_rate$U_frac_re)) - - ## TODO: LEGACY CODE - target <- which(!is.na(data$sample_offset)) - distance <- data.frame(upper = c(rev(cumsum(data$thickness[target:1])[-1]) - data$sample_offset[target], - abs(data$sample_offset[target]), - cumsum(data$thickness[(target+1):nrow(data)]) + data$sample_offset[target])) - distance$lower <- abs(distance$upper - data$thickness) - - ## Calculate infitite dose rate and dose received by the sample - ## MAP: iterate over LAYERS - Inf_frac <- as.data.frame(do.call(rbind, Map(function(z, n) { - - interpol <- Map(function(x) { - approx(z, x, n = 1000, method = "linear") - }, frac_dose[, c("K", "Th", "U")]) - - x1 = data$thickness[n] - x2 = 0 - C1 = which.min(abs(interpol$K$x - x1)) - C2 = which.min(abs(interpol$K$x - x2)) - - ## MAP: iterate over NUCLIDE - do.call(cbind, Map(function(x) { - - y1 = interpol[[x]]$y[C1] - y2 = interpol[[x]]$y[C2] - - ### ---- - if (n != target) { - - if (n < target) { - k <- n + 1 - seq <- k:target - } else if (n > target) { - k <- n - 1 - seq <- target:k - } - - for (j in seq) { - fit <- approx(z_scale[ ,j], frac_dose[ , x], n = 1000, method = "linear") - x1_temp <- which.min(abs(fit$y - y1)) - x2_temp <- which.min(abs(fit$y - y2)) - - if (j != target) { - x1 <- fit$x[x1_temp] + data$thickness[j] - x2 <- fit$x[x2_temp] + data$thickness[j] - } - if (j == target) { - - if (n < target) { - x1 <- fit$x[x1_temp] + data$thickness[target] - data$sample_offset[target] - x2 <- fit$x[x2_temp] + data$thickness[target] - data$sample_offset[target] - } - - if (n > target) { - x1 <- fit$x[x1_temp] + data$sample_offset[target] - x2 <- fit$x[x2_temp] + data$sample_offset[target] - } - - - } - - C1_temp <- which.min(abs(fit$x - x1)) - C2_temp <- which.min(abs(fit$x - x2)) - - y1 <- fit$y[C1_temp] - y2 <- fit$y[C2_temp] - } - r <- y1 - y2 - } - - ### ---- - if (n == target) { - x1 <- data$sample_offset[target] - x2 <- abs(data$thickness[target] - data$sample_offset[target]) - - C1_temp <- which.min(abs(interpol[[x]]$x - x1)) - C2_temp <- which.min(abs(interpol[[x]]$x - x2)) - - r <- interpol[[x]]$y[C1_temp] + interpol[[x]]$y[C2_temp] - 1 - } - - return(r) - }, c("K", "Th", "U"))) - - }, as.data.frame(z_scale), 1:nrow(data)))) - - - ## Generate output object - op <- setNames(vector(mode = "list", length = 17), - nm = c("K","K_se","Th","Th_se","U","U_se","sum","sum_se", - "K_inf","K_inf_se","Th_inf","Th_inf_se","U_inf","U_inf_se","sum_inf","sum_inf_se", - "contrib")) - - # fractional dose rate - op$K <- Inf_frac$K * dose_rate$K / (1 + 1.14 * data$water_content / 100) - op$K_se <- op$K * sqrt(dose_rate$K_re^2 + (data$water_content_se / data$water_content)^2) - op$Th <- Inf_frac$Th * dose_rate$Th / (1 + 1.14 * data$water_content / 100) - op$Th_se <- op$Th * sqrt(dose_rate$Th_re^2 + (data$water_content_se / data$water_content)^2) - op$U <- Inf_frac$U * dose_rate$U / (1 + 1.14 * data$water_content / 100) - op$U_se <- op$U * sqrt(dose_rate$U_re^2 + (data$water_content_se / data$water_content)^2) - op$sum <- op$K + op$Th + op$U - op$sum_se <- sqrt(op$K_se^2 + op$Th_se^2 + op$U_se^2) - - # infinite matrix dose rate - op$K_inf <- op$K / Inf_frac$K - op$K_inf_se <- op$K_inf * sqrt(dose_rate$K_re^2 + (data$water_content_se / data$water_content)^2) - op$Th_inf <- op$Th / Inf_frac$Th - op$Th_inf_se <- op$Th_inf * sqrt(dose_rate$Th_re^2 + (data$water_content_se / data$water_content)^2) - op$U_inf <- op$U / Inf_frac$U - op$U_inf_se <- op$U_inf * sqrt(dose_rate$U_re^2 + (data$water_content_se / data$water_content)^2) - op$sum_inf <- op$K_inf + op$Th_inf + op$U_inf - op$sum_inf_se <- sqrt(op$K_inf_se^2 + op$Th_inf_se^2 + op$U_inf_se^2) - - ## Calculate the total dose rates - for(i in seq(1, length(op)-1, 2)) { - op[[i]] <- c(op[[i]], sum(op[[i]])) - op[[i+1]] <- c(op[[i+1]], sqrt(sum(op[[i+1]]^2))) - } - - ## Calculate contributions for each layer - op$contrib <- op$sum[1:nrow(data)] / op$sum[nrow(data)+1] * 100 - op$contrib <- c(op$contrib, sum(op$contrib)) - - - # Cast to data.frame - op <- as.data.frame(do.call(cbind, op)) - - ## ------------------------------------------------------------------------ ## - ## CONSOLE OUTPUT - ## ------------------------------------------------------------------------ ## - if (verbose) { - cat(paste0("\n [scale_GammaDose()]\n\n")) - cat(" ----\n") - cat(" Conversion factors:", conversion_factors, "\n") - cat(" Gamma dose fractions:", fractional_gamma_dose, "\n") - cat(" Target layer:", data$id[target], "\n\n") - - cat(" ---- Infinite matrix gamma dose rate per layer ----\n\n") - print(data.frame(ID = data$id, - `K (Gy/ka)` = paste0(f(op$K_inf[-(nrow(data)+1)]), "\u00b1", f(op$K_inf_se[-(nrow(data)+1)])), - `Th (Gy/ka)` = paste0(f(op$Th_inf[-(nrow(data)+1)]), "\u00b1", f(op$Th_inf_se[-(nrow(data)+1)])), - `U (Gy/ka)` = paste0(f(op$U_inf[-(nrow(data)+1)]), "\u00b1", f(op$U_inf_se[-(nrow(data)+1)])), - `Total (Gy/ka)` = f(op$sum_inf[-(nrow(data)+1)]), - check.names = FALSE - )) - cat("\n") - cat(sprintf(" ---- Scaled gamma dose rate for target layer: %s ----\n\n", data$id[target])) - print(data.frame(ID = c(data$id, "TOTAL"), - `K (Gy/ka)` = paste0(f(op$K), "\u00b1", f(op$K_se)), - `Th (Gy/ka)` = paste0(f(op$Th), "\u00b1", f(op$Th_se)), - `U (Gy/ka)` = paste0(f(op$U), "\u00b1", f(op$U_se)), - `Contribution (%)` = round(op$contrib, 1), - check.names = FALSE - )) - cat("\n ----\n") - cat(" Infinite matrix gamma dose rate:\t", - f(op$sum_inf[target]), "\u00b1", - f(op$sum_inf_se[target]), "Gy/ka \n") - cat(" Scaled gamma dose rate:\t\t", - f(op$sum[length(op$sum)]), "\u00b1", - f(op$sum_se[length(op$sum_se)]), "Gy/ka") - cat("\n\n") - } - - - ## ------------------------------------------------------------------------ ## - ## PLOT - ## ------------------------------------------------------------------------ ## - if (plot) { - - # save and recover plot parameters - par.old <- par(no.readonly = TRUE) - on.exit(par(par.old)) - - if (plot_single) - layout(matrix(c(1,1, 2, 3, 4, 5, - 1,1, 2, 3, 4, 5, - 1,1, 6, 6, 6, 6, - 1,1, 6, 6, 6, 6), ncol = 6, byrow = TRUE)) - - ## Plot 1 - Layer setup - ## -------------------------------------------------------------- - - ## Global plot settings - if (plot_single) - par(mar = c(2, 5, 1, 4) + 0.1) - else - par(mar = c(2, 5, 4, 4) + 0.1) - - plot(NA, NA, - main = ifelse(plot_single, "", "Profile structure"), - xlim = c(0, 1), - ylim = rev(range(pretty(c(sum(data$thickness), 0)))), - xaxt = "n", - xlab = "", - ylab = "Depth below surface of uppermost layer (cm)", - bty = "n", - xaxs = "i") - - # x-axis label - title(xlab = "Horizontal extent (a.u.)", line = 0) - - # horizontal layer lines - abline(h = c(0, cumsum(data$thickness), sum(data$thickness)), lty = 1, col = "grey50", xpd = FALSE) - - # layer names - mtext(side = 2, at = c(0, cumsum(data$thickness) - data$thickness / 2, sum(data$thickness)), - text = c("", data$id, ""), las = 1, line = -5, cex = 0.75, padj = 0.3, - col = "#428bca") - - # right y-axis - axis(side = 4, at = c(0, cumsum(data$thickness), sum(data$thickness)), - labels = FALSE, tck = -0.01) - - # right y-axis labels - mtext(side = 4, at = c(0, cumsum(data$thickness) - data$thickness / 2, sum(data$thickness)), - text = c("", paste(data$thickness, "cm"), ""), las = 1, - line = ifelse(plot_single, -4, 0.5), - cex = 0.8, - col = "#b22222") - - # fill gap between lowermost layer and max range of pretty xlim - polygon(x = c(0, 1, 1, 0), - y = c(sum(data$thickness), sum(data$thickness), - max(range(pretty(c(sum(data$thickness), 0)))), max(range(pretty(c(sum(data$thickness), 0))))), - density = 10, angle = 45 - ) - - # add sample - points(x = 0.5, y = sum(data$thickness[1:target]) - data$sample_offset[target], - pch = 13, col = "#b22222", cex = 3, lwd = 2) - - - ## PLOT 2 - Nuclide contents - ## -------------------------------------------------------------- - - # global plot settings - if (plot_single) { - par( - mar = c(4, 2, 3, 0.5) + 0.1, - cex = 0.6, - # oma = c(1, 1, 1, 1) + 0.1, - pch = 16) - } else { - par(par.old) - par( - mfrow = c(1, 4), - mar = c(4, 5, 0, 0) + 0.1, - oma = c(1, 1, 1, 1) + 0.1, - pch = 16) - } - - # calculate fancy x-axis limits by considering the error bars - calc_xlim <- function(x, se) { - range(pretty(c(x - se, x + se))) - } - - # horizontal error bars - plot_error <- function(x, se) { - segments(x - se, length(x):1, x + se, length(x):1) - epsilon <- 0.1 - segments(x - se, length(x):1 - epsilon, x - se, length(x):1 + epsilon) - segments(x + se, length(x):1 - epsilon, x + se, length(x):1 + epsilon) - } - - # plot labels - cols <- c("K", "Th", "U", "water_content") - xlabs <- c("K content (%)", "Th content (ppm)", "U content (ppm)", "Water content (%)") - - # main plot - for (i in 1:length(cols)) { - - # main - plot(NA, NA, - xlim = calc_xlim(data[[cols[i]]], data[[paste0(cols[i], "_se")]]), - ylim = c(1, nrow(data)), - ylab = "", - xlab = xlabs[i], - yaxt = "n") - - # vertical orientation lines - abline(v = axTicks(side = 1), col = "grey", lty = 3, xpd = FALSE) - - # data points - points(data[[cols[i]]], nrow(data):1, cex = 1.5) - - # errors - plot_error(data[[cols[i]]], data[[paste0(cols[i], "_se")]]) - - # y-axis label for the first plot - if (i == 1) - axis(2, at = nrow(data):1, labels = data$id, las = 1) - - } - - - ## PLOT 3 - Contribution - ## -------------------------------------------------------------- - - ## Global plot settings - # recover standard plot settings first - if (plot_single) { - par(mar = c(5, 5, 1, 6) + 0.1, - cex = 0.7) - } else { - par(par.old) - par(mar = c(5, 8, 4, 4) + 0.1, - cex = settings$cex) - } - - ## Set colors: target layer is blue, all other grey - cols <- c("grey", "#428bca") - pos <- rev(as.numeric(!is.na(data$sample_offset)) + 1) - - ## Contributions of each layer - bp <- barplot(height = op$contrib[(nrow(op)-1):1], - horiz = TRUE, - main = ifelse(plot_single, "", settings$main), - xlab = settings$xlab, - xlim = range(pretty(op$contrib[1:(nrow(op)-1)])), - col = cols[pos]) - - # layer names - mtext(side = 2, at = bp, - line = ifelse(plot_single, 3.5, 3), - las = 1, - cex = ifelse(plot_single, 0.7, 0.8), - text = rev(data$id)) - - # contribution percentage - mtext(side = 2, at = rev(bp), - text = paste(signif(op$contrib[1:(nrow(op) - 1)], 2), "%"), - col = "#b22222", - las = 1, line = 0.5, cex = 0.7) - - # absolute dose rate values (right side) - mtext(side = 4, at = rev(bp), - text = paste(c(" ", rep("+", nrow(op) - 2)), f(op$sum[1:(nrow(op) - 1)]), "Gy/ka"), - col = "black", - las = 1, line = -0.5, cex = 0.7) - - # sum of absolute dose rate values (-> scaled total gamma dose rate) - mtext(side = 4, - at = min(bp) - diff(bp)[1] / 2, - text = paste("=", f(op$sum[nrow(op)]), "Gy/ka"), - col = "#b22222", las = 1, - line = ifelse(plot_single, -0.5, -1), - cex = ifelse(plot_single, 0.7, 0.8)) - - # recover old plot parameters - par(par.old) - } - - ## ------------------------------------------------------------------------ ## - ## RETURN VALUE - ## ------------------------------------------------------------------------ ## - - ## Infinity matrix dose rate table - infinite_matrix <- data.frame( - ID = data$id, - K = op$K_inf[-(nrow(data)+1)], - K_err = op$K_inf_se[-(nrow(data)+1)], - Th = op$Th_inf[-(nrow(data)+1)], - Th_err = op$Th_inf_se[-(nrow(data)+1)], - U = op$U_inf[-(nrow(data)+1)], - U_err = op$U_inf_se[-(nrow(data)+1)], - Total = op$sum_inf[-(nrow(data)+1)] - ) - - ## Scaled dose rate table - scaled_dose_rate <- data.frame( - ID = c(data$id, "TOTAL"), - K = op$K, - K_err = op$K_se, - Th = op$Th, - Th_err = op$Th_se, - U = op$U, - U_err = op$U_se, - Contribution = op$contrib - ) - - ## Summary table with the most important results - summary <- data.frame( - id = data$id[target], - dose_rate_K = op$K[nrow(op)], - dose_rate_K_err = op$K_se[nrow(op)], - dose_rate_Th = op$Th[nrow(op)], - dose_rate_Th_err = op$Th_se[nrow(op)], - dose_rate_U = op$U[nrow(op)], - dose_rate_U_err = op$U_se[nrow(op)], - dose_rate_total = op$sum[length(op$sum)], - dose_rate_total_err = op$sum_se[length(op$sum_se)] - ) - - ## Create RLum.Results object (return object) - results <- set_RLum(class = "RLum.Results", - originator = "scale_GammaDose", - data = list(summary = summary, - data = data, - dose_rates = list( - infinite_matrix = infinite_matrix, - scaled_dose_rate = scaled_dose_rate - ), - tables = list( - conversion_factors = conv_fac, - distances = distance, - layer_fractional_dose_rate = layer_fracDoseRate, - dose_rates = dose_rate, - infnite_matrix_dose_fractions = Inf_frac, - z_scale = z_scale - ), - args = as.list(sys.call()[-1]), - call = sys.call()), - info = settings$info - ) - - return(results) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/set_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/set_RLum.R deleted file mode 100644 index 5fe4d1a9a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/set_RLum.R +++ /dev/null @@ -1,85 +0,0 @@ -#' General set function for RLum S4 class objects -#' -#' Function calls object-specific set functions for RLum S4 class objects. -#' -#' The function provides a generalised access point for specific -#' [RLum-class] objects.\cr -#' Depending on the given class, the corresponding method to create an object -#' from this class will be selected. Allowed additional arguments can be found -#' in the documentations of the corresponding [RLum-class] class: -#' - [RLum.Data.Curve-class], -#' - [RLum.Data.Image-class], -#' - [RLum.Data.Spectrum-class], -#' - [RLum.Analysis-class], -#' - [RLum.Results-class] -#' -#' @param class [RLum-class] (**required**): -#' name of the S4 class to create -#' -#' @param originator [character] (*automatic*): -#' contains the name of the calling function (the function that produces this object); -#' can be set manually. -#' -#' @param .uid [character] (*automatic*): -#' sets an unique ID for this object using the internal C++ function `create_UID`. -#' -#' @param .pid [character] (*with default*): -#' option to provide a parent id for nesting at will. -#' -#' @param ... further arguments that one might want to pass to the specific set method -#' -#' @return -#' Returns an object of the specified class. -#' -#' @section Function version: 0.3.0 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum.Data.Curve-class], [RLum.Data.Image-class], -#' [RLum.Data.Spectrum-class], [RLum.Analysis-class], [RLum.Results-class] -#' -#' @keywords utilities -#' -#' @examples -#' -#' ##produce empty objects from each class -#' set_RLum(class = "RLum.Data.Curve") -#' set_RLum(class = "RLum.Data.Spectrum") -#' set_RLum(class = "RLum.Data.Spectrum") -#' set_RLum(class = "RLum.Analysis") -#' set_RLum(class = "RLum.Results") -#' -#' ##produce a curve object with arbitrary curve values -#' object <- set_RLum( -#' class = "RLum.Data.Curve", -#' curveType = "arbitrary", -#' recordType = "OSL", -#' data = matrix(c(1:100,exp(-c(1:100))),ncol = 2)) -#' -#' ##plot this curve object -#' plot_RLum(object) -#' -#' @md -#' @export -setGeneric("set_RLum", function (class, originator, .uid = create_UID(), .pid = NA_character_, ... ) { - class(class) <- as.character(class) - - if(missing(originator)) { - if (is(sys.call(which = -1)[[1]], "language")) { - originator <- as.character(sys.call(which = -1)[[1]]) - - ##account for calls using the double colons, in this case the vector is - ##of length 3, not only 1 - if(length(originator) == 3){ - originator <- originator[3] - } - - } else{ - originator <- NA_character_ - } - } - - standardGeneric("set_RLum") -}) - diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/set_Risoe.BINfileData.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/set_Risoe.BINfileData.R deleted file mode 100644 index d493c7b9d..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/set_Risoe.BINfileData.R +++ /dev/null @@ -1,35 +0,0 @@ -#' General accessor function for RLum S4 class objects -#' -#' Function calls object-specific get functions for RisoeBINfileData S4 class objects. -#' -#' The function provides a generalised access point for specific -#' [Risoe.BINfileData-class] objects.\cr -#' Depending on the input object, the corresponding get function will be selected. -#' Allowed arguments can be found in the documentations of the corresponding -#' [Risoe.BINfileData-class] class. -#' -#' @param METADATA x -#' -#' @param DATA x -#' -#' @param .RESERVED x -#' -#' @return Return is the same as input objects as provided in the list. -#' -#' @section Function version: 0.1 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [Risoe.BINfileData-class] -#' -#' @keywords utilities -#' -#' @md -#' @export -setGeneric("set_Risoe.BINfileData", - function(METADATA = data.frame(), DATA = list(), .RESERVED = list()) { - standardGeneric("set_Risoe.BINfileData") - }, - package = "Luminescence" -) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/smooth_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/smooth_RLum.R deleted file mode 100644 index 85552bc07..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/smooth_RLum.R +++ /dev/null @@ -1,78 +0,0 @@ -#' Smoothing of data -#' -#' Function calls the object-specific smooth functions for provided RLum S4-class objects. -#' -#' The function provides a generalised access point for specific -#' [RLum-class] objects.\cr -#' Depending on the input object, the corresponding function will be selected. -#' Allowed arguments can be found in the documentations of the corresponding -#' [RLum-class] class. The smoothing is based on an internal function -#' called `.smoothing`. -#' -#' @param object [RLum-class] (**required**): -#' S4 object of class `RLum` -#' -#' @param ... further arguments passed to the specific class method -#' -#' @return -#' An object of the same type as the input object is provided -#' -#' @section Function version: 0.1.0 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @note -#' Currently only `RLum` objects of class `RLum.Data.Curve` and `RLum.Analysis` -#' (with curve data) are supported! -#' -#' @seealso [RLum.Data.Curve-class], [RLum.Analysis-class] -#' -#' @examples -#' -#' ##load example data -#' data(ExampleData.CW_OSL_Curve, envir = environment()) -#' -#' ##create RLum.Data.Curve object from this example -#' curve <- -#' set_RLum( -#' class = "RLum.Data.Curve", -#' recordType = "OSL", -#' data = as.matrix(ExampleData.CW_OSL_Curve) -#' ) -#' -#' ##plot data without and with smoothing -#' plot_RLum(curve) -#' plot_RLum(smooth_RLum(curve)) -#' -#' @keywords utilities -#' -#' @md -#' @export -setGeneric("smooth_RLum", function(object, ...) { - standardGeneric("smooth_RLum") - -}) - -# Method for smooth_RLum method for RLum objects in a list for a list of objects ------------------- -#' @describeIn smooth_RLum -#' Returns a list of [RLum-class] objects that had been passed to [smooth_RLum] -#' -#' -#' @md -#' @export -setMethod("smooth_RLum", -signature = "list", -function(object, ...){ - - ##apply method in the objects and return the same - lapply(object, function(x){ - if(inherits(x, "RLum")){ - return(smooth_RLum(x,...)) - }else{ - return(x) - } - - }) - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/structure_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/structure_RLum.R deleted file mode 100644 index c0a0e8eea..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/structure_RLum.R +++ /dev/null @@ -1,64 +0,0 @@ -#' General structure function for RLum S4 class objects -#' -#' Function calls object-specific get functions for RLum S4 class objects. -#' -#' The function provides a generalised access point for specific -#' [RLum-class] objects.\cr -#' Depending on the input object, the corresponding structure function will -#' be selected. Allowed arguments can be found in the documentations of the -#' corresponding [RLum-class] class. -#' -#' @param object [RLum-class] (**required**): -#' S4 object of class `RLum` -#' -#' @param ... further arguments that one might want to pass to the specific -#' structure method -#' -#' @return -#' Returns a [data.frame] with structure of the object. -#' -#' @section Function version: 0.2.0 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @seealso [RLum.Data.Curve-class], [RLum.Data.Image-class], -#' [RLum.Data.Spectrum-class], [RLum.Analysis-class], [RLum.Results-class] -#' -#' @keywords utilities -#' -#' @examples -#' -#' ##load example data -#' data(ExampleData.XSYG, envir = environment()) -#' -#' ##show structure -#' structure_RLum(OSL.SARMeasurement$Sequence.Object) -#' -#' @md -#' @export -setGeneric("structure_RLum", function(object, ...) { - standardGeneric("structure_RLum") -}) - -# Method for structure_RLum method for RLum objects in a list for a list of objects ------------- -#' @describeIn structure_RLum -#' Returns a list of [RLum-class] objects that had been passed to [structure_RLum] -#' -#' -#' @md -#' @export -setMethod("structure_RLum", - signature = "list", - function(object, ...) { - ##apply method in the objects and return the same - lapply(object, function(x) { - if (inherits(x, "RLum")) { - return(structure_RLum(x, ...)) - } else{ - return(x) - } - - }) - - }) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/subset_SingleGrainData.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/subset_SingleGrainData.R deleted file mode 100644 index c64f0a691..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/subset_SingleGrainData.R +++ /dev/null @@ -1,64 +0,0 @@ -#'@title Simple Subsetting of Single Grain Data from Risø BIN/BINX files -#' -#'@description Most measured single grains do not exhibit light and it makes -#'usually sense to subset single grain datasets using a table of -#'position and grain pairs -#' -#'@param object [Risoe.BINfileData-class] (**required**): input object with the -#'data to subset -#' -#'@param selection [data.frame] (**required**): selection table with two columns -#'for position (1st column) and grain (2nd column) (columns names do not matter) -#' -#'@return A subset [Risoe.BINfileData-class] object -#' -#'@section Function version: 0.1.0 -#' -#'@author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#'@keywords manip datagen -#' -#'@seealso [Risoe.BINfileData-class], [read_BIN2R], [verify_SingleGrainData] -#' -#'@examples -#' -#'## load example data -#'data(ExampleData.BINfileData, envir = environment()) -#' -#'## set POSITION/GRAIN pair dataset -#'selection <- data.frame(POSITION = c(1,5,7), GRAIN = c(0,0,0)) -#' -#'##subset -#'subset_SingleGrainData(object = CWOSL.SAR.Data, selection = selection) -#' -#'@md -#'@export -subset_SingleGrainData <- function ( - object, - selection -){ - -# Integrity tests --------------------------------------------------------- - ## check object - if (!inherits(object, "Risoe.BINfileData")) - stop("[subset_SingleGrainData()] Only Risoe.BINfileData-class objects are allowed as input!", - call. = FALSE) - - ## try to work with selection - selection <- as.data.frame(selection)[,1:2] - colnames(selection) <- c("POSITION", "GRAIN") - -# Subset ------------------------------------------------------------------ - ## select ids for subsetting - sel_id <-sort(merge(object@METADATA[,c("POSITION", "GRAIN", "ID")], selection)[["ID"]]) - - ## pick data - object@METADATA <- object@METADATA[sel_id,] - object@DATA <- object@DATA[sel_id] - object@METADATA[["ID"]] <- 1:nrow(object@METADATA) - -# Return ------------------------------------------------------------------ - return(object) - -} - diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/template_DRAC.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/template_DRAC.R deleted file mode 100644 index 451c6c997..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/template_DRAC.R +++ /dev/null @@ -1,408 +0,0 @@ -#' Create a DRAC input data template (v1.2) -#' -#' This function returns a DRAC input template (v1.2) to be used in conjunction -#' with the [use_DRAC] function -#' -#' @param nrow [integer] (*with default*): -#' specifies the number of rows of the template (i.e., the number of data -#' sets you want to submit). -#' -#' @param preset [character] (*optional*): -#' By default, all values of the template are set to `NA`, which means that -#' the user needs to fill in **all** data first before submitting to DRAC -#' using `use_DRAC()`. To reduce the number of values that need to be -#' provided, `preset` can be used to create a template with at least -#' a minimum of reasonable preset values. -#' -#' `preset` can be one of the following: -#' - `quartz_coarse` -#' - `quartz_fine` -#' - `feldspar_coarse` -#' - `polymineral_fine` -#' - `DRAC-example_quartz` -#' - `DRAC-example_feldspar` -#' - `DRAC-example_polymineral` -#' -#' Note that the last three options can be used to produce a template -#' with values directly taken from the official DRAC input `.csv` file. -#' -#' @param notification [logical] (*with default*): -#' show or hide the notification -#' -#' @return A list. -#' -#' @author -#' Christoph Burow, University of Cologne (Germany), Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @references -#' Durcan, J.A., King, G.E., Duller, G.A.T., 2015. DRAC: Dose Rate and Age Calculator for trapped charge dating. -#' Quaternary Geochronology 28, 54-61. doi:10.1016/j.quageo.2015.03.012 -#' -#' @seealso [as.data.frame], [list] -#' -#' @examples -#' -#' # create a new DRAC input input -#' input <- template_DRAC(preset = "DRAC-example_quartz") -#' -#' # show content of the input -#' print(input) -#' print(input$`Project ID`) -#' print(input[[4]]) -#' -#' -#' ## Example: DRAC Quartz example -#' # note that you only have to assign new values where they -#' # are different to the default values -#' input$`Project ID` <- "DRAC-Example" -#' input$`Sample ID` <- "Quartz" -#' input$`Conversion factors` <- "AdamiecAitken1998" -#' input$`External U (ppm)` <- 3.4 -#' input$`errExternal U (ppm)` <- 0.51 -#' input$`External Th (ppm)` <- 14.47 -#' input$`errExternal Th (ppm)` <- 1.69 -#' input$`External K (%)` <- 1.2 -#' input$`errExternal K (%)` <- 0.14 -#' input$`Calculate external Rb from K conc?` <- "N" -#' input$`Calculate internal Rb from K conc?` <- "N" -#' input$`Scale gammadoserate at shallow depths?` <- "N" -#' input$`Grain size min (microns)` <- 90 -#' input$`Grain size max (microns)` <- 125 -#' input$`Water content ((wet weight - dry weight)/dry weight) %` <- 5 -#' input$`errWater content %` <- 2 -#' input$`Depth (m)` <- 2.2 -#' input$`errDepth (m)` <- 0.22 -#' input$`Overburden density (g cm-3)` <- 1.8 -#' input$`errOverburden density (g cm-3)` <- 0.1 -#' input$`Latitude (decimal degrees)` <- 30.0000 -#' input$`Longitude (decimal degrees)` <- 70.0000 -#' input$`Altitude (m)` <- 150 -#' input$`De (Gy)` <- 20 -#' input$`errDe (Gy)` <- 0.2 -#' -#' # use DRAC -#' \dontrun{ -#' output <- use_DRAC(input) -#' } -#' -#' @md -#' @export -template_DRAC <- function( - nrow = 1L, - preset = NULL, - notification = TRUE -){ - - ## TODO: - # 1 - allow mineral specific presets; new argument 'mineral' - # 2 - add option to return the DRAC example data set - - ## correct incoming to prevent negative values - if (!is.numeric(nrow)) { - .throw_error("'nrow' must be a positive integer scalar") - } - nrow <- max(1, nrow[1]) - - ## throw warning - if (nrow > 5000) - warning("[template_DRAC()] More than 5000 datasets might not be supported!", call. = FALSE) - - ## PRESETS ---- - valid_presets <- c("quartz_coarse", "quartz_fine", "feldspar_coarse", "polymineral_fine", - "DRAC-example_quartz", "DRAC-example_feldspar", "DRAC-example_polymineral") - - if (!is.null(preset)) { - if (length(preset) != 1 || !is.character(preset)) - stop("\n[template_DRAC()]: Argument 'preset' must be a 'character' of length 1.", - call. = FALSE) - - if (!preset %in% valid_presets) - stop("\n[template_DRAC()]: Invalid preset. Please use on of the following: ", - paste(valid_presets, collapse = ", "), call. = FALSE) - } - - ## LEGAL NOTICE ---- - messages <- list("\n", - "\t-------------------- IMPORTANT NOTE ------------------------\n", - "\t This function returns a DRAC input template to be used in ", - "\t conjunction with the use_DRAC() function. \n", - "\t The template was reproduced with great care, but we do not", - "\t take any responsibility and we are not liable for any ", - "\t mistakes or unforeseen misbehaviour.", - "\t Note that this template is only compatible with DRAC", - "\t version 1.1. Before using this template make sure that", - "\t this is the correct version, otherwise expect unspecified", - "\t errors.\n", - "\t Please ensure you cite the use of DRAC in your work,", - "\t published or otherwise. Please cite the website name and", - "\t version (e.g. DRAC v1.1) and the accompanying journal", - "\t article:", - "\t Durcan, J.A., King, G.E., Duller, G.A.T., 2015.", - "\t DRAC: Dose rate and age calculation for trapped charge", - "\t dating. Quaternary Geochronology 28, 54-61. \n", - "\t Set 'notification = FALSE' to hide this message. \n", - "\t-------------------- IMPORTANT NOTE ------------------------", - "\n") - - if (notification) lapply(messages, message) - - # CREATE TEMPLATE ---- - template <- list( - - `Project ID` = - structure(rep(NA_character_, nrow), required = TRUE, allowsX = FALSE, key = "TI:1", - description = "Inputs can be alphabetic, numeric or selected symbols (/ - () [] _). Spaces are not permitted."), # - - `Sample ID` = - structure(rep(NA_character_, nrow), required = TRUE, allowsX = FALSE, key = "TI:2", - description = "Inputs can be alphabetic, numeric or selected symbols (/ - () [] _). Spaces are not permitted."), # - - `Mineral` = - structure(factor(rep(NA_character_, nrow), c("Q", "F", "PM")), required = TRUE, allowsX = FALSE, key = "TI:3", - description = "The mineral used for dating: quartz, feldspar or polymineral. Input must be 'Q', 'F' or 'PM'."), # - - `Conversion factors` = - structure(factor(rep(NA_character_, nrow), c("AdamiecAitken1998", "Guerinetal2011", "Liritzisetal2013", "X")), required = FALSE, allowsX = TRUE, key = "TI:4", - description = "The conversion factors required to calculate dose rates from radionuclide concentrations. Users have the option of datasets from Adamiec and Aitken (1998), Guerin et al. (2011) or Liritzis et al. (2013). Input must be 'AdamiecAitken1998', 'Guerinetal2011', 'Liritzisetal2013' or 'X' if conversion factors are not required."), # - - `External U (ppm)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:5", - description = "Radionuclide concentrations in parts per million for Uranium, Thorium and Rubidium and % for Potassium. Inputs must be 0 or positive and should not be left blank."), # - - `errExternal U (ppm)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:6", - description = "Radionuclide concentrations in parts per million for Uranium, Thorium and Rubidium and % for Potassium. Inputs must be 0 or positive and should not be left blank."), # - - `External Th (ppm)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:7", - description = "Radionuclide concentrations in parts per million for Uranium, Thorium and Rubidium and % for Potassium. Inputs must be 0 or positive and should not be left blank."), # - - `errExternal Th (ppm)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:8", - description = "Radionuclide concentrations in parts per million for Uranium, Thorium and Rubidium and % for Potassium. Inputs must be 0 or positive and should not be left blank."), # - - `External K (%)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:9", - description = "Radionuclide concentrations in parts per million for Uranium, Thorium and Rubidium and % for Potassium. Inputs must be 0 or positive and should not be left blank."), # - - `errExternal K (%)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:10", - description = "Radionuclide concentrations in parts per million for Uranium, Thorium and Rubidium and % for Potassium. Inputs must be 0 or positive and should not be left blank."), # - - `External Rb (ppm)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:11", - description = "Radionuclide concentrations in parts per million for Uranium, Thorium and Rubidium and % for Potassium. Inputs must be 0 or positive and should not be left blank."), # - - `errExternal Rb (ppm)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:12", - description = "Radionuclide concentrations in parts per million for Uranium, Thorium and Rubidium and % for Potassium. Inputs must be 0 or positive and should not be left blank."), # - - `Calculate external Rb from K conc?` = - structure(factor(rep(NA_character_, nrow), c("Y", "N")), required = FALSE, allowsX = FALSE, key = "TI:13", - description = "Option to calculate a Rubidium concentration from Potassium, using the 270:1 ratio suggested by Mejdahl (1987). Input should be yes 'Y' or no 'N'."), # - - `Internal U (ppm)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:14", - description = "Internal radionuclide concentrations in parts per million for Uranium, Thorium and Rubidium and % for Potassium. Inputs must be 0 or positive and should not be left blank."), # - - `errInternal U (ppm)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:15", - description = "Internal radionuclide concentrations in parts per million for Uranium, Thorium and Rubidium and % for Potassium. Inputs must be 0 or positive and should not be left blank."), # - - `Internal Th (ppm)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:16", - description = "Internal radionuclide concentrations in parts per million for Uranium, Thorium and Rubidium and % for Potassium. Inputs must be 0 or positive and should not be left blank."), # - - `errInternal Th (ppm)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:17", - description = "Internal radionuclide concentrations in parts per million for Uranium, Thorium and Rubidium and % for Potassium. Inputs must be 0 or positive and should not be left blank."), # - - `Internal K (%)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:18", - description = "Internal radionuclide concentrations in parts per million for Uranium, Thorium and Rubidium and % for Potassium. Inputs must be 0 or positive and should not be left blank."), # - - `errInternal K (%)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:19", - description = "Internal radionuclide concentrations in parts per million for Uranium, Thorium and Rubidium and % for Potassium. Inputs must be 0 or positive and should not be left blank."), # - - `Rb (ppm)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:20", - description = "Internal radionuclide concentrations in parts per million for Uranium, Thorium and Rubidium and % for Potassium. Inputs must be 0 or positive and should not be left blank."), # - - `errRb (ppm)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:21", - description = "Internal radionuclide concentrations in parts per million for Uranium, Thorium and Rubidium and % for Potassium. Inputs must be 0 or positive and should not be left blank."), # - - `Calculate internal Rb from K conc?` = - structure(factor(rep(NA_character_, nrow), c("Y", "N", "X")), required = FALSE, allowsX = TRUE, key = "TI:22", - description = "Option to calculate an internal Rubidium concentration from Potassium, using the 270:1 ratio suggested by Mejdahl (1987). Input should be yes 'Y' or no 'N'."), # - - `User external alphadoserate (Gy.ka-1)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:23", - description = "Users may input directly measured values for external alpha, beta and gamma dose rates (in Gy.ka-1). Any positive inputs in these fields will override dose rates calculated from radionuclide concentrations. Inputs should be 0 or positive and should not be left blank"), # - - `errUser external alphadoserate (Gy.ka-1)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:24", - description = "Users may input directly measured values for external alpha, beta and gamma dose rates (in Gy.ka-1). Any positive inputs in these fields will override dose rates calculated from radionuclide concentrations. Inputs should be 0 or positive and should not be left blank"), # - - `User external betadoserate (Gy.ka-1)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:25", - description = "Users may input directly measured values for external alpha, beta and gamma dose rates (in Gy.ka-1). Any positive inputs in these fields will override dose rates calculated from radionuclide concentrations. Inputs should be 0 or positive and should not be left blank"), # - - `errUser external betadoserate (Gy.ka-1)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:26", - description = "Users may input directly measured values for external alpha, beta and gamma dose rates (in Gy.ka-1). Any positive inputs in these fields will override dose rates calculated from radionuclide concentrations. Inputs should be 0 or positive and should not be left blank"), # - - `User external gamma doserate (Gy.ka-1)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:27", - description = "Users may input directly measured values for external alpha, beta and gamma dose rates (in Gy.ka-1). Any positive inputs in these fields will override dose rates calculated from radionuclide concentrations. Inputs should be 0 or positive and should not be left blank"), # - - `errUser external gammadoserate (Gy.ka-1)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:28", - description = "Users may input directly measured values for external alpha, beta and gamma dose rates (in Gy.ka-1). Any positive inputs in these fields will override dose rates calculated from radionuclide concentrations. Inputs should be 0 or positive and should not be left blank"), # - - `User internal doserate (Gy.ka-1)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:29", - description = "Users may input an internal dose rate (either alpha, beta or the sum of the two; in Gy.ka-1). DRAC will assume that this value has already been corrected for attenuation. Inputs in this field will override dose rates calculated from radionuclide concentrations. Inputs should be 0 or positive and not left blank."), # - - `errUser internal doserate (Gy.ka-1)` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:30", - description = "Users may input an internal dose rate (either alpha, beta or the sum of the two; in Gy.ka-1). DRAC will assume that this value has already been corrected for attenuation. Inputs in this field will override dose rates calculated from radionuclide concentrations. Inputs should be 0 or positive and not left blank."), # - - `Scale gammadoserate at shallow depths?` = - structure(factor(rep(NA_character_, nrow), c("Y", "N")), required = FALSE, allowsX = FALSE, key = "TI:31", - description = "Users may choose to scale gamma dose rates for samples taken within 0.3 m of the ground surface. The scaling factors of Aitken (1985) are used. Input should be yes 'Y' or no 'N'."), # - - `Grain size min (microns)` = - structure(rep(NA_real_, nrow), required = TRUE, allowsX = FALSE, key = "TI:32", - description = "The grain size range analysed. DRAC can be used for the grain size ranges between 1 and 1000 microns. Inputs should range between 1 and 1000 and not be left blank."), # - - `Grain size max (microns)` = - structure(rep(NA_real_, nrow), required = TRUE, allowsX = FALSE, key = "TI:33", - description = "The grain size range analysed. DRAC can be used for the grain size ranges between 1 and 1000 microns. Inputs should range between 1 and 1000 and not be left blank."), # - - `alpha-Grain size attenuation` = - structure(factor(rep(NA_character_, nrow), c("Bell1980", "Brennanetal1991")), required = TRUE, allowsX = FALSE, key = "TI:34", - description = "The grain size attenuation factors for the alpha dose rate. Users have the option of datasets from Bell (1980) and Brennan et al. (1991). Input must be 'Bell1980' or 'Brennanetal1991'."), # - - `beta-Grain size attenuation ` = - structure(factor(rep(NA_character_, nrow), c("Mejdahl1979", "Brennan2003", "Guerinetal2012-Q", "Guerinetal2012-F")), required = TRUE, allowsX = FALSE, key = "TI:35", - description = "The grain size attenuation factors for the beta dose rate. Users have the option of datasets from Mejdahl (1979), Brennan (2003) and Guerin et al. (2012) for quartz or feldspar. Input must be 'Mejdahl1979', 'Brennan2003', 'Guerinetal2012-Q' or 'Guerinetal2012-F' ."), # - - `Etch depth min (microns)` = - structure(rep(NA_real_, nrow), required = TRUE, allowsX = FALSE, key = "TI:36", - description = "The user defined etch depth range (microns). Inputs should range between 0 and 30 and not be left blank."), # - - `Etch depth max (microns)` = - structure(rep(NA_real_, nrow), required = TRUE, allowsX = FALSE, key = "TI:37", - description = "The user defined etch depth range (microns). Inputs should range between 0 and 30 and not be left blank."), # - - `beta-Etch depth attenuation factor` = - structure(factor(rep(NA_character_, nrow), c("Bell1979", "Brennan2003", "X")), required = FALSE, allowsX = TRUE, key = "TI:38", - description = "The etch depth attenuation factors for the beta dose rate. Users have the option of datasets from Bell (1979) and Brennan (2003). Input must be 'Bell1979' or 'Brennan2003'. Note: only the dataset of Bell (1980) is provided for attenuation of the alpha dose rate by etching."), # - - `a-value` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = TRUE, key = "TI:39", - description = "Alpha track efficiency value and uncertainty defined by the user. Inputs should be 0 or positive and not left blank."), # - - `erra-value` = - structure(rep(NA_real_, nrow), required = TRUE, allowsX = TRUE, key = "TI:40", - description = "Alpha track efficiency value and uncertainty defined by the user. Inputs should be 0 or positive and not left blank."), # - - `Water content ((wet weight - dry weight)/dry weight) %` = - structure(rep(NA_real_, nrow), required = TRUE, allowsX = FALSE, key = "TI:41", - description = "Sediment water content (%) over the burial period. Inputs should be 0 or positive and not be left blank."), # - - `errWater content %` = - structure(rep(NA_real_, nrow), required = FALSE, allowsX = FALSE, key = "TI:42", - description = "Sediment water content (%) over the burial period. Inputs should be 0 or positive and not be left blank."), # - - `Depth (m)` = - structure(rep(NA_character_, nrow), required = FALSE, allowsX = TRUE, key = "TI:43", - description = "Depth and uncertainty from which sample was extracted beneath the ground surface. Inputs should be 0 or positive and not left blank."), # - - `errDepth (m)` = - structure(rep(NA_character_, nrow), required = FALSE, allowsX = TRUE, key = "TI:44", - description = "Depth and uncertainty from which sample was extracted beneath the ground surface. Inputs should be 0 or positive and not left blank."), # - - `Overburden density (g cm-3)` = - structure(rep(NA_real_, nrow), required = TRUE, allowsX = FALSE, key = "TI:45", - description = "Density of the overlying sediment matrix from which the sample was taken. Inputs should be 0 or positive and not be left blank. The scaling calculation will use the overburden density and uncertainty provided."), # - - `errOverburden density (g cm-3)` = - structure(rep(NA_real_, nrow), required = TRUE, allowsX = FALSE, key = "TI:46", - description = "Density of the overlying sediment matrix from which the sample was taken. Inputs should be 0 or positive and not be left blank. The scaling calculation will use the overburden density and uncertainty provided."), # - - `Latitude (decimal degrees)` = - structure(rep(NA_character_, nrow), required = FALSE, allowsX = TRUE, key = "TI:47", - description = "Latitude and longitude of sample location (in degree decimals). Positive values should be used for northern latitudes and eastern longitudes and negative values for southern latitudes and western longitudes. Inputs should range from -90 to 90 degrees for latitudes and -180 to 180 degrees for longitude."), # - - `Longitude (decimal degrees)` = - structure(rep(NA_character_, nrow), required = FALSE, allowsX = TRUE, key = "TI:48", - description = "Latitude and longitude of sample location (in degree decimals). Positive values should be used for northern latitudes and eastern longitudes and negative values for southern latitudes and western longitudes. Inputs should range from -90 to 90 degrees for latitudes and -180 to 180 degrees for longitude."), # - - `Altitude (m)` = - structure(rep(NA_character_, nrow), required = FALSE, allowsX = TRUE, key = "TI:49", - description = "Altitude of sample location in metres above sea level. Input should be less than 5000 and not left blank."), # - - `User cosmicdoserate (Gy.ka-1)` = - structure(rep(NA_character_, nrow), required = FALSE, allowsX = TRUE, key = "TI:50", - description = "Users may input a cosmic dose rate (in Gy.ka-1). Inputs in these fields will override the DRAC calculated cosmic dose rate. Inputs should be positive or 'X' if not required, and not left blank."), # - - `errUser cosmicdoserate (Gy.ka-1)` = - structure(rep(NA_character_, nrow), required = FALSE, allowsX = TRUE, key = "TI:51", - description = "Users may input a cosmic dose rate (in Gy.ka-1). Inputs in these fields will override the DRAC calculated cosmic dose rate. Inputs should be positive or 'X' if not required, and not left blank."), # - - `De (Gy)` = - structure(rep(NA_character_, nrow), required = FALSE, allowsX = TRUE, key = "TI:52", - description = "Sample De and uncertainty (in Gy). Inputs should be positive or 'X' if not required, and not left blank."), # - - `errDe (Gy)` = - structure(rep(NA_character_, nrow), required = FALSE, allowsX = TRUE, key = "TI:53", - description = "Sample De and uncertainty (in Gy). Inputs should be positive or 'X' if not required, and not left blank.") # - ) - - ## RETURN VALUE ---- - # add an additional DRAC class so we can define our own S3 method for as.data.frame - class(template) <- c("DRAC.list", "list") - # set preset - if (!is.null(preset)) - template <- .preset_DRAC(template, preset) - - invisible(template) -} - -.preset_DRAC <- function(x, preset) { - - preset_list <- list( - ## DRAC COLUMNS (TI:xx) --- TI:1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 - "quartz_coarse" = list("RLum_preset", "quartz_coarse", "Q", "Guerinetal2011", "X", "X", "X", - "X", "X", "X", "X", "X", "N", "X", "X", "X", "X", "X", "X", "X", "X", - "X", "X", "X", "X", "X", "X", "X", "X", "X", "Y", 100, 200, - "Brennanetal1991", "Guerinetal2012-Q", 20, 5, "Bell1979", - 0.035, 0.01, 0, 0, 0, 0, 1.8, 0.1, "X", "X", 0, "X", "X", "X", "X"), - "quartz_fine" = list("RLum_preset", "quartz_fine", "Q", "Guerinetal2011", "X", "X", "X", "X", - "X", "X", "X", "X", "N", "X", "X", "X", "X", "X", "X", "X", "X", "X", "X", - "X", "X", "X", "X", "X", "X", "X", "Y", 4, 11, "Brennanetal1991", - "Guerinetal2012-Q", 0, 0, "Bell1979", 0.035, 0.01, 0, 0, 0, 0, 1.8, 0.1, - "X", "X", 0, "X", "X", "X", "X"), - "feldspar_coarse" = list("RLum_preset", "feldspar_coarse", "F", "Guerinetal2011", "X", "X", "X", - "X", "X", "X", "X", "X", "Y", "X", "X", "X", "X", 12.5, 0.5, "X", "X", - "X", "X", "X", "X", "X", "X", "X", "X", "X", "Y", 100, 200, - "Brennanetal1991", "Guerinetal2012-F", 0, 0, "Bell1979", 0.08, 0.01, - 0, 0, 0, 0, 1.8, 0.1, "X", "X", 0, "X", "X", "X", "X"), - "polymineral_fine" = list("RLum_preset", "polymineral_fine", "PM", "Guerinetal2011", "X", "X", - "X", "X", "X", "X", "X", "X", "Y", "X", "X", "X", "X", 12.5, 0.5, - "X", "X", "X", "X", "X", "X", "X", "X", "X", "X", "X", "Y", 4, 11, - "Brennanetal1991", "Guerinetal2012-F", 0, 0, "Bell1979", 0.08, 0.01, - 0, 0, 0, 0, 1.8, 0.1, "X", "X", 0, "X", "X", "X", "X"), - "DRAC-example_quartz" = list("DRAC-example", "Quartz", "Q", "Guerinetal2011", 3.4, 0.51, 14.47, 1.69, 1.2, 0.14, 0, 0, "N", "X", "X", "X", "X", "X", "X", "X", "X", "X", "X", "X", "X", "X", "X", "X", "X", "X", "N", 90, 125, "Brennanetal1991", "Guerinetal2012-Q", 8, 10, "Bell1979", 0, 0, 5, 2, 2.22, 0.05, 1.8, 0.1, 30, 70, 150, "X", "X", 20, 0.2), - "DRAC-example_feldspar" = list( "DRAC-example", "Feldspar", "F", "AdamiecAitken1998", 2, 0.2, 8, 0.4, 1.75, 0.05, 0, 0, "Y", "X", "X", "X", "X", 12.5, 0.5, "X", "X", "N", "X", "X", "X", "X", "X", "X", "X", "X", "Y", 180, 212, "Bell1980", "Mejdahl1979", 0, 0, "Bell1979", 0.15, 0.05, 10, 3, 0.15, 0.02, 1.8, 0.1, 60, 100, 200, "X", "X", 15, 1.5), - "DRAC-example_polymineral" = list("DRAC-example", "Polymineral", "PM", "AdamiecAitken1998", 4, 0.4, 12, 0.12, 0.83, 0.08, 0, 0, "Y", "X", "X", "X", "X", 12.5, 0.5, "X", "X", "N", "X", "X", 2.5, 0.15, "X", "X", "X", "X", "Y", 4, 11, "Bell1980", "Mejdahl1979", 0, 0, "Bell1979", 0.086, 0.0038, 10, 5, 0.2, 0.02, 1.8, 0.1, 46, 118, 200, 0.2, 0.1, 204.47, 2.69) - ) - - n <- length(x[[1]]) - for (i in 1:length(x)) - x[[i]] <- rep(preset_list[[preset]][[i]], n) - return(x) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/trim_RLum.Data.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/trim_RLum.Data.R deleted file mode 100644 index bacf86386..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/trim_RLum.Data.R +++ /dev/null @@ -1,188 +0,0 @@ -#'@title Trim Channels of RLum.Data-class Objects -#' -#'@description Trim off the number of channels of [RLum.Data-class] objects of similar record type -#' on the time domain. This function is useful in cases where objects have different lengths (short/longer -#'measurement time) but should be analysed jointly by other functions. -#' -#'@details -#'The function has two modes of operation: -#' -#'1. Single [RLum.Data-class] objects or a [list] of such objects -#'The function is applied separately over each object. -#' -#'2. Multiple curves via [RLum.Analysis-class] or a [list] of such objects -#'In this mode, the function first determines the minimum number of channels for -#'each category of records and then jointly processes them. -#'For instance, the object contains one TL curve with 100 channels and two -#'OSL curves with 100 and 99 channels, respectively. Than the minimum for TL would be set -#'to 100 channels and 99 for the OSL curves. If no further parameters are applied, the -#'function will shorten all OSL curves to 99 channels, but leave the TL curve untouched. -#' -#'@param object [RLum.Data-class] [RLum.Analysis-class] (**required**): input object, -#'can be a [list] of objects. Please note that in the latter case the function works -#'only isolated on each element of the [list]. -#' -#'@param recordType [character] (*optional*): type of the record where the trim -#'should be applied. If not set, the types are determined automatically and applied -#'for each record type classes. Can be provided as [list]. -#' -#'@param trim_range [numeric] (*optional*): sets the trim range (everything -#'within the range + 1 is kept). If nothing is set all curves are trimmed to a similar -#'maximum length. Can be provided as [list]. -#' -#'@returns A trimmed object or [list] of such objects similar to the input objects -#' -#'@section Function version: 0.1.0 -#' -#'@author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#'@seealso [RLum.Data-class], [RLum.Analysis-class] -#' -#'@keywords manip -#' -#'@examples -#'## trim all TL curves in the object to channels 10 to 20 -#'data(ExampleData.BINfileData, envir = environment()) -#'temp <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = 1) -#' -#'c <- trim_RLum.Data( -#' object = temp, -#' recordType = "TL", -#' trim_range = c(10,20)) -#' -#'plot_RLum.Analysis( -#'object = c, -#'combine = TRUE, -#'subset = list(recordType = "TL")) -#' -#'## simulate a situation where one OSL curve -#'## in the dataset has only 999 channels instead of 1000 -#'## all curves should be limited to 999 -#'temp@records[[2]]@data <- temp@records[[2]]@data[-nrow(temp[[2]]@data),] -#' -#'c <- trim_RLum.Data(object = temp) -#'nrow(c@records[[4]]@data) -#' -#' -#'@md -#'@export -trim_RLum.Data <- function( - object, - recordType = NULL, - trim_range = NULL -) { - - -# Self-call --------------------------------------------------------------- - if(inherits(object, "list")) { - ## expand parameters - parm <- .expand_parameters(length(object)) - - l <- lapply(seq_along(object), function(x){ - trim_RLum.Data( - object = object[[x]], - recordType = parm$recordType[[x]], - trim_range = parm$trim_range[[x]]) - - }) - - return(l) - - } - -# Work horse functions ---------------------------------------------------- - ## RLum.Data.Curve - .trim_RLum.Data.Curve <- function(object, type, range){ - ## only if type is matched - if(any(object@recordType[1] %in% type)) - object@data <- object@data[max(c(1,range[1])):min(c(nrow(object@data),range[2])),, drop = FALSE] - - object - } - - ## RLum.Data.Spectrum - .trim_RLum.Data.Spectrum <- function(object, type, range){ - ## only if type is matched - if(any(object@recordType[1] %in% type)) - object@data <- object@data[,max(c(1,range[1])):min(c(ncol(object@data),range[2])), drop = FALSE] - - object - } - - ## RLum.Data.Image - .trim_RLum.Data.Image <- function(object, type, range){ - ## only if type is matched - if(any(object@recordType[1] %in% type)) - object@data <- object@data[,,max(c(1,range[1])):min(c(ncol(object@data),range[2])), drop = FALSE] - - object - } - - ## RLum.Analysis (which calls the functions above) - .trim_RLum.Analysis <- function(object, type, range) { - ## determine lengths of objects - ln <- unlist(lapply(object@records, function(x) { - ln <- switch( - class(x)[1], - "RLum.Data.Curve" = dim(x@data)[1], - "RLum.Data.Spectrum" = dim(x@dsta)[2], - "RLum.Data.Image" = dim(x@data)[3] - ) - names(ln) <- x@recordType - ln - - })) - - ## run over single objects - object@records <- lapply(object@records, function(x){ - ## determine max and min of the particular record Types compared to the global information - tmp_max <- min(c(ln[names(ln) == x@recordType], range[2])) - tmp_min <- range[1] ## cannot be smaller than 1 - - ## call sub-function to process and return - switch( - class(x)[1], - "RLum.Data.Curve" = .trim_RLum.Data.Curve(object = x, type = recordType, range = c(tmp_min, tmp_max)), - "RLum.Data.Spectrum" = .trim_RLum.Data.Spectrum(object = x, type = recordType, range = c(tmp_min, tmp_max)), - "RLum.Data.Image" = .trim_RLum.Data.Image(object = x, type = recordType, range = c(tmp_min, tmp_max)), - x - ) - }) - - return(object) - - } - -# Dispatcher ------------------------------------------------------------------- - ## stop for wrong input - if(!inherits(object, "RLum.Data") && !inherits(object, "RLum.Analysis")) - stop("[trim_RLum.Data()] Unsupported input class!", call. = FALSE) - - ## determine classes for record Types - if(is.null(recordType)) { - recordType <- switch( - class(object)[1], - "RLum.Analysis" = unique(vapply(object@records, function(x) x@recordType, character(1))), - object@recordType - ) - - } - - ## silently sanitize trim_range input - if(all(is.null(trim_range))) - trim_range <- c(1,Inf) - else if(length(trim_range) == 1) - trim_range <- c(1, abs(trim_range)) - else if(length(trim_range) > 2) - trim_range <- abs(trim_range[1:2]) - -# Dispatch and return ----------------------------------------------------- - switch( - class(object)[1], - "RLum.Data.Curve" = .trim_RLum.Data.Curve(object, type = recordType, range = trim_range), - "RLum.Data.Spectrum" = .trim_RLum.Data.Spectrum(object, type = recordType, range = trim_range), - "RLum.Data.Image" = .trim_RLum.Data.Image(object, type = recordType, range = trim_range), - "RLum.Analysis" = .trim_RLum.Analysis(object, type = recordType, range = trim_range) - ) - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/tune_Data.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/tune_Data.R deleted file mode 100644 index 77da87fd5..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/tune_Data.R +++ /dev/null @@ -1,105 +0,0 @@ -#' Tune data for experimental purpose -#' -#' The error can be reduced and sample size increased for specific purpose. -#' -#' @param data [data.frame] (**required**): -#' input values, structure: data (`values[,1]`) and data error (`values [,2]`) -#' are required -#' -#' @param decrease.error [numeric]: -#' factor by which the error is decreased, ranges between 0 and 1. -#' -#' @param increase.data [numeric]: -#' factor by which the error is decreased, ranges between 0 and `Inf`. -#' -#' @return Returns a [data.frame] with tuned values. -#' -#' @note -#' You should not use this function to improve your poor data set! -#' -#' @section Function version: 0.5.0 -#' -#' @author -#' Michael Dietze, GFZ Potsdam (Germany) -#' -#' @keywords manip -#' -#' @examples -#' -#' ## load example data set -#' data(ExampleData.DeValues, envir = environment()) -#' x <- ExampleData.DeValues$CA1 -#' -#' ## plot original data -#' plot_AbanicoPlot(data = x, -#' summary = c("n", "mean")) -#' -#' ## decrease error by 10 % -#' plot_AbanicoPlot(data = tune_Data(x, decrease.error = 0.1), -#' summary = c("n", "mean")) -#' -#' ## increase sample size by 200 % -#' #plot_AbanicoPlot(data = tune_Data(x, increase.data = 2) , -#' # summary = c("n", "mean")) -#' -#' @md -#' @export -tune_Data <- function( - data, - decrease.error = 0, - increase.data = 0 -){ - - if(missing(decrease.error) == FALSE) { - - error.rel <- data[,2] / data[,1] - - data[,2] <- error.rel * (1 - decrease.error) * data[,1] - } - - if(missing(increase.data) == FALSE) { - - n <- round(x = increase.data * 100, - digits = 0) - - i.new <- sample(x = 1:nrow(data), - size = n, - replace = TRUE) - - x.new <- rnorm(n = n, - mean = data[i.new, 1], - sd = data[i.new, 2]) - - e.new <- rnorm(n = n, - mean = data[i.new, 2], - sd = data[i.new, 2] * 0.05) - - x.merge <- c(data[,1], x.new) - e.merge <- c(data[,2], e.new) - - e.merge <- e.merge[order(x.merge)] - x.merge <- x.merge[order(x.merge)] - - data.out <- data.frame(x.merge, e.merge) - - names(data.out) <- names(data) - - data <- data.out - } - - info <- Sys.info() - user <- info[length(info)] - os <- info[1] - - warning(paste("Dear ", - user, - ", these activities on your ", - os, - " machine have been tracked and will be submitted to ", - "the R.Lum data base. Cheating does not pay off! [", - Sys.time(), - "]", - sep = "")) - - return(data) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/use_DRAC.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/use_DRAC.R deleted file mode 100644 index dc1d8cd6b..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/use_DRAC.R +++ /dev/null @@ -1,392 +0,0 @@ -#' Use DRAC to calculate dose rate data -#' -#' The function provides an interface from R to DRAC. An R-object or a -#' pre-formatted XLS/XLSX file is passed to the DRAC website and the -#' results are re-imported into R. -#' -#' -#' @param file [character] (**required**): -#' spreadsheet to be passed to the DRAC website for calculation. Can also be a -#' DRAC template object obtained from `template_DRAC()`. -#' -#' @param name [character] (*with default*): -#' Optional user name submitted to DRAC. If omitted, a random name will be generated -#' -#' @param print_references (*with default*): -#' Print all references used in the input data table to the console. -#' -#' @param citation_style (*with default*): -#' If `print_references = TRUE` this argument determines the output style of the -#' used references. Valid options are `"Bibtex"`, `"citation"`, `"html"`, `"latex"` -#' or `"R"`. Default is `"text"`. -#' -#' @param ... Further arguments. -#' -#' - `url` [character]: provide an alternative URL to DRAC -#' - `verbose` [logical]: show or hide console output -#' -#' @return Returns an [RLum.Results-class] object containing the following elements: -#' -#' \item{DRAC}{[list]: a named list containing the following elements in slot `@@data`: -#' -#' \tabular{lll}{ -#' `$highlights` \tab [data.frame] \tab summary of 25 most important input/output fields \cr -#' `$header` \tab [character] \tab HTTP header from the DRAC server response \cr -#' `$labels` \tab [data.frame] \tab descriptive headers of all input/output fields \cr -#' `$content` \tab [data.frame] \tab complete DRAC input/output table \cr -#' `$input` \tab [data.frame] \tab DRAC input table \cr -#' `$output` \tab [data.frame] \tab DRAC output table \cr -#' `references`\tab [list] \tab A list of bib entries of used references \cr -#' } -#' -#' } -#' \item{data}{[character] or [list] path to the input spreadsheet or a DRAC template} -#' \item{call}{[call] the function call} -#' \item{args}{[list] used arguments} -#' -#' The output should be accessed using the function [get_RLum]. -#' -#' @section Function version: 0.14 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -#' Michael Dietze, GFZ Potsdam (Germany)\cr -#' Christoph Burow, University of Cologne (Germany) -#' -#' @references -#' Durcan, J.A., King, G.E., Duller, G.A.T., 2015. DRAC: Dose Rate and Age Calculator for trapped charge dating. -#' Quaternary Geochronology 28, 54-61. doi:10.1016/j.quageo.2015.03.012 -#' -#' @examples -#' -#' ## (1) Method using the DRAC spreadsheet -#' -#' file <- "/PATH/TO/DRAC_Input_Template.csv" -#' -#' # send the actual IO template spreadsheet to DRAC -#' \dontrun{ -#' use_DRAC(file = file) -#' } -#' -#' -#' -#' ## (2) Method using an R template object -#' -#' # Create a template -#' input <- template_DRAC(preset = "DRAC-example_quartz") -#' -#' # Fill the template with values -#' input$`Project ID` <- "DRAC-Example" -#' input$`Sample ID` <- "Quartz" -#' input$`Conversion factors` <- "AdamiecAitken1998" -#' input$`External U (ppm)` <- 3.4 -#' input$`errExternal U (ppm)` <- 0.51 -#' input$`External Th (ppm)` <- 14.47 -#' input$`errExternal Th (ppm)` <- 1.69 -#' input$`External K (%)` <- 1.2 -#' input$`errExternal K (%)` <- 0.14 -#' input$`Calculate external Rb from K conc?` <- "N" -#' input$`Calculate internal Rb from K conc?` <- "N" -#' input$`Scale gammadoserate at shallow depths?` <- "N" -#' input$`Grain size min (microns)` <- 90 -#' input$`Grain size max (microns)` <- 125 -#' input$`Water content ((wet weight - dry weight)/dry weight) %` <- 5 -#' input$`errWater content %` <- 2 -#' input$`Depth (m)` <- 2.2 -#' input$`errDepth (m)` <- 0.22 -#' input$`Overburden density (g cm-3)` <- 1.8 -#' input$`errOverburden density (g cm-3)` <- 0.1 -#' input$`Latitude (decimal degrees)` <- 30.0000 -#' input$`Longitude (decimal degrees)` <- 70.0000 -#' input$`Altitude (m)` <- 150 -#' input$`De (Gy)` <- 20 -#' input$`errDe (Gy)` <- 0.2 -#' -#' # use DRAC -#' \dontrun{ -#' output <- use_DRAC(input) -#' } -#' -#' @md -#' @export -use_DRAC <- function( - file, - name, - print_references = TRUE, - citation_style = "text", - ... -){ - ## TODO: - ## (1) Keep the data set as unmodified as possible. Check structure and order of parameters - ## for meaningful combination. - ## - ## (2) - ## Leave it to the user where the calculations made in our package should be used - - # Integrity tests ----------------------------------------------------------------------------- - if (inherits(file, "character")) { - if(!file.exists(file)){ - stop("[use_DRAC()] It seems that the file doesn't exist!", call. = FALSE) - - } - - # Import data --------------------------------------------------------------------------------- - - ## Import and skip the first rows and remove NA lines and the 2 row, as this row contains - ## only meta data - - ## DRAC v1.1 - XLS sheet - ##check if is the original DRAC table - if (tools::file_ext(file) == "xls" || tools::file_ext(file) == "xlsx") { - if (readxl::excel_sheets(file)[1] != "DRAC_1.1_input") - stop("[use_DRAC()] It looks like that you are not using the original DRAC v1.1 XLSX template. This is currently not supported!", call. = FALSE) - - warning("\n[use_DRAC()] The current DRAC version is 1.2, but you provided the v1.1 excel input template.", - "\nPlease transfer your data to the new CSV template introduced with DRAC v1.2.", call. = FALSE) - input.raw <- na.omit(as.data.frame(readxl::read_excel(path = file, sheet = 1, skip = 5)))[-1, ] - } - - ## DRAC v1.2 - CSV sheet - if (tools::file_ext(file) == "csv") { - if (read.csv(file, nrows = 1, header = FALSE)[1] != "DRAC v.1.2 Inputs") - stop("[use_DRAC()] It looks like that you are not using the original DRAC v1.2 CSV template. This is currently not supported!", call. = FALSE) - - input.raw <- read.csv(file, skip = 8, check.names = FALSE, header = TRUE, stringsAsFactors = FALSE)[-1, ] - } - - } else if (inherits(file, "DRAC.list")) { - input.raw <- as.data.frame(file) - - } else if (inherits(file, "DRAC.data.frame")) { - input.raw <- file - } else { - .throw_error("The provided data object is not a valid DRAC template.") - } - - if (nrow(input.raw) > 5000) - .throw_error("The limit of allowed datasets is 5000!") - - # Settings ------------------------------------------------------------------------------------ - settings <- list( - name = ifelse(missing(name), - paste0(sample(if(runif(1,-10,10)>0){LETTERS}else{letters}, runif(1, 2, 4))), name), - verbose = TRUE, - url = "https://www.aber.ac.uk/en/dges/research/quaternary/luminescence-research-laboratory/dose-rate-calculator/?show=calculator") - - # override defaults with args in ... - settings <- modifyList(settings, list(...)) - - # Set helper function ------------------------------------------------------------------------- - ## The real data are transferred without any encryption, so we have to mask the original - - ##(0) set masking function - .masking <- function(mean, sd, n) { - temp <- rnorm(n = 30 * n, mean = mean, sd = sd) - t(vapply(seq(1, length(temp), 30), function(x) { - c(format(mean(temp[x:(x + 29)]), digits = 2), - format(sd(temp[x:(x + 29)]), digits = 2)) - }, character(2))) - } - - - # Process data -------------------------------------------------------------------------------- - if (settings$verbose) message("\n\t Preparing data...") - ##(1) expand the rows in the data.frame a little bit - mask.df <- input.raw[rep(1:nrow(input.raw), each = 3), ] - - ##(2) generate some meaningful random variables - mask.df <- lapply(seq(1, nrow(input.raw), 3), function(x) { - if (mask.df[x,"TI:52"] != "X") { - ##replace some values - the De value - mask.df[x:(x + 2), c("TI:52","TI:53")] <- .masking( - mean = as.numeric(mask.df[x,"TI:52"]), - sd = as.numeric(mask.df[x,"TI:53"]), - n = 3) - return(mask.df) - } - - }) - - ##(3) bin values - DRAC_submission.df <- rbind(input.raw, mask.df[[1]]) - - ##(4) replace ID values - DRAC_submission.df$`TI:1` <- paste0( - paste0( - paste0( - sample(if(runif(1,-10,10)>0) LETTERS else letters, runif(1, 2, 4))), - ifelse(runif(1,-10,10)>0, "-", "")), - gsub(" ", "0", prettyNum(seq(sample(1:50, 1, prob = 50:1/50, replace = FALSE), - by = 1, length.out = nrow(DRAC_submission.df)), width = 2))) - - - ##(5) store the real IDs in a separate object - DRAC_results.id <- DRAC_submission.df[1:nrow(input.raw), "TI:1"] - - ##(6) create DRAC submission string - DRAC_submission.df <- DRAC_submission.df[sample(x = 1:nrow(DRAC_submission.df), nrow(DRAC_submission.df), - replace = FALSE), ] - - ##convert all columns of the data.frame to class 'character' - for (i in 1:ncol(DRAC_submission.df)) - DRAC_submission.df[ ,i] <- as.character(DRAC_submission.df[, i]) - - if (settings$verbose) message("\t Creating submission string...") - ##get line by line and remove unwanted characters - DRAC_submission.string <- sapply(1:nrow(DRAC_submission.df), function(x) { - paste0(gsub(",", "", toString(DRAC_submission.df[x, ])), "\n") - }) - - ##paste everything together to get the format we want - DRAC_input <- paste(DRAC_submission.string, collapse = "") - - # Send data to DRAC --------------------------------------------------------------------------- - if (settings$verbose) message(paste("\t Establishing connection to", settings$url)) - - ## send data set to DRAC website and receive response - DRAC.response <- httr::POST(settings$url, - body = list("drac_data[name]" = settings$name, - "drac_data[table]" = DRAC_input)) - ## check for correct response - if (DRAC.response$status_code != 200) { - stop(paste0("[use_DRAC()] transmission failed with HTTP status code: ", - DRAC.response$status_code)) - } else { - if (settings$verbose) message("\t The request was successful, processing the reply...") - } - - ## assign DRAC response data to variables - http.header <- DRAC.response$header - DRAC.content <- httr::content(x = DRAC.response, as = "text") - - ## if the input was valid from a technical standpoint, but not with regard - ## contents, we indeed get a valid response, but no DRAC output - if (!grepl("DRAC Outputs", DRAC.content)) { - error_start <- max(gregexpr("drac_field_error", DRAC.content)[[1]]) - error_end <- regexec('textarea name=', DRAC.content)[[1]] - error_msg <- substr(DRAC.content, error_start, error_end) - - # nocov start - on.exit({ - reply <- readline("Do you want to see the DRAC error message (Y/N)?") - if (reply == "Y" || reply == "y" || reply == 1) - cat(error_msg) - }) - # nocov end - - .throw_error("\n\t We got a response from the server, but it\n", - "\t did not contain DRAC output. Please check\n", - "\t your data and verify its validity.\n") - } else { - if (settings$verbose) message("\t Finalising the results...") - } - - ## split header and content - DRAC.content.split <- strsplit(x = DRAC.content, - split = "DRAC Outputs\n\n") - - ## assign DRAC header part - DRAC.header <- as.character(DRAC.content.split[[1]][1]) - - ## assign DRAC content part - DRAC.raw <- read.table(text = as.character(DRAC.content.split[[1]][2]), - sep = ",", - stringsAsFactors = FALSE) - - ## remove first two lines - DRAC.content <- data.table::fread(as.character(DRAC.content.split[[1]][2]), - sep = ",", skip = 2, - stringsAsFactors = FALSE, colClasses = c(V3 = "character"), - data.table = FALSE) - - ##Get rid of all the value we do not need anymore - DRAC.content <- subset(DRAC.content, DRAC.content$V1 %in% DRAC_results.id) - DRAC.content <- DRAC.content[with(DRAC.content, order(V1)), ] - - ##replace by original names - DRAC.content[ ,1] <- input.raw[ ,1] - - ## assign column names - colnames(DRAC.content) <- DRAC.raw[1, ] - - ## save column labels and use them as attributes for the I/O table columns - DRAC.labels <- DRAC.raw[2, ] - for (i in 1:length(DRAC.content)) { - attr(DRAC.content[ ,i], "description") <- DRAC.labels[1,i] - } - - ## DRAC also returns the input, so we need to split input and output - DRAC.content.input <- DRAC.content[ ,grep("TI:", names(DRAC.content))] - DRAC.content.output <- DRAC.content[ ,grep("TO:", names(DRAC.content))] - - ## The DRAC ouput also contains a highlight table, which results in - ## duplicate columns. When creating the data.frame duplicate columns - ## are automatically appended '.1' in their names, so we can identify - ## and remove them easily - DRAC.content.input <- DRAC.content.input[ ,-grep("\\.1", names(DRAC.content.input))] - DRAC.content.output <- DRAC.content.output[ ,-grep("\\.1", names(DRAC.content.output))] - - ## for some reason the returned input table is unsorted, so we resort it in increasing order - DRAC.content.input <- DRAC.content.input[ , paste0("TI:", 1:ncol(DRAC.content.input))] - - ## The output table (v1.2) has 198 columns, making it unreasonable complex - ## for standard data evaluation. We reproduce the DRAC highlight table - ## and use the descriptions (saved as attributes) as column names. - highlight.keys <- c("TI:1","TI:2","TI:3","TO:FQ","TO:FR", - "TO:FS", "TO:FT", "TO:FU", "TO:FV", "TO:FW", - "TO:FX", "TO:FY", "TO:FZ", "TO:GG", "TO:GH", - "TO:GI", "TO:GJ", "TO:GK", "TO:GL", "TO:GM", - "TO:GN", "TI:52", "TI:53", "TO:GO", "TO:GP") - DRAC.highlights <- subset(DRAC.content, select = highlight.keys) - DRAC.highlights.labels <- as.character(DRAC.labels[1, which(unique(names(DRAC.content)) %in% highlight.keys)]) - colnames(DRAC.highlights) <- DRAC.highlights.labels - for (i in 1:length(DRAC.highlights)) { - attr(DRAC.highlights[ ,i], "key") <- highlight.keys[i] - } - - ## finally, we add the 'DRAC.highlights' class so that we can use a custom print method - class(DRAC.highlights) <- c("DRAC.highlights", "data.frame") - - ## Final Disclaimer - messages <- list("\t Done! \n", - "\t We, the authors of the R package 'Luminescence', do not take any responsibility and we are not liable for any ", - "\t mistakes or unforeseen misbehaviour. All calculations are done by DRAC and it is outside our reference to", - "\t verify the input and output. \n", - "\t Note that this function is only compatible with DRAC version 1.2. Before using this function make sure that", - "\t this is the correct version, otherwise expect unspecified errors.\n", - "\t Please ensure you cite the use of DRAC in your work, published or otherwise. Please cite the website name and", - "\t version (e.g. DRAC v1.2) and the accompanying journal article:", - "\t Durcan, J.A., King, G.E., Duller, G.A.T., 2015. DRAC: Dose rate and age calculation for trapped charge", - "\t dating. Quaternary Geochronology 28, 54-61. \n", - "\t Use 'verbose = FALSE' to hide this message. \n") - - if (settings$verbose) lapply(messages, message) - - ## Get and print used references - references <- get_DRAC_references(DRAC.content.input) - - if (print_references && settings$verbose) { - for (i in 1:length(references$refs)) { - message("\nReference for: ", references$desc[i]) - print(references$refs[[i]], style = citation_style) - } - } - - - ## return output - DRAC.return <- set_RLum( - "RLum.Results", - data = list( - DRAC = list(highlights = DRAC.highlights, - header = DRAC.header, - labels = DRAC.labels, - content = DRAC.content, - input = DRAC.content.input, - output = DRAC.content.output, - references = references), - data = file, - call = sys.call(), - args = as.list(sys.call()[-1]))) - - invisible(DRAC.return) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/utils_DRAC.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/utils_DRAC.R deleted file mode 100644 index 9831fa8cf..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/utils_DRAC.R +++ /dev/null @@ -1,293 +0,0 @@ -## FUNCTIONS ------------------------------------------------------------------- - -# subset the DRAC reference list -# 'x' is the input table from use_DRAC() -get_DRAC_references <- function(x) { - - refs <- DRAC_refs() - refs_names <- names(refs) - - used <- list(refs = NULL, desc = NULL) - - # TI:4 - Conversion factors - ref_tmp <- unique(x$`TI:4`) - for (i in 1:length(ref_tmp)) { - if (ref_tmp[i] == "X") - next - used$refs <- c(used$refs, refs[refs_names %in% ref_tmp[i]]) - used$desc <- c(used$desc, "Conversion factors") - } - - # TI:13 - External Rubidium - ref_tmp <- unique(x$`TI:13`) - if (any(ref_tmp == "Y")) { - used$refs <- c(used$refs, refs["Mejdahl1987"]) - used$desc <- c(used$desc, "External rubidium") - } - - # TI:22 - Internal Rubidium - ref_tmp <- unique(x$`TI:22`) - if (any(ref_tmp == "Y")) { - used$refs <- c(used$refs, refs["Mejdahl1987"]) - used$desc <- c(used$desc, "Internal rubidium") - } - - # TI:31 - Gamma dose rate scaling - ref_tmp <- unique(x$`TI:31`) - if (any(ref_tmp == "Y")) { - used$refs <- c(used$refs, refs["Aitken1985"]) - used$desc <- c(used$desc, "Gamma dose rate scaling") - } - - # TI:34 - alpha grain size attenuation - ref_tmp <- unique(x$`TI:34`) - for (i in 1:length(ref_tmp)) { - if (ref_tmp[i] == "X") - next - used$refs <- c(used$refs, refs[refs_names %in% ref_tmp[i]]) - used$desc <- c(used$desc, "Alpha grain size attenuation factors") - } - - # TI:35 - Beta grain size attenuation - ref_tmp <- unique(x$`TI:35`) - for (i in 1:length(ref_tmp)) { - if (ref_tmp[i] == "X") - next - used$refs <- c(used$refs, refs[refs_names %in% ref_tmp[i]]) - used$desc <- c(used$desc, "Beta grain size attenuation factors") - } - - # TI:38 - beta etch attenuation factor - ref_tmp <- unique(x$`TI:38`) - for (i in 1:length(ref_tmp)) { - if (ref_tmp[i] == "X") - next - used$refs <- c(used$refs, refs[refs_names %in% ref_tmp[i]]) - used$desc <- c(used$desc, "Beta etch attenuation factor") - } - - # TI:50 - Cosmic dose rate - ref_tmp <- unique(x$`TI:50`) - if (any(ref_tmp == "X")) { - used$refs <- c(used$refs, refs[c("PrescottHutton1994", "PrescottStephan1982")]) - used$desc <- c(used$desc, c("Cosmic dose rate", "Cosmic dose rate")) - } - - return(used) -} - -## REFERENCE LIST -------------------------------------------------------------- -DRAC_refs <- function() { - - list( - Aitken1985 = bibentry( - bibtype = "Book", - author = person("M.J.", "Aitken"), - title = "Thermoluminescence Dating", - year = "1985", - publisher = "Academic Press", - adress = "London" - ), - - AitkenXie1990 = bibentry( - bibtype = "Article", - author = c( - person("M.J.", "Aitken"), - person("J.", "Xie") - ), - title = "Moisture correction for annual gamma dose", - year = "1990", - journal = "Ancient TL", - volume = "8", - pages = "6-9" - ), - - AdamiecAitken1998 = bibentry( - bibtype = "Article", - author = c( - person("G.", "Adamiec"), - person("M.J.", "Aitken") - ), - title = "Dose-rate conversion factors: update", - year = "1998", - journal = "Ancient TL", - volume = "16", - pages = "37-46" - ), - - Guerinetal2011 = bibentry( - bibtype = "Article", - author = c( - person("G.", "Guerin"), - person("N.", "Mercier"), - person("G.", "Adamiec") - ), - title = "Dose-rate conversion factors: update", - year = "2011", - journal = "Ancient TL", - volume = "29", - pages = "5-8" - ), - - Liritzisetal2013 = bibentry( - bibtype = "Article", - author = c( - person("I.", "Liritzis"), - person("K.", "Stamoulis"), - person("C.", "Papachristodoulou"), - person("K.", "Ioannides") - ), - title = "A re-evaluation of radiation dose-rate conversion factors. ", - year = "2013", - journal = "Mediterranean Archaeology and Archaeometry", - volume = "13", - pages = "1-15" - ), - - Bell1979 = bibentry( - bibtype = "Article", - author = c( - person("W.T.", "Bell") - ), - title = "Attenuation factors for the absorbed radiation dose in quartz inclusions for thermoluminescence dating", - year = "1979", - journal = "Ancient TL", - volume = "8", - pages = "1-12" - ), - - Bell1980 = bibentry( - bibtype = "Article", - author = c( - person("W.T.", "Bell") - ), - title = "Alpha attenuation in Quartz grains for Thermoluminescence Dating", - year = "1980", - journal = "Ancient TL", - volume = "12", - pages = "4-8" - ), - - Brennanetal1991 = bibentry( - bibtype = "Article", - author = c( - person("B.J.", "Brennan"), - person("R.G.", "Lyons"), - person("S.W.", "Phillips") - ), - title = "Attenuation of alpha particle track dose for spherical grains", - year = "1991", - journal = "International Journal of Radiation Applications and Instrumentation. Part D. Nuclear Tracks and Radiation Measurements", - volume = "18", - pages = "249-253" - ), - - Mejdahl1979 = bibentry( - bibtype = "Article", - author = c( - person("V.", "Mejdahl") - ), - title = "Thermoluminescence Dating: Beta-Dose Attenuation in Quartz Grains", - year = "1979", - journal = "Archaeometry", - volume = "21", - pages = "61-72" - ), - - Mejdahl1987 = bibentry( - bibtype = "Article", - author = c( - person("V.", "Mejdahl") - ), - title = "Internal radioactivity in quartz and feldspar grains", - year = "1987", - journal = "Ancient TL", - volume = "5", - pages = "10-17" - ), - - Brennan2003 = bibentry( - bibtype = "Article", - author = c( - person("B.J.", "Brennan") - ), - title = "Beta doses to spherical grains", - year = "2003", - journal = "Radiation Measurements", - volume = "37", - pages = "299-303" - ), - - `Guerinetal2012-Q` = bibentry( - bibtype = "Article", - author = c( - person("G.", "Guerin"), - person("N.", "Mercier"), - person("R.", "Nathan"), - person("G.", "Adamiec"), - person("Y.", "Lefrais") - ), - title = "On the use of the infinite matrix assumption and associated concepts: A critical review", - year = "2012", - journal = "Radiation Measurements", - volume = "47", - pages = "778-785" - ), - - `Guerinetal2012-F` = bibentry( - bibtype = "Article", - author = c( - person("G.", "Guerin"), - person("N.", "Mercier"), - person("R.", "Nathan"), - person("G.", "Adamiec"), - person("Y.", "Lefrais") - ), - title = "On the use of the infinite matrix assumption and associated concepts: A critical review", - year = "2012", - journal = "Radiation Measurements", - volume = "47", - pages = "778-785" - ), - - PrescottHutton1994 = bibentry( - bibtype = "Article", - author = c( - person("J.R.", "Prescott"), - person("J.T.", "Hutton") - ), - title = "Cosmic ray contributions to dose rates for luminescence and ESR dating: Large depths and long-term time variations", - year = "1994", - journal = "Radiation Measurements", - volume = "23", - pages = "497-500" - ), - - PrescottStephan1982 = bibentry( - bibtype = "Article", - author = c( - person("J.R.", "Prescott"), - person("L.G.", "Stephan") - ), - title = "The contribution of cosmic radiation to the environmental dose for thermoluminescence dating", - year = "1982", - journal = "PACT", - volume = "6", - pages = "17-25" - ), - - Readhead2002 = bibentry( - bibtype = "Article", - author = c( - person("M.L.", "ReadHead") - ), - title = "Absorbed dose fraction for 87Rb beta particles", - year = "2002", - journal = "Ancient TL", - volume = "20", - pages = "25-29" - ) - ) - - -} \ No newline at end of file diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/verify_SingleGrainData.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/verify_SingleGrainData.R deleted file mode 100644 index 1ca89375e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/verify_SingleGrainData.R +++ /dev/null @@ -1,490 +0,0 @@ -#' Verify single grain data sets and check for invalid grains, i.e. -#' zero-light level grains -#' -#' This function tries to identify automatically zero-light level curves (grains) -#' from single grain data measurements. -#' -#' **How does the method work?** -#' -#' The function compares the expected values (\eqn{E(X)}) and the variance -#' (\eqn{Var(X)}) of the count values for each curve. Assuming that the -#' background roughly follows a Poisson distribution, the absolute difference -#' of both values should be zero or at least around zero as -#' -#' \deqn{E(x) = Var(x) = \lambda} -#' -#' Thus the function checks for: -#' -#' \deqn{abs(E(x) - Var(x)) >= \Theta} -#' -#' With \eqn{\Theta} an arbitrary, user defined, threshold. Values above the -#' threshold indicate curves comprising a signal. -#' -#' Note: the absolute difference of \eqn{E(X)} and \eqn{Var(x)} instead of the -#' ratio was chosen as both terms can become 0 which would result in 0 or `Inf`, -#' if the ratio is calculated. -#' -#' @param object [Risoe.BINfileData-class] or [RLum.Analysis-class] (**required**): -#' input object. The function also accepts a list with objects of allowed type. -#' -#' @param threshold [numeric] (*with default*): -#' numeric threshold value for the allowed difference between the `mean` and -#' the `var` of the count values (see details) -#' -#' @param cleanup [logical] (*with default*): -#' if set to `TRUE`, curves identified as zero light level curves are -#' automatically removed. Output is an object as same type as the input, i.e. -#' either [Risoe.BINfileData-class] or [RLum.Analysis-class] -#' -#' @param cleanup_level [character] (*with default*): -#' selects the level for the clean-up of the input data sets. -#' Two options are allowed: `"curve"` or `"aliquot"`: -#' -#' - If `"curve"` is selected, every single curve marked as `invalid` is removed. -#' - If `"aliquot"` is selected, curves of one aliquot (grain or disc) can be -#' marked as invalid, but will not be removed. An aliquot will be only removed -#' if all curves of this aliquot are marked as invalid. -#' -#' @param verbose [logical] (*with default*): -#' enables or disables the terminal feedback -#' -#' @param plot [logical] (*with default*): -#' enables or disables the graphical feedback -#' -#' @param ... further parameters to control the plot output; if selected. -#' Supported arguments `main`, `ylim` -#' -#' @return -#' The function returns -#' -#' -----------------------------------\cr -#' `[ NUMERICAL OUTPUT ]`\cr -#' -----------------------------------\cr -#' -#' **`RLum.Results`**-object -#' -#' **slot:****`@data`** -#' -#' \tabular{lll}{ -#' **Element** \tab **Type** \tab **Description**\cr -#' `$unique_pairs` \tab `data.frame` \tab the unique position and grain pairs \cr -#' `$selection_id` \tab `numeric` \tab the selection as record ID \cr -#' `$selection_full` \tab `data.frame` \tab implemented models used in the baSAR-model core \cr -#' } -#' -#' **slot:****`@info`** -#' -#' The original function call -#' -#' **Output variation** -#' -#' For `cleanup = TRUE` the same object as the input is returned, but cleaned up -#' (invalid curves were removed). This means: Either a [Risoe.BINfileData-class] -#' or an [RLum.Analysis-class] object is returned in such cases. -#' A [Risoe.BINfileData-class] object can be exported to a BIN-file by -#' using the function [write_R2BIN]. -#' -#' @note -#' This function can work with [Risoe.BINfileData-class] objects or -#' [RLum.Analysis-class] objects (or a list of it). However, the function is -#' highly optimised for [Risoe.BINfileData-class] objects as it make sense to -#' remove identify invalid grains before the conversion to an -#' [RLum.Analysis-class] object. -#' -#' The function checking for invalid curves works rather robust and it is likely -#' that Reg0 curves within a SAR cycle are removed as well. Therefore it is -#' strongly recommended to use the argument `cleanup = TRUE` carefully. -#' -#' @section Function version: 0.2.3 -#' -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' -#' @seealso [Risoe.BINfileData-class], [RLum.Analysis-class], [write_R2BIN], -#' [read_BIN2R] -#' -#' @keywords manip datagen -#' -#' @examples -#' -#' ##01 - basic example I -#' ##just show how to apply the function -#' data(ExampleData.XSYG, envir = environment()) -#' -#' ##verify and get data.frame out of it -#' verify_SingleGrainData(OSL.SARMeasurement$Sequence.Object)$selection_full -#' -#' ##02 - basic example II -#' data(ExampleData.BINfileData, envir = environment()) -#' id <- verify_SingleGrainData(object = CWOSL.SAR.Data, -#' cleanup_level = "aliquot")$selection_id -#' -#' \dontrun{ -#' ##03 - advanced example I -#' ##importing and exporting a BIN-file -#' -#' ##select and import file -#' file <- file.choose() -#' object <- read_BIN2R(file) -#' -#' ##remove invalid aliquots(!) -#' object <- verify_SingleGrainData(object, cleanup = TRUE) -#' -#' ##export to new BIN-file -#' write_R2BIN(object, paste0(dirname(file),"/", basename(file), "_CLEANED.BIN")) -#' } -#' -#' @md -#' @export -verify_SingleGrainData <- function( - object, - threshold = 10, - cleanup = FALSE, - cleanup_level = 'aliquot', - verbose = TRUE, - plot = FALSE, - ... -){ - - - ##three types of input are allowed: - ##(1) RisoeBINfileData - ##(2) RLum.Analysis - ##(3) List of RLum.Analysis - - # Self Call ----------------------------------------------------------------------------------- - if(is(object, "list")){ - results <- .warningCatcher(lapply(1:length(object), function(x) { - verify_SingleGrainData( - object = object[[x]], - threshold = threshold, - cleanup = cleanup, - cleanup_level = cleanup_level, - verbose = verbose, - plot = plot, - main = paste0("Record #",x) - ) - })) - - ##account for cleanup - if(cleanup){ - return(results) - - }else{ - return(merge_RLum(results)) - - } - - } - - ##++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ##RisoeBINfileData - if(is(object, "Risoe.BINfileData")){ - - ##run test on DATA slot - ##MEAN + SD - temp.results_matrix <- lapply(X = object@DATA, FUN = function(x){ - c(mean(x), var(x)) - - }) - - temp.results_matrix <- do.call(rbind, temp.results_matrix) - - ##DIFF - temp.results_matrix_RATIO <- temp.results_matrix[,2]/temp.results_matrix[,1] - - ##SEL - temp.results_matrix_VALID <- temp.results_matrix_RATIO > threshold - - ##combine everything to in a data.frame - selection <- data.frame( - POSITION = object@METADATA$POSITION, - GRAIN = object@METADATA$GRAIN, - MEAN = temp.results_matrix[, 1], - VAR = temp.results_matrix[, 2], - RATIO = temp.results_matrix_RATIO, - THRESHOLD = rep_len(threshold, length(object@DATA)), - VALID = temp.results_matrix_VALID - ) - - ##get unique pairs for POSITION and GRAIN for VALID == TRUE - unique_pairs <- unique( - selection[selection[["VALID"]], c("POSITION", "GRAIN")]) - - if(cleanup_level == "aliquot"){ - selection_id <- sort(unlist(lapply(1:nrow(unique_pairs), function(x) { - which( - .subset2(selection, 1) == .subset2(unique_pairs, 1)[x] & - .subset2(selection, 2) == .subset2(unique_pairs, 2)[x] - ) - - - }))) - - - }else{ - - ##reduce data to TRUE selection - selection_id <- which(selection[["VALID"]]) - - } - - - ##select output on the chosen input - if(cleanup){ - ##selected wanted elements - object@DATA <- object@DATA[selection_id] - object@METADATA <- object@METADATA[selection_id,] - object@METADATA$ID <- 1:length(object@DATA) - - - ##print message - selection_id <- paste(selection_id, collapse = ", ") - if(verbose){ - cat(paste0("\n[verify_SingleGrainData()] Risoe.BINfileData object reduced to records: \n", selection_id)) - cat("\n\n[verify_SingleGrainData()] Risoe.BINfileData object record index reset.\n") - - } - - ##return - return_object <- object - - }else{ - return_object <- set_RLum( - class = "RLum.Results", - data = list( - unique_pairs = unique_pairs, - selection_id = selection_id, - selection_full = selection), - info = list(call = sys.call()) - ) - - } - - - ##++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ##RLum.Analysis and list with RLum.Analysis objects - ## ... and yes it make sense not to mix that up with the code above - }else if(is(object,"RLum.Analysis")){ - ##first extract all count values from all curves - object_list <- lapply(get_RLum(object), function(x){ - ##yes, would work differently, but it is faster - x@data[,2] - - }) - - ##MEAN + SD - temp.results_matrix <- lapply(X = object_list, FUN = function(x){ - c(mean(x), var(x)) - - }) - - temp.results_matrix <- do.call(rbind, temp.results_matrix) - - ##DIFF - temp.results_matrix_RATIO <- temp.results_matrix[,2]/temp.results_matrix[,1] - - ##SEL - temp.results_matrix_VALID <- temp.results_matrix_RATIO > threshold - - ##get structure for the RLum.Analysis object - temp_structure <- structure_RLum(object, fullExtent = TRUE) - - ##now we have two cases, depending on where measurement is coming from - if (object@originator == "Risoe.BINfileData2RLum.Analysis") { - - ##combine everything to in a data.frame - selection <- data.frame( - POSITION = temp_structure$info.POSITION, - GRAIN = temp_structure$info.GRAIN, - MEAN = temp.results_matrix[, 1], - VAR = temp.results_matrix[, 2], - RATIO = temp.results_matrix_RATIO, - THRESHOLD = rep_len(threshold, length(object_list)), - VALID = temp.results_matrix_VALID - ) - - ##get unique pairs for POSITION and GRAIN for VALID == TRUE - unique_pairs <- unique( - selection[selection[["VALID"]], c("POSITION", "GRAIN")]) - - } else if (object@originator == "read_XSYG2R") { - ##combine everything to in a data.frame - selection <- data.frame( - POSITION = if(any(grepl(pattern = "position", names(temp_structure)))){ - temp_structure$info.position}else{ - NA - }, - GRAIN = NA, - MEAN = temp.results_matrix[, 1], - VAR = temp.results_matrix[, 2], - RATIO = temp.results_matrix_RATIO, - THRESHOLD = rep_len(threshold, length(object_list)), - VALID = temp.results_matrix_VALID - ) - - ##get unique pairs for POSITION for VALID == TRUE - unique_pairs <- unique( - selection[["POSITION"]][selection[["VALID"]]]) - - } else{ - - stop("[verify_SingleGrainData()] I don't know what to do object 'originator' not supported!", - call. = FALSE) - } - - - ##set up cleanup - if(cleanup_level == "aliquot") { - if (object@originator == "read_XSYG2R") { - - if(!is.na(unique_pairs)){ - selection_id <- - sort(unlist(lapply(1:nrow(unique_pairs), function(x) { - which(.subset2(selection, 1) == .subset2(unique_pairs, 1)[x]) - - - }))) - - }else{ - selection_id <- NA - - } - - - } else if (object@originator == "Risoe.BINfileData2RLum.Analysis") { - selection_id <- - sort(unlist(lapply(1:nrow(unique_pairs), function(x) { - which( - .subset2(selection, 1) == .subset2(unique_pairs, 1)[x] & - .subset2(selection, 2) == .subset2(unique_pairs, 2)[x] - ) - - - }))) - - } - - ##make sure that we do not break subsequent code - if(length(selection_id) == 0) selection_id <- NA - - - } else{ - ##reduce data to TRUE selection - selection_id <- which(selection[["VALID"]]) - - } - - - ##return value - ##select output on the chosen input - if(cleanup && !any(is.na(selection_id))){ - - ##print message - if(verbose){ - selection_id_text <- paste(selection_id, collapse = ", ") - cat(paste0("\n[verify_SingleGrainData()] RLum.Analysis object reduced to records: ", - selection_id_text), "\n") - - } - - ##selected wanted elements - if (length(selection_id) == 0) { - object <- set_RLum( - class = "RLum.Analysis", - originator = object@originator, - protocol = object@protocol, - records = list(), - info = list( - unique_pairs = unique_pairs, - selection_id = selection_id, - selection_full = selection) - ) - - } else{ - - object <- set_RLum( - class = "RLum.Analysis", - records = get_RLum(object, record.id = selection_id, drop = FALSE), - info = list( - unique_pairs = unique_pairs, - selection_id = selection_id, - selection_full = selection) - ) - - } - - ##return - return_object <- object - - }else{ - if(any(is.na(selection_id))){ - warning("[verify_SingleGrainData()] selection_id is NA, nothing removed, everything selected for removal!", - call. = FALSE) - - } - - return_object <- set_RLum( - class = "RLum.Results", - data = list( - unique_pairs = unique_pairs, - selection_id = selection_id, - selection_full = selection), - info = list(call = sys.call()) - ) - - } - - - }else{ - stop("[verify_SingleGrainData()] Input type '", is(object)[1], - "' is not allowed for this function!", call. = FALSE) - } - - # Plot ---------------------------------------------------------------------------------------- - if(plot){ - ##set plot settings - plot_settings <- - modifyList(x = list( - main = "Record selection", - ylim = range(c(selection[["RATIO"]], threshold * 1.1)) - ), - val = list(...)) - - - - ##plot area - plot( - NA, - NA, - xlim = c(1,nrow(selection)), - ylim = plot_settings$ylim, - log = "y", - xlab = "Record index", - ylab = "Calculated ratio [a.u.]", - main = plot_settings$main - ) - - ##plot points above the threshold - points(x = which(selection[["VALID"]]), - y = selection[["RATIO"]][selection[["VALID"]]], pch = 20, col = "darkgreen") - points(x = which(!selection[["VALID"]]), - y = selection[["RATIO"]][!selection[["VALID"]]], pch = 20, col = rgb(0,0,0,0.5)) - - abline(h = threshold, col = "red", lty = 1, lwd = 2) - - mtext( - side = 3, - text = paste0( - "(total: ", nrow(selection), - " | valid: ", length(which(selection[["VALID"]])), - " | invalid: ", length(which(!selection[["VALID"]])), ")"), - cex = 0.9 * par()$cex) - - } - - # Return -------------------------------------------------------------------------------------- - return(return_object) -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/write_R2BIN.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/write_R2BIN.R deleted file mode 100644 index 24a1152af..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/write_R2BIN.R +++ /dev/null @@ -1,1328 +0,0 @@ -#' @title Export Risoe.BINfileData into Risø BIN/BINX-file -#' -#' @description Exports a `Risoe.BINfileData` object in a `*.bin` or `*.binx` file that can be -#' opened by the Analyst software or other Risø software. -#' -#' @details -#' The structure of the exported binary data follows the data structure -#' published in the Appendices of the *Analyst* manual p. 42. -#' -#' If -#' `LTYPE`, `DTYPE` and `LIGHTSOURCE` are not of type -#' [character], no transformation into numeric values is done. -#' -#' @param object [Risoe.BINfileData-class] (**required**): -#' input object to be stored in a bin file. -#' -#' @param file [character] (**required**): -#' file name and path of the output file -#' -#' - `[WIN]`: `write_R2BIN(object, "C:/Desktop/test.bin")` -#' - `[MAC/LINUX]`: `write_R2BIN("/User/test/Desktop/test.bin")` -#' -#' @param version [character] (*optional*): -#' version number for the output file. If no value is provided, the highest -#' version number from the [Risoe.BINfileData-class] is taken automatically. -#' -#' **Note:** -#' This argument can be used to convert BIN-file versions. -#' -#' @param compatibility.mode [logical] (*with default*): -#' this option recalculates the position values if necessary and set the max. -#' value to 48. The old position number is appended as comment (e.g., 'OP: 70). -#' This option accounts for potential compatibility problems with the Analyst software. -#' It further limits the maximum number of points per curve to 9,999. If a curve contains more -#' data the curve data get binned using the smallest possible bin width. -#' -#' @param txtProgressBar [logical] (*with default*): -#' enables or disables [txtProgressBar]. -#' -#' @return Write a binary file. -#' -#' @note -#' The function just roughly checks the data structures. The validity of -#' the output data depends on the user. -#' -#' The validity of the file path is not further checked. BIN-file conversions -#' using the argument `version` may be a lossy conversion, depending on the -#' chosen input and output data (e.g., conversion from version 08 to 07 to 06 to 05 to 04 or 03). -#' -#' **Warning** -#' -#' Although the coding was done carefully, it seems that the BIN/BINX-files -#' produced by Risø DA 15/20 TL/OSL readers slightly differ on the byte level. -#' No obvious differences are observed in the METADATA, however, the -#' BIN/BINX-file may not fully compatible, at least not similar to the ones -#' directly produced by the Risø readers! -#' -#' @section Function version: 0.5.2 -#' -#' @author -#' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#' @note -#' ROI definitions (introduced in BIN-file version 8) are not supported! -#' There are furthermore ignored by the function [read_BIN2R]. -#' -#' @seealso [read_BIN2R], [Risoe.BINfileData-class], [writeBin] -#' -#' @references -#' DTU Nutech, 2016. The Sequence Editor, Users Manual, February, 2016. -#' [https://www.fysik.dtu.dk]() -#' -#' @keywords IO -#' -#' @examples -#' ##load example dataset -#' file <- system.file("extdata/BINfile_V8.binx", package = "Luminescence") -#' temp <- read_BIN2R(file) -#' -#' ##create temporary file path -#' ##(for usage replace by own path) -#' temp_file <- tempfile(pattern = "output", fileext = ".binx") -#' -#' ##export to temporary file path -#' write_R2BIN(temp, file = temp_file) -#' -#' @md -#' @export -write_R2BIN <- function( - object, - file, - version, - compatibility.mode = FALSE, - txtProgressBar = TRUE -){ - - # Config ------------------------------------------------------------------ - - ##set supported BIN format version - VERSION.supported <- as.raw(c(3, 4, 5, 6, 7, 8)) - - # Check integrity --------------------------------------------------------- - - ##check if input object is of type 'Risoe.BINfileData' - if(is(object, "Risoe.BINfileData") == FALSE){ - stop("[write_R2BIN()] Input object is not of type Risoe.BINfileData!", call. = FALSE) - - } - - ## check if it fulfills the latest definition ... - if(ncol(object@METADATA) != ncol(set_Risoe.BINfileData()@METADATA)){ - .throw_error("Your Risoe.BINfileData object is not compatible with the ", - "latest specification of this S4-class object. You are ", - "probably trying to export a Risoe.BINfileData from your ", - "workspace you produced manually or with an old version. ", - "Please re-import the BIN-file using function read_BIN2R().") - } - - ##check if input file is of type 'character' - if(is(file, "character") == FALSE){ - stop("[write_R2BIN()] argument 'file' has to be of type character!", call. = FALSE) - - } - - # Check Risoe.BINfileData Struture ---------------------------------------- - ##check wether the BIN-file DATA slot contains more than 9999 records; needs to be run all the time - temp_check <- vapply(object@DATA, function(x){ - if(length(x) > 9999){ - TRUE - }else{ - FALSE - } - - }, FUN.VALUE = logical(1)) - - ##force compatibility - if(compatibility.mode && any(temp_check)){ - - ##drop warning - warning("[write_R2BIN()] Compatibility mode selected: Some data sets are longer than 9,999 points and will be binned!", call. = FALSE) - - ##BIN data to reduce amount of data if the BIN-file is too long - object@DATA <- lapply(object@DATA, function(x){ - if(length(x) > 9999){ - ##we want to have a minimum binning (smallest number possible) - bin_width <- ceiling(length(x)/9999) - - ##it should be symmetric, thus, remove values - if((length(x)/bin_width)%%2 != 0){ - x <- x[-length(x)] - - } - - ##create matrix and return - colSums(matrix(x, nrow = bin_width)) - - }else{ - x - - } - - }) - - ##reset temp_check - temp_check <- FALSE - - ##get new number of points - temp_NPOINTS <- sapply(object@DATA, length) - - ##correct LENGTH - object@METADATA[["LENGTH"]] <- object@METADATA[["LENGTH"]] - (4 * object@METADATA[["NPOINTS"]]) + (temp_NPOINTS * 4) - - ##correct PREVIOUS - object@METADATA[["PREVIOUS"]] <- c(0,object@METADATA[["LENGTH"]][2:length(object@METADATA[["LENGTH"]])]) - - ##correct NPOINTS - object@METADATA[["NPOINTS"]] <- temp_NPOINTS - - ##write comment - object@METADATA[["COMMENT"]] <- paste(object@METADATA[["COMMENT"]], " - binned") - - } - - if(any(temp_check)) - stop(paste("[write_R2BIN()]", length(which(temp_check)), " out of ",length(temp_check), "records contain more than 9,999 data points. This violates the BIN/BINX-file definition!"), call. = FALSE) - - ##remove - rm(temp_check) - - - ##VERSION - - ##If missing version argument set to the highest value - if(missing(version)){ - - version <- as.raw(max(as.numeric(object@METADATA[,"VERSION"]))) - version.original <- version - - - }else{ - - version.original <- as.raw(max(as.numeric(object@METADATA[,"VERSION"]))) - version <- as.raw(version) - object@METADATA[["VERSION"]] <- version - - ##Furthermore, entries length needed to be recalculated - if(version.original != version){ - ##stepping decision - header.stepping <- switch( - EXPR = as.character(version), - "08" = 507, - "07" = 447, - "06" = 447, - "05" = 423, - "04" = 272, - "03" = 272) - - object@METADATA[,"LENGTH"] <- vapply(1:nrow(object@METADATA), function(x){ - header.stepping + 4 * object@METADATA[x,"NPOINTS"] - - }, numeric(1)) - - object@METADATA[,"PREVIOUS"] <- vapply(1:nrow(object@METADATA), function(x){ - if(x == 1) 0 else header.stepping + 4 * object@METADATA[x-1,"NPOINTS"] - - }, numeric(1)) - - } - } - - ##Check if the BINfile object contains of unsupported versions - if((as.raw(object@METADATA[1,"VERSION"]) %in% VERSION.supported) == FALSE || - version %in% VERSION.supported == FALSE){ - - ##show error message - error.text <- paste("[write_R2BIN()] Writing BIN-files in format version (", - object@METADATA[1,"VERSION"],") is currently not supported! - Supported version numbers are: ", - paste(VERSION.supported,collapse=", "),".",sep="") - stop(error.text) - } - - ##CHECK file name for version == 06 it has to be *.binx and correct for it - if(version == 05 | version == 06 | version == 07 | version == 08){ - ##grep file ending - temp.file.name <- unlist(strsplit(file, "[:.:]")) - - ##*.bin? >> correct to binx - if(temp.file.name[length(temp.file.name)]=="bin"){ - temp.file.name[length(temp.file.name)] <- "binx" - file <- paste(temp.file.name, collapse=".") - } - } - - - ##SEQUENCE - if (suppressWarnings(max(nchar(as.character(object@METADATA[,"SEQUENCE"]), type = - "bytes"), na.rm = TRUE)) > 8) { - stop("[write_R2BIN()] Value in 'SEQUENCE' exceeds storage limit!") - - } - - ##USER - if (suppressWarnings(max(nchar(as.character(object@METADATA[,"USER"]), type = - "bytes"), na.rm = TRUE)) > 8) { - stop("[write_R2BIN()] 'USER' exceeds storage limit!") - - } - - ##SAMPLE - if (suppressWarnings(max(nchar(as.character(object@METADATA[,"SAMPLE"]), type = - "bytes"), na.rm = TRUE)) > 20) { - stop("[write_R2BIN()] 'SAMPLE' exceeds storage limit!") - - } - - ##enables compatibility to the Analyst as the the max value for POSITION becomes 48 - if(compatibility.mode){ - ##just do if position values > 48 - if(max(object@METADATA[,"POSITION"])>48){ - - ##grep relevant IDs - temp.POSITION48.id <- which(object@METADATA[,"POSITION"]>48) - - ##find unique values - temp.POSITION48.unique <- unique(object@METADATA[temp.POSITION48.id,"POSITION"]) - - ##set translation vector starting from 1 and ending at 48 - temp.POSITION48.new <- rep_len(1:48, length.out = length(temp.POSITION48.unique)) - - ##recaluate POSITION and update comment - for(i in 1:length(temp.POSITION48.unique)){ - - object@METADATA[object@METADATA[,"POSITION"] == temp.POSITION48.unique[i],"COMMENT"] <- - paste0(object@METADATA[object@METADATA[,"POSITION"] == temp.POSITION48.unique[i],"COMMENT"], - "OP:",object@METADATA[object@METADATA[,"POSITION"] == temp.POSITION48.unique[i],"POSITION"]) - - object@METADATA[object@METADATA[,"POSITION"] == temp.POSITION48.unique[i],"POSITION"] <- - temp.POSITION48.new[i] - - } - - } - - } - - ##COMMENT - if(max(nchar(as.character(object@METADATA[,"COMMENT"]), type="bytes"))>80){ - stop("[write_R2BIN()] 'COMMENT' exceeds storage limit!", call. = FALSE) - - } - - # Translation Matrices ----------------------------------------------------- - ##LTYPE - LTYPE.TranslationMatrix <- matrix(NA, nrow=14, ncol=2) - LTYPE.TranslationMatrix[,1] <- 0:13 - LTYPE.TranslationMatrix[,2] <- c( - "TL", "OSL", "IRSL", "M-IR", "M-VIS", "TOL", "TRPOSL", "RIR", "RBR", - "USER", "POSL", "SGOSL", "RL", "XRF") - - ##DTYPE - DTYPE.TranslationMatrix <- matrix(NA, nrow=8, ncol=2) - DTYPE.TranslationMatrix[,1] <- 0:7 - DTYPE.TranslationMatrix[,2] <- c("Natural","N+dose","Bleach", - "Bleach+dose","Natural (Bleach)", - "N+dose (Bleach)","Dose","Background") - - ##LIGHTSOURCE - LIGHTSOURCE.TranslationMatrix <- matrix(NA, nrow=8, ncol=2) - LIGHTSOURCE.TranslationMatrix[,1] <- 0:7 - LIGHTSOURCE.TranslationMatrix[,2] <- c( - "None", "Lamp", "IR diodes/IR Laser", "Calibration LED", "Blue Diodes", - "White light", "Green laser (single grain)", "IR laser (single grain)" - ) - - ##TRANSLATE VALUES IN METADATA - ##LTYPE - if(is(object@METADATA[1,"LTYPE"], "character") == TRUE | - is(object@METADATA[1,"LTYPE"], "factor") == TRUE){ - - object@METADATA[,"LTYPE"]<- sapply(1:length(object@METADATA[,"LTYPE"]),function(x){ - as.integer(LTYPE.TranslationMatrix[object@METADATA[x,"LTYPE"]==LTYPE.TranslationMatrix[,2],1]) - - }) - } - - ##DTYPE - if(is(object@METADATA[1,"DTYPE"], "character") == TRUE | - is(object@METADATA[1,"DTYPE"], "factor") == TRUE){ - object@METADATA[,"DTYPE"]<- sapply(1:length(object@METADATA[,"DTYPE"]),function(x){ - - as.integer(DTYPE.TranslationMatrix[object@METADATA[x,"DTYPE"]==DTYPE.TranslationMatrix[,2],1]) - - }) - } - - ##LIGHTSOURCE - if(is(object@METADATA[1,"LIGHTSOURCE"], "character") == TRUE | - is(object@METADATA[1,"LIGHTSOURCE"], "factor") == TRUE){ - - object@METADATA[,"LIGHTSOURCE"]<- sapply(1:length(object@METADATA[,"LIGHTSOURCE"]),function(x){ - - as.integer(LIGHTSOURCE.TranslationMatrix[ - object@METADATA[x,"LIGHTSOURCE"]==LIGHTSOURCE.TranslationMatrix[,2],1]) - - })} - - ##TIME - object@METADATA[,"TIME"] <- vapply(1:length(object@METADATA[["TIME"]]),function(x){ - if(is.na(object@METADATA[["TIME"]][x])){ - "000000" - - }else{ - as.character(gsub(":","",object@METADATA[["TIME"]][x])) - - } - - }, character(1)) - - ##TAG and SEL - ##in TAG information on the SEL are storred, here the values are copied to TAG - ##before export - object@METADATA[,"TAG"] <- ifelse(object@METADATA[,"SEL"] == TRUE, 1, 0) - - # SET FILE AND VALUES ----------------------------------------------------- - con<-file(file, "wb") - - ##get records - n.records <- length(object@METADATA[,"ID"]) - - ##output - message(paste0("[write_R2BIN()]\n\t >> ",file)) - - ##set progressbar - if(txtProgressBar) - pb <- txtProgressBar(min=0,max=n.records, char="=", style=3) - - # LOOP ------------------------------------------------------------------- - ID <- 1 - if(version == 03 || version == 04){ - ## version 03 and 04 - ##start loop for export BIN data - while(ID<=n.records) { - - ##VERSION - writeBin(as.raw(object@METADATA[ID,"VERSION"]), - con, - size = 1, - endian="little") - - ##stepping - writeBin(raw(length=1), - con, - size = 1, - endian="little") - - - ##LENGTH, PREVIOUS, NPOINTS - writeBin(c(as.integer(object@METADATA[ID,"LENGTH"]), - as.integer(object@METADATA[ID,"PREVIOUS"]), - as.integer(object@METADATA[ID,"NPOINTS"])), - con, - size = 2, - endian="little") - - ##LTYPE - writeBin(object@METADATA[ID,"LTYPE"], - con, - size = 1, - endian="little") - - ##LOW, HIGH, RATE - writeBin(c(as.double(object@METADATA[ID,"LOW"]), - as.double(object@METADATA[ID,"HIGH"]), - as.double(object@METADATA[ID,"RATE"])), - con, - size = 4, - endian="little") - - ##TEMPERATURE, XCOORD, YCOORD, TOLDELAY; TOLON, TOLOFF - writeBin(c(as.integer(object@METADATA[ID,"TEMPERATURE"]), - as.integer(object@METADATA[ID,"XCOORD"]), - as.integer(object@METADATA[ID,"YCOORD"]), - as.integer(object@METADATA[ID,"TOLDELAY"]), - as.integer(object@METADATA[ID,"TOLON"]), - as.integer(object@METADATA[ID,"TOLOFF"])), - con, - size = 2, - endian="little") - - ##POSITION, RUN - writeBin(c(as.integer(object@METADATA[ID,"POSITION"]), - as.integer(object@METADATA[ID,"RUN"])), - con, - size = 1, - endian="little") - - ##TIME - TIME_SIZE <- nchar(object@METADATA[ID,"TIME"]) - writeBin(as.integer(TIME_SIZE), - con, - size = 1, - endian="little") - - writeChar(object@METADATA[ID,"TIME"], - con, - nchars =TIME_SIZE, - useBytes=TRUE, - eos = NULL) - - if(6-TIME_SIZE>0){ - writeBin(raw(length = c(6-TIME_SIZE)), - con, - size = 1, - endian="little") - - } - - ##DATE - writeBin(as.integer(6), - con, - size = 1 , - endian="little") - - suppressWarnings(writeChar(as.character(object@METADATA[ID,"DATE"]), - con, - nchars = 6, - useBytes=TRUE, - eos = NULL)) - - ##SEQUENCE - ##count number of characters - SEQUENCE_SIZE <- as.integer( - nchar(as.character(object@METADATA[["SEQUENCE"]][ID]), type = "bytes", keepNA = FALSE)) - - writeBin(SEQUENCE_SIZE, - con, - size = 1, - endian="little") - - writeChar(as.character(object@METADATA[ID,"SEQUENCE"]), - con, - nchars = SEQUENCE_SIZE, - useBytes=TRUE, - eos = NULL) - - ##stepping - if(8-SEQUENCE_SIZE>0){ - writeBin(raw(length = (8-SEQUENCE_SIZE)), - con, - size = 1, - endian="little") - } - - ##USER - USER_SIZE <- as.integer(nchar(as.character(object@METADATA[ID,"USER"]), type="bytes")) - - writeBin(USER_SIZE, - con, - size = 1, - endian="little") - - writeChar(as.character(object@METADATA[ID,"USER"]), - con, - nchars = USER_SIZE, - useBytes=TRUE, - eos = NULL) - - ##stepping - if(8-USER_SIZE>0){ - writeBin(raw(length = (8-USER_SIZE)), - con, - size = 1, - endian="little") - } - - ##DTYPE - writeBin(object@METADATA[ID,"DTYPE"], - con, - size = 1, - endian="little") - - ##IRR_TIME - writeBin(as.double(object@METADATA[ID,"IRR_TIME"]), - con, - size = 4, - endian="little") - - - ##IRR_TYPE, IRR_UNIT - writeBin(c(object@METADATA[ID,"IRR_TYPE"], - object@METADATA[ID,"IRR_UNIT"]), - con, - size = 1, - endian="little") - - - ##BL_TIME - writeBin(as.double(object@METADATA[ID,"BL_TIME"]), - con, - size = 4, - endian="little") - - ##BL_UNIT - writeBin(as.integer(object@METADATA[ID,"BL_UNIT"]), - con, - size = 1, - endian="little") - - ##AN_TEMP, AN_TIME, NORM1, NORM2, NORM2, BG - writeBin(c(as.double(object@METADATA[ID,"AN_TEMP"]), - as.double(object@METADATA[ID,"AN_TIME"]), - as.double(object@METADATA[ID,"NORM1"]), - as.double(object@METADATA[ID,"NORM2"]), - as.double(object@METADATA[ID,"NORM3"]), - as.double(object@METADATA[ID,"BG"])), - con, - size = 4, - endian="little") - - ##SHIFT - writeBin(as.integer(object@METADATA[ID,"SHIFT"]), - con, - size = 2, - endian="little") - - ##SAMPLE - SAMPLE_SIZE <- as.integer(nchar(as.character(object@METADATA[ID,"SAMPLE"]), type="bytes")) - - ##avoid problems with empty sample names - if(SAMPLE_SIZE == 0){ - - SAMPLE_SIZE <- as.integer(2) - object@METADATA[ID,"SAMPLE"] <- " " - - } - - writeBin(SAMPLE_SIZE, - con, - size = 1, - endian="little") - - writeChar(as.character(object@METADATA[ID,"SAMPLE"]), - con, - nchars = SAMPLE_SIZE, - useBytes=TRUE, - eos = NULL) - - if((20-SAMPLE_SIZE)>0){ - writeBin(raw(length = (20-SAMPLE_SIZE)), - con, - size = 1, - endian="little") - } - - ##COMMENT - COMMENT_SIZE <- as.integer(nchar(as.character(object@METADATA[ID,"COMMENT"]), type="bytes")) - - ##avoid problems with empty comments - if(COMMENT_SIZE == 0){ - COMMENT_SIZE <- as.integer(2) - object@METADATA[ID,"COMMENT"] <- " " - - } - - writeBin(COMMENT_SIZE, - con, - size = 1, - endian="little") - - suppressWarnings(writeChar(as.character(object@METADATA[ID,"COMMENT"]), - con, - nchars = COMMENT_SIZE, - useBytes=TRUE, - eos = NULL)) - - - if((80-COMMENT_SIZE)>0){ - writeBin(raw(length = c(80-COMMENT_SIZE)), - con, - size = 1, - endian="little") - - } - - ##LIGHTSOURCE, SET, TAG - writeBin(c(as.integer(object@METADATA[ID,"LIGHTSOURCE"]), - as.integer(object@METADATA[ID,"SET"]), - as.integer(object@METADATA[ID,"TAG"])), - con, - size = 1, - endian="little") - - ##GRAIN - writeBin(as.integer(object@METADATA[ID,"GRAIN"]), - con, - size = 2, - endian="little") - - ##LPOWER - writeBin(as.double(object@METADATA[ID,"LPOWER"]), - con, - size = 4, - endian="little") - - ##SYSTEMID - writeBin(as.integer(object@METADATA[ID,"SYSTEMID"]), - con, - size = 2, - endian="little") - - ##Further distinction needed to fully support format version 03 and 04 separately - if(version == 03){ - ##RESERVED 1 - if(length(object@.RESERVED) == 0 || version.original != version){ - writeBin(raw(length=36), - con, - size = 1, - endian="little") - }else{ - writeBin(object = object@.RESERVED[[ID]][[1]], - con, - size = 1, - endian="little") - - } - - ##ONTIME, OFFTIME - writeBin(c(as.integer(object@METADATA[ID,"ONTIME"]), - as.integer(object@METADATA[ID,"OFFTIME"])), - con, - size = 4, - endian="little") - - ##GATE_ENABLED - writeBin(as.integer(object@METADATA[ID,"GATE_ENABLED"]), - con, - size = 1, - endian="little") - - - ##GATE_START, GATE_STOP - writeBin(c(as.integer(object@METADATA[ID,"GATE_START"]), - as.integer(object@METADATA[ID,"GATE_STOP"])), - con, - size = 4, - endian="little") - - - ##RESERVED 2 - if(length(object@.RESERVED) == 0 || version.original != version){ - writeBin(raw(length=1), - con, - size = 1, - endian="little") - - }else{ - writeBin(object@.RESERVED[[ID]][[2]], - con, - size = 1, - endian="little") - - } - - } else { - ##version 04 - ##RESERVED 1 - if(length(object@.RESERVED) == 0 || version.original != version){ - writeBin(raw(length=20), - con, - size = 1, - endian="little") - } else{ - writeBin(object@.RESERVED[[ID]][[1]], - con, - size = 1, - endian="little") - - } - - ##CURVENO - writeBin(as.integer(object@METADATA[ID,"CURVENO"]), - con, - size = 2, - endian="little") - - ##TIMETICK - writeBin(c(as.double(object@METADATA[ID,"TIMETICK"])), - con, - size = 4, - endian="little") - - ##ONTIME, STIMPERIOD - writeBin(c(as.integer(object@METADATA[ID,"ONTIME"]), - as.integer(object@METADATA[ID,"STIMPERIOD"])), - con, - size = 4, - endian="little") - - ##GATE_ENABLED - writeBin(as.integer(object@METADATA[ID,"GATE_ENABLED"]), - con, - size = 1, - endian="little") - - - ##GATE_START, GATE_STOP - writeBin(c(as.integer(object@METADATA[ID,"GATE_START"]), - as.integer(object@METADATA[ID,"GATE_STOP"])), - con, - size = 4, - endian="little") - - - ##PTENABLED - writeBin(as.integer(object@METADATA[ID,"PTENABLED"]), - con, - size = 1, - endian="little") - - - ##RESERVED 2 - if(length(object@.RESERVED) == 0 || version.original != version){ - writeBin(raw(length=10), - con, - size = 1, - endian="little") - - } else { - writeBin(object@.RESERVED[[ID]][[2]], - con, - size = 1, - endian="little") - - } - } - ##DPOINTS - writeBin(as.integer(unlist(object@DATA[ID])), - con, - size = 4, - endian="little") - - #SET UNIQUE ID - ID <- ID + 1 - ##update progress bar - if(txtProgressBar) setTxtProgressBar(pb, ID) - - } - } - ## ==================================================== - ## version > 06 - if(version == 05 | version == 06 | version == 07 | version == 08){ - ##start loop for export BIN data - while(ID<=n.records) { - ##VERSION - writeBin(as.raw(object@METADATA[ID,"VERSION"]), - con, - size = 1, - endian="little") - - ##stepping - writeBin(raw(length=1), - con, - size = 1, - endian="little") - - ##LENGTH, PREVIOUS, NPOINTS - writeBin(c(as.integer(object@METADATA[ID,"LENGTH"]), - as.integer(object@METADATA[ID,"PREVIOUS"]), - as.integer(object@METADATA[ID,"NPOINTS"])), - con, - size = 4, - endian="little") - - if(version == 08){ - writeBin(as.integer(object@METADATA[ID,"RECTYPE"]), - con, - size = 1, - endian="little") - } - - ##RUN, SET, POSITION, GRAINNUMBER, CURVENO, XCOORD, YCOORD - writeBin(c(as.integer(object@METADATA[ID,"RUN"]), - as.integer(object@METADATA[ID,"SET"]), - as.integer(object@METADATA[ID,"POSITION"]), - as.integer(object@METADATA[ID,"GRAINNUMBER"]), - as.integer(object@METADATA[ID,"CURVENO"]), - as.integer(object@METADATA[ID,"XCOORD"]), - as.integer(object@METADATA[ID,"YCOORD"])), - con, - size = 2, - endian="little") - - ##SAMPLE - SAMPLE_SIZE <- as.integer(nchar(as.character(object@METADATA[ID,"SAMPLE"]), type="bytes")) - - ##avoid problems with empty sample names - if(SAMPLE_SIZE == 0){ - - SAMPLE_SIZE <- as.integer(2) - object@METADATA[ID,"SAMPLE"] <- " " - - } - - writeBin(SAMPLE_SIZE, - con, - size = 1, - endian="little") - - - writeChar(as.character(object@METADATA[ID,"SAMPLE"]), - con, - nchars = SAMPLE_SIZE, - useBytes=TRUE, - eos = NULL) - - if((20-SAMPLE_SIZE)>0){ - writeBin(raw(length = (20-SAMPLE_SIZE)), - con, - size = 1, - endian="little") - } - - ##COMMENT - COMMENT_SIZE <- as.integer(nchar(as.character(object@METADATA[ID,"COMMENT"]), type="bytes")) - - ##avoid problems with empty comments - if(COMMENT_SIZE == 0){ - - COMMENT_SIZE <- as.integer(2) - object@METADATA[ID,"COMMENT"] <- " " - - } - - writeBin(COMMENT_SIZE, - con, - size = 1, - endian="little") - - writeChar(as.character(object@METADATA[ID,"COMMENT"]), - con, - nchars = COMMENT_SIZE, - useBytes=TRUE, - eos = NULL) - - if((80-COMMENT_SIZE)>0){ - writeBin(raw(length = c(80-COMMENT_SIZE)), - con, - size = 1, - endian="little") - - } - - ##Instrument and sequence characteristics - ##SYSTEMID - writeBin(as.integer(object@METADATA[ID,"SYSTEMID"]), - con, - size = 2, - endian="little") - - ##FNAME - FNAME_SIZE <- as.integer(nchar(as.character(object@METADATA[ID,"FNAME"]), type="bytes")) - - ##correct for case that this is of 0 length - if(length(FNAME_SIZE) == 0){FNAME_SIZE <- as.integer(0)} - - writeBin(FNAME_SIZE, - con, - size = 1, - endian="little") - - if(FNAME_SIZE>0) { - writeChar( - as.character(object@METADATA[ID,"FNAME"]), - con, - nchars = FNAME_SIZE, - useBytes = TRUE, - eos = NULL - ) - } - - if((100-FNAME_SIZE)>0){ - writeBin(raw(length = c(100-FNAME_SIZE)), - con, - size = 1, - endian="little") - - } - - ##USER - USER_SIZE <- as.integer(nchar(as.character(object@METADATA[ID,"USER"]), type="bytes")) - - writeBin(USER_SIZE, - con, - size = 1, - endian="little") - - writeChar(as.character(object@METADATA[ID,"USER"]), - con, - nchars = USER_SIZE, - useBytes=TRUE, - eos = NULL) - - - if((30-USER_SIZE)>0){ - writeBin(raw(length = c(30-USER_SIZE)), - con, - size = 1, - endian="little") - - } - - ##TIME - TIME_SIZE <- nchar(object@METADATA[ID,"TIME"]) - - writeBin(as.integer(TIME_SIZE), - con, - size = 1, - endian="little") - - writeChar(object@METADATA[ID,"TIME"], - con, - nchars =TIME_SIZE, - useBytes=TRUE, - eos = NULL) - - if(6-TIME_SIZE>0){ - writeBin(raw(length = c(6-TIME_SIZE)), - con, - size = 1, - endian="little") - - } - - ##DATE - writeBin(as.integer(6), - con, - size = 1 , - endian="little") - - - suppressWarnings(writeChar(as.character(object@METADATA[ID,"DATE"]), - con, - nchars = 6, - useBytes=TRUE, - eos = NULL)) - - ##Analysis - ##DTYPE - writeBin(object@METADATA[ID,"DTYPE"], - con, - size = 1, - endian="little") - - - ##BL_TIME - writeBin(as.double(object@METADATA[ID,"BL_TIME"]), - con, - size = 4, - endian="little") - - ##BL_UNIT - writeBin(as.integer(object@METADATA[ID,"BL_UNIT"]), - con, - size = 1, - endian="little") - - ##NORM1, NORM2, NORM3, BG - writeBin(c(as.double(object@METADATA[ID,"NORM1"]), - as.double(object@METADATA[ID,"NORM2"]), - as.double(object@METADATA[ID,"NORM3"]), - as.double(object@METADATA[ID,"BG"])), - con, - size = 4, - endian="little") - - ##SHIFT - writeBin(as.integer(object@METADATA[ID,"SHIFT"]), - con, - size = 2, - endian="little") - - ##TAG - writeBin(c(as.integer(object@METADATA[ID,"TAG"])), - con, - size = 1, - endian="little") - - ##RESERVED 1 - if(length(object@.RESERVED) == 0 || version.original != version){ - writeBin(raw(length=20), - con, - size = 1, - endian="little") - }else{ - - writeBin(object@.RESERVED[[ID]][[1]], - con, - size = 1, - endian="little") - - } - - ##Measurement characteristics - ##LTYPE - writeBin(object@METADATA[ID,"LTYPE"], - con, - size = 1, - endian="little") - - - ##LIGHTSOURCE - writeBin(c(as.integer(object@METADATA[ID,"LIGHTSOURCE"])), - con, - size = 1, - endian="little") - - ##LIGHTPOWER, LOW, HIGH, RATE - writeBin(c(as.double(object@METADATA[ID,"LIGHTPOWER"]), - as.double(object@METADATA[ID,"LOW"]), - as.double(object@METADATA[ID,"HIGH"]), - as.double(object@METADATA[ID,"RATE"])), - con, - size = 4, - endian="little") - - ##TEMPERATURE, MEASTEMP - writeBin(c(as.integer(object@METADATA[ID,"TEMPERATURE"]), - as.integer(object@METADATA[ID,"MEASTEMP"])), - con, - size = 2, - endian="little") - - ##AN_TEMP, AN_TIME - writeBin(c(as.double(object@METADATA[ID,"AN_TEMP"]), - as.double(object@METADATA[ID,"AN_TIME"])), - con, - size = 4, - endian="little") - - ##TOLDELAY; TOLON, TOLOFF - writeBin(c(as.integer(object@METADATA[ID,"TOLDELAY"]), - as.integer(object@METADATA[ID,"TOLON"]), - as.integer(object@METADATA[ID,"TOLOFF"])), - con, - size = 2, - endian="little") - - ##IRR_TIME - writeBin(as.double(object@METADATA[ID,"IRR_TIME"]), - con, - size = 4, - endian="little") - - - ##IRR_TYPE - writeBin(c(object@METADATA[ID,"IRR_TYPE"]), - con, - size = 1, - endian="little") - - ##IRR_DOSERATE, IRR_DOSERATEERR - if(version == 05){ - writeBin(as.double(object@METADATA[ID,"IRR_DOSERATE"]), - con, - size = 4, - endian="little") - - }else{ - writeBin(c(as.double(object@METADATA[ID,"IRR_DOSERATE"]), - as.double(object@METADATA[ID,"IRR_DOSERATEERR"])), - con, - size = 4, - endian="little") - - } - - ##TIMESINCEIRR - writeBin(c(as.integer(object@METADATA[ID,"TIMESINCEIRR"])), - con, - size = 4, - endian="little") - - ##TIMETICK - writeBin(c(as.double(object@METADATA[ID,"TIMETICK"])), - con, - size = 4, - endian="little") - - ##ONTIME, STIMPERIOD - writeBin(c(suppressWarnings(as.integer(object@METADATA[ID,"ONTIME"])), - as.integer(object@METADATA[ID,"STIMPERIOD"])), - con, - size = 4, - endian="little") - - ##GATE_ENABLED - writeBin(as.integer(object@METADATA[ID,"GATE_ENABLED"]), - con, - size = 1, - endian="little") - - ##GATE_START, GATE_STOP - writeBin(c(as.integer(object@METADATA[ID,"GATE_START"]), - as.integer(object@METADATA[ID,"GATE_STOP"])), - con, - size = 4, - endian="little") - - ##PTENABLED, DTENABLED - writeBin(c(as.integer(object@METADATA[ID,"PTENABLED"]), - as.integer(object@METADATA[ID,"DTENABLED"])), - con, - size = 1, - endian="little") - - ##DEADTIME, MAXLPOWER, XRF_ACQTIME, XRF_HV - writeBin(c(as.double(object@METADATA[ID,"DEADTIME"]), - as.double(object@METADATA[ID,"MAXLPOWER"]), - as.double(object@METADATA[ID,"XRF_ACQTIME"]), - as.double(object@METADATA[ID,"XRF_HV"])), - con, - size = 4, - endian="little") - - ##XRF_CURR - writeBin(c(as.integer(object@METADATA[ID,"XRF_CURR"])), - con, - size = 4, - endian="little") - - ##XRF_DEADTIMEF - writeBin(c(as.double(object@METADATA[ID,"XRF_DEADTIMEF"])), - con, - size = 4, - endian="little") - - - ##add version support for V7 - if(version == 05){ - ##RESERVED 2 - if(length(object@.RESERVED) == 0 || version.original != version){ - writeBin(raw(length=4), - con, - size = 1, - endian="little") - }else{ - writeBin(object@.RESERVED[[ID]][[2]], - con, - size = 1, - endian="little") - } - - }else if(version == 06){ - - ##RESERVED 2 - if(length(object@.RESERVED) == 0 || version.original != version){ - writeBin(raw(length=24), - con, - size = 1, - endian="little") - }else{ - writeBin(object@.RESERVED[[ID]][[2]], - con, - size = 1, - endian="little") - } - - }else{ - - ##DETECTOR_ID - writeBin(as.integer(object@METADATA[ID,"DETECTOR_ID"]), - con, - size = 1, - endian="little") - - ##LOWERFILTER_ID, UPPERFILTER_ID - writeBin(c(as.integer(object@METADATA[ID,"LOWERFILTER_ID"]), - as.integer(object@METADATA[ID,"UPPERFILTER_ID"])), - con, - size = 2, - endian="little") - - - ##ENOISEFACTOR - writeBin(as.double(object@METADATA[ID,"ENOISEFACTOR"]), - con, - size = 4, - endian="little") - - - ##VERSION 08 - if(version == 07){ - - ##RESERVED 2 - if(length(object@.RESERVED) == 0 || version.original != version){ - writeBin(raw(length=15), - con, - size = 1, - endian="little") - }else{ - - writeBin(object@.RESERVED[[ID]][[2]], - con, - size = 1, - endian="little") - } - - - }else{ - - ##MARKPOS POSITION and extraction - writeBin( - c( - as.double(object@METADATA[ID, "MARKPOS_X1"]), - as.double(object@METADATA[ID, "MARKPOS_Y1"]), - as.double(object@METADATA[ID, "MARKPOS_X2"]), - as.double(object@METADATA[ID, "MARKPOS_Y2"]), - as.double(object@METADATA[ID, "MARKPOS_X3"]), - as.double(object@METADATA[ID, "MARKPOS_Y3"]), - as.double(object@METADATA[ID, "EXTR_START"]), - as.double(object@METADATA[ID, "EXTR_END"]) - ), - con, - size = 4, - endian = "little" - ) - - ##RESERVED 2 - if(length(object@.RESERVED) == 0 || version.original != version){ - writeBin(raw(length=42), - con, - size = 1, - endian="little") - }else{ - - writeBin(object@.RESERVED[[ID]][[2]], - con, - size = 1, - endian="little") - } - } - - }#end if version decision - ##DPOINTS - writeBin(as.integer(unlist(object@DATA[ID])), - con, - size = 4, - endian="little") - - #SET UNIQUE ID - ID <- ID + 1 - - ##update progress bar - if(txtProgressBar) setTxtProgressBar(pb, ID) - - } - } - - # ##close con - close(con) - # - # ##close - if(txtProgressBar) close(pb) - - ##output - message("\t >> ", ID - 1, " records have been written successfully!\n\n") -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/write_R2TIFF.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/write_R2TIFF.R deleted file mode 100644 index 8ea3a9a20..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/write_R2TIFF.R +++ /dev/null @@ -1,89 +0,0 @@ -#'@title Export RLum.Data.Image and RLum.Data.Spectrum objects to TIFF Images -#' -#'@description Simple wrapper around [tiff::writeTIFF] to export suitable -#' RLum-class objects to TIFF images. Per default 16-bit TIFF files are exported. -#' -#'@param object [RLum.Data.Image-class] or [RLum.Data.Spectrum-class] object (**required**): -#'input object, can be a [list] of such objects -#' -#'@param file [character] (**required**): the file name and path -#' -#'@param norm [numeric] (*with default*): normalisation values. Values in TIFF files must range between 0-1, however, usually -#'in imaging applications the pixel values are real integer count values. The normalisation to the -#'to the highest 16-bit integer values -1 ensures that the numerical values are retained in the exported -#'image. If `1` nothing is normalised. -#' -#'@param ... further arguments to be passed to [tiff::writeTIFF]. -#' -#'@return A TIFF file -#' -#'@author Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -#' -#'@section Function version: 0.1.0 -#' -#'@seealso [tiff::writeTIFF], [RLum.Data.Image-class], [RLum.Data.Spectrum-class] -#' -#'@keywords IO -#' -#'@examples -#'data(ExampleData.RLum.Data.Image, envir = environment()) -#'write_R2TIFF(ExampleData.RLum.Data.Image, file = tempfile()) -#' -#'@md -#'@export -write_R2TIFF <- function( - object, - file = tempfile(), - norm = 65535, - ... -){ -# Integrity --------------------------------------------------------------- - ## most of the users don't need this import, no need to bother them - ## with required libraries - if (!requireNamespace("tiff", quietly = TRUE)) - # nocov start - stop("Exporting objects to TIFF files requires the package tiff.\n", - "To install this package run 'install.packages('tiff')' in your R console.", - call. = FALSE) - # nocov end - -# Transform -------------------------------------------------------------- - ## make a list ... it is just easier - if(!is(object, "list")) - object <- list(object) - - ## check list input - if(!any(vapply(object, function(x) class(x)[1], character(1)) %in% c("RLum.Data.Image", "RLum.Data.Spectrum"))) - stop("[write_R2TIFF()] Only RLum.Data.Image and RLum.Data.Spectrum objects are supported!", call. = FALSE) - - ## check path - if(!dir.exists(dirname(file))) - stop("[write_R2TIFF()] Path does not exist!", call. = FALSE) - - ## create file names - file <- normalizePath(file, mustWork = FALSE) - file_dir <- dirname(file) - file_base <- strsplit(basename(file), split = ".", fixed = TRUE)[[1]][1] - - ## expand if longer than 1 - if(length(object) > 1) - file <- normalizePath(paste0(file_dir,"/",file_base,"_",1:length(object),".tiff"), mustWork = FALSE) - -# Export to TIFF ---------------------------------------------------------- - ## remove arguments we already use - args <- list(...)[!list(...) %in% c("what", "where")] - - ## modify arguments - args <- modifyList(x = list( - bits.per.sample = 16L - ), args) - - - for(i in 1:length(object)){ - object[[i]]@data[] <- as.numeric(object[[i]]@data) - object[[i]]@data[] <- object[[i]]@data / norm[1] - do.call(what = tiff::writeTIFF, args = c(list(object[[i]]@data, where = file[i]), args)) - - } - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/write_RLum2CSV.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/write_RLum2CSV.R deleted file mode 100644 index 4bb629cca..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/write_RLum2CSV.R +++ /dev/null @@ -1,275 +0,0 @@ -#' @title Export RLum-objects to CSV -#' -#' @description This function exports [RLum-class]-objects to CSV-files using the R function -#' [utils::write.table]. All [RLum-class]-objects are supported, but the -#' export is lossy, i.e. the pure numerical values are exported only. Information -#' that cannot be coerced to a [data.frame] or a [matrix] are discarded as well as -#' metadata. -#' -#' @details However, in combination with the implemented import functions, nearly every -#' supported import data format can be exported to CSV-files, this gives a great -#' deal of freedom in terms of compatibility with other tools. -#' -#' **Input is a list of objects** -#' -#' If the input is a [list] of objects all explicit function arguments can be provided -#' as [list]. -#' -#' @param object [RLum-class] or a [list] of `RLum` objects (**required**): -#' objects to be written. Can be a [data.frame] if needed internally. -#' -#' @param path [character] (*optional*): -#' character string naming folder for the output to be written. If nothing -#' is provided `path` will be set to the working directory. -#' **Note:** this argument is ignored if the the argument `export` is set to `FALSE`. -#' -#' @param prefix [character] (*with default*): -#' optional prefix to name the files. This prefix is valid for all written files -#' -#' @param export [logical] (*with default*): -#' enable or disable the file export. If set to `FALSE` nothing is written to -#' the file connection, but a list comprising objects of type [data.frame] and [matrix] -#' is returned instead -#' -#' @param compact [logical] (*with default*): if `TRUE` (the default) the output will be more -#' simple but less comprehensive, means not all elements in the objects will be fully broken down. -#' This is in particular useful for writing `RLum.Results` objects to CSV-files, such objects -#' can be rather complex and not all information are needed in a CSV-file or can be meaningful translated -#' to it. -#' -#' @param ... further arguments that will be passed to the function -#' [utils::write.table]. All arguments except the argument `file` are supported -#' -#' -#' @return -#' The function returns either a CSV-file (or many of them) or for the -#' option `export == FALSE` a list comprising objects of type [data.frame] and [matrix] -#' -#' -#' @section Function version: 0.2.2 -#' -#' @author -#' Sebastian Kreutzer, Geography & Earth Science, Aberystwyth University (United Kingdom) -#' -#' @seealso [RLum.Analysis-class], [RLum.Data-class], [RLum.Results-class], -#' [utils::write.table] -#' -#' @keywords IO -#' -#' @examples -#' -#' ##transform values to a list (and do not write) -#' data(ExampleData.BINfileData, envir = environment()) -#' object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data)[[1]] -#' write_RLum2CSV(object, export = FALSE) -#' -#' \dontrun{ -#' -#' ##create temporary filepath -#' ##(for usage replace by own path) -#' temp_file <- tempfile(pattern = "output", fileext = ".csv") -#' -#' ##write CSV-file to working directory -#' write_RLum2CSV(temp_file) -#' -#' } -#' -#' @md -#' @export -write_RLum2CSV <- function( - object, - path = NULL, - prefix = "", - export = TRUE, - compact = TRUE, - ... - -){ - # General tests ------------------------------------------------------------------------------- - if(missing(object)){ - stop("[write_RLum2CSV()] input object is missing!", call. = FALSE) - - } - - # Self-call ----------------------------------------------------------------------------------- - ##this option allows to work on a list of RLum-objects - if(is.list(object) && !is.data.frame(object)){ - ##extent the list of arguments if set - ##path - path <- rep(list(path), length = length(object)) - - ##prefix ... create automatic prefix if nothing is provided - prefix <- as.list(paste0(prefix[1], "[[",1:length(object),"]]_")) - - ##export - export <- rep(list(export), length = length(object)) - - ## write list name to object - for (i in 1:length(object)) - attr(object[[i]], "list_name") <- names(object)[i] - - ##execute the self-call function - temp <- lapply(1:length(object), function(x){ - write_RLum2CSV( - object = object[[x]], - path = path[[x]], - prefix = prefix[[x]], - export = export[[x]], - ... - ) - - }) - - ##this prevents that we get a list of NULL - if(is.null(unlist(temp))){ - return(NULL) - - }else{ - return(temp) - - } - - } - - # Integrity tests ----------------------------------------------------------------------------- - ##check path - ##if NULL condition - if(export == TRUE && is.null(path)){ - path <- getwd() - message(paste0("[write_RLum2CSV()] Path automatically set to: ", path)) - - } - - ##non NULL conditon - if(export == TRUE && !dir.exists(path)){ - stop("[write_RLum2CSV()] Directory provided via the argument 'path' does not exist!", call. = FALSE) - - } - - ## What do we need at the end of the day is a named list of data.frames or matrices we can export - ## using the function write.table; the name of the list elements will become the file names - if(inherits(object, "RLum")){ - if(is(object, "RLum.Analysis") || - is(object, "RLum.Data.Curve") || - is(object, "RLum.Data.Spectrum") || is(object, "RLum.Data.Image")){ - - ##extract all elements ... depending on the input - if(is(object, "RLum.Analysis")){ - ##tricky, we cannot use get_RLum() as the function lapply calls as.list() for an object! - object_list <- lapply(object, function(x){get_RLum(x)}) - - ##change names of the list and produce the right format straight away - names(object_list) <- paste0(1:length(object_list),"_",names(object)) - - } else { - - ##get object and make list - object_list <- list(get_RLum(object)) - - ##set new name - names(object_list) <- paste0("1_",object@recordType) - - } - - } else if (is(object, "RLum.Results")){ - ##unlist what ever comes, but do not break structures like matrices, numerics and - names <- names(object@data) - - ##get elements - object_list <- lapply(object@data, function(e){ - ##only run something on the list of it is worth it and pack it in the list - if(inherits(e, "matrix") || inherits(e, "numeric") || inherits(e, "data.frame")) - return(list(e)) - - ##unlist the rest until the end - if(!compact) - return(unlist(e)) - - ##now we return whatever we have - return(e) - - }) - - ##now unlist again one level - object_list <- unlist(object_list, recursive = FALSE) - - ##sort out objects we do not like and we cannot procede ... - object_list_rm <- vapply(object_list, function(x) { - inherits(x, "matrix") || inherits(x, "numeric") || inherits(x, "data.frame") - - }, vector(mode = "logical", length = 1)) - - ##remove unwanted objects - object_list <- object_list[object_list_rm] - - - ##set warning - if(any(!object_list_rm)) - warning(paste0("[write_RLum2CSV()] ", length(which(!object_list_rm)), " elements could not be converted to a CSV-structure!"), call. = FALSE) - - ##adjust the names - names(object_list) <- paste0(1:length(object_list),"_",names(object_list)) - - } else { - # nocov start - message("[write_RLum2CSV()] Error: One particular RLum-object ", - "is not yet supported, NULL returned") - return(NULL) - # nocov end - } - - } else if (inherits(object, "data.frame")) { - object_list <- list(object) - if(!is.null(attr(object, "filename"))) filename <- attr(object, "filename") else filename <- "" - - names(object_list) <- paste0("conv_", attr(object, "list_name"), filename) - - }else{ - stop("[write_RLum2CSV()] Object needs to be a member of the object class RLum!", call. = FALSE) - - } - - # Export -------------------------------------------------------------------------------------- - if(export){ - ##set export settings for write.table - export_settings.default <- list( - append = FALSE, - quote = TRUE, - sep = ";", - eol = "\n", - na = "NA", - dec = ".", - row.names = FALSE, - col.names = FALSE, - qmethod = c("escape", "double"), - fileEncoding = "" - - ) - - ##modify on demand - export_settings <- modifyList(x = export_settings.default, val = list(...)) - - ##write files to file system - for(i in 1:length(object_list)){ - utils::write.table( - x = object_list[[i]], - file = paste0(path,"/", prefix, names(object_list)[i],".csv"), - append = export_settings$append, - quote = export_settings$quote, - sep = export_settings$sep, - eol = export_settings$eol, - na = export_settings$na, - dec = export_settings$dec, - row.names = export_settings$row.names, - col.names = export_settings$col.names, - qmethod = export_settings$qmethod, - fileEncoding = export_settings$fileEncoding) - - } - - }else{ - return(object_list) - - } - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/zzz.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/zzz.R deleted file mode 100644 index 63470dd18..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/R/zzz.R +++ /dev/null @@ -1,287 +0,0 @@ -##////////////////////////////////////////////////////////////////////////////// -##//zzz.R -##////////////////////////////////////////////////////////////////////////////// -## -##============================================================================== -##author: R Luminescence Package Team -##organisation: -##version.: 0.2.1 -##date: 2013-11-10 -##============================================================================== -# Set namespace .LuminescenceEnv ------------------------------------------ -.LuminescenceEnv <- new.env(parent = emptyenv()) - - -# Assign variables to Namespace ------------------------------------------- -##variable col to define colours in the functions for output -assign("col", - unlist(colors())[c(261,552,51,62,76,151,451,474,654,657,100,513,23,612,129,27,551,393,80,652,555)], - pos = ".LuminescenceEnv", - envir = .LuminescenceEnv) - - -##============================================================================== -##on Attach -.onAttach <- function(libname,pkgname){ - - ##set startup message - try(packageStartupMessage(paste("Welcome to the R package Luminescence version ", - packageDescription(pkg="Luminescence")$Version, - " [Built: ", - trimws(strsplit(packageDescription(pkg="Luminescence")$Built, ";")[[1]][3]), - "]", sep=""), - "\n", - get_Quote()), silent=TRUE) -} - -##============================================================================== -# DO NOT TOUCH! ----------------------------------------------------------- -#' sTeve - sophisticated tool for efficient data validation and evaluation -#' -#' This function provides a sophisticated routine for comprehensive -#' luminescence dating data analysis. -#' -#' This amazing sophisticated function validates your data seriously. -#' -#' @param n_frames [integer] (*with default*): -#' n frames -#' -#' @param t_animation [integer] (*with default*): -#' t animation -#' -#' @param n.tree [integer] (*with default*): -#' how many trees do you want to cut? -#' -#' @param type [integer] (*optional*): -#' Make a decision: 1, 2 or 3 -#' -#' @return Validates your data. -#' -#' @note This function should not be taken too seriously. -#' -#' @author R Luminescence Team, 2012-2046 -#' -#' @seealso [plot_KDE] -#' -#' @keywords manip -#' @examples -#' -#' ##no example available -#' -#' @md -#' @export -sTeve<- function(n_frames = 10, t_animation = 2, n.tree = 7, type) { - - ## allow new overlay plot - par(new = TRUE) - - ## infer month of year - month <- as.numeric(strsplit(x = as.character(Sys.Date()), split = "-")[[1]][2]) - - ## select showtime item based on month or user-defined type - if(missing(type) == TRUE) { - if(month >= 1 & month <= 3) { - type <- 1 - } else if(month >3 & month <= 11) { - type <- 2 - } else if(month > 11 & month <= 12) { - type <- 3 - } - } - - - - if(type == 1) { - ## SHOWTIME OPTION 1 - Sys.sleep(5) - shape::emptyplot() - shape::filledrectangle(wx = 0.9, wy = 0.4, - mid = c(0.5, 0.5), - lcol ="red", - lwd=1, - col=0, - angle = 45) - - text(x=0.5, y=0.5, - labels="NOT FUNNY", - cex=2, - col="red", - font=2, - srt=45) - } else if(type == 2) { - - ## SHOWTIME OPTION 2 - plot(NA, xlim = c(0, 10), - ylim = c(0, 10), - main = "", - xlab = "", - ylab = "", - axes = FALSE, - frame.plot = FALSE) - - n_frames <- n_frames - t_animation <- t_animation - - dt <- t_animation / n_frames - x1 <- seq(0, 10, length.out = n_frames) - y1 <- rep(1.5, n_frames) - r1 <- 0.5 - - x2 <- seq(0, 16, length.out = n_frames) - y2 <- rep(8.5, n_frames) - r2 <- 0.5 - - x4 <- seq(11, 0, length.out = n_frames) - y4 <- rep(5, n_frames) - r4 <- 0.5 - - # set angles for each step of mouth opening - angles_mouth <- rep(c(0.01, 0.25, 0.5, 0.25), - length.out = n_frames) - - for(i in 1:n_frames){ - # define pacman circles - shape::filledcircle(r1 = r1, - r2 = 0.00001, - mid = c(x1[i], y1[i]), - from = angles_mouth[i], - to = 2 * pi - angles_mouth[i], - col = "yellow") - shape::filledcircle(r1 = r2, - r2 = 0.00001, - mid = c(x2[i], y2[i]), - from = angles_mouth[i], - to = 2 * pi - angles_mouth[i], - col = "yellow") - shape::filledcircle(r1 = r4, - r2 = 0.00001, - mid = c(x4[i], y4[i]), - from = angles_mouth[i] + 3, - to = 2 * pi - angles_mouth[i] + 3, - col = "yellow") - - # define eyes for pacman - points(x1[i] + 0.2, y1[i] + 0.75, pch = 21, bg = 1, cex = 0.7) - points(x2[i] + 0.2, y2[i] + 0.75, pch = 21, bg = 1, cex = 0.7) - points(x4[i] - 0.05, y4[i] + 0.75, pch = 21, bg = 1, cex = 0.7) - - Sys.sleep(dt) - - shape::plotcircle(r = 1.1 * r1, - mid = c(x1[i], y1[i]), - col = "white", - lcol = "white") - shape::plotcircle(r = 1.1 * r2, - mid = c(x2[i], y2[i]), - col = "white", - lcol = "white") - shape::plotcircle(r = 1.1 * r4, - mid = c(x4[i], y4[i]), - col = "white", - lcol = "white") - } - } else if(type == 3) { - ## calculate display ratio - f <- par()$pin[2] / par()$pin[1] - - ## create new overlay plot - plot(NA, - xlim = c(0, 100), - ylim = c(0, 100), - axes = F, - frame.plot = FALSE, - xlab = "", - ylab = "") - - ## create semi-transparent layer - polygon(x = c(-100, -100, 200, 200), - y = c(-100, 200, 200, -100), - col = rgb(1,1,1, 0.8), - lty = 0) - - ## draw christmas trees - n = n.tree - tree.x <- runif(n, 10, 90) - tree.y <- runif(n, 10, 90) - tree.size <- runif(n, 0.3, 1.5) - - for(i in 1:n) { - ## stem - polygon(x = c(tree.x[i] - 1.5 * tree.size[i], - tree.x[i] - 1.5 * tree.size[i], - tree.x[i] + 1.5 * tree.size[i], - tree.x[i] + 1.5 * tree.size[i]) , - y = c(tree.y[i] - 12 * tree.size[i], - tree.y[i] - 1 * tree.size[i], - tree.y[i] - 1 * tree.size[i], - tree.y[i] - 12* tree.size[i]), - col = "rosybrown4", - lty = 0) - - ## branch one - shape::filledellipse(rx1 = 10 * tree.size[i], - rx2 = 0.00001, - mid = c(tree.x[i], tree.y[i] + 3 * tree.size[i]), - col = "darkgreen", - from = 4.0143, - to = 5.41052) - - ## branch two - shape::filledellipse(rx1 = 8 * tree.size[i], - rx2 = 0.00001, - mid = c(tree.x[i], tree.y[i] + 7 * tree.size[i]), - col = "darkgreen", - from = 4.0143, - to = 5.41052) - - ## branch three - shape::filledellipse(rx1 = 6 * tree.size[i], - rx2 = 0.00001, - mid = c(tree.x[i], tree.y[i] + 9 * tree.size[i]), - col = "darkgreen", - from = 4.0143, - to = 5.41052) - - ## branch four - shape::filledellipse(rx1 = 4 * tree.size[i], - rx2 = 0.00001, - mid = c(tree.x[i], tree.y[i] + 11 * tree.size[i]), - col = "darkgreen", - from = 4.0143, - to = 5.41052) - - ## sphere one - shape::filledellipse(rx1 = 1 * f * tree.size[i], - ry1 = 1 * tree.size[i], - mid = c(tree.x[i] + 2 * tree.size[i], - tree.y[i] + 5 * tree.size[i]), - col = shape::shadepalette(n = 20, endcol = "darkred")) - - ## sphere two - shape::filledellipse(rx1 = 0.8 * f * tree.size[i], - ry1 = 0.8 * tree.size[i], - mid = c(tree.x[i] - 1 * tree.size[i], - tree.y[i] + -3 * tree.size[i]), - col = shape::shadepalette(n = 20, endcol = "orange")) - - ## sphere three - shape::filledellipse(rx1 = 1.2 * f * tree.size[i], - ry1 = 1.2 * tree.size[i], - mid = c(tree.x[i] - 1.7 * tree.size[i], - tree.y[i] + 2 * tree.size[i]), - col = shape::shadepalette(n = 20, endcol = "yellow3")) - - ## sphere four - shape::filledellipse(rx1 = 1 * f * tree.size[i], - ry1 = 1 * tree.size[i], - mid = c(tree.x[i] + 3 * tree.size[i], - tree.y[i] - 4 * tree.size[i]), - col = shape::shadepalette(n = 20, endcol = "darkblue")) - - Sys.sleep(0.1) - } - - ## add snow - points(runif(300, 0, 100), runif(300, 0, 100), pch = 8, col = "lightgrey") - } -}#end function diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/README.md b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/README.md deleted file mode 100644 index ffa89ee72..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/README.md +++ /dev/null @@ -1,148 +0,0 @@ - - - - - - - -# Luminescence - -The R package `'Luminescence'` by the R-Luminescence Group provides a -collection of various R functions for luminescence dating data analysis. - -[![Project Status: Active – The project has reached a stable, usable -state and is being actively -developed.](https://www.repostatus.org/badges/latest/active.svg)](https://www.repostatus.org/#active) -[![CRAN](https://www.r-pkg.org/badges/version/Luminescence)](https://CRAN.R-project.org/package=Luminescence) -[![CRAN -DOI](https://img.shields.io/badge/DOI-10.32614/CRAN.package.Luminescence-1f57b6?style=flat&link=https://doi.org/10.32614/CRAN.package.Luminescence)](https://doi.org/10.32614/CRAN.package.Luminescence) -[![ZENODO -DOI](https://zenodo.org/badge/23153315.svg)](https://zenodo.org/badge/latestdoi/23153315) - -[![Downloads](https://cranlogs.r-pkg.org/badges/grand-total/Luminescence)](https://www.r-pkg.org/pkg/Luminescence) -[![Downloads](https://cranlogs.r-pkg.org/badges/Luminescence)](https://www.r-pkg.org/pkg/Luminescence) -[![Downloads](https://cranlogs.r-pkg.org/badges/last-week/Luminescence)](https://www.r-pkg.org/pkg/Luminescence) -[![Downloads](https://cranlogs.r-pkg.org/badges/last-day/Luminescence)](https://www.r-pkg.org/pkg/Luminescence) - -[![R-CMD-check](https://github.com/R-Lum/Luminescence/workflows/GitHub%20Actions%20CI/badge.svg)](https://github.com/R-Lum/Luminescence/actions) -[![Coverage -Status](https://img.shields.io/codecov/c/github/R-Lum/Luminescence.svg)](https://app.codecov.io/github/R-Lum/Luminescence?branch=master) - -## Social media and other resources - -Visit our [R-Luminescence homepage](https://r-luminescence.org). - -## Installation - -#### i. Requirements - -- *Windows (32/64bit)*: - [Rtools](https://cran.r-project.org/bin/windows/Rtools/) (provided by - CRAN) -- *macOS*: [Xcode](https://developer.apple.com/) (provided by Apple) -- *Linux*: [gcc](https://gcc.gnu.org) often comes pre-installed in most - distributions. - -#### ii. Install the package - -Install any development versions using our [RStudio](https://posit.co) -add-in - -![](man/figures/README-Screenshot_AddIn.png) - -##### The plain **R** way - -To install the stable version from CRAN, simply run the following from -an R console: - -``` r -install.packages("Luminescence") -``` - -To install the latest development builds directly from GitHub, run - -``` r -if(!require("devtools")) - install.packages("devtools") -devtools::install_github("R-Lum/Luminescence@") -``` - -## Contribute - -The R luminescence project is based on and evolves from ideas, -contributions and constructive criticism of its users. Help us to -maintain and develop the package, to find bugs and create new functions -as well as a user-friendly design. Try - or write us an -[e-mail](mailto:developers@r-luminescence.org) if anything crosses your -mind or if you want your new self-written function to be to implemented. -You are kindly invited to bring forward the package with us! - -## Note - -**The package comes without any guarantee!** - -Please further note that this version is a development version and may -change day by day. For stable branches please visit the package on [CRAN -Luminescence](https://CRAN.R-project.org/package=Luminescence). - -## License - -This program is free software: you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation, either version 3 of the License, or any later -version. - -This program is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the [GNU -General Public -License](https://github.com/R-Lum/Luminescence/blob/master/LICENSE) for -more details. - -## Funding - -- 2011-2013: The initial version of the package was developed in the - framework of the PhD thesis by Sebastian Kreutzer, while he was funded - through the DFG programme “Rekonstruktion der Umweltbedingungen des - Spätpleistozäns in Mittelsachsen anhand von Löss-Paläobodensequenzen” - ([GEPRIS id: 46526743](https://gepris.dfg.de/gepris/projekt/46526743)) - -- 2014-2018: Cooperation and personal exchange between the developers is - gratefully funded by the DFG in the framework of the program - “Scientific Networks”. Project title: “RLum.Network: Ein - Wissenschaftsnetzwerk zur Analyse von Lumineszenzdaten mit R” ([GEPRIS - id: 250974974](https://gepris.dfg.de/gepris/projekt/250974974)) - -- 05/2014-12/2019: The work of Sebastian Kreutzer as maintainer of the - package was supported by LabEx LaScArBx (ANR - n. ANR-10-LABX-52). - -- 01/2020-04/2022: Sebastian Kreutzer as maintainer of the package has - received funding from the European Union’s Horizon 2020 research and - innovation programme under the Marie Skłodowska-Curie grant agreement - [No 844457 (CREDit)](https://cordis.europa.eu/project/id/844457), and - could continue maintaining the package. - -- since 03/2023: Sebastian Kreutzer as maintainer of the package - receives funding from the DFG Heisenberg programme [No - 505822867](https://gepris.dfg.de/gepris/projekt/505822867). - -- since 08/2024 the future and sustainable development of - `'Luminescence'` towards better reproducibility and usability is - supported through the DFG programme “REPLAY: REProducible Luminescence - Data AnalYses” [No - 528704761](https://gepris.dfg.de/gepris/projekt/528704761?language=en) - led by Dr Sebastian Kreutzer (PI at Heidelberg University, DE) and Dr - Thomas Kolb (PI at Justus-Liebig-University Giessen, DE). - -- All other authors gratefully received additional funding from various - public funding bodies. - -## Related projects - -- [RLumModel](https://github.com/R-Lum/RLumModel) -- [RLumShiny](https://github.com/R-Lum/RLumShiny) -- [RLumDocker](https://github.com/R-Lum/RLumDocker) -- [BayLum](https://github.com/crp2a/BayLum) -- [RCarb](https://github.com/R-Lum/RCarb) -- [RLumCarlo](https://github.com/R-Lum/RLumCarlo) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/build/partial.rdb b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/build/partial.rdb deleted file mode 100644 index 939802b7a..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/build/partial.rdb and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/build/vignette.rds b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/build/vignette.rds deleted file mode 100644 index 54f258387..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/build/vignette.rds and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/BaseDataSet.ConversionFactors.rda b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/BaseDataSet.ConversionFactors.rda deleted file mode 100644 index 116bb67a1..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/BaseDataSet.ConversionFactors.rda and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/BaseDataSet.CosmicDoseRate.rda b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/BaseDataSet.CosmicDoseRate.rda deleted file mode 100644 index cd6e62c41..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/BaseDataSet.CosmicDoseRate.rda and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/BaseDataSet.FractionalGammaDose.rda b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/BaseDataSet.FractionalGammaDose.rda deleted file mode 100644 index dc2dbfce1..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/BaseDataSet.FractionalGammaDose.rda and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/BaseDataSet.GrainSizeAttenuation.rda b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/BaseDataSet.GrainSizeAttenuation.rda deleted file mode 100644 index 054c21d64..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/BaseDataSet.GrainSizeAttenuation.rda and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.Al2O3C.rda b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.Al2O3C.rda deleted file mode 100644 index af9e04f43..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.Al2O3C.rda and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.BINfileData.rda b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.BINfileData.rda deleted file mode 100644 index c370e040f..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.BINfileData.rda and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.CW_OSL_Curve.rda b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.CW_OSL_Curve.rda deleted file mode 100644 index 8f172783e..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.CW_OSL_Curve.rda and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.CobbleData.rda b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.CobbleData.rda deleted file mode 100644 index 1b9718049..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.CobbleData.rda and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.DeValues.rda b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.DeValues.rda deleted file mode 100644 index 71bf0a69a..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.DeValues.rda and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.Fading.rda b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.Fading.rda deleted file mode 100644 index bda9a4cc0..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.Fading.rda and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.FittingLM.rda b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.FittingLM.rda deleted file mode 100644 index 1a0df9a4e..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.FittingLM.rda and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.LxTxData.rda b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.LxTxData.rda deleted file mode 100644 index 92198f7f1..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.LxTxData.rda and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.LxTxOSLData.rda b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.LxTxOSLData.rda deleted file mode 100644 index 5cb03f806..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.LxTxOSLData.rda and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.MortarData.rda b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.MortarData.rda deleted file mode 100644 index 3b177b12e..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.MortarData.rda and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.RLum.Analysis.rda b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.RLum.Analysis.rda deleted file mode 100644 index 3e71ba490..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.RLum.Analysis.rda and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.RLum.Data.Image.rda b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.RLum.Data.Image.rda deleted file mode 100644 index 17e74c011..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.RLum.Data.Image.rda and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.ScaleGammaDose.rda b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.ScaleGammaDose.rda deleted file mode 100644 index 6e8c30ef1..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.ScaleGammaDose.rda and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.SurfaceExposure.rda b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.SurfaceExposure.rda deleted file mode 100644 index cec2e3203..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.SurfaceExposure.rda and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.TR_OSL.rda b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.TR_OSL.rda deleted file mode 100644 index 70b6ce0c4..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.TR_OSL.rda and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.XSYG.rda b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.XSYG.rda deleted file mode 100644 index 2bebcca14..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.XSYG.rda and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.portableOSL.rda b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.portableOSL.rda deleted file mode 100644 index 7fd5518c2..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/ExampleData.portableOSL.rda and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/datalist b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/datalist deleted file mode 100644 index 808177afa..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/data/datalist +++ /dev/null @@ -1,21 +0,0 @@ -BaseDataSet.ConversionFactors: BaseDataSet.ConversionFactors -BaseDataSet.CosmicDoseRate: values.cosmic.Softcomp values.factor.Altitude values.par.FJH -BaseDataSet.FractionalGammaDose: BaseDataSet.FractionalGammaDose -BaseDataSet.GrainSizeAttenuation: BaseDataSet.GrainSizeAttenuation -ExampleData.Al2O3C: data_CrossTalk data_ITC -ExampleData.BINfileData: CWOSL.SAR.Data TL.SAR.Data -ExampleData.CobbleData: ExampleData.CobbleData -ExampleData.CW_OSL_Curve: CW_Curve.BosWallinga2012 ExampleData.CW_OSL_Curve -ExampleData.DeValues: ExampleData.DeValues -ExampleData.Fading: ExampleData.Fading -ExampleData.FittingLM: values.curve values.curveBG -ExampleData.LxTxData: LxTxData -ExampleData.LxTxOSLData: Lx.data Tx.data -ExampleData.MortarData: MortarData -ExampleData.portableOSL: ExampleData.portableOSL -ExampleData.RLum.Analysis: IRSAR.RF.Data -ExampleData.RLum.Data.Image: ExampleData.RLum.Data.Image -ExampleData.ScaleGammaDose: ExampleData.ScaleGammaDose -ExampleData.SurfaceExposure: ExampleData.SurfaceExposure -ExampleData.TR_OSL: ExampleData.TR_OSL -ExampleData.XSYG: OSL.SARMeasurement TL.Spectrum diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/CITATION b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/CITATION deleted file mode 100644 index bcebfc07a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/CITATION +++ /dev/null @@ -1,95 +0,0 @@ -citHeader("The R package 'Luminescence' is the joint work of many over many years. To cite the R package 'Luminescence' we suggest using the first entry and applying the rest were justified. To credit all authors **and** contributors, please see https://10.32614/CRAN.package.Luminescence and the archive on Zenodo https://doi.org/10.5281/zenodo.596252 and for an always-up-tp-date citation record with DOI.") - -citation(auto = meta) - - bibentry(bibtype = "Article", - title = "Introducing an R package for luminescence dating analysis", - author = "Sebastian Kreutzer, Christoph Schmidt, Margret C. Fuchs, Michael Dietze, Manfred Fischer, Markus Fuchs", - year = "2012", - journal = "Ancient TL", - volume = "30", - number = "1", - pages = "1-8") - - bibentry(bibtype = "Article", - title = "A practical guide to the R package Luminescence", - author = "Michael Dietze, Sebastian Kreutzer, Margret C. Fuchs, Christoph Burow, Manfred Fischer, Christoph Schmidt", - year = "2013", - journal = "Ancient TL", - volume = "31", - number = "1", - pages = "11-18") - - bibentry(bibtype = "Article", - title = "Data processing in luminescence dating analysis: An exemplary workflow using the R package 'Luminescence'", - author = "Margret C. Fuchs, Sebastian Kreutzer, Christoph Burow, Michael Dietze, Manfred Fischer, - Christoph Schmidt, Markus Fuchs", - year = "2015", - journal = "Quaternary International", - volume = "362", - pages = "8-13", - doi = "10.1016/j.quaint.2014.06.034") - - bibentry(bibtype = "Article", - title = "A new R function for the Internal External Uncertainty (IEU) model", - author = "Rachel K Smedley", - journal = "Ancient TL", - year = "2015", - volume = "33", - number = "1", - pages = "16-21") - - bibentry(bibtype = "Article", - title = "The abanico plot: visualising chronometric data with individual standard errors", - author = "Michael Dietze, Sebastian Kreutzer, Christoph Burow, Margret C. Fuchs, Manfred Fischer, Christoph Schmidt", - year = "2016", - journal = "Quaternary Geochronology", - volume = "31", - pages = "12-18", - doi = "10.1016/j.quageo.2015.09.003") - - bibentry(bibtype = "Article", - title = "Bayesian statistics in luminescence dating: The baSAR-model and its implementation in the R package 'Luminescence'", - author = "Norbert Mercier and Sebastian Kreutzer and Claire Christophe and Guillaume - Guerin and Pierre Guibert and Christelle Lahaye and Philippe Lanos and Anne Philippe and Chantal Tribolo", - year = "2016", - journal = "Ancient TL", - volume = "34", - number = "2", - pages = "14-21") - - bibentry(bibtype = "Article", - title = "Software in the context of luminescence dating: status, concepts and suggestions exemplified by the R package 'Luminescence'", - author = "Sebastian Kreutzer and Christoph Burow and Michael Dietze and Margret C. Fuchs and Manfred Fischer and Christoph Schmidt", - year = "2017", - journal = "Ancient TL", - volume = "35", - number = "2", - pages = "1-11") - - bibentry(bibtype = "Article", - title = "Environmental Dose Rate Determination Using a Passive Dosimeter: Techniques and Workflow for alpha-Al2O3:C Chips", - author = "Sebastian Kreutzer and Loic Martin and Guillaume Guerin and Chantal Tribolo and Pierre Selva and Norbert Mercier", - year = "2018", - journal = "Geochronometria", - volume = "45", - pages = "56-67") - - bibentry(bibtype = "Article", - title = "Age determination using feldspar: Evaluating fading-correction model performance", - author = "Georgina E.King and Christoph Burow and Helen M.Roberts and Nicholas J.G.Pearce", - year = "2018", - journal = "Radiation Measurements", - volume = "119", - pages = "58-73", - doi = "10.1016/j.radmeas.2018.07.013") - - bibentry(bibtype = "Article", - title = "Luminescence age calculation through Bayesian convolution of equivalent dose and dose-rate distributions:the D_e D_r model", - author = "Norbert Mercier and Jean-Michel Galharret and Chantal Tribolo and Sebastian Kreutzer and Anne Philippe", - year = "2022", - journal = "Geochronology", - volume = "4", - issue = "1", - pages = "292-310", - doi = "10.5194/gchron-4-297-2022") diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/WORDLIST b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/WORDLIST deleted file mode 100644 index 4339fb1ee..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/WORDLIST +++ /dev/null @@ -1,626 +0,0 @@ -AEQUIVAL -ANR -Abanico -AbanicoPlot -Aberystwyth -Acknowledgements -Acta -Adamiec -Adrie -Aitken -Aktivitaet -Alastair -AliquotSize -Aliquots -Allkofer -Amidon -Analyse -Angelucci -Angulo -Anhalt -Archaeometry -Auclair -AverageDose -Azevedo -BINX -BINfile -BINfileData -BT -Baartman -Barbouti -Barwa -BaseDataSet -BayLum -Bergakademie -Bestimmung -Bingen -Biometrika -Biomolecular -Blasse -Bluszcz -Boca -Boetter -Bolker -Bortolot -Bos -BosWallinga -Bq -Bracht -Brightline -Brookhaven -Bugfixes -Bulur -Buylaert -CCD -CLL -CMD -CNRS -CRC -CREDit -CRP -CWCurve -CWOSL -Cammeraat -Carstensen -CentralDose -Centre -Chapot -Characterisation -CobbleDoseRate -Colour -Combès -CommonDose -ConversionFactors -CosmicDoseRate -CosmicRayRemoval -Cresswell -CrossTalk -Croux -Cueva -Cunha -DEoptim -DFG -DLED -DOI -DRAC -DRC -DRCSummary -DRTResults -DTU -DTYPE -Dau -De -DeLong -DeWitt -Debertin -Debruyne -Deconvolution -DetPlot -Dolni -Donnelly -DorNie -Dormagen -DoseRate -Dosimetry -Dunson -Durbin -EBG -EfficiencyCorrection -Efron -Ein -Elsevier -EmissionSpectra -Engelen -Eq -Erfurt -ExampleData -FDist -FFM -FI -FMM -FadingCorr -FadingMeasurement -FastRatio -FilterCombinations -FiniteMixture -Freiberg -Frouin -FuchsLang -Furetta -GEPRIS -GFZ -GammaDose -Gauthier -Gelman -Geochronology -Geochronometria -Geoff -Geomorphologie -Geomorphology -Geophys -Giessen -Gorin -Grabmaier -Grabmeier -Grampp -Grehl -GrowthCurve -Gruen -Guadalentin -Guo -Guralnik -Guérin -Gy -HC -HZDR -Hadley -Hamzaoui -Hase -Hatte -Heer -Helmer -Hilgers -Hintze -Hoehne -HomogeneityTest -Hornik -Huot -IC -IEU -IRAMAT -IRSAR -IRSL -ISSN -ITC -ImageJ -Ioannides -IrradiationTimes -Jakob -Jinmium -Jokisch -Justus -KDE -Kambhampati -Kars -Karsten -Kehl -Kinahan -Kitis -Krbetschek -LABX -LEDs -LIGHTSOURCE -LM -LMCurve -LTYPE -LaScArBx -LabEx -Lagroix -Lahaye -Lamothe -Lanos -Laslett -Lauer -Lausanne -Lefrais -Lenovo -Lett -Levenberg -Liebig -Liritzis -LnTn -Lubachevsky -Lum -Lumineszenzdaten -Lx -LxTx -Löss -MAAD -MASSAKT -MCM -MERCHANTABILITY -Madsen -Majeed -Marquardt -MatLab -MaxDose -McKeever -Meszner -MinDose -Mittelsachsen -Mittelstraß -Moine -Morthekai -Moska -Mungo -NCL -NNDC -NRt -NUTECH -Namche -Nievenheim -Normalisation -Normalise -Nuclide -Nurmela -Nutech -OSL -OSLAgeSummary -OSLLifeTimes -OSLLxTxDecomposed -OSLLxTxRatio -OSLdata -Oestergard -Olley -Ostrau -PECC -PMT -POSL -PSL -Pagonis -Palais -Paläobodensequenzen -Papachristodoulou -Parmigiani -Pearce -Pederson -Petr -Photoionisation -Photomultiplier -Pikal -Plummer -Preusser -Princton -Pych -QNL -RCarb -RECTYPE -RLum -RLumCarlo -RLumDocker -RLumModel -RLumShiny -RMF -ROI -ROIs -RStudio -RadialPlot -Radionukliden -Rainer -Ramped -Rastin -Rastin's -Raton -Rds -Rekonstruktion -Risoe -RisoeBINfileData -Risø -Rodnight -Rosspeintner -Rottewitz -Rousseeuw -Rtools -Ruehle -Ruprecht -SAR -SARMeasurement -SCHM -SG -SHA -SPE -STRB -SUERC -Sanderson -Sandur -Sauer -ScaleGammaDose -Schlunegger -Schoorl -Selva -Semrock -Simmank -Singarayer -Singhvi -SingleGrainData -Sippewissett -Skłodowska -Soerensen -Softcomp -Sohbati -SourceDoseRate -Spectrochimica -Spectrometry -Springer -Spätpleistozäns -Stamoulis -Standardised -Steffen -Stolz -Storn -Straessner -Streibig -Subclasses -SurfaceExposure -Svoboda -Sébastien -TLAPLLIC -TLLxTxRatio -TOL -Technometrics -TestFile -ThermalLifetime -ThermalQuenching -Thermo -Thermoluminescence -Thomsen -Thue's -Tibshirani -TnTx -Tobias -Torben -Trautmann -Trave -Trebgast -Tribolo -Tx -UMR -UNIL -USGS -Umweltbedingungen -Un -Université -Unravelling -Urbanova -Valla -Vehtari -Veldkamp -Vestonice -Villaverde -ViolinPlot -Visualise -Vogl -Wageningen -Wallinga -Weniger -Wickham -Wiechen -Willian -Wintle -Wissenschaftsnetzwerk -Woda -WodaFuchs -XLS -XLSX -XRF -XSXG -XSYG -Xcode -YAML -Yoshida -ZEU -Zeitschrift -Zeuchfeld -Zilhao -abanico -abline -absorber -al -aliqouts -aliquot -aliquots -aluminium -amongst -analyse -analysed -analysing -anhand -ascendantly -astr -athermal -baSAR -bbmle -behaviour -binx -calc -centre -centred -centres -centring -chemometrics -chronometric -colour -coloured -colours -confint -cts -curveType -customise -customised -data's -de -deconvolution -deconvolve -dependences -der -des -detrapping -devtools -dispersive -doi -dosimetric -dosimetry -du -eV -eq -et -feldspars -fuer -gSGC -gcc -gchron -generalised -geochr -geochronometry -ggplot -github -grey -harmonise -hg -hotbleach -http -https -initialisation -irradiations -isochrons -isothermal -iteratively -ka -labelling -lamW -lambertW -lexsyg -lm -loess -logarithmized -lossy -ly -mGy -mJ -mW -macOS -massebezogenen -matplot -matrixStats -minimisation -minpack -mit -modelled -modelling -mol -monochromator -mtext -muon -muons -nd -neighbouring -nls -nlsLM -nm -normalisation -normalise -normalised -normalises -nuclide -onwards -openFileInOS -optimisation -optimise -optimised -pHM -pHMi -pIRIR -pIRIRSequence -pLM -pLMi -pPM -pPMi -packings -palaeodose -pandoc -pch -persp -photoionisation -photomultiplier -physica -plotly -poisson -polymineral -portableOSL -pre -preprint -programme -pseudoR -psl -quageo -quartile -radioelement -radioelements -radiofluorescence -radioluminescence -radionuclide -radmeas -rasterImage -readBin -readSPE -readTIFF -readxl -realised -recognised -reorganisation -reproducibility -retrapping -rightAnswer -rjags -rmarkdown -rnorm -rollmean -rollmedian -rowMeans -rowMedians -rowMins -rowSds -rowSums -rowVars -rstudioapi -sTeve -serialised -sig -sigmab -standardisation -standardised -stratigraphy -summand -summarise -summarised -summarises -summarising -svg -tc -thermochronometry -thermoluminescence -txtProgressBar -uid -un -unfaded -uniroot -unitless -unrecognised -utilises -violinmplot -violplot -vioplot -visualisation -visualised -visualising -von -writeTIFF -xsyg -xy -ymax -ymin -zur -µA -µm -µs -’Luminescence’ -ORCID -Oehler -Neudorf -GOK -artefact -Zhang -Klasen -Junjie -Tsukamoto -Murari diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/doc/S4classObjects.pdf b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/doc/S4classObjects.pdf deleted file mode 100644 index cd40e12c2..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/doc/S4classObjects.pdf and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/doc/S4classObjects.pdf.asis b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/doc/S4classObjects.pdf.asis deleted file mode 100644 index b4728c24d..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/doc/S4classObjects.pdf.asis +++ /dev/null @@ -1,6 +0,0 @@ -%\VignetteIndexEntry{S4-class Object Structure in 'Luminescence'} -%\VignetteEngine{R.rsp::asis} -%\VignetteKeyword{PDF} -%\VignetteKeyword{HTML} -%\VignetteKeyword{vignette} -%\VignetteKeyword{package} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/BINfile_V8.binx b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/BINfile_V8.binx deleted file mode 100644 index a28b1cc6d..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/BINfile_V8.binx and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/Daybreak_TestFile.DAT b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/Daybreak_TestFile.DAT deleted file mode 100644 index b1d8c29a8..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/Daybreak_TestFile.DAT and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/Daybreak_TestFile.txt b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/Daybreak_TestFile.txt deleted file mode 100644 index 23288c3ca..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/Daybreak_TestFile.txt +++ /dev/null @@ -1,810 +0,0 @@ -ScriptFile=C:\Program Files\Daybreak\FL Console\Scripts\active\QSAR23c.TXT - -ScriptName=Single aliquot regenerative dose method - -Sample= - -ReaderID=TLINFO.DTA - -ReaderType=2200 - -SingleAliquot=true - -[NewRecord] - -Operation=1 - -SampleType=Disk - -Disk=0 - -DataType=PREHEAT TL - -MaxTemp=200 - -HoldTime=10 - -RampRate=3 - -Started=6/4/2015 3:58:46 PM - -Stopped=6/4/2015 4:00:52 PM - -Points=40 - - 0; 5.000; 30.000; valid - - 1; 10.000; 32.000; valid - - 2; 15.000; 30.000; valid - - 3; 20.000; 28.000; valid - - 4; 25.000; 32.000; valid - - 5; 30.000; 33.000; valid - - 6; 35.000; 37.000; valid - - 7; 40.000; 31.000; valid - - 8; 45.000; 29.000; valid - - 9; 50.000; 25.000; valid - - 10; 55.000; 37.000; valid - - 11; 60.000; 37.000; valid - - 12; 65.000; 36.000; valid - - 13; 70.000; 34.000; valid - - 14; 75.000; 28.000; valid - - 15; 80.000; 36.000; valid - - 16; 85.000; 35.000; valid - - 17; 90.000; 32.000; valid - - 18; 95.000; 31.000; valid - - 19; 100.000; 31.000; valid - - 20; 105.000; 31.000; valid - - 21; 110.000; 41.000; valid - - 22; 115.000; 28.000; valid - - 23; 120.000; 39.000; valid - - 24; 125.000; 28.000; valid - - 25; 130.000; 39.000; valid - - 26; 135.000; 28.000; valid - - 27; 140.000; 31.000; valid - - 28; 145.000; 36.000; valid - - 29; 150.000; 43.000; valid - - 30; 155.000; 34.000; valid - - 31; 160.000; 39.000; valid - - 32; 165.000; 31.000; valid - - 33; 170.000; 35.000; valid - - 34; 175.000; 41.000; valid - - 35; 180.000; 45.000; valid - - 36; 185.000; 46.000; valid - - 37; 190.000; 50.000; valid - - 38; 195.000; 70.000; valid - - 39; 200.000; 82.000; valid - - - -[NewRecord] - -Operation=2 - -SampleType=Disk - -Disk=0 - -DataType=OSL - -SampleTemp=125 - -Power=95.00 - -Started=6/4/2015 4:01:23 PM - -Stopped=6/4/2015 4:03:03 PM - -Points=325 - - 0; 0.100; 303.000; valid - - 1; 0.200; 335.000; valid - - 2; 0.300; 344.000; valid - - 3; 0.400; 332.000; valid - - 4; 0.500; 304.000; valid - - 5; 0.600; 325.000; valid - - 6; 0.700; 324.000; valid - - 7; 0.800; 292.000; valid - - 8; 0.900; 290.000; valid - - 9; 1.000; 301.000; valid - - 10; 1.100; 310.000; valid - - 11; 1.200; 279.000; valid - - 12; 1.300; 288.000; valid - - 13; 1.400; 298.000; valid - - 14; 1.500; 272.000; valid - - 15; 1.600; 292.000; valid - - 16; 1.700; 323.000; valid - - 17; 1.800; 273.000; valid - - 18; 1.900; 290.000; valid - - 19; 2.000; 315.000; valid - - 20; 2.100; 296.000; valid - - 21; 2.200; 286.000; valid - - 22; 2.300; 280.000; valid - - 23; 2.400; 293.000; valid - - 24; 2.500; 299.000; valid - - 25; 2.600; 260.000; valid - - 26; 2.700; 275.000; valid - - 27; 2.800; 267.000; valid - - 28; 2.900; 252.000; valid - - 29; 3.000; 278.000; valid - - 30; 3.100; 276.000; valid - - 31; 3.200; 268.000; valid - - 32; 3.300; 278.000; valid - - 33; 3.400; 293.000; valid - - 34; 3.500; 266.000; valid - - 35; 3.600; 279.000; valid - - 36; 3.700; 257.000; valid - - 37; 3.800; 272.000; valid - - 38; 3.900; 264.000; valid - - 39; 4.000; 279.000; valid - - 40; 4.100; 263.000; valid - - 41; 4.200; 264.000; valid - - 42; 4.300; 246.000; valid - - 43; 4.400; 285.000; valid - - 44; 4.500; 252.000; valid - - 45; 4.600; 238.000; valid - - 46; 4.700; 257.000; valid - - 47; 4.800; 280.000; valid - - 48; 4.900; 264.000; valid - - 49; 5.000; 242.000; valid - - 50; 5.100; 256.000; valid - - 51; 5.200; 257.000; valid - - 52; 5.300; 238.000; valid - - 53; 5.400; 234.000; valid - - 54; 5.500; 239.000; valid - - 55; 5.600; 252.000; valid - - 56; 5.700; 220.000; valid - - 57; 5.800; 239.000; valid - - 58; 5.900; 234.000; valid - - 59; 6.000; 233.000; valid - - 60; 6.100; 227.000; valid - - 61; 6.200; 215.000; valid - - 62; 6.300; 252.000; valid - - 63; 6.400; 214.000; valid - - 64; 6.500; 231.000; valid - - 65; 6.600; 232.000; valid - - 66; 6.700; 214.000; valid - - 67; 6.800; 242.000; valid - - 68; 6.900; 216.000; valid - - 69; 7.000; 216.000; valid - - 70; 7.100; 225.000; valid - - 71; 7.200; 204.000; valid - - 72; 7.300; 224.000; valid - - 73; 7.400; 235.000; valid - - 74; 7.500; 227.000; valid - - 75; 7.600; 207.000; valid - - 76; 7.700; 209.000; valid - - 77; 7.800; 221.000; valid - - 78; 7.900; 207.000; valid - - 79; 8.000; 221.000; valid - - 80; 8.100; 200.000; valid - - 81; 8.200; 214.000; valid - - 82; 8.300; 228.000; valid - - 83; 8.400; 207.000; valid - - 84; 8.500; 200.000; valid - - 85; 8.600; 195.000; valid - - 86; 8.700; 193.000; valid - - 87; 8.800; 187.000; valid - - 88; 8.900; 212.000; valid - - 89; 9.000; 197.000; valid - - 90; 9.100; 206.000; valid - - 91; 9.200; 227.000; valid - - 92; 9.300; 202.000; valid - - 93; 9.400; 180.000; valid - - 94; 9.500; 186.000; valid - - 95; 9.600; 193.000; valid - - 96; 9.700; 203.000; valid - - 97; 9.800; 204.000; valid - - 98; 9.900; 189.000; valid - - 99; 10.000; 202.000; valid - -100; 10.100; 186.000; valid - -101; 10.200; 174.000; valid - -102; 10.300; 180.000; valid - -103; 10.400; 208.000; valid - -104; 10.500; 194.000; valid - -105; 10.600; 185.000; valid - -106; 10.700; 194.000; valid - -107; 10.800; 184.000; valid - -108; 10.900; 178.000; valid - -109; 11.000; 170.000; valid - -110; 11.100; 181.000; valid - -111; 11.200; 181.000; valid - -112; 11.300; 183.000; valid - -113; 11.400; 192.000; valid - -114; 11.500; 167.000; valid - -115; 11.600; 179.000; valid - -116; 11.700; 175.000; valid - -117; 11.800; 161.000; valid - -118; 11.900; 145.000; valid - -119; 12.000; 175.000; valid - -120; 12.100; 192.000; valid - -121; 12.200; 178.000; valid - -122; 12.300; 164.000; valid - -123; 12.400; 162.000; valid - -124; 12.500; 188.000; valid - -125; 12.600; 173.000; valid - -126; 12.700; 170.000; valid - -127; 12.800; 191.000; valid - -128; 12.900; 156.000; valid - -129; 13.000; 159.000; valid - -130; 13.100; 173.000; valid - -131; 13.200; 154.000; valid - -132; 13.300; 155.000; valid - -133; 13.400; 151.000; valid - -134; 13.500; 165.000; valid - -135; 13.600; 161.000; valid - -136; 13.700; 150.000; valid - -137; 13.800; 161.000; valid - -138; 13.900; 161.000; valid - -139; 14.000; 168.000; valid - -140; 14.100; 152.000; valid - -141; 14.200; 157.000; valid - -142; 14.300; 171.000; valid - -143; 14.400; 154.000; valid - -144; 14.500; 162.000; valid - -145; 14.600; 162.000; valid - -146; 14.700; 173.000; valid - -147; 14.800; 162.000; valid - -148; 14.900; 154.000; valid - -149; 15.000; 155.000; valid - -150; 15.100; 139.000; valid - -151; 15.200; 134.000; valid - -152; 15.300; 148.000; valid - -153; 15.400; 148.000; valid - -154; 15.500; 155.000; valid - -155; 15.600; 140.000; valid - -156; 15.700; 151.000; valid - -157; 15.800; 140.000; valid - -158; 15.900; 147.000; valid - -159; 16.000; 146.000; valid - -160; 16.100; 146.000; valid - -161; 16.200; 145.000; valid - -162; 16.300; 127.000; valid - -163; 16.400; 156.000; valid - -164; 16.500; 144.000; valid - -165; 16.600; 145.000; valid - -166; 16.700; 137.000; valid - -167; 16.800; 131.000; valid - -168; 16.900; 130.000; valid - -169; 17.000; 146.000; valid - -170; 17.100; 133.000; valid - -171; 17.200; 121.000; valid - -172; 17.300; 114.000; valid - -173; 17.400; 146.000; valid - -174; 17.500; 122.000; valid - -175; 17.600; 131.000; valid - -176; 17.700; 144.000; valid - -177; 17.800; 134.000; valid - -178; 17.900; 147.000; valid - -179; 18.000; 126.000; valid - -180; 18.100; 131.000; valid - -181; 18.200; 120.000; valid - -182; 18.300; 133.000; valid - -183; 18.400; 138.000; valid - -184; 18.500; 127.000; valid - -185; 18.600; 140.000; valid - -186; 18.700; 125.000; valid - -187; 18.800; 133.000; valid - -188; 18.900; 128.000; valid - -189; 19.000; 114.000; valid - -190; 19.100; 131.000; valid - -191; 19.200; 113.000; valid - -192; 19.300; 123.000; valid - -193; 19.400; 128.000; valid - -194; 19.500; 127.000; valid - -195; 19.600; 132.000; valid - -196; 19.700; 120.000; valid - -197; 19.800; 109.000; valid - -198; 19.900; 107.000; valid - -199; 20.000; 112.000; valid - -200; 20.100; 108.000; valid - -201; 20.200; 124.000; valid - -202; 20.300; 110.000; valid - -203; 20.400; 120.000; valid - -204; 20.500; 117.000; valid - -205; 20.600; 115.000; valid - -206; 20.700; 122.000; valid - -207; 20.800; 102.000; valid - -208; 20.900; 128.000; valid - -209; 21.000; 105.000; valid - -210; 21.100; 114.000; valid - -211; 21.200; 114.000; valid - -212; 21.300; 107.000; valid - -213; 21.400; 118.000; valid - -214; 21.500; 118.000; valid - -215; 21.600; 120.000; valid - -216; 21.700; 113.000; valid - -217; 21.800; 126.000; valid - -218; 21.900; 119.000; valid - -219; 22.000; 108.000; valid - -220; 22.100; 92.000; valid - -221; 22.200; 92.000; valid - -222; 22.300; 94.000; valid - -223; 22.400; 107.000; valid - -224; 22.500; 117.000; valid - -225; 22.600; 92.000; valid - -226; 22.700; 105.000; valid - -227; 22.800; 99.000; valid - -228; 22.900; 123.000; valid - -229; 23.000; 111.000; valid - -230; 23.100; 102.000; valid - -231; 23.200; 109.000; valid - -232; 23.300; 96.000; valid - -233; 23.400; 90.000; valid - -234; 23.500; 94.000; valid - -235; 23.600; 103.000; valid - -236; 23.700; 98.000; valid - -237; 23.800; 101.000; valid - -238; 23.900; 108.000; valid - -239; 24.000; 101.000; valid - -240; 24.100; 100.000; valid - -241; 24.200; 108.000; valid - -242; 24.300; 93.000; valid - -243; 24.400; 107.000; valid - -244; 24.500; 107.000; valid - -245; 24.600; 92.000; valid - -246; 24.700; 94.000; valid - -247; 24.800; 89.000; valid - -248; 24.900; 97.000; valid - -249; 25.000; 95.000; valid - -250; 26.000; 892.000; valid - -251; 27.000; 890.000; valid - -252; 28.000; 841.000; valid - -253; 29.000; 850.000; valid - -254; 30.000; 807.000; valid - -255; 31.000; 791.000; valid - -256; 32.000; 753.000; valid - -257; 33.000; 728.000; valid - -258; 34.000; 703.000; valid - -259; 35.000; 651.000; valid - -260; 36.000; 640.000; valid - -261; 37.000; 612.000; valid - -262; 38.000; 550.000; valid - -263; 39.000; 539.000; valid - -264; 40.000; 524.000; valid - -265; 41.000; 501.000; valid - -266; 42.000; 503.000; valid - -267; 43.000; 478.000; valid - -268; 44.000; 468.000; valid - -269; 45.000; 438.000; valid - -270; 46.000; 434.000; valid - -271; 47.000; 441.000; valid - -272; 48.000; 388.000; valid - -273; 49.000; 381.000; valid - -274; 50.000; 372.000; valid - -275; 51.000; 380.000; valid - -276; 52.000; 349.000; valid - -277; 53.000; 326.000; valid - -278; 54.000; 317.000; valid - -279; 55.000; 297.000; valid - -280; 56.000; 299.000; valid - -281; 57.000; 294.000; valid - -282; 58.000; 258.000; valid - -283; 59.000; 260.000; valid - -284; 60.000; 264.000; valid - -285; 61.000; 271.000; valid - -286; 62.000; 250.000; valid - -287; 63.000; 241.000; valid - -288; 64.000; 239.000; valid - -289; 65.000; 241.000; valid - -290; 66.000; 220.000; valid - -291; 67.000; 215.000; valid - -292; 68.000; 217.000; valid - -293; 69.000; 203.000; valid - -294; 70.000; 196.000; valid - -295; 71.000; 201.000; valid - -296; 72.000; 198.000; valid - -297; 73.000; 188.000; valid - -298; 74.000; 183.000; valid - -299; 75.000; 173.000; valid - -300; 76.000; 166.000; valid - -301; 77.000; 167.000; valid - -302; 78.000; 187.000; valid - -303; 79.000; 169.000; valid - -304; 80.000; 162.000; valid - -305; 81.000; 145.000; valid - -306; 82.000; 163.000; valid - -307; 83.000; 151.000; valid - -308; 84.000; 154.000; valid - -309; 85.000; 135.000; valid - -310; 86.000; 134.000; valid - -311; 87.000; 133.000; valid - -312; 88.000; 133.000; valid - -313; 89.000; 141.000; valid - -314; 90.000; 134.000; valid - -315; 91.000; 133.000; valid - -316; 92.000; 120.000; valid - -317; 93.000; 128.000; valid - -318; 94.000; 114.000; valid - -319; 95.000; 147.000; valid - -320; 96.000; 139.000; valid - -321; 97.000; 114.000; valid - -322; 98.000; 128.000; valid - -323; 99.000; 113.000; valid - -324; 100.000; 127.000; valid - - - -[NewRecord] - -Operation=3 - -SampleType=Disk - -Disk=0 - -DataType=NORM Irrad - -SampleTemp=20 - -IrradTime=257 - -IrradDose=20.02 - -Started=6/4/2015 4:03:51 PM - -Stopped=6/4/2015 4:08:15 PM - - - diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/DorNie_0016.psl b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/DorNie_0016.psl deleted file mode 100644 index 545e5370e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/DorNie_0016.psl +++ /dev/null @@ -1,330 +0,0 @@ - -========================================================================================= -Run Name: ALU Sample no: 0016 -Sequence Name: Praktikum2016 Filename: Praktikum2016 -Dark Count: 15 c/s Light Count: 0 c/s -Dark Count Correction: OFF 256 Offset Subtract: ON - -Datafile Path: D:\Results\DORNIE\ALU\ALU0016.psl -Summary Path : D:\Results\DORNIE\ALU\summary\ALU.sum -Run Sequence : Praktikum2016 ------------------------------------------------------------------------------------------ -\ L11 @ 5/19/2016 4:45:12 PM / - '--------------------------' - - ----------------------------------------------------------------------------------------- -Measurement : DARK 15s | Stim 0 | On/Off(us) 15,15 | Cycle(ms),No 1000, 15 ----------------------------------------------------------------------------------------- - -Time (s) Total Count Counts per Cycle --------- --------------------- --------------------- - - 1 0 +/- 4 0 +/- 4 - 2 -2 +/- 6 -2 +/- 4 - 3 12 +/- 8 14 +/- 5 - 4 19 +/- 9 7 +/- 5 - 5 25 +/- 10 6 +/- 5 - 6 18 +/- 10 -7 +/- 5 - 7 17 +/- 11 -1 +/- 4 - 8 23 +/- 12 6 +/- 5 - 9 15 +/- 12 -8 +/- 5 - 10 18 +/- 13 3 +/- 4 - 11 16 +/- 13 -2 +/- 4 - 12 22 +/- 14 6 +/- 5 - 13 22 +/- 15 0 +/- 4 - 14 28 +/- 15 6 +/- 5 - 15 25 +/- 16 -3 +/- 4 - - - - Terminal Count = 25 +/- 16 - - - ----------------------------------------------------------------------------------------- -Measurement : S1 15 0 100s | Stim 1 | On/Off(us) 15, 0 | Cycle(ms),No 1000, 100 ----------------------------------------------------------------------------------------- - -Time (s) Total Count Counts per Cycle --------- --------------------- --------------------- - - 1 16660 +/- 129 16660 +/- 129 - 2 32789 +/- 181 16129 +/- 127 - 3 48649 +/- 221 15860 +/- 126 - 4 64422 +/- 254 15773 +/- 126 - 5 77931 +/- 279 13509 +/- 116 - 6 93102 +/- 305 15171 +/- 123 - 7 108127 +/- 329 15025 +/- 123 - 8 122880 +/- 351 14753 +/- 122 - 9 137318 +/- 371 14438 +/- 120 - 10 151523 +/- 389 14205 +/- 119 - 11 165571 +/- 407 14048 +/- 119 - 12 179457 +/- 424 13886 +/- 118 - 13 193226 +/- 440 13769 +/- 117 - 14 206845 +/- 455 13619 +/- 117 - 15 220210 +/- 470 13365 +/- 116 - 16 233057 +/- 483 12847 +/- 113 - 17 246024 +/- 496 12967 +/- 114 - 18 258717 +/- 509 12693 +/- 113 - 19 271443 +/- 521 12726 +/- 113 - 20 284106 +/- 533 12663 +/- 113 - 21 296846 +/- 545 12740 +/- 113 - 22 309240 +/- 556 12394 +/- 111 - 23 321382 +/- 567 12142 +/- 110 - 24 333521 +/- 578 12139 +/- 110 - 25 345488 +/- 588 11967 +/- 109 - 26 357358 +/- 598 11870 +/- 109 - 27 369194 +/- 608 11836 +/- 109 - 28 380867 +/- 617 11673 +/- 108 - 29 392406 +/- 627 11539 +/- 107 - 30 403919 +/- 636 11513 +/- 107 - 31 415362 +/- 645 11443 +/- 107 - 32 426753 +/- 654 11391 +/- 107 - 33 438016 +/- 662 11263 +/- 106 - 34 449144 +/- 671 11128 +/- 106 - 35 460170 +/- 679 11026 +/- 105 - 36 471161 +/- 687 10991 +/- 105 - 37 481959 +/- 695 10798 +/- 104 - 38 492740 +/- 702 10781 +/- 104 - 39 503494 +/- 710 10754 +/- 104 - 40 513949 +/- 717 10455 +/- 102 - 41 524654 +/- 725 10705 +/- 104 - 42 535111 +/- 732 10457 +/- 102 - 43 545469 +/- 739 10358 +/- 102 - 44 556047 +/- 746 10578 +/- 103 - 45 566590 +/- 753 10543 +/- 103 - 46 576850 +/- 760 10260 +/- 101 - 47 587113 +/- 767 10263 +/- 101 - 48 597322 +/- 773 10209 +/- 101 - 49 607258 +/- 780 9936 +/- 100 - 50 617201 +/- 786 9943 +/- 100 - 51 626983 +/- 792 9782 +/- 99 - 52 636819 +/- 798 9836 +/- 99 - 53 646695 +/- 805 9876 +/- 99 - 54 655509 +/- 810 8814 +/- 94 - 55 665363 +/- 816 9854 +/- 99 - 56 674934 +/- 822 9571 +/- 98 - 57 684515 +/- 828 9581 +/- 98 - 58 693948 +/- 834 9433 +/- 97 - 59 703516 +/- 839 9568 +/- 98 - 60 712982 +/- 845 9466 +/- 97 - 61 722344 +/- 850 9362 +/- 97 - 62 731611 +/- 856 9267 +/- 96 - 63 740851 +/- 861 9240 +/- 96 - 64 750276 +/- 867 9425 +/- 97 - 65 759405 +/- 872 9129 +/- 96 - 66 768537 +/- 877 9132 +/- 96 - 67 777573 +/- 882 9036 +/- 95 - 68 786739 +/- 888 9166 +/- 96 - 69 795598 +/- 893 8859 +/- 94 - 70 804571 +/- 898 8973 +/- 95 - 71 813485 +/- 903 8914 +/- 94 - 72 822406 +/- 907 8921 +/- 95 - 73 831225 +/- 912 8819 +/- 94 - 74 840160 +/- 917 8935 +/- 95 - 75 848871 +/- 922 8711 +/- 93 - 76 857733 +/- 927 8862 +/- 94 - 77 866580 +/- 932 8847 +/- 94 - 78 875191 +/- 936 8611 +/- 93 - 79 883976 +/- 941 8785 +/- 94 - 80 892559 +/- 945 8583 +/- 93 - 81 900899 +/- 950 8340 +/- 91 - 82 909380 +/- 954 8481 +/- 92 - 83 917905 +/- 959 8525 +/- 92 - 84 926191 +/- 963 8286 +/- 91 - 85 934738 +/- 967 8547 +/- 93 - 86 943030 +/- 972 8292 +/- 91 - 87 951445 +/- 976 8415 +/- 92 - 88 959676 +/- 980 8231 +/- 91 - 89 967730 +/- 984 8054 +/- 90 - 90 976219 +/- 989 8489 +/- 92 - 91 984294 +/- 993 8075 +/- 90 - 92 992370 +/- 997 8076 +/- 90 - 93 1000418 +/- 1001 8048 +/- 90 - 94 1008331 +/- 1005 7913 +/- 89 - 95 1016283 +/- 1009 7952 +/- 89 - 96 1024276 +/- 1013 7993 +/- 89 - 97 1032190 +/- 1017 7914 +/- 89 - 98 1040099 +/- 1021 7909 +/- 89 - 99 1047962 +/- 1024 7863 +/- 89 - 100 1055928 +/- 1028 7966 +/- 89 - - - - Terminal Count = 1055928 +/- 1028 - - - ----------------------------------------------------------------------------------------- -Measurement : DARK 15s | Stim 0 | On/Off(us) 15,15 | Cycle(ms),No 1000, 15 ----------------------------------------------------------------------------------------- - -Time (s) Total Count Counts per Cycle --------- --------------------- --------------------- - - 1 4 +/- 4 4 +/- 4 - 2 14 +/- 7 10 +/- 5 - 3 9 +/- 7 -5 +/- 4 - 4 8 +/- 8 -1 +/- 4 - 5 0 +/- 9 -8 +/- 5 - 6 -6 +/- 10 -6 +/- 5 - 7 7 +/- 11 13 +/- 5 - 8 12 +/- 11 5 +/- 4 - 9 -12 +/- 12 -24 +/- 6 - 10 -1 +/- 12 11 +/- 5 - 11 8 +/- 13 9 +/- 5 - 12 15 +/- 14 7 +/- 5 - 13 7 +/- 14 -8 +/- 5 - 14 -5 +/- 15 -12 +/- 5 - 15 -12 +/- 15 -7 +/- 5 - - - - Terminal Count = -12 +/- 15 - - - ----------------------------------------------------------------------------------------- -Measurement : S2 15 0 100s | Stim 2 | On/Off(us) 15, 0 | Cycle(ms),No 1000, 100 ----------------------------------------------------------------------------------------- - -Time (s) Total Count Counts per Cycle --------- --------------------- --------------------- - - 1 88023 +/- 297 88023 +/- 297 - 2 173608 +/- 417 85585 +/- 293 - 3 257002 +/- 507 83394 +/- 289 - 4 337842 +/- 581 80840 +/- 284 - 5 416668 +/- 646 78826 +/- 281 - 6 493191 +/- 702 76523 +/- 277 - 7 567633 +/- 753 74442 +/- 273 - 8 640003 +/- 800 72370 +/- 269 - 9 710432 +/- 843 70429 +/- 265 - 10 779934 +/- 883 69502 +/- 264 - 11 847323 +/- 921 67389 +/- 260 - 12 912894 +/- 956 65571 +/- 256 - 13 977444 +/- 989 64550 +/- 254 - 14 1040046 +/- 1020 62602 +/- 250 - 15 1101576 +/- 1050 61530 +/- 248 - 16 1161549 +/- 1078 59973 +/- 245 - 17 1220325 +/- 1105 58776 +/- 242 - 18 1277027 +/- 1130 56702 +/- 238 - 19 1333490 +/- 1155 56463 +/- 238 - 20 1389034 +/- 1179 55544 +/- 236 - 21 1443594 +/- 1202 54560 +/- 234 - 22 1497249 +/- 1224 53655 +/- 232 - 23 1548759 +/- 1245 51510 +/- 227 - 24 1600292 +/- 1265 51533 +/- 227 - 25 1650904 +/- 1285 50612 +/- 225 - 26 1700538 +/- 1304 49634 +/- 223 - 27 1749403 +/- 1323 48865 +/- 221 - 28 1796880 +/- 1341 47477 +/- 218 - 29 1844491 +/- 1358 47611 +/- 218 - 30 1890984 +/- 1375 46493 +/- 216 - 31 1937212 +/- 1392 46228 +/- 215 - 32 1982618 +/- 1408 45406 +/- 213 - 33 2027030 +/- 1424 44412 +/- 211 - 34 2071016 +/- 1439 43986 +/- 210 - 35 2113676 +/- 1454 42660 +/- 207 - 36 2156344 +/- 1469 42668 +/- 207 - 37 2198478 +/- 1483 42134 +/- 205 - 38 2240192 +/- 1497 41714 +/- 204 - 39 2281314 +/- 1511 41122 +/- 203 - 40 2321794 +/- 1524 40480 +/- 201 - 41 2361658 +/- 1537 39864 +/- 200 - 42 2401167 +/- 1550 39509 +/- 199 - 43 2439834 +/- 1562 38667 +/- 197 - 44 2474234 +/- 1573 34400 +/- 186 - 45 2511724 +/- 1585 37490 +/- 194 - 46 2549656 +/- 1597 37932 +/- 195 - 47 2586736 +/- 1609 37080 +/- 193 - 48 2623506 +/- 1620 36770 +/- 192 - 49 2659445 +/- 1631 35939 +/- 190 - 50 2695350 +/- 1642 35905 +/- 190 - 51 2730486 +/- 1653 35136 +/- 187 - 52 2765285 +/- 1663 34799 +/- 187 - 53 2799384 +/- 1673 34099 +/- 185 - 54 2833349 +/- 1683 33965 +/- 184 - 55 2866981 +/- 1693 33632 +/- 183 - 56 2900327 +/- 1703 33346 +/- 183 - 57 2933060 +/- 1713 32733 +/- 181 - 58 2965878 +/- 1722 32818 +/- 181 - 59 2997817 +/- 1732 31939 +/- 179 - 60 3029628 +/- 1741 31811 +/- 178 - 61 3061474 +/- 1750 31846 +/- 178 - 62 3092488 +/- 1759 31014 +/- 176 - 63 3123846 +/- 1768 31358 +/- 177 - 64 3154486 +/- 1776 30640 +/- 175 - 65 3184857 +/- 1785 30371 +/- 174 - 66 3215039 +/- 1793 30182 +/- 174 - 67 3244570 +/- 1802 29531 +/- 172 - 68 3274321 +/- 1810 29751 +/- 173 - 69 3303533 +/- 1818 29212 +/- 171 - 70 3332132 +/- 1826 28599 +/- 169 - 71 3360314 +/- 1833 28182 +/- 168 - 72 3388958 +/- 1841 28644 +/- 169 - 73 3417112 +/- 1849 28154 +/- 168 - 74 3444699 +/- 1856 27587 +/- 166 - 75 3472236 +/- 1864 27537 +/- 166 - 76 3499511 +/- 1871 27275 +/- 165 - 77 3526575 +/- 1878 27064 +/- 165 - 78 3553717 +/- 1885 27142 +/- 165 - 79 3580372 +/- 1893 26655 +/- 163 - 80 3606875 +/- 1899 26503 +/- 163 - 81 3633171 +/- 1906 26296 +/- 162 - 82 3658384 +/- 1913 25213 +/- 159 - 83 3684158 +/- 1920 25774 +/- 161 - 84 3708882 +/- 1926 24724 +/- 157 - 85 3734219 +/- 1933 25337 +/- 159 - 86 3759580 +/- 1939 25361 +/- 159 - 87 3784542 +/- 1946 24962 +/- 158 - 88 3808953 +/- 1952 24411 +/- 156 - 89 3833380 +/- 1958 24427 +/- 156 - 90 3857979 +/- 1965 24599 +/- 157 - 91 3882107 +/- 1971 24128 +/- 155 - 92 3906050 +/- 1977 23943 +/- 155 - 93 3927964 +/- 1982 21914 +/- 148 - 94 3951776 +/- 1988 23812 +/- 154 - 95 3975292 +/- 1994 23516 +/- 153 - 96 3998638 +/- 2000 23346 +/- 153 - 97 4021603 +/- 2006 22965 +/- 152 - 98 4044558 +/- 2011 22955 +/- 152 - 99 4067386 +/- 2017 22828 +/- 151 - 100 4089938 +/- 2023 22552 +/- 150 - - - - Terminal Count = 4089938 +/- 2023 - - - ----------------------------------------------------------------------------------------- -Measurement : DARK 15s | Stim 0 | On/Off(us) 15,15 | Cycle(ms),No 1000, 15 ----------------------------------------------------------------------------------------- - -Time (s) Total Count Counts per Cycle --------- --------------------- --------------------- - - 1 -22 +/- 6 -22 +/- 6 - 2 -23 +/- 7 -1 +/- 4 - 3 2 +/- 7 25 +/- 6 - 4 2 +/- 8 0 +/- 4 - 5 14 +/- 9 12 +/- 5 - 6 18 +/- 10 4 +/- 4 - 7 30 +/- 12 12 +/- 5 - 8 17 +/- 12 -13 +/- 5 - 9 43 +/- 13 26 +/- 6 - 10 27 +/- 13 -16 +/- 6 - 11 1 +/- 13 -26 +/- 6 - 12 -11 +/- 14 -12 +/- 5 - 13 17 +/- 15 28 +/- 7 - 14 9 +/- 15 -8 +/- 5 - 15 -1 +/- 15 -10 +/- 5 - - - - Terminal Count = -1 +/- 15 - - - diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/HeliosOSL_Example.osl b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/HeliosOSL_Example.osl deleted file mode 100644 index 16554374a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/HeliosOSL_Example.osl +++ /dev/null @@ -1,110 +0,0 @@ -"Index", "t[s]", "J", "Jcorr", "Jphd", "dt[s]", "T[K]", "ILed[A]" -00000000, 0000.100, 01189809, 01192363, 16000.000, 000.100, 000.0, 0.048 -00000001, 0000.200, 01471786, 01475695, 16300.000, 000.100, 000.0, 0.051 -00000002, 0000.300, 01488945, 01492946, 16300.000, 000.100, 000.0, 0.063 -00000003, 0000.400, 01497596, 01501644, 16200.000, 000.100, 000.0, 0.060 -00000004, 0000.500, 01503611, 01507692, 16200.000, 000.100, 000.0, 0.042 -00000005, 0000.600, 01508142, 01512247, 16200.000, 000.100, 000.0, 0.063 -00000006, 0000.700, 01510667, 01514786, 16200.000, 000.100, 000.0, 0.018 -00000007, 0000.800, 01511510, 01515634, 16200.000, 000.100, 000.0, 0.072 -00000008, 0000.900, 01510997, 01515118, 16200.000, 000.100, 000.0, 0.045 -00000009, 0001.000, 01510583, 01514702, 16200.000, 000.100, 000.0, 0.048 -00000010, 0001.100, 01509716, 01513830, 16200.000, 000.100, 000.0, 0.054 -00000011, 0001.200, 01507963, 01512067, 16200.000, 000.100, 000.0, 0.048 -00000012, 0001.300, 01505014, 01509102, 16200.000, 000.100, 000.0, 0.048 -00000013, 0001.400, 01503109, 01507187, 16200.000, 000.100, 000.0, 0.048 -00000014, 0001.500, 01500568, 01504632, 16200.000, 000.100, 000.0, 0.045 -00000015, 0001.600, 01498341, 01502393, 16200.000, 000.100, 000.0, 0.042 -00000016, 0001.700, 01495834, 01499872, 16200.000, 000.100, 000.0, 0.051 -00000017, 0001.800, 01492595, 01496616, 16200.000, 000.100, 000.0, 0.042 -00000018, 0001.900, 01489543, 01493547, 16200.000, 000.100, 000.0, 0.051 -00000019, 0002.000, 01485754, 01489738, 16200.000, 000.100, 000.0, 0.027 -00000020, 0002.100, 01483114, 01487084, 16200.000, 000.100, 000.0, 0.051 -00000021, 0002.200, 01478922, 01482869, 16200.000, 000.100, 000.0, 0.033 -00000022, 0002.300, 01476509, 01480444, 16200.000, 000.100, 000.0, 0.051 -00000023, 0002.400, 01473851, 01477771, 16200.000, 000.100, 000.0, 0.051 -00000024, 0002.500, 01470244, 01474145, 16200.000, 000.100, 000.0, 0.051 -00000025, 0002.600, 01467267, 01471152, 16200.000, 000.100, 000.0, 0.048 -00000026, 0002.700, 01464453, 01468324, 16200.000, 000.100, 000.0, 0.048 -00000027, 0002.800, 01460361, 01464210, 16200.000, 000.100, 000.0, 0.042 -00000028, 0002.900, 01457955, 01461791, 16200.000, 000.100, 000.0, 0.042 -00000029, 0003.000, 01454319, 01458136, 16200.000, 000.100, 000.0, 0.048 -00000030, 0003.100, 01451173, 01454974, 16200.000, 000.100, 000.0, 0.042 -00000031, 0003.200, 01448019, 01451803, 16200.000, 000.100, 000.0, 0.045 -00000032, 0003.300, 01445265, 01449035, 16200.000, 000.100, 000.0, 0.066 -00000033, 0003.400, 01441307, 01445056, 16200.000, 000.100, 000.0, 0.048 -00000034, 0003.500, 01437953, 01441685, 16200.000, 000.100, 000.0, 0.060 -00000035, 0003.600, 01434582, 01438296, 16200.000, 000.100, 000.0, 0.042 -00000036, 0003.700, 01432149, 01435850, 16200.000, 000.100, 000.0, 0.075 -00000037, 0003.800, 01428824, 01432508, 16200.000, 000.100, 000.0, 0.042 -00000038, 0003.900, 01424830, 01428494, 16200.000, 000.100, 000.0, 0.078 -00000039, 0004.000, 01422442, 01426093, 16200.000, 000.100, 000.0, 0.051 -00000040, 0004.100, 01419328, 01422963, 16200.000, 000.100, 000.0, 0.051 -00000041, 0004.200, 01415667, 01419284, 16200.000, 000.100, 000.0, 0.045 -00000042, 0004.300, 01412155, 01415754, 16200.000, 000.100, 000.0, 0.048 -00000043, 0004.400, 01409349, 01412933, 16200.000, 000.100, 000.0, 0.048 -00000044, 0004.500, 01406672, 01410243, 16200.000, 000.100, 000.0, 0.045 -00000045, 0004.600, 01402982, 01406534, 16200.000, 000.100, 000.0, 0.051 -00000046, 0004.700, 01400873, 01404414, 16200.000, 000.100, 000.0, 0.045 -00000047, 0004.800, 01397592, 01401117, 16200.000, 000.100, 000.0, 0.045 -00000048, 0004.900, 01393671, 01397176, 16200.000, 000.100, 000.0, 0.021 -00000049, 0005.000, 01391049, 01394541, 16200.000, 000.100, 000.0, 0.045 -00000050, 0005.100, 01387535, 01391009, 16200.000, 000.100, 000.0, 0.051 -00000051, 0005.200, 01384815, 01388276, 16200.000, 000.100, 000.0, 0.051 -00000052, 0005.300, 01382063, 01385510, 16200.000, 000.100, 000.0, 0.048 -00000053, 0005.400, 01378735, 01382165, 16200.000, 000.100, 000.0, 0.048 -00000054, 0005.500, 01376451, 01379870, 16200.000, 000.100, 000.0, 0.051 -00000055, 0005.600, 01372784, 01376185, 16200.000, 000.100, 000.0, 0.048 -00000056, 0005.700, 01369611, 01372996, 16200.000, 000.100, 000.0, 0.045 -00000057, 0005.800, 01367252, 01370625, 16200.000, 000.100, 000.0, 0.063 -00000058, 0005.900, 01363412, 01366766, 16200.000, 000.100, 000.0, 0.048 -00000059, 0006.000, 01361132, 01364475, 16200.000, 000.100, 000.0, 0.045 -00000060, 0006.100, 01357825, 01361152, 16200.000, 000.100, 000.0, 0.048 -00000061, 0006.200, 01355032, 01358345, 16200.000, 000.100, 000.0, 0.021 -00000062, 0006.300, 01351831, 01355128, 16200.000, 000.100, 000.0, 0.048 -00000063, 0006.400, 01349801, 01353089, 16200.000, 000.100, 000.0, 0.027 -00000064, 0006.500, 01346675, 01349947, 16200.000, 000.100, 000.0, 0.045 -00000065, 0006.600, 01343113, 01346368, 16200.000, 000.100, 000.0, 0.054 -00000066, 0006.700, 01341182, 01344428, 16200.000, 000.100, 000.0, 0.051 -00000067, 0006.800, 01337106, 01340332, 16200.000, 000.100, 000.0, 0.051 -00000068, 0006.900, 01335046, 01338262, 16200.000, 000.100, 000.0, 0.048 -00000069, 0007.000, 01331658, 01334858, 16200.000, 000.100, 000.0, 0.042 -00000070, 0007.100, 01329712, 01332902, 16200.000, 000.100, 000.0, 0.045 -00000071, 0007.200, 01327289, 01330468, 16200.000, 000.100, 000.0, 0.048 -00000072, 0007.300, 01324082, 01327245, 16200.000, 000.100, 000.0, 0.048 -00000073, 0007.400, 01321572, 01324723, 16200.000, 000.100, 000.0, 0.048 -00000074, 0007.500, 01318351, 01321487, 16200.000, 000.100, 000.0, 0.063 -00000075, 0007.600, 01315995, 01319120, 16200.000, 000.100, 000.0, 0.048 -00000076, 0007.700, 01313127, 01316238, 16200.000, 000.100, 000.0, 0.057 -00000077, 0007.800, 01310549, 01313648, 16200.000, 000.100, 000.0, 0.051 -00000078, 0007.900, 01307554, 01310639, 16200.000, 000.100, 000.0, 0.078 -00000079, 0008.000, 01304852, 01307924, 16200.000, 000.100, 000.0, 0.051 -00000080, 0008.100, 01302725, 01305787, 16200.000, 000.100, 000.0, 0.078 -00000081, 0008.200, 01300078, 01303128, 16200.000, 000.100, 000.0, 0.051 -00000082, 0008.300, 01296192, 01299223, 16200.000, 000.100, 000.0, 0.048 -00000083, 0008.400, 01294321, 01297344, 16200.000, 000.100, 000.0, 0.051 -00000084, 0008.500, 01291768, 01294779, 16200.000, 000.100, 000.0, 0.054 -00000085, 0008.600, 01289057, 01292055, 16200.000, 000.100, 000.0, 0.045 -00000086, 0008.700, 01285486, 01288467, 16200.000, 000.100, 000.0, 0.048 -00000087, 0008.800, 01283607, 01286580, 16200.000, 000.100, 000.0, 0.060 -00000088, 0008.900, 01281143, 01284104, 16200.000, 000.100, 000.0, 0.045 -00000089, 0009.000, 01278574, 01281523, 16200.000, 000.100, 000.0, 0.060 -00000090, 0009.100, 01275227, 01278161, 16200.000, 000.100, 000.0, 0.024 -00000091, 0009.200, 01272986, 01275910, 16200.000, 000.100, 000.0, 0.075 -00000092, 0009.300, 01270813, 01273727, 16200.000, 000.100, 000.0, 0.045 -00000093, 0009.400, 01267965, 01270866, 16200.000, 000.100, 000.0, 0.078 -00000094, 0009.500, 01264870, 01267756, 16200.000, 000.100, 000.0, 0.054 -00000095, 0009.600, 01262368, 01265243, 16200.000, 000.100, 000.0, 0.045 -00000096, 0009.700, 01259830, 01262693, 16200.000, 000.100, 000.0, 0.048 -00000097, 0009.800, 01257246, 01260098, 16200.000, 000.100, 000.0, 0.048 -00000098, 0009.900, 01255112, 01257954, 16200.000, 000.100, 000.0, 0.045 -"LED DC amplitude: 0.05 [A]" -"LED AC amplitude: 0 [A]" -"LED AC period: 0 [s]" -"LED AC initial phase: 0 [deg]" -"Mode: CW Spectrum separation" -"Samples: 1000" -"Sampling period: 0.1 [s]" -"SW version: 11.05.2018 18:04:26" -"Helios version: 2.1 [07.05.2018 20:45:19]" -"Al2O3:C" diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/QNL84_2_bleached.txt b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/QNL84_2_bleached.txt deleted file mode 100644 index 62dfe5480..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/QNL84_2_bleached.txt +++ /dev/null @@ -1,19 +0,0 @@ -# -------------------------------------------------------------------------------------- -# CURVE FITTING TEST DATASET -# Berger, G.W., Huntley, D.J., 1989. Test data for exponential fits. Ancient TL 7, 43-46. -# -# SAMPLE: QNL84 - 2 (bleached) -# -------------------------------------------------------------------------------------- -0 20766 -0 21393 -0 22493 -120 31290 -120 33779 -240 43221 -240 43450 -240 41427 -480 51804 -480 59555 -480 54013 -960 75748 -960 76613 \ No newline at end of file diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/QNL84_2_unbleached.txt b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/QNL84_2_unbleached.txt deleted file mode 100644 index 13669c13e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/QNL84_2_unbleached.txt +++ /dev/null @@ -1,22 +0,0 @@ -# -------------------------------------------------------------------------------------- -# CURVE FITTING TEST DATASET -# Berger, G.W., Huntley, D.J., 1989. Test data for exponential fits. Ancient TL 7, 43-46. -# -# SAMPLE: QNL84 - 2 (Unbleached) -# -------------------------------------------------------------------------------------- -0 38671 -0 40646 -0 38149 -0 35836 -120 65931 -120 67887 -120 66133 -240 82496 -240 86708 -240 86580 -480 110978 -480 113807 -480 114192 -480 109652 -960 130373 -960 137789 \ No newline at end of file diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/RF_file.rf b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/RF_file.rf deleted file mode 100644 index 95fa8320e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/RF_file.rf +++ /dev/null @@ -1,591 +0,0 @@ - - -ROI: ROI 1 ROI 2 ROI 3 ROI 4 ROI 5 ROI 6 ROI 7 ROI 8 ROI 9 ROI 10 ROI 11 -x: 19 117 135 54 49 78 209 108 246 232 28 -y: 19 73 82 168 175 167 110 54 175 172 169 -width: 351 20 20 20 20 20 20 20 20 20 20 -height: 351 20 20 20 20 20 20 20 20 20 20 -area: 96765 316 316 316 316 316 316 316 316 316 316 - - - -No. time (sec) aliquot grain 1 grain 2 grain 3 grain 4 grain 5 grain 6 grain 7 grain 8 grain 9 grain 10 -1 12.5 613.6036 650.769 643.1361 646.7025 644.8513 629.8418 626.5759 627.2722 618.2816 619.0475 623.5696 -2 37.5 615.3152 651.269 644.5728 649.4241 646.5759 631.7563 629.0032 628.8703 619.8639 621.1551 626.2848 -3 62.5 615.2543 651.9747 645.1139 649.3703 646.712 630.5253 628.0095 628.962 619.7184 620.6994 625.5443 -4 87.5 616.8258 652.0823 646.2278 650.3987 648.3861 632.5475 630.3165 630.2563 621.5348 622.0475 627.1835 -5 112.5 617.073 652.5411 646.9177 649.6266 648.0475 632.4747 630.0222 629.9272 621.981 623 627.5633 -6 137.5 618.0075 653.7753 647.9937 651.3354 648.9494 634.1614 631.9715 631.5696 622.4968 622.9684 627.5158 -7 162.5 617.5387 653.9209 646.3797 651.0443 649.0348 633.4367 630.481 630.4747 622.519 623.2975 627.7089 -8 187.5 618.7645 654.5538 648.3861 652.8513 650.4019 633.9399 632.2816 631.6487 624.1519 625.0823 629.0158 -9 212.5 618.8933 654.8228 647.731 653.0506 650.2975 634.5823 632.0348 632.693 623.8101 624.962 628.8386 -10 237.5 618.4924 654.6329 648.269 651.8291 649.788 634.8228 631.8291 631.7152 623.212 624.0759 628.3987 -11 262.5 618.6822 654.4241 647.7278 651.3513 649.9146 634.2405 632.8829 632.0506 623.2184 624.3513 628.8829 -12 287.5 619.1796 654.0253 648.481 653.1424 651.1551 634.3259 632.212 632.3101 625.1867 625.4019 630.5665 -13 312.5 618.8217 653.9462 647.8544 652.3924 650.0886 633.5854 632.1867 633.1139 623.538 624.4589 628.6772 -14 337.5 618.9307 654.1108 649.0443 652.3133 650.019 634.3987 632.2215 631.9747 623.9778 624.5285 628.443 -15 362.5 619.3048 654.7722 648.2816 653.1171 650.7658 634.3861 631.8892 632.3956 624.212 624.6424 629.6266 -16 387.5 619.0163 654.6171 648.943 651.8513 649.5728 634.6392 632.3323 632.8386 624.6551 625.5095 628.1329 -17 412.5 618.9434 654.5285 649.2057 651.7753 649.8165 634.5538 632.0728 632.5063 624.3608 624.1013 629.7627 -18 437.5 618.737 654.5949 648.0696 651.4525 648.8608 634.0443 632.4873 631.6804 623.231 624.4873 628.7627 -19 462.5 618.7779 654.2563 648.1171 651.5127 649.6899 633.6835 631.6203 632.5886 623.9272 624.5222 628.5285 -20 487.5 619.3553 654.6582 648.6772 652.0949 650.1076 635.0918 632.6487 632.3259 624.2848 624.9525 629.0949 -21 512.5 619.4536 654.6234 648.6994 653.0854 650.5253 635.1614 632.4209 633.2658 624.1266 625.2911 629.0032 -22 537.5 618.7475 653.8101 647.7658 651.9209 649.943 634.1456 631.7975 631.6677 624.3101 624.5696 628.1677 -23 562.5 618.4579 654.2532 647.5728 651.0823 649.0601 634.2405 631.4589 632.3544 623.5918 625.1424 628.4968 -24 587.5 618.923 653.9114 647.8608 651.6835 650.2215 634.4019 631.9968 631.8196 624.4272 624.1582 628.6266 -25 612.5 618.8005 653.6139 648.0443 651.3892 649.3323 634.6108 632.3133 632.3418 623.8703 624.7437 628.6994 -26 637.5 619.1491 653.5411 647.693 652.3608 649.557 634.6994 632.3513 632.5222 624.1962 624.2722 628.731 -27 662.5 618.89 654.4905 648.2563 652.2184 650.3354 634.3766 632.3892 631.3797 624.0633 624.943 628.5854 -28 687.5 618.9607 654.693 647.8734 652.4873 649.6361 634.0475 632.4114 631.8639 624.4557 625.1899 629.2753 -29 712.5 618.8 654.7658 647.0728 651.0665 648.5222 634.2658 632.0032 632.4747 623.8165 624.2057 629.0886 -30 737.5 619.0514 653.5032 647.5411 651.807 650.0918 634.0222 631.6804 632.4082 623.6203 624.7247 628.9019 -31 762.5 619.311 654.7943 647.5601 652.1709 650.1804 634.6329 632.0285 632.8449 624.5348 624.9747 629.0601 -32 787.5 618.7398 653.4525 647.3924 650.8101 649.0316 634.2373 631.5032 631.1013 623.8354 625.3513 627.7627 -33 812.5 619.0412 654.1234 648.4557 652.557 650.0063 634.1456 631.7057 632.5728 624.2373 624.5601 628.4905 -34 837.5 619.0312 653.9335 647.8133 650.7627 649.4747 634.4272 631.3671 632.0601 624.0696 624.3513 629.1899 -35 862.5 618.9551 654.1899 647.6456 651.0886 648.7975 633.9304 631.9177 632.5918 623.6013 624.3671 628.7057 -36 887.5 618.4504 653.8513 647.269 651.5063 648.481 634.9241 631.2658 632.0095 623.9684 624 627.6013 -37 912.5 619.1043 654.5886 648.0063 651.3259 649.2025 634.0127 632.3323 632.0633 624.0411 625.0443 629.8924 -38 937.5 619.1799 653.9241 648.1044 651.1867 649 634.6361 631.5949 631.0348 624.6677 624.557 628.7595 -39 962.5 619.041 653.2753 647.9873 651.788 649.1899 634.1456 631.557 632.2658 624.2658 624.4778 628.7753 -40 987.5 619.302 654.4525 648.0032 651.731 649.1899 634.5095 632.3956 632.6614 624.9114 625.6108 628.9873 -41 1012.5 618.2681 652.7184 646.9778 650.7278 648.5095 633.3513 631.1361 631.2278 622.4652 623.5696 627.6646 -42 1037.5 618.4242 652.693 646.9525 650.1614 648.3766 632.9747 631.6139 631.2943 622.9968 624.4367 627.9304 -43 1062.5 619.0967 653.4399 646.8133 650.3449 648.2184 635.1392 632.1456 631.8797 624.1899 624.6108 629.0443 -44 1087.5 618.6087 653.2532 646.7342 651.5949 649.1487 633.9177 631.3956 631.7468 623.981 624.9146 628.7943 -45 1112.5 619.049 653.8165 648.0981 650.8797 648.8924 634.8323 631.6677 631.8418 624.3386 624.8544 628.9462 -46 1137.5 619.0551 653.1424 647.1171 650.5665 648.3038 634.1772 631.25 632.0285 624.5506 624.731 629.1297 -47 1162.5 618.4463 653.3639 646.2943 649.9747 648.2785 633.7468 631.5665 631.6424 623.7405 623.9241 628.3703 -48 1187.5 618.7559 654 647.1424 650.6044 647.8956 633.9146 630.8892 632.2753 624.1741 624.1867 628.212 -49 1212.5 618.488 652.8101 647.1171 650.3703 648.8386 633.9272 631.3101 631.9462 622.9114 623.807 628.0759 -50 1237.5 618.7313 652.7627 647.2247 651.0475 648.462 633.9019 632.8354 631.6582 623.8259 624.731 628.1551 -51 1262.5 618.7288 652.981 647.8165 650.3703 648.6203 633.8259 631.6741 631.6392 624.0348 624.712 628.1392 -52 1287.5 618.7365 652.7753 647.019 650.9272 648.0759 633.7658 632.0886 631.7532 623.7184 624.269 629.0981 -53 1312.5 618.9991 653.269 647.519 650.3418 648.0475 634.5348 631.5601 631.8892 624.3323 624.8639 628.8766 -54 1337.5 618.4219 652.8291 647.0506 649.7437 648.1203 633.25 630.9747 631.3829 623.7753 624.4051 627.7468 -55 1362.5 618.9692 653.0886 646.9177 650.9241 649.5316 635.4051 632.2753 631.5253 624.9114 624.6677 628.8608 -56 1387.5 619.48 653.5918 647.8481 651.5949 649.2184 634.7816 631.5158 631.8892 624.1867 625.1044 628.5633 -57 1412.5 618.6523 653.1772 647.0316 650.288 648.3703 634.193 631.4494 631.6487 623.7785 624.4462 628.6171 -58 1437.5 618.9045 654.0411 646.9968 650.193 648.057 633.3165 631.6709 631.7342 624.519 623.9399 628.8006 -59 1462.5 618.7706 652.6234 647.0759 650.3513 648.3449 633.5443 631.7342 631.1013 623.7342 624.5728 628.4589 -60 1487.5 618.4059 652.1835 646.6582 649.807 647.7025 633.0095 631.1108 630.8323 623.6297 623.5728 627.6994 -61 1512.5 618.8161 653.0285 648.1076 650.1013 648.1804 634.1835 631.9747 631.3766 623.7532 625.5095 627.4335 -62 1537.5 618.4463 652.4715 646.8165 649.1804 647.2532 633.8513 631.1044 631.9715 623.1171 623.8101 627.2373 -63 1562.5 618.9866 653.0949 647.0633 650.0981 647.519 634.3228 631.8418 631.7563 623.1424 624.4842 628.1835 -64 1587.5 618.334 652.5475 646.3133 649.9462 647.7532 633.2278 630.8133 630.9684 623.2025 623.8797 627.2152 -65 1612.5 618.952 653.3354 647.8291 650.7911 648.7722 634.5475 631.7975 632.3924 624.1013 625.0475 629.0886 -66 1637.5 618.6641 651.6646 647.1772 649.1677 647.0538 633.25 631.0601 631.7057 623.8259 623.8639 627.7627 -67 1662.5 618.5372 652.2785 646.7342 650.1646 647.8956 633.5127 631.1203 630.981 623.5665 624.443 627.7722 -68 1687.5 618.8991 652.8639 646.7025 650.3639 648.2025 634.1772 631.0823 631.5665 624.1772 624.9241 628.0633 -69 1712.5 618.3047 651.5222 646.6772 648.7722 646.9937 633.2247 630.8766 631.0633 623.0601 624.481 627.0316 -70 1737.5 618.8147 653.2342 647.193 649.3861 647.6203 634.5127 631.1804 631.4652 623.7563 624.4652 628.8734 -71 1762.5 618.501 652.0728 646.9589 648.8513 647.1424 633.2278 631.0633 631.3165 623.5759 624.4177 628.1108 -72 1787.5 619.1409 654.0158 646.712 650.2753 648.0506 634.3133 631.9652 631.9652 623.5665 624.2658 628.2911 -73 1812.5 618.8329 652.3608 647.4304 649.5791 647.7753 634.2184 631.5316 631.0696 624.3608 625.0506 627.4399 -74 1837.5 618.4696 653.3544 646.0981 649.3259 647.4494 633.8639 630.7753 631.1203 622.8734 626.2722 627.8196 -75 1862.5 618.4497 652.5854 647.1709 648.3639 646.4051 633.5348 631.5918 631.0095 623.9399 624.2057 628.2627 -76 1887.5 618.8617 652.2278 646.0411 649.5506 647.8861 633.519 631.4367 631.1203 624.0759 624.2215 628.0095 -77 1912.5 618.2807 651.7278 646.557 649.1962 646.8924 632.481 631.9051 631.7753 622.8861 623.6361 627.3133 -78 1937.5 619.117 653.0918 647.0949 649.3418 647.8797 634.1203 631.3797 631.9525 624.8671 624.7532 628.25 -79 1962.5 618.8144 652.9747 646.5348 649.9873 647.5095 634.2468 631.6171 630.9272 624.1424 624.6709 627.7658 -80 1987.5 618.6177 652.7405 646.6614 649.6867 646.6329 633.5823 631.6108 631.231 623.9304 624.1709 628.6487 -81 2012.5 618.7662 652.481 646.3481 649.7278 647.4209 634.1171 631.2785 630.6962 623.6266 625.2247 627.5728 -82 2037.5 618.5925 652.3956 646.0063 649.6139 647.0475 633.6013 631.0949 631.3513 623.4557 624.7373 627.5601 -83 2062.5 619.0939 652.7785 646.5728 649.981 647.6044 633.8449 631.0063 632.2532 624.1392 624.5316 628.1994 -84 2087.5 619.1902 652.3797 647.1962 649.4367 647.1835 633.0696 631.3924 632.0285 624.3703 624.6614 628.3861 -85 2112.5 618.8515 652.519 646.0665 649.6203 647.7215 633.5285 631.3703 632.1108 624.2627 624 627.9905 -86 2137.5 618.7562 653.0158 646.75 649.7753 648.4051 633.8101 632.0222 630.6772 624.1361 623.8671 627.6266 -87 2162.5 618.5491 652.1013 646.0032 649.6646 647.9494 633.2658 631.25 631.2184 624.1424 624.0285 627.8291 -88 2187.5 618.7426 652.3671 646.4367 649.0443 647.4652 633.8165 630.6519 630.7247 623.8797 624.8259 628.0538 -89 2212.5 618.5531 652.0601 646.0158 647.9589 646.462 634.2025 631.1772 630.7152 623.3101 624.1171 628.0158 -90 2237.5 618.6534 652.3165 646.4146 649.1108 646.9525 632.8671 631.7816 631.712 623.1772 623.5538 628.0696 -91 2262.5 618.6187 652.4905 646.7057 648.4114 646.5728 633.5348 631.5443 631.3513 623.8449 625.1361 628.2658 -92 2287.5 618.4215 651.0918 645.9905 649.0633 646.9937 632.712 631.0127 631.4241 623.2785 623.9747 627.5032 -93 2312.5 618.7115 651.693 645.0127 648.7342 647.5 632.8481 631.3133 631.038 623.1171 624.1646 627.4494 -94 2337.5 619.0205 652.3892 646.4652 648.8924 646.6013 633.7532 632.9399 631.4778 624.769 624.4304 628.2532 -95 2362.5 618.5737 651.2405 646.6108 648.25 646.3924 633.3291 631.6203 631.7405 624.0032 623.8703 629.1203 -96 2387.5 617.6356 650.3861 645.2089 646.943 645.4715 632.9715 630.2595 629.5823 622.4747 623.3449 627.038 -97 2412.5 618.6216 651.9462 646.1677 648.962 646.9335 633.712 631.2722 631.1203 623.8766 624.519 627.8038 -98 2437.5 618.6898 651.8196 645.7278 648.4968 646.3861 633.7405 631.288 631.3354 624.2342 624.3386 628.0918 -99 2462.5 618.0993 650.731 644.7089 647.9177 646.5728 632.8513 629.9272 630.9462 622.6361 623.4241 627.7373 -100 2487.5 618.5218 651.4873 645.4304 649.0285 646.9082 632.9051 631.0316 630.4589 623.1392 624.0316 627.4652 -101 2512.5 619.0366 651.538 646.4019 648.9684 646.8449 633.8418 631.288 632.3481 624.1297 624.2563 628.5285 -102 2537.5 618.8007 651.6519 645.8481 648.5759 646.7595 633.3386 631.3228 630.8038 624.1835 624.2785 627.3133 -103 2562.5 618.554 652.0253 645.5886 648.7658 646.8228 632.1646 630.1741 630.8608 623.3924 623.6171 627.7342 -104 2587.5 618.0766 651.2278 645.057 647.3956 645.5601 632.6392 630.5759 630.3956 622.6867 623.6646 626.4462 -105 2612.5 618.5946 650.9937 645.8861 647.9873 646.3449 632.9873 631.9272 631.0222 623.693 623.5759 626.7816 -106 2637.5 617.9828 650.7563 645.7215 647.6424 645.75 632.5759 630.4652 629.8576 622.3386 623.2595 626.7468 -107 2662.5 619.0805 651.9304 645.9747 648.6392 646.9209 634.6234 631.3956 631.3987 624.019 624.8766 627.8418 -108 2687.5 618.3992 651.4399 646.1709 647.5854 646.4905 632.4937 630.3101 630.4747 622.962 623.1456 628.2532 -109 2712.5 618.4353 651.6171 646.6297 647.7405 646.0601 633.5886 630.5475 630.4019 623.0348 623.5316 627.4082 -110 2737.5 618.943 651.4462 645.5443 649.0253 646.9335 634.2437 631.2595 630.9177 623.981 624.8133 627.3892 -111 2762.5 618.6558 651.6203 646.0285 647.9335 646.4209 633.3924 631.2563 630.9968 622.9905 624.0127 627.6013 -112 2787.5 618.4095 651.962 645.6108 648.7816 646.519 633.3196 631.1994 630.481 623.4209 623.5538 627.4652 -113 2812.5 618.5409 651.3038 645.4082 648.0063 646.1203 633.1519 631.8259 630.2373 623.8386 624.3449 626.6835 -114 2837.5 618.4967 651.4146 645.3766 648.2816 645.9462 633.2943 630.1614 631.3259 623.3797 624.0759 627.4715 -115 2862.5 618.8603 651.3165 646.3766 648.3576 646.5918 633.25 631.8829 631.1297 624.2215 624.2278 627.8544 -116 2887.5 619.1797 651.481 646.2405 648.4905 647.0411 634.2658 630.9557 631.7184 624.0095 624.2816 627.981 -117 2912.5 618.3571 651.3956 645.1234 647.1551 645.6456 633.3418 631.0854 630.6835 623.2658 623.5728 627.8924 -118 2937.5 618.0335 650.3924 645.481 647.3892 645.5 632.1741 630.3196 630.4114 623.2658 623.4241 627.1266 -119 2962.5 618.1177 650.0063 645.8006 647.8165 645.4873 632.4335 630.8291 630.788 623.0316 623.8861 627.2437 -120 2987.5 618.9252 650.75 645.769 648.7911 646.8544 633.462 631.0854 631.0063 623.6266 624.1519 627.6456 -121 3012.5 618.2519 651.3006 645.9462 647.8418 645.6392 632.3354 630.2057 630.2278 623.1076 623.8101 627.4304 -122 3037.5 618.8213 650.7342 645.8259 648.1551 646.7595 632.7437 630.6013 631.2785 623.9873 624.3101 628.019 -123 3062.5 618.7147 651.7627 645.8133 647.9684 645.9715 633.8924 631.231 630.6835 623.1361 624.1709 627.5728 -124 3087.5 618.7709 650.8671 646.1551 647.8987 645.9778 633.2025 631.0823 631.2373 623.6076 624.2215 628.1139 -125 3112.5 618.1167 650.9684 645.4209 647.4019 645.7152 632.7785 630.1962 630.2089 623.1013 624.269 626.9462 -126 3137.5 619.3078 650.8892 646.0063 648.2184 646.6835 633.5791 631.3386 631.4082 624.3576 625.7184 627.8513 -127 3162.5 618.7881 651.2532 646.2215 647.6044 646.0981 633.3608 631.0728 631.1741 624.212 624.3038 627.6709 -128 3187.5 618.6196 651.038 646.038 647.6551 646.3449 632.8797 630.9367 630.9842 623.3006 624.0854 627.0696 -129 3212.5 618.9873 650.8449 646.25 648.231 645.9525 633.9747 630.7278 631.4209 623.8576 624.1234 628.2215 -130 3237.5 618.4587 650.8386 645.557 647.6329 645.3861 632.9937 631.0601 631.4209 623.6709 623.3576 627.019 -131 3262.5 618.0786 649.6329 644.2437 646.9494 644.5601 631.712 630.1835 630.5918 622.6804 623.6013 626.8449 -132 3287.5 618.625 650.6044 644.8892 648.2184 645.5316 632.8481 630.5665 631.3133 623.3101 623.9019 627.019 -133 3312.5 618.6231 651.6424 645.8829 647.1234 645.5253 633.9019 630.7152 631.0538 623.3987 623.1551 627.6424 -134 3337.5 618.6622 650.5 645.1044 647.9177 645.3101 632.9304 630.6677 630.3259 623.7247 623.7943 627.4146 -135 3362.5 618.5464 650.6044 644.7089 646.8038 645.3924 632.6329 630.481 630.7278 624.0443 624.2785 626.9589 -136 3387.5 618.7836 650.3671 645.6835 647.2595 645.2563 633.4177 630.693 631.1835 623.3386 624.3418 626.9241 -137 3412.5 618.8434 651.3323 644.9684 647.3671 645.3449 633.3449 630.943 630.3418 623.5759 623.9525 628.3797 -138 3437.5 618.6767 650.7437 645.8133 646.9082 644.5981 633.2911 630.2785 631.0918 623.8639 624.1139 626.5791 -139 3462.5 618.2843 649.8323 644.7595 647.7943 645.6392 632.7405 629.9304 630.1329 622.5886 623.2247 626.7437 -140 3487.5 618.3255 651.6203 644.9146 647.5854 645.3481 632.6614 630.1424 630.0601 623.7057 623.8829 627.0348 -141 3512.5 618.8023 650.8291 644.9462 647.7184 645.6804 632.4146 630.9209 631.0063 623.8133 624.1456 627.5791 -142 3537.5 618.2801 650.3734 644.4146 647.8165 645.1361 632.9715 630.4462 630.1962 623.2563 624.462 626.481 -143 3562.5 618.6223 650.7215 644.8703 647.1392 645.5538 632.7816 630.5601 629.9873 623.5665 623.4209 626.8544 - - - -No. time (sec) aliquot grain 1 grain 2 grain 3 grain 4 grain 5 grain 6 grain 7 grain 8 grain 9 grain 10 -1 12.5 616.0312 658.6906 649.9153 658.2347 655.7046 633.8033 631.1412 632.9204 621.5427 622.2058 629.0102 -2 37.5 612.2725 655.4048 646.6503 655.4416 652.5029 629.4791 626.8322 628.7589 618.7269 618.154 625.8077 -3 62.5 613.7485 656.4286 647.5412 656.7557 653.8102 631.0449 628.7583 629.5886 619.1664 619.6345 626.887 -4 87.5 614.9674 658.2303 648.6834 657.0633 653.7187 632.5811 629.3318 631.163 620.3468 620.5988 628.0899 -5 112.5 615.9991 657.9084 648.8509 657.479 654.627 633.0045 632.493 631.985 622.7405 623.5552 629.6421 -6 137.5 616.2784 658.4475 649.7241 658.8042 656.2519 634.8908 631.4959 632.1283 621.2177 622.3616 629.4942 -7 162.5 616.1318 659.4131 649.8941 658.4598 656.1778 633.8129 631.2871 632.5899 620.932 622.107 628.9506 -8 187.5 616.8854 659.6138 650.2727 658.8553 656.225 634.6475 632.155 632.6959 622.0203 622.6792 629.8228 -9 212.5 617.3767 660.7341 651.209 659.1971 656.6876 634.6072 632.0881 633.5808 622.4895 623.2277 629.7101 -10 237.5 617.4728 659.6334 650.7071 658.6893 656.4377 635.3214 632.2872 632.9481 622.7366 623.164 630.1439 -11 262.5 618.0988 660.6009 651.5431 660.2137 658.0555 635.9507 632.8362 633.7608 623.0455 623.0344 630.3384 -12 287.5 618.1591 660.6857 651.6801 660.0739 657.2581 636.1234 633.2454 634.4526 623.7032 624.5858 630.8197 -13 312.5 618.4908 661.368 652.1233 660.3118 657.2619 636.2012 633.1976 634.0285 624.1963 624.7369 631.0497 -14 337.5 618.6913 661.0175 652.3968 661.1084 658.283 636.5828 633.3447 634.4143 623.9483 624.9399 631.358 -15 362.5 618.5761 660.6205 652.3064 660.9544 658.1209 636.4211 633.6617 634.9462 623.7633 624.4986 631.2697 -16 387.5 619.0878 661.6962 652.0899 660.2787 657.1431 636.2823 634.0592 635.3468 624.1583 625.4925 631.0609 -17 412.5 619.1123 661.0516 653.4275 661.4284 658.7825 636.6452 633.8941 635.0008 624.4952 625.1524 631.2235 -18 437.5 619.1219 661.83 652.6724 660.51 657.6139 637.0458 634.0824 635.157 625.0518 625.1468 631.8565 -19 462.5 619.1186 660.596 652.6746 660.2996 657.7479 636.0863 634.0373 635.409 625.2233 626.069 631.0531 -20 487.5 618.6514 660.9863 652.2574 659.3774 657.0476 635.8082 633.5955 634.8518 624.9103 624.4519 631.1783 -21 512.5 618.6185 661.108 652.826 660.109 657.1883 636.7313 633.7887 634.8854 623.9059 624.4369 631.8754 -22 537.5 619.0751 660.9557 653.2617 660.274 657.0657 636.7279 633.791 635.2694 624.6487 625.6795 630.7416 -23 562.5 618.8382 660.4928 651.8307 659.4779 656.3989 636.0958 633.3189 634.919 624.4194 624.9968 631.0872 -24 587.5 619.1382 660.9742 652.1005 660.8257 657.4648 636.3843 633.3951 635.4573 624.4644 624.8242 631.8506 -25 612.5 619.7459 661.0917 652.6333 660.569 658.3732 637.754 634.7651 635.4046 624.9538 626.0424 631.7531 -26 637.5 619.3593 661.2368 652.5708 660.5365 657.9042 636.8119 634.2966 634.7033 624.1106 625.0724 631.2318 -27 662.5 619.4168 661.4003 652.8548 660.5254 658.0511 636.8973 633.3523 635.1406 624.1972 625.0206 631.5518 -28 687.5 619.8258 660.9017 652.6172 660.6988 658.0219 637.6791 634.7789 635.3681 624.8823 626.8548 631.3864 -29 712.5 619.4522 661.8692 651.9301 660.1876 657.8309 637.6165 634.5131 635.77 624.4221 625.0042 631.6815 -30 737.5 619.6236 661.1969 653.3451 660.4172 657.922 636.145 634.2412 635.0599 625.5943 625.7517 632.543 -31 762.5 619.3767 660.958 652.1418 660.562 658.2986 636.2887 634.3318 635.3714 625.2461 624.884 631.8345 -32 787.5 619.1879 660.5759 652.2561 659.0396 656.5601 635.7813 634.2179 635.4272 624.7261 625.9287 632.3679 -33 812.5 619.5383 660.4396 652.2926 659.4839 657.0866 636.5578 633.9843 635.2885 624.8658 625.742 631.2716 -34 837.5 619.8293 661.4764 652.6684 660.3092 658.0901 636.7865 634.6386 635.0527 625.0525 626.3872 632.4097 -35 862.5 619.3868 661.2335 652.5278 659.1183 656.4801 637.0851 634.5441 634.3174 624.1022 624.6214 630.8086 -36 887.5 619.5994 660.5377 652.3172 660.0516 657.437 636.587 634.1476 635.7901 625.9885 626.2344 632.9402 -37 912.5 619.0942 659.3482 652.157 658.9576 655.6765 637.0414 633.3473 633.5141 624.4448 623.8679 630.0886 -38 937.5 619.4612 659.5308 652.6359 660.1829 656.9747 637.1701 634.1015 636.1454 625.1366 626.2227 631.9286 -39 962.5 619.23 660.2986 651.4306 659.4451 656.2312 636.3953 633.2892 634.6489 624.569 625.2839 631.4595 -40 987.5 619.5328 660.9764 651.7374 659.2391 656.6079 636.4839 633.713 635.7279 624.8239 626.4778 631.2861 -41 1012.5 619.5093 659.6945 651.6841 659.2604 655.8882 635.5746 633.858 635.6404 625.4522 625.3535 631.8243 -42 1037.5 618.6795 659.061 651.4754 658.0793 655.6121 636.4216 632.8933 633.8865 624.0987 624.48 630.4105 -43 1062.5 619.2866 659.7778 652.5493 659.2619 656.6086 637.068 633.6919 634.7811 624.4517 624.8592 631.1715 -44 1087.5 619.1471 660.3686 652.1764 658.2279 656.1815 636.1857 634.2407 634.8808 625.1851 625.1814 630.8224 -45 1112.5 619.6001 660.9443 652.8683 658.8397 656.3722 636.2745 634.5092 635.2982 624.781 624.8203 631.3737 -46 1137.5 619.6578 660.1256 652.3762 659.4315 656.9237 636.7025 634.0145 635.1175 625.2248 626.2819 631.1542 -47 1162.5 619.195 659.4838 651.4366 658.5505 655.7848 636.5201 633.5235 634.7034 624.5456 625.142 631.4184 -48 1187.5 619.4215 659.7769 651.7305 657.9934 655.585 636.2133 633.8861 635.2471 624.3509 625.1392 631.3784 -49 1212.5 619.4365 660.417 651.6828 658.4544 656.0292 636.839 633.8779 636.0436 624.8158 625.3572 631.5027 -50 1237.5 619.2843 659.2626 652.1786 658.4305 656.2508 636.8049 632.9646 634.1576 624.554 625.3334 631.2679 -51 1262.5 619.6429 659.0053 651.6919 658.7217 656.6364 636.5588 634.3722 635.2047 624.8602 625.6231 631 -52 1287.5 619.0538 659.3861 651.2924 657.7921 655.3807 635.633 633.1669 634.139 624.5008 625.173 631.1169 -53 1312.5 620.032 660.536 652.2995 660.0736 657.1688 637.2071 634.6034 634.9736 625.1411 626.5192 631.8403 -54 1337.5 619.4964 659.4269 651.6734 658.4676 656.1291 636.8711 633.8782 634.7606 624.4274 625.0013 630.9104 -55 1362.5 619.7869 660.1535 652.2897 658.3939 655.9227 637.2328 633.873 635.0491 625.0588 626.2417 631.6512 -56 1387.5 619.4803 660.4408 651.9966 658.3815 656.0329 637.2461 633.9087 634.7836 624.2137 625.2806 631.6511 -57 1412.5 619.6992 660.2073 651.504 658.0831 655.4986 636.1798 634.1972 635.0368 625.1055 626.2759 631.6616 -58 1437.5 619.5442 658.662 651.3918 657.9064 655.5442 635.9153 633.7881 634.1599 624.1967 625.1631 631.4295 -59 1462.5 619.4614 659.7977 651.5216 658.4922 655.9853 636.4371 634.2494 634.2409 625.1905 625.6924 632.02 -60 1487.5 619.6884 659.9299 651.3604 658.3508 655.3531 636.6494 634.5504 634.9116 624.3557 625.6612 631.0877 -61 1512.5 619.321 658.5944 651.0599 658.6518 655.6142 636.0016 633.4034 634.5415 624.6537 625.0472 630.9542 -62 1537.5 618.9828 658.6687 651.6243 657.6624 655.6001 635.7524 633.4592 634.2011 624.1516 624.5758 631.3773 -63 1562.5 618.8885 658.6872 650.5297 657.4567 654.5753 635.5946 632.2904 634.1618 623.8654 625.468 630.3673 -64 1587.5 619.4941 658.6496 651.5327 657.9368 655.829 636.1975 633.2635 634.4595 625.245 625.7107 631.5946 -65 1612.5 619.3935 659.1844 650.7135 657.4629 654.9711 636.492 634.176 635.4589 624.9972 624.9031 630.5326 -66 1637.5 620.0406 659.5483 651.796 658.3489 655.9309 637.283 634.1377 635.8601 624.9593 625.9175 632.1007 -67 1662.5 619.3584 658.9118 651.6015 657.316 655.3936 636.2646 633.7975 633.9978 625.6658 625.9268 630.9313 -68 1687.5 619.5718 659.0942 651.0267 656.9502 654.5683 636.1923 633.5457 634.6133 624.7929 625.713 631.9673 -69 1712.5 619.2193 658.7454 651.3887 657.2803 655.3566 635.1547 634.0597 634.3789 624.0603 624.6939 631.1956 -70 1737.5 618.9174 657.8332 651.453 657.6417 654.7302 635.399 634.1921 634.3673 624.1435 624.8887 630.1608 -71 1762.5 619.4594 658.7201 651.0777 657.3186 654.5621 636.7052 633.9346 634.8716 624.0879 625.0527 631.0306 -72 1787.5 619.7125 659.3703 651.2185 656.8614 654.7953 636.302 633.8636 634.1315 624.8647 626.2475 630.7097 -73 1812.5 619.5472 657.7522 651.5681 657.1853 654.6893 635.6448 633.6509 634.3233 624.8097 625.5929 631.1763 -74 1837.5 619.0432 657.8746 651.3865 656.5779 655.0572 635.7624 633.8879 634.907 624.4179 625.2225 630.7489 -75 1862.5 619.6406 659.345 651.2913 657.4556 655.0584 635.8297 633.7887 634.3467 625.2603 625.3803 630.8645 -76 1887.5 619.2242 657.9095 651.259 656.5765 654.3004 636.3673 633.3679 634.3054 624.8213 625.1158 629.9752 -77 1912.5 619.1395 657.4696 650.5891 656.6981 653.9891 635.7321 633.3386 634.003 623.9899 624.5865 629.89 -78 1937.5 619.5915 659.051 651.9002 656.2175 653.737 636.5006 633.1654 634.2198 625.5754 625.6681 630.9369 -79 1962.5 619.1232 658.8884 651.6986 656.3629 654.0432 636.0789 633.3622 634.2651 624.0047 625.3912 630.3894 -80 1987.5 619.1797 657.7236 650.7777 656.6434 654.3553 636.203 633.3624 633.9448 624.7588 625.7231 631.2615 -81 2012.5 619.4284 657.9564 650.2802 657.3472 654.7189 635.5213 632.7538 633.3559 624.2177 625.1658 630.4095 -82 2037.5 619.8186 659.4537 650.7789 656.8068 653.9533 635.7599 634.2697 634.5317 625.5351 625.7355 630.6639 -83 2062.5 619.0361 658.4525 650.6979 655.9353 654.8402 636.3408 633.0554 634.0612 625.0946 625.2953 630.1426 -84 2087.5 619.0679 658.2028 650.7546 656.263 653.9579 635.3997 632.9751 633.8175 624.7005 625.0064 630.2469 -85 2112.5 619.5036 657.6676 650.9825 656.0741 653.8184 635.8177 633.756 634.3187 625.1032 625.7711 631.028 -86 2137.5 619.5838 658.24 651.1151 656.7514 654.7543 636.0051 633.4436 635.0968 624.5704 625.4066 630.8816 -87 2162.5 619.7774 658.8586 650.8417 656.5809 653.8432 636.021 633.6121 635.1417 625.2152 625.9074 631.0059 -88 2187.5 619.3818 658.008 651.2315 655.5812 653.7966 635.8189 633.3187 634.5345 625.5258 625.5007 629.6714 -89 2212.5 619.4099 657.9034 650.5906 656.2516 654.5323 635.8962 633.5433 634.6133 624.7552 624.6984 630.9105 -90 2237.5 619.4089 657.8727 650.5439 656.8112 653.9223 636.1951 633.3068 634.0905 624.7773 625.0253 629.772 -91 2262.5 619.0846 657.3841 650.6034 654.7351 652.6919 635.3334 633.3407 634.7331 625.0086 624.9161 630.2352 -92 2287.5 619.1711 657.5069 650.5812 655.9594 653.3334 635.3078 633.4448 634.1535 624.0512 624.5332 630.9288 -93 2312.5 619.6704 657.979 650.9181 656.2473 654.2735 635.9193 634.164 634.3943 625.4596 625.8996 630.9707 -94 2337.5 618.9883 657.2547 649.8742 655.3017 653.7401 634.9956 633.05 633.1128 624.573 625.1108 630.315 -95 2362.5 618.77 656.8524 650.6318 655.4716 652.9324 635.1069 632.2976 633.7103 623.8329 624.6676 630.0484 -96 2387.5 619.18 656.759 649.9029 654.9803 653.013 635.6059 633.0676 634.4104 624.1588 625.0173 630.1128 -97 2412.5 619.5943 657.0053 650.5318 655.9102 653.5507 636.4233 633.3031 634.4716 625.0143 626.319 630.4698 -98 2437.5 619.5089 657.0871 650.8551 655.4628 653.8055 635.4576 633.061 634.1545 624.5815 625.6028 630.2713 -99 2462.5 619.1695 656.976 650.3881 654.7235 652.6026 635.3256 633.1645 633.4862 624.8209 624.662 630.4411 -100 2487.5 618.513 656.6107 649.1075 654.3781 652.9325 634.9442 632.8046 633.1775 623.6661 624.6586 629.0236 -101 2512.5 619.2534 657.1351 650.5383 656.098 653.0957 635.2848 633.0267 634.5299 624.5957 624.9733 629.6232 -102 2537.5 619.2428 656.8518 649.9549 655.1723 652.813 635.4614 633.5816 633.4532 624.7441 625.315 630.2144 -103 2562.5 619.3259 657.2634 650.6989 655.4452 652.9216 635.4495 632.8607 633.0796 624.5442 625.4914 629.8364 -104 2587.5 618.8588 655.8009 649.4842 654.8497 652.251 635.2849 633.4936 633.4721 624.7792 624.7345 629.9124 -105 2612.5 619.1994 656.7192 650.2401 655.0245 652.8849 635.9081 633.3239 633.1811 624.7036 625.19 630.1405 -106 2637.5 619.9097 656.9048 650.4774 655.2567 653.4062 635.5823 633.2125 634.011 625.769 625.796 631.052 -107 2662.5 619.4985 657.6028 650.6427 655.4614 653.269 635.1971 633.4538 633.2507 624.8212 625.5746 630.1575 -108 2687.5 619.5252 657.6984 649.8065 655.6652 653.447 635.831 633.2355 633.1174 624.3204 625.6367 629.853 -109 2712.5 618.6822 656.1635 650.075 653.9919 651.5348 634.6455 633.0949 633.5289 624.6241 623.9609 629.9132 -110 2737.5 619.5611 657.4272 650.3853 655.1591 653.2736 634.8469 633.1436 634.2127 624.3819 625.4382 629.7827 -111 2762.5 619.2262 656.3097 649.845 654.0503 652.607 635.4814 633.1084 633.1744 624.3562 625.4302 629.8924 -112 2787.5 619.0123 656.8555 650.4595 654.914 652.7917 634.7565 632.5618 633.6617 624.5954 625.0725 629.9964 -113 2812.5 619.0788 655.4473 649.5705 654.366 652.6426 635.1044 633.3604 633.324 623.7475 624.5335 629.8858 -114 2837.5 618.9793 656.731 649.5823 654.2256 652.1266 634.853 633.2974 633.3168 624.1936 624.96 629.4152 -115 2862.5 618.7719 655.694 649.4038 654.2175 652.1053 635.1691 633.1611 632.8076 623.1571 624.4319 630.0259 -116 2887.5 619.1117 656.9854 650.0139 653.9536 651.8239 635.6695 632.1369 632.7 623.9512 624.8383 629.6973 -117 2912.5 619.1237 656.0197 650.2586 654.5489 652.2038 635.4597 632.4124 633.5215 624.9163 625.3797 629.4735 -118 2937.5 618.9059 656.6491 648.8929 654.4913 651.8942 635.3355 631.9433 633.5877 623.8877 624.385 629.1411 -119 2962.5 619.3233 656.8432 649.3856 654.7177 653.3717 635.5564 633.6213 633.4085 625.1093 624.9929 630.0352 -120 2987.5 619.8558 656.845 650.6094 654.5986 652.7007 636.4113 633.2379 633.598 625.1809 626.0924 630.5962 -121 3012.5 618.9967 655.3859 649.56 654.115 652.3905 635.3777 632.0422 633.4079 624.9945 624.5787 629.6779 -122 3037.5 619.3723 656.248 649.6002 654.6798 653.4212 635.6108 632.0718 633.4992 625.0539 624.9248 629.7259 -123 3062.5 619.1507 656.0902 649.1019 653.3824 651.2278 635.6783 633.2289 633.1657 623.6423 624.6499 630.4444 -124 3087.5 619.0089 656.5217 649.2501 653.7768 651.6482 634.6413 632.5473 633.2417 623.4923 623.9783 629.4027 -125 3112.5 619.3791 656.786 649.4983 654.3871 652.0517 635.4073 632.6579 632.9998 624.485 624.9732 629.9129 -126 3137.5 618.9518 655.0029 649.4529 653.5898 651.7109 634.7494 632.6919 632.8519 623.8593 624.4421 629.7089 -127 3162.5 618.9306 654.9382 649.198 653.5625 652.1641 635.0823 632.6989 633.2711 623.9617 625.4174 630.0145 -128 3187.5 619.4031 656.3798 649.6674 654.3949 652.3793 635.1739 632.3031 633.898 624.6795 625.2214 630.1257 -129 3212.5 619.3513 655.6458 648.8299 653.5794 651.51 635.39 633.0969 632.8097 624.3643 625.5809 629.4613 -130 3237.5 619.3712 655.9213 650.0245 654.0766 651.2707 635.3219 632.8387 633.6629 624.7969 625.624 629.8997 -131 3262.5 619.7244 656.536 649.5171 653.7458 652.416 635.3601 633.2222 633.986 625.4069 625.3191 630.0709 -132 3287.5 619.252 655.9579 649.5582 653.9075 651.657 635.4694 633.4507 633.4692 624.5755 625.2649 630.2173 -133 3312.5 618.7681 655.9811 649.3099 652.7297 650.7115 634.4634 632.3627 633.4456 624.0453 623.7238 629.3844 -134 3337.5 618.5923 655.5339 649.1084 653.0037 651.1682 634.2581 632.8341 632.6062 623.3144 624.769 629.4238 -135 3362.5 618.7292 655.2741 648.5827 653.3296 650.7324 635.1216 631.6936 632.1359 624.1303 624.507 629.8434 -136 3387.5 618.8453 655.0162 649.3634 653.23 650.9911 634.3368 632.558 633.0361 624.3333 625.1946 629.0829 -137 3412.5 619.0023 655.6075 648.5613 653.0687 650.2505 634.5349 632.2745 633.4133 624.0704 624.4851 630.5593 -138 3437.5 619.4083 656.1359 649.5212 653.6081 650.8799 635.3503 632.8908 633.652 624.937 626.2503 630.021 -139 3462.5 619.1464 655.9159 650.2939 652.9551 651.3079 635.4584 632.5818 633.2102 625.1875 625.5281 629.0551 -140 3487.5 618.6135 654.8158 648.183 651.9918 650.1188 634.7103 631.5634 632.6345 624.2616 624.8559 628.3536 -141 3512.5 618.9261 655.6843 648.6419 653.0123 650.9351 634.9509 631.7626 632.6395 623.7726 624.7664 629.5252 -142 3537.5 619.0118 655.2039 649.4776 653.4562 651.3888 634.5172 632.2866 632.4602 624.7291 624.9897 629.2447 -143 3562.5 618.9974 656.1514 649.4982 653.2829 650.7573 635.6186 632.8572 632.0904 624.5361 625.1963 629.7383 -144 3587.5 619.2582 654.5657 649.0555 653.6096 651.5511 634.9013 632.5776 633.134 624.4961 624.8664 629.3546 -145 3612.5 618.9818 654.2458 648.5193 652.3381 650.2084 634.7433 631.8828 632.7137 624.1804 625.0461 629.5779 -146 3637.5 618.885 655.1888 648.4858 653.0299 650.7826 634.6405 633.4996 632.4273 623.8651 624.1743 628.95 -147 3662.5 618.738 654.3687 649.2513 651.7636 649.9919 634.0802 631.0274 632.905 624.3196 625.1019 627.5411 -148 3687.5 619.1882 655.8884 648.9971 652.8715 651.0577 635.1871 632.2535 633.0031 624.3674 624.9991 629.8081 -149 3712.5 619.0847 655.2343 649.6264 653.1473 651.5538 635.2048 632.7107 633.1395 625.5345 624.3397 629.1202 -150 3737.5 619.2066 655.369 648.4612 652.5426 650.9735 635.1124 632.6933 632.6564 624.7077 624.9398 629.0221 -151 3762.5 618.6994 654.3894 648.0961 652.2881 649.7615 635.0301 631.8474 632.3641 623.9357 624.5118 628.5999 -152 3787.5 618.9899 654.8033 648.2224 652.3129 649.9764 634.7707 632.9237 632.5437 623.5759 624.7902 629.6734 -153 3812.5 619.3187 654.9825 649.1985 652.5379 650.9844 634.6611 633.0142 633.3398 624.703 625.1121 629.1493 -154 3837.5 618.8222 654.5908 648.3707 652.4884 650.0787 634.7839 632.0598 632.7098 624.1325 624.4341 629.077 -155 3862.5 618.3551 654.2616 647.2054 650.4855 648.6326 634.2486 631.8976 632.4435 622.8922 623.8339 628.2844 -156 3887.5 618.9439 654.8196 648.0153 652.6733 650.5895 634.6042 632.3701 632.7489 624.1487 624.2561 628.8858 -157 3912.5 619.2987 655.654 648.8183 652.8049 650.9519 635.0246 632.7168 633.0453 624.6938 625.5101 629.5049 -158 3937.5 619.1912 654.6866 648.7767 651.8879 649.8744 634.7485 632.1456 632.5525 625.0925 625.234 629.4699 -159 3962.5 619.1578 655.1568 648.922 652.4542 649.8878 634.1395 632.115 632.5593 624.7185 624.8243 629.4701 -160 3987.5 618.954 653.5426 648.1742 652.4137 650.4536 635.095 632.2903 632.9483 624.0543 625.6944 628.8961 -161 4012.5 619.0859 654.4974 648.9592 652.6077 650.5737 634.72 632.2438 632.2209 624.3072 625.0119 628.9657 -162 4037.5 618.9742 654.8866 649.5078 651.8472 649.6595 634.9389 632.4768 632.697 624.3441 625.2724 628.9327 -163 4062.5 618.5499 654.163 648.7347 651.0778 649.625 634.4678 632.9044 631.8673 623.7386 623.8049 628.7251 -164 4087.5 618.9236 654.6388 647.8996 652.0784 649.914 634.8287 631.9617 632.2116 624.1101 625.0873 628.792 -165 4112.5 618.4588 653.8673 647.7265 651.611 648.9233 633.7383 631.6205 631.6542 624.0559 624.7463 628.8468 -166 4137.5 618.7164 654.4114 648.5582 651.5499 649.8556 634.1824 632.1235 631.708 623.8893 623.9264 628.8113 -167 4162.5 618.8752 654.1756 647.7811 651.4162 649.5315 634.7821 632.1283 632.8556 624.2156 624.1171 628.1944 -168 4187.5 619.3569 654.6552 648.099 651.7625 650.9024 634.5983 632.9384 633.0293 624.1294 624.8762 629.8321 -169 4212.5 618.4404 653.5798 647.4559 652.1242 649.8545 634.6389 632.2939 631.8735 623.4035 624.022 628.4769 -170 4237.5 618.6147 653.7813 647.3801 650.9257 648.8427 633.3048 631.7706 633.0439 623.0475 624.9094 628.6247 -171 4262.5 618.5714 652.9237 646.916 651.2937 648.8039 634.0328 632.0201 632.2848 623.6776 624.8949 628.707 -172 4287.5 618.4561 654.454 648.1065 651.0211 649.0695 633.6688 631.2935 631.864 623.6754 624.7348 629.1651 -173 4312.5 619.0053 654.5872 648.0999 652.0448 649.8237 634.4566 631.8808 632.6611 624.0995 624.6749 628.3811 -174 4337.5 618.7321 654.0076 647.7945 651.0182 649.4733 634.1226 631.7433 632.5805 624.262 624.6751 628.9124 -175 4362.5 618.8796 654.0749 648.2349 651.6931 649.5934 634.7741 632.4299 632.2821 623.5638 624.6331 629.2547 -176 4387.5 618.9158 653.4054 648.0452 651.3552 649.3086 634.5742 632.0158 632.6057 623.9611 625.1525 629.1208 -177 4412.5 618.8451 655.1949 647.7965 651.2479 649.4624 634.492 631.9341 632.1602 624.2743 623.874 627.9982 -178 4437.5 619.0385 654.3906 647.7725 651.0811 649.1565 634.1971 632.6773 632.0087 624.7515 624.6455 628.8649 -179 4462.5 618.9516 654.4443 648.1627 650.8967 649.2179 634.1522 632.333 631.9168 623.8803 624.6349 628.3874 -180 4487.5 619.0969 654.2161 648.8333 652.1127 650.1702 634.502 631.7016 632.349 623.9839 624.3378 628.9979 -181 4512.5 619.0494 653.2785 647.5071 651.651 650.4825 634.0314 632.3306 633.0096 623.6339 624.9298 629.3816 -182 4537.5 618.364 653.3339 647.7706 650.8002 649.297 633.0787 630.4672 631.3637 624.3894 624.2077 628.7537 -183 4562.5 619.2493 653.2704 648.3747 651.6715 649.2655 634.2729 631.8156 632.6542 624.8062 625.5303 630.5464 -184 4587.5 618.8602 653.9763 648.3001 650.8425 649.372 634.2168 631.493 631.8857 623.7743 624.0267 628.5333 -185 4612.5 618.8645 653.8773 648.1708 651.5908 649.8723 634.3427 632.026 632.8272 623.6715 624.4646 628.6919 -186 4637.5 618.9328 653.9892 648.087 651.1106 649.2112 634.2443 632.2555 632.2057 623.7227 624.9694 629.0577 -187 4662.5 618.8254 653.7014 647.6111 650.5595 648.8868 633.9651 631.9907 631.7869 624.0993 624.759 627.9094 -188 4687.5 618.9911 653.4959 648.0767 651.2509 648.958 634.2695 631.7548 632.4656 624.4515 624.6573 628.4349 -189 4712.5 619.1516 653.4524 647.6667 650.73 648.4824 634.3106 632.5616 632.5456 624.0686 624.596 628.713 -190 4737.5 618.5762 653.2439 647.0638 650.0874 648.158 635.021 631.304 631.6893 623.7921 623.4843 627.5759 -191 4762.5 618.6338 653.1327 647.8505 650.8884 648.4176 633.7389 631.458 631.6995 623.4723 623.624 628.1091 -192 4787.5 618.7654 652.8275 648.0166 650.9777 649.6025 633.3308 631.7606 631.9956 623.6587 624.4399 627.9926 -193 4812.5 618.4063 653.5255 647.7662 650.8618 648.3132 633.7052 631.0402 631.5484 623.2467 624.2804 627.402 -194 4837.5 618.1688 652.8664 646.6762 650.8303 648.195 633.496 630.8218 631.3971 623.5202 623.6875 627.8834 -195 4862.5 619.1283 654.2303 647.4854 650.7154 649.0818 634.702 632.3014 632.281 623.2738 624.3089 628.6441 -196 4887.5 619.2227 653.2196 648.4142 651.187 649.3789 634.2461 631.2062 632.2326 624.1006 625.3618 629.5652 -197 4912.5 618.7722 653.8734 647.7479 650.426 648.2083 633.5101 631.7288 631.7939 623.9939 624.3515 627.9678 -198 4937.5 619.203 653.266 647.6406 651.2157 649.2556 634.3605 632.2576 632.7565 624.7757 624.7714 628.4938 -199 4962.5 618.6023 652.9386 647.7863 650.4492 648.3712 633.7404 631.6671 631.9933 623.9734 624.5115 628.193 -200 4987.5 618.5643 653.054 646.8557 649.6625 647.9863 633.8609 631.5303 631.7036 623.9881 624.3636 627.8617 -201 5012.5 618.9945 653.9163 647.5579 650.4969 648.5955 633.7961 632.3524 631.8314 624.0592 625.0209 628.7744 -202 5037.5 618.8036 653.3631 647.6549 650.2506 647.6292 633.5085 631.7846 632.1385 623.4423 624.4778 627.9361 -203 5062.5 618.9353 653.2382 647.4943 649.9781 648.3486 634.2175 631.3141 632.1607 623.8845 624.994 628.1153 -204 5087.5 618.8769 652.2405 647.3362 649.9139 648.6146 634.112 632.1768 631.6975 624.1771 625.1053 628.9446 -205 5112.5 618.9629 652.2856 648.2336 651.5798 649.2323 633.871 631.3724 632.2623 624.4001 624.2176 628.3257 -206 5137.5 618.5888 653.0329 646.4013 650.6897 648.7911 633.3618 631.4572 631.302 623.522 623.9393 627.7615 -207 5162.5 618.5332 652.966 647.0297 650.0679 648.0988 632.9859 630.8757 631.049 623.7867 624.8207 627.6892 -208 5187.5 619.2727 653.5433 648.2781 650.5863 649.1801 633.7943 632.6711 632.0327 624.2103 624.7424 629.4621 -209 5212.5 618.7765 652.9074 647.416 649.6592 647.4137 634.0584 631.0725 632.0022 623.3719 624.4958 627.8934 -210 5237.5 618.9615 652.582 647.2526 650.5398 648.5964 633.5985 632.227 631.8234 624.2246 624.4247 628.0643 -211 5262.5 619.0009 652.7223 647.438 650.2225 647.9529 634.3578 632.3067 632.3832 624.3578 624.3336 628.4965 -212 5287.5 618.9458 652.6265 647.3358 649.77 647.63 633.5897 632.2106 631.3565 624.2521 625.0172 628.9265 -213 5312.5 618.8072 652.4581 646.9609 649.2367 647.822 633.8555 632.4647 631.2376 624.2442 624.3329 628.6963 -214 5337.5 618.5354 652.092 647.0957 649.1379 647.9707 633.4178 631.472 631.2896 623.2217 624.1828 628.4373 -215 5362.5 618.7768 652.0957 647.1739 649.217 648.299 634.1184 631.7813 631.9216 623.8468 624.4162 628.0313 -216 5387.5 618.9748 652.3557 646.764 649.8083 647.7198 634.2619 632.4328 631.9969 624.6183 625.6374 628.4755 -217 5412.5 619.439 653.6304 648.3546 650.8978 648.4926 634.5473 632.1081 632.3116 624.7527 625.4262 628.7746 -218 5437.5 618.7111 653.4909 647.0508 649.2834 646.8163 633.4722 631.3457 631.6077 624.0118 623.8951 627.7093 -219 5462.5 618.8112 652.3801 647.352 649.8355 647.8631 633.4998 631.3351 632.343 623.451 624.0698 628.0892 -220 5487.5 618.2131 652.578 646.3652 648.7379 647.3924 634.0418 631.1596 631.0277 623.2672 623.6799 627.7253 -221 5512.5 618.5854 653.149 646.8393 649.188 646.6886 633.166 631.5174 631.1911 623.5634 623.8946 627.9638 -222 5537.5 618.5213 652.0917 645.9027 649.1051 646.8119 634.7473 632.009 631.2304 623.8827 624.8598 627.0569 -223 5562.5 619.0323 652.4625 646.7866 650.3601 647.4203 633.6518 632.1259 631.6863 624.6704 624.6772 628.4052 -224 5587.5 618.6252 652.0872 646.4479 648.502 646.9255 633.5339 632.1697 630.8464 623.5466 624.4852 627.8798 -225 5612.5 618.5673 652.2964 647.0101 649.1359 647.6871 633.5874 630.7991 632.2396 624.2537 624.4285 627.2764 -226 5637.5 618.8451 652.1103 647.0721 649.4681 647.1686 634.5487 631.163 631.5285 624.3839 624.7169 629.0421 -227 5662.5 618.9258 652.987 647.0167 650.0562 647.9343 634.1851 632.0204 631.5921 623.5986 624.1024 628.602 -228 5687.5 619.0433 652.563 647.48 649.4209 647.8456 633.9053 631.3552 631.7692 623.9901 625.3299 628.6911 -229 5712.5 618.9093 653.0607 647.2772 649.6101 648.1616 633.8955 631.5607 631.7954 623.5102 624.4634 628.29 -230 5737.5 618.2741 651.683 646.157 649.5037 647.0727 633.3031 630.8218 631.244 623.6108 624.7005 627.5605 -231 5762.5 619.143 652.87 647.2256 650.0595 647.7934 634.1636 631.401 632.8653 624.1015 624.1788 627.9962 -232 5787.5 618.9545 652.5454 646.8469 649.2721 647.5413 634.1884 631.5245 631.0145 624.1489 624.9394 628.0456 -233 5812.5 618.8908 652.3326 647.5903 649.397 648.1425 634.0223 631.2271 631.0431 623.513 624.3311 627.9605 -234 5837.5 618.9236 652.8054 646.764 648.8079 647.2703 633.6219 631.3885 630.6707 624.1685 624.5713 627.8141 -235 5862.5 618.811 651.6793 646.3536 649.6607 647.9751 634.0148 631.5314 631.5793 624.4696 624.8814 627.7988 -236 5887.5 619.0164 652.2158 646.9457 649.9317 647.8622 633.8169 630.9459 632.0796 624.1904 624.4197 627.5697 -237 5912.5 618.739 652.3353 647.0415 648.8077 646.7442 633.8036 630.6798 631.9432 623.8518 624.3821 627.8839 -238 5937.5 618.4722 652.3319 646.5427 648.6056 646.5049 633.3466 630.897 630.6872 624.8246 624.0144 627.0977 -239 5962.5 618.4676 651.7141 645.9844 648.5367 646.2891 633.38 631.3219 631.1309 623.3089 624.2309 627.3183 -240 5987.5 618.5736 651.9366 646.8758 648.7231 646.8516 634.081 631.132 631.3326 622.8598 624.5669 627.4215 -241 6012.5 618.5775 652.3941 646.6208 648.9467 647.336 633.8886 631.0278 631.8381 623.9088 624.679 627.7326 -242 6037.5 618.4216 651.8822 645.9825 648.4448 646.5095 633.8057 630.9413 631.1101 623.8846 624.1879 627.4334 -243 6062.5 618.093 651.1863 645.6364 648.0116 645.9717 632.7636 630.8826 630.7844 623.6428 623.76 628.4916 -244 6087.5 618.011 650.7627 645.1145 647.7979 645.8697 632.7751 630.0246 629.9156 622.7402 623.46 627.2273 -245 6112.5 618.393 651.7139 645.8012 648.4682 646.4808 633.1117 630.7762 630.6297 623.1604 623.7627 627.5273 -246 6137.5 618.4089 651.1519 645.9778 647.8734 646.1238 633.5215 631.1628 630.885 624.1536 624.0203 627.4756 -247 6162.5 618.4086 650.6174 646.2551 647.4361 645.6442 633.1803 630.8233 631.2525 623.3068 623.3222 628.213 -248 6187.5 618.4941 650.7368 646.2873 648.206 645.8069 633.2143 631.2049 630.8191 624.0545 624.7554 627.856 -249 6212.5 618.3587 651.5488 646.0264 648.4196 646.4547 633.1145 630.4532 630.44 623.2864 624.6866 626.9993 -250 6237.5 618.8981 652.0637 646.6025 648.0815 646.7123 632.9885 631.2276 632.0408 623.7819 624.257 628.1196 -251 6262.5 618.2112 651.0093 645.9306 647.6297 645.5979 632.6874 630.309 631.9392 622.8574 623.9678 626.5563 -252 6287.5 618.3797 650.8463 645.115 648.2466 646.4703 632.9657 631.0185 630.9376 623.6062 624.1074 627.3731 -253 6312.5 618.6171 651.0803 646.4533 647.7855 645.7398 632.955 630.9232 631.6985 623.9085 623.8961 627.4292 -254 6337.5 618.6821 651.1905 646.9589 648.7276 646.8346 633.3911 631.5856 631.1552 623.1318 624.2305 627.5624 -255 6362.5 618.6308 651.8107 646.0864 648.1322 646.6225 633.5327 631.3765 631.0332 623.7023 623.9898 627.2907 -256 6387.5 618.6265 651.64 646.1128 648.3339 646.3668 632.7732 630.5766 630.7189 623.9275 625.5066 627.7556 -257 6412.5 618.4316 651.2918 647.3736 646.9403 645.4584 633.2405 630.9283 631.7579 623.6013 623.7031 627.3668 -258 6437.5 618.8508 651.4332 647.1757 648.4575 646.2968 634.4756 631.2028 631.7496 624.1447 625.1056 628.1667 -259 6462.5 618.2028 651.6175 645.2017 648.1664 646.5113 632.6745 631.1601 630.247 622.4272 623.6615 626.9515 -260 6487.5 618.1785 650.8184 645.2308 647.8696 645.9977 632.9228 630.7756 630.3073 622.8306 623.8459 626.6337 -261 6512.5 618.2871 651.1972 646.1493 648.7333 646.6203 633.7166 630.508 630.387 623.4867 623.6911 626.775 -262 6537.5 618.9505 651.377 646.7259 648.7837 646.4083 633.7539 631.0143 631.2833 625.0178 624.33 627.725 -263 6562.5 618.5302 650.8953 645.8485 648.3132 646.1617 633.0473 631.371 630.3833 623.5478 623.6528 627.4871 -264 6587.5 618.5667 650.5818 645.5633 647.6813 645.8256 632.8955 631.3222 631.2744 624.285 624.4284 627.361 -265 6612.5 618.1587 650.5808 646.0063 647.2793 645.5067 633.5839 630.3443 630.6163 622.3919 623.8034 626.9281 -266 6637.5 618.4789 651.6074 646.1382 647.9849 646.1978 632.0409 631.0717 630.9895 623.8639 624.0661 627.6185 -267 6662.5 618.6895 651.1743 645.0934 648.2558 646.2116 632.8265 630.8822 630.2263 623.8095 623.5925 627.3405 -268 6687.5 618.824 652.0283 646.1471 647.5767 645.7159 634.2792 630.9498 631.313 623.7428 624.2681 628.0645 -269 6712.5 618.6317 650.9717 645.122 648.1999 645.7176 633.7947 631.0049 631.0455 623.8011 623.8533 626.908 -270 6737.5 618.5133 651.2345 645.0101 647.6289 646.5774 632.9885 631.0599 631.5557 624.08 623.6674 626.7621 -271 6762.5 618.4715 650.5145 646.1657 646.9936 645.7424 632.5369 630.9801 631.683 623.3716 623.7228 627.4534 -272 6787.5 618.512 651.0828 645.5219 646.6826 644.795 633.5704 630.6304 630.1678 624.1887 624.2213 626.3114 -273 6812.5 618.6452 651.2954 645.7911 647.2936 645.9355 632.8019 631.0129 630.7956 623.8557 624.532 626.6105 -274 6837.5 618.8978 651.0166 646.9765 648.2441 645.8021 633.5285 631.0142 631.1585 623.8816 624.6734 628.1299 -275 6862.5 618.3586 650.302 644.2611 648.542 645.8646 632.945 630.6007 630.6872 623.4219 623.7298 626.6519 -276 6887.5 618.4875 650.8549 645.873 647.2126 645.4785 632.9577 630.4811 630.9634 623.2826 623.3281 627.4324 -277 6912.5 618.6757 650.3267 645.4689 647.3181 645.8541 632.8485 631.4462 631.3532 623.8546 624.0416 628.1203 -278 6937.5 618.2115 650.3977 645.1668 646.0031 644.3501 632.735 630.4579 631.429 623.5469 624.2447 626.2979 -279 6962.5 618.3628 650.3816 644.6562 646.7577 645.142 633.5831 630.3956 630.2956 622.966 623.9322 626.9581 -280 6987.5 618.5374 650.4845 645.6938 647.8725 646.2198 633.1813 631.1056 630.7955 623.8157 623.9563 626.9682 -281 7012.5 618.5039 650.4199 645.5979 647.872 645.4787 632.1809 630.9974 630.6805 623.1477 624.2579 627.2339 -282 7037.5 618.7678 651.0885 645.2875 647.7262 645.6397 632.7452 631.1904 630.6738 623.8352 624.3883 627.5483 -283 7062.5 618.2261 650.6754 645.1489 647.1713 645.9271 632.7379 630.2042 630.4537 622.8319 623.7862 626.3857 -284 7087.5 618.5986 650.8426 646.1051 646.8343 645.2433 633.3667 630.7269 630.8247 623.623 623.9239 627.6721 -285 7112.5 618.3443 651.1782 645.5043 646.5859 645.2304 633.4053 630.373 631.0143 623.5604 623.8627 627.244 -286 7137.5 618.7396 650.7602 645.9398 648.3223 645.9961 633.6356 630.7913 630.7576 623.138 624.1686 627.8974 -287 7162.5 619.0795 651.3266 645.8681 647.5622 645.5512 634.4992 631.1298 631.4903 623.7069 624.4254 628.2348 -288 7187.5 618.3279 650.2048 644.8116 646.5444 644.5427 632.7031 630.5645 630.8341 623.2977 624.2077 627.2958 -289 7212.5 618.2973 650.6044 645.1635 646.8084 644.6295 632.4833 630.0304 630.7622 623.752 624.2131 627.506 -290 7237.5 618.859 650.8688 645.9185 647.6035 645.3818 633.1843 631.3684 631.0757 623.5035 624.3592 626.7896 -291 7262.5 618.2963 650.1216 645.4653 646.7793 645.3006 633.4122 630.8581 630.724 623.6299 623.5449 626.261 -292 7287.5 618.7335 650.2448 646.2549 646.7894 644.9746 632.6145 631.1034 630.9787 623.3859 624.0314 627.3662 -293 7312.5 618.4626 650.4178 645.0825 646.8085 645.4283 632.6787 630.565 630.6512 623.6212 623.6796 626.8558 -294 7337.5 618.6748 649.8851 645.3406 647.0794 644.8849 632.8644 631.1923 631.0913 623.8293 625.2235 627.555 -295 7362.5 618.2332 648.9786 644.2948 646.8331 644.4878 633.0242 629.955 630.1825 623.5684 623.5459 626.9243 -296 7387.5 618.4091 650.1669 644.8131 646.3815 644.3585 632.6979 630.2908 629.8451 623.6335 624.1096 626.9751 -297 7412.5 618.4987 650.7976 644.4052 646.1215 644.2645 633.0426 630.2771 630.1676 623.1582 623.245 627.1333 -298 7437.5 618.4745 650.0045 644.9857 646.6431 645.1226 632.4447 630.7097 630.8005 622.7082 623.7896 627.8796 -299 7462.5 618.7395 650.1959 645.7572 646.3635 644.1454 632.8343 630.291 630.8889 623.9828 623.597 626.7385 -300 7487.5 618.7043 650.5124 645.9306 647.0941 645.1926 633.5556 630.5643 630.8277 623.6326 624.196 627.044 -301 7512.5 619.0649 650.7897 645.3888 647.4891 645.7593 633.4466 631.4775 630.8706 624.4205 624.4989 627.328 -302 7537.5 618.5242 650.8239 645.1647 646.4609 644.4305 632.8471 631.4025 630.4154 623.3036 623.7999 627.6354 -303 7562.5 618.4352 650.4218 645.1364 646.7873 645.2778 632.3872 630.5753 630.4445 623.0562 624.3973 626.6241 -304 7587.5 618.4319 649.9424 644.7924 646.772 645.3847 633.2489 630.5264 630.5124 622.8138 624.1622 627.0306 -305 7612.5 618.4504 650.152 645.4666 646.6695 644.4017 632.5882 630.2798 630.1396 623.9076 623.6975 627.1513 -306 7637.5 618.3089 650.7886 644.414 647.0801 645.5416 632.6067 630.0021 630.5348 623.5274 623.8616 626.629 -307 7662.5 618.6721 650.4858 645.5833 646.2829 644.9763 633.039 630.5968 630.9221 623.7247 624.3492 626.4539 -308 7687.5 618.3895 650.6616 644.9204 646.2094 644.0641 632.6111 630.8601 630.9184 623.2283 623.6508 626.9643 -309 7712.5 619.0706 651.3523 645.5729 646.3172 644.9272 633.3322 630.9194 630.8345 623.827 624.3725 627.6029 -310 7737.5 618.3439 649.728 645.1075 646.5331 644.3375 632.4734 630.283 629.9038 623.1606 623.4886 627.0319 -311 7762.5 618.9544 650.4042 645.4888 646.8574 645.0176 633.0137 631.1789 630.9664 623.8693 624.6666 627.8776 -312 7787.5 618.1977 649.8716 644.6861 645.3126 644.4462 631.8128 630.6642 629.7904 623.3611 623.0477 626.8131 -313 7812.5 618.1473 649.7101 643.9476 645.6463 644.142 632.8172 630.344 630.3991 622.835 622.895 626.627 -314 7837.5 618.862 650.1162 644.3231 647.1564 645.4676 632.6408 631.6468 630.9702 623.8692 623.9261 626.4991 -315 7862.5 618.4185 649.6833 645.1225 646.0168 644.3929 632.5783 630.7495 630.5514 622.6778 624.2944 626.9491 -316 7887.5 618.3152 649.4984 644.7363 645.7152 644.3641 632.9649 629.771 630.5899 623.5342 624.5155 626.9422 -317 7912.5 618.2918 649.4324 644.4608 647.1509 644.4112 633.0677 629.9365 629.7813 623.2294 622.9217 626.7955 -318 7937.5 618.4807 650.8046 645.1009 645.7318 644.1698 632.419 630.4016 630.3552 624.068 623.7154 626.8045 -319 7962.5 618.2901 649.5621 644.9576 645.4758 644.1941 632.5734 630.2385 629.8744 623.7524 623.7316 626.7106 -320 7987.5 618.364 649.5074 643.8624 646.2436 644.4735 632.7982 630.3678 630.9499 623.7981 624.6382 626.9544 -321 8012.5 618.8354 650.1159 645.4016 647.2214 645.6133 632.8678 630.6392 630.8544 623.2534 624.1601 626.9893 -322 8037.5 618.6215 649.928 644.6645 645.8989 643.6923 633.2473 630.9215 630.2488 623.0786 624.1518 626.9227 -323 8062.5 618.9782 650.3453 644.4418 646.5901 644.9668 633.245 630.9773 630.8305 624.1211 624.282 627.9896 -324 8087.5 618.0019 648.5852 644.6289 645.2636 643.9906 632.0613 630.5516 629.8139 622.9913 623.1181 626.175 -325 8112.5 618.2685 649.8962 645.0746 646.1486 643.9857 631.9631 631.4108 630.1446 623.9561 623.8182 626.7123 -326 8137.5 618.2903 649.6125 644.0575 644.9006 643.1916 631.7471 630.3981 629.9039 623.3989 623.994 627.0982 -327 8162.5 618.5256 649.6985 644.9219 646.5496 644.2649 632.31 630.8333 630.2354 623.1154 623.4292 626.9045 -328 8187.5 618.6263 649.13 644.3508 645.7005 643.6443 631.9247 630.8098 630.7128 624.0049 623.5818 627.8002 -329 8212.5 618.565 651.0052 644.5112 645.7753 644.4512 632.8293 630.2637 630.5492 623.4625 623.5892 626.6317 -330 8237.5 618.3657 649.8342 644.8589 645.9157 643.9619 633.1589 630.0736 630.5122 622.9489 623.7293 627.0794 -331 8262.5 618.3354 649.5816 643.9188 645.6946 643.9122 632.5254 630.2308 630.3366 623.895 623.3626 626.2339 -332 8287.5 618.489 650.1469 644.9995 646.0249 643.9678 632.7201 630.8447 630.2843 623.1595 623.6675 627.4992 -333 8312.5 618.4103 649.2427 643.7491 645.1183 643.585 632.7074 630.0562 630.8584 623.9041 624.5068 627.1074 -334 8337.5 618.775 649.9411 645.0695 646.5077 644.542 633.5217 630.9005 631.5416 623.9577 623.5901 627.5317 -335 8362.5 618.6649 649.6666 645.0583 647.0481 644.9319 632.4419 630.9266 630.2653 624.0309 624.2949 627.7756 -336 8387.5 618.5972 650.51 644.6694 645.3269 643.7284 632.702 630.8527 630.397 623.556 623.7085 626.4101 -337 8412.5 618.2018 649.096 644.4631 645.6769 643.7876 632.2838 630.0569 629.9414 623.4953 623.3194 626.4029 -338 8437.5 618.5864 650.9217 644.8315 645.6452 643.2927 632.428 630.5806 630.6544 624.0461 623.5732 627.5798 -339 8462.5 618.0637 648.3583 644.2733 645.4712 643.3705 632.1783 630.677 630.224 622.2156 623.6408 625.8602 -340 8487.5 618.3464 650.4567 644.1441 646.0295 643.9643 631.7144 630.3444 631.081 623.825 624.0898 627.4506 -341 8512.5 618.6875 649.3386 645.7851 646.3093 643.873 632.8727 630.5329 630.3559 623.0921 623.7292 627.4044 -342 8537.5 618.226 648.528 644.6844 645.4502 643.583 631.4378 629.3295 630.3208 623.9322 623.3319 625.8648 -343 8562.5 618.3907 649.3694 643.7564 645.5451 643.8227 632.4523 630.2999 629.6681 623.0829 623.3485 625.5932 -344 8587.5 618.6668 649.3559 644.3465 645.8364 643.7917 632.6209 630.7156 630.521 623.3915 624.6564 626.7504 -345 8612.5 618.4699 649.3436 644.804 646.1493 644.0891 633.1641 630.395 630.5449 623.3689 623.4048 626.454 -346 8637.5 618.5243 648.9337 644.5682 645.1041 643.015 633.1662 630.1375 629.7279 622.9173 623.6332 627.0146 -347 8662.5 618.2064 648.5491 643.8893 645.4478 643.2366 632.1683 630.1043 629.596 622.4739 624.0199 626.508 -348 8687.5 618.4275 649.0491 644.4008 645.3 643.4925 632.7113 630.6609 630.2512 623.1657 623.8705 626.3277 -349 8712.5 618.5667 650.2475 643.9579 645.3668 643.8265 633.2668 631.1766 630.0999 623.5194 623.6311 626.7078 -350 8737.5 618.5017 649.0488 644.7107 645.0626 644.102 631.778 630.7302 630.2522 623.2993 624.086 626.9363 -351 8762.5 618.4543 648.3395 644.4734 645.1038 642.6601 632.8849 630.4172 630.5424 623.0777 623.0308 627.3421 -352 8787.5 618.8428 649.9798 644.0939 645.4286 643.7637 632.8143 630.5114 630.8691 624.4572 623.7593 627.2918 -353 8812.5 618.4342 649.3737 644.246 645.4604 642.9952 632.1868 630.2811 629.83 623.5446 624.1014 626.0372 -354 8837.5 618.7335 649.1455 645.1523 645.6904 643.6562 632.4996 630.3286 630.1065 623.2224 624.2629 627.9404 -355 8862.5 618.8819 649.1021 644.8431 645.9183 643.7847 632.6263 630.8952 630.333 623.681 624.6149 627.1219 -356 8887.5 618.7337 648.9698 645.845 645.7788 644.5348 632.7433 629.8293 630.2963 623.6382 624.24 626.7588 -357 8912.5 618.5966 649.8865 644.7819 645.2094 643.2773 631.7107 630.7093 630.3165 623.5106 623.9584 626.8737 -358 8937.5 618.2953 648.5237 643.2282 644.8661 642.9077 632.307 630.0069 629.4535 623.3817 624.2337 626.9178 -359 8962.5 618.4522 648.8473 643.9328 644.5106 642.81 632.3212 630.2171 630.0487 624.0746 623.7379 625.8119 -360 8987.5 618.1987 649.5801 644.1971 644.4061 642.3501 631.8334 630.0769 629.7371 623.4826 623.7143 625.7715 -361 9012.5 618.6604 648.8025 644.5723 644.9618 643.9131 633.0034 631.1027 630.4953 623.3564 624.161 626.3954 -362 9037.5 618.4766 648.3843 643.907 645.296 642.8569 632.3137 629.6657 629.796 622.7613 623.72 626.1989 -363 9062.5 617.9552 647.5717 643.8892 644.3449 642.853 632.3802 629.3721 629.4203 622.4843 623.1292 626.0959 -364 9087.5 618.0586 648.6588 643.6195 644.3138 642.8918 632.3866 630.0131 629.6002 623.2503 624.1777 625.8431 -365 9112.5 618.2538 648.8638 644.0906 644.6384 643.2183 632.2125 629.9573 630.113 623.1203 623.9502 625.9283 -366 9137.5 618.3348 649.3889 643.5032 644.5769 642.7786 633.0311 630.1023 630.3598 622.764 623.3851 626.3935 -367 9162.5 618.2285 648.3715 643.6462 643.8999 643.0072 631.9955 630.0289 630.4701 622.5838 624.1422 626.8893 -368 9187.5 618.3764 648.4641 644.1332 644.8917 642.5606 631.5427 630.1089 629.5101 623.274 623.6395 626.2112 -369 9212.5 618.4925 648.7271 644.0112 644.3022 642.6092 632.4091 630.4191 630.0229 623.7411 624.1999 626.5547 -370 9237.5 617.9371 648.4581 643.4852 644.2721 642.51 631.1778 630.1696 628.9105 622.242 623.0448 626.217 -371 9262.5 618.0937 649.1332 644.2218 644.5459 642.7458 631.5524 630.086 629.4436 622.7374 623.4835 626.7291 -372 9287.5 617.9835 648.7028 643.4191 644.2373 642.3337 631.7539 629.1179 630.0249 622.7879 622.9156 625.9305 -373 9312.5 618.6342 649.1277 643.5998 644.5541 643.1012 632.5915 629.2926 630.784 623.463 623.4691 626.2484 -374 9337.5 617.7979 648.6783 643.8123 644.7457 642.3512 631.7824 629.779 628.7636 622.6756 623.4227 625.9601 -375 9362.5 618.1734 647.8283 644.1797 644.8148 642.7339 631.7168 630.1532 629.9965 622.914 623.3928 626.1645 -376 9387.5 618.7312 649.4527 644.3163 644.5857 643.1813 632.8515 630.3759 629.651 623.5558 624.5426 626.368 -377 9412.5 618.0063 648.1059 643.4379 643.7064 642.2692 631.7398 629.3768 629.355 622.5813 623.0003 626.8682 -378 9437.5 618.5759 648.2842 643.6792 644.917 643.1413 632.4457 630.8254 630.3641 623.4134 623.9466 626.8719 -379 9462.5 618.3521 648.3616 644.0281 644.0362 642.2481 631.0841 630.0707 629.6455 622.8475 623.1573 626.0066 -380 9487.5 618.157 647.7067 643.0498 644.0736 642.7409 631.2069 629.6264 629.6725 622.9569 622.7905 625.7662 -381 9512.5 617.9725 648.8606 643.9327 644.3573 642.2167 631.1654 628.9784 629.2826 623.0738 623.7036 625.817 -382 9537.5 618.7489 648.3842 644.2837 645.1919 643.1051 632.1657 631.0128 630.867 623.4777 623.5722 627.5416 -383 9562.5 617.8265 646.8775 643.2375 644.2315 642.5984 631.5545 629.6814 629.7804 623.1103 622.591 625.656 -384 9587.5 618.4409 648.4052 643.6649 643.5457 642.6738 632.0575 629.8965 629.6938 622.908 623.8966 626.826 -385 9612.5 619.0416 649.5977 643.6657 644.7118 643.0229 632.8607 631.5474 630.3487 624.4663 623.8067 627.0891 -386 9637.5 618.3461 648.2963 642.905 644.1572 642.5398 631.8768 629.5719 630.1785 622.8795 623.7967 626.035 -387 9662.5 618.3498 648.3428 643.8818 644.5497 642.6002 631.9827 629.6941 629.5495 623.1228 622.9446 626.1307 -388 9687.5 618.1572 648.089 643.369 644.2119 642.1496 631.1705 629.9102 629.8906 622.5808 623.9903 626.354 -389 9712.5 618.3647 648.6657 644.0529 644.183 642.9127 632.0826 629.4771 630.1224 623.7083 623.5812 626.0413 -390 9737.5 618.5168 648.5977 643.9052 645.2474 643.2351 631.804 630.3215 629.216 623.5666 624.1424 626.3207 -391 9762.5 618.0275 648.2418 643.6906 643.7616 642.0941 631.4929 629.4654 629.28 622.3514 623.2917 625.2658 -392 9787.5 618.2667 647.3649 643.4853 644.7407 643.2198 632.41 629.6619 630.2525 623.24 623.6723 626.3983 -393 9812.5 618.3468 648.5295 644.1379 643.5131 642.0088 632.3274 628.9454 630.5922 623.2969 624.2035 625.8965 -394 9837.5 618.4358 649.0129 643.9139 644.2854 642.763 631.7873 629.3355 629.2727 623.1277 623.571 625.6473 -395 9862.5 618.1271 647.406 643.7066 642.863 642.0241 632.1009 629.909 629.0679 622.7357 623.1508 626.1223 -396 9887.5 617.9229 647.6817 642.7045 643.7678 642.1103 631.4221 628.8112 628.9842 622.3607 622.786 626.744 -397 9912.5 618.6469 648.8355 643.3469 644.6775 643.2816 631.9663 630.1039 629.7807 623.4054 624.1391 626.7914 -398 9937.5 617.7221 646.9633 642.0548 643.6641 642.0682 631.4566 629.7685 628.4507 622.8747 623.107 626.0303 -399 9962.5 618.2958 648.0546 642.8984 644.578 642.1019 631.8155 629.3374 628.9635 623.1402 622.9276 625.9091 -400 9987.5 618.0993 647.0377 642.5144 644.368 642.0623 631.8915 629.7869 629.003 622.5751 623.6693 625.8073 -401 10012.5 618.1272 647.2462 642.4072 644.4166 641.7524 631.1989 629.263 629.419 622.7052 623.7405 625.7961 -402 10037.5 618.4154 647.6229 643.4176 644.0985 643.03 631.8913 629.5855 630.1053 623.6872 623.5963 626.1135 -403 10062.5 618.5835 648.9072 644.0621 644.5265 642.5212 633.0004 630.1475 629.7055 622.766 624.4352 625.7347 -404 10087.5 618.0216 647.6785 642.9856 643.8038 642.4717 631.2042 629.8713 629.7814 622.5835 623.238 626.5525 -405 10112.5 618.2201 647.6977 643.0132 644.4261 642.548 631.6777 629.1582 629.689 623.3602 623.2825 625.6037 -406 10137.5 618.2251 647.7091 642.9163 643.212 641.877 631.297 629.2489 629.2729 623.52 623.3742 626.0713 -407 10162.5 618.3507 648.5285 643.1431 643.9415 642.2181 631.7845 630.0111 630.0578 622.9511 623.6954 625.783 -408 10187.5 618.1182 647.6229 642.7609 642.9742 641.2529 631.3859 629.7497 629.6435 623.1985 624.1358 625.8631 -409 10212.5 617.9782 647.1648 643.171 643.8479 641.2091 631.2998 628.9912 629.2563 623.5774 623.1912 625.8413 -410 10237.5 617.6732 647.3444 642.3775 642.8249 641.534 630.1176 629.1761 628.7322 622.1397 622.1891 625.0741 -411 10262.5 618.1717 647.6369 643.7163 644.1544 642.0439 631.5784 628.9904 629.7674 622.5278 623.7442 626.3526 -412 10287.5 618.6397 647.2312 643.4321 644.5102 642.5814 632.5985 629.7049 629.5013 624.2129 623.7569 626.4116 -413 10312.5 618.3368 648.2129 643.3842 643.9775 642.4043 631.991 630.7045 628.701 623.5927 624.3752 626.6277 -414 10337.5 618.0742 647.8487 643.1686 643.7808 642.3062 631.3772 629.9242 629.0876 623.2576 623.6289 625.4375 -415 10362.5 617.7497 647.013 641.7815 643.2179 641.4163 630.8726 629.2208 629.2222 622.5629 622.5882 625.5398 -416 10387.5 618.4549 647.6987 643.0436 643.9575 642.4734 631.6887 629.8469 629.3193 623.7414 623.7411 625.8074 -417 10412.5 618.2528 647.8874 643.2693 643.1774 642.4411 631.8712 629.4941 629.2646 623.7571 624.1682 625.9747 -418 10437.5 618.131 647.8884 642.6342 643.031 641.5251 631.7709 629.5714 629.9105 623.192 623.973 625.5489 -419 10462.5 618.3785 647.001 643.1022 643.6928 642.6541 631.5855 629.5517 629.547 622.94 624.0887 626.5947 -420 10487.5 617.9627 647.6881 643.2336 642.816 641.5233 631.1578 628.8576 629.158 622.453 622.9434 625.2868 -421 10512.5 618.729 647.9235 643.2214 643.8734 642.0082 631.4508 630.1806 629.7437 623.5755 623.8893 626.5532 -422 10537.5 617.5241 646.6207 642.648 642.2259 641.1804 630.6105 628.5996 628.8971 621.6964 622.9705 624.9856 -423 10562.5 618.4024 648.6393 642.9753 643.8009 642.6087 632.1996 629.7879 629.7999 623.0841 623.8905 626.3713 -424 10587.5 618.0944 647.4147 642.4924 642.7857 641.5279 632.8795 630.2167 629.3568 622.8895 623.4556 625.6895 -425 10612.5 618.331 647.5699 642.7685 644.1743 641.4024 631.2979 629.5014 628.7688 623.1797 622.6307 626.3287 -426 10637.5 618.2501 648.0763 643.1176 643.3727 641.4119 631.1455 629.911 628.9497 623.8503 623.3407 625.3356 -427 10662.5 618.2344 646.9236 643.4489 643.5155 641.561 631.5596 629.6456 629.5593 623.126 623.1235 625.3179 -428 10687.5 617.8233 646.361 642.6951 643.7252 641.8952 631.7112 628.3871 628.7961 623.5494 623.0217 626.3651 -429 10712.5 617.9861 647.0634 643.0438 642.6142 640.8954 632.15 629.1689 629.1661 622.4247 622.9066 625.6096 -430 10737.5 618.3168 647.869 643.2796 644.0039 642.3156 631.5433 629.3045 629.8434 624.0207 624.1194 625.8442 -431 10762.5 618.2615 648.145 643.1503 644.2762 642.096 631.206 629.7108 629.457 623.3217 623.8368 626.7375 - diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/STRB87_1_bleached.txt b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/STRB87_1_bleached.txt deleted file mode 100644 index a68aff668..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/STRB87_1_bleached.txt +++ /dev/null @@ -1,22 +0,0 @@ -# -------------------------------------------------------------------------------------- -# CURVE FITTING TEST DATASET -# Berger, G.W., Huntley, D.J., 1989. Test data for exponential fits. Ancient TL 7, 43-46. -# -# SAMPLE: STRB87 - 1 (bleached) -# -------------------------------------------------------------------------------------- -0 11814.6 -0 11587.8 -0 11708.6 -1 26645.2 -1 26445.2 -1 26368.6 -2 41487.1 -2 39125.1 -2 40582.5 -4 61532.1 -4 57023.6 -8 93015.8 -8 87907.7 -8 87655.2 -16 107618.3 -16 110394.02 diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/STRB87_1_unbleached.txt b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/STRB87_1_unbleached.txt deleted file mode 100644 index 01b747b73..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/STRB87_1_unbleached.txt +++ /dev/null @@ -1,25 +0,0 @@ -# -------------------------------------------------------------------------------------- -# CURVE FITTING TEST DATASET -# Berger, G.W., Huntley, D.J., 1989. Test data for exponential fits. Ancient TL 7, 43-46. -# -# SAMPLE: STRB87 - 1 (unbbleached) -# -------------------------------------------------------------------------------------- -0 20522.2 -0 19373.6 -0 21040.6 -0 18899.1 -1 50382.5 -1 48570.2 -1 49529.5 -2 77706.6 -2 75291.3 -2 74563.8 -4 111547.5 -4 113899.1 -4 109461.1 -8 164564.9 -8 151504.2 -8 168042.1 -16 204726.5 -16 201964.3 -16 193457.6 diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/TIFFfile.tif b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/TIFFfile.tif deleted file mode 100644 index f259f216a..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/TIFFfile.tif and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/XSYG_file.xsyg b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/XSYG_file.xsyg deleted file mode 100644 index b53ff4d11..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/extdata/XSYG_file.xsyg +++ /dev/null @@ -1,25 +0,0 @@ - - - - - 0.1,6;0.2,6;0.3,5;0.4,5;0.5,3;0.6,5;0.7,0;0.8,2;0.9,10;1,3;1.1,11;1.2,7;1.3,4;1.4,9;1.5,6;1.6,7;1.7,6;1.8,3;1.9,5;2,5;2.1,0;2.2,7;2.3,5;2.4,11;2.5,5;2.6,9;2.7,10;2.8,6;2.9,6;3,1;3.1,7;3.2,5;3.3,4;3.4,1;3.5,4;3.6,3;3.7,5;3.8,7;3.9,3;4,8;4.1,3;4.2,1;4.3,6;4.4,10;4.5,3;4.6,4;4.7,4;4.8,8;4.9,4;5,1;5.1,11;5.2,5;5.3,3;5.4,1;5.5,2;5.6,4;5.7,4;5.8,4;5.9,5;6,4;6.1,6;6.2,3;6.3,3;6.4,2;6.5,8;6.6,7;6.7,4;6.8,3;6.9,6;7,5;7.1,2;7.2,5;7.3,3;7.4,3;7.5,3;7.6,9;7.7,7;7.8,7;7.9,3;8,6;8.1,11;8.2,6;8.3,5;8.4,8;8.5,2;8.6,3;8.7,7;8.8,2;8.9,2;9,4;9.1,6;9.2,6;9.3,2;9.4,5;9.5,9;9.6,6;9.7,7;9.8,3;9.9,4;10,6;10.1,6;10.2,13;10.3,7;10.4,8;10.5,7;10.6,4;10.7,5;10.8,9;10.9,4;11,8;11.1,3;11.2,6;11.3,2;11.4,8;11.5,3;11.6,8;11.7,7;11.8,4;11.9,5;12,5;12.1,5;12.2,6;12.3,4;12.4,1;12.5,5;12.6,1;12.7,3;12.8,4;12.9,12;13,2;13.1,4;13.2,13;13.3,1;13.4,5;13.5,4;13.6,7;13.7,6;13.8,6;13.9,3;14,3;14.1,6;14.2,9;14.3,5;14.4,7;14.5,2;14.6,4;14.7,1;14.8,3;14.9,9;15,8;15.1,4;15.2,2;15.3,8;15.4,4;15.5,7;15.6,9;15.7,3;15.8,7;15.9,4;16,5;16.1,1;16.2,4;16.3,8;16.4,3;16.5,6;16.6,2;16.7,4;16.8,3;16.9,4;17,7;17.1,2;17.2,3;17.3,4;17.4,3;17.5,9;17.6,5;17.7,2;17.8,1;17.9,14;18,2;18.1,1;18.2,4;18.3,6;18.4,6;18.5,11;18.6,11;18.7,10;18.8,4;18.9,5;19,8;19.1,0;19.2,2;19.3,4;19.4,3;19.5,6;19.6,2;19.7,9;19.8,2;19.9,2;20,5;20.1,7;20.2,1;20.3,7;20.4,4;20.5,4;20.6,4;20.7,6;20.8,3;20.9,2;21,4;21.1,4;21.2,6;21.3,6;21.4,5;21.5,5;21.6,2;21.7,10;21.8,4;21.9,7;22,8;22.1,6;22.2,6;22.3,7;22.4,10;22.5,4;22.6,7;22.7,4;22.8,5;22.9,8;23,8;23.1,2;23.2,2;23.3,2;23.4,11;23.5,6;23.6,3;23.7,4;23.8,4;23.9,3;24,5;24.1,10;24.2,4;24.3,2;24.4,3;24.5,6;24.6,6;24.7,6;24.8,10;24.9,3;25,5;25.1,10;25.2,8;25.3,4;25.4,5;25.5,7;25.6,5;25.7,8;25.8,7;25.9,1;26,7;26.1,4;26.2,7;26.3,5;26.4,8;26.5,13;26.6,4;26.7,8;26.8,4;26.9,7;27,6;27.1,9;27.2,2;27.3,8;27.4,5;27.5,6;27.6,10;27.7,3;27.8,10;27.9,12;28,10;28.1,8;28.2,10;28.3,3;28.4,9;28.5,13;28.6,7;28.7,5;28.8,12;28.9,5;29,7;29.1,9;29.2,9;29.3,9;29.4,12;29.5,7;29.6,8;29.7,10;29.8,12;29.9,6;30,13;30.1,11;30.2,7;30.3,14;30.4,18;30.5,18;30.6,18;30.7,20;30.8,19;30.9,19;31,17;31.1,11;31.2,20;31.3,17;31.4,14;31.5,25;31.6,23;31.7,21;31.8,20;31.9,16;32,20;32.1,25;32.2,28;32.3,30;32.4,25;32.5,31;32.6,23;32.7,19;32.8,25;32.9,30;33,36;33.1,31;33.2,29;33.3,30;33.4,40;33.5,35;33.6,34;33.7,47;33.8,43;33.9,45;34,36;34.1,56;34.2,56;34.3,63;34.4,61;34.5,47;34.6,61;34.7,66;34.8,76;34.9,73;35,80;35.1,79;35.2,85;35.3,81;35.4,79;35.5,86;35.6,84;35.7,97;35.8,91;35.9,103;36,112;36.1,112;36.2,105;36.3,107;36.4,128;36.5,117;36.6,139;36.7,146;36.8,156;36.9,151;37,145;37.1,136;37.2,137;37.3,185;37.4,182;37.5,173;37.6,189;37.7,197;37.8,223;37.9,209;38,208;38.1,257;38.2,232;38.3,218;38.4,279;38.5,263;38.6,254;38.7,290;38.8,275;38.9,289;39,330;39.1,328;39.2,309;39.3,353;39.4,361;39.5,361;39.6,353;39.7,338;39.8,413;39.9,400;40,417;40.1,431;40.2,473;40.3,482;40.4,446;40.5,470;40.6,502;40.7,526;40.8,535;40.9,508;41,529;41.1,498;41.2,572;41.3,552;41.4,581;41.5,593;41.6,650;41.7,668;41.8,613;41.9,653;42,680;42.1,659;42.2,729;42.3,715;42.4,798;42.5,765;42.6,742;42.7,773;42.8,852;42.9,834;43,844;43.1,918;43.2,886;43.3,885;43.4,977;43.5,952;43.6,1013;43.7,967;43.8,1043;43.9,1007;44,1005;44.1,1007;44.2,1100;44.3,1094;44.4,1117;44.5,1134;44.6,1220;44.7,1236;44.8,1188;44.9,1254;45,1242;45.1,1299;45.2,1334;45.3,1352;45.4,1406;45.5,1339;45.6,1413;45.7,1439;45.8,1504;45.9,1488;46,1579;46.1,1655;46.2,1643;46.3,1687;46.4,1628;46.5,1725;46.6,1743;46.7,1800;46.8,1831;46.9,1871;47,1870;47.1,1905;47.2,1911;47.3,2007;47.4,2037;47.5,2087;47.6,2133;47.7,2084;47.8,2157;47.9,2195;48,2256;48.1,2190;48.2,2360;48.3,2348;48.4,2260;48.5,2329;48.6,2317;48.7,2340;48.8,2346;48.9,2402;49,2385;49.1,2400;49.2,2419;49.3,2413;49.4,2370;49.5,2468;49.6,2404;49.7,2472;49.8,2405;49.9,2357;50,2423;50.1,2418;50.2,2535;50.3,2503;50.4,2436;50.5,2350;50.6,2484;50.7,2358;50.8,2454;50.9,2286;51,2448;51.1,2422;51.2,2455;51.3,2377;51.4,2305;51.5,2317;51.6,2366;51.7,2329;51.8,2334;51.9,2310;52,2321;52.1,2288;52.2,2250;52.3,2235;52.4,2216;52.5,2221;52.6,2176;52.7,2198;52.8,2123;52.9,2174;53,2219;53.1,2176;53.2,2146;53.3,2113;53.4,2153;53.5,2098;53.6,2093;53.7,2034;53.8,2087;53.9,2081;54,2004;54.1,1998;54.2,1961;54.3,1935;54.4,1895;54.5,1904;54.6,1838;54.7,1843;54.8,1852;54.9,1856;55,1822;55.1,1857;55.2,1766;55.3,1728;55.4,1748;55.5,1777;55.6,1721;55.7,1770;55.8,1669;55.9,1707;56,1685;56.1,1651;56.2,1654;56.3,1652;56.4,1576;56.5,1594;56.6,1566;56.7,1626;56.8,1557;56.9,1592 - 0,25;47,260;57,260;77,60;197,60 - 0.2,27.0804882049561;0.4,27.0798873901367;0.6,27.0809726715088;0.8,27.0831527709961;1,27.079402923584;1.2,27.0986099243164;1.4,27.1498222351074;1.6,27.4493923187256;1.8,27.7364311218262;2,28.1406993865967;2.2,29.3179683685303;2.4,30.0697174072266;2.6,30.8972682952881;2.8,32.6637191772461;3,33.5518417358398;3.2,34.4185752868652;3.4,36.0412330627441;3.6,36.7972145080566;3.8,37.5352096557617;4,38.9637413024902;4.2,39.6741523742676;4.4,40.3962631225586;4.6,41.8783111572266;4.8,42.6388664245605;5,43.4063034057617;5.2,44.9716835021973;5.4,45.7557830810547;5.6,46.534740447998;5.8,48.0852394104004;6,48.8538589477539;6.2,49.6121978759766;6.4,51.1420059204102;6.6,51.8980140686035;6.8,52.6662635803223;7,54.2057876586914;7.2,54.9717025756836;7.4,55.7467079162598;7.6,57.299144744873;7.8,58.0755920410156;8,58.8502769470215;8.2,60.3935203552246;8.4,61.1761207580566;8.6,61.9391098022461;8.8,63.4827728271484;9,64.2569732666016;9.2,65.0282821655273;9.4,66.5849609375;9.6,67.3621063232422;9.8,68.1395645141602;10,69.6889266967773;10.2,70.4668197631836;10.4,71.241340637207;10.6,72.7888565063477;10.8,73.569206237793;11,74.3448333740234;11.2,75.892333984375;11.4,76.6711959838867;11.6,77.4519729614258;11.8,79.0002975463867;12,79.7770538330078;12.2,80.5531387329102;12.4,82.1066741943359;12.6,82.8803253173828;12.8,83.6636352539063;13,85.2125549316406;13.2,85.9880065917969;13.4,86.7693023681641;13.6,88.3218078613281;13.8,89.0941390991211;14,89.8683547973633;14.2,91.4216079711914;14.4,92.1995391845703;14.6,92.979362487793;14.8,94.5301284790039;15,95.3131713867188;15.2,96.0798416137695;15.4,97.6346435546875;15.6,98.4167404174805;15.8,99.1912155151367;16,100.738433837891;16.2,101.516716003418;16.4,102.289123535156;16.6,103.838607788086;16.8,104.619148254395;17,105.393913269043;17.2,106.942420959473;17.4,107.717399597168;17.6,108.493896484375;17.8,110.046989440918;18,110.817626953125;18.2,111.597969055176;18.4,113.14608001709;18.6,113.917327880859;18.8,114.693809509277;19,116.238647460938;19.2,117.017677307129;19.4,117.788551330566;19.6,119.33903503418;19.8,120.111328125;20,120.892349243164;20.2,122.442260742188;20.4,123.205062866211;20.6,123.975341796875;20.8,125.522903442383;21,126.289619445801;21.2,127.067794799805;21.4,128.617599487305;21.6,129.396072387695;21.8,130.169692993164;22,131.714385986328;22.2,132.482055664063;22.4,133.251129150391;22.6,134.79736328125;22.8,135.571197509766;23,136.341293334961;23.2,137.880615234375;23.4,138.646469116211;23.6,139.423828125;23.8,140.970932006836;24,141.745162963867;24.2,142.518051147461;24.4,144.061538696289;24.6,144.825424194336;24.8,145.598175048828;25,147.139190673828;25.2,147.901931762695;25.4,148.677780151367;25.6,150.212387084961;25.8,150.982879638672;26,151.75358581543;26.2,153.292510986328;26.4,154.066223144531;26.6,154.832290649414;26.8,156.379409790039;27,157.139953613281;27.2,157.91096496582;27.4,159.454376220703;27.6,160.217498779297;27.8,160.987350463867;28,162.522369384766;28.2,163.289428710938;28.4,164.056579589844;28.6,165.584976196289;28.8,166.359237670898;29,167.126953125;29.2,168.658935546875;29.4,169.438171386719;29.6,170.199920654297;29.8,171.738403320313;30,172.50244140625;30.2,173.267990112305;30.4,174.79801940918;30.6,175.5595703125;30.8,176.326644897461;31,177.857833862305;31.2,178.626693725586;31.4,179.398071289063;31.6,180.936935424805;31.8,181.697387695313;32,182.463363647461;32.2,183.990783691406;32.4,184.752243041992;32.6,185.516082763672;32.8,187.049896240234;33,187.808700561523;33.2,188.581573486328;33.4,190.114852905273;33.6,190.872268676758;33.8,191.641326904297;34,193.167633056641;34.2,193.924880981445;34.4,194.690124511719;34.6,196.223922729492;34.8,196.992218017578;35,197.74934387207;35.2,199.275482177734;35.4,200.034881591797;35.6,200.803588867188;35.8,202.325668334961;36,203.088180541992;36.2,203.857315063477;36.4,205.385589599609;36.6,206.148376464844;36.8,206.910629272461;37,208.424377441406;37.2,209.183807373047;37.4,209.955673217773;37.6,211.479721069336;37.8,212.24462890625;38,213.007949829102;38.2,214.533065795898;38.4,215.2900390625;38.6,216.052368164063;38.8,217.570816040039;39,218.326766967773;39.2,219.090530395508;39.4,220.613418579102;39.6,221.377105712891;39.8,222.141738891602;40,223.659576416016;40.2,224.421234130859;40.4,225.183578491211;40.6,226.702407836914;40.8,227.457229614258;41,228.221450805664;41.2,229.746429443359;41.4,230.503631591797;41.6,231.264053344727;41.8,232.785171508789;42,233.552597045898;42.2,234.305999755859;42.4,235.822235107422;42.6,236.583145141602;42.8,237.334365844727;43,238.853652954102;43.2,239.620758056641;43.4,240.379119873047;43.6,241.898056030273;43.8,242.660369873047;44,243.413619995117;44.2,244.93571472168;44.4,245.695297241211;44.6,246.450881958008;44.8,247.961395263672;45,248.722198486328;45.2,249.476806640625;45.4,250.992065429688;45.6,251.753646850586;45.8,252.515777587891;46,254.033126831055;46.2,254.793487548828;46.4,255.552825927734;46.6,257.073181152344;46.8,257.824768066406;47,258.58056640625;47.2,260.091033935547;47.4,260.847320556641;47.6,261.493530273438;47.8,262.138610839844;48,262.115509033203;48.2,261.912475585938;48.4,261.2255859375;48.6,260.858612060547;48.8,260.529357910156;49,260.125823974609;49.2,260.076873779297;49.4,260.136444091797;49.6,260.468597412109;49.8,260.676849365234;50,260.878051757813;50.2,261.156524658203;50.4,261.207946777344;50.6,261.216674804688;50.8,261.105773925781;51,261.019134521484;51.2,260.9423828125;51.4,260.819061279297;51.6,260.793029785156;51.8,260.791900634766;52,260.858612060547;52.2,260.905822753906;52.4,260.957702636719;52.6,261.050323486328;52.8,261.079284667969;53,261.092193603516;53.2,261.094604492188;53.4,261.093994140625;53.6,261.075714111328;53.8,261.056945800781;54,261.048553466797;54.2,261.042602539063;54.4,261.053253173828;54.6,261.062683105469;54.8,261.072814941406;55,261.088165283203;55.2,261.101715087891;55.4,261.113525390625;55.6,261.12939453125;55.8,261.126953125;56,261.135833740234;56.2,261.135314941406;56.4,261.128875732422;56.6,261.134704589844;56.8,261.128875732422;57,261.12939453125;57.2,261.134704589844;57.4,261.099945068359;57.6,260.892761230469;57.8,260.446807861328;58,259.040069580078;58.2,258.224456787109;58.4,256.755523681641;58.6,253.193466186523;58.8,251.453521728516;59,249.752563476563;59.2,246.430221557617;59.4,244.806564331055;59.6,243.209350585938;59.8,240.094573974609;60,238.556488037109;60.2,237.046081542969;60.4,234.089981079102;60.6,232.649429321289;60.8,231.218368530273;61,228.399658203125;61.2,227.032424926758;61.4,225.676895141602;61.6,223.024215698242;61.8,221.716033935547;62,220.423355102539;62.2,217.906204223633;62.4,216.662475585938;62.6,215.430816650391;62.8,212.999862670898;63,211.818008422852;63.2,210.635437011719;63.4,208.332061767578;63.6,207.189147949219;63.8,206.061294555664;64,203.851501464844;64.2,202.75505065918;64.4,201.680480957031;64.6,199.544631958008;64.8,198.490310668945;65,197.442199707031;65.2,195.382476806641;65.4,194.368988037109;65.6,193.359420776367;65.8,191.373626708984;66,190.388824462891;66.2,189.414733886719;66.4,187.494064331055;66.6,186.543563842773;66.8,185.606567382813;67,183.743392944336;67.2,182.82405090332;67.4,181.912994384766;67.6,180.105880737305;67.8,179.215347290039;68,178.338424682617;68.2,176.585922241211;68.4,175.719039916992;68.6,174.863342285156;68.8,173.159088134766;69,172.325500488281;69.2,171.495529174805;69.4,169.844390869141;69.6,169.031860351563;69.8,168.223068237305;70,166.627349853516;70.2,165.827835083008;70.4,165.044616699219;70.6,163.475372314453;70.8,162.702651977539;71,161.936935424805;71.2,160.411987304688;71.4,159.660614013672;71.6,158.900985717773;71.8,157.422973632813;72,156.683319091797;72.2,155.945175170898;72.4,154.504684448242;72.6,153.785354614258;72.8,153.069152832031;73,151.66162109375;73.2,150.967590332031;73.4,150.26628112793;73.6,148.895736694336;73.8,148.216705322266;74,147.534896850586;74.2,146.172744750977;74.4,145.513717651367;74.6,144.855392456055;74.8,143.533325195313;75,142.88916015625;75.2,142.232864379883;75.4,140.955703735352;75.6,140.318008422852;75.8,139.690628051758;76,138.439239501953;76.2,137.815124511719;76.4,137.202072143555;76.6,135.979049682617;76.8,135.376571655273;77,134.767471313477;77.2,133.564407348633;77.4,132.979965209961;77.6,132.38737487793;77.8,131.223968505859;78,130.640701293945;78.2,130.053131103516;78.4,128.916748046875;78.6,128.349349975586;78.8,127.783264160156;79,126.668235778809;79.2,126.114944458008;79.4,125.563949584961;79.6,124.461952209473;79.8,123.927589416504;80,123.386833190918;80.2,122.321189880371;80.4,121.794692993164;80.6,121.26774597168;80.8,120.214950561523;81,119.701385498047;81.2,119.188995361328;81.4,118.16577911377;81.6,117.657684326172;81.8,117.153617858887;82,116.160949707031;82.2,115.662902832031;82.4,115.173240661621;82.6,114.19718170166;82.8,113.712287902832;83,113.228805541992;83.2,112.279266357422;83.4,111.799919128418;83.6,111.335151672363;83.8,110.401062011719;84,109.93384552002;84.2,109.475608825684;84.4,108.56623840332;84.6,108.111137390137;84.8,107.660675048828;85,106.757667541504;85.2,106.318016052246;85.4,105.877777099609;85.6,105.000068664551;85.8,104.577430725098;86,104.13655090332;86.2,103.279029846191;86.4,102.856719970703;86.6,102.432334899902;86.8,101.588821411133;87,101.180786132813;87.2,100.758453369141;87.4,99.9411315917969;87.6,99.5317993164063;87.8,99.126823425293;88,98.3296432495117;88.2,97.9283752441406;88.4,97.5387878417969;88.6,96.7560195922852;88.8,96.3656845092773;89,95.9857482910156;89.2,95.2189788818359;89.4,94.8394241333008;89.6,94.453857421875;89.8,93.7114715576172;90,93.3393478393555;90.2,92.9710845947266;90.4,92.2304916381836;90.6,91.8669128417969;90.8,91.5017547607422;91,90.786979675293;91.2,90.4297180175781;91.4,90.0780181884766;91.6,89.3754730224609;91.8,89.0322799682617;92,88.686393737793;92.2,87.9870910644531;92.4,87.6550979614258;92.6,87.3139038085938;92.8,86.6430816650391;93,86.3086242675781;93.2,85.9720001220703;93.4,85.3243255615234;93.6,84.9928359985352;93.8,84.6707305908203;94,84.0191116333008;94.2,83.7049789428711;94.4,83.3874282836914;94.6,82.7576904296875;94.8,82.4469833374023;95,82.1352081298828;95.2,81.5245208740234;95.4,81.2173767089844;95.6,80.9107437133789;95.8,80.3119659423828;96,80.0120468139648;96.2,79.7183074951172;96.4,79.1320114135742;96.6,78.8399353027344;96.8,78.5524520874023;97,77.9741058349609;97.2,77.6871719360352;97.4,77.4086151123047;97.6,76.8514633178711;97.8,76.5680618286133;98,76.2945175170898;98.2,75.7460098266602;98.4,75.472038269043;98.6,75.2009201049805;98.8,74.6652297973633;99,74.3968658447266;99.2,74.132453918457;99.4,73.6074829101563;99.6,73.3448486328125;99.8,73.0854263305664;100,72.5733871459961;100.2,72.3168411254883;100.4,72.0712356567383;100.6,71.5643768310547;100.8,71.3123168945313;101,71.0647048950195;101.2,70.5778656005859;101.4,70.3347015380859;101.6,70.0816421508789;101.8,69.6113662719727;102,69.3711090087891;102.2,69.1319580078125;102.4,68.6619338989258;102.6,68.4288482666016;102.8,68.1968841552734;103,67.7358093261719;103.2,67.507698059082;103.4,67.2813034057617;103.6,66.8351745605469;103.8,66.6088256835938;104,66.3952331542969;104.2,65.9519195556641;104.4,65.7383651733398;104.6,65.5165023803711;104.8,65.0887298583984;105,64.876335144043 - - - 30.1,2263;30.2,2328;30.3,2229;30.4,2069;30.5,2142;30.6,1923;30.7,1812;30.8,1858;30.9,1698;31,1660;31.1,1584;31.2,1537;31.3,1457;31.4,1388;31.5,1322;31.6,1331;31.7,1260;31.8,1208;31.9,1146;32,1103;32.1,1123;32.2,1033;32.3,1004;32.4,1091;32.5,953;32.6,961;32.7,876;32.8,877;32.9,885;33,859;33.1,775;33.2,796;33.3,731;33.4,735;33.5,740;33.6,733;33.7,710;33.8,681;33.9,670;34,608;34.1,625;34.2,630;34.3,617;34.4,584;34.5,567;34.6,530;34.7,570;34.8,553;34.9,476;35,503;35.1,517;35.2,513;35.3,472;35.4,470;35.5,477;35.6,418;35.7,491;35.8,461;35.9,435;36,404;36.1,424;36.2,391;36.3,423;36.4,410;36.5,426;36.6,389;36.7,358;36.8,372;36.9,354;37,406;37.1,366;37.2,374;37.3,358;37.4,338;37.5,365;37.6,355;37.7,372;37.8,379;37.9,358;38,338;38.1,363;38.2,371;38.3,369;38.4,323;38.5,324;38.6,321;38.7,360;38.8,321;38.9,297;39,295;39.1,336;39.2,293;39.3,283;39.4,301;39.5,304;39.6,287;39.7,295;39.8,298;39.9,332;40,305;40.1,284;40.2,319;40.3,292;40.4,274;40.5,289;40.6,286;40.7,254;40.8,288;40.9,258;41,271;41.1,285;41.2,283;41.3,299;41.4,283;41.5,316;41.6,266;41.7,286;41.8,282;41.9,292;42,269;42.1,269;42.2,277;42.3,288;42.4,312;42.5,247;42.6,260;42.7,273;42.8,265;42.9,256;43,272;43.1,259;43.2,231;43.3,287;43.4,268;43.5,247;43.6,267;43.7,258;43.8,257;43.9,279;44,277;44.1,278;44.2,283;44.3,267;44.4,249;44.5,247;44.6,253;44.7,256;44.8,256;44.9,281;45,246;45.1,232;45.2,221;45.3,263;45.4,233;45.5,251;45.6,282;45.7,257;45.8,245;45.9,228;46,263;46.1,240;46.2,263;46.3,236;46.4,269;46.5,261;46.6,252;46.7,251;46.8,224;46.9,210;47,251;47.1,252;47.2,250;47.3,255;47.4,254;47.5,228;47.6,241;47.7,266;47.8,264;47.9,257;48,237;48.1,222;48.2,243;48.3,248;48.4,221;48.5,263;48.6,233;48.7,239;48.8,252;48.9,232;49,250;49.1,235;49.2,230;49.3,236;49.4,255;49.5,248;49.6,212;49.7,234;49.8,238;49.9,265;50,256;50.1,245;50.2,241;50.3,237;50.4,244;50.5,242;50.6,228;50.7,225;50.8,214;50.9,240;51,248;51.1,255;51.2,231;51.3,202;51.4,235;51.5,220;51.6,239;51.7,253;51.8,281;51.9,247;52,215;52.1,230;52.2,214;52.3,254;52.4,220;52.5,256;52.6,259;52.7,246;52.8,234;52.9,218;53,204;53.1,233;53.2,227;53.3,236;53.4,229;53.5,225;53.6,222;53.7,236;53.8,247;53.9,228;54,234;54.1,256;54.2,265;54.3,240;54.4,240;54.5,230;54.6,240;54.7,236;54.8,229;54.9,200;55,219;55.1,220;55.2,221;55.3,212;55.4,224;55.5,235;55.6,220;55.7,242;55.8,247;55.9,222;56,228;56.1,239;56.2,226;56.3,213;56.4,218;56.5,247;56.6,236;56.7,227;56.8,235;56.9,238;57,192;57.1,247;57.2,228;57.3,220;57.4,243;57.5,225;57.6,226;57.7,235;57.8,200;57.9,237;58,200;58.1,223;58.2,227;58.3,214;58.4,193;58.5,221;58.6,225;58.7,226;58.8,238;58.9,267;59,236;59.1,233;59.2,222;59.3,210;59.4,226;59.5,209;59.6,220;59.7,215;59.8,239;59.9,224;60,259;60.1,236;60.2,240;60.3,226;60.4,237;60.5,213;60.6,218;60.7,234;60.8,220;60.9,219;61,201;61.1,235;61.2,196;61.3,202;61.4,216;61.5,198;61.6,229;61.7,249;61.8,211;61.9,225;62,224;62.1,204;62.2,214;62.3,213;62.4,209;62.5,201;62.6,212;62.7,219;62.8,216;62.9,191;63,245;63.1,209;63.2,244;63.3,229;63.4,224;63.5,211;63.6,226;63.7,227;63.8,221;63.9,228;64,229;64.1,242;64.2,218;64.3,198;64.4,207;64.5,216;64.6,209;64.7,239;64.8,241;64.9,220;65,196;65.1,211;65.2,239;65.3,226;65.4,219;65.5,238;65.6,226;65.7,246;65.8,231;65.9,253;66,220;66.1,209;66.2,206;66.3,209;66.4,215;66.5,220;66.6,220;66.7,216;66.8,242;66.9,211;67,224;67.1,232;67.2,226;67.3,239;67.4,232;67.5,222;67.6,238;67.7,235;67.8,218;67.9,226;68,223;68.1,196;68.2,223;68.3,225;68.4,237;68.5,236;68.6,215;68.7,203;68.8,229;68.9,223;69,214;69.1,213;69.2,207;69.3,229;69.4,222;69.5,210;69.6,226;69.7,224;69.8,222;69.9,241;70,228;70.1,220;70.2,224;70.3,226;70.4,229;70.5,213;70.6,207;70.7,236;70.8,218;70.9,213;71,206;71.1,212;71.2,219;71.3,213;71.4,215;71.5,207;71.6,231;71.7,201;71.8,238;71.9,213;72,232;72.1,223;72.2,242;72.3,185;72.4,229;72.5,212;72.6,228;72.7,183;72.8,216;72.9,224;73,200;73.1,229;73.2,193;73.3,233;73.4,206;73.5,218;73.6,194;73.7,217;73.8,226;73.9,214;74,198;74.1,228;74.2,226;74.3,227;74.4,217;74.5,230;74.6,212;74.7,222;74.8,230;74.9,218;75,205;75.1,239;75.2,201;75.3,218;75.4,215;75.5,208;75.6,198;75.7,208;75.8,233;75.9,199;76,231;76.1,226;76.2,191;76.3,219;76.4,193;76.5,223;76.6,216;76.7,236;76.8,230;76.9,217;77,223;77.1,211;77.2,247;77.3,204;77.4,232;77.5,260;77.6,237;77.7,219;77.8,215;77.9,225;78,224;78.1,225;78.2,226;78.3,228;78.4,243;78.5,235;78.6,190;78.7,221;78.8,191;78.9,237;79,191;79.1,229;79.2,213;79.3,214;79.4,213;79.5,245;79.6,218;79.7,245;79.8,220;79.9,214;80,222;80.1,201;80.2,231;80.3,243;80.4,230;80.5,205;80.6,245;80.7,220;80.8,215;80.9,220;81,209;81.1,242;81.2,240;81.3,212;81.4,196;81.5,212;81.6,221;81.7,202;81.8,247;81.9,211;82,237;82.1,212;82.2,208;82.3,211;82.4,219;82.5,205;82.6,223;82.7,224;82.8,209;82.9,218;83,223;83.1,228;83.2,250;83.3,228;83.4,211;83.5,210;83.6,216;83.7,183;83.8,219;83.9,203;84,205;84.1,210;84.2,191;84.3,206;84.4,197;84.5,212;84.6,242;84.7,211;84.8,218;84.9,223;85,209;85.1,209;85.2,200;85.3,190;85.4,234;85.5,200;85.6,198;85.7,227;85.8,202;85.9,229;86,213;86.1,248;86.2,219;86.3,213;86.4,213;86.5,197;86.6,221;86.7,223;86.8,220;86.9,216;87,207;87.1,230;87.2,200;87.3,232;87.4,208;87.5,222;87.6,170;87.7,231;87.8,202;87.9,225;88,238;88.1,213;88.2,192;88.3,212;88.4,206;88.5,225;88.6,202;88.7,247;88.8,204;88.9,206;89,189;89.1,224;89.2,217;89.3,227;89.4,222;89.5,214;89.6,196;89.7,250;89.8,214;89.9,216;90,214;90.1,231;90.2,206;90.3,223;90.4,221;90.5,200;90.6,200;90.7,243;90.8,199;90.9,215;91,218;91.1,187;91.2,200;91.3,244;91.4,213;91.5,213;91.6,201;91.7,203;91.8,195;91.9,224;92,222;92.1,197;92.2,228;92.3,220;92.4,210;92.5,185;92.6,202;92.7,188;92.8,233;92.9,220;93,204;93.1,237;93.2,241;93.3,225;93.4,233;93.5,223;93.6,220;93.7,212;93.8,196;93.9,228;94,198;94.1,191;94.2,189;94.3,184;94.4,224;94.5,218;94.6,224;94.7,198;94.8,216;94.9,193;95,204;95.1,223;95.2,197;95.3,223;95.4,186;95.5,205;95.6,221;95.7,240;95.8,173;95.9,240;96,230;96.1,201;96.2,219;96.3,234;96.4,222;96.5,235;96.6,221;96.7,214;96.8,207;96.9,196;97,206;97.1,202;97.2,200;97.3,194;97.4,195;97.5,232;97.6,207;97.7,224;97.8,226;97.9,221;98,198;98.1,209;98.2,217;98.3,192;98.4,198;98.5,198;98.6,214;98.7,208;98.8,215;98.9,201;99,219;99.1,216;99.2,211;99.3,215;99.4,207;99.5,212;99.6,255;99.7,223;99.8,220;99.9,228;100,226;100.1,228;100.2,183;100.3,204;100.4,222;100.5,216;100.6,207;100.7,228;100.8,231;100.9,213;101,217;101.1,199;101.2,206;101.3,231;101.4,208;101.5,210;101.6,197;101.7,225;101.8,197;101.9,219;102,212;102.1,223;102.2,212;102.3,219;102.4,218;102.5,210;102.6,203;102.7,215;102.8,217;102.9,217;103,224;103.1,227;103.2,210;103.3,202;103.4,240;103.5,208;103.6,206;103.7,237;103.8,217;103.9,219;104,216;104.1,216;104.2,210;104.3,229;104.4,201;104.5,216;104.6,212;104.7,200;104.8,191;104.9,203;105,201;105.1,193;105.2,214;105.3,208;105.4,217;105.5,191;105.6,205;105.7,230;105.8,201;105.9,205;106,204;106.1,233;106.2,202;106.3,230;106.4,215;106.5,206;106.6,232;106.7,214;106.8,196;106.9,200;107,238;107.1,184;107.2,225;107.3,221;107.4,198;107.5,191;107.6,225;107.7,218;107.8,222;107.9,237;108,226;108.1,199;108.2,206;108.3,207;108.4,210;108.5,194;108.6,203;108.7,206;108.8,187;108.9,201;109,238;109.1,210;109.2,215;109.3,179;109.4,223;109.5,198;109.6,204;109.7,230;109.8,214;109.9,205;110,201;110.1,200;110.2,214;110.3,225;110.4,206;110.5,217;110.6,199;110.7,210;110.8,205;110.9,190;111,219;111.1,213;111.2,183;111.3,224;111.4,195;111.5,191;111.6,207;111.7,197;111.8,195;111.9,214;112,198;112.1,232;112.2,232;112.3,215;112.4,219;112.5,217;112.6,214;112.7,194;112.8,194;112.9,207;113,208;113.1,202;113.2,206;113.3,200;113.4,216;113.5,219;113.6,214;113.7,193;113.8,229;113.9,205;114,176;114.1,183;114.2,199;114.3,219;114.4,210;114.5,209;114.6,216;114.7,210;114.8,212;114.9,219;115,212;115.1,193;115.2,178;115.3,231;115.4,182;115.5,200;115.6,207;115.7,182;115.8,206;115.9,214;116,201;116.1,186;116.2,195;116.3,231;116.4,217;116.5,219;116.6,204;116.7,210;116.8,211;116.9,219;117,215;117.1,214;117.2,215;117.3,215;117.4,205;117.5,173;117.6,198;117.7,202;117.8,224;117.9,215;118,212;118.1,211;118.2,212;118.3,215;118.4,235;118.5,227;118.6,204;118.7,220;118.8,235;118.9,203;119,198;119.1,199;119.2,209;119.3,216;119.4,193;119.5,204;119.6,221;119.7,226;119.8,218;119.9,197;120,215;120.1,191;120.2,212;120.3,180;120.4,233;120.5,202;120.6,210;120.7,206;120.8,220;120.9,197;121,202;121.1,197;121.2,225;121.3,220;121.4,190;121.5,181;121.6,216;121.7,185;121.8,231;121.9,202;122,228;122.1,218;122.2,198;122.3,180;122.4,208;122.5,200;122.6,218;122.7,207;122.8,213;122.9,201;123,182;123.1,189;123.2,219;123.3,208;123.4,229;123.5,190;123.6,209;123.7,227;123.8,208;123.9,217;124,232;124.1,205;124.2,201;124.3,216;124.4,230;124.5,192;124.6,224;124.7,185;124.8,204;124.9,209;125,208;125.1,216;125.2,210;125.3,217;125.4,226;125.5,207;125.6,209;125.7,215;125.8,202;125.9,215;126,215;126.1,228;126.2,234;126.3,215;126.4,182;126.5,237;126.6,217;126.7,194;126.8,180;126.9,198;127,217;127.1,187;127.2,221;127.3,238;127.4,225;127.5,210;127.6,188;127.7,192;127.8,210;127.9,216;128,201;128.1,197;128.2,198;128.3,205;128.4,215;128.5,235;128.6,224;128.7,217;128.8,197;128.9,195;129,208;129.1,187;129.2,197;129.3,209;129.4,181;129.5,234;129.6,201;129.7,223;129.8,222;129.9,209 - 0,25;20,125;130,125;136,60;256,60 - 0.2,39.7064247131348;0.4,39.6876220703125;0.6,39.6655387878418;0.8,39.6451530456543;1,39.6338691711426;1.2,39.6161575317383;1.4,39.5904350280762;1.6,39.5738143920898;1.8,39.556583404541;2,39.5318374633789;2.2,39.5103645324707;2.4,39.5028419494629;2.6,39.4786987304688;2.8,39.4873123168945;3,39.5404472351074;3.2,39.8584518432617;3.4,40.1625366210938;3.6,40.5810928344727;3.8,41.7658767700195;4,42.4898452758789;4.2,43.2938079833984;4.4,44.9959945678711;4.6,45.8377342224121;4.8,46.6636543273926;5,48.2162895202637;5.2,48.9440460205078;5.4,49.6450691223145;5.6,51.017650604248;5.8,51.7064933776855;6,52.3967132568359;6.2,53.8201637268066;6.4,54.5556182861328;6.6,55.2924613952637;6.8,56.7957305908203;7,57.5503349304199;7.2,58.3024253845215;7.4,59.8001937866211;7.6,60.5326728820801;7.8,61.2675323486328;8,62.737133026123;8.2,63.4740943908691;8.4,64.2151336669922;8.6,65.7017669677734;8.8,66.450798034668;9,67.1968231201172;9.2,68.6919555664063;9.4,69.4382476806641;9.6,70.182746887207;9.8,71.6857528686523;10,72.4256057739258;10.2,73.1812210083008;10.4,74.6761474609375;10.6,75.4326400756836;10.8,76.1799697875977;11,77.6811447143555;11.2,78.4361114501953;11.4,79.1841201782227;11.6,80.6909408569336;11.8,81.4454574584961;12,82.1952209472656;12.2,83.6999206542969;12.4,84.4549942016602;12.6,85.2054138183594;12.8,86.7225036621094;13,87.469841003418;13.2,88.2296524047852;13.4,89.7452239990234;13.6,90.4993591308594;13.8,91.2458877563477;14,92.75830078125;14.2,93.5157852172852;14.4,94.2712097167969;14.6,95.7909240722656;14.8,96.5478134155273;15,97.3038635253906;15.2,98.8213806152344;15.4,99.567756652832;15.6,100.331108093262;15.8,101.834899902344;16,102.600677490234;16.2,103.362907409668;16.4,104.876678466797;16.6,105.636390686035;16.8,106.397003173828;17,107.916793823242;17.2,108.66707611084;17.4,109.427169799805;17.6,110.941955566406;17.8,111.700622558594;18,112.455581665039;18.2,113.973770141602;18.4,114.73511505127;18.6,115.495742797852;18.8,117.019912719727;19,117.777381896973;19.2,118.536209106445;19.4,120.050338745117;19.6,120.807106018066;19.8,121.569854736328;20,123.083839416504;20.2,123.846885681152;20.4,124.608947753906;20.6,125.848709106445;20.8,126.18286895752;21,126.311019897461;21.2,126.139694213867;21.4,125.937522888184;21.6,125.715599060059;21.8,125.316909790039;22,125.183181762695;22.2,125.107444763184;22.4,125.087791442871;22.6,125.146751403809;22.8,125.22200012207;23,125.394401550293;23.2,125.47688293457;23.4,125.541557312012;23.6,125.628517150879;23.8,125.649917602539;24,125.65998840332;24.2,125.668441772461;24.4,125.65998840332;24.6,125.666709899902;24.8,125.675788879395;25,125.686981201172;25.2,125.700416564941;25.4,125.73127746582;25.6,125.748191833496;25.8,125.767845153809;26,125.802673339844;26.2,125.81275177002;26.4,125.83464050293;26.6,125.861022949219;26.8,125.871726989746;27,125.884658813477;27.2,125.902076721191;27.4,125.914886474609;27.6,125.920608520508;27.8,125.945373535156;28,125.946487426758;28.2,125.964401245117;28.4,125.975601196289;28.6,125.986801147461;28.8,125.995880126953;29,126.010437011719;29.2,126.0205078125;29.4,126.028350830078;29.6,126.042419433594;29.8,126.052612304688;30,126.057586669922;30.2,126.069396972656;30.4,126.080101013184;30.6,126.082344055176;30.8,126.086822509766;31,126.097511291504;31.2,126.106483459473;31.4,126.116058349609;31.6,126.115432739258;31.8,126.126136779785;32,126.133979797363;32.2,126.135215759277;32.4,126.139068603516;32.6,126.144668579102;32.8,126.146911621094;33,126.155990600586;33.2,126.160980224609;33.4,126.155990600586;33.6,126.168312072754;33.8,126.173408508301;34,126.17391204834;34.2,126.177276611328;34.4,126.17552947998;34.6,126.177276611328;34.8,126.183486938477;35,126.185722351074;35.2,126.189582824707;35.4,126.190208435059;35.6,126.196426391602;35.8,126.195808410645;36,126.187973022461;36.2,126.183486938477;36.4,126.185104370117;36.6,126.18684387207;36.8,126.183990478516;37,126.189582824707;37.2,126.183486938477;37.4,126.189094543457;37.6,126.190826416016;37.8,126.188461303711;38,126.187339782715;38.2,126.194068908691;38.4,126.181747436523;38.6,126.180122375488;38.8,126.180625915527;39,126.173408508301;39.2,126.17839050293;39.4,126.17391204834;39.6,126.171051025391;39.8,126.16943359375;40,126.16495513916;40.2,126.16047668457;40.4,126.15648651123;40.6,126.15648651123;40.8,126.15648651123;41,126.153625488281;41.2,126.15251159668;41.4,126.151390075684;41.6,126.145301818848;41.8,126.137954711914;42,126.131851196289;42.2,126.13346862793;42.4,126.129005432129;42.6,126.127891540527;42.8,126.119422912598;43,126.113319396973;43.2,126.112075805664;43.4,126.105361938477;43.6,126.101997375488;43.8,126.103622436523;44,126.093536376953;44.2,126.08967590332;44.4,126.087440490723;44.6,126.081230163574;44.8,126.072265625;45,126.073883056641;45.2,126.063804626465;45.4,126.056587219238;45.6,126.055961608887;45.8,126.051986694336;46,126.047004699707;46.2,126.044769287109;46.4,126.038558959961;46.6,126.032455444336;46.8,126.028350830078;47,126.020027160645;47.2,126.017272949219;47.4,126.017768859863;47.6,126.009323120117;47.8,126.00658416748;48,125.997001647949;48.2,125.992515563965;48.4,125.98518371582;48.6,125.97908782959;48.8,125.971618652344;49,125.974479675293;49.2,125.96216583252;49.4,125.955940246582;49.6,125.95482635498;49.8,125.957061767578;50,125.948112487793;50.2,125.939643859863;50.4,125.936904907227;50.6,125.927963256836;50.8,125.919990539551;51,125.917259216309;51.2,125.906555175781;51.4,125.908790588379;51.6,125.901458740234;51.8,125.891998291016;52,125.891372680664;52.2,125.885284423828;52.4,125.877319335938;52.6,125.873458862305;52.8,125.869483947754;53,125.86164855957;53.2,125.854927062988;53.4,125.849822998047;53.6,125.843109130859;53.8,125.840873718262;54,125.83576965332;54.2,125.829048156738;54.4,125.823455810547;54.6,125.816101074219;54.8,125.813369750977;55,125.804916381836;55.2,125.802673339844;55.4,125.798202514648;55.6,125.789115905762;55.8,125.784141540527;56,125.779663085938;56.2,125.77742767334;56.4,125.77294921875;56.6,125.755523681641;56.8,125.758758544922;57,125.751541137695;57.2,125.74259185791;57.4,125.744201660156;57.6,125.731887817383;57.8,125.731887817383;58,125.734634399414;58.2,125.727905273438;58.4,125.714477539063;58.6,125.712242126465;58.8,125.707138061523;59,125.70092010498;59.2,125.696563720703;59.4,125.694816589355;59.6,125.680267333984;59.8,125.678031921387;60,125.678031921387;60.2,125.671188354492;60.4,125.665588378906;60.6,125.665588378906;60.8,125.651519775391;61,125.647674560547;61.2,125.645927429199;61.4,125.635231018066;61.6,125.627395629883;61.8,125.627395629883;62,125.626281738281;62.2,125.624664306641;62.4,125.620185852051;62.6,125.606628417969;62.8,125.602638244629;63,125.606628417969;63.2,125.594306945801;63.4,125.588706970215;63.6,125.58423614502;63.8,125.582489013672;64,125.579132080078;64.2,125.583602905273;64.4,125.571296691895;64.6,125.563331604004;64.8,125.560592651367;65,125.557235717773;65.2,125.548774719238;65.4,125.545913696289;65.6,125.542678833008;65.8,125.539825439453;66,125.530853271484;66.2,125.527503967285;66.4,125.521789550781;66.6,125.52352142334;66.8,125.518424987793;67,125.51456451416;67.2,125.508964538574;67.4,125.503868103027;67.6,125.496658325195;67.8,125.500511169434;68,125.497650146484;68.2,125.483093261719;68.4,125.483093261719;68.6,125.476379394531;68.8,125.47688293457;69,125.47127532959;69.2,125.462326049805;69.4,125.465682983398;69.6,125.467926025391;69.8,125.455604553223;70,125.454986572266;70.2,125.450004577637;70.4,125.447769165039;70.6,125.438194274902;70.8,125.43147277832;71,125.430847167969;71.2,125.429229736328;71.4,125.424125671387;71.6,125.417419433594;71.8,125.42015838623;72,125.41854095459;72.2,125.414558410645;72.4,125.401741027832;72.6,125.407341003418;72.8,125.398384094238;73,125.394401550293;73.2,125.396026611328;73.4,125.390419006348;73.6,125.391052246094;73.8,125.380348205566;74,125.376365661621;74.2,125.375862121582;74.4,125.371887207031;74.6,125.371887207031;74.8,125.36629486084;75,125.370269775391;75.2,125.358955383301;75.4,125.356216430664;75.6,125.351119995117;75.8,125.351737976074;76,125.342651367188;76.2,125.345024108887;76.4,125.34440612793;76.6,125.340545654297;76.8,125.334815979004;77,125.329216003418;77.2,125.330963134766;77.4,125.324119567871;77.6,125.322006225586;77.8,125.323623657227;78,125.318023681641;78.2,125.314170837402;78.4,125.309074401855;78.6,125.309074401855;78.8,125.306205749512;79,125.30509185791;79.2,125.30347442627;79.4,125.293266296387;79.6,125.297752380371;79.8,125.292785644531;80,125.2900390625;80.2,125.286552429199;80.4,125.282585144043;80.6,125.284942626953;80.8,125.278228759766;81,125.274238586426;81.2,125.269760131836;81.4,125.27075958252;81.6,125.263046264648;81.8,125.266906738281;82,125.260810852051;82.2,125.265289306641;82.4,125.26180267334;82.6,125.260810852051;82.8,125.251724243164;83,125.257942199707;83.2,125.24340057373;83.4,125.249488830566;83.6,125.247253417969;83.8,125.24227142334;84,125.241653442383;84.2,125.237174987793;84.4,125.237174987793;84.6,125.236549377441;84.8,125.228713989258;85,125.229965209961;85.2,125.229347229004;85.4,125.221382141113;85.6,125.22200012207;85.8,125.219261169434;86,125.212417602539;86.2,125.221382141113;86.4,125.215278625488;86.6,125.215278625488;86.8,125.210678100586;87,125.209060668945;87.2,125.205207824707;87.4,125.200736999512;87.6,125.201225280762;87.8,125.205841064453;88,125.206321716309;88.2,125.196754455566;88.4,125.192764282227;88.6,125.191650390625;88.8,125.188911437988;89,125.186050415039;89.2,125.186553955078;89.4,125.185554504395;89.6,125.184936523438;89.8,125.181579589844;90,125.187797546387;90.2,125.179832458496;90.4,125.17374420166;90.6,125.17423248291;90.8,125.171997070313;91,125.169761657715;91.2,125.166397094727;91.4,125.164161682129;91.6,125.167526245117;91.8,125.163047790527;92,125.165908813477;92.2,125.158073425293;92.4,125.163047790527;92.6,125.165283203125;92.8,125.160804748535;93,125.158561706543;93.2,125.154586791992;93.4,125.153465270996;93.6,125.15682220459;93.8,125.154586791992;94,125.146751403809;94.2,125.147369384766;94.4,125.141151428223;94.6,125.14338684082;94.8,125.144020080566;95,125.140029907227;95.2,125.13493347168;95.4,125.141151428223;95.6,125.138916015625;95.8,125.138290405273;96,125.136672973633;96.2,125.133316040039;96.4,125.133316040039;96.6,125.12996673584;96.8,125.12996673584;97,125.129333496094;97.2,125.131080627441;97.4,125.12996673584;97.6,125.124855041504;97.8,125.12149810791;98,125.117515563965;98.2,125.12149810791;98.4,125.117515563965;98.6,125.119262695313;98.8,125.115905761719;99,125.118141174316;99.2,125.115409851074;99.4,125.109680175781;99.6,125.118644714355;99.8,125.110801696777;100,125.111923217773;100.2,125.112548828125;100.4,125.105827331543;100.6,125.106941223145;100.8,125.109680175781;101,125.101348876953;101.2,125.098991394043;101.4,125.100723266602;101.6,125.098991394043;101.8,125.098991394043;102,125.09561920166;102.2,125.092887878418;102.4,125.096252441406;102.6,125.104705810547;102.8,125.096870422363;103,125.096252441406;103.2,125.088287353516;103.4,125.092399597168;103.6,125.09065246582;103.8,125.09065246582;104,125.096252441406;104.2,125.090034484863;104.4,125.094017028809;104.6,125.084434509277;104.8,125.084434509277;105,125.081703186035;105.2,125.08219909668;105.4,125.08219909668;105.6,125.083320617676;105.8,125.077713012695;106,125.077713012695;106.2,125.085556030273;106.4,125.080581665039;106.6,125.08219909668;106.8,125.081085205078;107,125.077713012695;107.2,125.08381652832;107.4,125.078826904297;107.6,125.073860168457;107.8,125.077224731445;108,125.070999145508;108.2,125.070381164551;108.4,125.072120666504;108.6,125.069877624512;108.8,125.075981140137;109,125.070381164551;109.2,125.072120666504;109.4,125.064155578613;109.6,125.068145751953;109.8,125.072120666504;110,125.068145751953;110.2,125.061424255371;110.4,125.063659667969;110.6,125.067024230957;110.8,125.067024230957;111,125.068145751953;111.2,125.057441711426;111.4,125.061424255371;111.6,125.056945800781;111.8,125.062049865723;112,125.064155578613;112.2,125.062049865723;112.4,125.050231933594;112.6,125.054206848145;112.8,125.056945800781;113,125.062538146973;113.2,125.058067321777;113.4,125.057441711426;113.6,125.05135345459;113.8,125.050727844238;114,125.050231933594;114.2,125.056449890137;114.4,125.055824279785;114.6,125.052467346191;114.8,125.050231933594;115,125.053588867188;115.2,125.046875;115.4,125.048492431641;115.6,125.047370910645;115.8,125.047988891602;116,125.047370910645;116.2,125.050727844238;116.4,125.048492431641;116.6,125.05135345459;116.8,125.047988891602;117,125.047988891602;117.2,125.04288482666;117.4,125.047988891602;117.6,125.047988891602;117.8,125.045753479004;118,125.045127868652;118.2,125.044013977051;118.4,125.047370910645;118.6,125.046875;118.8,125.040649414063;119,125.040649414063;119.2,125.038414001465;119.4,125.034439086914;119.6,125.045127868652;119.8,125.03678894043;120,125.03678894043;120.2,125.045127868652;120.4,125.044639587402;120.6,125.041282653809;120.8,125.036178588867;121,125.037300109863;121.2,125.033317565918;121.4,125.038414001465;121.6,125.041282653809;121.8,125.033935546875;122,125.035057067871;122.2,125.031700134277;122.4,125.035057067871;122.6,125.03231048584;122.8,125.033317565918;123,125.034439086914;123.2,125.03231048584;123.4,125.033935546875;123.6,125.034439086914;123.8,125.03231048584;124,125.03108215332;124.2,125.03231048584;124.4,125.033317565918;124.6,125.02995300293;124.8,125.025482177734;125,125.026596069336;125.2,125.032821655273;125.4,125.033317565918;125.6,125.034439086914;125.8,125.034439086914;126,125.031700134277;126.2,125.03231048584;126.4,125.027221679688;126.6,125.027221679688;126.8,125.027717590332;127,125.027717590332;127.2,125.027717590332;127.4,125.027221679688;127.6,125.027717590332;127.8,125.033317565918;128,125.024971008301;128.2,125.025482177734;128.4,125.022735595703;128.6,125.027717590332;128.8,125.021614074707;129,125.022735595703;129.2,125.028831481934;129.4,125.021614074707;129.6,125.020500183105;129.8,125.024360656738;130,125.025482177734;130.2,125.022735595703;130.4,125.004089355469;130.6,124.89525604248;130.8,124.68692779541;131,123.83283996582;131.2,123.110824584961;131.4,122.418769836426;131.6,121.063827514648;131.8,120.399826049805;132,119.754051208496;132.2,118.476852416992;132.4,117.854606628418;132.6,117.242012023926;132.8,116.039070129395;133,115.444869995117;133.2,114.852989196777;133.4,113.699516296387;133.6,113.127235412598;133.8,112.569427490234;134,111.464576721191;134.2,110.918518066406;134.4,110.387062072754;134.6,109.325691223145;134.8,108.798645019531;135,108.279472351074;135.2,107.25471496582;135.4,106.753219604492;135.6,106.261192321777;135.8,105.272605895996;136,104.787696838379;136.2,104.310028076172;136.4,103.357948303223;136.6,102.894561767578;136.8,102.429130554199;137,101.502754211426;137.2,101.049858093262;137.4,100.608001708984;137.6,99.7148361206055;137.8,99.2816696166992;138,98.8530120849609;138.2,97.9905242919922;138.4,97.5648574829102;138.6,97.1460189819336;138.8,96.3052978515625;139,95.8938980102539;139.2,95.4903182983398;139.4,94.6834182739258;139.6,94.2828063964844;139.8,93.8863220214844;140,93.1000137329102;140.2,92.7063598632813;140.4,92.3200378417969;140.6,91.5559005737305;140.8,91.1714248657227;141,90.799186706543;141.2,90.0549697875977;141.4,89.6922225952148;141.6,89.3213882446289;141.8,88.6113586425781;142,88.236930847168;142.2,87.8806381225586;142.4,87.183723449707;142.6,86.8316192626953;142.8,86.4849624633789;143,85.8002471923828;143.2,85.4559173583984;143.4,85.1123580932617;143.6,84.450065612793;143.8,84.1181640625;144,83.7869110107422;144.2,83.1300582885742;144.4,82.8115692138672;144.6,82.4926223754883;144.8,81.8487930297852;145,81.5360794067383;145.2,81.2262268066406;145.4,80.6058731079102;145.6,80.2954788208008;145.8,79.9846343994141;146,79.3774032592773;146.2,79.0820083618164;146.4,78.7862548828125;146.6,78.1936187744141;146.8,77.8962249755859;147,77.6039047241211;147.2,77.033561706543;147.4,76.7408294677734;147.6,76.4579238891602;147.8,75.8883972167969;148,75.6101303100586;148.2,75.3323593139648;148.4,74.7714996337891;148.6,74.511344909668;148.8,74.2376022338867;149,73.6994934082031;149.2,73.4362335205078;149.4,73.1712799072266;149.6,72.6494216918945;149.8,72.3851470947266;150,72.1308212280273;150.2,71.6179504394531;150.4,71.3582916259766;150.6,71.1051483154297;150.8,70.6094741821289;151,70.3647232055664;151.2,70.1111755371094;151.4,69.6239852905273;151.6,69.3836059570313;151.8,69.1390609741211;152,68.6608428955078;152.2,68.4239501953125;152.4,68.1924743652344;152.6,67.7189178466797;152.8,67.4912872314453;153,67.2590103149414;153.2,66.7975921630859;153.4,66.5767669677734;153.6,66.3493270874023;153.8,65.9007568359375;154,65.6810913085938;154.2,65.4614410400391;154.4,65.0216827392578;154.6,64.8125991821289 - 0,50;100,50 - 0.012,47.8;0.512,48.9;1.012,50.1;1.512,50;2.012,50;2.512,50;3.012,50;3.512,50;4.012,50.1;4.512,50;5.012,50;5.512,50;6.012,50;6.512,50;7.012,50;7.512,50;8.012,50;8.512,50;9.012,50;9.512,49.9;10.012,50;10.512,49.9;11.012,49.9;11.512,50;12.012,50.1;12.512,50;13.012,49.9;13.512,49.9;14.012,49.9;14.512,50;15.012,50;15.512,49.9;16.012,50;16.512,50;17.012,49.9;17.512,49.8;18.012,49.9;18.512,49.9;19.012,50;19.512,50;20.012,50.1;20.512,50;21.012,50;21.512,50;22.012,50.1;22.512,50;23.012,49.9;23.512,50;24.012,50;24.512,50.1;25.012,50;25.512,50;26.012,50;26.512,50;27.012,50;27.512,49.9;28.012,49.8;28.512,49.9;29.012,50;29.512,50;30.012,49.9;30.512,49.9;31.012,50;31.512,50;32.012,50;32.512,50.1;33.012,50;33.512,49.9;34.012,49.9;34.512,50;35.012,49.9;35.512,49.9;36.012,50.1;36.512,50;37.012,49.9;37.512,49.9;38.012,49.9;38.512,49.9;39.012,49.9;39.512,50;40.012,50;40.512,50;41.012,49.9;41.512,50;42.012,50.1;42.512,50;43.012,50;43.512,50.1;44.012,50.1;44.512,50;45.012,49.9;45.512,49.9;46.012,50;46.512,50;47.012,50.1;47.512,50;48.012,49.9;48.512,50;49.012,50;49.512,50;50.012,50;50.512,50;51.012,50;51.512,50;52.012,50;52.512,50.1;53.012,50.2;53.512,50.1;54.012,50.1;54.512,50;55.012,49.9;55.512,49.9;56.012,49.9;56.512,49.9;57.012,49.9;57.512,50;58.012,50;58.512,50.1;59.012,50;59.512,50;60.012,50;60.512,50;61.012,50;61.512,50.1;62.012,50.1;62.512,50;63.012,50;63.512,49.9;64.012,49.8;64.512,49.9;65.012,50;65.512,50;66.012,50.1;66.512,50.1;67.012,50.1;67.512,49.9;68.012,50;68.512,50;69.012,49.9;69.512,49.9;70.012,50;70.512,50.1;71.012,50.1;71.512,50.2;72.012,50.1;72.512,50;73.012,50;73.512,50;74.012,50;74.512,50;75.012,49.9;75.512,50;76.012,50;76.512,50;77.012,50;77.512,50.1;78.012,50;78.512,50;79.012,50.1;79.512,50;80.012,50;80.512,50;81.012,50;81.512,50;82.012,50;82.512,50.1;83.012,50;83.512,50;84.012,50.1;84.512,50;85.012,49.9;85.512,49.8;86.012,49.9;86.512,50;87.012,50.1;87.512,50.1;88.012,50;88.512,50;89.012,50.1;89.512,50;90.012,49.9;90.512,50;91.012,50;91.512,50;92.012,50.1;92.512,50;93.012,49.9;93.512,49.9;94.012,49.9;94.512,50;95.012,50;95.512,49.9;96.012,50;96.512,50.1;97.012,50.1;97.512,50;98.012,50;98.512,50;99.012,49.9;99.512,49.9;100.012,50;100.512,50.1;101.011,25;101.511,0;102.011,0;102.511,0;103.011,0;103.511,0;104.011,0;104.511,0;105.011,0;105.511,0;106.011,0;106.511,0;107.011,0;107.511,0;108.011,0;108.511,0;109.011,0;109.511,0;110.011,0;110.511,0;111.011,0;111.511,0;112.011,0;112.511,0;113.011,0;113.511,0;114.011,0;114.511,0;115.011,0;115.511,0;116.011,0;116.511,0;117.011,0;117.511,0;118.011,0;118.511,0;119.011,0;119.511,0;120.011,0;120.511,0;121.011,0;121.511,0;122.011,0;122.511,0;123.011,0;123.511,0;124.011,0;124.511,0 - - - 0,1;80,1 - - - 0.1,89;0.2,69;0.3,77;0.4,81;0.5,71;0.6,74;0.7,69;0.8,70;0.9,63;1,66;1.1,66;1.2,63;1.3,72;1.4,76;1.5,68;1.6,62;1.7,61;1.8,79;1.9,64;2,69;2.1,73;2.2,72;2.3,73;2.4,70;2.5,67;2.6,77;2.7,87;2.8,73;2.9,71;3,63;3.1,79;3.2,67;3.3,79;3.4,72;3.5,79;3.6,75;3.7,73;3.8,75;3.9,63;4,89;4.1,77;4.2,84;4.3,87;4.4,79;4.5,102;4.6,89;4.7,89;4.8,92;4.9,91;5,100;5.1,99;5.2,105;5.3,107;5.4,85;5.5,120;5.6,102;5.7,118;5.8,101;5.9,114;6,103;6.1,116;6.2,107;6.3,113;6.4,133;6.5,120;6.6,149;6.7,140;6.8,157;6.9,157;7,148;7.1,181;7.2,187;7.3,157;7.4,164;7.5,189;7.6,195;7.7,186;7.8,237;7.9,200;8,210;8.1,229;8.2,217;8.3,246;8.4,248;8.5,267;8.6,258;8.7,290;8.8,298;8.9,292;9,284;9.1,325;9.2,297;9.3,317;9.4,371;9.5,376;9.6,390;9.7,356;9.8,425;9.9,415;10,433;10.1,454;10.2,443;10.3,479;10.4,496;10.5,529;10.6,539;10.7,535;10.8,543;10.9,587;11,625;11.1,593;11.2,633;11.3,650;11.4,690;11.5,695;11.6,752;11.7,798;11.8,778;11.9,778;12,802;12.1,897;12.2,881;12.3,957;12.4,994;12.5,958;12.6,1055;12.7,1077;12.8,1085;12.9,1179;13,1146;13.1,1247;13.2,1260;13.3,1274;13.4,1342;13.5,1417;13.6,1472;13.7,1432;13.8,1528;13.9,1632;14,1655;14.1,1601;14.2,1716;14.3,1724;14.4,1807;14.5,1902;14.6,1930;14.7,1965;14.8,2006;14.9,2035;15,2216;15.1,2194;15.2,2318;15.3,2218;15.4,2428;15.5,2556;15.6,2682;15.7,2622;15.8,2727;15.9,2801;16,2931;16.1,2916;16.2,2967;16.3,3042;16.4,3140;16.5,3277;16.6,3185;16.7,3247;16.8,3294;16.9,3442;17,3561;17.1,3603;17.2,3674;17.3,3726;17.4,3796;17.5,3728;17.6,3855;17.7,3832;17.8,3798;17.9,3946;18,3910;18.1,3930;18.2,3937;18.3,3898;18.4,4057;18.5,3985;18.6,3801;18.7,3786;18.8,3762;18.9,3756;19,3630;19.1,3609;19.2,3537;19.3,3555;19.4,3541;19.5,3367;19.6,3345;19.7,3146;19.8,3108;19.9,2975;20,2788;20.1,2688;20.2,2478;20.3,2452;20.4,2349;20.5,2141;20.6,2065;20.7,1890;20.8,1803;20.9,1604;21,1498;21.1,1394;21.2,1291;21.3,1204;21.4,1059;21.5,1028;21.6,931;21.7,866;21.8,770;21.9,691;22,614;22.1,559;22.2,582;22.3,476;22.4,490;22.5,450;22.6,370;22.7,403;22.8,390;22.9,317;23,342;23.1,319;23.2,291;23.3,307;23.4,306;23.5,278;23.6,311;23.7,297;23.8,296;23.9,330;24,323;24.1,289;24.2,284;24.3,305;24.4,284;24.5,294;24.6,271;24.7,288;24.8,317;24.9,307;25,282;25.1,297;25.2,303;25.3,281;25.4,323;25.5,327;25.6,294;25.7,290;25.8,276;25.9,271;26,272;26.1,282;26.2,262;26.3,241;26.4,286;26.5,277;26.6,247;26.7,267;26.8,289;26.9,263;27,261;27.1,262;27.2,256;27.3,239;27.4,263;27.5,253;27.6,241;27.7,235;27.8,229;27.9,220;28,203;28.1,225;28.2,225;28.3,206;28.4,209;28.5,188;28.6,214;28.7,196;28.8,185;28.9,174;29,168;29.1,175;29.2,184;29.3,187;29.4,176;29.5,162;29.6,173;29.7,168;29.8,132;29.9,151;30,134;30.1,175;30.2,143;30.3,127;30.4,137;30.5,140;30.6,115;30.7,138;30.8,139;30.9,120;31,124;31.1,121;31.2,111;31.3,149;31.4,137;31.5,120;31.6,132;31.7,113;31.8,127;31.9,116;32,108;32.1,117;32.2,116;32.3,98;32.4,120;32.5,101;32.6,87;32.7,111;32.8,107;32.9,108;33,101;33.1,118;33.2,86;33.3,106;33.4,121;33.5,105;33.6,87;33.7,80;33.8,101;33.9,105;34,103;34.1,86;34.2,87;34.3,79;34.4,84;34.5,84;34.6,95;34.7,96;34.8,77;34.9,99;35,82;35.1,81;35.2,78;35.3,91;35.4,81;35.5,95;35.6,90;35.7,100;35.8,90;35.9,79;36,92;36.1,78;36.2,95;36.3,96;36.4,81;36.5,82;36.6,71;36.7,78;36.8,67;36.9,79 - 0,25;27,160;37,160;47,60;167,60 - 0.2,30.7578144073486;0.4,30.749828338623;0.6,30.7449951171875;0.8,30.7407608032227;1,30.7310848236084;1.2,30.7257633209229;1.4,30.7359218597412;1.6,30.7620487213135;1.8,30.9956016540527;2,31.2360744476318;2.2,31.5899219512939;2.4,32.6551284790039;2.6,33.3335723876953;2.8,34.1144981384277;3,35.822639465332;3.2,36.6979446411133;3.4,37.552906036377;3.6,39.1688652038574;3.8,39.9255523681641;4,40.6455459594727;4.2,42.0563163757324;4.4,42.7529144287109;4.6,43.4563598632813;4.8,44.8957214355469;5,45.6382179260254;5.2,46.3881988525391;5.4,47.9173316955566;5.6,48.6773834228516;5.8,49.4495544433594;6,50.9787979125977;6.2,51.7368240356445;6.4,52.4800605773926;6.6,53.98974609375;6.8,54.7403602600098;7,55.4934730529785;7.2,56.9991645812988;7.4,57.7553939819336;7.6,58.5142555236816;7.8,60.0343589782715;8,60.8039169311523;8.2,61.5676765441895;8.4,63.0930557250977;8.6,63.855655670166;8.8,64.6153869628906;9,66.1405181884766;9.2,66.9011611938477;9.4,67.665901184082;9.6,69.199089050293;9.8,69.9642486572266;10,70.7248153686523;10.2,72.2572479248047;10.4,73.0180969238281;10.6,73.7821807861328;10.8,75.3098907470703;11,76.0807800292969;11.2,76.8520736694336;11.4,78.3845138549805;11.6,79.1556015014648;11.8,79.9225692749023;12,81.4514846801758;12.2,82.2133102416992;12.4,82.9787368774414;12.6,84.5177536010742;12.8,85.2853012084961;13,86.0507965087891;13.2,87.5911712646484;13.4,88.3543395996094;13.6,89.1260528564453;13.8,90.664436340332;14,91.4320907592773;14.2,92.2000350952148;14.4,93.7308502197266;14.6,94.4997711181641;14.8,95.2650299072266;15,96.7986221313477;15.2,97.5664596557617;15.4,98.3374176025391;15.6,99.8789672851563;15.8,100.646324157715;16,101.412368774414;16.2,102.946762084961;16.4,103.704116821289;16.6,104.481300354004;16.8,106.01197052002;17,106.784912109375;17.2,107.550453186035;17.4,109.088424682617;17.6,109.864204406738;17.8,110.630226135254;18,112.167663574219;18.2,112.926696777344;18.4,113.696151733398;18.6,115.221885681152;18.8,115.993766784668;19,116.762702941895;19.2,118.296165466309;19.4,119.069755554199;19.6,119.839645385742;19.8,121.374252319336;20,122.141204833984;20.2,122.905448913574;20.4,124.441665649414;20.6,125.207939147949;20.8,125.970626831055;21,127.496505737305;21.2,128.26904296875;21.4,129.039993286133;21.6,130.574813842773;21.8,131.350021362305;22,132.108551025391;22.2,133.64616394043;22.4,134.416809082031;22.6,135.176849365234;22.8,136.704681396484;23,137.470108032227;23.2,138.233657836914;23.4,139.769119262695;23.6,140.533935546875;23.8,141.302368164063;24,142.833724975586;24.2,143.610900878906;24.4,144.36669921875;24.6,145.90007019043;24.8,146.661865234375;25,147.426055908203;25.2,148.952987670898;25.4,149.718017578125;25.6,150.48828125;25.8,152.018951416016;26,152.778060913086;26.2,153.551071166992;26.4,155.086044311523;26.6,155.845001220703;26.8,156.606582641602;27,158.139953613281;27.2,158.892471313477;27.4,159.657852172852;27.6,160.827529907227;27.8,161.087600708008;28,161.141891479492;28.2,160.823669433594;28.4,160.564743041992;28.6,160.285919189453;28.8,159.846450805664;29,159.716018676758;29.2,159.65950012207;29.4,159.734176635742;29.6,159.842422485352;29.8,159.968490600586;30,160.21923828125;30.2,160.31672668457;30.4,160.389678955078;30.6,160.449066162109;30.8,160.448455810547;31,160.43766784668;31.2,160.404434204102;31.4,160.389678955078;31.6,160.388534545898;31.8,160.398315429688;32,160.413116455078;32.2,160.442169189453;32.4,160.495681762695;32.6,160.523132324219;32.8,160.545959472656;33,160.592041015625;33.2,160.6103515625;33.4,160.632049560547;33.6,160.654235839844;33.8,160.662231445313;34,160.667999267578;34.2,160.687286376953;34.4,160.698822021484;34.6,160.709594726563;34.8,160.729034423828;35,160.737548828125;35.2,160.748352050781;35.4,160.778045654297;35.6,160.786560058594;35.8,160.802597045898;36,160.817886352539;36.2,160.826538085938;36.4,160.829925537109;36.6,160.853225708008;36.8,160.853225708008;37,160.861251831055;37.2,160.876693725586;37.4,160.860641479492;37.6,160.729034423828;37.8,159.924011230469;38,159.381454467773;38.2,158.391235351563;38.4,156.103927612305;38.6,155.00016784668;38.8,153.917785644531;39,151.826400756836;39.2,150.803482055664;39.4,149.796920776367;39.6,147.840072631836;39.8,146.885192871094;40,145.955184936523;40.2,144.127105712891;40.4,143.218612670898;40.6,142.34147644043;40.8,140.618179321289;41,139.770263671875;41.2,138.937942504883;41.4,137.314926147461;41.6,136.512878417969;41.8,135.73030090332;42,134.185089111328;42.2,133.424102783203;42.4,132.679168701172;42.6,131.209274291992;42.8,130.489364624023;43,129.784790039063;43.2,128.397766113281;43.4,127.703979492188;43.6,127.028472900391;43.8,125.690956115723;44,125.033935546875;44.2,124.385581970215;44.4,123.114181518555;44.6,122.48316192627;44.8,121.858070373535;45,120.640235900879;45.2,120.034065246582;45.4,119.440391540527;45.6,118.255317687988;45.8,117.675064086914;46,117.100479125977;46.2,115.96696472168;46.4,115.405158996582;46.6,114.846908569336;46.8,113.754699707031;47,113.218643188477;47.2,112.687225341797;47.4,111.629211425781;47.6,111.10595703125;47.8,110.589569091797;48,109.565940856934;48.2,109.056579589844;48.4,108.559059143066;48.6,107.566543579102;48.8,107.089897155762;49,106.58903503418;49.2,105.639739990234;49.4,105.161338806152;49.6,104.683753967285;49.8,103.761405944824;50,103.304016113281;50.2,102.845703125;50.4,101.93480682373;50.6,101.486671447754;50.8,101.044288635254;51,100.161399841309;51.2,99.7320098876953;51.4,99.297737121582;51.6,98.4410781860352;51.8,98.0126419067383;52,97.6025238037109;52.2,96.7665100097656;52.4,96.3555526733398;52.6,95.9420471191406;52.8,95.1333160400391;53,94.7310638427734;53.2,94.3320541381836;53.4,93.5500793457031;53.6,93.1568908691406;53.8,92.7682876586914;54,91.9939346313477;54.2,91.616081237793;54.4,91.2365188598633;54.6,90.4877777099609;54.8,90.1127777099609;55,89.7463226318359;55.2,89.0256195068359;55.4,88.6665496826172;55.6,88.3052978515625;55.8,87.5967178344727;56,87.2427139282227;56.2,86.8883819580078;56.4,86.1946105957031;56.6,85.8464202880859;56.8,85.5104598999023;57,84.8315963745117;57.2,84.4985504150391;57.4,84.1595153808594;57.6,83.5019683837891;57.8,83.171875;58,82.8478546142578;58.2,82.1979293823242;58.4,81.8703155517578;58.6,81.5580902099609;58.8,80.931640625;59,80.6152114868164;59.2,80.3119659423828;59.4,79.6913986206055;59.6,79.3894500732422;59.8,79.08642578125;60,78.4937286376953;60.2,78.1925048828125;60.4,77.8928985595703;60.6,77.3071823120117;60.8,77.0236206054688;61,76.7281875610352;61.2,76.1668319702148;61.4,75.8796997070313;61.6,75.5985794067383;61.8,75.0381698608398;62,74.7599639892578;62.2,74.4850845336914;62.4,73.9419097900391;62.6,73.6765518188477;62.8,73.4071655273438;63,72.8792572021484;63.2,72.6132431030273;63.4,72.3490982055664;63.6,71.8273544311523;63.8,71.5741806030273;64,71.3145294189453;64.2,70.8061981201172;64.4,70.5586090087891;64.6,70.3095855712891;64.8,69.8118209838867;65,69.56884765625;65.2,69.3230743408203;65.4,68.8386917114258;65.6,68.5990982055664;65.8,68.3627166748047;66,67.895622253418;66.2,67.6616134643555;66.4,67.4270095825195;66.6,66.9568557739258;66.8,66.7256011962891;67,66.500373840332;67.2,66.0505599975586;67.4,65.8270950317383;67.6,65.604248046875;67.8,65.1671600341797;68,64.9509582519531 - - - \ No newline at end of file diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/rstudio/addins.dcf b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/rstudio/addins.dcf deleted file mode 100644 index 515a3af5f..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/inst/rstudio/addins.dcf +++ /dev/null @@ -1,9 +0,0 @@ -Name: Search for TODOs -Description: List TODOs in the source code -Binding: .listTODO -Interactive: false - -Name: Install package development version -Description: Install the developement version of the R package 'Luminescence' -Binding: .installDevelopmentVersion -Interactive: true diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/Analyse_SAR.OSLdata.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/Analyse_SAR.OSLdata.Rd deleted file mode 100644 index 5f0db71be..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/Analyse_SAR.OSLdata.Rd +++ /dev/null @@ -1,165 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Analyse_SAR.OSLdata.R -\name{Analyse_SAR.OSLdata} -\alias{Analyse_SAR.OSLdata} -\title{Analyse SAR CW-OSL measurements.} -\usage{ -Analyse_SAR.OSLdata( - input.data, - signal.integral, - background.integral, - position, - run, - set, - dtype, - keep.SEL = FALSE, - info.measurement = "unknown measurement", - output.plot = FALSE, - output.plot.single = FALSE, - cex.global = 1, - ... -) -} -\arguments{ -\item{input.data}{\linkS4class{Risoe.BINfileData} (\strong{required}): -input data from a Risø BIN file, produced by the function \link{read_BIN2R}.} - -\item{signal.integral}{\link{vector} (\strong{required}): -channels used for the signal integral, e.g. \code{signal.integral=c(1:2)}} - -\item{background.integral}{\link{vector} (\strong{required}): -channels used for the background integral, e.g. \code{background.integral=c(85:100)}} - -\item{position}{\link{vector} (\emph{optional}): -reader positions that want to be analysed (e.g. \code{position=c(1:48)}. -Empty positions are automatically omitted. If no value is given all -positions are analysed by default.} - -\item{run}{\link{vector} (\emph{optional}): -range of runs used for the analysis. If no value is given the range of the -runs in the sequence is deduced from the \code{Risoe.BINfileData} object.} - -\item{set}{\link{vector} (\emph{optional}): -range of sets used for the analysis. If no value is given the range of the -sets in the sequence is deduced from the \code{Risoe.BINfileData} object.} - -\item{dtype}{\link{character} (\emph{optional}): -allows to further limit the curves by their data type (\code{DTYPE}), -e.g., \code{dtype = c("Natural", "Dose")} limits the curves to this two data types. -By default all values are allowed. -See \linkS4class{Risoe.BINfileData} for allowed data types.} - -\item{keep.SEL}{\link{logical} (default): -option allowing to use the \code{SEL} element of the \linkS4class{Risoe.BINfileData} manually. -\strong{NOTE:} In this case any limitation provided by \code{run}, \code{set} and \code{dtype} -are ignored!} - -\item{info.measurement}{\link{character} (\emph{with default}): -option to provide information about the measurement on the plot -output (e.g. name of the BIN or BINX file).} - -\item{output.plot}{\link{logical} (\emph{with default}): -plot output (\code{TRUE/FALSE})} - -\item{output.plot.single}{\link{logical} (\emph{with default}): -single plot output (\code{TRUE/FALSE}) to allow for plotting the results in -single plot windows. Requires \code{output.plot = TRUE}.} - -\item{cex.global}{\link{numeric} (\emph{with default}): -global scaling factor.} - -\item{...}{further arguments that will be passed to the function -\link{calc_OSLLxTxRatio} (supported: \code{background.count.distribution}, \code{sigmab}, -\code{sig0}; e.g., for instrumental error) and can be used to adjust the plot. -Supported" \code{mtext}, \code{log}} -} -\value{ -A plot (\emph{optional}) and \link{list} is returned containing the -following elements: - -\item{LnLxTnTx}{\link{data.frame} of all calculated Lx/Tx values including signal, background counts and the dose points.} -\item{RejectionCriteria}{\link{data.frame} with values that might by used as rejection criteria. NA is produced if no R0 dose point exists.} -\item{SARParameters}{\link{data.frame} of additional measurement parameters obtained from the BIN file, e.g. preheat or read temperature -(not valid for all types of measurements).} -} -\description{ -The function analyses SAR CW-OSL curve data and provides a summary of the -measured data for every position. The output of the function is optimised -for SAR OSL measurements on quartz. -} -\details{ -The function works only for standard SAR protocol measurements introduced by -Murray and Wintle (2000) with CW-OSL curves. For the calculation of the -Lx/Tx value the function \link{calc_OSLLxTxRatio} is used. - -\strong{Provided rejection criteria} - -\verb{[recyling ratio]}: calculated for every repeated regeneration dose point. - -\verb{[recuperation]}: recuperation rate calculated by comparing the \code{Lx/Tx} values of the zero -regeneration point with the \code{Ln/Tn} value (the \code{Lx/Tx} ratio of the natural -signal). For methodological background see Aitken and Smith (1988) - -\verb{[IRSL/BOSL]}: the integrated counts (\code{signal.integral}) of an -IRSL curve are compared to the integrated counts of the first regenerated -dose point. It is assumed that IRSL curves got the same dose as the first -regenerated dose point. \strong{Note:} This is not the IR depletion ratio -described by Duller (2003). -} -\note{ -Rejection criteria are calculated but not considered during the -analysis to discard values. - -\strong{The analysis of IRSL data is not directly supported}. You may want to -consider using the functions \link{analyse_SAR.CWOSL} or -\link{analyse_pIRIRSequence} instead. - -\strong{The development of this function will not be continued. We recommend to use the function \link{analyse_SAR.CWOSL} or instead.} -} -\section{Function version}{ - 0.2.17 -} - -\examples{ -##load data -data(ExampleData.BINfileData, envir = environment()) - -##analyse data -output <- Analyse_SAR.OSLdata(input.data = CWOSL.SAR.Data, - signal.integral = c(1:5), - background.integral = c(900:1000), - position = c(1:1), - output.plot = TRUE) - -##combine results relevant for further analysis -output.SAR <- data.frame(Dose = output$LnLxTnTx[[1]]$Dose, - LxTx = output$LnLxTnTx[[1]]$LxTx, - LxTx.Error = output$LnLxTnTx[[1]]$LxTx.Error) -output.SAR - -} - -\section{How to cite}{ -Kreutzer, S., Fuchs, M.C., 2024. Analyse_SAR.OSLdata(): Analyse SAR CW-OSL measurements.. Function version 0.2.17. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Aitken, M.J. and Smith, B.W., 1988. Optical dating: recuperation -after bleaching. Quaternary Science Reviews 7, 387-393. - -Duller, G., 2003. Distinguishing quartz and feldspar in single grain -luminescence measurements. Radiation Measurements, 37 (2), 161-165. - -Murray, A.S. and Wintle, A.G., 2000. Luminescence dating of quartz using an -improved single-aliquot regenerative-dose protocol. Radiation Measurements -32, 57-73. -} -\seealso{ -\link{calc_OSLLxTxRatio}, \linkS4class{Risoe.BINfileData}, \link{read_BIN2R}, \link{plot_GrowthCurve} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -Margret C. Fuchs, HZDR, Freiberg (Germany) -, RLum Developer Team} -\keyword{datagen} -\keyword{dplot} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/BaseDataSet.ConversionFactors.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/BaseDataSet.ConversionFactors.Rd deleted file mode 100644 index 146de06f2..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/BaseDataSet.ConversionFactors.Rd +++ /dev/null @@ -1,58 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\name{BaseDataSet.ConversionFactors} -\alias{BaseDataSet.ConversionFactors} -\title{Base data set of dose-rate conversion factors} -\format{ -A \code{\link{list}} with three elements with dose-rate conversion factors -sorted by article and radiation type (alpha, beta, gamma): - -\tabular{ll}{ - -\code{AdamiecAitken1998}: \tab -Conversion factors from Tables 5 and 6 \cr - -\code{Cresswelletal2018}: \tab -Conversion factors from Tables 5 and 6 \cr - -\code{Guerinetal2011}: \tab -Conversion factors from Tables 1, 2 and 3 \cr - -\code{Liritzisetal2013}: \tab -Conversion factors from Tables 1, 2 and 3 \cr -} -} -\source{ -All gamma conversion factors were carefully read from the tables given in the -references above. -} -\description{ -Collection of published dose-rate conversion factors to convert concentrations -of radioactive isotopes to dose rate values. -} -\section{Version}{ - 0.2.0 -} - -\examples{ - -## Load data -data("BaseDataSet.ConversionFactors", envir = environment()) - -} -\references{ -Adamiec, G., Aitken, M.J., 1998. Dose-rate conversion factors: update. -Ancient TL 16, 37-46. - -Cresswell., A.J., Carter, J., Sanderson, D.C.W., 2018. -Dose rate conversion parameters: Assessment of nuclear data. -Radiation Measurements 120, 195-201. - -Guerin, G., Mercier, N., Adamiec, G., 2011. Dose-rate conversion -factors: update. Ancient TL, 29, 5-8. - -Liritzis, I., Stamoulis, K., Papachristodoulou, C., Ioannides, K., 2013. -A re-evaluation of radiation dose-rate conversion factors. Mediterranean -Archaeology and Archaeometry 13, 1-15. -} -\keyword{datasets} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/BaseDataSet.CosmicDoseRate.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/BaseDataSet.CosmicDoseRate.Rd deleted file mode 100644 index 21f4ad1e7..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/BaseDataSet.CosmicDoseRate.Rd +++ /dev/null @@ -1,120 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\name{BaseDataSet.CosmicDoseRate} -\alias{BaseDataSet.CosmicDoseRate} -\alias{values.cosmic.Softcomp} -\alias{values.factor.Altitude} -\alias{values.par.FJH} -\title{Base data set for cosmic dose rate calculation} -\format{ -\tabular{ll}{ - -\code{values.cosmic.Softcomp}: \tab -data frame containing cosmic dose rates -for shallow depths (< 167 g cm^-2) obtained using the "AGE" program by -Rainer Gruen (cf. Gruen 2009). These data essentially reproduce the graph -shown in Fig. 1 of Prescott & Hutton (1988). \cr - -\code{values.factor.Altitude}: \tab -data frame containing altitude factors -for adjusting geomagnetic field-change factors. Values were read from Fig. 1 -in Prescott & Hutton (1994). \cr - -\code{values.par.FJH}: \tab -data frame containing values for parameters F, J -and H (read from Fig. 2 in Prescott & Hutton 1994) used in the expression \cr -} - -\deqn{Dc = D0*(F+J*exp((altitude/1000)/H))} -} -\source{ -The following data were carefully read from figures in mentioned -sources and used for fitting procedures. The derived expressions are used in -the function \code{calc_CosmicDoseRate}. - -\strong{values.cosmic.Softcomp} - -\tabular{ll}{ -Program: \tab "AGE"\cr -Reference: \tab Gruen (2009) \cr -Fit: \tab Polynomials in the form of -} - -For depths between 40-167 g cm^-2: - -\deqn{y = 2*10^-6*x^2-0.0008*x+0.2535} - -(For depths <40 g cm^-2) - -\deqn{y = -6*10^-8*x^3+2*10^-5*x^2-0.0025*x+0.2969} - -\strong{\code{values.factor.Altitude}} - -\tabular{ll}{ -Reference: \tab Prescott & Hutton (1994) \cr -Page: \tab 499 \cr -Figure: \tab 1 \cr -Fit: \tab 2-degree polynomial in the form of -} - -\deqn{y = -0.026*x^2 + 0.6628*x + 1.0435} - -\strong{\code{values.par.FJH}} - -\tabular{ll}{ -Reference: \tab Prescott & Hutton (1994) \cr -Page: \tab 500 \cr -Figure: \tab 2 \cr -Fits: \tab 3-degree polynomials and linear fits -} - -F (non-linear part, \eqn{\lambda} < 36.5 deg.): - -\deqn{y = -7*10^-7*x^3-8*10^-5*x^2-0.0009*x+0.3988} - -F (linear part, \eqn{\lambda} > 36.5 deg.): - -\deqn{y = -0.0001*x + 0.2347} - -J (non-linear part, \eqn{\lambda} < 34 deg.): - -\deqn{y = 5*10^-6*x^3-5*10^-5*x^2+0.0026*x+0.5177} - -J (linear part, \eqn{\lambda} > 34 deg.): - -\deqn{y = 0.0005*x + 0.7388} - -H (non-linear part, \eqn{\lambda} < 36 deg.): - -\deqn{y = -3*10^-6*x^3-5*10^-5*x^2-0.0031*x+4.398} - -H (linear part, \eqn{\lambda} > 36 deg.): - -\deqn{y = 0.0002*x + 4.0914} -} -\description{ -Collection of data from various sources needed for cosmic dose rate -calculation -} -\section{Version}{ - 0.1 -} - -\examples{ - -##load data -data(BaseDataSet.CosmicDoseRate) - -} -\references{ -Gruen, R., 2009. The "AGE" program for the calculation of luminescence age estimates. -Ancient TL, 27, pp. 45-46. - -Prescott, J.R., Hutton, J.T., 1988. Cosmic ray and gamma ray dosimetry for -TL and ESR. Nuclear Tracks and Radiation Measurements, 14, pp. 223-227. - -Prescott, J.R., Hutton, J.T., 1994. Cosmic ray contributions to dose rates -for luminescence and ESR dating: large depths and long-term time variations. -Radiation Measurements, 23, pp. 497-500. -} -\keyword{datasets} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/BaseDataSet.FractionalGammaDose.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/BaseDataSet.FractionalGammaDose.Rd deleted file mode 100644 index c6239c370..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/BaseDataSet.FractionalGammaDose.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\name{BaseDataSet.FractionalGammaDose} -\alias{BaseDataSet.FractionalGammaDose} -\title{Base data set of fractional gamma-dose values} -\format{ -A \code{\link{list}} with fractional gamma dose-rate values -sorted by article: - -\tabular{ll}{ - -\code{Aitken1985}: \tab -Fractional gamma-dose values from table H.1 -} -} -\source{ -Fractional gamma dose values were carefully read from the tables given in the -references above. -} -\description{ -Collection of (un-)published fractional gamma dose-rate values to scale the -gamma-dose rate considering layer-to-layer variations in soil radioactivity. -} -\section{Version}{ - 0.1 -} - -\examples{ - -## Load data -data("BaseDataSet.FractionalGammaDose", envir = environment()) - -} -\references{ -Aitken, M.J., 1985. Thermoluminescence Dating. Academic Press, London. -} -\keyword{datasets} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/BaseDataSet.GrainSizeAttenuation.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/BaseDataSet.GrainSizeAttenuation.Rd deleted file mode 100644 index 1474fe2ef..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/BaseDataSet.GrainSizeAttenuation.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\name{BaseDataSet.GrainSizeAttenuation} -\alias{BaseDataSet.GrainSizeAttenuation} -\title{Base dataset for grain size attenuation data by Guérin et al. (2012)} -\source{ -Guérin, G., Mercier, N., Nathan, R., Adamiec, G., Lefrais, Y., 2012. -On the use of the infinite matrix assumption and associated concepts: -A critical review. Radiation Measurements, 47, 778-785. -} -\description{ -Grain size correction data for beta-dose rates -published by Guérin et al. (2012). - -#' @format - -A \code{\link{data.frame}} seven columns and sixteen rows. Column headers -are \code{GrainSize}, \code{Q_K}, \code{FS_K}, \code{Q_Th}, \code{FS_Th}, \code{Q_U}, \code{FS_U}. -Grain sizes are quoted in µm (e.g., 20, 40, 60 etc.) -} -\section{Version}{ - 0.1.0 -} - -\examples{ - -## load data -data("BaseDataSet.GrainSizeAttenuation", envir = environment()) - -} -\keyword{datasets} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/CW2pHMi.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/CW2pHMi.Rd deleted file mode 100644 index 201db6c8e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/CW2pHMi.Rd +++ /dev/null @@ -1,209 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CW2pHMi.R -\name{CW2pHMi} -\alias{CW2pHMi} -\title{Transform a CW-OSL curve into a pHM-OSL curve via interpolation under -hyperbolic modulation conditions} -\usage{ -CW2pHMi(values, delta) -} -\arguments{ -\item{values}{\linkS4class{RLum.Data.Curve} or \link{data.frame} (\strong{required}): -\linkS4class{RLum.Data.Curve} or \link{data.frame} with measured curve data of type -stimulation time (t) (\code{values[,1]}) and measured counts (cts) (\code{values[,2]}).} - -\item{delta}{\link{vector} (\emph{optional}): -stimulation rate parameter, if no value is given, the optimal value is -estimated automatically (see details). Smaller values of delta produce more -points in the rising tail of -the curve.} -} -\value{ -The function returns the same data type as the input data type with -the transformed curve values. - -\strong{\code{RLum.Data.Curve}} - -\tabular{ll}{ -\verb{$CW2pHMi.x.t} \tab: transformed time values \cr -\verb{$CW2pHMi.method} \tab: used method for the production of the new data points -} - -\strong{\code{data.frame}} - -\tabular{ll}{ -\verb{$x} \tab: time\cr -\verb{$y.t} \tab: transformed count values\cr -\verb{$x.t} \tab: transformed time values \cr -\verb{$method} \tab: used method for the production of the new data points -} -} -\description{ -This function transforms a conventionally measured continuous-wave (CW) -OSL-curve to a pseudo hyperbolic modulated (pHM) curve under hyperbolic -modulation conditions using the interpolation procedure described by Bos & -Wallinga (2012). -} -\details{ -The complete procedure of the transformation is described in Bos & Wallinga -(2012). The input \code{data.frame} consists of two columns: time (t) and -count values (CW(t)) - -\strong{Internal transformation steps} - -(1) log(CW-OSL) values - -(2) -Calculate t' which is the transformed time: -\deqn{t' = t-(1/\delta)*log(1+\delta*t)} - -(3) -Interpolate CW(t'), i.e. use the log(CW(t)) to obtain the count values -for the transformed time (t'). Values beyond \code{min(t)} and \code{max(t)} -produce \code{NA} values. - -(4) -Select all values for t' < \code{min(t)}, i.e. values beyond the time -resolution of t. Select the first two values of the transformed data set -which contain no \code{NA} values and use these values for a linear fit -using \link{lm}. - -(5) -Extrapolate values for t' < \code{min(t)} based on the previously -obtained fit parameters. - -(6) -Transform values using -\deqn{pHM(t) = (\delta*t/(1+\delta*t))*c*CW(t')} -\deqn{c = (1+\delta*P)/\delta*P} -\deqn{P = length(stimulation~period)} - -(7) Combine all values and truncate all values for t' > \code{max(t)} - -\strong{NOTE:} -The number of values for t' < \code{min(t)} depends on the stimulation rate -parameter \code{delta}. To avoid the production of too many artificial data -at the raising tail of the determined pHM curve, it is recommended to use -the automatic estimation routine for \code{delta}, i.e. provide no value for -\code{delta}. -} -\note{ -According to Bos & Wallinga (2012), the number of extrapolated points -should be limited to avoid artificial intensity data. If \code{delta} is -provided manually and more than two points are extrapolated, a warning -message is returned. - -The function \link{approx} may produce some \code{Inf} and \code{NaN} data. -The function tries to manually interpolate these values by calculating -the \code{mean} using the adjacent channels. If two invalid values are succeeding, -the values are removed and no further interpolation is attempted. -In every case a warning message is shown. -} -\section{Function version}{ - 0.2.2 -} - -\examples{ - -##(1) - simple transformation - -##load CW-OSL curve data -data(ExampleData.CW_OSL_Curve, envir = environment()) - -##transform values -values.transformed<-CW2pHMi(ExampleData.CW_OSL_Curve) - -##plot -plot(values.transformed$x, values.transformed$y.t, log = "x") - -##(2) - load CW-OSL curve from BIN-file and plot transformed values - -##load BINfile -#BINfileData<-readBIN2R("[path to BIN-file]") -data(ExampleData.BINfileData, envir = environment()) - -##grep first CW-OSL curve from ALQ 1 -curve.ID<-CWOSL.SAR.Data@METADATA[CWOSL.SAR.Data@METADATA[,"LTYPE"]=="OSL" & - CWOSL.SAR.Data@METADATA[,"POSITION"]==1 - ,"ID"] - -curve.HIGH<-CWOSL.SAR.Data@METADATA[CWOSL.SAR.Data@METADATA[,"ID"]==curve.ID[1] - ,"HIGH"] - -curve.NPOINTS<-CWOSL.SAR.Data@METADATA[CWOSL.SAR.Data@METADATA[,"ID"]==curve.ID[1] - ,"NPOINTS"] - -##combine curve to data set - -curve<-data.frame(x = seq(curve.HIGH/curve.NPOINTS,curve.HIGH, - by = curve.HIGH/curve.NPOINTS), - y=unlist(CWOSL.SAR.Data@DATA[curve.ID[1]])) - - -##transform values - -curve.transformed <- CW2pHMi(curve) - -##plot curve -plot(curve.transformed$x, curve.transformed$y.t, log = "x") - - -##(3) - produce Fig. 4 from Bos & Wallinga (2012) - -##load data -data(ExampleData.CW_OSL_Curve, envir = environment()) -values <- CW_Curve.BosWallinga2012 - -##open plot area -plot(NA, NA, - xlim=c(0.001,10), - ylim=c(0,8000), - ylab="pseudo OSL (cts/0.01 s)", - xlab="t [s]", - log="x", - main="Fig. 4 - Bos & Wallinga (2012)") - -values.t<-CW2pLMi(values, P=1/20) -lines(values[1:length(values.t[,1]),1],CW2pLMi(values, P=1/20)[,2], - col="red" ,lwd=1.3) -text(0.03,4500,"LM", col="red" ,cex=.8) - -values.t<-CW2pHMi(values, delta=40) -lines(values[1:length(values.t[,1]),1],CW2pHMi(values, delta=40)[,2], - col="black", lwd=1.3) -text(0.005,3000,"HM", cex=.8) - -values.t<-CW2pPMi(values, P=1/10) -lines(values[1:length(values.t[,1]),1],CW2pPMi(values, P=1/10)[,2], - col="blue", lwd=1.3) -text(0.5,6500,"PM", col="blue" ,cex=.8) - -} - -\section{How to cite}{ -Kreutzer, S., 2024. CW2pHMi(): Transform a CW-OSL curve into a pHM-OSL curve via interpolation under hyperbolic modulation conditions. Function version 0.2.2. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Bos, A.J.J. & Wallinga, J., 2012. How to visualize quartz OSL -signal components. Radiation Measurements, 47, 752-758.\cr - -\strong{Further Reading} - -Bulur, E., 1996. An Alternative Technique For -Optically Stimulated Luminescence (OSL) Experiment. Radiation Measurements, -26, 701-709. - -Bulur, E., 2000. A simple transformation for converting CW-OSL curves to -LM-OSL curves. Radiation Measurements, 32, 141-145. -} -\seealso{ -\link{CW2pLM}, \link{CW2pLMi}, \link{CW2pPMi}, \link{fit_LMCurve}, \link{lm}, -\linkS4class{RLum.Data.Curve} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -Based on comments and suggestions from:\cr -Adrie J.J. Bos, Delft University of Technology, The Netherlands -, RLum Developer Team} -\keyword{manip} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/CW2pLM.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/CW2pLM.Rd deleted file mode 100644 index c0250824c..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/CW2pLM.Rd +++ /dev/null @@ -1,88 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CW2pLM.R -\name{CW2pLM} -\alias{CW2pLM} -\title{Transform a CW-OSL curve into a pLM-OSL curve} -\usage{ -CW2pLM(values) -} -\arguments{ -\item{values}{\linkS4class{RLum.Data.Curve} or \link{data.frame} (\strong{required}): -\code{RLum.Data.Curve} data object. Alternatively, a \code{data.frame} of the measured -curve data of type stimulation time (t) (\code{values[,1]}) and measured counts (cts) -(\code{values[,2]}) can be provided.} -} -\value{ -The function returns the same data type as the input data type with -the transformed curve values (\link{data.frame} or \linkS4class{RLum.Data.Curve}). -} -\description{ -Transforms a conventionally measured continuous-wave (CW) curve into a -pseudo linearly modulated (pLM) curve using the equations given in Bulur -(2000). -} -\details{ -According to Bulur (2000) the curve data are transformed by introducing two -new parameters \code{P} (stimulation period) and \code{u} (transformed time): - -\deqn{P=2*max(t)} \deqn{u=\sqrt{(2*t*P)}} - -The new count values are then calculated by -\deqn{ctsNEW = cts(u/P)} - -and the returned \code{data.frame} is produced by: \code{data.frame(u,ctsNEW)} - -The output of the function can be further used for LM-OSL fitting. -} -\note{ -The transformation is recommended for curves recorded with a channel -resolution of at least 0.05 s/channel. -} -\section{Function version}{ - 0.4.1 -} - -\examples{ - -##read curve from CWOSL.SAR.Data transform curve and plot values -data(ExampleData.BINfileData, envir = environment()) - -##read id for the 1st OSL curve -id.OSL <- CWOSL.SAR.Data@METADATA[CWOSL.SAR.Data@METADATA[,"LTYPE"] == "OSL","ID"] - -##produce x and y (time and count data for the data set) -x<-seq(CWOSL.SAR.Data@METADATA[id.OSL[1],"HIGH"]/CWOSL.SAR.Data@METADATA[id.OSL[1],"NPOINTS"], - CWOSL.SAR.Data@METADATA[id.OSL[1],"HIGH"], - by = CWOSL.SAR.Data@METADATA[id.OSL[1],"HIGH"]/CWOSL.SAR.Data@METADATA[id.OSL[1],"NPOINTS"]) -y <- unlist(CWOSL.SAR.Data@DATA[id.OSL[1]]) -values <- data.frame(x,y) - -##transform values -values.transformed <- CW2pLM(values) - -##plot -plot(values.transformed) - -} - -\section{How to cite}{ -Kreutzer, S., 2024. CW2pLM(): Transform a CW-OSL curve into a pLM-OSL curve. Function version 0.4.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Bulur, E., 2000. A simple transformation for converting CW-OSL -curves to LM-OSL curves. Radiation Measurements, 32, 141-145. - -\strong{Further Reading} - -Bulur, E., 1996. An Alternative Technique For Optically Stimulated -Luminescence (OSL) Experiment. Radiation Measurements, 26, 701-709. -} -\seealso{ -\link{CW2pHMi}, \link{CW2pLMi}, \link{CW2pPMi}, \link{fit_LMCurve}, \link{lm}, -\linkS4class{RLum.Data.Curve} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{manip} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/CW2pLMi.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/CW2pLMi.Rd deleted file mode 100644 index 18a0f6210..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/CW2pLMi.Rd +++ /dev/null @@ -1,165 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CW2pLMi.R -\name{CW2pLMi} -\alias{CW2pLMi} -\title{Transform a CW-OSL curve into a pLM-OSL curve via interpolation under linear -modulation conditions} -\usage{ -CW2pLMi(values, P) -} -\arguments{ -\item{values}{\linkS4class{RLum.Data.Curve} or \link{data.frame} (\strong{required}): -\linkS4class{RLum.Data.Curve} or \code{data.frame} with measured curve data of type -stimulation time (t) (\code{values[,1]}) and measured counts (cts) (\code{values[,2]})} - -\item{P}{\link{vector} (\emph{optional}): -stimulation time in seconds. If no value is given the optimal value is -estimated automatically (see details). Greater values of P produce more -points in the rising tail of the curve.} -} -\value{ -The function returns the same data type as the input data type with -the transformed curve values. - -\strong{\code{RLum.Data.Curve}} - -\tabular{rl}{ -\verb{$CW2pLMi.x.t} \tab: transformed time values \cr -\verb{$CW2pLMi.method} \tab: used method for the production of the new data points -} -} -\description{ -Transforms a conventionally measured continuous-wave (CW) OSL-curve into a -pseudo linearly modulated (pLM) curve under linear modulation conditions -using the interpolation procedure described by Bos & Wallinga (2012). -} -\details{ -The complete procedure of the transformation is given in Bos & Wallinga -(2012). The input \code{data.frame} consists of two columns: time (t) and -count values (CW(t)) - -\strong{Nomenclature} -\itemize{ -\item P = stimulation time (s) -\item 1/P = stimulation rate (1/s) -} - -\strong{Internal transformation steps} - -(1) -log(CW-OSL) values - -(2) -Calculate t' which is the transformed time: -\deqn{t' = 1/2*1/P*t^2} - -(3) -Interpolate CW(t'), i.e. use the log(CW(t)) to obtain the count values -for the transformed time (t'). Values beyond \code{min(t)} and \code{max(t)} -produce \code{NA} values. - -(4) -Select all values for t' < \code{min(t)}, i.e. values beyond the time resolution -of t. Select the first two values of the transformed data set which contain -no \code{NA} values and use these values for a linear fit using \link{lm}. - -(5) -Extrapolate values for t' < \code{min(t)} based on the previously obtained -fit parameters. - -(6) -Transform values using -\deqn{pLM(t) = t/P*CW(t')} - -(7) -Combine values and truncate all values for t' > \code{max(t)} - -\strong{NOTE:} -The number of values for t' < \code{min(t)} depends on the stimulation -period (P) and therefore on the stimulation rate 1/P. To avoid the -production of too many artificial data at the raising tail of the determined -pLM curves it is recommended to use the automatic estimation routine for -\code{P}, i.e. provide no own value for \code{P}. -} -\note{ -According to Bos & Wallinga (2012) the number of extrapolated points -should be limited to avoid artificial intensity data. If \code{P} is -provided manually and more than two points are extrapolated, a warning -message is returned. -} -\section{Function version}{ - 0.3.1 -} - -\examples{ - -##(1) -##load CW-OSL curve data -data(ExampleData.CW_OSL_Curve, envir = environment()) - -##transform values -values.transformed <- CW2pLMi(ExampleData.CW_OSL_Curve) - -##plot -plot(values.transformed$x, values.transformed$y.t, log = "x") - -##(2) - produce Fig. 4 from Bos & Wallinga (2012) -##load data -data(ExampleData.CW_OSL_Curve, envir = environment()) -values <- CW_Curve.BosWallinga2012 - -##open plot area -plot(NA, NA, - xlim = c(0.001,10), - ylim = c(0,8000), - ylab = "pseudo OSL (cts/0.01 s)", - xlab = "t [s]", - log = "x", - main = "Fig. 4 - Bos & Wallinga (2012)") - - -values.t <- CW2pLMi(values, P = 1/20) -lines(values[1:length(values.t[,1]),1],CW2pLMi(values, P = 1/20)[,2], - col = "red", lwd = 1.3) -text(0.03,4500,"LM", col = "red", cex = .8) - -values.t <- CW2pHMi(values, delta = 40) -lines(values[1:length(values.t[,1]),1],CW2pHMi(values, delta = 40)[,2], - col = "black", lwd = 1.3) -text(0.005,3000,"HM", cex =.8) - -values.t <- CW2pPMi(values, P = 1/10) -lines(values[1:length(values.t[,1]),1], CW2pPMi(values, P = 1/10)[,2], - col = "blue", lwd = 1.3) -text(0.5,6500,"PM", col = "blue", cex = .8) - -} - -\section{How to cite}{ -Kreutzer, S., 2024. CW2pLMi(): Transform a CW-OSL curve into a pLM-OSL curve via interpolation under linear modulation conditions. Function version 0.3.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Bos, A.J.J. & Wallinga, J., 2012. How to visualize quartz OSL -signal components. Radiation Measurements, 47, 752-758. - -\strong{Further Reading} - -Bulur, E., 1996. An Alternative Technique For -Optically Stimulated Luminescence (OSL) Experiment. Radiation Measurements, -26, 701-709. - -Bulur, E., 2000. A simple transformation for converting CW-OSL curves to -LM-OSL curves. Radiation Measurements, 32, 141-145. -} -\seealso{ -\link{CW2pLM}, \link{CW2pHMi}, \link{CW2pPMi}, \link{fit_LMCurve}, -\linkS4class{RLum.Data.Curve} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) - -Based on comments and suggestions from:\cr -Adrie J.J. Bos, Delft University of Technology, The Netherlands -, RLum Developer Team} -\keyword{manip} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/CW2pPMi.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/CW2pPMi.Rd deleted file mode 100644 index b73a89459..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/CW2pPMi.Rd +++ /dev/null @@ -1,174 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CW2pPMi.R -\name{CW2pPMi} -\alias{CW2pPMi} -\title{Transform a CW-OSL curve into a pPM-OSL curve via interpolation under -parabolic modulation conditions} -\usage{ -CW2pPMi(values, P) -} -\arguments{ -\item{values}{\linkS4class{RLum.Data.Curve} or \link{data.frame} (\strong{required}): -\linkS4class{RLum.Data.Curve} or \code{data.frame} with measured curve data of type -stimulation time (t) (\code{values[,1]}) and measured counts (cts) (\code{values[,2]})} - -\item{P}{\link{vector} (\emph{optional}): -stimulation period in seconds. If no value is given, the optimal value is -estimated automatically (see details). Greater values of P produce more -points in the rising tail of the curve.} -} -\value{ -The function returns the same data type as the input data type with -the transformed curve values. - -\code{RLum.Data.Curve} - -\tabular{rl}{ -\verb{$CW2pPMi.x.t} \tab: transformed time values \cr -\verb{$CW2pPMi.method} \tab: used method for the production of the new data points -} - -\code{data.frame} - -\tabular{rl}{ -\verb{$x} \tab: time\cr -\verb{$y.t} \tab: transformed count values\cr -\verb{$x.t} \tab: transformed time values \cr -\verb{$method} \tab: used method for the production of the new data points -} -} -\description{ -Transforms a conventionally measured continuous-wave (CW) OSL-curve into a -pseudo parabolic modulated (pPM) curve under parabolic modulation conditions -using the interpolation procedure described by Bos & Wallinga (2012). -} -\details{ -The complete procedure of the transformation is given in Bos & Wallinga -(2012). The input \code{data.frame} consists of two columns: time (t) and -count values (CW(t)) - -\strong{Nomenclature} -\itemize{ -\item P = stimulation time (s) -\item 1/P = stimulation rate (1/s) -} - -\strong{Internal transformation steps} - -(1) -log(CW-OSL) values - -(2) -Calculate t' which is the transformed time: -\deqn{t' = (1/3)*(1/P^2)t^3} - -(3) -Interpolate CW(t'), i.e. use the log(CW(t)) to obtain the count values for -the transformed time (t'). Values beyond \code{min(t)} and \code{max(t)} -produce \code{NA} values. - -(4) -Select all values for t' < \code{min(t)}, i.e. values beyond the time resolution -of t. Select the first two values of the transformed data set which contain -no \code{NA} values and use these values for a linear fit using \link{lm}. - -(5) -Extrapolate values for t' < \code{min(t)} based on the previously obtained -fit parameters. The extrapolation is limited to two values. Other values at -the beginning of the transformed curve are set to 0. - -(6) -Transform values using -\deqn{pLM(t) = t^2/P^2*CW(t')} - -(7) -Combine all values and truncate all values for t' > \code{max(t)} - -\strong{NOTE:} -The number of values for t' < \code{min(t)} depends on the stimulation -period \code{P}. To avoid the production of too many artificial data at the -raising tail of the determined pPM curve, it is recommended to use the -automatic estimation routine for \code{P}, i.e. provide no value for -\code{P}. -} -\note{ -According to Bos & Wallinga (2012), the number of extrapolated points -should be limited to avoid artificial intensity data. If \code{P} is -provided manually, not more than two points are extrapolated. -} -\section{Function version}{ - 0.2.1 -} - -\examples{ - - -##(1) -##load CW-OSL curve data -data(ExampleData.CW_OSL_Curve, envir = environment()) - -##transform values -values.transformed <- CW2pPMi(ExampleData.CW_OSL_Curve) - -##plot -plot(values.transformed$x,values.transformed$y.t, log = "x") - -##(2) - produce Fig. 4 from Bos & Wallinga (2012) - -##load data -data(ExampleData.CW_OSL_Curve, envir = environment()) -values <- CW_Curve.BosWallinga2012 - -##open plot area -plot(NA, NA, - xlim = c(0.001,10), - ylim = c(0,8000), - ylab = "pseudo OSL (cts/0.01 s)", - xlab = "t [s]", - log = "x", - main = "Fig. 4 - Bos & Wallinga (2012)") - -values.t <- CW2pLMi(values, P = 1/20) -lines(values[1:length(values.t[,1]),1],CW2pLMi(values, P = 1/20)[,2], - col = "red",lwd = 1.3) -text(0.03,4500,"LM", col = "red", cex = .8) - -values.t <- CW2pHMi(values, delta = 40) -lines(values[1:length(values.t[,1]),1], CW2pHMi(values, delta = 40)[,2], - col = "black", lwd = 1.3) -text(0.005,3000,"HM", cex = .8) - -values.t <- CW2pPMi(values, P = 1/10) -lines(values[1:length(values.t[,1]),1], CW2pPMi(values, P = 1/10)[,2], - col = "blue", lwd = 1.3) -text(0.5,6500,"PM", col = "blue", cex = .8) - -} - -\section{How to cite}{ -Kreutzer, S., 2024. CW2pPMi(): Transform a CW-OSL curve into a pPM-OSL curve via interpolation under parabolic modulation conditions. Function version 0.2.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Bos, A.J.J. & Wallinga, J., 2012. How to visualize quartz OSL -signal components. Radiation Measurements, 47, 752-758. - -\strong{Further Reading} - -Bulur, E., 1996. An Alternative Technique For -Optically Stimulated Luminescence (OSL) Experiment. Radiation Measurements, -26, 701-709. - -Bulur, E., 2000. A simple transformation for converting CW-OSL curves to -LM-OSL curves. Radiation Measurements, 32, 141-145. -} -\seealso{ -\link{CW2pLM}, \link{CW2pLMi}, \link{CW2pHMi}, \link{fit_LMCurve}, \linkS4class{RLum.Data.Curve} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) - -Based on comments and suggestions from:\cr -Adrie J.J. Bos, Delft University of Technology, The Netherlands -, RLum Developer Team} -\keyword{manip} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.Al2O3C.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.Al2O3C.Rd deleted file mode 100644 index 4d536c8ec..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.Al2O3C.Rd +++ /dev/null @@ -1,46 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\name{ExampleData.Al2O3C} -\alias{ExampleData.Al2O3C} -\alias{data_CrossTalk} -\alias{data_ITC} -\title{Example Al2O3:C Measurement Data} -\format{ -Two datasets comprising \linkS4class{RLum.Analysis} data imported using the function \link{read_XSYG2R} - -\describe{ -\code{data_ITC}: Measurement data to determine the irradiation time correction, the data can -be analysed with the function \link{analyse_Al2O3C_ITC} - -\code{data_CrossTalk}: Measurement data obtained while estimating the irradiation cross-talk of the -reader used for the experiments. The data can be analysed either with the function -\link{analyse_Al2O3C_CrossTalk} or \link{analyse_Al2O3C_Measurement} -} -} -\description{ -Measurement data obtained from measuring Al2O3:C chips at the IRAMAT-CRP2A, Université Bordeaux -Montaigne in 2017 on a Freiberg Instruments lexsyg SMART reader. -The example data used in particular to allow test of the functions -developed in framework of the work by Kreutzer et al., 2018. -} -\note{ -From both datasets unneeded curves have been removed and -the number of aliquots have been reduced to a required minimum to keep the file size small, but -still being able to run the corresponding functions. -} -\examples{ - -##(1) curves -data(ExampleData.Al2O3C, envir = environment()) -plot_RLum(data_ITC[1:2]) - -} -\references{ -Kreutzer, S., Martin, L., Guérin, G., Tribolo, C., Selva, P., Mercier, N., 2018. -Environmental Dose Rate Determination Using a Passive Dosimeter: Techniques and Workflow for alpha-Al2O3:C Chips. -Geochronometria 45, 56–67. -} -\seealso{ -\link{analyse_Al2O3C_ITC}, \link{analyse_Al2O3C_CrossTalk}, \link{analyse_Al2O3C_Measurement} -} -\keyword{datasets} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.BINfileData.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.BINfileData.Rd deleted file mode 100644 index 8ba623d1b..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.BINfileData.Rd +++ /dev/null @@ -1,69 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\docType{data} -\name{ExampleData.BINfileData} -\alias{ExampleData.BINfileData} -\alias{CWOSL.SAR.Data} -\alias{TL.SAR.Data} -\title{Example data from a SAR OSL and SAR TL measurement for the package -Luminescence} -\format{ -\code{CWOSL.SAR.Data}: SAR OSL measurement data - -\code{TL.SAR.Data}: SAR TL measurement data - -Each class object contains two slots: (a) \code{METADATA} is a \link{data.frame} with -all metadata stored in the BIN file of the measurements and (b) \code{DATA} -contains a list of vectors of the measured data (usually count values). -} -\source{ -\strong{CWOSL.SAR.Data} - -\tabular{ll}{ -Lab: \tab Luminescence Laboratory Bayreuth \cr -Lab-Code: \tab BT607 \cr -Location: \tab Saxony/Germany \cr -Material: \tab Middle grain quartz measured on aluminium cups on a Risø TL/OSL DA-15 reader\cr -Reference: \tab unpublished -} - -\strong{TL.SAR.Data} - -\tabular{ll}{ -Lab: \tab Luminescence Laboratory of Cologne\cr -Lab-Code: \tab LP1_5\cr -Location: \tab Spain\cr -Material: \tab Flint \cr -Setup: \tab Risoe TL/OSL DA-20 reader (Filter: Semrock Brightline, HC475/50, N2, unpolished steel discs) \cr -Reference: \tab unpublished \cr -Remarks: \tab dataset limited to one position -} -} -\description{ -Example data from a SAR OSL and TL measurement for package Luminescence -directly extracted from a Risoe BIN-file and provided in an object of type -\linkS4class{Risoe.BINfileData} -} -\note{ -Please note that this example data cannot be exported to a BIN-file using the function -\code{writeR2BIN} as it was generated and implemented in the package long time ago. In the meantime -the BIN-file format changed. -} -\section{Version}{ - 0.1 -} - -\examples{ - -## show first 5 elements of the METADATA and DATA elements in the terminal -data(ExampleData.BINfileData, envir = environment()) -CWOSL.SAR.Data@METADATA[1:5,] -CWOSL.SAR.Data@DATA[1:5] - -} -\references{ -\strong{CWOSL.SAR.Data}: unpublished data - -\strong{TL.SAR.Data}: unpublished data -} -\keyword{datasets} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.CW_OSL_Curve.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.CW_OSL_Curve.Rd deleted file mode 100644 index e35cc43f9..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.CW_OSL_Curve.Rd +++ /dev/null @@ -1,53 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\docType{data} -\name{ExampleData.CW_OSL_Curve} -\alias{ExampleData.CW_OSL_Curve} -\alias{CW_Curve.BosWallinga2012} -\title{Example CW-OSL curve data for the package Luminescence} -\format{ -Data frame with 1000 observations on the following 2 variables: -\itemize{ -\item \code{list("x")}: a numeric vector, time -\item \code{list("y")}: a numeric vector, counts -} -} -\source{ -\strong{ExampleData.CW_OSL_Curve} - -\tabular{ll}{ -Lab: \tab Luminescence Laboratory Bayreuth\cr -Lab-Code: \tab BT607\cr -Location: \tab Saxony/Germany\cr -Material: \tab Middle grain quartz measured on aluminium cups on a Risø TL/OSL DA-15 reader.\cr -Reference: \tab unpublished data } - -\strong{CW_Curve.BosWallinga2012} - -\tabular{ll}{ -Lab: \tab Netherlands Centre for Luminescence Dating (NCL)\cr -Lab-Code: \tab NCL-2108077\cr -Location: \tab Guadalentin Basin, Spain\cr -Material: \tab Coarse grain quartz\cr -Reference: \tab Bos & Wallinga (2012) and Baartman et al. (2011) -} -} -\description{ -\code{data.frame} containing CW-OSL curve data (time, counts) -} -\examples{ - -data(ExampleData.CW_OSL_Curve, envir = environment()) -plot(ExampleData.CW_OSL_Curve) - -} -\references{ -Baartman, J.E.M., Veldkamp, A., Schoorl, J.M., Wallinga, J., -Cammeraat, L.H., 2011. Unravelling Late Pleistocene and Holocene landscape -dynamics: The Upper Guadalentin Basin, SE Spain. Geomorphology, 125, -172-185. - -Bos, A.J.J. & Wallinga, J., 2012. How to visualize quartz OSL signal -components. Radiation Measurements, 47, 752-758. -} -\keyword{datasets} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.CobbleData.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.CobbleData.Rd deleted file mode 100644 index f58cdca47..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.CobbleData.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\name{ExampleData.CobbleData} -\alias{ExampleData.CobbleData} -\title{Example data for calc_CobbleDoseRate()} -\format{ -A \code{\link{data.frame}}. Please see \link{calc_CobbleDoseRate} for detailed information -on the structure of the \link{data.frame}. -} -\description{ -An example data set for the function \link{calc_CobbleDoseRate} containing layer -specific information for the cobble to be used in the function. -} -\section{Version}{ - 0.1.0 -} - -\examples{ - -## Load data -data("ExampleData.CobbleData", envir = environment()) - -} -\keyword{datasets} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.DeValues.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.DeValues.Rd deleted file mode 100644 index f064d7b0f..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.DeValues.Rd +++ /dev/null @@ -1,74 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\name{ExampleData.DeValues} -\alias{ExampleData.DeValues} -\title{Example De data sets for the package Luminescence} -\format{ -A \link{list} with two elements, each containing a two column \link{data.frame}: - -\describe{ -\verb{$BT998}: De and De error values for a fine grain quartz -sample from a loess section in Rottewitz. - -\verb{$CA1}: Single grain De -and De error values for a coarse grain quartz sample from a fluvial deposit -in the rock shelter of Cueva Anton -} -} -\description{ -Equivalent dose (De) values measured for a fine grain quartz sample from a -loess section in Rottewitz (Saxony/Germany) and for a coarse grain quartz -sample from a fluvial deposit in the rock shelter of Cueva Anton -(Murcia/Spain). -} -\examples{ - -##(1) plot values as histogram -data(ExampleData.DeValues, envir = environment()) -plot_Histogram(ExampleData.DeValues$BT998, xlab = "De [s]") - -##(2) plot values as histogram (with second to gray conversion) -data(ExampleData.DeValues, envir = environment()) - -De.values <- Second2Gray(ExampleData.DeValues$BT998, - dose.rate = c(0.0438, 0.0019)) - - -plot_Histogram(De.values, xlab = "De [Gy]") - -} -\references{ -\strong{BT998} - -Unpublished data - -\strong{CA1} - -Burow, C., Kehl, M., Hilgers, A., Weniger, G.-C., Angelucci, D., Villaverde, -V., Zapata, J. and Zilhao, J. (2015). Luminescence dating of fluvial -deposits in the rock shelter of Cueva Anton, Spain. Geochronometria 52, 107-125. - -\strong{BT998} - -\tabular{ll}{ -Lab: \tab Luminescence Laboratory Bayreuth\cr -Lab-Code: \tab BT998\cr -Location: \tab Rottewitz (Saxony/Germany)\cr -Material: \tab Fine grain quartz measured on aluminium discs on a Risø TL/OSL DA-15 reader\cr -Units: \tab Values are given in seconds \cr -Dose Rate: \tab Dose rate of the beta-source at measurement ca. 0.0438 Gy/s +/- 0.0019 Gy/s\cr -Measurement Date: \tab 2012-01-27 -} - -\strong{CA1} - -\tabular{ll}{ -Lab: \tab Cologne Luminescence Laboratory (CLL)\cr -Lab-Code: \tab C-L2941\cr -Location: \tab Cueva Anton (Murcia/Spain)\cr -Material: \tab Coarse grain quartz (200-250 microns) measured on single grain discs on a Risoe TL/OSL DA-20 reader\cr -Units: \tab Values are given in Gray \cr -Measurement Date: \tab 2012 -} -} -\keyword{datasets} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.Fading.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.Fading.Rd deleted file mode 100644 index 25b3d8b9e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.Fading.Rd +++ /dev/null @@ -1,91 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\name{ExampleData.Fading} -\alias{ExampleData.Fading} -\title{Example data for feldspar fading measurements} -\format{ -A \link{list} with two elements, each containing a further \link{list} of -\link{data.frame}s containing the data on the fading and equivalent dose measurements: - -\describe{ -\verb{$fading.data}: A named \link{list} of \link{data.frame}s, -each having three named columns (\verb{LxTx, LxTx.error, timeSinceIrradiation}).\cr -\code{..$IR50}: Fading data of the IR50 signal.\cr -\code{..$IR100}: Fading data of the IR100 signal.\cr -\code{..$IR150}: Fading data of the IR150 signal.\cr -\code{..$IR225}: Fading data of the IR225 signal.\cr - -\verb{$equivalentDose.data}: A named of \link{data.frame}s, -each having three named columns (\verb{dose, LxTx, LxTx.error}).\cr -\code{..$IR50}: Equivalent dose measurement data of the IR50 signal.\cr -\code{..$IR100}: Equivalent dose measurement data of the IR100 signal.\cr -\code{..$IR150}: Equivalent dose measurement data of the IR150 signal.\cr -\code{..$IR225}: Equivalent dose measurement data of the IR225 signal.\cr -} -} -\source{ -These data were kindly provided by Georgina E. King. Detailed information -on the sample UNIL/NB123 can be found in the reference given below. The raw -data can be found in the accompanying supplementary information. -} -\description{ -Example data set for fading measurements of the IR50, IR100, IR150 and -IR225 feldspar signals of sample UNIL/NB123. It further contains regular equivalent dose -measurement data of the same sample, which can be used to apply a -fading correction to. -} -\examples{ - -## Load example data -data("ExampleData.Fading", envir = environment()) - -## Get fading measurement data of the IR50 signal -IR50_fading <- ExampleData.Fading$fading.data$IR50 -head(IR50_fading) - -## Determine g-value and rho' for the IR50 signal -IR50_fading.res <- analyse_FadingMeasurement(IR50_fading) - -## Show g-value and rho' results -gval <- get_RLum(IR50_fading.res) -rhop <- get_RLum(IR50_fading.res, "rho_prime") - -gval -rhop - -## Get LxTx values of the IR50 DE measurement -IR50_De.LxTx <- ExampleData.Fading$equivalentDose.data$IR50 - -## Calculate the De of the IR50 signal -IR50_De <- plot_GrowthCurve(IR50_De.LxTx, - mode = "interpolation", - fit.method = "EXP") - -## Extract the calculated De and its error -IR50_De.res <- get_RLum(IR50_De) -De <- c(IR50_De.res$De, IR50_De.res$De.Error) - -## Apply fading correction (age conversion greatly simplified) -IR50_Age <- De / 7.00 -IR50_Age.corr <- calc_FadingCorr(IR50_Age, g_value = IR50_fading.res) - - -} -\references{ -King, G.E., Herman, F., Lambert, R., Valla, P.G., Guralnik, B., 2016. -Multi-OSL-thermochronometry of feldspar. Quaternary Geochronology 33, 76-87. -doi:10.1016/j.quageo.2016.01.004 - -\strong{Details} - -\tabular{ll}{ -Lab: \tab University of Lausanne \cr -Lab-Code: \tab UNIL/NB123 \cr -Location: \tab Namche Barwa (eastern Himalayas)\cr -Material: \tab Coarse grained (180-212 microns) potassium feldspar \cr -Units: \tab Values are given in seconds \cr -Lab Dose Rate: \tab Dose rate of the beta-source at measurement ca. 0.1335 +/- 0.004 Gy/s \cr -Environmental Dose Rate: \tab 7.00 +/- 0.92 Gy/ka (includes internal dose rate) -} -} -\keyword{datasets} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.FittingLM.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.FittingLM.Rd deleted file mode 100644 index 7cf93daf5..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.FittingLM.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\name{ExampleData.FittingLM} -\alias{ExampleData.FittingLM} -\alias{values.curve} -\alias{values.curveBG} -\title{Example data for fit_LMCurve() in the package Luminescence} -\format{ -Two objects (data.frames) with two columns (time and counts). -} -\source{ -\tabular{ll}{ -Lab: \tab Luminescence Laboratory Bayreuth\cr -Lab-Code: \tab BT900\cr -Location: \tab Norway\cr -Material: \tab Beach deposit, coarse grain quartz measured on aluminium discs on a Risø TL/OSL DA-15 reader\cr -} -} -\description{ -Linearly modulated (LM) measurement data from a quartz sample from Norway -including background measurement. Measurements carried out in the -luminescence laboratory at the University of Bayreuth. -} -\examples{ - -##show LM data -data(ExampleData.FittingLM, envir = environment()) -plot(values.curve,log="x") - -} -\references{ -Fuchs, M., Kreutzer, S., Fischer, M., Sauer, D., Soerensen, R., 2012. OSL and IRSL -dating of raised beach sand deposits along the south-eastern coast of Norway. -Quaternary Geochronology, 10, 195-200. -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.LxTxData.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.LxTxData.Rd deleted file mode 100644 index 4264948ce..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.LxTxData.Rd +++ /dev/null @@ -1,30 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\name{ExampleData.LxTxData} -\alias{ExampleData.LxTxData} -\alias{LxTxData} -\title{Example Lx/Tx data from CW-OSL SAR measurement} -\format{ -A \code{\link{data.frame}} with 4 columns (Dose, LxTx, LxTx.Error, TnTx). -} -\source{ -\tabular{ll}{ -Lab: \tab Luminescence Laboratory Bayreuth\cr -Lab-Code: \tab BT607\cr -Location: \tab Ostrau (Saxony-Anhalt/Germany)\cr -Material: \tab Middle grain (38-63 \eqn{\mu}m) quartz measured on a Risoe TL/OSL DA-15 reader. -} -} -\description{ -LxTx data from a SAR measurement for the package Luminescence. -} -\examples{ - -## plot Lx/Tx data vs dose [s] -data(ExampleData.LxTxData, envir = environment()) -plot(LxTxData$Dose,LxTxData$LxTx) - -} -\references{ -unpublished data -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.LxTxOSLData.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.LxTxOSLData.Rd deleted file mode 100644 index 0e7837190..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.LxTxOSLData.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\name{ExampleData.LxTxOSLData} -\alias{ExampleData.LxTxOSLData} -\alias{Lx.data} -\alias{Tx.data} -\title{Example Lx and Tx curve data from an artificial OSL measurement} -\format{ -Two \code{\link{data.frame}}s containing time and count values. -} -\source{ -Arbitrary OSL measurement. -} -\description{ -\code{Lx} and \code{Tx} data of continuous wave (CW-) OSL signal curves. -} -\examples{ - -##load data -data(ExampleData.LxTxOSLData, envir = environment()) - -##plot data -plot(Lx.data) -plot(Tx.data) - -} -\references{ -unpublished data -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.MortarData.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.MortarData.Rd deleted file mode 100644 index 4d676db7d..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.MortarData.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\name{ExampleData.MortarData} -\alias{ExampleData.MortarData} -\alias{MortarData} -\title{Example equivalent dose data from mortar samples} -\format{ -Two \code{\link{data.frame}}s containing De and De error -} -\source{ -Arbitrary measurements. -} -\description{ -Arbitrary data to test the function \code{calc_EED_Model} -} -\examples{ - -##load data -data(ExampleData.MortarData, envir = environment()) - -##plot data -plot(MortarData) - -} -\references{ -unpublished data -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.RLum.Analysis.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.RLum.Analysis.Rd deleted file mode 100644 index 00677a1eb..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.RLum.Analysis.Rd +++ /dev/null @@ -1,50 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\name{ExampleData.RLum.Analysis} -\alias{ExampleData.RLum.Analysis} -\alias{IRSAR.RF.Data} -\title{Example data as \linkS4class{RLum.Analysis} objects} -\format{ -\code{IRSAR.RF.Data}: IRSAR.RF.Data on coarse grain feldspar - -Each object contains data needed for the given protocol analysis. -} -\source{ -\strong{IRSAR.RF.Data} - -These data were kindly provided by Tobias Lauer and Matthias Krbetschek. - -\tabular{ll}{ -Lab: \tab Luminescence Laboratory TU Bergakademie Freiberg\cr -Lab-Code: \tab ZEU/SA1\cr -Location: \tab Zeuchfeld (Zeuchfeld Sandur; Saxony-Anhalt/Germany)\cr -Material: \tab K-feldspar (130-200 \eqn{\mu}m)\cr -Reference: \tab Kreutzer et al. (2014) -} -} -\description{ -Collection of different \linkS4class{RLum.Analysis} objects for -protocol analysis. -} -\section{Version}{ - 0.1 -} - -\examples{ - -##load data -data(ExampleData.RLum.Analysis, envir = environment()) - -##plot data -plot_RLum(IRSAR.RF.Data) - -} -\references{ -\strong{IRSAR.RF.Data} - -Kreutzer, S., Lauer, T., Meszner, S., Krbetschek, M.R., Faust, D., Fuchs, -M., 2014. Chronology of the Quaternary profile Zeuchfeld in Saxony-Anhalt / -Germany - a preliminary luminescence dating study. Zeitschrift fuer -Geomorphologie 58, 5-26. doi: 10.1127/0372-8854/2012/S-00112 -} -\keyword{datasets} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.RLum.Data.Image.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.RLum.Data.Image.Rd deleted file mode 100644 index 9d80f9d6c..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.RLum.Data.Image.Rd +++ /dev/null @@ -1,43 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\name{ExampleData.RLum.Data.Image} -\alias{ExampleData.RLum.Data.Image} -\title{Example data as \linkS4class{RLum.Data.Image} objects} -\format{ -Object of class \linkS4class{RLum.Data.Image} -} -\source{ -\strong{ExampleData.RLum.Data.Image} - -These data were kindly provided by Regina DeWitt. - -\tabular{ll}{ -Lab.: \tab Department of Physics, East-Carolina University, NC, USA\cr -Lab-Code: \tab - \cr -Location: \tab - \cr -Material: \tab - \cr -Reference: \tab - \cr -} - -Image data is a measurement of fluorescent ceiling lights with a cooled -Princeton Instruments (TM) camera fitted on Risø DA-20 TL/OSL reader. -} -\description{ -Measurement of Princton Instruments camera imported with the function -\link{read_SPE2R} to R to produce an -\linkS4class{RLum.Data.Image} object. -} -\section{Version}{ - 0.1 -} - -\examples{ - -##load data -data(ExampleData.RLum.Data.Image, envir = environment()) - -##plot data -plot_RLum(ExampleData.RLum.Data.Image) - -} -\keyword{datasets} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.ScaleGammaDose.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.ScaleGammaDose.Rd deleted file mode 100644 index e6287377e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.ScaleGammaDose.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\name{ExampleData.ScaleGammaDose} -\alias{ExampleData.ScaleGammaDose} -\title{Example data for scale_GammaDose()} -\format{ -A \code{\link{data.frame}}. Please see \code{?scale_GammaDose()} for a detailed description -of its structure. -} -\description{ -An example data set for the function \code{scale_GammaDose()} containing layer -specific information to scale the gamma dose rate considering variations in -soil radioactivity. -} -\section{Version}{ - 0.1 -} - -\examples{ - -## Load data -data("ExampleData.ScaleGammaDose", envir = environment()) - -} -\keyword{datasets} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.SurfaceExposure.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.SurfaceExposure.Rd deleted file mode 100644 index b1334a1b1..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.SurfaceExposure.Rd +++ /dev/null @@ -1,155 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\name{ExampleData.SurfaceExposure} -\alias{ExampleData.SurfaceExposure} -\title{Example OSL surface exposure dating data} -\format{ -A \link{list} with 4 elements: - -\tabular{ll}{ -\strong{Element} \tab \strong{Content} \cr -\verb{$sample_1} \tab A \link{data.frame} with 3 columns (depth, intensity, error) \cr -\verb{$sample_2} \tab A \link{data.frame} with 3 columns (depth, intensity, error) \cr -\verb{$set_1} \tab A \link{list} of 4 \link{data.frame}s, each representing a sample with different ages \cr -\verb{$set_2} \tab A \link{list} of 5 \link{data.frame}s, each representing a sample with different ages \cr -} -} -\source{ -See examples for the code used to create the data sets. -} -\description{ -A set of synthetic OSL surface exposure dating data to demonstrate the -\link{fit_SurfaceExposure} functionality. See examples to reproduce the data -interactively. -} -\details{ -\strong{\verb{$sample_1}} - -\tabular{ccc}{ -\strong{mu} \tab \strong{\code{sigmaphi}} \tab \strong{age} \cr -0.9 \tab 5e-10 \tab 10000 \cr -} - -\strong{\verb{$sample_2}} - -\tabular{ccccc}{ -\strong{mu} \tab \strong{\code{sigmaphi}} \tab \strong{age} \tab \strong{Dose rate} \tab \strong{D0} \cr -0.9 \tab 5e-10 \tab 10000 \tab 2.5 \tab 40 \cr -} - -\strong{\verb{$set_1}} - -\tabular{ccc}{ -\strong{mu} \tab \strong{\code{sigmaphi}} \tab \strong{ages} \cr -0.9 \tab 5e-10 \tab 1e3, 1e4, 1e5, 1e6 \cr -} - -\strong{\verb{$set_2}} - -\tabular{ccccc}{ -\strong{mu} \tab \strong{\code{sigmaphi}} \tab \strong{ages} \tab \strong{Dose rate} \tab \strong{D0} \cr -0.9 \tab 5e-10 \tab 1e2, 1e3, 1e4, 1e5, 1e6 \tab 1.0 \tab 40 \cr -} -} -\examples{ - -## ExampleData.SurfaceExposure$sample_1 -sigmaphi <- 5e-10 -age <- 10000 -mu <- 0.9 -x <- seq(0, 10, 0.1) -fun <- exp(-sigmaphi * age * 365.25*24*3600 * exp(-mu * x)) - -set.seed(666) -synth_1 <- data.frame(depth = x, - intensity = jitter(fun, 1, 0.1), - error = runif(length(x), 0.01, 0.2)) - -## VALIDATE sample_1 -fit_SurfaceExposure(synth_1, mu = mu, sigmaphi = sigmaphi) - - - - -## ExampleData.SurfaceExposure$sample_2 -sigmaphi <- 5e-10 -age <- 10000 -mu <- 0.9 -x <- seq(0, 10, 0.1) -Ddot <- 2.5 / 1000 / 365.25 / 24 / 60 / 60 # 2.5 Gy/ka in Seconds -D0 <- 40 -fun <- (sigmaphi * exp(-mu * x) * - exp(-(age * 365.25*24*3600) * - (sigmaphi * exp(-mu * x) + Ddot/D0)) + Ddot/D0) / - (sigmaphi * exp(-mu * x) + Ddot/D0) - -set.seed(666) -synth_2 <- data.frame(depth = x, - intensity = jitter(fun, 1, 0.1), - error = runif(length(x), 0.01, 0.2)) - -## VALIDATE sample_2 -fit_SurfaceExposure(synth_2, mu = mu, sigmaphi = sigmaphi, Ddot = 2.5, D0 = D0) - - - -## ExampleData.SurfaceExposure$set_1 -sigmaphi <- 5e-10 -mu <- 0.9 -x <- seq(0, 15, 0.2) -age <- c(1e3, 1e4, 1e5, 1e6) -set.seed(666) - -synth_3 <- vector("list", length = length(age)) - -for (i in 1:length(age)) { - fun <- exp(-sigmaphi * age[i] * 365.25*24*3600 * exp(-mu * x)) - synth_3[[i]] <- data.frame(depth = x, - intensity = jitter(fun, 1, 0.05)) -} - - -## VALIDATE set_1 -fit_SurfaceExposure(synth_3, age = age, sigmaphi = sigmaphi) - - - -## ExampleData.SurfaceExposure$set_2 -sigmaphi <- 5e-10 -mu <- 0.9 -x <- seq(0, 15, 0.2) -age <- c(1e2, 1e3, 1e4, 1e5, 1e6) -Ddot <- 1.0 / 1000 / 365.25 / 24 / 60 / 60 # 2.0 Gy/ka in Seconds -D0 <- 40 -set.seed(666) - -synth_4 <- vector("list", length = length(age)) - -for (i in 1:length(age)) { - fun <- (sigmaphi * exp(-mu * x) * - exp(-(age[i] * 365.25*24*3600) * - (sigmaphi * exp(-mu * x) + Ddot/D0)) + Ddot/D0) / - (sigmaphi * exp(-mu * x) + Ddot/D0) - - synth_4[[i]] <- data.frame(depth = x, - intensity = jitter(fun, 1, 0.05)) -} - - -## VALIDATE set_2 -fit_SurfaceExposure(synth_4, age = age, sigmaphi = sigmaphi, D0 = D0, Ddot = 1.0) - -\dontrun{ -ExampleData.SurfaceExposure <- list( - sample_1 = synth_1, - sample_2 = synth_2, - set_1 = synth_3, - set_2 = synth_4 -) -} - -} -\references{ -Unpublished synthetic data -} -\keyword{datasets} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.TR_OSL.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.TR_OSL.Rd deleted file mode 100644 index dc752db14..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.TR_OSL.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\name{ExampleData.TR_OSL} -\alias{ExampleData.TR_OSL} -\title{Example TR-OSL data} -\format{ -One \linkS4class{RLum.Data.Curve} dataset imported using the function \link{read_XSYG2R} - -\describe{ -\code{ExampleData.TR_OSL}: A single \linkS4class{RLum.Data.Curve} object with the TR-OSL data - -} -} -\description{ -Single TR-OSL curve obtained by Schmidt et al. (under review) for quartz sample BT729 -(origin: Trebgast Valley, Germany, quartz, 90-200 µm, unpublished data). -} -\examples{ - -##(1) curves -data(ExampleData.TR_OSL, envir = environment()) -plot_RLum(ExampleData.TR_OSL) - -} -\references{ -Schmidt, C., Simmank, O., Kreutzer, S., under review. -Time-Resolved Optically Stimulated Luminescence of Quartz in the Nanosecond Time Domain. Journal -of Luminescence, 1-90 -} -\seealso{ -\link{fit_OSLLifeTimes} -} -\keyword{datasets} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.XSYG.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.XSYG.Rd deleted file mode 100644 index cd499e490..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.XSYG.Rd +++ /dev/null @@ -1,104 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\name{ExampleData.XSYG} -\alias{ExampleData.XSYG} -\alias{OSL.SARMeasurement} -\alias{TL.Spectrum} -\title{Example data for a SAR OSL measurement and a TL spectrum using a lexsyg -reader} -\format{ -\code{OSL.SARMeasurement}: SAR OSL measurement data - -The data contain two elements: (a) \verb{$Sequence.Header} is a -\link{data.frame} with metadata from the measurement,(b) -\code{Sequence.Object} contains an \linkS4class{RLum.Analysis} object -for further analysis. - -\code{TL.Spectrum}: TL spectrum data - -\linkS4class{RLum.Data.Spectrum} object for further analysis. The -spectrum was cleaned from cosmic-rays using the function - -\code{apply_CosmicRayRemoval}. Note that no quantum efficiency calibration -was performed. -} -\source{ -\strong{OSL.SARMeasurement} - -\tabular{ll}{ -Lab: \tab Luminescence Laboratory Giessen\cr -Lab-Code: \tab no code\cr -Location: \tab not specified\cr -Material: \tab Coarse grain quartz on steel cups on lexsyg research reader\cr -Reference: \tab unpublished -} - -\strong{TL.Spectrum} - -\tabular{ll}{ -Lab: \tab Luminescence Laboratory Giessen\cr -Lab-Code: \tab BT753\cr -Location: \tab Dolni Vestonice/Czech Republic\cr -Material: \tab Fine grain polymineral on steel cups on lexsyg research reader\cr -Reference: \tab Fuchs et al., 2013 \cr -Spectrum: \tab Integration time 19 s, channel time 20 s\cr -Heating: \tab 1 K/s, up to 500 deg. C -} -} -\description{ -Example data from a SAR OSL measurement and a TL spectrum for package -Luminescence imported from a Freiberg Instruments XSYG file using the -function \link{read_XSYG2R}. -} -\section{Version}{ - 0.1 -} - -\examples{ -##show data -data(ExampleData.XSYG, envir = environment()) - -## ========================================= -##(1) OSL.SARMeasurement -OSL.SARMeasurement - -##show $Sequence.Object -OSL.SARMeasurement$Sequence.Object - -##grep OSL curves and plot the first curve -OSLcurve <- get_RLum(OSL.SARMeasurement$Sequence.Object, -recordType="OSL")[[1]] -plot_RLum(OSLcurve) - -## ========================================= -##(2) TL.Spectrum -TL.Spectrum - -##plot simple spectrum (2D) -plot_RLum.Data.Spectrum(TL.Spectrum, - plot.type="contour", - xlim = c(310,750), - ylim = c(0,300), - bin.rows=10, - bin.cols = 1) - -##plot 3d spectrum (uncomment for usage) -# plot_RLum.Data.Spectrum(TL.Spectrum, plot.type="persp", -# xlim = c(310,750), ylim = c(0,300), bin.rows=10, -# bin.cols = 1) - -} -\references{ -Unpublished data measured to serve as example data for that -package. Location origin of sample BT753 is given here: - -Fuchs, M., Kreutzer, S., Rousseau, D.D., Antoine, P., Hatte, C., Lagroix, -F., Moine, O., Gauthier, C., Svoboda, J., Lisa, L., 2013. The loess sequence -of Dolni Vestonice, Czech Republic: A new OSL-based chronology of the Last -Climatic Cycle. Boreas, 42, 664--677. -} -\seealso{ -\link{read_XSYG2R}, \linkS4class{RLum.Analysis}, \linkS4class{RLum.Data.Spectrum}, -\link{plot_RLum}, \link{plot_RLum.Analysis}, \link{plot_RLum.Data.Spectrum} -} -\keyword{datasets} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.portableOSL.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.portableOSL.Rd deleted file mode 100644 index 4befb6831..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/ExampleData.portableOSL.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\docType{data} -\name{ExampleData.portableOSL} -\alias{ExampleData.portableOSL} -\title{Example portable OSL curve data for the package Luminescence} -\source{ -\strong{ExampleData.portableOSL} - -\tabular{ll}{ -Lab: \tab Cologne Luminescence Laboratory\cr -Lab-Code: \tab \code{none} \cr -Location: \tab Nievenheim/Germany\cr -Material: \tab Fine grain quartz \cr -Reference: \tab unpublished data -} -} -\description{ -A \code{list} of \linkS4class{RLum.Analysis} objects, each containing -the same number of \linkS4class{RLum.Data.Curve} objects representing -individual OSL, IRSL and dark count measurements of a sample. -} -\examples{ - -data(ExampleData.portableOSL, envir = environment()) -plot_RLum(ExampleData.portableOSL) - -} -\keyword{datasets} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/GitHub-API.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/GitHub-API.Rd deleted file mode 100644 index a025cee17..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/GitHub-API.Rd +++ /dev/null @@ -1,101 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/github.R -\name{GitHub-API} -\alias{GitHub-API} -\alias{github_commits} -\alias{github_branches} -\alias{github_issues} -\title{GitHub API} -\usage{ -github_commits(user = "r-lum", repo = "luminescence", branch = "master", n = 5) - -github_branches(user = "r-lum", repo = "luminescence") - -github_issues(user = "r-lum", repo = "luminescence", verbose = TRUE) -} -\arguments{ -\item{user}{\link{character} (\emph{with default}): -GitHub user name (defaults to \code{'r-lum'}).} - -\item{repo}{\link{character} (\emph{with default}): -name of a GitHub repository (defaults to \code{'luminescence'}).} - -\item{branch}{\link{character} (\emph{with default}): -branch of a GitHub repository (defaults to \code{'master'}).} - -\item{n}{\link{integer} (\emph{with default}): -number of commits returned (defaults to 5).} - -\item{verbose}{\link{logical} (\emph{with default}): -print the output to the console (defaults to \code{TRUE}).} -} -\value{ -\code{github_commits}: \link{data.frame} with columns: - -\tabular{ll}{ -\verb{[ ,1]} \tab SHA \cr -\verb{[ ,2]} \tab AUTHOR \cr -\verb{[ ,3]} \tab DATE \cr -\verb{[ ,4]} \tab MESSAGE \cr -} - -\code{github_branches}: \link{data.frame} with columns: - -\tabular{ll}{ -\verb{[ ,1]} \tab BRANCH \cr -\verb{[ ,2]} \tab SHA \cr -\verb{[ ,3]} \tab INSTALL \cr -} - -\code{github_commits}: Nested \link{list} with \code{n} elements. -Each commit element is a list with elements: - -\tabular{ll}{ -\verb{[[1]]} \tab NUMBER \cr -\verb{[[2]]} \tab TITLE \cr -\verb{[[3]]} \tab BODY \cr -\verb{[[4]]} \tab CREATED \cr -\verb{[[5]]} \tab UPDATED \cr -\verb{[[6]]} \tab CREATOR \cr -\verb{[[7]]} \tab URL \cr -\verb{[[8]]} \tab STATUS \cr -} -} -\description{ -R Interface to the GitHub API v3. -} -\details{ -These functions can be used to query a specific repository hosted on GitHub. \cr - -\code{github_commits} lists the most recent \code{n} commits of a specific branch of a repository. - -\code{github_branches} can be used to list all current branches of a -repository and returns the corresponding SHA hash as well as an installation -command to install the branch in R via the 'devtools' package. - -\code{github_issues} lists all open issues for a repository in valid YAML. -} -\section{Function version}{ - 0.1.0 -} - -\examples{ - -\dontrun{ -github_branches(user = "r-lum", repo = "luminescence") -github_issues(user = "r-lum", repo = "luminescence") -github_commits(user = "r-lum", repo = "luminescence", branch = "master", n = 10) -} - -} - -\section{How to cite}{ -Burow, C., 2024. GitHub-API(): GitHub API. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -GitHub Developer API v3. \url{https://docs.github.com/v3/}, last accessed: 10/01/2017. -} -\author{ -Christoph Burow, University of Cologne (Germany) -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/Luminescence-package.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/Luminescence-package.Rd deleted file mode 100644 index a206adfce..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/Luminescence-package.Rd +++ /dev/null @@ -1,150 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\docType{package} -\name{Luminescence-package} -\alias{Luminescence-package} -\alias{Luminescence} -\title{Comprehensive Luminescence Dating Data Analysis\cr - -\if{html}{ -\figure{Luminescence_logo.png}{options: width="75" alt="r-luminescence.org"} -}} -\description{ -A collection of various R functions for the purpose of luminescence dating -data analysis. This includes, amongst others, data import, export, -application of age models, curve deconvolution, sequence analysis and -plotting of equivalent dose distributions. -} -\details{ -\strong{Supervisor of the initial version in 2012} - -Markus Fuchs, Justus-Liebig-University Giessen, Germany - -\strong{Support contact} -\itemize{ -\item \email{developers@r-luminescence.org} -\item \url{https://github.com/R-Lum/Luminescence/discussions} -} - -\strong{Bug reporting} -\itemize{ -\item \email{developers@r-luminescence.org} or -\item \url{https://github.com/R-Lum/Luminescence/issues} -} - -\strong{Project website} -\itemize{ -\item \url{https://r-luminescence.org} -} - -\strong{Project source code repository} -\itemize{ -\item \url{https://github.com/R-Lum/Luminescence} -} - -\strong{Related package projects} -\itemize{ -\item \url{https://cran.r-project.org/package=RLumShiny} -\item \url{https://cran.r-project.org/package=RLumModel} -\item \url{https://cran.r-project.org/package=RLumCarlo} -\item \url{https://cran.r-project.org/package=RCarb} -} - -\strong{Funding} -\itemize{ -\item 2011-2013: The initial version of the package was developed, while Sebastian Kreutzer -was funded through the DFG programme "Rekonstruktion der Umweltbedingungen -des Spätpleistozäns in Mittelsachsen anhand von Löss-Paläobodensequenzen" -(DFG id: 46526743) -\item 2014-2018: Cooperation and personal exchange between the developers is gratefully -funded by the DFG (SCHM 3051/3-1) in the framework of the program -"Scientific Networks". Project title: "RLum.Network: Ein -Wissenschaftsnetzwerk zur Analyse von Lumineszenzdaten mit R" (2014-2018) -\item 05/2014-12/2019: The work of Sebastian Kreutzer as maintainer of the package was supported -by LabEx LaScArBx (ANR - n. ANR-10-LABX-52). -\item 01/2020-04/2022: Sebastian Kreutzer as maintainer of the package has received funding -from the European Union’s Horizon 2020 research and innovation programme under -the Marie Skłodowska-Curie grant agreement No 844457 (CREDit), and could continue -maintaining the package. -\item since 03/2023: Sebastian Kreutzer as maintainer of the package receives funding from the -DFG Heisenberg programme No 505822867. -\item All other authors gratefully received additional funding from various public funding bodies. -} -} -\references{ -Dietze, M., Kreutzer, S., Fuchs, M.C., Burow, C., Fischer, M., -Schmidt, C., 2013. A practical guide to the R package Luminescence. -Ancient TL, 31 (1), 11-18. - -Dietze, M., Kreutzer, S., Burow, C., Fuchs, M.C., Fischer, M., Schmidt, C., 2016. The abanico plot: -visualising chronometric data with individual standard errors. Quaternary Geochronology 31, 1-7. -https://doi.org/10.1016/j.quageo.2015.09.003 - -Fuchs, M.C., Kreutzer, S., Burow, C., Dietze, M., Fischer, M., Schmidt, C., -Fuchs, M., 2015. Data processing in luminescence dating analysis: An -exemplary workflow using the R package 'Luminescence'. Quaternary -International, 362,8-13. https://doi.org/10.1016/j.quaint.2014.06.034 - -Kreutzer, S., Schmidt, C., Fuchs, M.C., Dietze, M., Fischer, M., Fuchs, M., -2012. Introducing an R package for luminescence dating analysis. Ancient TL, -30 (1), 1-8. - -Mercier, N., Kreutzer, S., Christophe, C., Guérin, G., Guibert, P., Lahaye, C., Lanos, P., Philippe, A., -Tribolo, C., 2016. Bayesian statistics in luminescence dating: The 'baSAR'-model and its -implementation in the R package ’Luminescence’. Ancient TL 34 (2), 14-21. - -Mercier, N., Galharret, J.-M., Tribolo, C., Kreutzer, S., Philippe, A., 2022. -Luminescence age calculation through Bayesian convolution of equivalent dose -and dose-rate distributions: the De_Dr model. -Geochronology 4, 297–310. https://doi.org/10.5194/gchron-4-297-2022 - -Smedley, R.K., 2015. A new R function for the Internal External Uncertainty (IEU) model. -Ancient TL, 33 (1), 16-21. - -King, E.G., Burow, C., Roberts, H., Pearce, N.J.G., 2018. Age determination -using feldspar: evaluating fading-correction model performance. Radiation Measurements 119, 58-73. -https://doi.org/10.1016/j.radmeas.2018.07.013 -} -\seealso{ -Useful links: -\itemize{ - \item \url{https://r-lum.github.io/Luminescence/} - \item Report bugs at \url{https://github.com/R-Lum/Luminescence/issues} -} - -} -\author{ -\strong{Maintainer}: Sebastian Kreutzer \email{maintainer_luminescence@r-luminescence.org} (\href{https://orcid.org/0000-0002-0734-2199}{ORCID}) [translator, data contributor] - -Authors: -\itemize{ - \item Christoph Burow (\href{https://orcid.org/0000-0002-5023-4046}{ORCID}) [translator, data contributor] - \item Michael Dietze (\href{https://orcid.org/0000-0001-6063-1726}{ORCID}) - \item Margret C. Fuchs (\href{https://orcid.org/0000-0001-7210-1132}{ORCID}) - \item Christoph Schmidt (\href{https://orcid.org/0000-0002-2309-3209}{ORCID}) - \item Manfred Fischer [translator] - \item Johannes Friedrich (\href{https://orcid.org/0000-0002-0805-9547}{ORCID}) - \item Norbert Mercier (\href{https://orcid.org/0000-0002-6375-9108}{ORCID}) - \item Anne Philippe (\href{https://orcid.org/0000-0002-5331-5087}{ORCID}) - \item Svenja Riedesel (\href{https://orcid.org/0000-0003-2936-8776}{ORCID}) - \item Martin Autzen (\href{https://orcid.org/0000-0001-6249-426X}{ORCID}) - \item Dirk Mittelstrass (\href{https://orcid.org/0000-0002-9567-8791}{ORCID}) - \item Harrison J. Gray (\href{https://orcid.org/0000-0002-4555-7473}{ORCID}) - \item Jean-Michel Galharret (\href{https://orcid.org/0000-0003-2219-8727}{ORCID}) - \item Marco Colombo (\href{https://orcid.org/0000-0001-6672-0623}{ORCID}) -} - -Other contributors: -\itemize{ - \item Rachel K. Smedley (\href{https://orcid.org/0000-0001-7773-5193}{ORCID}) [contributor] - \item Claire Christophe [contributor] - \item Antoine Zink (\href{https://orcid.org/0000-0001-7146-1101}{ORCID}) [contributor] - \item Julie Durcan (\href{https://orcid.org/0000-0001-8724-8022}{ORCID}) [contributor] - \item Georgina E. King (\href{https://orcid.org/0000-0003-1059-8192}{ORCID}) [contributor, data contributor] - \item Guillaume Guerin (\href{https://orcid.org/0000-0001-6298-5579}{ORCID}) [contributor] - \item Pierre Guibert (\href{https://orcid.org/0000-0001-8969-8684}{ORCID}) [contributor] - \item Markus Fuchs (\href{https://orcid.org/0000-0003-4669-6528}{ORCID}) [thesis advisor] -} - -} -\keyword{package} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/PSL2Risoe.BINfileData.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/PSL2Risoe.BINfileData.Rd deleted file mode 100644 index 7b57c91dc..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/PSL2Risoe.BINfileData.Rd +++ /dev/null @@ -1,65 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/PSL2Risoe.BINfileData.R -\name{PSL2Risoe.BINfileData} -\alias{PSL2Risoe.BINfileData} -\title{Convert portable OSL data to a Risoe.BINfileData object} -\usage{ -PSL2Risoe.BINfileData(object, ...) -} -\arguments{ -\item{object}{\linkS4class{RLum.Analysis} (\strong{required}): -\code{RLum.Analysis} object produced by \link{read_PSL2R}} - -\item{...}{currently not used.} -} -\value{ -Returns an S4 \linkS4class{Risoe.BINfileData} object that can be used to write a -BIN file using \link{write_R2BIN}. -} -\description{ -Converts an \code{RLum.Analysis} object produced by the function \code{read_PSL2R()} to -a \code{Risoe.BINfileData} object \strong{(BETA)}. -} -\details{ -This function converts an \linkS4class{RLum.Analysis} object that was produced -by the \link{read_PSL2R} function to a \linkS4class{Risoe.BINfileData}. -The \code{Risoe.BINfileData} can be used to write a Risoe BIN file via -\link{write_R2BIN}. -} -\section{Function version}{ - 0.0.1 -} - -\examples{ - -# (1) load and plot example data set -data("ExampleData.portableOSL", envir = environment()) -plot_RLum(ExampleData.portableOSL) - -# (2) merge all RLum.Analysis objects into one -merged <- merge_RLum(ExampleData.portableOSL) -merged - -# (3) convert to RisoeBINfile object -bin <- PSL2Risoe.BINfileData(merged) -bin - -# (4) write Risoe BIN file -\dontrun{ -write_R2BIN(bin, "~/portableOSL.binx") -} - -} -\seealso{ -\linkS4class{RLum.Analysis}, \linkS4class{RLum.Data.Curve}, -\linkS4class{Risoe.BINfileData} -} -\author{ -Christoph Burow, University of Cologne (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Burow, C., 2024. PSL2Risoe.BINfileData(): Convert portable OSL data to a Risoe.BINfileData object. Function version 0.0.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{IO} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/RLum-class.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/RLum-class.Rd deleted file mode 100644 index 504635e1f..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/RLum-class.Rd +++ /dev/null @@ -1,82 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/RLum-class.R -\docType{class} -\name{RLum-class} -\alias{RLum-class} -\alias{replicate_RLum,RLum-method} -\title{Class \code{"RLum"}} -\usage{ -\S4method{replicate_RLum}{RLum}(object, times = NULL) -} -\arguments{ -\item{object}{\linkS4class{RLum} (\strong{required}): -an object of class \linkS4class{RLum}} - -\item{times}{\link{integer} (\emph{optional}): -number for times each element is repeated element} -} -\description{ -Abstract class for data in the package Luminescence -Subclasses are: -} -\details{ -\strong{RLum-class}\cr -|\cr -|----\linkS4class{RLum.Data}\cr -|----|-- \linkS4class{RLum.Data.Curve}\cr -|----|-- \linkS4class{RLum.Data.Spectrum}\cr -|----|-- \linkS4class{RLum.Data.Image}\cr -|----\linkS4class{RLum.Analysis}\cr -|----\linkS4class{RLum.Results} -} -\section{Methods (by generic)}{ -\itemize{ -\item \code{replicate_RLum(RLum)}: Replication method RLum-objects - -}} -\section{Slots}{ - -\describe{ -\item{\code{originator}}{Object of class \link{character} containing the name of the producing -function for the object. Set automatically by using the function \link{set_RLum}.} - -\item{\code{info}}{Object of class \link{list} for additional information on the object itself} - -\item{\code{.uid}}{Object of class \link{character} for a unique object identifier. This id is -usually calculated using the internal function \code{create_UID()} if the function \link{set_RLum} -is called.} - -\item{\code{.pid}}{Object of class \link{character} for a parent id. This allows nesting RLum-objects -at will. The parent id can be the uid of another object.} -}} - -\note{ -\code{RLum} is a virtual class. -} -\section{Objects from the Class}{ - -A virtual Class: No objects can be created from it. -} - -\section{Class version}{ - 0.4.0 -} - -\examples{ - -showClass("RLum") - -} -\seealso{ -\linkS4class{RLum.Data}, \linkS4class{RLum.Data.Curve}, \linkS4class{RLum.Data.Spectrum}, \linkS4class{RLum.Data.Image}, -\linkS4class{RLum.Analysis}, \linkS4class{RLum.Results}, \link{methods_RLum} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. RLum-class(): Class 'RLum'. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{classes} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/RLum.Analysis-class.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/RLum.Analysis-class.Rd deleted file mode 100644 index d84580d33..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/RLum.Analysis-class.Rd +++ /dev/null @@ -1,238 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/RLum.Analysis-class.R -\docType{class} -\name{RLum.Analysis-class} -\alias{RLum.Analysis-class} -\alias{show,RLum.Analysis-method} -\alias{set_RLum,RLum.Analysis-method} -\alias{get_RLum,RLum.Analysis-method} -\alias{structure_RLum,RLum.Analysis-method} -\alias{length_RLum,RLum.Analysis-method} -\alias{names_RLum,RLum.Analysis-method} -\alias{smooth_RLum,RLum.Analysis-method} -\title{Class \code{"RLum.Analysis"}} -\usage{ -\S4method{show}{RLum.Analysis}(object) - -\S4method{set_RLum}{RLum.Analysis}( - class, - originator, - .uid, - .pid, - protocol = NA_character_, - records = list(), - info = list() -) - -\S4method{get_RLum}{RLum.Analysis}( - object, - record.id = NULL, - recordType = NULL, - curveType = NULL, - RLum.type = NULL, - protocol = "UNKNOWN", - get.index = NULL, - drop = TRUE, - recursive = TRUE, - info.object = NULL, - subset = NULL, - env = parent.frame(2) -) - -\S4method{structure_RLum}{RLum.Analysis}(object, fullExtent = FALSE) - -\S4method{length_RLum}{RLum.Analysis}(object) - -\S4method{names_RLum}{RLum.Analysis}(object) - -\S4method{smooth_RLum}{RLum.Analysis}(object, ...) -} -\arguments{ -\item{object}{\code{\link{get_RLum}}: \code{\link{names_RLum}}, \code{\link{length_RLum}}, \code{\link{structure_RLum}} (\strong{required}): -an object of class \linkS4class{RLum.Analysis}} - -\item{class}{\code{\link{set_RLum}} \link{character} (\strong{required}): -name of the \code{RLum} class to be created} - -\item{originator}{\code{\link{set_RLum}} \link{character} (\emph{automatic}): -contains the name of the calling function (the function that produces this object); -can be set manually.} - -\item{.uid}{\code{\link{set_RLum}} \link{character} (\emph{automatic}): -sets an unique ID for this object using the internal C++ function \code{create_UID}.} - -\item{.pid}{\code{\link{set_RLum}} \link{character} (\emph{with default}): -option to provide a parent id for nesting at will.} - -\item{protocol}{\code{\link{set_RLum}} \link{character} (\emph{optional}): -sets protocol type for analysis object. Value may be used by subsequent analysis functions.} - -\item{records}{\code{\link{set_RLum}} \link{list} (\strong{required}): -list of \linkS4class{RLum.Analysis} objects} - -\item{info}{\code{\link{set_RLum}} \link{list} (\emph{optional}): -a list containing additional info data for the object - -\strong{\code{set_RLum}}: - -Returns an \linkS4class{RLum.Analysis} object.} - -\item{record.id}{\code{\link{get_RLum}}: \link{numeric} or \link{logical} (\emph{optional}): -IDs of specific records. If of type \code{logical} the entire id range is assumed -and \code{TRUE} and \code{FALSE} indicates the selection.} - -\item{recordType}{\code{\link{get_RLum}}: \link{character} (\emph{optional}): -record type (e.g., "OSL"). Can be also a vector, for multiple matching, -e.g., \code{recordType = c("OSL", "IRSL")}} - -\item{curveType}{\code{\link{get_RLum}}: \link{character} (\emph{optional}): -curve type (e.g. "predefined" or "measured")} - -\item{RLum.type}{\code{\link{get_RLum}}: \link{character} (\emph{optional}): -RLum object type. Defaults to "RLum.Data.Curve" and "RLum.Data.Spectrum".} - -\item{get.index}{\code{\link{get_RLum}}: \link{logical} (\emph{optional}): -return a numeric vector with the index of each element in the RLum.Analysis object.} - -\item{drop}{\code{\link{get_RLum}}: \link{logical} (\emph{with default}): -coerce to the next possible layer (which are \code{RLum.Data}-objects), -\code{drop = FALSE} keeps the original \code{RLum.Analysis}} - -\item{recursive}{\code{\link{get_RLum}}: \link{logical} (\emph{with default}): -if \code{TRUE} (the default) and the result of the \code{get_RLum()} request is a single -object this object will be unlisted, means only the object itself and no -list containing exactly one object is returned. Mostly this makes things -easier, however, if this method is used within a loop this might be undesired.} - -\item{info.object}{\code{\link{get_RLum}}: \link{character} (\emph{optional}): -name of the wanted info element} - -\item{subset}{\code{\link{get_RLum}}: \link{expression} (\emph{optional}): -logical expression indicating elements or rows to keep: missing values are -taken as false. This argument takes precedence over all other arguments, -meaning they are not considered when subsetting the object.} - -\item{env}{\code{\link{get_RLum}}: \link{environment} (\emph{with default}): -An environment passed to \link{eval} as the enclosure. This argument is only -relevant when subsetting the object and should not be used manually.} - -\item{fullExtent}{\link{structure_RLum}; \link{logical} (\emph{with default}): -extents the returned \code{data.frame} to its full extent, i.e. all info elements -are part of the return as well. The default value is \code{FALSE} as the data -frame might become rather big.} - -\item{...}{further arguments passed to underlying methods} -} -\value{ -\strong{\code{get_RLum}}: - -Returns: -\enumerate{ -\item \link{list} of \linkS4class{RLum.Data} objects or -\item Single \linkS4class{RLum.Data} object, if only one object is contained and \code{recursive = FALSE} or -\item \linkS4class{RLum.Analysis} objects for \code{drop = FALSE} -} - -\strong{\code{structure_RLum}}: - -Returns \linkS4class{data.frame} showing the structure. - -\strong{\code{length_RLum}} - -Returns the number records in this object. - -\strong{\code{names_RLum}} - -Returns the names of the record types (\code{recordType}) in this object. - -\strong{\code{smooth_RLum}} - -Same object as input, after smoothing -} -\description{ -Object class to represent analysis data for protocol analysis, i.e. all curves, -spectra etc. from one measurements. Objects from this class are produced, -by e.g. \link{read_XSYG2R}, \link{read_Daybreak2R} -} -\section{Methods (by generic)}{ -\itemize{ -\item \code{show(RLum.Analysis)}: Show structure of \code{RLum.Analysis} object - -\item \code{set_RLum(RLum.Analysis)}: Construction method for \linkS4class{RLum.Analysis} objects. - -\item \code{get_RLum(RLum.Analysis)}: Accessor method for RLum.Analysis object. - -The slots record.id, \verb{@recordType}, \verb{@curveType} and \verb{@RLum.type} are optional to allow for records -limited by their id (list index number), their record type (e.g. \code{recordType = "OSL"}) -or object type. - -Example: curve type (e.g. \code{curveType = "predefined"} or \code{curveType ="measured"}) - -The selection of a specific RLum.type object superimposes the default selection. -Currently supported objects are: RLum.Data.Curve and RLum.Data.Spectrum - -\item \code{structure_RLum(RLum.Analysis)}: Method to show the structure of an \linkS4class{RLum.Analysis} object. - -\item \code{length_RLum(RLum.Analysis)}: Returns the length of the object, i.e., number of stored records. - -\item \code{names_RLum(RLum.Analysis)}: Returns the names of the \linkS4class{RLum.Data} objects objects (same as shown with the show method) - -\item \code{smooth_RLum(RLum.Analysis)}: Smoothing of \code{RLum.Data} objects contained in this \code{RLum.Analysis} object -\link[zoo:rollmean]{zoo::rollmean} or \link[zoo:rollmean]{zoo::rollmedian}. In particular the internal -function \code{.smoothing} is used. - -}} -\section{Slots}{ - -\describe{ -\item{\code{protocol}}{Object of class \link{character} describing the applied measurement protocol} - -\item{\code{records}}{Object of class \link{list} containing objects of class \linkS4class{RLum.Data}} -}} - -\note{ -The method \link{structure_RLum} is currently just available for objects -containing \linkS4class{RLum.Data.Curve}. -} -\section{Objects from the Class}{ - -Objects can be created by calls of the form \code{set_RLum("RLum.Analysis", ...)}. -} - -\section{Class version}{ - 0.4.16 -} - -\examples{ - -showClass("RLum.Analysis") - -##set empty object -set_RLum(class = "RLum.Analysis") - -###use example data -##load data -data(ExampleData.RLum.Analysis, envir = environment()) - -##show curves in object -get_RLum(IRSAR.RF.Data) - -##show only the first object, but by keeping the object -get_RLum(IRSAR.RF.Data, record.id = 1, drop = FALSE) - -} -\seealso{ -\link{Risoe.BINfileData2RLum.Analysis}, -\linkS4class{Risoe.BINfileData}, \linkS4class{RLum} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. RLum.Analysis-class(): Class 'RLum.Analysis'. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{classes} -\keyword{internal} -\keyword{methods} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/RLum.Data-class.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/RLum.Data-class.Rd deleted file mode 100644 index d06edebda..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/RLum.Data-class.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/RLum.Data-class.R -\docType{class} -\name{RLum.Data-class} -\alias{RLum.Data-class} -\title{Class \code{"RLum.Data"}} -\description{ -Generalized virtual data class for luminescence data. -} -\note{ -Just a virtual class. -} -\section{Objects from the Class}{ - -A virtual Class: No objects can be created from it. -} - -\section{Class version}{ - 0.2.1 -} - -\examples{ - -showClass("RLum.Data") - -} -\seealso{ -\linkS4class{RLum}, \linkS4class{RLum.Data.Curve}, -\linkS4class{RLum.Data.Spectrum}, \linkS4class{RLum.Data.Image} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{classes} -\keyword{internal} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/RLum.Data.Curve-class.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/RLum.Data.Curve-class.Rd deleted file mode 100644 index 835a451f3..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/RLum.Data.Curve-class.Rd +++ /dev/null @@ -1,201 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/RLum.Data.Curve-class.R -\docType{class} -\name{RLum.Data.Curve-class} -\alias{RLum.Data.Curve-class} -\alias{show,RLum.Data.Curve-method} -\alias{set_RLum,RLum.Data.Curve-method} -\alias{get_RLum,RLum.Data.Curve-method} -\alias{length_RLum,RLum.Data.Curve-method} -\alias{names_RLum,RLum.Data.Curve-method} -\alias{bin_RLum.Data,RLum.Data.Curve-method} -\alias{smooth_RLum,RLum.Data.Curve-method} -\title{Class \code{"RLum.Data.Curve"}} -\usage{ -\S4method{show}{RLum.Data.Curve}(object) - -\S4method{set_RLum}{RLum.Data.Curve}( - class, - originator, - .uid, - .pid, - recordType = NA_character_, - curveType = NA_character_, - data = matrix(0, ncol = 2), - info = list() -) - -\S4method{get_RLum}{RLum.Data.Curve}(object, info.object = NULL) - -\S4method{length_RLum}{RLum.Data.Curve}(object) - -\S4method{names_RLum}{RLum.Data.Curve}(object) - -\S4method{bin_RLum.Data}{RLum.Data.Curve}(object, bin_size = 2) - -\S4method{smooth_RLum}{RLum.Data.Curve}(object, k = NULL, fill = NA, align = "right", method = "mean") -} -\arguments{ -\item{object}{\code{\link{get_RLum}}, \code{\link{length_RLum}}, \code{\link{names_RLum}} (\strong{required}): -an object of class \linkS4class{RLum.Data.Curve}} - -\item{class}{\code{\link{set_RLum}}; \link{character} (\strong{required}): -name of the \code{RLum} class to create} - -\item{originator}{\code{\link{set_RLum}}; \link{character} (\emph{automatic}): -contains the name of the calling function (the function that produces this object); -can be set manually.} - -\item{.uid}{\code{\link{set_RLum}}; \link{character} (\emph{automatic}): -sets an unique ID for this object using the internal C++ function \code{create_UID}.} - -\item{.pid}{\code{\link{set_RLum}}; \link{character} (\emph{with default}): -option to provide a parent id for nesting at will.} - -\item{recordType}{\code{\link{set_RLum}}; \link{character} (\emph{optional}): -record type (e.g., "OSL")} - -\item{curveType}{\code{\link{set_RLum}}; \link{character} (\emph{optional}): -curve type (e.g., "predefined" or "measured")} - -\item{data}{\code{\link{set_RLum}}; \link{matrix} (\strong{required}): -raw curve data. If \code{data} itself is a \code{RLum.Data.Curve}-object this can be -used to re-construct the object (s. details), i.e. modified parameters except -\code{.uid}, \code{.pid} and \code{originator}. The rest will be subject to copy and paste unless provided.} - -\item{info}{\code{\link{set_RLum}}; \link{list} (\emph{optional}): -info elements} - -\item{info.object}{\code{\link{get_RLum}} \link{character} (\emph{optional}): -name of the wanted info element} - -\item{bin_size}{\link{integer} (\emph{with default}): -set number of channels used for each bin, e.g. \code{bin_size = 2} means that -two channels are binned.} - -\item{k}{\code{\link{smooth_RLum}}; \link{integer} (\emph{with default}): -window for the rolling mean; must be odd for \code{rollmedian}. -If nothing is set k is set automatically} - -\item{fill}{\code{\link{smooth_RLum}}; \link{numeric} (\emph{with default}): -a vector defining the left and the right hand data} - -\item{align}{\code{\link{smooth_RLum}}; \link{character} (\emph{with default}): -specifying whether the index of the result should be left- or right-aligned -or centred (default) compared to the rolling window of observations, allowed -\code{"right"}, \code{"center"} and \code{"left"}} - -\item{method}{\code{\link{smooth_RLum}}; \link{character} (\emph{with default}): -defines which method should be applied for the smoothing: \code{"mean"} or \code{"median"}} -} -\value{ -\strong{\code{set_RLum}} - -Returns an \linkS4class{RLum.Data.Curve} object. - -\strong{\code{get_RLum}} -\enumerate{ -\item A \link{matrix} with the curve values or -\item only the info object if \code{info.object} was set. -} - -\strong{\code{length_RLum}} - -Number of channels in the curve (row number of the matrix) - -\strong{\code{names_RLum}} - -Names of the info elements (slot \code{info}) - -\strong{\code{bin_RLum.Data}} - -Same object as input, after applying the binning. - -\strong{\code{smooth_RLum}} - -Same object as input, after smoothing -} -\description{ -Class for representing luminescence curve data. -} -\section{Methods (by generic)}{ -\itemize{ -\item \code{show(RLum.Data.Curve)}: Show structure of \code{RLum.Data.Curve} object - -\item \code{set_RLum(RLum.Data.Curve)}: Construction method for RLum.Data.Curve object. The slot info is optional -and predefined as empty list by default. - -\item \code{get_RLum(RLum.Data.Curve)}: Accessor method for RLum.Data.Curve object. The argument info.object is -optional to directly access the info elements. If no info element name is -provided, the raw curve data (matrix) will be returned. - -\item \code{length_RLum(RLum.Data.Curve)}: Returns the length of the curve object, which is the maximum of the -value time/temperature of the curve (corresponding to the stimulation length) - -\item \code{names_RLum(RLum.Data.Curve)}: Returns the names info elements coming along with this curve object - -\item \code{bin_RLum.Data(RLum.Data.Curve)}: Allows binning of specific objects - -\item \code{smooth_RLum(RLum.Data.Curve)}: Smoothing of RLum.Data.Curve objects using the function \link[zoo:rollmean]{zoo::rollmean} or \link[zoo:rollmean]{zoo::rollmedian}. -In particular the internal function \code{.smoothing} is used. - -}} -\section{Slots}{ - -\describe{ -\item{\code{recordType}}{Object of class "character" containing the type of the curve (e.g. "TL" or "OSL")} - -\item{\code{curveType}}{Object of class "character" containing curve type, allowed values are measured or predefined} - -\item{\code{data}}{Object of class \link{matrix} containing curve x and y data. -'data' can also be of type \code{RLum.Data.Curve} to change object values without -de-constructing the object. For example: - -\if{html}{\out{
}}\preformatted{set_RLum(class = 'RLum.Data.Curve', - data = Your.RLum.Data.Curve, - recordType = 'never seen before') -}\if{html}{\out{
}} - -would just change the \code{recordType}. Missing arguments the value is taken -from the input object in 'data' (which is already an RLum.Data.Curve object -in this example)} -}} - -\note{ -The class should only contain data for a single curve. For additional -elements the slot \code{info} can be used (e.g. providing additional heating -ramp curve). Objects from the class \code{RLum.Data.Curve} are produced by other -functions (partly within \linkS4class{RLum.Analysis} objects), -namely: \link{Risoe.BINfileData2RLum.Analysis}, \link{read_XSYG2R} -} -\section{Create objects from this Class}{ - -Objects can be created by calls of the form -\code{set_RLum(class = "RLum.Data.Curve", ...)}. -} - -\section{Class version}{ - 0.5.1 -} - -\examples{ - -showClass("RLum.Data.Curve") - -##set empty curve object -set_RLum(class = "RLum.Data.Curve") - -} -\seealso{ -\linkS4class{RLum}, \linkS4class{RLum.Data}, \link{plot_RLum}, \link{merge_RLum} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. RLum.Data.Curve-class(): Class 'RLum.Data.Curve'. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{classes} -\keyword{internal} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/RLum.Data.Image-class.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/RLum.Data.Image-class.Rd deleted file mode 100644 index 4c2ca02ff..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/RLum.Data.Image-class.Rd +++ /dev/null @@ -1,141 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/RLum.Data.Image-class.R -\docType{class} -\name{RLum.Data.Image-class} -\alias{RLum.Data.Image-class} -\alias{show,RLum.Data.Image-method} -\alias{set_RLum,RLum.Data.Image-method} -\alias{get_RLum,RLum.Data.Image-method} -\alias{names_RLum,RLum.Data.Image-method} -\title{Class \code{"RLum.Data.Image"}} -\usage{ -\S4method{show}{RLum.Data.Image}(object) - -\S4method{set_RLum}{RLum.Data.Image}( - class, - originator, - .uid, - .pid, - recordType = "Image", - curveType = NA_character_, - data = array(), - info = list() -) - -\S4method{get_RLum}{RLum.Data.Image}(object, info.object) - -\S4method{names_RLum}{RLum.Data.Image}(object) -} -\arguments{ -\item{object}{\code{\link{get_RLum}}, \code{\link{names_RLum}} (\strong{required}): -an object of class \linkS4class{RLum.Data.Image}} - -\item{class}{\code{\link{set_RLum}}; \link{character}: name of the \code{RLum} class to create} - -\item{originator}{\code{\link{set_RLum}}; \link{character} (\emph{automatic}): -contains the name of the calling function (the function that produces this object); -can be set manually.} - -\item{.uid}{\code{\link{set_RLum}}; \link{character} (\emph{automatic}): -sets an unique ID for this object using the internal C++ function \code{create_UID}.} - -\item{.pid}{\code{\link{set_RLum}}; \link{character} (\emph{with default}): -option to provide a parent id for nesting at will.} - -\item{recordType}{\code{\link{set_RLum}}; \link{character}: -record type (e.g. "OSL")} - -\item{curveType}{\code{\link{set_RLum}}; \link{character}: -curve type (e.g. "predefined" or "measured")} - -\item{data}{\code{\link{set_RLum}}; \link{matrix}: -raw curve data. If data is of type \code{RLum.Data.Image} this can be used to -re-construct the object, i.e. modified parameters except \code{.uid} and \code{.pid}. The rest -will be subject to copy and paste unless provided.} - -\item{info}{\code{\link{set_RLum}}; \link{list}: -info elements} - -\item{info.object}{\code{\link{get_RLum}}; \link{character}: -name of the info object to returned} -} -\value{ -\strong{\code{set_RLum}} - -Returns an object from class \code{RLum.Data.Image} - -\strong{\code{get_RLum}} -\enumerate{ -\item Returns the data object (\link{array}) -\item only the info object if \code{info.object} was set. -} - -\strong{\code{names_RLum}} - -Returns the names of the info elements -} -\description{ -Class for representing luminescence image data (TL/OSL/RF). Such data are for example produced -by the function \link{read_SPE2R} -} -\section{Methods (by generic)}{ -\itemize{ -\item \code{show(RLum.Data.Image)}: Show structure of \code{RLum.Data.Image} object - -\item \code{set_RLum(RLum.Data.Image)}: Construction method for RLum.Data.Image object. The slot info is optional -and predefined as empty list by default. - -\item \code{get_RLum(RLum.Data.Image)}: Accessor method for \code{RLum.Data.Image} object. The argument \code{info.object} is -optional to directly access the info elements. If no info element name is -provided, the raw image data (\code{array}) will be returned. - -\item \code{names_RLum(RLum.Data.Image)}: Returns the names info elements coming along with this curve object - -}} -\section{Slots}{ - -\describe{ -\item{\code{recordType}}{Object of class \link{character} containing the type of the curve (e.g. "OSL image", "TL image")} - -\item{\code{curveType}}{Object of class \link{character} containing curve type, allowed values -are measured or predefined} - -\item{\code{data}}{Object of class \link{array} containing image data.} - -\item{\code{info}}{Object of class \link{list} containing further meta information objects} -}} - -\note{ -The class should only contain data for a set of images. For additional -elements the slot \code{info} can be used. -} -\section{Objects from the class}{ - -Objects can be created by calls of the form \code{set_RLum("RLum.Data.Image", ...)}. -} - -\section{Class version}{ - 0.5.1 -} - -\examples{ - -showClass("RLum.Data.Image") - -##create empty RLum.Data.Image object -set_RLum(class = "RLum.Data.Image") - -} -\seealso{ -\linkS4class{RLum}, \linkS4class{RLum.Data}, \link{plot_RLum}, \link{read_SPE2R}, \link{read_TIFF2R} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. RLum.Data.Image-class(): Class 'RLum.Data.Image'. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{classes} -\keyword{internal} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/RLum.Data.Spectrum-class.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/RLum.Data.Spectrum-class.Rd deleted file mode 100644 index 5cb0f167b..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/RLum.Data.Spectrum-class.Rd +++ /dev/null @@ -1,171 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/RLum.Data.Spectrum-class.R -\docType{class} -\name{RLum.Data.Spectrum-class} -\alias{RLum.Data.Spectrum-class} -\alias{show,RLum.Data.Spectrum-method} -\alias{set_RLum,RLum.Data.Spectrum-method} -\alias{get_RLum,RLum.Data.Spectrum-method} -\alias{names_RLum,RLum.Data.Spectrum-method} -\alias{bin_RLum.Data,RLum.Data.Spectrum-method} -\title{Class \code{"RLum.Data.Spectrum"}} -\usage{ -\S4method{show}{RLum.Data.Spectrum}(object) - -\S4method{set_RLum}{RLum.Data.Spectrum}( - class, - originator, - .uid, - .pid, - recordType = "Spectrum", - curveType = NA_character_, - data = matrix(), - info = list() -) - -\S4method{get_RLum}{RLum.Data.Spectrum}(object, info.object) - -\S4method{names_RLum}{RLum.Data.Spectrum}(object) - -\S4method{bin_RLum.Data}{RLum.Data.Spectrum}(object, bin_size.col = 1, bin_size.row = 1) -} -\arguments{ -\item{object}{\code{\link{get_RLum}}, \code{\link{names_RLum}} (\strong{required}): -an object of class \linkS4class{RLum.Data.Spectrum}} - -\item{class}{\code{\link{set_RLum}}; \link{character} (\emph{automatic}): -name of the \code{RLum} class to create.} - -\item{originator}{\link{character} (\emph{automatic}): -contains the name of the calling function (the function that produces this object); -can be set manually.} - -\item{.uid}{\code{\link{set_RLum}}; \link{character} (\emph{automatic}): -sets an unique ID for this object using the internal C++ function \code{create_UID}.} - -\item{.pid}{\code{\link{set_RLum}}; \link{character} (\emph{with default}): -option to provide a parent id for nesting at will.} - -\item{recordType}{\code{\link{set_RLum}}; \link{character}: -record type (e.g. "OSL")} - -\item{curveType}{\code{\link{set_RLum}}; \link{character}: -curve type (e.g. "predefined" or "measured")} - -\item{data}{\code{\link{set_RLum}}; \link{matrix}: -raw curve data. If data is of type \code{RLum.Data.Spectrum}, this can be used -to re-construct the object. If the object is reconstructed, \code{.uid}, \code{.pid} and \code{orginator} -are always taken from the input object} - -\item{info}{\code{\link{set_RLum}} \link{list}: -info elements} - -\item{info.object}{\code{\link{get_RLum}}; \link{character} (\emph{optional}): -the name of the info object to be called} - -\item{bin_size.col}{\link{integer} (\emph{with default}): -set number of channels used for each bin, e.g. \code{bin_size.col = 2} means that -two channels are binned. Note: The function does not check the input, very large values -mean a full column binning (a single sum)} - -\item{bin_size.row}{\link{integer} (\emph{with default}): -set number of channels used for each bin, e.g. \code{bin_size.row = 2} means that -two channels are binned. Note: The function does not check the input, very large values -mean a full row binning (a single sum)} -} -\value{ -\strong{\verb{[set_RLum]}} - -An object from the class \code{RLum.Data.Spectrum} - -\strong{\verb{[get_RLum]}} -\enumerate{ -\item A \link{matrix} with the spectrum values or -\item only the info object if \code{info.object} was set. -} - -\strong{\verb{[names_RLum]}} - -The names of the info objects - -\strong{\verb{[bin_RLum.Data]}} - -Same object as input, after applying the binning. -} -\description{ -Class for representing luminescence spectra data (TL/OSL/RF). -} -\section{Methods (by generic)}{ -\itemize{ -\item \code{show(RLum.Data.Spectrum)}: Show structure of \code{RLum.Data.Spectrum} object - -\item \code{set_RLum(RLum.Data.Spectrum)}: Construction method for RLum.Data.Spectrum object. The slot info is optional -and predefined as empty list by default - -\item \code{get_RLum(RLum.Data.Spectrum)}: Accessor method for RLum.Data.Spectrum object. The argument info.object -is optional to directly access the info elements. If no info element name -is provided, the raw curve data (matrix) will be returned - -\item \code{names_RLum(RLum.Data.Spectrum)}: Returns the names info elements coming along with this curve object - -\item \code{bin_RLum.Data(RLum.Data.Spectrum)}: Allows binning of RLum.Data.Spectrum data. Count values and values on the x-axis are summed-up; -for wavelength/energy values the mean is calculated. - -}} -\section{Slots}{ - -\describe{ -\item{\code{recordType}}{Object of class \link{character} containing the type of the curve (e.g. "TL" or "OSL")} - -\item{\code{curveType}}{Object of class \link{character} containing curve type, allowed values are measured or predefined} - -\item{\code{data}}{Object of class \link{matrix} containing spectrum (count) values. -Row labels indicate wavelength/pixel values, column labels are temperature or time values.} - -\item{\code{info}}{Object of class \link{list} containing further meta information objects} -}} - -\note{ -The class should only contain data for a single spectra data set. For -additional elements the slot \code{info} can be used. Objects from this class are automatically -created by, e.g., \link{read_XSYG2R} -} -\section{Objects from the Class}{ - -Objects can be created by calls of the form \code{set_RLum("RLum.Data.Spectrum", ...)}. -} - -\section{Class version}{ - 0.5.2 -} - -\examples{ - -showClass("RLum.Data.Spectrum") - -##show example data -data(ExampleData.XSYG, envir = environment()) -TL.Spectrum - -##show data matrix -get_RLum(TL.Spectrum) - -##plot spectrum -\dontrun{ -plot_RLum(TL.Spectrum) -} - -} -\seealso{ -\linkS4class{RLum}, \linkS4class{RLum.Data}, \link{plot_RLum} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. RLum.Data.Spectrum-class(): Class 'RLum.Data.Spectrum'. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{classes} -\keyword{internal} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/RLum.Results-class.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/RLum.Results-class.Rd deleted file mode 100644 index b37f3a467..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/RLum.Results-class.Rd +++ /dev/null @@ -1,163 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/RLum.Results-class.R -\docType{class} -\name{RLum.Results-class} -\alias{RLum.Results-class} -\alias{show,RLum.Results-method} -\alias{set_RLum,RLum.Results-method} -\alias{get_RLum,RLum.Results-method} -\alias{length_RLum,RLum.Results-method} -\alias{names_RLum,RLum.Results-method} -\title{Class \code{"RLum.Results"}} -\usage{ -\S4method{show}{RLum.Results}(object) - -\S4method{set_RLum}{RLum.Results}(class, originator, .uid, .pid, data = list(), info = list()) - -\S4method{get_RLum}{RLum.Results}(object, data.object, info.object = NULL, drop = TRUE) - -\S4method{length_RLum}{RLum.Results}(object) - -\S4method{names_RLum}{RLum.Results}(object) -} -\arguments{ -\item{object}{\code{\link{get_RLum}}; \linkS4class{RLum.Results} (\strong{required}): -an object of class \linkS4class{RLum.Results} to be evaluated} - -\item{class}{\code{\link{set_RLum}}; \link{character} \strong{(required)}: -name of the \code{RLum} class to create} - -\item{originator}{\code{\link{set_RLum}}; \link{character} (\emph{automatic}): -contains the name of the calling function (the function that produces this object); -can be set manually.} - -\item{.uid}{\code{\link{set_RLum}}; \link{character} (\emph{automatic}): -sets an unique ID for this object using the internal C++ function \code{create_UID}.} - -\item{.pid}{\code{\link{set_RLum}}; \link{character} (\emph{with default}): -option to provide a parent id for nesting at will.} - -\item{data}{\code{\link{set_RLum}}; \link{list} (\emph{optional}): -a list containing the data to -be stored in the object} - -\item{info}{\code{\link{set_RLum}}; \link{list} (\emph{optional}): -a list containing additional info data for the object} - -\item{data.object}{\code{\link{get_RLum}}; \link{character} or \link{numeric}: -name or index of the data slot to be returned} - -\item{info.object}{\code{\link{get_RLum}}; \link{character} (\emph{optional}): -name of the wanted info element} - -\item{drop}{\code{\link{get_RLum}}; \link{logical} (\emph{with default}): -coerce to the next possible layer (which are data objects, \code{drop = FALSE} -keeps the original \code{RLum.Results}} -} -\value{ -\strong{\code{set_RLum}}: - -Returns an object from the class \linkS4class{RLum.Results} - -\strong{\code{get_RLum}}: - -Returns: -\enumerate{ -\item Data object from the specified slot -\item \link{list} of data objects from the slots if 'data.object' is vector or -\item an \linkS4class{RLum.Results} for \code{drop = FALSE}. -} - -\strong{\code{length_RLum}} - -Returns the number of data elements in the \code{RLum.Results} object. - -\strong{\code{names_RLum}} - -Returns the names of the data elements in the object. -} -\description{ -Object class contains results data from functions (e.g., \link{analyse_SAR.CWOSL}). -} -\section{Methods (by generic)}{ -\itemize{ -\item \code{show(RLum.Results)}: Show structure of \code{RLum.Results} object - -\item \code{set_RLum(RLum.Results)}: Construction method for an RLum.Results object. - -\item \code{get_RLum(RLum.Results)}: Accessor method for RLum.Results object. The argument data.object allows -directly accessing objects delivered within the slot data. The default -return object depends on the object originator (e.g., \code{fit_LMCurve}). -If nothing is specified always the first \code{data.object} will be returned. - -Note: Detailed specification should be made in combination with the originator slot in the -receiving function if results are pipped. - -\item \code{length_RLum(RLum.Results)}: Returns the length of the object, i.e., number of stored data.objects - -\item \code{names_RLum(RLum.Results)}: Returns the names data.objects - -}} -\section{Slots}{ - -\describe{ -\item{\code{data}}{Object of class \link{list} containing output data} -}} - -\note{ -The class is intended to store results from functions to be used by -other functions. The data in the object should always be accessed by the -method \code{get_RLum}. -} -\section{Objects from the Class}{ - -Objects can be created by calls of the form \code{new("RLum.Results", ...)}. -} - -\section{Class version}{ - 0.5.2 -} - -\examples{ - -showClass("RLum.Results") - -##create an empty object from this class -set_RLum(class = "RLum.Results") - -##use another function to show how it works - -##Basic calculation of the dose rate for a specific date - dose.rate <- calc_SourceDoseRate( - measurement.date = "2012-01-27", - calib.date = "2014-12-19", - calib.dose.rate = 0.0438, - calib.error = 0.0019) - -##show object -dose.rate - -##get results -get_RLum(dose.rate) - -##get parameters used for the calcualtion from the same object -get_RLum(dose.rate, data.object = "parameters") - -##alternatively objects can be accessed using S3 generics, such as -dose.rate$parameters - -} -\seealso{ -\linkS4class{RLum}, \link{plot_RLum}, \link{merge_RLum} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. RLum.Results-class(): Class 'RLum.Results'. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{classes} -\keyword{internal} -\keyword{methods} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/Risoe.BINfileData-class.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/Risoe.BINfileData-class.Rd deleted file mode 100644 index 6d544c2f3..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/Risoe.BINfileData-class.Rd +++ /dev/null @@ -1,266 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Risoe.BINfileData-class.R -\docType{class} -\name{Risoe.BINfileData-class} -\alias{Risoe.BINfileData-class} -\alias{show,Risoe.BINfileData-method} -\alias{set_Risoe.BINfileData,ANY-method} -\alias{get_Risoe.BINfileData,Risoe.BINfileData-method} -\title{Class \code{"Risoe.BINfileData"}} -\usage{ -\S4method{show}{Risoe.BINfileData}(object) - -\S4method{set_Risoe.BINfileData}{ANY}( - METADATA = data.frame(), - DATA = list(), - .RESERVED = list() -) - -\S4method{get_Risoe.BINfileData}{Risoe.BINfileData}(object, ...) -} -\arguments{ -\item{object}{an object of class \linkS4class{Risoe.BINfileData}} - -\item{METADATA}{Object of class "data.frame" containing the meta information -for each curve.} - -\item{DATA}{Object of class "list" containing numeric vector with count data.} - -\item{.RESERVED}{Object of class "list" containing list of undocumented raw -values for internal use only.} - -\item{...}{other arguments that might be passed} -} -\description{ -S4 class object for luminescence data in R. The object is produced as output -of the function \link{read_BIN2R}. -} -\section{Methods (by generic)}{ -\itemize{ -\item \code{show(Risoe.BINfileData)}: Show structure of RLum and Risoe.BINfile class objects - -\item \code{set_Risoe.BINfileData(ANY)}: The Risoe.BINfileData is normally produced as output of the function read_BIN2R. -This construction method is intended for internal usage only. - -\item \code{get_Risoe.BINfileData(Risoe.BINfileData)}: Formal get-method for Risoe.BINfileData object. It does not allow accessing -the object directly, it is just showing a terminal message. - -}} -\section{Slots}{ - -\describe{ -\item{\code{METADATA}}{Object of class "data.frame" containing the meta information for each curve.} - -\item{\code{DATA}}{Object of class "list" containing numeric vector with count data.} - -\item{\code{.RESERVED}}{Object of class "list" containing list of undocumented raw values for internal use only.} -}} - -\note{ -\strong{Internal METADATA - object structure} - -This structure is compatible with BIN/BINX-files version 03-08, however, it does not follow (in its -sequential arrangement) the manual provided by the manufacturer, -but an own structure accounting for the different versions. - -\tabular{rllll}{ -\strong{#} \tab \strong{Name} \tab \strong{Data Type} \tab \strong{V} \tab \strong{Description} \cr -\verb{[,1]} \tab \code{ID} \tab \code{numeric} \tab RLum \tab Unique record ID (same ID as in slot \code{DATA})\cr -\verb{[,2]} \tab \code{SEL} \tab \code{logic} \tab RLum \tab Record selection, not part official BIN-format, triggered by TAG\cr -\verb{[,3]} \tab \code{VERSION} \tab \code{raw} \tab 03-08 \tab BIN-file version number \cr -\verb{[,4]} \tab \code{LENGTH} \tab \code{integer} \tab 03-08 \tab Length of this record\cr -\verb{[,5]} \tab \code{PREVIOUS} \tab \code{integer} \tab 03-08 \tab Length of previous record\cr -\verb{[,6]} \tab \code{NPOINTS} \tab \code{integer} \tab 03-08 \tab Number of data points in the record\cr -\verb{[,7]} \tab \code{RECTYPE} \tab \code{integer} \tab 08 \tab Record type \cr -\verb{[,8]} \tab \code{RUN} \tab \code{integer} \tab 03-08 \tab Run number\cr -\verb{[,9]} \tab \code{SET} \tab \code{integer} \tab 03-08 \tab Set number\cr -\verb{[,10]} \tab \code{POSITION} \tab \code{integer} \tab 03-08 \tab Position number\cr -\verb{[,11]} \tab \code{GRAIN} \tab \code{integer} \tab 03-04 \tab Grain number\cr -\verb{[,12]} \tab \code{GRAINNUMBER} \tab \code{integer} \tab 05-08 \tab Grain number\cr -\verb{[,13]} \tab \code{CURVENO} \tab \code{integer} \tab 05-08 \tab Curve number\cr -\verb{[,14]} \tab \code{XCOORD} \tab \code{integer} \tab 03-08 \tab X position of a single grain\cr -\verb{[,15]} \tab \code{YCOORD} \tab \code{integer} \tab 03-08 \tab Y position of a single grain\cr -\verb{[,16]} \tab \code{SAMPLE} \tab \code{factor} \tab 03-08 \tab Sample name\cr -\verb{[,17]} \tab \code{COMMENT} \tab \code{factor} \tab 03-08 \tab Comment name\cr -\verb{[,18]} \tab \code{SYSTEMID} \tab \code{integer} \tab 03-08 \tab Risø system id\cr -\verb{[,19]} \tab \code{FNAME} \tab \code{factor} \tab 05-08 \tab File name (\emph{.bin/}.binx)\cr -\verb{[,20]} \tab \code{USER} \tab \code{factor} \tab 03-08 \tab User name\cr -\verb{[,21]} \tab \code{TIME} \tab \code{character} \tab 03-08 \tab Data collection time (\code{hh-mm-ss})\cr -\verb{[,22]} \tab \code{DATE} \tab \code{factor} \tab 03-08 \tab Data collection date (\code{ddmmyy})\cr -\verb{[,23]} \tab \code{DTYPE} \tab \code{character} \tab 03-08 \tab Data type\cr -\verb{[,24]} \tab \code{BL_TIME} \tab \code{numeric} \tab 03-08 \tab Bleaching time\cr -\verb{[,25]} \tab \code{BL_UNIT} \tab \code{integer} \tab 03-08 \tab Bleaching unit (mJ, J, s, min, h)\cr -\verb{[,26]} \tab \code{NORM1} \tab \code{numeric} \tab 03-08 \tab Normalisation factor (1)\cr -\verb{[,27]} \tab \code{NORM2} \tab \code{numeric} \tab 03-08 \tab Normalisation factor (2)\cr -\verb{[,28]} \tab \code{NORM3} \tab \code{numeric} \tab 03-08 \tab Normalisation factor (3)\cr -\verb{[,29]} \tab \code{BG} \tab \code{numeric} \tab 03-08 \tab Background level\cr -\verb{[,30]} \tab \code{SHIFT} \tab \code{integer} \tab 03-08 \tab Number of channels to shift data\cr -\verb{[,31]} \tab \code{TAG} \tab \code{integer} \tab 03-08 \tab Tag, triggers \code{SEL}\cr -\verb{[,32]} \tab \code{LTYPE} \tab \code{character} \tab 03-08 \tab Luminescence type\cr -\verb{[,33]} \tab \code{LIGHTSOURCE} \tab \code{character} \tab 03-08 \tab Light source\cr -\verb{[,34]} \tab \code{LPOWER} \tab \code{numeric} \tab 03-08 \tab Optical stimulation power\cr -\verb{[,35]} \tab \code{LIGHTPOWER} \tab \code{numeric} \tab 05-08 \tab Optical stimulation power\cr -\verb{[,36]} \tab \code{LOW} \tab \code{numeric} \tab 03-08 \tab Low (temperature, time, wavelength)\cr -\verb{[,37]} \tab \code{HIGH} \tab \code{numeric} \tab 03-08 \tab High (temperature, time, wavelength)\cr -\verb{[,38]} \tab \code{RATE} \tab \code{numeric} \tab 03-08 \tab Rate (heating rate, scan rate)\cr -\verb{[,39]} \tab \code{TEMPERATURE} \tab \code{integer} \tab 03-08 \tab Sample temperature\cr -\verb{[,40]} \tab \code{MEASTEMP} \tab \code{integer} \tab 05-08 \tab Measured temperature\cr -\verb{[,41]} \tab \code{AN_TEMP} \tab \code{numeric} \tab 03-08 \tab Annealing temperature\cr -\verb{[,42]} \tab \code{AN_TIME} \tab \code{numeric} \tab 03-08 \tab Annealing time\cr -\verb{[,43]} \tab \code{TOLDELAY} \tab \code{integer} \tab 03-08 \tab TOL 'delay' channels\cr -\verb{[,44]} \tab \code{TOLON} \tab \code{integer} \tab 03-08 \tab TOL 'on' channels\cr -\verb{[,45]} \tab \code{TOLOFF} \tab \code{integer} \tab 03-08 \tab TOL 'off' channels\cr -\verb{[,46]} \tab \code{IRR_TIME} \tab \code{numeric} \tab 03-08 \tab Irradiation time\cr -\verb{[,47]} \tab \code{IRR_TYPE} \tab \code{integer} \tab 03-08 \tab Irradiation type (alpha, beta or gamma)\cr -\verb{[,48]} \tab \code{IRR_UNIT} \tab \code{integer} \tab 03-04 \tab Irradiation unit (Gy, rad, s, min, h)\cr -\verb{[,49]} \tab \code{IRR_DOSERATE} \tab \code{numeric} \tab 05-08 \tab Irradiation dose rate (Gy/s)\cr -\verb{[,50]} \tab \code{IRR_DOSERATEERR} \tab \code{numeric} \tab 06-08 \tab Irradiation dose rate error (Gy/s)\cr -\verb{[,51]} \tab \code{TIMESINCEIRR} \tab \code{integer} \tab 05-08 \tab Time since irradiation (s)\cr -\verb{[,52]} \tab \code{TIMETICK} \tab \code{numeric} \tab 05-08 \tab Time tick for pulsing (s)\cr -\verb{[,53]} \tab \code{ONTIME} \tab \code{integer} \tab 05-08 \tab On-time for pulsing (in time ticks)\cr -\verb{[,54]} \tab \code{OFFTIME} \tab \code{integer} \tab 03 \tab Off-time for pulsed stimulation (in s) \cr -\verb{[,55]} \tab \code{STIMPERIOD} \tab \code{integer} \tab 05-08 \tab Stimulation period (on+off in time ticks)\cr -\verb{[,56]} \tab \code{GATE_ENABLED} \tab \code{raw} \tab 05-08 \tab PMT signal gating enabled\cr -\verb{[,57]} \tab \code{ENABLE_FLAGS} \tab \code{raw} \tab 05-08 \tab PMT signal gating enabled\cr -\verb{[,58]} \tab \code{GATE_START} \tab \code{integer} \tab 05-08 \tab Start gating (in time ticks)\cr -\verb{[,59]} \tab \code{GATE_STOP} \tab \code{integer} \tab 05-08 \tab Stop gating (in time ticks), \code{'Gateend'} for version 04, here only GATE_STOP is used\cr -\verb{[,60]} \tab \code{PTENABLED} \tab \code{raw} \tab 05-08 \tab Photon time enabled\cr -\verb{[,61]} \tab \code{DTENABLED} \tab \code{raw} \tab 05-08 \tab PMT dead time correction enabled\cr -\verb{[,62]} \tab \code{DEADTIME} \tab \code{numeric} \tab 05-08 \tab PMT dead time (s)\cr -\verb{[,63]} \tab \code{MAXLPOWER} \tab \code{numeric} \tab 05-08 \tab Stimulation power to 100 percent (mW/cm^2)\cr -\verb{[,64]} \tab \code{XRF_ACQTIME} \tab \code{numeric} \tab 05-08 \tab XRF acquisition time (s)\cr -\verb{[,65]} \tab \code{XRF_HV} \tab \code{numeric} \tab 05-08 \tab XRF X-ray high voltage (V)\cr -\verb{[,66]} \tab \code{XRF_CURR} \tab \code{integer} \tab 05-08 \tab XRF X-ray current (µA)\cr -\verb{[,67]} \tab \code{XRF_DEADTIMEF} \tab \code{numeric} \tab 05-08 \tab XRF dead time fraction\cr -\verb{[,68]} \tab \code{DETECTOR_ID} \tab \code{raw} \tab 07-08 \tab Detector ID\cr -\verb{[,69]} \tab \code{LOWERFILTER_ID} \tab \code{integer} \tab 07-08 \tab Lower filter ID in reader\cr -\verb{[,70]} \tab \code{UPPERFILTER_ID} \tab \code{integer} \tab 07-08 \tab Upper filter ID in reader\cr -\verb{[,71]} \tab \code{ENOISEFACTOR} \tab \code{numeric} \tab 07-08 \tab Excess noise filter, usage unknown \cr -\verb{[,72]} \tab \code{MARKPOS_X1} \tab \code{numeric} \tab 08 \tab Coordinates marker position 1 \cr -\verb{[,73]} \tab \code{MARKPOS_Y1} \tab \code{numeric} \tab 08 \tab Coordinates marker position 1 \cr -\verb{[,74]} \tab \code{MARKPOS_X2} \tab \code{numeric} \tab 08 \tab Coordinates marker position 2 \cr -\verb{[,75]} \tab \code{MARKPOS_Y2} \tab \code{numeric} \tab 08 \tab Coordinates marker position 2 \cr -\verb{[,76]} \tab \code{MARKPOS_X3} \tab \code{numeric} \tab 08 \tab Coordinates marker position 3 \cr -\verb{[,77]} \tab \code{MARKPOS_Y3} \tab \code{numeric} \tab 08 \tab Coordinates marker position 3 \cr -\verb{[,78]} \tab \code{EXTR_START} \tab \code{numeric} \tab 08 \tab usage unknown \cr -\verb{[,79]} \tab \code{EXTR_END} \tab \code{numeric} \tab 08 \tab usage unknown\cr -\verb{[,80]} \tab \code{SEQUENCE} \tab \code{character} \tab 03-04 \tab Sequence name -} -V = BIN-file version (RLum means that it does not depend on a specific BIN version) - -Note that the \code{Risoe.BINfileData} object combines all values from -different versions from the BIN-file, reserved bits are skipped, however, -the function \link{write_R2BIN} reset arbitrary reserved bits. Invalid -values for a specific version are set to \code{NA}. Furthermore, the -internal R data types do not necessarily match the required data types for -the BIN-file data import! Data types are converted during data import.\cr - -\strong{LTYPE} values - -\tabular{rll}{ -VALUE \tab TYPE \tab DESCRIPTION \cr -\verb{[0]} \tab \code{TL} \tab: Thermoluminescence \cr -\verb{[1]} \tab \code{OSL} \tab: Optically stimulated luminescence \cr -\verb{[2]} \tab \code{IRSL} \tab: Infrared stimulated luminescence \cr -\verb{[3]} \tab \code{M-IR} \tab: Infrared monochromator scan\cr -\verb{[4]} \tab \code{M-VIS} \tab: Visible monochromator scan\cr -\verb{[5]} \tab \code{TOL} \tab: Thermo-optical luminescence \cr -\verb{[6]} \tab \code{TRPOSL} \tab: Time Resolved Pulsed OSL\cr -\verb{[7]} \tab \code{RIR} \tab: Ramped IRSL\cr -\verb{[8]} \tab \code{RBR} \tab: Ramped (Blue) LEDs\cr -\verb{[9]} \tab \code{USER} \tab: User defined\cr -\verb{[10]} \tab \code{POSL} \tab: Pulsed OSL \cr -\verb{[11]} \tab \code{SGOSL} \tab: Single Grain OSL\cr -\verb{[12]} \tab \code{RL} \tab: Radio Luminescence \cr -\verb{[13]} \tab \code{XRF} \tab: X-ray Fluorescence -} - -\strong{DTYPE} values - -\tabular{rl}{ -VALUE \tab DESCRIPTION \cr -\verb{[0]} \tab Natural \cr -\verb{[1]} \tab N+dose \cr -\verb{[2]} \tab Bleach \cr -\verb{[3]} \tab Bleach+dose \cr -\verb{[4]} \tab Natural (Bleach) \cr -\verb{[5]} \tab N+dose (Bleach) \cr -\verb{[6]} \tab Dose \cr -\verb{[7]} \tab Background -} - -\strong{LIGHTSOURCE} values - -\tabular{rl}{ -VALUE \tab DESCRIPTION \cr -\verb{[0]} \tab None \cr -\verb{[1]} \tab Lamp \cr -\verb{[2]} \tab IR diodes/IR Laser \cr -\verb{[3]} \tab Calibration LED \cr -\verb{[4]} \tab Blue Diodes \cr -\verb{[5]} \tab White light \cr -\verb{[6]} \tab Green laser (single grain) \cr -\verb{[7]} \tab IR laser (single grain) } - -\strong{Internal DATA - object structure} - -With version 8 of the BIN/BINX file format, slot \verb{@DATA} (byte array \code{DPOINTS}) can -contain two different values: -\enumerate{ -\item \code{DPOINTS} (standard for \code{RECTYPE} := (0,1)): is a vector with the length defined -through \code{NPOINTS}. This is the standard for xy-curves since version 03. -\item \code{DPOINTS} (\code{RECTYPE} := 128) is contains no count values but information about -the definition of the regions of interest (ROI). Each definition is 504 bytes long. -The number of definitions is defined by \code{NPOINTS} in \verb{@METADATA}. The record -describes basically the geometric features of the regions of interest. -The representation in R is a nested \link{list}. -} - -\tabular{rllll}{ -\strong{#} \tab \strong{Name} \tab \strong{Data Type} \tab \strong{V} \tab \strong{Description} \cr -\verb{[,1]} \tab \code{NOFPOINTS} \tab \code{numeric} \tab 08 \tab number of points in the definition (e.g., if the ROI is a rectangle: 4)\cr -\verb{[,2]} \tab \code{USEDFOR} \tab \code{logical} \tab 08 \tab samples for which the ROI is used for; a maximum of 48 samples are allowed.\cr -\verb{[,3]} \tab \code{SHOWNFOR} \tab \code{logical} \tab 08 \tab samples for which the ROI is shown for; a maximum of 48 samples are allowed.\cr -\verb{[,4]} \tab \code{COLOR} \tab \code{numeric} \tab 08 \tab The colour values of the ROI.\cr -\verb{[,5]} \tab \code{X} \tab \code{numeric} \tab 08 \tab The x coordinates used to draw the ROI geometry (up to 50 points are allowed).\cr -\verb{[,6]} \tab \code{Y} \tab \code{numeric} \tab 08 \tab The y coordinates used to draw the ROI geometry (up to 50 points are allowed).\cr -} - -(information on the BIN/BINX file format are kindly provided by Risø, DTU Nutech) -} -\section{Objects from the Class}{ - Objects can be created by calls of the form -\code{new("Risoe.BINfileData", ...)}. -} - -\section{Function version}{ - 0.4.1 -} - -\examples{ - -showClass("Risoe.BINfileData") - -} - -\section{How to cite}{ -Kreutzer, S., 2024. Risoe.BINfileData-class(): Class 'Risoe.BINfileData'. Function version 0.4.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Risø DTU, 2013. The Sequence Editor User Manual - Feb 2013 and Risø DTU, 2016. - -The Sequence Editor User Manual - February 2016 - -\url{https://www.fysik.dtu.dk} -} -\seealso{ -\link{plot_Risoe.BINfileData}, \link{read_BIN2R}, \link{write_R2BIN}, -\link{merge_Risoe.BINfileData}, \link{Risoe.BINfileData2RLum.Analysis} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -based on information provided by Torben Lapp and Karsten Bracht Nielsen (Risø DTU, Denmark) -, RLum Developer Team} -\keyword{classes} -\keyword{internal} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/Risoe.BINfileData2RLum.Analysis.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/Risoe.BINfileData2RLum.Analysis.Rd deleted file mode 100644 index 259d41c41..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/Risoe.BINfileData2RLum.Analysis.Rd +++ /dev/null @@ -1,105 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Risoe.BINfileData2RLum.Analysis.R -\name{Risoe.BINfileData2RLum.Analysis} -\alias{Risoe.BINfileData2RLum.Analysis} -\title{Convert Risoe.BINfileData object to an RLum.Analysis object} -\usage{ -Risoe.BINfileData2RLum.Analysis( - object, - pos = NULL, - grain = NULL, - run = NULL, - set = NULL, - ltype = NULL, - dtype = NULL, - protocol = "unknown", - keep.empty = TRUE, - txtProgressBar = FALSE -) -} -\arguments{ -\item{object}{\linkS4class{Risoe.BINfileData} (\strong{required}): -\code{Risoe.BINfileData} object} - -\item{pos}{\link{numeric} (\emph{optional}): position number of the \code{Risoe.BINfileData} -object for which the curves are stored in the \code{RLum.Analysis} object. -If \code{length(position)>1} a list of \code{RLum.Analysis} objects is returned. -If nothing is provided every position will be converted. -If the position is not valid \code{NULL} is returned.} - -\item{grain}{\link{vector}, \link{numeric} (\emph{optional}): -grain number from the measurement to limit the converted data set -(e.g., \code{grain = c(1:48)}). Please be aware that this option may lead to -unwanted effects, as the output is strictly limited to the chosen grain -number for all position numbers} - -\item{run}{\link{vector}, \link{numeric} (\emph{optional}): -run number from the measurement to limit the converted data set -(e.g., \code{run = c(1:48)}).} - -\item{set}{\link{vector}, \link{numeric} (\emph{optional}): -set number from the measurement to limit the converted data set -(e.g., \code{set = c(1:48)}).} - -\item{ltype}{\link{vector}, \link{character} (\emph{optional}): -curve type to limit the converted data. Commonly allowed values are: -\code{IRSL}, \code{OSL}, \code{TL}, \code{RIR}, \code{RBR} and \code{USER} -(see also \linkS4class{Risoe.BINfileData})} - -\item{dtype}{\link{vector}, \link{character} (\emph{optional}): -data type to limit the converted data. Commonly allowed values are -listed in \linkS4class{Risoe.BINfileData}} - -\item{protocol}{\link{character} (\emph{optional}): -sets protocol type for analysis object. Value may be used by subsequent -analysis functions.} - -\item{keep.empty}{\link{logical} (\emph{with default}): -If \code{TRUE} (default) an \code{RLum.Analysis} object is returned even if it does -not contain any records. Set to \code{FALSE} to discard all empty objects.} - -\item{txtProgressBar}{\link{logical} (\emph{with default}): -enables or disables \link{txtProgressBar}.} -} -\value{ -Returns an \linkS4class{RLum.Analysis} object. -} -\description{ -Converts values from one specific position of a Risoe.BINfileData S4-class -object to an RLum.Analysis object. -} -\details{ -The \linkS4class{RLum.Analysis} object requires a set of curves for -specific further protocol analyses. However, the \linkS4class{Risoe.BINfileData} -usually contains a set of curves for different aliquots and different -protocol types that may be mixed up. Therefore, a conversion is needed. -} -\note{ -The \code{protocol} argument of the \linkS4class{RLum.Analysis} -object is set to 'unknown' if not stated otherwise. -} -\section{Function version}{ - 0.4.3 -} - -\examples{ - -##load data -data(ExampleData.BINfileData, envir = environment()) - -##convert values for position 1 -Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = 1) - -} -\seealso{ -\linkS4class{Risoe.BINfileData}, \linkS4class{RLum.Analysis}, \link{read_BIN2R} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. Risoe.BINfileData2RLum.Analysis(): Convert Risoe.BINfileData object to an RLum.Analysis object. Function version 0.4.3. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{manip} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/Second2Gray.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/Second2Gray.Rd deleted file mode 100644 index b9c2bef90..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/Second2Gray.Rd +++ /dev/null @@ -1,111 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Second2Gray.R -\name{Second2Gray} -\alias{Second2Gray} -\title{Converting equivalent dose values from seconds (s) to Gray (Gy)} -\usage{ -Second2Gray(data, dose.rate, error.propagation = "omit") -} -\arguments{ -\item{data}{\link{data.frame} (\strong{required}): -input values, structure: data (\code{values[,1]}) and data error (\code{values [,2]}) -are required} - -\item{dose.rate}{\linkS4class{RLum.Results}, \link{data.frame} or \link{numeric} (\strong{required}): -\code{RLum.Results} needs to be originated from the function \link{calc_SourceDoseRate}, -for \code{vector} dose rate in Gy/s and dose rate error in Gy/s} - -\item{error.propagation}{\link{character} (\emph{with default}): -error propagation method used for error calculation (\code{omit}, \code{gaussian} or -\code{absolute}), see details for further information} -} -\value{ -Returns a \link{data.frame} with converted values. -} -\description{ -Conversion of absorbed radiation dose in seconds (s) to the SI unit Gray -(Gy) including error propagation. Normally used for equivalent dose data. -} -\details{ -Calculation of De values from seconds (s) to Gray (Gy) - -\deqn{De [Gy] = De [s] * Dose Rate [Gy/s])} - -Provided calculation error propagation methods for error calculation -(with \code{'se'} as the standard error and \code{'DR'} of the dose rate of the beta-source): - -\strong{(1) \code{omit}} (default) - -\deqn{se(De) [Gy] = se(De) [s] * DR [Gy/s]} - -In this case the standard error of the dose rate of the beta-source is -treated as systematic (i.e. non-random), it error propagation is omitted. -However, the error must be considered during calculation of the final age. -(cf. Aitken, 1985, pp. 242). This approach can be seen as method (2) (gaussian) -for the case the (random) standard error of the beta-source calibration is -0. Which particular method is requested depends on the situation and cannot -be prescriptive. - -\strong{(2) \code{gaussian}} error propagation - -\deqn{se(De) [Gy] = \sqrt((DR [Gy/s] * se(De) [s])^2 + (De [s] * se(DR) [Gy/s])^2)} - -Applicable under the assumption that errors of \code{De} and \code{se} are uncorrelated. - -\strong{(3) \code{absolute}} error propagation - -\deqn{se(De) [Gy]= abs(DR [Gy/s] * se(De) [s]) + abs(De [s] * se(DR) [Gy/s])} - -Applicable under the assumption that errors of \code{De} and \code{se} are correlated. -} -\note{ -If no or a wrong error propagation method is given, the execution of the function is -stopped. Furthermore, if a \code{data.frame} is provided for the dose rate values is has to -be of the same length as the data frame provided with the argument \code{data} -} -\section{Function version}{ - 0.6.0 -} - -\examples{ - -##(A) for known source dose rate at date of measurement -## - load De data from the example data help file -data(ExampleData.DeValues, envir = environment()) -## - convert De(s) to De(Gy) -Second2Gray(ExampleData.DeValues$BT998, c(0.0438,0.0019)) - - - - - -##(B) for source dose rate calibration data -## - calculate source dose rate first -dose.rate <- calc_SourceDoseRate(measurement.date = "2012-01-27", - calib.date = "2014-12-19", - calib.dose.rate = 0.0438, - calib.error = 0.0019) -# read example data -data(ExampleData.DeValues, envir = environment()) - -# apply dose.rate to convert De(s) to De(Gy) -Second2Gray(ExampleData.DeValues$BT998, dose.rate) - -} - -\section{How to cite}{ -Kreutzer, S., Dietze, M., Fuchs, M.C., 2024. Second2Gray(): Converting equivalent dose values from seconds (s) to Gray (Gy). Function version 0.6.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Aitken, M.J., 1985. Thermoluminescence dating. Academic Press. -} -\seealso{ -\link{calc_SourceDoseRate} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -Michael Dietze, GFZ Potsdam (Germany)\cr -Margret C. Fuchs, HZDR, Helmholtz-Institute Freiberg for Resource Technology (Germany) -, RLum Developer Team} -\keyword{manip} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_Al2O3C_CrossTalk.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_Al2O3C_CrossTalk.Rd deleted file mode 100644 index fb4a9147c..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_Al2O3C_CrossTalk.Rd +++ /dev/null @@ -1,109 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/analyse_Al2O3C_CrossTalk.R -\name{analyse_Al2O3C_CrossTalk} -\alias{analyse_Al2O3C_CrossTalk} -\title{Al2O3:C Reader Cross Talk Analysis} -\usage{ -analyse_Al2O3C_CrossTalk( - object, - signal_integral = NULL, - dose_points = c(0, 4), - recordType = c("OSL (UVVIS)"), - irradiation_time_correction = NULL, - method_control = NULL, - plot = TRUE, - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum.Analysis} \strong{(required)}: -measurement input} - -\item{signal_integral}{\link{numeric} (\emph{optional}): -signal integral, used for the signal and the background. -If nothing is provided the full range is used} - -\item{dose_points}{\link{numeric} (\emph{with default}): -vector with dose points, if dose points are repeated, only the general -pattern needs to be provided. Default values follow the suggestions -made by Kreutzer et al., 2018} - -\item{recordType}{\link{character} (\emph{with default}): input curve selection, which is passed to -function \link{get_RLum}. To deactivate the automatic selection set the argument to \code{NULL}} - -\item{irradiation_time_correction}{\link{numeric} or \linkS4class{RLum.Results} (\emph{optional}): -information on the used irradiation time correction obtained by another experiments.} - -\item{method_control}{\link{list} (\emph{optional}): -optional parameters to control the calculation. -See details for further explanations} - -\item{plot}{\link{logical} (\emph{with default}): -enable/disable plot output} - -\item{...}{further arguments that can be passed to the plot output} -} -\value{ -Function returns results numerically and graphically: - ------------------------------------\cr -\verb{[ NUMERICAL OUTPUT ]}\cr ------------------------------------\cr - -\strong{\code{RLum.Results}}-object - -\strong{slot:} \strong{\verb{@data}} - -\tabular{lll}{ -\strong{Element} \tab \strong{Type} \tab \strong{Description}\cr -\verb{$data} \tab \code{data.frame} \tab summed apparent dose table \cr -\verb{$data_full} \tab \code{data.frame} \tab full apparent dose table \cr -\verb{$fit} \tab \code{lm} \tab the linear model obtained from fitting \cr -\verb{$col.seq} \tab \code{numeric} \tab the used colour vector \cr -} - -\strong{slot:} \strong{\verb{@info}} - -The original function call - -------------------------\cr -\verb{[ PLOT OUTPUT ]}\cr -------------------------\cr -\itemize{ -\item An overview of the obtained apparent dose values -} -} -\description{ -The function provides the analysis of cross-talk measurements on a -FI lexsyg SMART reader using Al2O3:C chips -} -\section{Function version}{ - 0.1.3 -} - -\examples{ - -##load data -data(ExampleData.Al2O3C, envir = environment()) - -##run analysis -analyse_Al2O3C_CrossTalk(data_CrossTalk) - -} - -\section{How to cite}{ -Kreutzer, S., 2024. analyse_Al2O3C_CrossTalk(): Al2O3:C Reader Cross Talk Analysis. Function version 0.1.3. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Kreutzer, S., Martin, L., Guérin, G., Tribolo, C., Selva, P., Mercier, N., 2018. Environmental Dose Rate -Determination Using a Passive Dosimeter: Techniques and Workflow for alpha-Al2O3:C Chips. -Geochronometria 45, 56-67. doi: 10.1515/geochr-2015-0086 -} -\seealso{ -\link{analyse_Al2O3C_ITC} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_Al2O3C_ITC.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_Al2O3C_ITC.Rd deleted file mode 100644 index cac38d49f..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_Al2O3C_ITC.Rd +++ /dev/null @@ -1,132 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/analyse_Al2O3C_ITC.R -\name{analyse_Al2O3C_ITC} -\alias{analyse_Al2O3C_ITC} -\title{Al2O3 Irradiation Time Correction Analysis} -\usage{ -analyse_Al2O3C_ITC( - object, - signal_integral = NULL, - dose_points = c(2, 4, 8, 12, 16), - recordType = c("OSL (UVVIS)"), - method_control = NULL, - verbose = TRUE, - plot = TRUE, - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum.Analysis} or \link{list} \strong{(required)}: -results obtained from the measurement. -Alternatively a list of \linkS4class{RLum.Analysis} objects can be provided to allow an automatic analysis} - -\item{signal_integral}{\link{numeric} (\emph{optional}): -signal integral, used for the signal and the background. -If nothing is provided the full range is used. Argument can be provided as \link{list}.} - -\item{dose_points}{\link{numeric} (\emph{with default}): -vector with dose points, if dose points are repeated, only the general -pattern needs to be provided. Default values follow the suggestions -made by Kreutzer et al., 2018. Argument can be provided as \link{list}.} - -\item{recordType}{\link{character} (\emph{with default}): input curve selection, which is passed to -function \link{get_RLum}. To deactivate the automatic selection set the argument to \code{NULL}} - -\item{method_control}{\link{list} (\emph{optional}): -optional parameters to control the calculation. -See details for further explanations} - -\item{verbose}{\link{logical} (\emph{with default}): -enable/disable verbose mode} - -\item{plot}{\link{logical} (\emph{with default}): -enable/disable plot output} - -\item{...}{further arguments that can be passed to the plot output} -} -\value{ -Function returns results numerically and graphically: - ------------------------------------\cr -\verb{[ NUMERICAL OUTPUT ]}\cr ------------------------------------\cr - -\strong{\code{RLum.Results}}-object - -\strong{slot:} \strong{\verb{@data}} - -\tabular{lll}{ -\strong{Element} \tab \strong{Type} \tab \strong{Description}\cr -\verb{$data} \tab \code{data.frame} \tab correction value and error \cr -\verb{$table} \tab \code{data.frame} \tab table used for plotting \cr -\verb{$table_mean} \tab \code{data.frame} \tab table used for fitting \cr -\verb{$fit} \tab \code{lm} or \code{nls} \tab the fitting as returned by the function \link{plot_GrowthCurve} -} - -\strong{slot:} \strong{\verb{@info}} - -The original function call - -------------------------\cr -\verb{[ PLOT OUTPUT ]}\cr -------------------------\cr -\itemize{ -\item A dose response curve with the marked correction values -} -} -\description{ -The function provides a very particular analysis to correct the irradiation -time while irradiating Al2O3:C chips in a luminescence reader. -} -\details{ -Background: Due to their high dose sensitivity Al2O3:C chips are usually -irradiated for only a very short duration or under the closed beta-source -within a luminescence reader. However, due to its high dose sensitivity, during -the movement towards the beta-source, the pellet already receives and non-negligible -dose. Based on measurements following a protocol suggested by Kreutzer et al., 2018, -a dose response curve is constructed and the intersection (absolute value) with the time axis -is taken as real irradiation time. - -\strong{\code{method_control}} - -To keep the generic argument list as clear as possible, arguments to allow a -deeper control of the method are all preset with meaningful default parameters and can be -handled using the argument \code{method_control} only, e.g., -\code{method_control = list(fit.method = "LIN")}. Supported arguments are: - -\tabular{lll}{ -\strong{ARGUMENT} \tab \strong{FUNCTION} \tab \strong{DESCRIPTION}\cr -\code{mode} \tab \code{plot_GrowthCurve} \tab as in \link{plot_GrowthCurve}; sets the mode used for fitting\cr -\code{fit.method} \tab \code{plot_GrowthCurve} \tab as in \link{plot_GrowthCurve}; sets the function applied for fitting\cr -} -} -\section{Function version}{ - 0.1.1 -} - -\examples{ - -##load data -data(ExampleData.Al2O3C, envir = environment()) - -##run analysis -analyse_Al2O3C_ITC(data_ITC) - -} - -\section{How to cite}{ -Kreutzer, S., 2024. analyse_Al2O3C_ITC(): Al2O3 Irradiation Time Correction Analysis. Function version 0.1.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Kreutzer, S., Martin, L., Guérin, G., Tribolo, C., Selva, P., Mercier, N., 2018. Environmental Dose Rate -Determination Using a Passive Dosimeter: Techniques and Workflow for alpha-Al2O3:C Chips. -Geochronometria 45, 56-67. doi: 10.1515/geochr-2015-0086 -} -\seealso{ -\link{plot_GrowthCurve} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_Al2O3C_Measurement.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_Al2O3C_Measurement.Rd deleted file mode 100644 index 7d5619e09..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_Al2O3C_Measurement.Rd +++ /dev/null @@ -1,163 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/analyse_Al2O3C_Measurement.R -\name{analyse_Al2O3C_Measurement} -\alias{analyse_Al2O3C_Measurement} -\title{Al2O3:C Passive Dosimeter Measurement Analysis} -\usage{ -analyse_Al2O3C_Measurement( - object, - signal_integral = NULL, - dose_points = c(0, 4), - recordType = c("OSL (UVVIS)", "TL (UVVIS)"), - calculate_TL_dose = FALSE, - irradiation_time_correction = NULL, - cross_talk_correction = NULL, - travel_dosimeter = NULL, - test_parameters = NULL, - verbose = TRUE, - plot = TRUE, - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum.Analysis} (\strong{required}): measurement input} - -\item{signal_integral}{\link{numeric} (\emph{optional}): signal integral, used for the signal -and the background. Example: \code{c(1:10)} for the first 10 channels. -If nothing is provided the full range is used} - -\item{dose_points}{\link{numeric} (\emph{with default}): -vector with dose points, if dose points are repeated, only the general -pattern needs to be provided. Default values follow the suggestions -made by Kreutzer et al., 2018} - -\item{recordType}{\link{character} (\emph{with default}): input curve selection, which is passed to -function \link{get_RLum}. To deactivate the automatic selection set the argument to \code{NULL}} - -\item{calculate_TL_dose}{\link{logical} (\emph{with default}): Enables/disables experimental dose estimation -based on the TL curves. Taken is the ratio of the peak sums of each curves +/- 5 channels.} - -\item{irradiation_time_correction}{\link{numeric} or \linkS4class{RLum.Results} (\emph{optional}): -information on the used irradiation time correction obtained by another experiments. -If a \code{numeric} is provided it has to be of length two: mean, standard error} - -\item{cross_talk_correction}{\link{numeric} or \linkS4class{RLum.Results} (\emph{optional}): -information on the used irradiation time correction obtained by another experiments. -If a \code{numeric} vector is provided it has to be of length three: -mean, 2.5 \% quantile, 97.5 \% quantile.} - -\item{travel_dosimeter}{\link{numeric} (\emph{optional}): specify the position of the travel dosimeter -(so far measured at the same time). The dose of travel dosimeter will be subtracted from all -other values.} - -\item{test_parameters}{\link{list} (\emph{with default}): -set test parameters. Supported parameters are: \code{TL_peak_shift} All input: \link{numeric} -values, \code{NA} and \code{NULL} (s. Details)} - -\item{verbose}{\link{logical} (\emph{with default}): -enable/disable verbose mode} - -\item{plot}{\link{logical} (\emph{with default}): enable/disable plot output, if \code{object} is of type \link{list}, -a \link{numeric} vector can be provided to limit the plot output to certain aliquots} - -\item{...}{further arguments that can be passed to the plot output, supported are \code{norm}, \code{main}, \code{mtext}, -\code{title} (for self-call mode to specify, e.g., sample names)} -} -\value{ -Function returns results numerically and graphically: - ------------------------------------\cr -\verb{[ NUMERICAL OUTPUT ]}\cr ------------------------------------\cr - -\strong{\code{RLum.Results}}-object - -\strong{slot:} \strong{\verb{@data}} - -\tabular{lll}{ -\strong{Element} \tab \strong{Type} \tab \strong{Description}\cr -\verb{$data} \tab \code{data.frame} \tab the estimated equivalent dose \cr -\verb{$data_table} \tab \code{data.frame} \tab full dose and signal table \cr -\code{test_parameters} \tab \code{data.frame} \tab results with test parameters \cr -\code{data_TDcorrected} \tab \code{data.frame} \tab travel dosimeter corrected results (only if TD was provided)\cr -} - -\emph{Note: If correction the irradiation time and the cross-talk correction method is used, the De -values in the table \code{data} table are already corrected, i.e. if you want to get an uncorrected value, -you can use the column \code{CT_CORRECTION} remove the correction} - -\strong{slot:} \strong{\verb{@info}} - -The original function call - -------------------------\cr -\verb{[ PLOT OUTPUT ]}\cr -------------------------\cr -\itemize{ -\item OSL and TL curves, combined on two plots. -} -} -\description{ -The function provides the analysis routines for measurements on a -FI lexsyg SMART reader using Al2O3:C chips according to Kreutzer et al., 2018 -} -\details{ -\strong{Working with a travel dosimeter} - -The function allows to define particular aliquots as travel dosimeters. For example: -\code{travel_dosimeter = c(1,3,5)} sets aliquots 1, 3 and 5 as travel dosimeters. These dose values -of this dosimeters are combined and automatically subtracted from the obtained dose values -of the other dosimeters. - -\strong{Calculate TL dose} - -The argument \code{calculate_TL_dose} provides the possibility to experimentally calculate a TL-dose, -i.e. an apparent dose value derived from the TL curve ratio. However, it should be noted that -this value is only a fall back in case something went wrong during the measurement of the optical -stimulation. The TL derived dose value is corrected for cross-talk and for the irradiation time, -but not considered if a travel dosimeter is defined. - -Calculating the palaeodose is possible without \strong{any TL} curve in the sequence! - -\strong{Test parameters} - -\code{TL_peak_shift} \link{numeric} (default: \code{15}): - -Checks whether the TL peak shift is bigger > 15 K, indicating a problem with the -thermal contact of the chip. - -\code{stimulation_power} \link{numeric} (default: \code{0.05}): - -So far available, information on the delivered optical stimulation are compared. Compared are -the information from the first curves with all others. If the ratio differs more from -unity than the defined by the threshold, a warning is returned. -} -\section{Function version}{ - 0.2.6 -} - -\examples{ -##load data -data(ExampleData.Al2O3C, envir = environment()) - -##run analysis -analyse_Al2O3C_Measurement(data_CrossTalk) - -} - -\section{How to cite}{ -Kreutzer, S., 2024. analyse_Al2O3C_Measurement(): Al2O3:C Passive Dosimeter Measurement Analysis. Function version 0.2.6. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Kreutzer, S., Martin, L., Guérin, G., Tribolo, C., Selva, P., Mercier, N., 2018. Environmental Dose Rate -Determination Using a Passive Dosimeter: Techniques and Workflow for alpha-Al2O3:C Chips. -Geochronometria 45, 56-67. -} -\seealso{ -\link{analyse_Al2O3C_ITC} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_FadingMeasurement.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_FadingMeasurement.Rd deleted file mode 100644 index a72d1964a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_FadingMeasurement.Rd +++ /dev/null @@ -1,211 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/analyse_FadingMeasurement.R -\name{analyse_FadingMeasurement} -\alias{analyse_FadingMeasurement} -\title{Analyse fading measurements and returns the fading rate per decade (g-value)} -\usage{ -analyse_FadingMeasurement( - object, - structure = c("Lx", "Tx"), - signal.integral, - background.integral, - t_star = "half", - n.MC = 100, - verbose = TRUE, - plot = TRUE, - plot.single = FALSE, - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum.Analysis} (\strong{required}): -input object with the measurement data. Alternatively, a \link{list} containing \linkS4class{RLum.Analysis} -objects or a \link{data.frame} with three columns -(x = LxTx, y = LxTx error, z = time since irradiation) can be provided. -Can also be a wide table, i.e. a \link{data.frame} with a number of columns divisible by 3 -and where each triplet has the before mentioned column structure. - -\strong{Please note: The input object should solely consists of the curve needed for the data analysis, i.e. -only IRSL curves representing Lx (and Tx)} - -If data from multiple aliquots are provided please \strong{see the details below} with regard to -Lx/Tx normalisation. \strong{The function assumes that all your measurements are related to -one (comparable) sample. If you to treat independent samples, you have use this function -in a loop.}} - -\item{structure}{\link{character} (\emph{with default}): -sets the structure of the measurement data. Allowed are \code{'Lx'} or \code{c('Lx','Tx')}. -Other input is ignored} - -\item{signal.integral}{\link{vector} (\strong{required}): vector with channels for the signal integral -(e.g., \code{c(1:10)}). Not required if a \code{data.frame} with \code{LxTx} values is provided.} - -\item{background.integral}{\link{vector} (\strong{required}): vector with channels for the background integral -(e.g., \code{c(90:100)}). Not required if a \code{data.frame} with \code{LxTx} values is provided.} - -\item{t_star}{\link{character} (\emph{with default}): -method for calculating the time elapsed since irradiation if input is \strong{not} a \code{data.frame}. -Options are: \code{'half'} (the default), \verb{'half_complex}, which uses the long equation in Auclair et al. 2003, and -and \code{'end'}, which takes the time between irradiation and the measurement step. -Alternatively, \code{t_star} can be a function with one parameter which works on \code{t1}. -For more information see details. \cr - -\emph{\code{t_star} has no effect if the input is a \link{data.frame}, because this input comes -without irradiation times.}} - -\item{n.MC}{\link{integer} (\emph{with default}): -number for Monte Carlo runs for the error estimation} - -\item{verbose}{\link{logical} (\emph{with default}): -enables/disables verbose mode} - -\item{plot}{\link{logical} (\emph{with default}): -enables/disables plot output} - -\item{plot.single}{\link{logical} (\emph{with default}): -enables/disables single plot mode, i.e. one plot window per plot. -Alternatively a vector specifying the plot to be drawn, e.g., -\code{plot.single = c(3,4)} draws only the last two plots} - -\item{...}{(\emph{optional}) further arguments that can be passed to internally used functions. Supported arguments: -\code{xlab}, \code{log}, \code{mtext}, \code{plot.trend} (enable/disable trend blue line), and \code{xlim} for the -two first curve plots, and \code{ylim} for the fading -curve plot. For further plot customization please use the numerical output of the functions for -own plots.} -} -\value{ -An \linkS4class{RLum.Results} object is returned: - -Slot: \strong{@data} - -\tabular{lll}{ -\strong{OBJECT} \tab \strong{TYPE} \tab \strong{COMMENT}\cr -\code{fading_results} \tab \code{data.frame} \tab results of the fading measurement in a table \cr -\code{fit} \tab \code{lm} \tab object returned by the used linear fitting function \link[stats:lm]{stats::lm}\cr -\code{rho_prime} \tab \code{data.frame} \tab results of rho' estimation after Kars et al. (2008) \cr -\code{LxTx_table} \tab \code{data.frame} \tab Lx/Tx table, if curve data had been provided \cr -\code{irr.times} \tab \code{integer} \tab vector with the irradiation times in seconds \cr -} - -Slot: \strong{@info} - -\tabular{lll}{ -\strong{OBJECT} \tab \code{TYPE} \tab \code{COMMENT}\cr -\code{call} \tab \code{call} \tab the original function call\cr -} -} -\description{ -The function analysis fading measurements and returns a fading rate including an error estimation. -The function is not limited to standard fading measurements, as can be seen, e.g., Huntley and -Lamothe (2001). Additionally, the density of recombination centres (rho') is estimated after -Kars et al. (2008). -} -\details{ -All provided output corresponds to the \eqn{tc} value obtained by this analysis. Additionally -in the output object the g-value normalised to 2-days is provided. The output of this function -can be passed to the function \link{calc_FadingCorr}. - -\strong{Fitting and error estimation} - -For the fitting the function \link[stats:lm]{stats::lm} is used without applying weights. For the -error estimation all input values, except \code{tc}, as the precision can be considered as sufficiently -high enough with regard to the underlying problem, are sampled assuming a normal distribution -for each value with the value as the mean and the provided uncertainty as standard deviation. - -\strong{The options for \code{t_star}} - -\itemize{ -\item \code{t_star = "half"} (the default) The calculation follows the simplified -version in Auclair et al. (2003), which reads -\deqn{t_{star} := t_1 + (t_2 - t_1)/2} -\item \code{t_star = "half_complex"} This option applies the complex function shown in Auclair et al. (2003), -which is derived from Aitken (1985) appendix F, equations 9 and 11. -It reads \deqn{t_{star} = t0 * 10^[(t_2 log(t_2/t_0) - t_1 log(t_1/t_0) - 0.43(t_2 - t_1))/(t_2 - t_1)]} -where 0.43 = \eqn{1/ln(10)}. t0, which is an arbitrary constant, is set to 1. -Please note that the equation in Auclair et al. (2003) is incorrect -insofar that it reads \eqn{10exp(...)}, where the base should be 10 and not the Euler's number. -Here we use the correct version (base 10). -\item \code{t_star = "end"} This option uses the simplest possible form for \code{t_star} which is the time since -irradiation without taking into account any addition parameter and it equals t1 in Auclair et al. (2003) -\item \verb{t_star = } This last option allows you to provide an R function object that works on t1 and -gives you all possible freedom. For instance, you may want to define the following -function \code{fun <- function(x) {x^2}}, this would square all values of t1, because internally -it calls \code{fun(t1)}. The name of the function does not matter. -} - -\strong{Density of recombination centres} - -The density of recombination centres, expressed by the dimensionless variable rho', is estimated -by fitting equation 5 in Kars et al. 2008 to the data. For the fitting the function -\link[stats:nls]{stats::nls} is used without applying weights. For the error estimation the same -procedure as for the g-value is applied (see above). - -\strong{Multiple aliquots & Lx/Tx normalisation} - -Be aware that this function will always normalise all \code{Lx/Tx} values by the \code{Lx/Tx} value of the -prompt measurement of the first aliquot. This implicitly assumes that there are no systematic -inter-aliquot variations in the \code{Lx/Tx} values. If deemed necessary to normalise the \code{Lx/Tx} values -of each aliquot by its individual prompt measurement please do so \strong{before} running -\link{analyse_FadingMeasurement} and provide the already normalised values for \code{object} instead. - -\strong{Shine-down curve plots} -Please note that the shine-down curve plots are for information only. As such -not all pause steps are plotted to avoid graphically overloaded plots. -However, \emph{all} pause times are taken into consideration for the analysis. -} -\section{Function version}{ - 0.1.22 -} - -\examples{ - -## load example data (sample UNIL/NB123, see ?ExampleData.Fading) -data("ExampleData.Fading", envir = environment()) - -##(1) get fading measurement data (here a three column data.frame) -fading_data <- ExampleData.Fading$fading.data$IR50 - -##(2) run analysis -g_value <- analyse_FadingMeasurement( -fading_data, -plot = TRUE, -verbose = TRUE, -n.MC = 10) - -##(3) this can be further used in the function -## to correct the age according to Huntley & Lamothe, 2001 -results <- calc_FadingCorr( -age.faded = c(100,2), -g_value = g_value, -n.MC = 10) - -} - -\section{How to cite}{ -Kreutzer, S., Burow, C., 2024. analyse_FadingMeasurement(): Analyse fading measurements and returns the fading rate per decade (g-value). Function version 0.1.22. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Aitken, M.J., 1985. Thermoluminescence dating, Studies in archaeological science. -Academic Press, London, Orlando. - -Auclair, M., Lamothe, M., Huot, S., 2003. Measurement of anomalous fading for feldspar IRSL using -SAR. Radiation Measurements 37, 487-492. \doi{10.1016/S1350-4487(03)00018-0} - -Huntley, D.J., Lamothe, M., 2001. Ubiquity of anomalous fading in K-feldspars and the measurement -and correction for it in optical dating. Canadian Journal of Earth Sciences 38, -1093-1106. doi: \code{10.1139/cjes-38-7-1093} - -Kars, R.H., Wallinga, J., Cohen, K.M., 2008. A new approach towards anomalous -fading correction for feldspar IRSL dating-tests on samples in field saturation. -Radiation Measurements 43, 786-790. \doi{10.1016/j.radmeas.2008.01.021} -} -\seealso{ -\link{calc_OSLLxTxRatio}, \link{read_BIN2R}, \link{read_XSYG2R}, -\link{extract_IrradiationTimes}, \link{calc_FadingCorr} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) \cr -Christoph Burow, University of Cologne (Germany) -, RLum Developer Team} -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_IRSAR.RF.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_IRSAR.RF.Rd deleted file mode 100644 index cc5cb7016..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_IRSAR.RF.Rd +++ /dev/null @@ -1,435 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/analyse_IRSAR.RF.R -\name{analyse_IRSAR.RF} -\alias{analyse_IRSAR.RF} -\title{Analyse IRSAR RF measurements} -\usage{ -analyse_IRSAR.RF( - object, - sequence_structure = c("NATURAL", "REGENERATED"), - RF_nat.lim = NULL, - RF_reg.lim = NULL, - method = "FIT", - method.control = NULL, - test_parameters = NULL, - n.MC = 10, - txtProgressBar = TRUE, - plot = TRUE, - plot_reduced = FALSE, - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum.Analysis} or a \link{list} of \linkS4class{RLum.Analysis}-objects (\strong{required}): -input object containing data for protocol analysis. The function expects to -find at least two curves in the \linkS4class{RLum.Analysis} object: (1) \code{RF_nat}, (2) \code{RF_reg}. -If a \code{list} is provided as input all other parameters can be provided as -\code{list} as well to gain full control.} - -\item{sequence_structure}{\link{vector} \link{character} (\emph{with default}): -specifies the general sequence structure. Allowed steps are \code{NATURAL}, \code{REGENERATED}. -In addition any other character is allowed in the sequence structure; -such curves will be ignored during the analysis.} - -\item{RF_nat.lim}{\link{vector} (\emph{with default}): -set minimum and maximum channel range for natural signal fitting and sliding. -If only one value is provided this will be treated as minimum value and the -maximum limit will be added automatically.} - -\item{RF_reg.lim}{\link{vector} (\emph{with default}): -set minimum and maximum channel range for regenerated signal fitting and sliding. -If only one value is provided this will be treated as minimum value and the -maximum limit will be added automatically.} - -\item{method}{\link{character} (\emph{with default}): select method applied for the data analysis. -Possible options are \code{"FIT"}, \code{"SLIDE"}, \code{"VSLIDE"}.} - -\item{method.control}{\link{list} (\emph{optional}): -parameters to control the method, that can be passed to the chosen method. -These are for (1) \code{method = "FIT"}: \code{'trace'}, \code{'maxiter'}, \code{'warnOnly'}, \code{'minFactor'} and for -(2) \code{method = "SLIDE"}: \code{'correct_onset'}, \code{'show_density'}, \code{'show_fit'}, \code{'trace'}. -See details.} - -\item{test_parameters}{\link{list} (\emph{with default}): -set test parameters. Supported parameters are: \code{curves_ratio}, \code{residuals_slope} (only for -\code{method = "SLIDE"}), \code{curves_bounds}, \code{dynamic_ratio}, -\code{lambda}, \code{beta} and \code{delta.phi}. All input: \link{numeric} -values, \code{NA} and \code{NULL} (s. Details) - -(see Details for further information)} - -\item{n.MC}{\link{numeric} (\emph{with default}): -set number of Monte Carlo runs for start parameter estimation (\code{method = "FIT"}) or -error estimation (\code{method = "SLIDE"}). This value can be set to \code{NULL} to skip the -MC runs. Note: Large values will significantly increase the computation time} - -\item{txtProgressBar}{\link{logical} (\emph{with default}): -enables \code{TRUE} or disables \code{FALSE} the progress bar during MC runs} - -\item{plot}{\link{logical} (\emph{with default}): -plot output (\code{TRUE} or \code{FALSE})} - -\item{plot_reduced}{\link{logical} (\emph{optional}): -provides a reduced plot output if enabled to allow common R plot combinations, -e.g., \code{par(mfrow(...))}. If \code{TRUE} no residual plot -is returned; it has no effect if \code{plot = FALSE}} - -\item{...}{further arguments that will be passed to the plot output. -Currently supported arguments are \code{main}, \code{xlab}, \code{ylab}, -\code{xlim}, \code{ylim}, \code{log}, \code{legend} (\code{TRUE/FALSE}), -\code{legend.pos}, \code{legend.text} (passes argument to x,y in -\link[graphics:legend]{graphics::legend}), \code{xaxt}} -} -\value{ -The function returns numerical output and an (\emph{optional}) plot. - ------------------------------------\cr -\verb{[ NUMERICAL OUTPUT ]}\cr ------------------------------------\cr - -\strong{\code{RLum.Results}}-object - -\strong{slot:} \strong{\verb{@data}} - -\verb{[.. $data : data.frame]} - -\tabular{lll}{ -\strong{Column} \tab \strong{Type} \tab \strong{Description}\cr -\code{DE} \tab \code{numeric} \tab the obtained equivalent dose\cr -\code{DE.ERROR} \tab \code{numeric} \tab (only \code{method = "SLIDE"}) standard deviation obtained from MC runs \cr -\code{DE.LOWER} \tab \code{numeric}\tab 2.5\% quantile for De values obtained by MC runs \cr -\code{DE.UPPER} \tab \code{numeric}\tab 97.5\% quantile for De values obtained by MC runs \cr -\code{DE.STATUS} \tab \code{character}\tab test parameter status\cr -\code{RF_NAT.LIM} \tab \code{character}\tab used \code{RF_nat} curve limits \cr -\code{RF_REG.LIM} \tab \code{character}\tab used \code{RF_reg} curve limits\cr -\code{POSITION} \tab \code{integer}\tab (\emph{optional}) position of the curves\cr -\code{DATE} \tab \code{character}\tab (\emph{optional}) measurement date\cr -\code{SEQUENCE_NAME} \tab \code{character}\tab (\emph{optional}) sequence name\cr -\code{UID} \tab \code{character}\tab unique data set ID -} - -\verb{[.. $De.MC : numeric]} - -A \code{numeric} vector with all the De values obtained by the MC runs. - -\verb{[.. $test_parameters : data.frame]} - -\tabular{lll}{ -\strong{Column} \tab \strong{Type} \tab \strong{Description}\cr -\code{POSITION} \tab \code{numeric} \tab aliquot position \cr -\code{PARAMETER} \tab \code{character} \tab test parameter name \cr -\code{THRESHOLD} \tab \code{numeric} \tab set test parameter threshold value \cr -\code{VALUE} \tab \code{numeric} \tab the calculated test parameter value (to be compared with the threshold)\cr -\code{STATUS} \tab \code{character} \tab test parameter status either \code{"OK"} or \code{"FAILED"} \cr -\code{SEQUENCE_NAME} \tab \code{character} \tab name of the sequence, so far available \cr -\code{UID} \tab \code{character}\tab unique data set ID -} - -\verb{[.. $fit : data.frame]} - -An \link{nls} object produced by the fitting. - -\verb{[.. $slide : list]} - -A \link{list} with data produced during the sliding. Some elements are previously -reported with the summary object data. List elements are: - -\tabular{lll}{ -\strong{Element} \tab \strong{Type} \tab \strong{Description}\cr -\code{De} \tab \code{numeric} \tab the final De obtained with the sliding approach \cr -\code{De.MC} \tab \code{numeric} \tab all De values obtained by the MC runs \cr -\code{residuals} \tab \code{numeric} \tab the obtained residuals for each channel of the curve \cr -\code{trend.fit} \tab \code{lm} \tab fitting results produced by the fitting of the residuals \cr -\code{RF_nat.slid} \tab \code{matrix} \tab the slid \code{RF_nat} curve \cr -\code{t_n.id} \tab \code{numeric} \tab the index of the t_n offset \cr -\code{I_n} \tab \code{numeric} \tab the vertical intensity offset if a vertical slide was applied \cr -\code{algorithm_error} \tab \code{numeric} \tab the vertical sliding suffers from a systematic effect induced by the used -algorithm. The returned value is the standard deviation of all obtained De values while expanding the -vertical sliding range. I can be added as systematic error to the final De error; so far wanted.\cr -\code{vslide_range} \tab \code{numeric} \tab the range used for the vertical sliding \cr -\code{squared_residuals} \tab \code{numeric} \tab the squared residuals (horizontal sliding) -} - -\strong{slot:} \strong{\verb{@info}} - -The original function call (\link[methods:LanguageClasses]{methods::language}-object) - -The output (\code{data}) should be accessed using the function \link{get_RLum} - -------------------------\cr -\verb{[ PLOT OUTPUT ]}\cr -------------------------\cr - -The slid IR-RF curves with the finally obtained De -} -\description{ -Function to analyse IRSAR RF measurements on K-feldspar samples, performed -using the protocol according to Erfurt et al. (2003) and beyond. -} -\details{ -The function performs an IRSAR analysis described for K-feldspar samples by -Erfurt et al. (2003) assuming a negligible sensitivity change of the RF -signal. - -\strong{General Sequence Structure} (according to Erfurt et al., 2003) -\enumerate{ -\item Measuring IR-RF intensity of the natural dose for a few seconds (\eqn{RF_{nat}}) -\item Bleach the samples under solar conditions for at least 30 min without changing the geometry -\item Waiting for at least one hour -\item Regeneration of the IR-RF signal to at least the natural level (measuring (\eqn{RF_{reg}}) -\item Fitting data with a stretched exponential function -\item Calculate the the palaeodose \eqn{D_{e}} using the parameters from the fitting -} - -Actually two methods are supported to obtain the \eqn{D_{e}}: -\code{method = "FIT"} and \code{method = "SLIDE"}: - -\strong{\code{method = "FIT"}} - -The principle is described above and follows the original suggestions by -Erfurt et al., 2003. For the fitting the mean count value of the \code{RF_nat} curve is used. - -Function used for the fitting (according to Erfurt et al. (2003)): - -\deqn{\phi(D) = \phi_{0}-\Delta\phi(1-exp(-\lambda*D))^\beta} - -with -\eqn{\phi(D)} the dose dependent IR-RF flux, -\eqn{\phi_{0}} the initial IR-RF flux, -\eqn{\Delta\phi} the dose dependent change of the IR-RF flux, -\eqn{\lambda} the exponential parameter, \eqn{D} the dose and -\eqn{\beta} the dispersive factor. - -To obtain the palaeodose -\eqn{D_{e}} the function is changed to: - -\deqn{D_{e} = ln(-(\phi(D) - \phi_{0})/(-\lambda*\phi)^{1/\beta}+1)/-\lambda} - -The fitting is done using the \code{port} algorithm of the \link{nls} function. - -\strong{\code{method = "SLIDE"}} - -For this method, the natural curve is slid along the x-axis until -congruence with the regenerated curve is reached. Instead of fitting this -allows working with the original data without the need for any physical -model. This approach was introduced for RF curves by Buylaert et al., 2012 -and Lapp et al., 2012. - -Here the sliding is done by searching for the minimum of the squared residuals. -For the mathematical details of the implementation see Frouin et al., 2017 - -\strong{\code{method = "VSLIDE"}} - -Same as \code{"SLIDE"} but searching also vertically for the best match (i.e. in xy-direction.) -See Kreutzer et al. (2017) and Murari et al. (2021). By default the vertical sliding -range will is set to \code{"auto"} (see \code{method.control}). This setting can be still -changed with \code{method.control}. - -\strong{\code{method.control}} - -To keep the generic argument list as clear as possible, arguments to control the methods -for De estimation are all preset with meaningful default parameters and can be -handled using the argument \code{method.control} only, e.g., -\code{method.control = list(trace = TRUE)}. Supported arguments are: - -\tabular{lll}{ -\strong{ARGUMENT} \tab \strong{METHOD} \tab \strong{DESCRIPTION}\cr -\code{trace} \tab \code{FIT}, \code{SLIDE} or \code{VSLIDE} \tab as in \link{nls}; shows sum of squared residuals\cr -\code{trace_vslide} \tab \code{SLIDE} or \code{VSLIDE} \tab \link{logical} argument to enable or disable the tracing of the vertical sliding\cr -\code{maxiter} \tab \code{FIT} \tab as in \link{nls}\cr -\code{warnOnly} \tab \code{FIT} \tab as in \link{nls}\cr -\code{minFactor} \tab \code{FIT} \tab as in \link{nls}\cr -\code{correct_onset} \tab \code{SLIDE} or \code{VSLIDE} \tab The logical argument shifts the curves along the x-axis by the first channel, -as light is expected in the first channel. The default value is \code{TRUE}.\cr -\code{show_density} \tab \code{SLIDE} or \code{VSLIDE} \tab \link{logical} (\emph{with default}) -enables or disables KDE plots for MC run results. If the distribution is too narrow nothing is shown.\cr -\code{show_fit} \tab \code{SLIDE} or \code{VSLIDE} \tab \link{logical} (\emph{with default}) -enables or disables the plot of the fitted curve routinely obtained during the evaluation.\cr -\code{n.MC} \tab \code{SLIDE} or \code{VSLIDE} \tab \link{integer} (\emph{with default}): -This controls the number of MC runs within the sliding (assessing the possible minimum values). -The default \code{n.MC = 1000}. Note: This parameter is not the same as controlled by the -function argument \code{n.MC}. \cr -\code{vslide_range} \tab \code{SLIDE} or \code{VSLIDE} \tab \link{logical} or \link{numeric} or \link{character} (\emph{with default}): -This argument sets the boundaries for a vertical curve -sliding. The argument expects a vector with an absolute minimum and a maximum (e.g., \code{c(-1000,1000)}). -Alternatively the values \code{NULL} and \code{'auto'} are allowed. The automatic mode detects the -reasonable vertical sliding range (\strong{recommended}). \code{NULL} applies no vertical sliding. -The default is \code{NULL}.\cr -\code{cores} \tab \code{SLIDE} or \code{VSLIDE} \tab \code{number} or \code{character} (\emph{with default}): set number of cores to be allocated -for a parallel processing of the Monte-Carlo runs. The default value is \code{NULL} (single thread), -the recommended values is \code{'auto'}. An optional number (e.g., \code{cores} = 8) assigns a value manually. -} - -\strong{Error estimation} - -For \strong{\code{method = "FIT"}} the asymmetric error range is obtained by using the 2.5 \% (lower) and -the 97.5 \% (upper) quantiles of the \eqn{RF_{nat}} curve for calculating the \eqn{D_{e}} error range. - -For \strong{\code{method = "SLIDE"}} the error is obtained by bootstrapping the residuals of the slid -curve to construct new natural curves for a Monte Carlo simulation. The error is returned in two -ways: (a) the standard deviation of the herewith obtained \eqn{D_{e}} from the MC runs and (b) the confidence -interval using the 2.5 \% (lower) and the 97.5 \% (upper) quantiles. The results of the MC runs -are returned with the function output. - -\strong{Test parameters} - -The argument \code{test_parameters} allows to pass some thresholds for several test parameters, -which will be evaluated during the function run. If a threshold is set and it will be exceeded the -test parameter status will be set to \code{"FAILED"}. Intentionally this parameter is not termed -\code{'rejection criteria'} as not all test parameters are evaluated for both methods and some parameters -are calculated by not evaluated by default. Common for all parameters are the allowed argument options -\code{NA} and \code{NULL}. If the parameter is set to \code{NA} the value is calculated but the -result will not be evaluated, means it has no effect on the status (\code{"OK"} or \code{"FAILED"}) -of the parameter. -Setting the parameter to \code{NULL} disables the parameter entirely and the parameter will be -also removed from the function output. This might be useful in cases where a particular parameter -asks for long computation times. Currently supported parameters are: - -\code{curves_ratio} \link{numeric} (default: \code{1.001}): - -The ratio of \eqn{RF_{nat}} over \eqn{RF_{reg}} in the range of\eqn{RF_{nat}} of is calculated -and should not exceed the threshold value. - -\code{intersection_ratio} \link{numeric} (default: \code{NA}): - -Calculated as absolute difference from 1 of the ratio of the integral of the normalised RF-curves, -This value indicates intersection of the RF-curves and should be close to 0 if the curves -have a similar shape. For this calculation first the corresponding time-count pair value on the RF_reg -curve is obtained using the maximum count value of the \code{RF_nat} curve and only this segment (fitting to -the \code{RF_nat} curve) on the RF_reg curve is taken for further calculating this ratio. If nothing is -found at all, \code{Inf} is returned. - -\code{residuals_slope} \link{numeric} (default: \code{NA}; only for \code{method = "SLIDE"}): - -A linear function is fitted on the residuals after sliding. -The corresponding slope can be used to discard values as a high (positive, negative) slope -may indicate that both curves are fundamentally different and the method cannot be applied at all. -Per default the value of this parameter is calculated but not evaluated. - -\code{curves_bounds} \link{numeric} (default: \eqn{max(RF_{reg_counts})}: - -This measure uses the maximum time (x) value of the regenerated curve. -The maximum time (x) value of the natural curve cannot be larger than this value. However, although -this is not recommended the value can be changed or disabled. - -\code{dynamic_ratio} \link{numeric} (default: \code{NA}): - -The dynamic ratio of the regenerated curve is calculated as ratio of the minimum and maximum count values. - -\code{lambda}, \code{beta} and \code{delta.phi} -\link{numeric} (default: \code{NA}; \code{method = "SLIDE"}): - -The stretched exponential function suggested by Erfurt et al. (2003) describing the decay of -the RF signal, comprises several parameters that might be useful to evaluate the shape of the curves. -For \code{method = "FIT"} this parameter is obtained during the fitting, for \code{method = "SLIDE"} a -rather rough estimation is made using the function \link[minpack.lm:nlsLM]{minpack.lm::nlsLM} and the equation -given above. Note: As this procedure requests more computation time, setting of one of these three parameters -to \code{NULL} also prevents a calculation of the remaining two. -} -\note{ -This function assumes that there is no sensitivity change during the -measurements (natural vs. regenerated signal), which is in contrast to the -findings by Buylaert et al. (2012). -} -\section{Function version}{ - 0.7.10 -} - -\examples{ - -##load data -data(ExampleData.RLum.Analysis, envir = environment()) - -##(1) perform analysis using the method 'FIT' -results <- analyse_IRSAR.RF(object = IRSAR.RF.Data) - -##show De results and test paramter results -get_RLum(results, data.object = "data") -get_RLum(results, data.object = "test_parameters") - -##(2) perform analysis using the method 'SLIDE' -results <- analyse_IRSAR.RF(object = IRSAR.RF.Data, method = "SLIDE", n.MC = 1) - -\dontrun{ -##(3) perform analysis using the method 'SLIDE' and method control option -## 'trace -results <- analyse_IRSAR.RF( - object = IRSAR.RF.Data, - method = "SLIDE", - method.control = list(trace = TRUE)) -} - -} - -\section{How to cite}{ -Kreutzer, S., 2024. analyse_IRSAR.RF(): Analyse IRSAR RF measurements. Function version 0.7.10. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Buylaert, J.P., Jain, M., Murray, A.S., Thomsen, K.J., Lapp, T., -2012. IR-RF dating of sand-sized K-feldspar extracts: A test of accuracy. -Radiation Measurements 44 (5-6), 560-565. doi: 10.1016/j.radmeas.2012.06.021 - -Erfurt, G., Krbetschek, M.R., 2003. IRSAR - A single-aliquot -regenerative-dose dating protocol applied to the infrared radiofluorescence -(IR-RF) of coarse- grain K-feldspar. Ancient TL 21, 35-42. - -Erfurt, G., 2003. Infrared luminescence of Pb+ centres in potassium-rich -feldspars. physica status solidi (a) 200, 429-438. - -Erfurt, G., Krbetschek, M.R., 2003. Studies on the physics of the infrared -radioluminescence of potassium feldspar and on the methodology of its -application to sediment dating. Radiation Measurements 37, 505-510. - -Erfurt, G., Krbetschek, M.R., Bortolot, V.J., Preusser, F., 2003. A fully -automated multi-spectral radioluminescence reading system for geochronometry -and dosimetry. Nuclear Instruments and Methods in Physics Research Section -B: Beam Interactions with Materials and Atoms 207, 487-499. - -Frouin, M., Huot, S., Kreutzer, S., Lahaye, C., Lamothe, M., Philippe, A., Mercier, N., 2017. -An improved radiofluorescence single-aliquot regenerative dose protocol for K-feldspars. -Quaternary Geochronology 38, 13-24. doi:10.1016/j.quageo.2016.11.004 - -Kreutzer, S., Murari, M.K., Frouin, M., Fuchs, M., Mercier, N., 2017. -Always remain suspicious: a case study on tracking down a technical artefact while measuring IR-RF. -Ancient TL 35, 20–30. - -Murari, M.K., Kreutzer, S., Fuchs, M., 2018. Further investigations on IR-RF: -Dose recovery and correction. Radiation Measurements 120, 110–119. -doi: 10.1016/j.radmeas.2018.04.017 - -Lapp, T., Jain, M., Thomsen, K.J., Murray, A.S., Buylaert, J.P., 2012. New -luminescence measurement facilities in retrospective dosimetry. Radiation -Measurements 47, 803-808. doi:10.1016/j.radmeas.2012.02.006 - -Trautmann, T., 2000. A study of radioluminescence kinetics of natural -feldspar dosimeters: experiments and simulations. Journal of Physics D: -Applied Physics 33, 2304-2310. - -Trautmann, T., Krbetschek, M.R., Dietrich, A., Stolz, W., 1998. -Investigations of feldspar radioluminescence: potential for a new dating -technique. Radiation Measurements 29, 421-425. - -Trautmann, T., Krbetschek, M.R., Dietrich, A., Stolz, W., 1999. Feldspar -radioluminescence: a new dating method and its physical background. Journal -of Luminescence 85, 45-58. - -Trautmann, T., Krbetschek, M.R., Stolz, W., 2000. A systematic study of the -radioluminescence properties of single feldspar grains. Radiation -Measurements 32, 685-690. - -** Further reading** - -Murari, M.K., Kreutzer, S., King, G.E., Frouin, M., Tsukamoto, S., Schmidt, C., Lauer, T., -Klasen, N., Richter, D., Friedrich, J., Mercier, N., Fuchs, M., 2021. -Infrared radiofluorescence (IR-RF) dating: A review. Quaternary Geochronology 64, -101155. doi: 10.1016/j.quageo.2021.101155 -} -\seealso{ -\linkS4class{RLum.Analysis}, \linkS4class{RLum.Results}, \link{get_RLum}, -\link{nls}, \link[minpack.lm:nlsLM]{minpack.lm::nlsLM}, \code{parallel::mclapply} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_SAR.CWOSL.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_SAR.CWOSL.Rd deleted file mode 100644 index dd0545487..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_SAR.CWOSL.Rd +++ /dev/null @@ -1,287 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/analyse_SAR.CWOSL.R -\name{analyse_SAR.CWOSL} -\alias{analyse_SAR.CWOSL} -\title{Analyse SAR CW-OSL measurements} -\usage{ -analyse_SAR.CWOSL( - object, - signal.integral.min = NA, - signal.integral.max = NA, - background.integral.min = NA, - background.integral.max = NA, - OSL.component = NULL, - rejection.criteria = list(), - dose.points = NULL, - trim_channels = FALSE, - mtext.outer = "", - plot = TRUE, - plot_onePage = FALSE, - plot.single = FALSE, - onlyLxTxTable = FALSE, - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum.Analysis} (\strong{required}): -input object containing data for analysis, alternatively a \link{list} of -\linkS4class{RLum.Analysis} objects can be provided. The object should contain \strong{only} curves -considered part of the SAR protocol (see Details.)} - -\item{signal.integral.min}{\link{integer} (\strong{required}): -lower bound of the signal integral. Can be a \link{list} of \link{integer}s, if \code{object} is -of type \link{list}. If the input is vector (e.g., \code{c(1,2)}) the 2nd value will be interpreted -as the minimum signal integral for the \code{Tx} curve. Can be set to \code{NA}, in this -case no integrals are taken into account.} - -\item{signal.integral.max}{\link{integer} (\strong{required}): -upper bound of the signal integral. Can be a \link{list} of \link{integer}s, if \code{object} is -of type \link{list}. If the input is vector (e.g., \code{c(1,2)}) the 2nd value will be interpreted -as the maximum signal integral for the \code{Tx} curve. Can be set to \code{NA}, in this -case no integrals are taken into account.} - -\item{background.integral.min}{\link{integer} (\strong{required}): -lower bound of the background integral. Can be a \link{list} of \link{integer}s, if \code{object} is -of type \link{list}. If the input is vector (e.g., \code{c(1,2)}) the 2nd value will be interpreted -as the minimum background integral for the \code{Tx} curve. Can be set to \code{NA}, in this -case no integrals are taken into account.} - -\item{background.integral.max}{\link{integer} (\strong{required}): -upper bound of the background integral. Can be a \link{list} of \link{integer}s, if \code{object} is -of type \link{list}. If the input is vector (e.g., \code{c(1,2)}) the 2nd value will be interpreted -as the maximum background integral for the \code{Tx} curve. Can be set to \code{NA}, in this -case no integrals are taken into account.} - -\item{OSL.component}{\link{character} or \link{integer} (\emph{optional}): s single index -or a \link{character} defining the signal component to be evaluated. -It requires that the object was processed by \verb{[OSLdecomposition::RLum.OSL_decomposition]}. -This argument can either be the name of the OSL component assigned by -\verb{[OSLdecomposition::RLum.OSL_global_fitting]} or the index in the descending -order of decay rates. Then \code{"1"} selects the fastest decaying component, \code{"2"} -the second fastest and so on. Can be a \link{list} of \link{integer}s or strings (or mixed) -If object is a \link{list} and this parameter is provided as \link{list} it alternates over -the elements (aliquots) of the object list, e.g., \code{list(1,2)} processes the first -aliquot with component \code{1} and the second aliquot with component \code{2}. -\code{NULL} does not process any component.} - -\item{rejection.criteria}{\link{list} (\emph{with default}): -provide a \emph{named} list and set rejection criteria in \strong{percentage} -for further calculation. Can be a \link{list} in a \link{list}, if \code{object} is of type \link{list}. -Note: If an \emph{unnamed} \link{list} is provided the new settings are ignored! - -Allowed arguments are \code{recycling.ratio}, \code{recuperation.rate}, -\code{palaeodose.error}, \code{testdose.error}, \code{exceed.max.regpoint = TRUE/FALSE}, -\code{recuperation_reference = "Natural"} (or any other dose point, e.g., \code{"R1"}). -Example: \code{rejection.criteria = list(recycling.ratio = 10)}. -Per default all numerical values are set to 10, \code{exceed.max.regpoint = TRUE}. -Every criterion can be set to \code{NA}. In this value are calculated, but not considered, i.e. -the RC.Status becomes always \code{'OK'}} - -\item{dose.points}{\link{numeric} (\emph{optional}): -a numeric vector containing the dose points values. Using this argument -overwrites dose point values extracted from other data. Can be a \link{list} of -\link{numeric} vectors, if \code{object} is of type \link{list}} - -\item{trim_channels}{\link{logical} (\emph{with default}): trim channels per record category -to the lowest number of channels in the category by using \link{trim_RLum.Data}. -Applies only to \code{OSL} and \code{IRSL} curves. For a more granular control use \link{trim_RLum.Data} -before passing the input object.} - -\item{mtext.outer}{\link{character} (\emph{optional}): -option to provide an outer margin \code{mtext}. Can be a \link{list} of \link{character}s, -if \code{object} is of type \link{list}} - -\item{plot}{\link{logical} (\emph{with default}): enables or disables plot output.} - -\item{plot_onePage}{\link{logical} (\emph{with default}): enables or disables on page plot output} - -\item{plot.single}{\link{logical} (\emph{with default}) or \link{numeric} (\emph{optional}): -single plot output (\code{TRUE/FALSE}) to allow for plotting the results in single plot windows. -If a \link{numeric} vector is provided the plots can be selected individually, i.e. -\code{plot.single = c(1,2,3,4)} will plot the TL and Lx, Tx curves but not the legend (5) or the -growth curve (6), (7) and (8) belong to rejection criteria plots. Requires -\code{plot = TRUE}.} - -\item{onlyLxTxTable}{\link{logical} (with default): If \code{TRUE} the dose response -curve fitting and plotting is skipped. -This allows to get hands on the \code{Lx/Tx} table for large datasets -without the need for a curve fitting.} - -\item{...}{further arguments that will be passed to the function -\link{plot_GrowthCurve} or \link{calc_OSLLxTxRatio} -(supported: \code{background.count.distribution}, \code{sigmab}, \code{sig0}). -\strong{Please note} that if you consider to use the early light subtraction -method you should provide your own \code{sigmab} value!} -} -\value{ -A plot (\emph{optional}) and an \linkS4class{RLum.Results} object is -returned containing the following elements: - -\item{data}{\link{data.frame} containing De-values, De-error and further parameters} -\item{LnLxTnTx.values}{\link{data.frame} of all calculated Lx/Tx values including signal, -background counts and the dose points} -\item{rejection.criteria}{\link{data.frame} with values that might by used as rejection criteria. -\code{NA} is produced if no R0 dose point exists.} -\item{Formula}{\link{formula} formula that have been used for the growth curve fitting} - -The output should be accessed using the function \link{get_RLum}. -} -\description{ -The function performs a SAR CW-OSL analysis on an -\linkS4class{RLum.Analysis} object including growth curve fitting. -} -\details{ -The function performs an analysis for a standard SAR protocol measurements -introduced by Murray and Wintle (2000) with CW-OSL curves. For the -calculation of the \code{Lx/Tx} value the function \link{calc_OSLLxTxRatio} is -used. For \strong{changing the way the Lx/Tx error is calculated} use the argument -\code{background.count.distribution} and \code{sigmab}, which will be passed to the function -\link{calc_OSLLxTxRatio}. - -\strong{What is part of a SAR sequence?} - -The function is rather picky when it comes down to accepted curve input (OSL,IRSL,...) and structure. -A SAR sequence is basically a set of \eqn{L_{x}/T_{x}} curves. Hence, every 2nd curve -is considered a shine-down curve related to the test dose. It also means that the number of -curves for \eqn{L_{x}} has to be equal to the number of \eqn{T_{x}} curves, and that -hot-bleach curves \strong{do not} belong into a SAR sequence; at least not for the analysis. -Other curves allowed and processed are preheat curves, or preheat curves measured as TL, and -irradiation curves. The later one indicates the duration of the irradiation, the -dose and test dose points, e.g., as part of XSYG files. - -\strong{Argument \code{object} is of type \code{list}} - -If the argument \code{object} is of type \link{list} containing \strong{only} -\linkS4class{RLum.Analysis} objects, the function re-calls itself as often as elements -are in the list. This is useful if an entire measurement wanted to be analysed without -writing separate for-loops. To gain in full control of the parameters (e.g., \code{dose.points}) for -every aliquot (corresponding to one \linkS4class{RLum.Analysis} object in the list), in -this case the arguments can be provided as \link{list}. This \code{list} should -be of similar length as the \code{list} provided with the argument \code{object}, -otherwise the function will create an own list of the requested length. -Function output will be just one single \linkS4class{RLum.Results} object. - -Please be careful when using this option. It may allow a fast an efficient data analysis, but -the function may also break with an unclear error message, due to wrong input data. - -\strong{Working with IRSL data} - -The function was originally designed to work just for 'OSL' curves, -following the principles of the SAR protocol. An IRSL measurement protocol -may follow this procedure, e.g., post-IR IRSL protocol (Thomsen et al., -2008). Therefore this functions has been enhanced to work with IRSL data, -however, the function is only capable of analysing curves that follow the -SAR protocol structure, i.e., to analyse a post-IR IRSL protocol, curve data -have to be pre-selected by the user to fit the standards of the SAR -protocol, i.e., Lx,Tx,Lx,Tx and so on. - -Example: Imagine the measurement contains \code{pIRIR50} and \code{pIRIR225} IRSL curves. -Only one curve type can be analysed at the same time: The \code{pIRIR50} curves or -the \code{pIRIR225} curves. - -\strong{Supported rejection criteria} - -\verb{[recycling.ratio]}: calculated for every repeated regeneration dose point. - -\verb{[recuperation.rate]}: recuperation rate calculated by comparing the -\code{Lx/Tx} values of the zero regeneration point with the \code{Ln/Tn} value (the \code{Lx/Tx} -ratio of the natural signal). For methodological background see Aitken and -Smith (1988). As a variant with the argument \code{recuperation_reference} another dose point can be -selected as reference instead of \code{Ln/Tn}. - -\verb{[testdose.error]}: set the allowed error for the test dose, which per -default should not exceed 10\%. The test dose error is calculated as \code{Tx_net.error/Tx_net}. -The calculation of the \eqn{T_{n}} error is detailed in \link{calc_OSLLxTxRatio}. - -\verb{[palaeodose.error]}: set the allowed error for the De value, which per -default should not exceed 10\%. - -\strong{Irradiation times} - -The function makes two attempts to extra irradiation data (dose points) -automatically from the input object, if the argument \code{dose.points} was not -set (aka set to \code{NULL}). -\enumerate{ -\item It searches in every curve for an info object called \code{IRR_TIME}. If this was set, any value -set here is taken as dose point. -\item If the object contains curves of type \code{irradiation}, the function tries to -use this information to assign these values to the curves. However, the function -does \strong{not} overwrite values preset in \code{IRR_TIME}. -} -} -\note{ -This function must not be mixed up with the function -\link{Analyse_SAR.OSLdata}, which works with -\linkS4class{Risoe.BINfileData} objects. - -\strong{The function currently does support only 'OSL', 'IRSL' and 'POSL' data!} -} -\section{Function version}{ - 0.10.3 -} - -\examples{ - -##load data -##ExampleData.BINfileData contains two BINfileData objects -##CWOSL.SAR.Data and TL.SAR.Data -data(ExampleData.BINfileData, envir = environment()) - -##transform the values from the first position in a RLum.Analysis object -object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) - -##perform SAR analysis and set rejection criteria -results <- analyse_SAR.CWOSL( -object = object, -signal.integral.min = 1, -signal.integral.max = 2, -background.integral.min = 900, -background.integral.max = 1000, -log = "x", -fit.method = "EXP", -rejection.criteria = list( - recycling.ratio = 10, - recuperation.rate = 10, - testdose.error = 10, - palaeodose.error = 10, - recuperation_reference = "Natural", - exceed.max.regpoint = TRUE) -) - -##show De results -get_RLum(results) - -##show LnTnLxTx table -get_RLum(results, data.object = "LnLxTnTx.table") - -} - -\section{How to cite}{ -Kreutzer, S., 2024. analyse_SAR.CWOSL(): Analyse SAR CW-OSL measurements. Function version 0.10.3. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Aitken, M.J. and Smith, B.W., 1988. Optical dating: recuperation -after bleaching. Quaternary Science Reviews 7, 387-393. - -Duller, G., 2003. Distinguishing quartz and feldspar in single grain -luminescence measurements. Radiation Measurements, 37 (2), 161-165. - -Murray, A.S. and Wintle, A.G., 2000. Luminescence dating of quartz using an -improved single-aliquot regenerative-dose protocol. Radiation Measurements -32, 57-73. - -Thomsen, K.J., Murray, A.S., Jain, M., Boetter-Jensen, L., 2008. Laboratory -fading rates of various luminescence signals from feldspar-rich sediment -extracts. Radiation Measurements 43, 1474-1486. -doi:10.1016/j.radmeas.2008.06.002 -} -\seealso{ -\link{calc_OSLLxTxRatio}, \link{plot_GrowthCurve}, \linkS4class{RLum.Analysis}, -\linkS4class{RLum.Results}, \link{get_RLum} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{datagen} -\keyword{plot} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_SAR.TL.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_SAR.TL.Rd deleted file mode 100644 index 13e1db4a3..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_SAR.TL.Rd +++ /dev/null @@ -1,137 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/analyse_SAR.TL.R -\name{analyse_SAR.TL} -\alias{analyse_SAR.TL} -\title{Analyse SAR TL measurements} -\usage{ -analyse_SAR.TL( - object, - object.background, - signal.integral.min, - signal.integral.max, - integral_input = "channel", - sequence.structure = c("PREHEAT", "SIGNAL", "BACKGROUND"), - rejection.criteria = list(recycling.ratio = 10, recuperation.rate = 10), - dose.points, - log = "", - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum.Analysis} or a \link{list} of such objects (\strong{required}) : -input object containing data for analysis} - -\item{object.background}{currently not used} - -\item{signal.integral.min}{\link{integer} (\strong{required}): -requires the channel number for the lower signal integral bound -(e.g. \code{signal.integral.min = 100})} - -\item{signal.integral.max}{\link{integer} (\strong{required}): -requires the channel number for the upper signal integral bound -(e.g. \code{signal.integral.max = 200})} - -\item{integral_input}{\link{character} (\emph{with default}): -defines the input for the the arguments \code{signal.integral.min} and -\code{signal.integral.max}. These limits can be either provided \code{'channel'} -number (the default) or \code{'temperature'}. If \code{'temperature'} is chosen the -best matching channel is selected.} - -\item{sequence.structure}{\link{vector} \link{character} (\emph{with default}): -specifies the general sequence structure. Three steps are allowed -(\code{"PREHEAT"}, \code{"SIGNAL"}, \code{"BACKGROUND"}), in addition a -parameter \code{"EXCLUDE"}. This allows excluding TL curves which are not -relevant for the protocol analysis. (\strong{Note:} None TL are removed by default)} - -\item{rejection.criteria}{\link{list} (\emph{with default}): -list containing rejection criteria in percentage for the calculation.} - -\item{dose.points}{\link{numeric} (\emph{optional}): -option set dose points manually} - -\item{log}{\link{character} (\emph{with default}): -a character string which contains \code{"x"} if the x-axis is to be logarithmic, -\code{"y"} if the y axis is to be logarithmic and \code{"xy"} or \code{"yx"} if both axes -are to be logarithmic. See -\link{plot.default}).} - -\item{...}{further arguments that will be passed to the function \link{plot_GrowthCurve}} -} -\value{ -A plot (\emph{optional}) and an \linkS4class{RLum.Results} object is -returned containing the following elements: - -\item{De.values}{\link{data.frame} containing De-values and further parameters} -\item{LnLxTnTx.values}{\link{data.frame} of all calculated \code{Lx/Tx} values including signal, background counts and the dose points.} -\item{rejection.criteria}{\link{data.frame} with values that might by used as rejection criteria. NA is produced if no R0 dose point exists.} - -\strong{note:} the output should be accessed using the function \link{get_RLum} -} -\description{ -The function performs a SAR TL analysis on a -\linkS4class{RLum.Analysis} object including growth curve fitting. -} -\details{ -This function performs a SAR TL analysis on a set of curves. The SAR -procedure in general is given by Murray and Wintle (2000). For the -calculation of the \code{Lx/Tx} value the function \link{calc_TLLxTxRatio} is -used. - -\strong{Provided rejection criteria} - -\verb{[recyling.ratio]}: calculated for every repeated regeneration dose point. - -\verb{[recuperation.rate]}: recuperation rate calculated by -comparing the \code{Lx/Tx} values of the zero regeneration point with the \code{Ln/Tn} -value (the \code{Lx/Tx} ratio of the natural signal). For methodological -background see Aitken and Smith (1988) -} -\note{ -\strong{THIS IS A BETA VERSION} - -None TL curves will be removed -from the input object without further warning. -} -\section{Function version}{ - 0.3.0 -} - -\examples{ - -##load data -data(ExampleData.BINfileData, envir = environment()) - -##transform the values from the first position in a RLum.Analysis object -object <- Risoe.BINfileData2RLum.Analysis(TL.SAR.Data, pos=3) - -##perform analysis -analyse_SAR.TL( - object = object, - signal.integral.min = 210, - signal.integral.max = 220, - fit.method = "EXP OR LIN", - sequence.structure = c("SIGNAL", "BACKGROUND")) - -} - -\section{How to cite}{ -Kreutzer, S., 2024. analyse_SAR.TL(): Analyse SAR TL measurements. Function version 0.3.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Aitken, M.J. and Smith, B.W., 1988. Optical dating: recuperation -after bleaching. Quaternary Science Reviews 7, 387-393. - -Murray, A.S. and Wintle, A.G., 2000. Luminescence dating of quartz using an -improved single-aliquot regenerative-dose protocol. Radiation Measurements -32, 57-73. -} -\seealso{ -\link{calc_TLLxTxRatio}, \link{plot_GrowthCurve}, \linkS4class{RLum.Analysis}, -\linkS4class{RLum.Results}, \link{get_RLum} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{datagen} -\keyword{plot} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_baSAR.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_baSAR.Rd deleted file mode 100644 index 7dac5040f..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_baSAR.Rd +++ /dev/null @@ -1,448 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/analyse_baSAR.R -\name{analyse_baSAR} -\alias{analyse_baSAR} -\title{Bayesian models (baSAR) applied on luminescence data} -\usage{ -analyse_baSAR( - object, - XLS_file = NULL, - aliquot_range = NULL, - source_doserate = NULL, - signal.integral, - signal.integral.Tx = NULL, - background.integral, - background.integral.Tx = NULL, - irradiation_times = NULL, - sigmab = 0, - sig0 = 0.025, - distribution = "cauchy", - baSAR_model = NULL, - n.MCMC = 1e+05, - fit.method = "EXP", - fit.force_through_origin = TRUE, - fit.includingRepeatedRegPoints = TRUE, - method_control = list(), - digits = 3L, - distribution_plot = "kde", - plot = TRUE, - plot_reduced = TRUE, - plot.single = FALSE, - verbose = TRUE, - ... -) -} -\arguments{ -\item{object}{\linkS4class{Risoe.BINfileData}, \linkS4class{RLum.Results}, \link{list} of \linkS4class{RLum.Analysis}, -\link{character} or \link{list} (\strong{required}): -input object used for the Bayesian analysis. If a \code{character} is provided the function -assumes a file connection and tries to import a BIN/BINX-file using the provided path. If a \code{list} is -provided the list can only contain either \code{Risoe.BINfileData} objects or \code{character}s -providing a file connection. Mixing of both types is not allowed. If an \linkS4class{RLum.Results} -is provided the function directly starts with the Bayesian Analysis (see details)} - -\item{XLS_file}{\link{character} (\emph{optional}): -XLS_file with data for the analysis. This file must contain 3 columns: -the name of the file, the disc position and the grain position -(the last being 0 for multi-grain measurements).\cr -Alternatively a \code{data.frame} of similar structure can be provided.} - -\item{aliquot_range}{\link{numeric} (\emph{optional}): -allows to limit the range of the aliquots used for the analysis. -This argument has only an effect if the argument \code{XLS_file} is used or -the input is the previous output (i.e. is \linkS4class{RLum.Results}). In this case the -new selection will add the aliquots to the removed aliquots table.} - -\item{source_doserate}{\link{numeric} \strong{(required)}: -source dose rate of beta-source used for the measurement and its uncertainty -in Gy/s, e.g., \code{source_doserate = c(0.12, 0.04)}. Parameter can be provided -as \code{list}, for the case that more than one BIN-file is provided, e.g., -\code{source_doserate = list(c(0.04, 0.004), c(0.05, 0.004))}.} - -\item{signal.integral}{\link{vector} (\strong{required}): -vector with the limits for the signal integral used for the calculation, -e.g., \code{signal.integral = c(1:5)}. Ignored if \code{object} is an \linkS4class{RLum.Results} object. -The parameter can be provided as \code{list}, see \code{source_doserate}.} - -\item{signal.integral.Tx}{\link{vector} (\emph{optional}): -vector with the limits for the signal integral for the Tx curve. I -f nothing is provided the value from \code{signal.integral} is used and it is ignored -if \code{object} is an \linkS4class{RLum.Results} object. -The parameter can be provided as \code{list}, see \code{source_doserate}.} - -\item{background.integral}{\link{vector} (\strong{required}): -vector with the bounds for the background integral. -Ignored if \code{object} is an \linkS4class{RLum.Results} object. -The parameter can be provided as \code{list}, see \code{source_doserate}.} - -\item{background.integral.Tx}{\link{vector} (\emph{optional}): -vector with the limits for the background integral for the Tx curve. -If nothing is provided the value from \code{background.integral} is used. -Ignored if \code{object} is an \linkS4class{RLum.Results} object. -The parameter can be provided as \code{list}, see \code{source_doserate}.} - -\item{irradiation_times}{\link{numeric} (\emph{optional}): if set this vector replaces all irradiation -times for one aliquot and one cycle (Lx and Tx curves) and recycles it for all others cycles and aliquots. -Please note that if this argument is used, for every(!) single curve -in the dataset an irradiation time needs to be set.} - -\item{sigmab}{\link{numeric} (\emph{with default}): -option to set a manual value for the overdispersion (for \code{LnTx} and \code{TnTx}), -used for the \code{Lx}/\code{Tx} error calculation. The value should be provided as -absolute squared count values, cf. \link{calc_OSLLxTxRatio}. -The parameter can be provided as \code{list}, see \code{source_doserate}.} - -\item{sig0}{\link{numeric} (\emph{with default}): -allow adding an extra component of error to the final Lx/Tx error value -(e.g., instrumental error, see details is \link{calc_OSLLxTxRatio}). -The parameter can be provided as \code{list}, see \code{source_doserate}.} - -\item{distribution}{\link{character} (\emph{with default}): -type of distribution that is used during Bayesian calculations for -determining the Central dose and overdispersion values. -Allowed inputs are \code{"cauchy"}, \code{"normal"} and \code{"log_normal"}.} - -\item{baSAR_model}{\link{character} (\emph{optional}): -option to provide an own modified or new model for the Bayesian calculation -(see details). If an own model is provided the argument \code{distribution} is -ignored and set to \code{'user_defined'}} - -\item{n.MCMC}{\link{integer} (\emph{with default}): -number of iterations for the Markov chain Monte Carlo (MCMC) simulations} - -\item{fit.method}{\link{character} (\emph{with default}): -equation used for the fitting of the dose-response curve using the function -\link{plot_GrowthCurve} and then for the Bayesian modelling. Here supported methods: \code{EXP}, \code{EXP+LIN} and \code{LIN}} - -\item{fit.force_through_origin}{\link{logical} (\emph{with default}): -force fitting through origin} - -\item{fit.includingRepeatedRegPoints}{\link{logical} (\emph{with default}): -includes the recycling point (assumed to be measured during the last cycle)} - -\item{method_control}{\link{list} (\emph{optional}): -named list of control parameters that can be directly -passed to the Bayesian analysis, e.g., \code{method_control = list(n.chains = 4)}. -See details for further information} - -\item{digits}{\link{integer} (\emph{with default}): -round output to the number of given digits} - -\item{distribution_plot}{\link{character} (\emph{with default}): sets the final distribution plot that -shows equivalent doses obtained using the frequentist approach and sets in the central dose -as comparison obtained using baSAR. Allowed input is \code{'abanico'} or \code{'kde'}. If set to \code{NULL} nothing is plotted.} - -\item{plot}{\link{logical} (\emph{with default}): -enables or disables plot output} - -\item{plot_reduced}{\link{logical} (\emph{with default}): -enables or disables the advanced plot output} - -\item{plot.single}{\link{logical} (\emph{with default}): -enables or disables single plots or plots arranged by \code{analyse_baSAR}} - -\item{verbose}{\link{logical} (\emph{with default}): -enables or disables verbose mode} - -\item{...}{parameters that can be passed to the function \link{calc_OSLLxTxRatio} -(almost full support), \link[readxl:read_excel]{readxl::read_excel} (full support), \link{read_BIN2R} (\code{n.records}, -\code{position}, \code{duplicated.rm}), see details.} -} -\value{ -Function returns results numerically and graphically: - ------------------------------------\cr -\verb{[ NUMERICAL OUTPUT ]}\cr ------------------------------------\cr - -\strong{\code{RLum.Results}}-object - -\strong{slot:} \strong{\verb{@data}} - -\tabular{lll}{ -\strong{Element} \tab \strong{Type} \tab \strong{Description}\cr -\verb{$summary} \tab \code{data.frame} \tab statistical summary, including the central dose \cr -\verb{$mcmc} \tab \code{mcmc} \tab \link[coda:mcmc.list]{coda::mcmc.list} object including raw output \cr -\verb{$models} \tab \code{character} \tab implemented models used in the baSAR-model core \cr -\verb{$input_object} \tab \code{data.frame} \tab summarising table (same format as the XLS-file) including, e.g., Lx/Tx values\cr -\verb{$removed_aliquots} \tab \code{data.frame} \tab table with removed aliquots (e.g., \code{NaN}, or \code{Inf} \code{Lx}/\code{Tx} values). If nothing was removed \code{NULL} is returned -} - -\strong{slot:} \strong{\verb{@info}} - -The original function call - -------------------------\cr -\verb{[ PLOT OUTPUT ]}\cr -------------------------\cr -\itemize{ -\item (A) Ln/Tn curves with set integration limits, -\item (B) trace plots are returned by the baSAR-model, showing the convergence of the parameters (trace) -and the resulting kernel density plots. If \code{plot_reduced = FALSE} for every(!) dose a trace and -a density plot is returned (this may take a long time), -\item (C) dose plots showing the dose for every aliquot as boxplots and the marked -HPD in within. If boxes are coloured 'orange' or 'red' the aliquot itself should be checked, -\item (D) the dose response curve resulting from the monitoring of the Bayesian modelling are -provided along with the Lx/Tx values and the HPD. Note: The amount for curves displayed -is limited to 1000 (random choice) for performance reasons, -\item (E) the final plot is the De distribution as calculated using the conventional (frequentist) approach -and the central dose with the HPDs marked within. This figure is only provided for a comparison, -no further statistical conclusion should be drawn from it. -} - -\strong{Please note: If distribution was set to \code{log_normal} the central dose is given as geometric mean!} -} -\description{ -This function allows the application of Bayesian models on luminescence data, measured -with the single-aliquot regenerative-dose (SAR, Murray and Wintle, 2000) protocol. In particular, -it follows the idea proposed by Combès et al., 2015 of using an hierarchical model for estimating -a central equivalent dose from a set of luminescence measurements. This function is (I) the adoption -of this approach for the R environment and (II) an extension and a technical refinement of the -published code. -} -\details{ -Internally the function consists of two parts: (I) The Bayesian core for the Bayesian calculations -and applying the hierarchical model and (II) a data pre-processing part. The Bayesian core can be run -independently, if the input data are sufficient (see below). The data pre-processing part was -implemented to simplify the analysis for the user as all needed data pre-processing is done -by the function, i.e. in theory it is enough to provide a BIN/BINX-file with the SAR measurement -data. For the Bayesian analysis for each aliquot the following information are needed from the SAR analysis. -\code{LxTx}, the \code{LxTx} error and the dose values for all regeneration points. - -\strong{How is the systematic error contribution calculated?} - -Standard errors (so far) provided with the source dose rate are considered as systematic uncertainties -and added to final central dose by: - -\deqn{systematic.error = 1/n \sum SE(source.doserate)} - -\deqn{SE(central.dose.final) = \sqrt{SE(central.dose)^2 + systematic.error^2}} - -Please note that this approach is rather rough and can only be valid if the source dose rate -errors, in case different readers had been used, are similar. In cases where more than -one source dose rate is provided a warning is given. - -\strong{Input / output scenarios} - -Various inputs are allowed for this function. Unfortunately this makes the function handling rather -complex, but at the same time very powerful. Available scenarios: - -\strong{(1) - \code{object} is BIN-file or link to a BIN-file} - -Finally it does not matter how the information of the BIN/BINX file are provided. The function -supports \strong{(a)} either a path to a file or directory or a \code{list} of file names or paths or -\strong{(b)} a \linkS4class{Risoe.BINfileData} object or a list of these objects. The latter one can -be produced by using the function \link{read_BIN2R}, but this function is called automatically -if only a file name and/or a path is provided. In both cases it will become the data that can be -used for the analysis. - -\verb{[XLS_file = NULL]} - -If no XLS file (or data frame with the same format) is provided the functions runs an automatic process that -consists of the following steps: -\enumerate{ -\item Select all valid aliquots using the function \link{verify_SingleGrainData} -\item Calculate \code{Lx/Tx} values using the function \link{calc_OSLLxTxRatio} -\item Calculate De values using the function \link{plot_GrowthCurve} -} - -These proceeded data are subsequently used in for the Bayesian analysis - -\verb{[XLS_file != NULL]} - -If an XLS-file is provided or a \code{data.frame} providing similar information the pre-processing -steps consists of the following steps: -\enumerate{ -\item Calculate \code{Lx/Tx} values using the function \link{calc_OSLLxTxRatio} -\item Calculate De values using the function \link{plot_GrowthCurve} -} - -Means, the XLS file should contain a selection of the BIN-file names and the aliquots selected -for the further analysis. This allows a manual selection of input data, as the automatic selection -by \link{verify_SingleGrainData} might be not totally sufficient. - -\strong{(2) - \code{object} \verb{RLum.Results object}} - -If an \linkS4class{RLum.Results} object is provided as input and(!) this object was -previously created by the function \code{analyse_baSAR()} itself, the pre-processing part -is skipped and the function starts directly with the Bayesian analysis. This option is very powerful -as it allows to change parameters for the Bayesian analysis without the need to repeat -the data pre-processing. If furthermore the argument \code{aliquot_range} is set, aliquots -can be manually excluded based on previous runs. - -\strong{\code{method_control}} - -These are arguments that can be passed directly to the Bayesian calculation core, supported arguments -are: - -\tabular{lll}{ -\strong{Parameter} \tab \strong{Type} \tab \strong{Description}\cr -\code{lower_centralD} \tab \link{numeric} \tab sets the lower bound for the expected De range. Change it only if you know what you are doing!\cr -\code{upper_centralD} \tab \link{numeric} \tab sets the upper bound for the expected De range. Change it only if you know what you are doing!\cr -\code{n.chains} \tab \link{integer} \tab sets number of parallel chains for the model (default = 3) (cf. \link[rjags:jags.model]{rjags::jags.model})\cr -\code{inits} \tab \link{list} \tab option to set initialisation values (cf. \link[rjags:jags.model]{rjags::jags.model}) \cr -\code{thin} \tab \link{numeric} \tab thinning interval for monitoring the Bayesian process (cf. \link[rjags:jags.model]{rjags::jags.model})\cr -\code{variable.names} \tab \link{character} \tab set the variables to be monitored during the MCMC run, default: -\code{'central_D'}, \code{'sigma_D'}, \code{'D'}, \code{'Q'}, \code{'a'}, \code{'b'}, \code{'c'}, \code{'g'}. -Note: only variables present in the model can be monitored. -} - -\strong{User defined models}\cr - -The function provides the option to modify and to define own models that can be used for -the Bayesian calculation. In the case the user wants to modify a model, a new model -can be piped into the function via the argument \code{baSAR_model} as \code{character}. -The model has to be provided in the JAGS dialect of the BUGS language (cf. \link[rjags:jags.model]{rjags::jags.model}) -and parameter names given with the pre-defined names have to be respected, otherwise the function -will break. - -\strong{FAQ} - -Q: How can I set the seed for the random number generator (RNG)? - -A: Use the argument \code{method_control}, e.g., for three MCMC chains -(as it is the default): - -\if{html}{\out{
}}\preformatted{method_control = list( -inits = list( - list(.RNG.name = "base::Wichmann-Hill", .RNG.seed = 1), - list(.RNG.name = "base::Wichmann-Hill", .RNG.seed = 2), - list(.RNG.name = "base::Wichmann-Hill", .RNG.seed = 3) -)) -}\if{html}{\out{
}} - -This sets a reproducible set for every chain separately.\cr - -Q: How can I modify the output plots? - -A: You can't, but you can use the function output to create own, modified plots. - -Q: Can I change the boundaries for the central_D? - -A: Yes, we made it possible, but we DO NOT recommend it, except you know what you are doing!\cr -Example: \verb{method_control = list(lower_centralD = 10))} - -Q: The lines in the baSAR-model appear to be in a wrong logical order?\cr - -A: This is correct and allowed (cf. JAGS manual) - -\strong{Additional arguments support via the \code{...} argument} - -This list summarizes the additional arguments that can be passed to the internally used -functions. - -\tabular{llll}{ -\strong{Supported argument} \tab \strong{Corresponding function} \tab \strong{Default} \tab **Short description **\cr -\code{threshold} \tab \link{verify_SingleGrainData} \tab \code{30} \tab change rejection threshold for curve selection \cr -\code{sheet} \tab \link[readxl:read_excel]{readxl::read_excel} \tab \code{1} \tab select XLS-sheet for import\cr -\code{col_names} \tab \link[readxl:read_excel]{readxl::read_excel} \tab \code{TRUE} \tab first row in XLS-file is header\cr -\code{col_types} \tab \link[readxl:read_excel]{readxl::read_excel} \tab \code{NULL} \tab limit import to specific columns\cr -\code{skip} \tab \link[readxl:read_excel]{readxl::read_excel} \tab \code{0} \tab number of rows to be skipped during import\cr -\code{n.records} \tab \link{read_BIN2R} \tab \code{NULL} \tab limit records during BIN-file import\cr -\code{duplicated.rm} \tab \link{read_BIN2R} \tab \code{TRUE} \tab remove duplicated records in the BIN-file\cr -\code{pattern} \tab \link{read_BIN2R} \tab \code{TRUE} \tab select BIN-file by name pattern\cr -\code{position} \tab \link{read_BIN2R} \tab \code{NULL} \tab limit import to a specific position\cr -\code{background.count.distribution} \tab \link{calc_OSLLxTxRatio} \tab \code{"non-poisson"} \tab set assumed count distribution\cr -\code{fit.weights} \tab \link{plot_GrowthCurve} \tab \code{TRUE} \tab enables / disables fit weights\cr -\code{fit.bounds} \tab \link{plot_GrowthCurve} \tab \code{TRUE} \tab enables / disables fit bounds\cr -\code{NumberIterations.MC} \tab \link{plot_GrowthCurve} \tab \code{100} \tab number of MC runs for error calculation\cr -\code{output.plot} \tab \link{plot_GrowthCurve} \tab \code{TRUE} \tab enables / disables dose response curve plot\cr -\code{output.plotExtended} \tab \link{plot_GrowthCurve} \tab \code{TRUE} \tab enables / disables extended dose response curve plot\cr -} -} -\note{ -\strong{If you provide more than one BIN-file}, it is \strong{strongly} recommended to provide -a \code{list} with the same number of elements for the following parameters: - -\code{source_doserate}, \code{signal.integral}, \code{signal.integral.Tx}, \code{background.integral}, -\code{background.integral.Tx}, \code{sigmab}, \code{sig0}. - -Example for two BIN-files: \code{source_doserate = list(c(0.04, 0.006), c(0.05, 0.006))} - -\strong{The function is currently limited to work with standard Risoe BIN-files only!} -} -\section{Function version}{ - 0.1.33 -} - -\examples{ - -##(1) load package test data set -data(ExampleData.BINfileData, envir = environment()) - -##(2) selecting relevant curves, and limit dataset -CWOSL.SAR.Data <- subset( - CWOSL.SAR.Data, - subset = POSITION\%in\%c(1:3) & LTYPE == "OSL") - -\dontrun{ -##(3) run analysis -##please not that the here selected parameters are -##choosen for performance, not for reliability -results <- analyse_baSAR( - object = CWOSL.SAR.Data, - source_doserate = c(0.04, 0.001), - signal.integral = c(1:2), - background.integral = c(80:100), - fit.method = "LIN", - plot = FALSE, - n.MCMC = 200 - -) - -print(results) - - -##XLS_file template -##copy and paste this the code below in the terminal -##you can further use the function write.csv() to export the example - -XLS_file <- -structure( -list( - BIN_FILE = NA_character_, - DISC = NA_real_, - GRAIN = NA_real_), - .Names = c("BIN_FILE", "DISC", "GRAIN"), - class = "data.frame", - row.names = 1L -) - -} - -} - -\section{How to cite}{ -Mercier, N., Kreutzer, S., 2024. analyse_baSAR(): Bayesian models (baSAR) applied on luminescence data. Function version 0.1.33. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Combès, B., Philippe, A., Lanos, P., Mercier, N., Tribolo, C., Guerin, G., Guibert, P., Lahaye, C., 2015. -A Bayesian central equivalent dose model for optically stimulated luminescence dating. -Quaternary Geochronology 28, 62-70. doi:10.1016/j.quageo.2015.04.001 - -Mercier, N., Kreutzer, S., Christophe, C., Guerin, G., Guibert, P., Lahaye, C., Lanos, P., Philippe, A., -Tribolo, C., 2016. Bayesian statistics in luminescence dating: The 'baSAR'-model and its implementation -in the R package 'Luminescence'. Ancient TL 34, 14-21. - -\strong{Further reading} - -Gelman, A., Carlin, J.B., Stern, H.S., Dunson, D.B., Vehtari, A., Rubin, D.B., 2013. -Bayesian Data Analysis, Third Edition. CRC Press. - -Murray, A.S., Wintle, A.G., 2000. Luminescence dating of quartz using an improved single-aliquot -regenerative-dose protocol. Radiation Measurements 32, 57-73. doi:10.1016/S1350-4487(99)00253-X - -Plummer, M., 2017. JAGS Version 4.3.0 user manual. \verb{https://sourceforge.net/projects/mcmc-jags/files/Manuals/4.x/jags_user_manual.pdf/download} -} -\seealso{ -\link{read_BIN2R}, \link{calc_OSLLxTxRatio}, \link{plot_GrowthCurve}, -\link[readxl:read_excel]{readxl::read_excel}, \link{verify_SingleGrainData}, -\link[rjags:jags.model]{rjags::jags.model}, \link[rjags:coda.samples]{rjags::coda.samples}, \link{boxplot.default} -} -\author{ -Norbert Mercier, IRAMAT-CRP2A, Université Bordeaux Montaigne (France) \cr -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) \cr -The underlying Bayesian model based on a contribution by Combès et al., 2015. -, RLum Developer Team} -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_pIRIRSequence.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_pIRIRSequence.Rd deleted file mode 100644 index ae692395a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_pIRIRSequence.Rd +++ /dev/null @@ -1,197 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/analyse_pIRIRSequence.R -\name{analyse_pIRIRSequence} -\alias{analyse_pIRIRSequence} -\title{Analyse post-IR IRSL measurement sequences} -\usage{ -analyse_pIRIRSequence( - object, - signal.integral.min, - signal.integral.max, - background.integral.min, - background.integral.max, - dose.points = NULL, - sequence.structure = c("TL", "IR50", "pIRIR225"), - plot = TRUE, - plot.single = FALSE, - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum.Analysis} or \link{list} of \linkS4class{RLum.Analysis} objects (\strong{required}): -input object containing data for analysis. -If a \link{list} is provided the functions tries to iterate over the list.} - -\item{signal.integral.min}{\link{integer} (\strong{required}): -lower bound of the signal integral. Provide this value as vector for different -integration limits for the different IRSL curves.} - -\item{signal.integral.max}{\link{integer} (\strong{required}): -upper bound of the signal integral. Provide this value as vector for different -integration limits for the different IRSL curves.} - -\item{background.integral.min}{\link{integer} (\strong{required}): -lower bound of the background integral. Provide this value as vector for -different integration limits for the different IRSL curves.} - -\item{background.integral.max}{\link{integer} (\strong{required}): -upper bound of the background integral. Provide this value as vector for -different integration limits for the different IRSL curves.} - -\item{dose.points}{\link{numeric} (\emph{optional}): -a numeric vector containing the dose points values. Using this argument overwrites dose point -values in the signal curves.} - -\item{sequence.structure}{\link{vector} \link{character} (\emph{with default}): -specifies the general sequence structure. Allowed values are \code{"TL"} and -any \code{"IR"} combination (e.g., \code{"IR50"},\code{"pIRIR225"}). -Additionally a parameter \code{"EXCLUDE"} is allowed to exclude curves from -the analysis (Note: If a preheat without PMT measurement is used, i.e. -preheat as none TL, remove the TL step.)} - -\item{plot}{\link{logical} (\emph{with default}): -enables or disables plot output.} - -\item{plot.single}{\link{logical} (\emph{with default}): -single plot output (\code{TRUE/FALSE}) to allow for plotting the results in single plot -windows. Requires \code{plot = TRUE}.} - -\item{...}{further arguments that will be passed to the function -\link{analyse_SAR.CWOSL} and \link{plot_GrowthCurve}. Furthermore, the arguments \code{main} (headers), \code{log} (IRSL curves), \code{cex} (control -the size) and \code{mtext.outer} (additional text on the plot area) can be passed to influence the plotting. If the input -is list, \code{main} can be passed as \link{vector} or \link{list}.} -} -\value{ -Plots (\emph{optional}) and an \linkS4class{RLum.Results} object is -returned containing the following elements: - -\tabular{lll}{ -\strong{DATA.OBJECT} \tab \strong{TYPE} \tab \strong{DESCRIPTION} \cr -\code{..$data} : \tab \code{data.frame} \tab Table with De values \cr -\code{..$LnLxTnTx.table} : \tab \code{data.frame} \tab with the \code{LnLxTnTx} values \cr -\code{..$rejection.criteria} : \tab \link{data.frame} \tab rejection criteria \cr -\code{..$Formula} : \tab \link{list} \tab Function used for fitting of the dose response curve \cr -\code{..$call} : \tab \link{call} \tab the original function call -} - -The output should be accessed using the function \link{get_RLum}. -} -\description{ -The function performs an analysis of post-IR IRSL sequences -including curve -fitting on \linkS4class{RLum.Analysis} objects. -} -\details{ -To allow post-IR IRSL protocol (Thomsen et al., 2008) measurement analyses -this function has been written as extended wrapper function for the function -\link{analyse_SAR.CWOSL}, facilitating an entire sequence analysis in -one run. With this, its functionality is strictly limited by the -functionality of the function \link{analyse_SAR.CWOSL}. - -\strong{Defining the sequence structure} - -The argument \code{sequence.structure} expects a shortened pattern of your sequence structure and was -mainly introduced to ease the use of the function. For example: If your measurement data contains -the following curves: \code{TL}, \code{IRSL}, \code{IRSL}, \code{TL}, \code{IRSL}, \code{IRSL}, the sequence pattern in \code{sequence.structure} -becomes \code{c('TL', 'IRSL', 'IRSL')}. The second part of your sequence for one cycle should be -similar and can be discarded. If this is not the case (e.g., additional hotbleach) such curves -have to be removed before using the function. - -\strong{If the input is a \code{list}} - -If the input is a list of RLum.Analysis-objects, every argument can be provided as list to allow -for different sets of parameters for every single input element. -For further information see \link{analyse_SAR.CWOSL}. -} -\note{ -Best graphical output can be achieved by using the function \code{pdf} -with the following options: - -\code{pdf(file = "", height = 15, width = 15)} -} -\section{Function version}{ - 0.2.4 -} - -\examples{ - - -### NOTE: For this example existing example data are used. These data are non pIRIR data. -### -##(1) Compile example data set based on existing example data (SAR quartz measurement) -##(a) Load example data -data(ExampleData.BINfileData, envir = environment()) - -##(b) Transform the values from the first position in a RLum.Analysis object -object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) - -##(c) Grep curves and exclude the last two (one TL and one IRSL) -object <- get_RLum(object, record.id = c(-29,-30)) - -##(d) Define new sequence structure and set new RLum.Analysis object -sequence.structure <- c(1,2,2,3,4,4) -sequence.structure <- as.vector(sapply(seq(0,length(object)-1,by = 4), - function(x){sequence.structure + x})) - -object <- sapply(1:length(sequence.structure), function(x){ - - object[[sequence.structure[x]]] - -}) - -object <- set_RLum(class = "RLum.Analysis", records = object, protocol = "pIRIR") - -##(2) Perform pIRIR analysis (for this example with quartz OSL data!) -## Note: output as single plots to avoid problems with this example -results <- analyse_pIRIRSequence(object, - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - fit.method = "EXP", - sequence.structure = c("TL", "pseudoIRSL1", "pseudoIRSL2"), - main = "Pseudo pIRIR data set based on quartz OSL", - plot.single = TRUE) - - -##(3) Perform pIRIR analysis (for this example with quartz OSL data!) -## Alternative for PDF output, uncomment and complete for usage -\dontrun{ -tempfile <- tempfile(fileext = ".pdf") -pdf(file = tempfile, height = 15, width = 15) - results <- analyse_pIRIRSequence(object, - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - fit.method = "EXP", - main = "Pseudo pIRIR data set based on quartz OSL") - - dev.off() -} - -} - -\section{How to cite}{ -Kreutzer, S., 2024. analyse_pIRIRSequence(): Analyse post-IR IRSL measurement sequences. Function version 0.2.4. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Murray, A.S., Wintle, A.G., 2000. Luminescence dating of quartz -using an improved single-aliquot regenerative-dose protocol. Radiation -Measurements 32, 57-73. \doi{10.1016/S1350-4487(99)00253-X} - -Thomsen, K.J., Murray, A.S., Jain, M., Boetter-Jensen, L., 2008. Laboratory -fading rates of various luminescence signals from feldspar-rich sediment -extracts. Radiation Measurements 43, 1474-1486. -\doi{10.1016/j.radmeas.2008.06.002} -} -\seealso{ -\link{analyse_SAR.CWOSL}, \link{calc_OSLLxTxRatio}, \link{plot_GrowthCurve}, -\linkS4class{RLum.Analysis}, \linkS4class{RLum.Results} \link{get_RLum} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{datagen} -\keyword{plot} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_portableOSL.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_portableOSL.Rd deleted file mode 100644 index 2cd6b9718..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/analyse_portableOSL.Rd +++ /dev/null @@ -1,134 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/analyse_portableOSL.R -\name{analyse_portableOSL} -\alias{analyse_portableOSL} -\title{Analyse portable CW-OSL measurements} -\usage{ -analyse_portableOSL( - object, - signal.integral = NULL, - invert = FALSE, - normalise = FALSE, - mode = "profile", - coord = NULL, - plot = TRUE, - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum.Analysis} (\strong{required}): \linkS4class{RLum.Analysis} object produced by \link{read_PSL2R}. -The input can be a \link{list} of such objects, in such case each input is treated as a separate sample -and the results are merged.} - -\item{signal.integral}{\link{numeric} (\strong{required}): A vector of two values specifying the lower and upper channel used to calculate the OSL/IRSL signal. Can be provided in form of \code{c(1, 5)} or \code{1:5}.} - -\item{invert}{\link{logical} (\emph{with default}): \code{TRUE} flip the plot the data in reverse order.} - -\item{normalise}{\link{logical} (\emph{with default}): \code{TRUE} to normalise the OSL/IRSL signals -to the \emph{mean} of all corresponding data curves.} - -\item{mode}{\link{character} (\emph{with default}): defines the analysis mode, allowed -are \code{"profile"} (the default) and \code{"surface"} for surface interpolation. If you select -something else, nothing will be plotted (similar to \code{plot = FALSE}).} - -\item{coord}{\link{list} \link{matrix} (\emph{optional}): a list or matrix of the same length as -number of samples measured with coordinates for the sampling positions. Coordinates -are expected to be provided in meter (unit: m). -Expected are x and y coordinates, e.g., -\verb{coord = list(samp1 = c(0.1, 0.2)}. If you have not measured x coordinates, please x should be 0.} - -\item{plot}{\link{logical} (\emph{with default}): enable/disable plot output} - -\item{...}{other parameters to be passed to modify the plot output. -Supported are \code{run} to provide the run name , -if the input is a \code{list}, this is set automatically. Further plot parameters are -\code{surface_values} (\link{character} with value to plot), \code{legend} (\code{TRUE}/\code{FALSE}), \code{col_ramp} (for -surface mode), \code{contour} (contour lines \code{TRUE}/\code{FALSE} in surface mode), \code{grid} (\code{TRUE}/\code{FALSE}), \code{col}, \code{pch} (for profile mode), \code{xlim} (a name \link{list} for profile mode), \code{ylim}, -\code{zlim} (surface mode only), \code{ylab}, \code{xlab}, \code{zlab} (here x-axis labelling), \code{main}, \code{bg_img} (for -profile mode background image, usually a profile photo; should be a raster object), -\code{bg_img_positions} (a vector with the four corner positions, cf. \link[graphics:rasterImage]{graphics::rasterImage})} -} -\value{ -Returns an S4 \linkS4class{RLum.Results} object with the following elements: - -\verb{$data}\cr -\code{.. $summary}: \link{data.frame} with the results\cr -\code{.. $data}: \link{list} with the \linkS4class{RLum.Analysis} objects\cr -\code{.. $args}: \link{list} the input arguments -} -\description{ -The function analyses CW-OSL curve data produced by a SUERC portable OSL reader and -produces a combined plot of OSL/IRSL signal intensities, OSL/IRSL depletion ratios -and the IRSL/OSL ratio. -} -\details{ -This function only works with \linkS4class{RLum.Analysis} objects produced by \link{read_PSL2R}. -It further assumes (or rather requires) an equal amount of OSL and IRSL curves that -are pairwise combined for calculating the IRSL/OSL ratio. For calculating the depletion ratios -the cumulative signal of the last n channels (same number of channels as specified -by \code{signal.integral}) is divided by cumulative signal of the first n channels (\code{signal.integral}). - -\strong{Note: The function assumes the following sequence pattern: \verb{DARK COUNT}, \code{IRSL}, \verb{DARK COUNT}, \code{BSL}, \verb{DARK COUNT}. If you have written a different sequence, the analysis function will (likely) not work!}. - -\strong{Signal processing} -The function processes the signals as follows: \code{BSL} and \code{IRSL} signals are extracted using the -chosen signal integral, dark counts are taken in full. - -\strong{Working with coordinates} -Usually samples are taken from a profile with a certain stratigraphy. In the past the function -calculated an index. With this newer version, you have two option of passing on xy-coordinates -to the function: -\itemize{ -\item (1) Add coordinates to the sample name during measurement. The form is rather -strict and has to follow the scheme \verb{_x:|y:}. Example: -\code{sample_x:0.2|y:0.4}. -\item (2) Alternatively, you can provide a \link{list} or \link{matrix} with the sample coordinates. -Example: \code{coord = list(c(0.2, 1), c(0.3,1.2))} -} - -Please note that the unit is meter (m) and the function expects always xy-coordinates. -The latter one is useful for surface interpolations. If you have measured a profile where -the x-coordinates to not measure, x-coordinates should be 0. -} -\section{Function version}{ - 0.1.1 -} - -\examples{ - -## example profile plot -# (1) load example data set -data("ExampleData.portableOSL", envir = environment()) - -# (2) merge and plot all RLum.Analysis objects -merged <- merge_RLum(ExampleData.portableOSL) -plot_RLum( - object = merged, - combine = TRUE, - records_max = 5, - legend.pos = "outside") -merged - -# (3) analyse and plot -results <- analyse_portableOSL( - merged, - signal.integral = 1:5, - invert = FALSE, - normalise = TRUE) -get_RLum(results) - -} -\seealso{ -\linkS4class{RLum.Analysis}, \linkS4class{RLum.Data.Curve}, \link{read_PSL2R} -} -\author{ -Christoph Burow, University of Cologne (Germany), Sebastian Kreutzer, -Institute of Geography, Ruprecht-Karl University of Heidelberg, Germany -, RLum Developer Team} - -\section{How to cite}{ -Burow, C., Kreutzer, S., 2024. analyse_portableOSL(): Analyse portable CW-OSL measurements. Function version 0.1.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{datagen} -\keyword{plot} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/apply_CosmicRayRemoval.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/apply_CosmicRayRemoval.Rd deleted file mode 100644 index 1a3102a39..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/apply_CosmicRayRemoval.Rd +++ /dev/null @@ -1,125 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/apply_CosmicRayRemoval.R -\name{apply_CosmicRayRemoval} -\alias{apply_CosmicRayRemoval} -\title{Function to remove cosmic rays from an RLum.Data.Spectrum S4 class object} -\usage{ -apply_CosmicRayRemoval( - object, - method = "smooth", - method.Pych.smoothing = 2, - method.Pych.threshold_factor = 3, - MARGIN = 2, - verbose = FALSE, - plot = FALSE, - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum.Data.Spectrum} or \linkS4class{RLum.Analysis} (\strong{required}): input -object to be treated. This can be also provided as \link{list}. If an \linkS4class{RLum.Analysis} object -is provided, only the \linkS4class{RLum.Data.Spectrum} objects are treated. Please note: this mixing of -objects does not work for a list of \code{RLum.Data} objects.} - -\item{method}{\link{character} (\emph{with default}): -Defines method that is applied for cosmic ray removal. Allowed methods are -\code{smooth}, the default, (\link{smooth}), \code{smooth.spline} (\link{smooth.spline}) -and \code{Pych}. See details for further information.} - -\item{method.Pych.smoothing}{\link{integer} (\emph{with default}): -Smoothing parameter for cosmic ray removal according to Pych (2003). -The value defines how many neighbouring values in each frame are used for smoothing -(e.g., \code{2} means that the two previous and two following values are used).} - -\item{method.Pych.threshold_factor}{\link{numeric} (\emph{with default}): -Threshold for zero-bins in the histogram. Small values mean that more peaks -are removed, but signal might be also affected by this removal.} - -\item{MARGIN}{\link{integer} (\emph{with default}): -on which part the function cosmic ray removal should be applied on: -\itemize{ -\item 1 = along the time axis (line by line), -\item 2 = along the wavelength axis (column by column). -} - -\strong{Note:} This argument currently only affects the methods \code{smooth} and \code{smooth.spline}} - -\item{verbose}{\link{logical} (\emph{with default}): -Option to suppress terminal output.,} - -\item{plot}{\link{logical} (\emph{with default}): -If \code{TRUE} the histograms used for the cosmic-ray removal are returned as plot -including the used threshold. Note: A separate plot is returned for each frame! -Currently only for \code{method = "Pych"} a graphical output is provided.} - -\item{...}{further arguments and graphical parameters that will be passed -to the \link{smooth} function.} -} -\value{ -Returns same object as input. -} -\description{ -The function provides several methods for cosmic-ray removal and spectrum -smoothing \linkS4class{RLum.Data.Spectrum} objects and such objects embedded in \link{list} or -\linkS4class{RLum.Analysis} objects. -} -\details{ -\strong{\code{method = "Pych"}} - -This method applies the cosmic-ray removal algorithm described by Pych -(2003). Some aspects that are different to the publication: -\itemize{ -\item For interpolation between neighbouring values the median and not the mean is used. -\item The number of breaks to construct the histogram is set to: \code{length(number.of.input.values)/2} -} - -For further details see references below. - -\strong{\code{method = "smooth"}} - -Method uses the function \link{smooth} to remove cosmic rays. - -Arguments that can be passed are: \code{kind}, \code{twiceit} - -\strong{\code{method = "smooth.spline"}} - -Method uses the function \link{smooth.spline} to remove cosmic rays. - -Arguments that can be passed are: \code{spar} - -\strong{How to combine methods?} - -Different methods can be combined by applying the method repeatedly to the -dataset (see example). -} -\section{Function version}{ - 0.3.0 -} - -\examples{ - -##(1) - use with your own data and combine (uncomment for usage) -## run two times the default method and smooth with another method -## your.spectrum <- apply_CosmicRayRemoval(your.spectrum, method = "Pych") -## your.spectrum <- apply_CosmicRayRemoval(your.spectrum, method = "Pych") -## your.spectrum <- apply_CosmicRayRemoval(your.spectrum, method = "smooth") - -} - -\section{How to cite}{ -Kreutzer, S., 2024. apply_CosmicRayRemoval(): Function to remove cosmic rays from an RLum.Data.Spectrum S4 class object. Function version 0.3.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Pych, W., 2004. A Fast Algorithm for Cosmic-Ray Removal from -Single Images. The Astronomical Society of the Pacific 116 (816), 148-153. -\doi{10.1086/381786} -} -\seealso{ -\linkS4class{RLum.Data.Spectrum}, \linkS4class{RLum.Analysis}, \link{smooth}, \link{smooth.spline}, -\link{apply_CosmicRayRemoval} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{manip} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/apply_EfficiencyCorrection.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/apply_EfficiencyCorrection.Rd deleted file mode 100644 index d8d0507eb..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/apply_EfficiencyCorrection.Rd +++ /dev/null @@ -1,65 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/apply_EfficiencyCorrection.R -\name{apply_EfficiencyCorrection} -\alias{apply_EfficiencyCorrection} -\title{Function to apply spectral efficiency correction to RLum.Data.Spectrum S4 -class objects} -\usage{ -apply_EfficiencyCorrection(object, spectral.efficiency) -} -\arguments{ -\item{object}{\linkS4class{RLum.Data.Spectrum} or \linkS4class{RLum.Analysis} (\strong{required}): -S4 object of class \code{RLum.Data.Spectrum}, \code{RLum.Analysis}or a \link{list} of such objects. Other objects in -the list are skipped.} - -\item{spectral.efficiency}{\link{data.frame} (\strong{required}): -Data set containing wavelengths (x-column) and relative spectral response values -(y-column) (values between 0 and 1). The provided data will be used to correct all spectra if \code{object} is -a \link{list}} -} -\value{ -Returns same object as provided as input -} -\description{ -The function allows spectral efficiency corrections for RLum.Data.Spectrum -S4 class objects -} -\details{ -The efficiency correction is based on a spectral response dataset provided -by the user. Usually the data set for the quantum efficiency is of lower -resolution and values are interpolated for the required spectral resolution using -the function \link[stats:approxfun]{stats::approx} - -If the energy calibration differs for both data set \code{NA} values are produces that -will be removed from the matrix. -} -\note{ -Please note that the spectral efficiency data from the camera alone may not -sufficiently correct for spectral efficiency of the entire optical system -(e.g., spectrometer, camera ...). -} -\section{Function version}{ - 0.2.0 -} - -\examples{ - -##(1) - use with your own data (uncomment for usage) -## spectral.efficiency <- read.csv("your data") -## -## your.spectrum <- apply_EfficiencyCorrection(your.spectrum, ) - -} -\seealso{ -\linkS4class{RLum.Data.Spectrum}, \linkS4class{RLum.Analysis} -} -\author{ -Sebastian Kreutzer, IRAMAT-CRP2A, UMR 5060, CNRS-Université Bordeaux Montaigne (France)\cr -Johannes Friedrich, University of Bayreuth (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., Friedrich, J., 2024. apply_EfficiencyCorrection(): Function to apply spectral efficiency correction to RLum.Data.Spectrum S4 class objects. Function version 0.2.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{manip} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/as.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/as.Rd deleted file mode 100644 index 8d276ca75..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/as.Rd +++ /dev/null @@ -1,76 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/RLum.Analysis-class.R, -% R/RLum.Data.Curve-class.R, R/RLum.Data.Image-class.R, -% R/RLum.Data.Spectrum-class.R, R/RLum.Results-class.R -\name{as} -\alias{as} -\title{as() - RLum-object coercion} -\arguments{ -\item{from}{\linkS4class{RLum}, \link{list}, \link{data.frame}, \link{matrix} (\strong{required}): -object to be coerced from} - -\item{to}{\link{character} (\strong{required}): -class name to be coerced to} -} -\description{ -for \verb{[RLum.Analysis-class]} - -for \verb{[RLum.Data.Curve-class]} - -for \verb{[RLum.Data.Image-class]} - -for \verb{[RLum.Data.Spectrum-class]} - -for \verb{[RLum.Results-class]} -} -\details{ -\strong{\linkS4class{RLum.Analysis}} - -\tabular{ll}{ -\strong{from} \tab \strong{to}\cr -\code{list} \tab \code{list}\cr -} - -Given that the \link{list} consists of \linkS4class{RLum.Analysis} objects. - -\strong{\linkS4class{RLum.Data.Curve}} - -\tabular{ll}{ -\strong{from} \tab \strong{to}\cr -\code{list} \tab \code{list} \cr -\code{data.frame} \tab \code{data.frame}\cr -\code{matrix} \tab \code{matrix} -} - -\strong{\linkS4class{RLum.Data.Image}} - -\tabular{ll}{ -\strong{from} \tab \strong{to}\cr -\code{data.frame} \tab \code{data.frame}\cr -\code{matrix} \tab \code{matrix} -} - -\strong{\linkS4class{RLum.Data.Spectrum}} - -\tabular{ll}{ -\strong{from} \tab \strong{to}\cr -\code{data.frame} \tab \code{data.frame}\cr -\code{matrix} \tab \code{matrix} -} - -\strong{\linkS4class{RLum.Results}} - -\tabular{ll}{ -\strong{from} \tab \strong{to}\cr -\code{list} \tab \code{list}\cr -} - -Given that the \link{list} consists of \linkS4class{RLum.Results} objects. -} -\note{ -Due to the complex structure of the \code{RLum} objects itself a coercing to standard -R data structures will be always loosely! -} -\seealso{ -\link[methods:as]{methods::as} -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/bin_RLum.Data.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/bin_RLum.Data.Rd deleted file mode 100644 index 650507e19..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/bin_RLum.Data.Rd +++ /dev/null @@ -1,65 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/bin_RLum.Data.R -\name{bin_RLum.Data} -\alias{bin_RLum.Data} -\title{Channel binning - method dispatcher} -\usage{ -bin_RLum.Data(object, ...) -} -\arguments{ -\item{object}{\linkS4class{RLum.Data} (\strong{required}): -S4 object of class \code{RLum.Data}} - -\item{...}{further arguments passed to the specific class method} -} -\value{ -An object of the same type as the input object is provided -} -\description{ -Function calls the object-specific bin functions for RLum.Data S4 class objects. -} -\details{ -The function provides a generalised access point for specific -\linkS4class{RLum.Data} objects. \cr -Depending on the input object, the corresponding function will be selected. -Allowed arguments can be found in the documentations of the corresponding -\linkS4class{RLum.Data} class. -} -\note{ -Currently only \code{RLum.Data} objects of class \linkS4class{RLum.Data.Curve} and \linkS4class{RLum.Data.Spectrum} are supported! -} -\section{Function version}{ - 0.2.0 -} - -\examples{ - -##load example data -data(ExampleData.CW_OSL_Curve, envir = environment()) - -##create RLum.Data.Curve object from this example -curve <- - set_RLum( - class = "RLum.Data.Curve", - recordType = "OSL", - data = as.matrix(ExampleData.CW_OSL_Curve) - ) - -##plot data without and with 2 and 4 channel binning -plot_RLum(curve) -plot_RLum(bin_RLum.Data(curve, bin_size = 2)) -plot_RLum(bin_RLum.Data(curve, bin_size = 4)) - -} -\seealso{ -\linkS4class{RLum.Data.Curve}, \linkS4class{RLum.Data.Spectrum} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. bin_RLum.Data(): Channel binning - method dispatcher. Function version 0.2.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{utilities} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_AliquotSize.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_AliquotSize.Rd deleted file mode 100644 index 881a7dc21..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_AliquotSize.Rd +++ /dev/null @@ -1,165 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_AliquotSize.R -\name{calc_AliquotSize} -\alias{calc_AliquotSize} -\title{Estimate the amount of grains on an aliquot} -\usage{ -calc_AliquotSize( - grain.size, - sample.diameter, - packing.density = 0.65, - MC = TRUE, - grains.counted, - plot = TRUE, - ... -) -} -\arguments{ -\item{grain.size}{\link{numeric} (\strong{required}): -mean grain size (microns) or a range of grain sizes from which the -mean grain size is computed (e.g. \code{c(100,200)}).} - -\item{sample.diameter}{\link{numeric} (\strong{required}): -diameter (mm) of the targeted area on the sample carrier.} - -\item{packing.density}{\link{numeric} (\emph{with default}): -empirical value for mean packing density. \cr -If \code{packing.density = "Inf"} a hexagonal structure on an infinite plane with -a packing density of \eqn{0.906\ldots} is assumed.} - -\item{MC}{\link{logical} (\emph{optional}): -if \code{TRUE} the function performs a Monte Carlo simulation for estimating the -amount of grains on the sample carrier and assumes random errors in grain -size distribution and packing density. Requires a vector with min and max -grain size for \code{grain.size}. For more information see details.} - -\item{grains.counted}{\link{numeric} (\emph{optional}): -grains counted on a sample carrier. If a non-zero positive integer is provided this function -will calculate the packing density of the aliquot. If more than one value is -provided the mean packing density and its standard deviation is calculated. -Note that this overrides \code{packing.density}.} - -\item{plot}{\link{logical} (\emph{with default}): -plot output (\code{TRUE}/\code{FALSE})} - -\item{...}{further arguments to pass (\verb{main, xlab, MC.iter}).} -} -\value{ -Returns a terminal output. In addition an -\linkS4class{RLum.Results} object is returned containing the -following element: - -\item{.$summary}{\link{data.frame} summary of all relevant calculation results.} -\item{.$args}{\link{list} used arguments} -\item{.$call}{\link{call} the function call} -\item{.$MC}{\link{list} results of the Monte Carlo simulation} - -The output should be accessed using the function \link{get_RLum}. -} -\description{ -Estimate the number of grains on an aliquot. Alternatively, the packing -density of an aliquot is computed. -} -\details{ -This function can be used to either estimate the number of grains on an -aliquot or to compute the packing density depending on the the arguments -provided. - -The following function is used to estimate the number of grains \code{n}: - -\deqn{n = (\pi*x^2)/(\pi*y^2)*d} - -where \code{x} is the radius of the aliquot size (microns), \code{y} is the mean -radius of the mineral grains (mm) and \code{d} is the packing density -(value between 0 and 1). - -\strong{Packing density} - -The default value for \code{packing.density} is 0.65, which is the mean of -empirical values determined by Heer et al. (2012) and unpublished data from -the Cologne luminescence laboratory. If \code{packing.density = "Inf"} a maximum -density of \eqn{\pi/\sqrt12 = 0.9068\ldots} is used. However, note that -this value is not appropriate as the standard preparation procedure of -aliquots resembles a PECC (\emph{"Packing Equal Circles in a Circle"}) problem -where the maximum packing density is asymptotic to about 0.87. - -\strong{Monte Carlo simulation} - -The number of grains on an aliquot can be estimated by Monte Carlo simulation -when setting \code{MC = TRUE}. Each of the parameters necessary to calculate -\code{n} (\code{x}, \code{y}, \code{d}) are assumed to be normally distributed with means -\eqn{\mu_x, \mu_y, \mu_d} and standard deviations \eqn{\sigma_x, \sigma_y, \sigma_d}. - -For the mean grain size random samples are taken first from -\eqn{N(\mu_y, \sigma_y)}, where \eqn{\mu_y = mean.grain.size} and -\eqn{\sigma_y = (max.grain.size-min.grain.size)/4} so that 95\\% of all -grains are within the provided the grain size range. This effectively takes -into account that after sieving the sample there is still a small chance of -having grains smaller or larger than the used mesh sizes. For each random -sample the mean grain size is calculated, from which random subsamples are -drawn for the Monte Carlo simulation. - -The packing density is assumed -to be normally distributed with an empirically determined \eqn{\mu = 0.65} -(or provided value) and \eqn{\sigma = 0.18}. The normal distribution is -truncated at \code{d = 0.87} as this is approximately the maximum packing -density that can be achieved in PECC problem. - -The sample diameter has -\eqn{\mu = sample.diameter} and \eqn{\sigma = 0.2} to take into account -variations in sample disc preparation (i.e. applying silicon spray to the -disc). A lower truncation point at \code{x = 0.5} is used, which assumes -that aliquots with smaller sample diameters of 0.5 mm are discarded. -Likewise, the normal distribution is truncated at 9.8 mm, which is the -diameter of the sample disc. - -For each random sample drawn from the -normal distributions the amount of grains on the aliquot is calculated. By -default, \code{10^5} iterations are used, but can be reduced/increased with -\code{MC.iter} (see \code{...}). The results are visualised in a bar- and -boxplot together with a statistical summary. -} -\section{Function version}{ - 0.31 -} - -\examples{ - -## Estimate the amount of grains on a small aliquot -calc_AliquotSize(grain.size = c(100,150), sample.diameter = 1, MC.iter = 100) - -## Calculate the mean packing density of large aliquots -calc_AliquotSize(grain.size = c(100,200), sample.diameter = 8, - grains.counted = c(2525,2312,2880), MC.iter = 100) - -} - -\section{How to cite}{ -Burow, C., 2024. calc_AliquotSize(): Estimate the amount of grains on an aliquot. Function version 0.31. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Duller, G.A.T., 2008. Single-grain optical dating of Quaternary -sediments: why aliquot size matters in luminescence dating. Boreas 37, -589-612. - -Heer, A.J., Adamiec, G., Moska, P., 2012. How many grains -are there on a single aliquot?. Ancient TL 30, 9-16. - -\strong{Further reading} - -Chang, H.-C., Wang, L.-C., 2010. A simple proof of Thue's -Theorem on Circle Packing. \url{https://arxiv.org/pdf/1009.4322v1}, -2013-09-13. - -Graham, R.L., Lubachevsky, B.D., Nurmela, K.J., -Oestergard, P.R.J., 1998. Dense packings of congruent circles in a circle. -Discrete Mathematics 181, 139-154. - -Huang, W., Ye, T., 2011. Global -optimization method for finding dense packings of equal circles in a circle. -European Journal of Operational Research 210, 474-481. -} -\author{ -Christoph Burow, University of Cologne (Germany) -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_AverageDose.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_AverageDose.Rd deleted file mode 100644 index 0b10bf6b0..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_AverageDose.Rd +++ /dev/null @@ -1,153 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_AverageDose.R -\name{calc_AverageDose} -\alias{calc_AverageDose} -\title{Calculate the Average Dose and the dose rate dispersion} -\usage{ -calc_AverageDose( - data, - sigma_m, - Nb_BE = 500, - na.rm = TRUE, - plot = TRUE, - verbose = TRUE, - ... -) -} -\arguments{ -\item{data}{\linkS4class{RLum.Results} or \link{data.frame} (\strong{required}): -for \link{data.frame}: two columns with \code{De} \code{(data[,1])} and \verb{De error} \code{(values[,2])}} - -\item{sigma_m}{\link{numeric} (\strong{required}): -the overdispersion resulting from a dose recovery -experiment, i.e. when all grains have received the same dose. Indeed in such a case, any -overdispersion (i.e. dispersion on top of analytical uncertainties) is, by definition, an -unrecognised measurement uncertainty.} - -\item{Nb_BE}{\link{integer} (\emph{with default}): -sample size used for the bootstrapping} - -\item{na.rm}{\link{logical} (\emph{with default}): -exclude NA values from the data set prior to any further operation.} - -\item{plot}{\link{logical} (\emph{with default}): -enables/disables plot output} - -\item{verbose}{\link{logical} (\emph{with default}): -enables/disables terminal output} - -\item{...}{further arguments that can be passed to \link[graphics:hist]{graphics::hist}. As three plots -are returned all arguments need to be provided as \link{list}, -e.g., \code{main = list("Plot 1", "Plot 2", "Plot 3")}. -Note: not all arguments of \code{hist} are -supported, but the output of \code{hist} is returned and can be used of own plots. \cr - -Further supported arguments: \code{mtext} (\link{character}), \code{rug} (\code{TRUE/FALSE}).} -} -\value{ -The function returns numerical output and an (\emph{optional}) plot. - ------------------------------------\cr -\verb{[ NUMERICAL OUTPUT ]} \cr ------------------------------------\cr -\strong{\code{RLum.Results}}-object\cr - -\strong{slot:} \strong{\verb{@data}} \cr - -\verb{[.. $summary : data.frame]}\cr - -\tabular{lll}{ -\strong{Column} \tab \strong{Type} \tab \strong{Description}\cr -AVERAGE_DOSE \tab \link{numeric} \tab the obtained average dose\cr -AVERAGE_DOSE.SE \tab \link{numeric} \tab the average dose error \cr -SIGMA_D \tab \link{numeric}\tab sigma \cr -SIGMA_D.SE \tab \link{numeric}\tab standard error of the sigma \cr -IC_AVERAGE_DOSE.LEVEL \tab \link{character}\tab confidence level average dose\cr -IC_AVERAGE_DOSE.LOWER \tab \link{character}\tab lower quantile of average dose \cr -IC_AVERAGE_DOSE.UPPER \tab \link{character}\tab upper quantile of average dose\cr -IC_SIGMA_D.LEVEL \tab \link{integer}\tab confidence level sigma\cr -IC_SIGMA_D.LOWER \tab \link{character}\tab lower sigma quantile\cr -IC_SIGMA_D.UPPER \tab \link{character}\tab upper sigma quantile\cr -L_MAX \tab \link{character}\tab maximum likelihood value -} - -\verb{[.. $dstar : matrix]} \cr - -Matrix with bootstrap values\cr - -\verb{[.. $hist : list]}\cr - -Object as produced by the function histogram - -------------------------\cr -\verb{[ PLOT OUTPUT ]}\cr -------------------------\cr - -The function returns two different plot panels. - -(1) An abanico plot with the dose values - -(2) A histogram panel comprising 3 histograms with the equivalent dose and the bootstrapped average -dose and the sigma values. -} -\description{ -This functions calculates the Average Dose and their extrinsic dispersion and estimates -the standard errors by bootstrapping based on the Average Dose Model by Guerin et al., 2017 -} -\details{ -\strong{\code{sigma_m}}\cr - -The program requires the input of a known value of \code{sigma_m}, -which corresponds to the intrinsic overdispersion, as determined -by a dose recovery experiment. Then the dispersion in doses (\code{sigma_d}) -will be that over and above \code{sigma_m} (and individual uncertainties \code{sigma_wi}). -} -\note{ -This function has beta status! -} -\section{Function version}{ - 0.1.5 -} - -\examples{ - -##Example 01 using package example data -##load example data -data(ExampleData.DeValues, envir = environment()) - -##calculate Average dose -##(use only the first 56 values here) -AD <- calc_AverageDose(ExampleData.DeValues$CA1[1:56,], sigma_m = 0.1) - -##plot De and set Average dose as central value -plot_AbanicoPlot( - data = ExampleData.DeValues$CA1[1:56,], - z.0 = AD$summary$AVERAGE_DOSE) - -} - -\section{How to cite}{ -Christophe, C., Philippe, A., Kreutzer, S., 2024. calc_AverageDose(): Calculate the Average Dose and the dose rate dispersion. Function version 0.1.5. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Guerin, G., Christophe, C., Philippe, A., Murray, A.S., Thomsen, K.J., Tribolo, C., Urbanova, P., -Jain, M., Guibert, P., Mercier, N., Kreutzer, S., Lahaye, C., 2017. Absorbed dose, equivalent dose, -measured dose rates, and implications for OSL age estimates: Introducing the Average Dose Model. -Quaternary Geochronology 1-32. doi:10.1016/j.quageo.2017.04.002 - -\strong{Further reading}\cr - -Efron, B., Tibshirani, R., 1986. Bootstrap Methods for Standard Errors, Confidence Intervals, -and Other Measures of Statistical Accuracy. Statistical Science 1, 54-75. -} -\seealso{ -\link{read.table}, \link[graphics:hist]{graphics::hist} -} -\author{ -Claire Christophe, IRAMAT-CRP2A, Université de Nantes (France), -Anne Philippe, Université de Nantes, (France), -Guillaume Guérin, IRAMAT-CRP2A, Université Bordeaux Montaigne, (France), -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_CentralDose.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_CentralDose.Rd deleted file mode 100644 index 3c1cdba32..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_CentralDose.Rd +++ /dev/null @@ -1,117 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_CentralDose.R -\name{calc_CentralDose} -\alias{calc_CentralDose} -\title{Apply the central age model (CAM) after Galbraith et al. (1999) to a given -De distribution} -\usage{ -calc_CentralDose(data, sigmab, log = TRUE, na.rm = FALSE, plot = TRUE, ...) -} -\arguments{ -\item{data}{\linkS4class{RLum.Results} or \link{data.frame} (\strong{required}): -for \link{data.frame}: two columns with De \code{(data[,1])} and De error \code{(data[,2])}} - -\item{sigmab}{\link{numeric} (\emph{with default}): -additional spread in De values. -This value represents the expected overdispersion in the data should the sample be -well-bleached (Cunningham & Walling 2012, p. 100). -\strong{NOTE}: For the logged model (\code{log = TRUE}) this value must be -a fraction, e.g. 0.2 (= 20 \\%). If the un-logged model is used (\code{log = FALSE}), -sigmab must be provided in the same absolute units of the De values (seconds or Gray).} - -\item{log}{\link{logical} (\emph{with default}): -fit the (un-)logged central age model to De data} - -\item{na.rm}{\link{logical} (\emph{with default}): strip \code{NA} values before the computation proceeds} - -\item{plot}{\link{logical} (\emph{with default}): -plot output} - -\item{...}{further arguments (\code{trace}, \code{verbose}).} -} -\value{ -Returns a plot (\emph{optional}) and terminal output. In addition an -\linkS4class{RLum.Results} object is returned containing the following elements: - -\item{.$summary}{\link{data.frame} summary of all relevant model results.} -\item{.$data}{\link{data.frame} original input data} -\item{.$args}{\link{list} used arguments} -\item{.$call}{\link{call} the function call} -\item{.$profile}{\link{data.frame} the log likelihood profile for sigma} - -The output should be accessed using the function \link{get_RLum} -} -\description{ -This function calculates the central dose and dispersion of the De -distribution, their standard errors and the profile log likelihood function -for sigma. -} -\details{ -This function uses the equations of Galbraith & Roberts (2012). The -parameters \code{delta} and \code{sigma} are estimated by numerically solving -eq. 15 and 16. Their standard errors are approximated using eq. 17. -In addition, the profile log-likelihood function for \code{sigma} is -calculated using eq. 18 and presented as a plot. Numerical values of the -maximum likelihood approach are \strong{only} presented in the plot and \strong{not} -in the console. A detailed explanation on maximum likelihood estimation can -be found in the appendix of Galbraith & Laslett (1993, 468-470) and -Galbraith & Roberts (2012, 15) -} -\section{Function version}{ - 1.4.1 -} - -\examples{ - -##load example data -data(ExampleData.DeValues, envir = environment()) - -##apply the central dose model -calc_CentralDose(ExampleData.DeValues$CA1) - -} - -\section{How to cite}{ -Burow, C., 2024. calc_CentralDose(): Apply the central age model (CAM) after Galbraith et al. (1999) to a given De distribution. Function version 1.4.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Galbraith, R.F. & Laslett, G.M., 1993. Statistical models for -mixed fission track ages. Nuclear Tracks Radiation Measurements 4, 459-470. - -Galbraith, R.F., Roberts, R.G., Laslett, G.M., Yoshida, H. & Olley, -J.M., 1999. Optical dating of single grains of quartz from Jinmium rock -shelter, northern Australia. Part I: experimental design and statistical -models. Archaeometry 41, 339-364. - -Galbraith, R.F. & Roberts, R.G., 2012. Statistical aspects of equivalent dose and error calculation and -display in OSL dating: An overview and some recommendations. Quaternary -Geochronology 11, 1-27. - -\strong{Further reading} - -Arnold, L.J. & Roberts, R.G., 2009. Stochastic modelling of multi-grain equivalent dose -(De) distributions: Implications for OSL dating of sediment mixtures. -Quaternary Geochronology 4, 204-230. - -Bailey, R.M. & Arnold, L.J., 2006. Statistical modelling of single grain quartz De distributions and an -assessment of procedures for estimating burial dose. Quaternary Science -Reviews 25, 2475-2502. - -Cunningham, A.C. & Wallinga, J., 2012. Realizing the potential of fluvial archives using robust OSL chronologies. -Quaternary Geochronology 12, 98-106. - -Rodnight, H., Duller, G.A.T., Wintle, A.G. & Tooth, S., 2006. Assessing the reproducibility and accuracy -of optical dating of fluvial deposits. Quaternary Geochronology, 1 109-120. - -Rodnight, H., 2008. How many equivalent dose values are needed to -obtain a reproducible distribution?. Ancient TL 26, 3-10. -} -\seealso{ -\link{plot}, \link{calc_CommonDose}, \link{calc_FiniteMixture}, -\link{calc_FuchsLang2001}, \link{calc_MinDose} -} -\author{ -Christoph Burow, University of Cologne (Germany) \cr -Based on a rewritten S script of Rex Galbraith, 2010 -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_CobbleDoseRate.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_CobbleDoseRate.Rd deleted file mode 100644 index 21772580d..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_CobbleDoseRate.Rd +++ /dev/null @@ -1,94 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_CobbleDoseRate.R -\name{calc_CobbleDoseRate} -\alias{calc_CobbleDoseRate} -\title{Calculate dose rate of slices in a spherical cobble} -\usage{ -calc_CobbleDoseRate(input, conversion = "Guerinetal2011") -} -\arguments{ -\item{input}{\link{data.frame} (\strong{required}): A table containing all relevant information -for each individual layer. For the table layout see details.} - -\item{conversion}{Which dose rate conversion factors to use. For accepted values see \link{BaseDataSet.ConversionFactors}} -} -\value{ -The function returns an \linkS4class{RLum.Results} object for which the first element -is a \link{matrix} (\code{DataIndividual}) that gives the dose rate results for each slice -for each decay chain individually, for both, the cobble dose rate and the sediment -dose rate. The second element is also a \link{matrix} (\code{DataComponent}) that gives -the total beta and gamma-dose rates for the cobble and the adjacent sediment -for each slice of the cobble. -} -\description{ -Calculates the dose rate profile through the cobble based on Riedesel and Autzen (2020). - -Corrects the beta dose rate in the cobble for the grain size following results -of Guérin et al. (2012). Sediment beta and gamma dose rates are corrected -for the water content of the sediment using the correction factors of Aitken (1985). -Water content in the cobble is assumed to be 0. -} -\details{ -\strong{The input table layout} - -\tabular{lll}{ -COLUMN \tab DATA TYPE \tab DESCRIPTION\cr -\code{Distance} \tab \code{numeric} \tab distance from the surface of the cobble to the top of each rock slice in mm. The distance for each slice will be listed in this column\cr -\code{DistanceError} \tab \code{numeric} \tab Error on the distance in mm\cr -\code{Thickness} \tab \code{numeric} \tab Thickness of each slice in mm\cr -\code{TicknessError} \tab \code{numeric} \tab uncertainty of the thickness in mm.\cr -\code{Mineral} \tab \code{character} \tab \code{'FS'} for feldspar, \code{'Q'} for quartz, depending which mineral in the cobble is used for dating\cr -\code{Cobble_K} \tab \code{numeric} \tab K nuclide content in \% of the bulk cobble\cr -\code{Cobble_K_SE} \tab \code{numeric} \tab error on K nuclide content in \% of the bulk cobble\cr -\code{Cobble_Th} \tab \code{numeric} \tab Th nuclide content in ppm of the bulk cobble\cr -\code{Cobble_Th_SE} \tab \code{numeric} \tab error on Th nuclide content in ppm of the bulk cobble\cr -\code{Cobble_U} \tab \code{numeric} \tab U nuclide content in ppm of the bulk cobble\cr -\code{CobbleU_SE} \tab \code{numeric} \tab error on U nuclide content in ppm of the bulk cobble\cr -\code{GrainSize} \tab \code{numeric} \tab average grain size in µm of the grains used for dating\cr -\code{Density} \tab \code{numeric} \tab Density of the cobble. Default is 2.7 g cm^-3\cr -\code{CobbleDiameter} \tab \code{numeric} \tab Diameter of the cobble in cm.\cr -\code{Sed_K} \tab \code{numeric} \tab K nuclide content in \% of the sediment matrix\cr -\code{Sed_K_SE} \tab \code{numeric} \tab error on K nuclide content in \% of the sediment matrix\cr -\code{Sed_Th} \tab \code{numeric} \tab Th nuclide content in ppm of the sediment matrix\cr -\code{Sed_Th_SE} \tab \code{numeric} \tab error on Th nuclide content in ppm of the sediment matrix\cr -\code{Sed_U} \tab \code{numeric} \tab U nuclide content in ppm of the sediment matrix\cr -\code{Sed_U_SE} \tab \code{numeric} \tab error on U nuclide content in ppm of the sediment matrix\cr -\code{GrainSize} \tab \code{numeric} \tab average grain size of the sediment matrix\cr -\code{WaterContent} \tab \code{numeric} \tab mean water content of the sediment matrix in \%\cr -\code{WaterContent_SE} \tab \code{numeric} \tab relative error on water content -} - -\strong{Water content} -The water content provided by the user should be calculated according to: - -\deqn{(Wet_weight - Dry_weight) / Dry_weight * 100} -} -\section{Function version}{ - 0.1.0 -} - -\examples{ -## load example data -data("ExampleData.CobbleData", envir = environment()) - -## run function -calc_CobbleDoseRate(ExampleData.CobbleData) - -} - -\section{How to cite}{ -Riedesel, S., Autzen, M., 2024. calc_CobbleDoseRate(): Calculate dose rate of slices in a spherical cobble. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Riedesel, S., Autzen, M., 2020. Beta and gamma dose rate attenuation in rocks and sediment. -Radiation Measurements 133, 106295. -} -\seealso{ -\link{convert_Concentration2DoseRate} -} -\author{ -Svenja Riedesel, Aberystwyth University (United Kingdom) \cr -Martin Autzen, DTU NUTECH Center for Nuclear Technologies (Denmark) -, RLum Developer Team} -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_CommonDose.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_CommonDose.Rd deleted file mode 100644 index 87647ea43..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_CommonDose.Rd +++ /dev/null @@ -1,113 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_CommonDose.R -\name{calc_CommonDose} -\alias{calc_CommonDose} -\title{Apply the (un-)logged common age model after Galbraith et al. (1999) to a -given De distribution} -\usage{ -calc_CommonDose(data, sigmab, log = TRUE, ...) -} -\arguments{ -\item{data}{\linkS4class{RLum.Results} or \link{data.frame} (\strong{required}): -for \link{data.frame}: two columns with De \code{(data[,1])} and De error \code{(data[,2])}} - -\item{sigmab}{\link{numeric} (\emph{with default}): -additional spread in De values. -This value represents the expected overdispersion in the data should the sample be -well-bleached (Cunningham & Walling 2012, p. 100). -\strong{NOTE}: For the logged model (\code{log = TRUE}) this value must be -a fraction, e.g. 0.2 (= 20 \\%). If the un-logged model is used (\code{log = FALSE}), -sigmab must be provided in the same absolute units of the De values (seconds or Gray).} - -\item{log}{\link{logical} (\emph{with default}): -fit the (un-)logged central age model to De data} - -\item{...}{currently not used.} -} -\value{ -Returns a terminal output. In addition an -\linkS4class{RLum.Results} object is returned containing the -following element: - -\item{.$summary}{\link{data.frame} summary of all relevant model results.} -\item{.$data}{\link{data.frame} original input data} -\item{.$args}{\link{list} used arguments} -\item{.$call}{\link{call} the function call} - -The output should be accessed using the function \link{get_RLum} -} -\description{ -Function to calculate the common dose of a De distribution. -} -\details{ -\strong{(Un-)logged model} - -When \code{log = TRUE} this function -calculates the weighted mean of logarithmic De values. Each of the estimates -is weighted by the inverse square of its relative standard error. The -weighted mean is then transformed back to the dose scale (Galbraith & -Roberts 2012, p. 14). - -The log transformation is not applicable if the -De estimates are close to zero or negative. In this case the un-logged model -can be applied instead (\code{log = FALSE}). The weighted mean is then -calculated using the un-logged estimates of De and their absolute standard -error (Galbraith & Roberts 2012, p. 14). -} -\section{Function version}{ - 0.1.1 -} - -\examples{ - -## load example data -data(ExampleData.DeValues, envir = environment()) - -## apply the common dose model -calc_CommonDose(ExampleData.DeValues$CA1) - -} - -\section{How to cite}{ -Burow, C., 2024. calc_CommonDose(): Apply the (un-)logged common age model after Galbraith et al. (1999) to a given De distribution. Function version 0.1.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Galbraith, R.F. & Laslett, G.M., 1993. Statistical models for -mixed fission track ages. Nuclear Tracks Radiation Measurements 4, 459-470. - -Galbraith, R.F., Roberts, R.G., Laslett, G.M., Yoshida, H. & Olley, -J.M., 1999. Optical dating of single grains of quartz from Jinmium rock -shelter, northern Australia. Part I: experimental design and statistical -models. Archaeometry 41, 339-364. - -Galbraith, R.F. & Roberts, R.G., 2012. Statistical aspects of equivalent dose and error calculation and -display in OSL dating: An overview and some recommendations. Quaternary -Geochronology 11, 1-27. - -\strong{Further reading} - -Arnold, L.J. & Roberts, R.G., 2009. Stochastic modelling of multi-grain equivalent dose -(De) distributions: Implications for OSL dating of sediment mixtures. -Quaternary Geochronology 4, 204-230. - -Bailey, R.M. & Arnold, L.J., 2006. Statistical modelling of single grain quartz De distributions and an -assessment of procedures for estimating burial dose. Quaternary Science -Reviews 25, 2475-2502. - -Cunningham, A.C. & Wallinga, J., 2012. Realizing the potential of fluvial archives using robust OSL chronologies. -Quaternary Geochronology 12, 98-106. - -Rodnight, H., Duller, G.A.T., Wintle, A.G. & Tooth, S., 2006. Assessing the reproducibility and accuracy -of optical dating of fluvial deposits. Quaternary Geochronology, 1 109-120. - -Rodnight, H., 2008. How many equivalent dose values are needed to -obtain a reproducible distribution?. Ancient TL 26, 3-10. -} -\seealso{ -\link{calc_CentralDose}, \link{calc_FiniteMixture}, -\link{calc_FuchsLang2001}, \link{calc_MinDose} -} -\author{ -Christoph Burow, University of Cologne (Germany) -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_CosmicDoseRate.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_CosmicDoseRate.Rd deleted file mode 100644 index 0c600baf1..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_CosmicDoseRate.Rd +++ /dev/null @@ -1,258 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_CosmicDoseRate.R -\name{calc_CosmicDoseRate} -\alias{calc_CosmicDoseRate} -\title{Calculate the cosmic dose rate} -\usage{ -calc_CosmicDoseRate( - depth, - density, - latitude, - longitude, - altitude, - corr.fieldChanges = FALSE, - est.age = NA, - half.depth = FALSE, - error = 10, - ... -) -} -\arguments{ -\item{depth}{\link{numeric} (\strong{required}): -depth of overburden (m). For more than one absorber use \cr -\code{c(depth_1, depth_2, ..., depth_n)}} - -\item{density}{\link{numeric} (\strong{required}): -average overburden density (g/cm^3). For more than one absorber use \cr -\code{c(density_1, density_2, ..., density_n)}} - -\item{latitude}{\link{numeric} (\strong{required}): -latitude (decimal degree), N positive} - -\item{longitude}{\link{numeric} (\strong{required}): -longitude (decimal degree), E positive} - -\item{altitude}{\link{numeric} (\strong{required}): -altitude (m above sea-level)} - -\item{corr.fieldChanges}{\link{logical} (\emph{with default}): -correct for geomagnetic field changes after Prescott & Hutton (1994). -Apply only when justified by the data.} - -\item{est.age}{\link{numeric} (\emph{with default}): -estimated age range (ka) for geomagnetic field change correction (0-80 ka allowed)} - -\item{half.depth}{\link{logical} (\emph{with default}): -How to overcome with varying overburden thickness. If \code{TRUE} only half the -depth is used for calculation. Apply only when justified, i.e. when a constant -sedimentation rate can safely be assumed.} - -\item{error}{\link{numeric} (\emph{with default}): -general error (percentage) to be implemented on corrected cosmic dose rate estimate} - -\item{...}{further arguments (\code{verbose} to disable/enable console output).} -} -\value{ -Returns a terminal output. In addition an -\linkS4class{RLum.Results}-object is returned containing the -following element: - -\item{summary}{\link{data.frame} summary of all relevant calculation results.} -\item{args}{\link{list} used arguments} -\item{call}{\link{call} the function call} - -The output should be accessed using the function \link{get_RLum} -} -\description{ -This function calculates the cosmic dose rate taking into account the soft- -and hard-component of the cosmic ray flux and allows corrections for -geomagnetic latitude, altitude above sea-level and geomagnetic field -changes. -} -\details{ -This function calculates the total cosmic dose rate considering both the -soft- and hard-component of the cosmic ray flux. - -\strong{Internal calculation steps} - -(1) -Calculate total depth of all absorber in hg/cm^2 (1 hg/cm^2 = 100 g/cm^2) - -\deqn{absorber = depth_1*density_1 + depth_2*density_2 + ... + depth_n*density_n} - -(2) -If \code{half.depth = TRUE} - -\deqn{absorber = absorber/2} - -(3) -Calculate cosmic dose rate at sea-level and 55 deg. latitude - -a) If absorber is > 167 g/cm^2 (only hard-component; Allkofer et al. 1975): -apply equation given by Prescott & Hutton (1994) (c.f. Barbouti & Rastin -1983) - -\deqn{D0 = C/(((absorber+d)^\alpha+a)*(absober+H))*exp(-B*absorber)} - -b) If absorber is < 167 g/cm^2 (soft- and hard-component): derive D0 from -Fig. 1 in Prescott & Hutton (1988). - -(4) -Calculate geomagnetic latitude (Prescott & Stephan 1982, Prescott & -Hutton 1994) - -\deqn{\lambda = arcsin(0.203*cos(latitude)*cos(longitude-291)+0.979* -sin(latitude))} - -(5) -Apply correction for geomagnetic latitude and altitude above sea-level. -Values for F, J and H were read from Fig. 3 shown in Prescott & Stephan -(1982) and fitted with 3-degree polynomials for lambda < 35 degree and a -linear fit for lambda > 35 degree. - -\deqn{Dc = D0*(F+J*exp((altitude/1000)/H))} - -(6) -Optional: Apply correction for geomagnetic field changes in the last -0-80 ka (Prescott & Hutton 1994). Correction and altitude factors are given -in Table 1 and Fig. 1 in Prescott & Hutton (1994). Values for altitude -factor were fitted with a 2-degree polynomial. The altitude factor is -operated on the decimal part of the correction factor. - -\deqn{Dc' = Dc*correctionFactor} - -\strong{Usage of \code{depth} and \code{density}} - -(1) If only one value for depth and density is provided, the cosmic dose -rate is calculated for exactly one sample and one absorber as overburden -(i.e. \code{depth*density}). - -(2) In some cases it might be useful to calculate the cosmic dose rate for a -sample that is overlain by more than one absorber, e.g. in a profile with -soil layers of different thickness and a distinct difference in density. -This can be calculated by providing a matching number of values for -\code{depth} and \code{density} (e.g. \verb{depth = c(1, 2), density = c(1.7, 2.4)}) - -(3) Another possibility is to calculate the cosmic dose rate for more than -one sample of the same profile. This is done by providing more than one -values for \code{depth} and only one for \code{density}. For example, -\code{depth = c(1, 2, 3)} and \code{density = 1.7} will calculate the cosmic dose rate -for three samples in 1, 2 and 3 m depth in a sediment of density 1.7 g/cm^3. -} -\note{ -Despite its universal use the equation to calculate the cosmic dose -rate provided by Prescott & Hutton (1994) is falsely stated to be valid from -the surface to 10^4 hg/cm^2 of standard rock. The original expression by -Barbouti & Rastin (1983) only considers the muon flux (i.e. hard-component) -and is by their own definition only valid for depths between 10-10^4 -hg/cm^2. - -Thus, for near-surface samples (i.e. for depths < 167 g/cm^2) the equation -of Prescott & Hutton (1994) underestimates the total cosmic dose rate, as it -neglects the influence of the soft-component of the cosmic ray flux. For -samples at zero depth and at sea-level the underestimation can be as large -as ~0.1 Gy/ka. In a previous article, Prescott & Hutton (1988) give another -approximation of Barbouti & Rastin's equation in the form of - -\deqn{D = 0.21*exp(-0.070*absorber+0.0005*absorber^2)} - -which is valid for depths between 150-5000 g/cm^2. For shallower depths (< -150 g/cm^2) they provided a graph (Fig. 1) from which the dose rate can be -read. - -As a result, this function employs the equation of Prescott & Hutton (1994) -only for depths > 167 g/cm^2, i.e. only for the hard-component of the cosmic -ray flux. Cosmic dose rate values for depths < 167 g/cm^2 were obtained from -the "AGE" program (Gruen 2009) and fitted with a 6-degree polynomial curve -(and hence reproduces the graph shown in Prescott & Hutton 1988). However, -these values assume an average overburden density of 2 g/cm^3. - -It is currently not possible to obtain more precise cosmic dose rate values -for near-surface samples as there is no equation known to the author of this -function at the time of writing. -} -\section{Function version}{ - 0.5.2 -} - -\examples{ - -##(1) calculate cosmic dose rate (one absorber) -calc_CosmicDoseRate(depth = 2.78, density = 1.7, - latitude = 38.06451, longitude = 1.49646, - altitude = 364, error = 10) - -##(2a) calculate cosmic dose rate (two absorber) -calc_CosmicDoseRate(depth = c(5.0, 2.78), density = c(2.65, 1.7), - latitude = 38.06451, longitude = 1.49646, - altitude = 364, error = 10) - -##(2b) calculate cosmic dose rate (two absorber) and -##correct for geomagnetic field changes -calc_CosmicDoseRate(depth = c(5.0, 2.78), density = c(2.65, 1.7), - latitude = 12.04332, longitude = 4.43243, - altitude = 364, corr.fieldChanges = TRUE, - est.age = 67, error = 15) - - -##(3) calculate cosmic dose rate and export results to .csv file -#calculate cosmic dose rate and save to variable -results<- calc_CosmicDoseRate(depth = 2.78, density = 1.7, - latitude = 38.06451, longitude = 1.49646, - altitude = 364, error = 10) - -# the results can be accessed by -get_RLum(results, "summary") - -#export results to .csv file - uncomment for usage -#write.csv(results, file = "c:/users/public/results.csv") - -##(4) calculate cosmic dose rate for 6 samples from the same profile -## and save to .csv file -#calculate cosmic dose rate and save to variable -results<- calc_CosmicDoseRate(depth = c(0.1, 0.5 , 2.1, 2.7, 4.2, 6.3), - density = 1.7, latitude = 38.06451, - longitude = 1.49646, altitude = 364, - error = 10) - -#export results to .csv file - uncomment for usage -#write.csv(results, file = "c:/users/public/results_profile.csv") - -} - -\section{How to cite}{ -Burow, C., 2024. calc_CosmicDoseRate(): Calculate the cosmic dose rate. Function version 0.5.2. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Allkofer, O.C., Carstensen, K., Dau, W.D., Jokisch, H., 1975. -Letter to the editor. The absolute cosmic ray flux at sea level. Journal of -Physics G: Nuclear and Particle Physics 1, L51-L52. - -Barbouti, A.I., Rastin, B.C., 1983. A study of the absolute intensity of muons at sea level -and under various thicknesses of absorber. Journal of Physics G: Nuclear and -Particle Physics 9, 1577-1595. - -Crookes, J.N., Rastin, B.C., 1972. An -investigation of the absolute intensity of muons at sea-level. Nuclear -Physics B 39, 493-508. - -Gruen, R., 2009. The "AGE" program for the -calculation of luminescence age estimates. Ancient TL 27, 45-46. - -Prescott, J.R., Hutton, J.T., 1988. Cosmic ray and gamma ray dosimetry for -TL and ESR. Nuclear Tracks and Radiation Measurements 14, 223-227. - -Prescott, J.R., Hutton, J.T., 1994. Cosmic ray contributions to dose rates -for luminescence and ESR dating: large depths and long-term time variations. -Radiation Measurements 23, 497-500. - -Prescott, J.R., Stephan, L.G., 1982. The contribution of cosmic radiation to the environmental dose for -thermoluminescence dating. Latitude, altitude and depth dependences. PACT 6, 17-25. -} -\seealso{ -\link{BaseDataSet.CosmicDoseRate} -} -\author{ -Christoph Burow, University of Cologne (Germany) -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_FadingCorr.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_FadingCorr.Rd deleted file mode 100644 index 02ee4ea0c..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_FadingCorr.Rd +++ /dev/null @@ -1,218 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_FadingCorr.R -\name{calc_FadingCorr} -\alias{calc_FadingCorr} -\title{Fading Correction after Huntley & Lamothe (2001)} -\usage{ -calc_FadingCorr( - age.faded, - g_value, - tc = NULL, - tc.g_value = tc, - n.MC = 10000, - seed = NULL, - interval = c(0.01, 500), - txtProgressBar = TRUE, - verbose = TRUE -) -} -\arguments{ -\item{age.faded}{\link{numeric} \link{vector} (\strong{required}): -uncorrected age with error in ka (see example)} - -\item{g_value}{\link{vector} (\strong{required}): -g-value and error obtained from separate fading measurements (see example). -Alternatively an \linkS4class{RLum.Results} object can be provided produced by the function -\link{analyse_FadingMeasurement}, in this case \code{tc} is set automatically} - -\item{tc}{\link{numeric} (\strong{required}): -time in seconds between irradiation and the prompt measurement (cf. Huntley & Lamothe 2001). -Argument will be ignored if \code{g_value} was an \linkS4class{RLum.Results} object} - -\item{tc.g_value}{\link{numeric} (\emph{with default}): -the time in seconds between irradiation and the prompt measurement used for estimating the g-value. -If the g-value was normalised to, e.g., 2 days, this time in seconds (i.e., 172800) should be given here. -If nothing is provided the time is set to tc, which is usual case for g-values obtained using the -SAR method and \eqn{g}-values that had been not normalised to 2 days.} - -\item{n.MC}{\link{integer} (\emph{with default}): -number of Monte Carlo simulation runs for error estimation. -If \code{n.MC = 'auto'} is used the function tries to find a 'stable' error for the age. -\strong{Note:} This may take a while!} - -\item{seed}{\link{integer} (\emph{optional}): -sets the seed for the random number generator in R using \link{set.seed}} - -\item{interval}{\link{numeric} (\emph{with default}): -a vector containing the end-points (age interval) of the interval to be searched for the root in 'ka'. -This argument is passed to the function \link[stats:uniroot]{stats::uniroot} used for solving the equation.} - -\item{txtProgressBar}{\link{logical} (\emph{with default}): -enables or disables \link{txtProgressBar}} - -\item{verbose}{\link{logical} (\emph{with default}): -enables or disables terminal output} -} -\value{ -Returns an S4 object of type \linkS4class{RLum.Results}.\cr - -Slot: \strong{\verb{@data}}\cr -\tabular{lll}{ -\strong{Object} \tab \strong{Type} \tab \strong{Comment} \cr -\code{age.corr} \tab \link{data.frame} \tab Corrected age \cr -\code{age.corr.MC} \tab \link{numeric} \tab MC simulation results with all possible ages from that simulation \cr -} - -Slot: \strong{\verb{@info}}\cr - -\tabular{lll}{ -\strong{Object} \tab \strong{Type} \tab \strong{Comment} \cr -\code{info} \tab \link{character} \tab the original function call -} -} -\description{ -Apply a fading correction according to Huntley & Lamothe (2001) for a given -\eqn{g}-value and a given \eqn{t_{c}} -} -\details{ -This function solves the equation used for correcting the fading affected age -including the error for a given \eqn{g}-value according to Huntley & Lamothe (2001): - -\deqn{ -\frac{A_{f}}{A} = 1 - \kappa * \Big[ln(\frac{A}{t_c}) - 1\Big] -} - -with \eqn{\kappa} defined as - -\deqn{ -\kappa = \frac{\frac{\mathrm{g\_value}}{ln(10)}}{100} -} - -\eqn{A} and \eqn{A_{f}} are given in ka. \eqn{t_c} is given in s, however, it -is internally recalculated to ka. - -As the \eqn{g}-value slightly depends on the time between irradiation and the -prompt measurement, this is \eqn{t_{c}}, always a \eqn{t_{c}} value needs to be provided. -If the \eqn{g}-value was normalised to a distinct -time or evaluated with a different tc value (e.g., external irradiation), also -the \eqn{t_{c}} value for the \eqn{g}-value needs to be provided (argument \code{tc.g_value} -and then the \eqn{g}-value is recalculated -to \eqn{t_{c}} of the measurement used for estimating the age applying the -following equation: - -\deqn{\kappa_{tc} = \kappa_{tc.g} / (1 - \kappa_{tc.g} * ln(tc/tc.g))} - -where - -\deqn{\kappa_{tc.g} = g / 100 / ln(10)} - -The error of the fading-corrected age is determined using a Monte Carlo -simulation approach. Solving of the equation is realised using -\link{uniroot}. Large values for \code{n.MC} will significantly -increase the computation time.\cr - -\strong{\code{n.MC = 'auto'}} - -The error estimation based on a stochastic process, i.e. for a small number of -MC runs the calculated error varies considerably every time the function is called, -even with the same input values. -The argument option \code{n.MC = 'auto'} tries to find a stable value for the standard error, i.e. -the standard deviation of values calculated during the MC runs (\code{age.corr.MC}), -within a given precision (2 digits) by increasing the number of MC runs stepwise and -calculating the corresponding error. - -If the determined error does not differ from the 9 values calculated previously -within a precision of (here) 3 digits the calculation is stopped as it is assumed -that the error is stable. Please note that (a) the duration depends on the input -values as well as on the provided computation resources and it may take a while, -(b) the length (size) of the output -vector \code{age.corr.MC}, where all the single values produced during the MC runs -are stored, equals the number of MC runs (here termed observations). - -To avoid an endless loop the calculation is stopped if the number of observations -exceeds 10^7. -This limitation can be overwritten by setting the number of MC runs manually, -e.g. \code{n.MC = 10000001}. Note: For this case the function is not checking whether the calculated -error is stable.\cr - -\strong{\code{seed}} - -This option allows to recreate previously calculated results by setting the seed -for the R random number generator (see \link{set.seed} for details). This option -should not be mixed up with the option \strong{\code{n.MC = 'auto'}}. The results may -appear similar, but they are not comparable!\cr - -\strong{FAQ}\cr - -\strong{Q}: Which \eqn{t_{c}} value is expected?\cr - -\strong{A}: \eqn{t_{c}} is the time in seconds between irradiation and the prompt measurement -applied during your \eqn{D_{e}} measurement. However, this \eqn{t_{c}} might -differ from the \eqn{t_{c}} used for estimating the \eqn{g}-value. In the -case of an SAR measurement \eqn{t_{c}} should be similar, however, -if it differs, you have to provide this -\eqn{t_{c}} value (the one used for estimating the \eqn{g}-value) using -the argument \code{tc.g_value}.\cr - -\strong{Q}: The function could not find a solution, what should I do?\cr - -\strong{A}: This usually happens for model parameters exceeding the boundaries of the -fading correction model (e.g., very high \eqn{g}-value). Please check -whether another fading correction model might be more appropriate. -} -\note{ -Special thanks to Sébastien Huot for his support and clarification via e-mail. -} -\section{Function version}{ - 0.4.3 -} - -\examples{ - -##run the examples given in the appendix of Huntley and Lamothe, 2001 - -##(1) faded age: 100 a -results <- calc_FadingCorr( - age.faded = c(0.1,0), - g_value = c(5.0, 1.0), - tc = 2592000, - tc.g_value = 172800, - n.MC = 100) - -##(2) faded age: 1 ka -results <- calc_FadingCorr( - age.faded = c(1,0), - g_value = c(5.0, 1.0), - tc = 2592000, - tc.g_value = 172800, - n.MC = 100) - -##(3) faded age: 10.0 ka -results <- calc_FadingCorr( - age.faded = c(10,0), - g_value = c(5.0, 1.0), - tc = 2592000, - tc.g_value = 172800, - n.MC = 100) - -##access the last output -get_RLum(results) - -} - -\section{How to cite}{ -Kreutzer, S., 2024. calc_FadingCorr(): Fading Correction after Huntley & Lamothe (2001). Function version 0.4.3. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Huntley, D.J., Lamothe, M., 2001. Ubiquity of anomalous fading -in K-feldspars and the measurement and correction for it in optical dating. -Canadian Journal of Earth Sciences, 38, 1093-1106. -} -\seealso{ -\linkS4class{RLum.Results}, \link{analyse_FadingMeasurement}, \link{get_RLum}, \link{uniroot} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_FastRatio.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_FastRatio.Rd deleted file mode 100644 index be7f6d3e6..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_FastRatio.Rd +++ /dev/null @@ -1,142 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_FastRatio.R -\name{calc_FastRatio} -\alias{calc_FastRatio} -\title{Calculate the Fast Ratio for CW-OSL curves} -\usage{ -calc_FastRatio( - object, - stimulation.power = 30.6, - wavelength = 470, - sigmaF = 2.6e-17, - sigmaM = 4.28e-18, - Ch_L1 = 1, - Ch_L2 = NULL, - Ch_L3 = NULL, - x = 1, - x2 = 0.1, - dead.channels = c(0, 0), - fitCW.sigma = FALSE, - fitCW.curve = FALSE, - plot = TRUE, - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum.Analysis}, \linkS4class{RLum.Data.Curve} or \link{data.frame} (\strong{required}): -x, y data of measured values (time and counts).} - -\item{stimulation.power}{\link{numeric} (\emph{with default}): -Stimulation power in mW/cm^2} - -\item{wavelength}{\link{numeric} (\emph{with default}): -Stimulation wavelength in nm} - -\item{sigmaF}{\link{numeric} (\emph{with default}): -Photoionisation cross-section (cm^2) of the fast component. -Default value after Durcan & Duller (2011).} - -\item{sigmaM}{\link{numeric} (\emph{with default}): -Photoionisation cross-section (cm^2) of the medium component. -Default value after Durcan & Duller (2011).} - -\item{Ch_L1}{\link{numeric} (\emph{with default}): -An integer specifying the channel for L1.} - -\item{Ch_L2}{\link{numeric} (\emph{optional}): -An integer specifying the channel for L2.} - -\item{Ch_L3}{\link{numeric} (\emph{optional}): -A vector of length 2 with integer values specifying the start and end -channels for L3 (e.g., \code{c(40, 50)}), with the second component greater -than or equal to the first. - -\\% of signal remaining from the fast component. -Used to define the location of L2 and L3 (start).} - -\item{x}{\link{numeric} (\emph{with default}):} - -\item{x2}{\link{numeric} (\emph{with default}): -\\% of signal remaining from the medium component. -Used to define the location of L3 (end).} - -\item{dead.channels}{\link{numeric} (\emph{with default}): -Vector of length 2 in the form of \code{c(x, y)}. -Channels that do not contain OSL data, i.e. at the start or end of measurement.} - -\item{fitCW.sigma}{\link{logical} (\emph{optional}): -fit CW-OSL curve using \link{fit_CWCurve} to calculate \code{sigmaF} and \code{sigmaM} (\strong{experimental}).} - -\item{fitCW.curve}{\link{logical} (\emph{optional}): -fit CW-OSL curve using \link{fit_CWCurve} and derive the counts of L2 and L3 -from the fitted OSL curve (\strong{experimental}).} - -\item{plot}{\link{logical} (\emph{with default}): -plot output (\code{TRUE}/\code{FALSE})} - -\item{...}{available options: \code{verbose} (\link{logical}). -Further arguments passed to \link{fit_CWCurve}.} -} -\value{ -Returns a plot (\emph{optional}) and an S4 object of type \linkS4class{RLum.Results}. -The slot \code{data} contains a \link{list} with the following elements: - -\item{summary}{\link{data.frame} summary of all relevant results} -\item{data}{the original input data} -\item{fit}{\linkS4class{RLum.Results} object if either \code{fitCW.sigma} or \code{fitCW.curve} is \code{TRUE}} -\item{args}{\link{list} of used arguments} -\item{call}{\verb{[call]} the function call} -} -\description{ -Function to calculate the fast ratio of quartz CW-OSL single grain or single -aliquot curves after Durcan & Duller (2011). -} -\details{ -This function follows the equations of Durcan & Duller (2011). The energy -required to reduce the fast and medium quartz OSL components to \code{x} and -\code{x2} \\% respectively using eq. 3 to determine channels L2 and L3 (start -and end). The fast ratio is then calculated from: \eqn{(L1-L3)/(L2-L3)}. -} -\section{Function version}{ - 0.1.1 -} - -\examples{ -# load example CW-OSL curve -data("ExampleData.CW_OSL_Curve") - -# calculate the fast ratio w/o further adjustments -res <- calc_FastRatio(ExampleData.CW_OSL_Curve) - -# show the summary table -get_RLum(res) - -} - -\section{How to cite}{ -King, G.E., Durcan, J., Burow, C., 2024. calc_FastRatio(): Calculate the Fast Ratio for CW-OSL curves. Function version 0.1.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Durcan, J.A. & Duller, G.A.T., 2011. The fast ratio: A rapid measure for testing -the dominance of the fast component in the initial OSL signal from quartz. -Radiation Measurements 46, 1065-1072. - -Madsen, A.T., Duller, G.A.T., Donnelly, J.P., Roberts, H.M. & Wintle, A.G., 2009. -A chronology of hurricane landfalls at Little Sippewissett Marsh, Massachusetts, USA, -using optical dating. Geomorphology 109, 36-45. - -\strong{Further reading} - -Steffen, D., Preusser, F. & Schlunegger, 2009. OSL quartz age underestimation -due to unstable signal components. Quaternary Geochronology 4, 353-362. -} -\seealso{ -\link{fit_CWCurve}, \link{get_RLum}, \linkS4class{RLum.Analysis}, -\linkS4class{RLum.Results}, \linkS4class{RLum.Data.Curve} -} -\author{ -Georgina E. King, University of Bern (Switzerland) \cr -Julie A. Durcan, University of Oxford (United Kingdom) \cr -Christoph Burow, University of Cologne (Germany) -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_FiniteMixture.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_FiniteMixture.Rd deleted file mode 100644 index 117dddd8e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_FiniteMixture.Rd +++ /dev/null @@ -1,212 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_FiniteMixture.R -\name{calc_FiniteMixture} -\alias{calc_FiniteMixture} -\title{Apply the finite mixture model (FMM) after Galbraith (2005) to a given De -distribution} -\usage{ -calc_FiniteMixture( - data, - sigmab, - n.components, - grain.probability = FALSE, - dose.scale, - pdf.weight = TRUE, - pdf.sigma = "sigmab", - pdf.colors = "gray", - pdf.scale, - plot.proportions = TRUE, - plot = TRUE, - ... -) -} -\arguments{ -\item{data}{\linkS4class{RLum.Results} or \link{data.frame} (\strong{required}): -for \link{data.frame}: two columns with De \code{(data[,1])} and De error \code{(values[,2])}} - -\item{sigmab}{\link{numeric} (\strong{required}): -spread in De values given as a fraction (e.g. 0.2). This value represents the expected -overdispersion in the data should the sample be well-bleached -(Cunningham & Wallinga 2012, p. 100).} - -\item{n.components}{\link{numeric} (\strong{required}): -number of components to be fitted. If a vector is provided (e.g. \code{c(2:8)}) the -finite mixtures for 2, 3 ... 8 components are calculated and a plot and a -statistical evaluation of the model performance (BIC score and maximum -log-likelihood) is provided.} - -\item{grain.probability}{\link{logical} (\emph{with default}): -prints the estimated probabilities of which component each grain is in} - -\item{dose.scale}{\link{numeric}: -manually set the scaling of the y-axis of the first plot with a vector -in the form of \code{c(min, max)}} - -\item{pdf.weight}{\link{logical} (\emph{with default}): -weight the probability density functions by the components proportion (applies only -when a vector is provided for \code{n.components})} - -\item{pdf.sigma}{\link{character} (\emph{with default}): -if \code{"sigmab"} the components normal distributions are plotted with a common standard -deviation (i.e. \code{sigmab}) as assumed by the FFM. Alternatively, -\code{"se"} takes the standard error of each component for the sigma -parameter of the normal distribution} - -\item{pdf.colors}{\link{character} (\emph{with default}): -colour coding of the components in the the plot. -Possible options are \code{"gray"}, \code{"colors"} and \code{"none"}} - -\item{pdf.scale}{\link{numeric}: -manually set the max density value for proper scaling of the x-axis of the first plot} - -\item{plot.proportions}{\link{logical} (\emph{with default}): -plot \link[graphics:barplot]{graphics::barplot} showing the proportions of components if -\code{n.components} a vector with a length > 1 (e.g., \code{n.components = c(2:3)})} - -\item{plot}{\link{logical} (\emph{with default}): plot output} - -\item{...}{further arguments to pass. See details for their usage.} -} -\value{ -Returns a plot (\emph{optional}) and terminal output. In addition an -\linkS4class{RLum.Results} object is returned containing the -following elements: - -\item{.$summary}{\link{data.frame} summary of all relevant model results.} -\item{.$data}{\link{data.frame} original input data} -\item{.$args}{\link{list} used arguments} -\item{.$call}{\link{call} the function call} -\item{.$mle}{ covariance matrices of the log likelihoods} -\item{.$BIC}{ BIC score} -\item{.$llik}{ maximum log likelihood} -\item{.$grain.probability}{ probabilities of a grain belonging to a component} -\item{.$components}{\link{matrix} estimates of the de, de error and proportion for each component} -\item{.$single.comp}{\link{data.frame} single component FFM estimate} - -If a vector for \code{n.components} is provided (e.g. \code{c(2:8)}), -\code{mle} and \code{grain.probability} are lists containing matrices of the -results for each iteration of the model. - -The output should be accessed using the function \link{get_RLum} -} -\description{ -This function fits a k-component mixture to a De distribution with differing -known standard errors. Parameters (doses and mixing proportions) are -estimated by maximum likelihood assuming that the log dose estimates are -from a mixture of normal distributions. -} -\details{ -This model uses the maximum likelihood and Bayesian Information Criterion -(BIC) approaches. - -Indications of overfitting are: -\itemize{ -\item increasing BIC -\item repeated dose estimates -\item covariance matrix not positive definite -\item covariance matrix produces \code{NaN} -\item convergence problems -} - -\strong{Plot} - -If a vector (\code{c(k.min:k.max)}) is provided -for \code{n.components} a plot is generated showing the the k components -equivalent doses as normal distributions. By default \code{pdf.weight} is -set to \code{FALSE}, so that the area under each normal distribution is -always 1. If \code{TRUE}, the probability density functions are weighted by -the components proportion for each iteration of k components, so the sum of -areas of each component equals 1. While the density values are on the same -scale when no weights are used, the y-axis are individually scaled if the -probability density are weighted by the components proportion.\cr -The standard deviation (sigma) of the normal distributions is by default -determined by a common \code{sigmab} (see \code{pdf.sigma}). For -\code{pdf.sigma = "se"} the standard error of each component is taken -instead.\cr -The stacked \link[graphics:barplot]{graphics::barplot} shows the proportion of each component (in -per cent) calculated by the FFM. The last plot shows the achieved BIC scores -and maximum log-likelihood estimates for each iteration of k. -} -\section{Function version}{ - 0.4.2 -} - -\examples{ - -## load example data -data(ExampleData.DeValues, envir = environment()) - -## (1) apply the finite mixture model -## NOTE: the data set is not suitable for the finite mixture model, -## which is why a very small sigmab is necessary -calc_FiniteMixture(ExampleData.DeValues$CA1, - sigmab = 0.2, n.components = 2, - grain.probability = TRUE) - -## (2) repeat the finite mixture model for 2, 3 and 4 maximum number of fitted -## components and save results -## NOTE: The following example is computationally intensive. Please un-comment -## the following lines to make the example work. -FMM<- calc_FiniteMixture(ExampleData.DeValues$CA1, - sigmab = 0.2, n.components = c(2:4), - pdf.weight = TRUE, dose.scale = c(0, 100)) - -## show structure of the results -FMM - -## show the results on equivalent dose, standard error and proportion of -## fitted components -get_RLum(object = FMM, data.object = "components") - -} - -\section{How to cite}{ -Burow, C., 2024. calc_FiniteMixture(): Apply the finite mixture model (FMM) after Galbraith (2005) to a given De distribution. Function version 0.4.2. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Galbraith, R.F. & Green, P.F., 1990. Estimating the component -ages in a finite mixture. Nuclear Tracks and Radiation Measurements 17, -197-206. - -Galbraith, R.F. & Laslett, G.M., 1993. Statistical models -for mixed fission track ages. Nuclear Tracks Radiation Measurements 4, -459-470. - -Galbraith, R.F. & Roberts, R.G., 2012. Statistical aspects of -equivalent dose and error calculation and display in OSL dating: An overview -and some recommendations. Quaternary Geochronology 11, 1-27. - -Roberts, R.G., Galbraith, R.F., Yoshida, H., Laslett, G.M. & Olley, J.M., 2000. -Distinguishing dose populations in sediment mixtures: a test of single-grain -optical dating procedures using mixtures of laboratory-dosed quartz. -Radiation Measurements 32, 459-465. - -Galbraith, R.F., 2005. Statistics for Fission Track Analysis, Chapman & Hall/CRC, Boca Raton. - -\strong{Further reading} - -Arnold, L.J. & Roberts, R.G., 2009. Stochastic -modelling of multi-grain equivalent dose (De) distributions: Implications -for OSL dating of sediment mixtures. Quaternary Geochronology 4, -204-230. - -Cunningham, A.C. & Wallinga, J., 2012. Realizing the -potential of fluvial archives using robust OSL chronologies. Quaternary -Geochronology 12, 98-106. - -Rodnight, H., Duller, G.A.T., Wintle, A.G. & -Tooth, S., 2006. Assessing the reproducibility and accuracy of optical -dating of fluvial deposits. Quaternary Geochronology 1, 109-120. - -Rodnight, H. 2008. How many equivalent dose values are needed to obtain a -reproducible distribution?. Ancient TL 26, 3-10. -} -\seealso{ -\link{calc_CentralDose}, \link{calc_CommonDose}, -\link{calc_FuchsLang2001}, \link{calc_MinDose} -} -\author{ -Christoph Burow, University of Cologne (Germany) \cr -Based on a rewritten S script of Rex Galbraith, 2006. -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_FuchsLang2001.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_FuchsLang2001.Rd deleted file mode 100644 index 9a5a91836..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_FuchsLang2001.Rd +++ /dev/null @@ -1,96 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_FuchsLang2001.R -\name{calc_FuchsLang2001} -\alias{calc_FuchsLang2001} -\title{Apply the model after Fuchs & Lang (2001) to a given De distribution.} -\usage{ -calc_FuchsLang2001(data, cvThreshold = 5, startDeValue = 1, plot = TRUE, ...) -} -\arguments{ -\item{data}{\linkS4class{RLum.Results} or \link{data.frame} (\strong{required}): -for \link{data.frame}: two columns with De \code{(data[,1])} and De error \code{(values[,2])}} - -\item{cvThreshold}{\link{numeric} (\emph{with default}): -coefficient of variation in percent, as threshold for the method, -e.g. \code{cvThreshold = 3}. See details -.} - -\item{startDeValue}{\link{numeric} (\emph{with default}): -number of the first aliquot that is used for the calculations} - -\item{plot}{\link{logical} (\emph{with default}): -plot output \code{TRUE}/\code{FALSE}} - -\item{...}{further arguments and graphical parameters passed to \link{plot}} -} -\value{ -Returns a plot (\emph{optional}) and terminal output. In addition an -\linkS4class{RLum.Results} object is returned containing the -following elements: - -\item{summary}{\link{data.frame} summary of all relevant model results.} -\item{data}{\link{data.frame} original input data} -\item{args}{\link{list} used arguments} -\item{call}{\link{call} the function call} -\item{usedDeValues}{\link{data.frame} containing the used values for the calculation} -} -\description{ -This function applies the method according to Fuchs & Lang (2001) for -heterogeneously bleached samples with a given coefficient of variation -threshold. -} -\details{ -\strong{Used values} - -If the coefficient of variation (\code{c[v]}) of the first -two values is larger than the threshold \code{c[v_threshold]}, the first value is -skipped. Use the \code{startDeValue} argument to define a start value for -calculation (e.g. 2nd or 3rd value). - -\strong{Basic steps of the approach} -\enumerate{ -\item Estimate natural relative variation of the sample using a dose recovery test -\item Sort the input values in ascending order -\item Calculate a running mean, starting with the lowermost two values and add values iteratively. -\item Stop if the calculated \code{c[v]} exceeds the specified \code{cvThreshold} -} -} -\note{ -Please consider the requirements and the constraints of this method -(see Fuchs & Lang, 2001) -} -\section{Function version}{ - 0.4.1 -} - -\examples{ -## load example data -data(ExampleData.DeValues, envir = environment()) - -## calculate De according to Fuchs & Lang (2001) -temp<- calc_FuchsLang2001(ExampleData.DeValues$BT998, cvThreshold = 5) - -} - -\section{How to cite}{ -Kreutzer, S., Burow, C., 2024. calc_FuchsLang2001(): Apply the model after Fuchs & Lang (2001) to a given De distribution.. Function version 0.4.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Fuchs, M. & Lang, A., 2001. OSL dating of coarse-grain fluvial -quartz using single-aliquot protocols on sediments from NE Peloponnese, -Greece. In: Quaternary Science Reviews 20, 783-787. - -Fuchs, M. & Wagner, G.A., 2003. Recognition of insufficient bleaching by -small aliquots of quartz for reconstructing soil erosion in Greece. -Quaternary Science Reviews 22, 1161-1167. -} -\seealso{ -\link{plot}, \link{calc_MinDose}, \link{calc_FiniteMixture}, \link{calc_CentralDose}, -\link{calc_CommonDose}, \linkS4class{RLum.Results} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) \cr -Christoph Burow, University of Cologne (Germany) -, RLum Developer Team} -\keyword{dplot} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_HomogeneityTest.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_HomogeneityTest.Rd deleted file mode 100644 index b47f6e2af..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_HomogeneityTest.Rd +++ /dev/null @@ -1,73 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_HomogeneityTest.R -\name{calc_HomogeneityTest} -\alias{calc_HomogeneityTest} -\title{Apply a simple homogeneity test after Galbraith (2003)} -\usage{ -calc_HomogeneityTest(data, log = TRUE, ...) -} -\arguments{ -\item{data}{\linkS4class{RLum.Results} or \link{data.frame} (\strong{required}): -for \link{data.frame}: two columns with De \code{(data[,1])} and De error \code{(values[,2])}} - -\item{log}{\link{logical} (\emph{with default}): -perform the homogeneity test with (un-)logged data} - -\item{...}{further arguments (for internal compatibility only).} -} -\value{ -Returns a terminal output. In addition an -\linkS4class{RLum.Results}-object is returned containing the -following elements: - -\item{summary}{\link{data.frame} summary of all relevant model results.} -\item{data}{\link{data.frame} original input data} -\item{args}{\link{list} used arguments} -\item{call}{\link{call} the function call} - -The output should be accessed using the function \link{get_RLum} -} -\description{ -A simple homogeneity test for De estimates -} -\details{ -For details see Galbraith (2003). -} -\section{Function version}{ - 0.3.0 -} - -\examples{ - -## load example data -data(ExampleData.DeValues, envir = environment()) - -## apply the homogeneity test -calc_HomogeneityTest(ExampleData.DeValues$BT998) - -## using the data presented by Galbraith (2003) -df <- - data.frame( - x = c(30.1, 53.8, 54.3, 29.0, 47.6, 44.2, 43.1), - y = c(4.8, 7.1, 6.8, 4.3, 5.2, 5.9, 3.0)) - -calc_HomogeneityTest(df) - - -} - -\section{How to cite}{ -Burow, C., Kreutzer, S., 2024. calc_HomogeneityTest(): Apply a simple homogeneity test after Galbraith (2003). Function version 0.3.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Galbraith, R.F., 2003. A simple homogeneity test for estimates -of dose obtained using OSL. Ancient TL 21, 75-77. -} -\seealso{ -\link{pchisq} -} -\author{ -Christoph Burow, University of Cologne (Germany), Sebastian Kreutzer, -IRAMAT-CRP2A, Université Bordeaux Montaigne (France) -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_Huntley2006.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_Huntley2006.Rd deleted file mode 100644 index a310bc27a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_Huntley2006.Rd +++ /dev/null @@ -1,312 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_Huntley2006.R -\name{calc_Huntley2006} -\alias{calc_Huntley2006} -\title{Apply the Huntley (2006) model} -\usage{ -calc_Huntley2006( - data, - LnTn = NULL, - rhop, - ddot, - readerDdot, - normalise = TRUE, - fit.method = c("EXP", "GOK"), - lower.bounds = c(-Inf, -Inf, -Inf, -Inf), - summary = TRUE, - plot = TRUE, - ... -) -} -\arguments{ -\item{data}{\link{data.frame} (\strong{required}): -A \code{data.frame} with one of the following structures: -\itemize{ -\item A \strong{three column} data frame with numeric values on a) dose (s), b) \code{LxTx} and -c) \code{LxTx} error. -\item If a \strong{two column} data frame is provided it is automatically -assumed that errors on \code{LxTx} are missing. A third column will be attached -with an arbitrary 5 \\% error on the provided \code{LxTx} values. -\item Can also be a \strong{wide table}, i.e. a \link{data.frame} with a number of columns divisible by 3 -and where each triplet has the aforementioned column structure. -} - -\if{html}{\out{
}}\preformatted{ (optional) - | dose (s)| LxTx | LxTx error | - | [ ,1] | [ ,2]| [ ,3] | - |---------|------|------------| -[1, ]| 0 | LnTn | LnTn error | (optional, see arg 'LnTn') -[2, ]| R1 | L1T1 | L1T1 error | - ... | ... | ... | ... | -[x, ]| Rx | LxTx | LxTx error | - -}\if{html}{\out{
}} - -\strong{NOTE:} The function assumes the first row of the function to be the -\code{Ln/Tn}-value. If you want to provide more than one \code{Ln/Tn}-value consider -using the argument \code{LnTn}.} - -\item{LnTn}{\link{data.frame} (\strong{optional}): -This argument should \strong{only} be used to provide more than one \code{Ln/Tn}-value. -It assumes a two column data frame with the following structure: - -\if{html}{\out{
}}\preformatted{ | LnTn | LnTn error | - | [ ,1] | [ ,2] | - |--------|--------------| -[1, ]| LnTn_1 | LnTn_1 error | -[2, ]| LnTn_2 | LnTn_2 error | - ... | ... | ... | -[x, ]| LnTn_x | LnTn_x error | -}\if{html}{\out{
}} - -The function will calculate a \strong{mean} \code{Ln/Tn}-value and uses either the -standard deviation or the highest individual error, whichever is larger. If -another mean value (e.g. a weighted mean or median) or error is preferred, -this value must be calculated beforehand and used in the first row in the -data frame for argument \code{data}. - -\strong{NOTE:} If you provide \code{LnTn}-values with this argument the data frame -for the \code{data}-argument \strong{must not} contain any \code{LnTn}-values!} - -\item{rhop}{\link{numeric} (\strong{required}): -The density of recombination centres (\eqn{\rho}') and its error (see Huntley 2006), -given as numeric vector of length two. Note that \eqn{\rho}' must \strong{not} be -provided as the common logarithm. Example: \code{rhop = c(2.92e-06, 4.93e-07)}.} - -\item{ddot}{\link{numeric} (\strong{required}): -Environmental dose rate and its error, given as a numeric vector of length two. -Expected unit: Gy/ka. Example: \code{ddot = c(3.7, 0.4)}.} - -\item{readerDdot}{\link{numeric} (\strong{required}): -Dose rate of the irradiation source of the OSL reader and its error, -given as a numeric vector of length two. -Expected unit: Gy/s. Example: \code{readerDdot = c(0.08, 0.01)}.} - -\item{normalise}{\link{logical} (\emph{with default}): If \code{TRUE} (the default) all measured and computed \eqn{\frac{L_x}{T_x}} values are normalised by the pre-exponential factor \code{A} (see details).} - -\item{fit.method}{\link{character} (\emph{with default}): -Fit function of the dose response curve. Can either be \code{EXP} (the default) -or \code{GOK}. Note that \code{EXP} (single saturating exponential) is the original -function the model after Huntley (2006) and Kars et al. (2008) was -designed to use. The use of a general-order kinetics function (\code{GOK}) -is an experimental adaptation of the model and should be used -with great care.} - -\item{lower.bounds}{\link{numeric} (\emph{with default}): -Only applicable for \code{fit.method = 'GOK'}. A vector of length 3 that -contains the lower bound values for fitting the general-order kinetics -function using \link[minpack.lm:nlsLM]{minpack.lm::nlsLM}. In most cases, the default values -(c(\verb{-Inf, -Inf, -Inf})) are appropriate for finding a best fit, but -sometimes it may be useful to restrict the lower bounds to e.g. -c(\verb{0, 0, 0}). The values of the vector are for parameters -\code{a}, \code{D0} and \code{c} in that particular order (see details in -\link{plot_GrowthCurve}).} - -\item{summary}{\link{logical} (\emph{with default}): -If \code{TRUE} (the default) various parameters provided by the user -and calculated by the model are added as text on the right-hand side of the -plot.} - -\item{plot}{\link{logical} (\emph{with default}): -enables/disables plot output.} - -\item{...}{Further parameters: -\itemize{ -\item \code{verbose} \link{logical}: Show or hide console output -\item \code{n.MC} \link{numeric}: Number of Monte Carlo iterations (default = \code{100000}). -\strong{Note} that it is generally advised to have a large number of Monte Carlo -iterations for the results to converge. Decreasing the number of iterations -will often result in unstable estimates. -} - -All other arguments are passed to \link{plot} and \link{plot_GrowthCurve} (in particular -\code{mode} for the fit mode and \code{fit.force_through_origin})} -} -\value{ -An \linkS4class{RLum.Results} object is returned: - -Slot: \strong{@data}\cr - -\tabular{lll}{ -\strong{OBJECT} \tab \strong{TYPE} \tab \strong{COMMENT}\cr -\code{results} \tab \link{data.frame} \tab results of the of Kars et al. 2008 model \cr -\code{data} \tab \link{data.frame} \tab original input data \cr -\code{Ln} \tab \link{numeric} \tab Ln and its error \cr -\code{LxTx_tables} \tab \code{list} \tab A \code{list} of \code{data.frames} containing data on dose, -LxTx and LxTx error for each of the dose response curves. -Note that these \strong{do not} contain the natural Ln signal, which is provided separately. \cr -\code{fits} \tab \code{list} \tab A \code{list} of \code{nls} objects produced by \link[minpack.lm:nlsLM]{minpack.lm::nlsLM} when fitting the dose response curves \cr -} - -Slot: \strong{@info}\cr - -\tabular{lll}{ -\strong{OBJECT} \tab \strong{TYPE} \tab \strong{COMMENT} \cr -\code{call} \tab \code{call} \tab the original function call \cr -\code{args} \tab \code{list} \tab arguments of the original function call \cr -} -} -\description{ -A function to calculate the expected sample specific fraction of saturation -based on the model of Huntley (2006) using the approach as implemented -in Kars et al. (2008) or Guralnik et al. (2015). -} -\details{ -This function applies the approach described in Kars et al. (2008) or Guralnik et al. (2015), -which are both developed from the model of Huntley (2006) to calculate the expected sample -specific fraction of saturation of a feldspar and also to calculate fading -corrected age using this model. \eqn{\rho}' (\code{rhop}), the density of recombination -centres, is a crucial parameter of this model and must be determined -separately from a fading measurement. The function \link{analyse_FadingMeasurement} -can be used to calculate the sample specific \eqn{\rho}' value. - -\strong{Kars et al. (2008) - Single saturating exponential} - -To apply the approach after Kars et al. (2008) use \code{fit.method = "EXP"}. - -Firstly, the unfaded \eqn{D_0} value is determined through applying equation 5 of -Kars et al. (2008) to the measured \eqn{\frac{L_x}{T_x}} data as a function of irradiation -time, and fitting the data with a single saturating exponential of the form: - -\deqn{\frac{L_x}{T_x}(t^*) = A \phi(t^*) \{1 - exp(-\frac{t^*}{D_0}))\}} - -where - -\deqn{\phi(t^*) = exp(-\rho' ln(1.8 \tilde{s} t^*)^3)} - -after King et al. (2016) where \eqn{A} is a pre-exponential factor, -\eqn{t^*} (s) is the irradiation time, starting at the mid-point of -irradiation (Auclair et al. 2003) and \eqn{\tilde{s}} (\eqn{3\times10^{15}} s\eqn{^{-1}}) is the athermal frequency factor after Huntley (2006). \cr - -Using fit parameters \eqn{A} and \eqn{D_0}, the function then computes a natural dose -response curve using the environmental dose rate, \eqn{\dot{D}} (Gy/s) and equations -\verb{[1]} and \verb{[2]}. Computed \eqn{\frac{L_x}{T_x}} values are then fitted using the -\link{plot_GrowthCurve} function and the laboratory measured LnTn can then -be interpolated onto this curve to determine the fading corrected -\eqn{D_e} value, from which the fading corrected age is calculated. - -\strong{Guralnik et al. (2015) - General-order kinetics} - -To apply the approach after Guralnik et al. (2015) use \code{fit.method = "GOK"}. - -The approach of Guralnik et al. (2015) is very similar to that of -Kars et al. (2008), but instead of using a single saturating exponential -the model fits a general-order kinetics function of the form: - -\deqn{\frac{L_x}{T_x}(t^*) = A \phi (t^*)(1 - (1 + (\frac{1}{D_0}) t^* c)^{-1/c})} - -where \eqn{A}, \eqn{\phi}, \eqn{t^*} and \eqn{D_0} are the same as above and \eqn{c} is a -dimensionless kinetic order modifier (cf. equation 10 in -Guralnik et al., 2015). - -\strong{Level of saturation} - -The \link{calc_Huntley2006} function also calculates the level of saturation (\eqn{\frac{n}{N}}) -and the field saturation (i.e. athermal steady state, (n/N)_SS) value for -the sample under investigation using the sample specific \eqn{\rho}', -unfaded \eqn{D_0} and \eqn{\dot{D}} values, following the approach of Kars et al. (2008). - -\strong{Uncertainties} - -Uncertainties are reported at \eqn{1\sigma} and are assumed to be normally -distributed and are estimated using Monte-Carlo re-sampling (\code{n.MC = 1000}) -of \eqn{\rho}' and \eqn{\frac{L_x}{T_x}} during dose response curve fitting, and of \eqn{\rho}' -in the derivation of (\eqn{n/N}) and (n/N)_SS. - -\strong{Age calculated from 2D0 of the simulated natural DRC} - -In addition to the age calculated from the equivalent dose derived from -\eqn{\frac{L_n}{T_n}} projected on the simulated natural dose response curve (DRC), this function -also calculates an age from twice the characteristic saturation dose (\code{D0}) -of the simulated natural DRC. This can be a useful information for -(over)saturated samples (i.e., no intersect of \eqn{\frac{L_n}{T_n}} on the natural DRC) -to obtain at least a "minimum age" estimate of the sample. In the console -output this value is denoted by \emph{"Age @2D0 (ka):"}. -} -\note{ -This function has BETA status, in particular for the GOK implementation. Please verify -your results carefully -} -\section{Function version}{ - 0.4.5 -} - -\examples{ - -## Load example data (sample UNIL/NB123, see ?ExampleData.Fading) -data("ExampleData.Fading", envir = environment()) - -## (1) Set all relevant parameters -# a. fading measurement data (IR50) -fading_data <- ExampleData.Fading$fading.data$IR50 - -# b. Dose response curve data -data <- ExampleData.Fading$equivalentDose.data$IR50 - -## (2) Define required function parameters -ddot <- c(7.00, 0.004) -readerDdot <- c(0.134, 0.0067) - -# Analyse fading measurement and get an estimate of rho'. -# Note that the RLum.Results object can be directly used for further processing. -# The number of MC runs is reduced for this example -rhop <- analyse_FadingMeasurement(fading_data, plot = TRUE, verbose = FALSE, n.MC = 10) - -## (3) Apply the Kars et al. (2008) model to the data -kars <- calc_Huntley2006( - data = data, - rhop = rhop, - ddot = ddot, - readerDdot = readerDdot, - n.MC = 25) - - -\dontrun{ -# You can also provide LnTn values separately via the 'LnTn' argument. -# Note, however, that the data frame for 'data' must then NOT contain -# a LnTn value. See argument descriptions! -LnTn <- data.frame( - LnTn = c(1.84833, 2.24833), - nTn.error = c(0.17, 0.22)) - -LxTx <- data[2:nrow(data), ] - -kars <- calc_Huntley2006( - data = LxTx, - LnTn = LnTn, - rhop = rhop, - ddot = ddot, - readerDdot = readerDdot, - n.MC = 25) -} -} - -\section{How to cite}{ -King, G.E., Burow, C., Kreutzer, S., 2024. calc_Huntley2006(): Apply the Huntley (2006) model. Function version 0.4.5. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Kars, R.H., Wallinga, J., Cohen, K.M., 2008. A new approach towards anomalous fading correction for feldspar -IRSL dating-tests on samples in field saturation. Radiation Measurements 43, 786-790. doi:10.1016/j.radmeas.2008.01.021 - -Guralnik, B., Li, B., Jain, M., Chen, R., Paris, R.B., Murray, A.S., Li, S.-H., Pagonis, P., -Herman, F., 2015. Radiation-induced growth and isothermal decay of infrared-stimulated luminescence -from feldspar. Radiation Measurements 81, 224-231. - -Huntley, D.J., 2006. An explanation of the power-law decay of luminescence. -Journal of Physics: Condensed Matter 18, 1359-1365. doi:10.1088/0953-8984/18/4/020 - -King, G.E., Herman, F., Lambert, R., Valla, P.G., Guralnik, B., 2016. -Multi-OSL-thermochronometry of feldspar. Quaternary Geochronology 33, 76-87. doi:10.1016/j.quageo.2016.01.004 - -\strong{Further reading} - -Morthekai, P., Jain, M., Cunha, P.P., Azevedo, J.M., Singhvi, A.K., 2011. An attempt to correct -for the fading in million year old basaltic rocks. Geochronometria 38(3), 223-230. -} -\author{ -Georgina E. King, University of Lausanne (Switzerland) \cr -Christoph Burow, University of Cologne (Germany) \cr -Sebastian Kreutzer, Ruprecht-Karl University of Heidelberg (Germany) -, RLum Developer Team} -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_IEU.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_IEU.Rd deleted file mode 100644 index f8926a864..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_IEU.Rd +++ /dev/null @@ -1,86 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_IEU.R -\name{calc_IEU} -\alias{calc_IEU} -\title{Apply the internal-external-uncertainty (IEU) model after Thomsen et al. -(2007) to a given De distribution} -\usage{ -calc_IEU(data, a, b, interval, decimal.point = 2, plot = TRUE, ...) -} -\arguments{ -\item{data}{\linkS4class{RLum.Results} or \link{data.frame} (\strong{required}): -for \link{data.frame}: two columns with De \code{(data[,1])} and -De error \code{(values[,2])}} - -\item{a}{\link{numeric} (\strong{required}): -slope} - -\item{b}{\link{numeric} (\strong{required}): -intercept} - -\item{interval}{\link{numeric} (\strong{required}): -fixed interval (e.g. 5 Gy) used for iteration of \code{Dbar}, from the mean to -Lowest.De used to create Graph.IEU \verb{[Dbar.Fixed vs Z]}} - -\item{decimal.point}{\link{numeric} (\emph{with default}): -number of decimal points for rounding calculations (e.g. 2)} - -\item{plot}{\link{logical} (\emph{with default}): -plot output} - -\item{...}{further arguments (\verb{trace, verbose}).} -} -\value{ -Returns a plot (\emph{optional}) and terminal output. In addition an -\linkS4class{RLum.Results} object is returned containing the -following elements: - -\item{.$summary}{\link{data.frame} summary of all relevant model results.} -\item{.$data}{\link{data.frame} original input data} -\item{.$args}{\link{list} used arguments} -\item{.$call}{\link{call} the function call} -\item{.$tables}{\link{list} a list of data frames containing all calculation tables} - -The output should be accessed using the function \link{get_RLum}. -} -\description{ -Function to calculate the IEU De for a De data set. -} -\details{ -This function uses the equations of Thomsen et al. (2007). The parameters a -and b are estimated from dose-recovery experiments. -} -\section{Function version}{ - 0.1.1 -} - -\examples{ - -## load data -data(ExampleData.DeValues, envir = environment()) - -## apply the IEU model -ieu <- calc_IEU(ExampleData.DeValues$CA1, a = 0.2, b = 1.9, interval = 1) - -} - -\section{How to cite}{ -Smedley, R.K., 2024. calc_IEU(): Apply the internal-external-uncertainty (IEU) model after Thomsen et al. (2007) to a given De distribution. Function version 0.1.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Smedley, R.K., 2015. A new R function for the Internal External Uncertainty (IEU) model. -Ancient TL 33, 16-21. - -Thomsen, K.J., Murray, A.S., Boetter-Jensen, L. & Kinahan, J., -2007. Determination of burial dose in incompletely bleached fluvial samples -using single grains of quartz. Radiation Measurements 42, 370-379. -} -\seealso{ -\link{plot}, \link{calc_CommonDose}, \link{calc_CentralDose}, \link{calc_FiniteMixture}, -\link{calc_FuchsLang2001}, \link{calc_MinDose} -} -\author{ -Rachel Smedley, Geography & Earth Sciences, Aberystwyth University (United Kingdom) \cr -Based on an excel spreadsheet and accompanying macro written by Kristina Thomsen. -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_Kars2008.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_Kars2008.Rd deleted file mode 100644 index 0f57bc7d7..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_Kars2008.Rd +++ /dev/null @@ -1,101 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_Kars2008.R -\name{calc_Kars2008} -\alias{calc_Kars2008} -\title{Apply the Kars et al. (2008) model (deprecated)} -\usage{ -calc_Kars2008(fit.method = "EXP", ...) -} -\arguments{ -\item{fit.method}{\link{character} (\emph{with default}): -Fit function of the dose response curve. Can either be \code{EXP} (the default) -or \code{GOK}. Note that \code{EXP} (single saturating exponential) is the original -function the model after Huntley (2006) and Kars et al. (2008) was -designed to use. The use of a general-order kinetics function (\code{GOK}) -is an experimental adaption of the model and should only be used -with great care.} - -\item{...}{Parameters passed to \link{calc_Huntley2006}.} -} -\value{ -An \linkS4class{RLum.Results} object is returned: -} -\description{ -A function to calculate the expected sample specific fraction of saturation -following Kars et al. (2008) and Huntley (2006). This function is deprecated -and will eventually be removed. Please use \code{calc_Huntley2006()} instead. -} -\details{ -This function applies the approach described in Kars et al. (2008), -developed from the model of Huntley (2006) to calculate the expected sample -specific fraction of saturation of a feldspar and also to calculate fading -corrected age using this model. \eqn{\rho}' (\code{rhop}), the density of recombination -centres, is a crucial parameter of this model and must be determined -separately from a fading measurement. The function \link{analyse_FadingMeasurement} -can be used to calculate the sample specific \eqn{\rho}' value. -} -\note{ -\strong{This function is deprecated and will eventually be removed from the package.} -\strong{Please use the function \code{\link[=calc_Huntley2006]{calc_Huntley2006()}} instead} -\strong{(use \code{fit.method = "EXP"} to apply the model after Kars et al., 2008).} -} -\section{Function version}{ - 0.4.0 -} - -\examples{ - -## Load example data (sample UNIL/NB123, see ?ExampleData.Fading) -data("ExampleData.Fading", envir = environment()) - -## (1) Set all relevant parameters -# a. fading measurement data (IR50) -fading_data <- ExampleData.Fading$fading.data$IR50 - -# b. Dose response curve data -data <- ExampleData.Fading$equivalentDose.data$IR50 - -## (2) Define required function parameters -ddot <- c(7.00, 0.004) -readerDdot <- c(0.134, 0.0067) - -# Analyse fading measurement and get an estimate of rho'. -# Note that the RLum.Results object can be directly used for further processing. -# The number of MC runs is reduced for this example -rhop <- analyse_FadingMeasurement(fading_data, plot = TRUE, verbose = FALSE, n.MC = 10) - -## (3) Apply the Kars et al. (2008) model to the data -kars <- suppressWarnings( - calc_Kars2008(data = data, - rhop = rhop, - ddot = ddot, - readerDdot = readerDdot, - n.MC = 25) -) - -} - -\section{How to cite}{ -King, G.E., Burow, C., 2024. calc_Kars2008(): Apply the Kars et al. (2008) model (deprecated). Function version 0.4.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Kars, R.H., Wallinga, J., Cohen, K.M., 2008. A new approach towards anomalous fading correction for feldspar -IRSL dating-tests on samples in field saturation. Radiation Measurements 43, 786-790. doi:10.1016/j.radmeas.2008.01.021 - -Huntley, D.J., 2006. An explanation of the power-law decay of luminescence. -Journal of Physics: Condensed Matter 18, 1359-1365. doi:10.1088/0953-8984/18/4/020 - -King, G.E., Herman, F., Lambert, R., Valla, P.G., Guralnik, B., 2016. -Multi-OSL-thermochronometry of feldspar. Quaternary Geochronology 33, 76-87. doi:10.1016/j.quageo.2016.01.004 - -\strong{Further reading} - -Morthekai, P., Jain, M., Cunha, P.P., Azevedo, J.M., Singhvi, A.K., 2011. An attempt to correct -for the fading in million year old basaltic rocks. Geochronometria 38(3), 223-230. -} -\author{ -Georgina E. King, University of Bern (Switzerland) \cr -Christoph Burow, University of Cologne (Germany) -, RLum Developer Team} -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_Lamothe2003.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_Lamothe2003.Rd deleted file mode 100644 index 9714b96fb..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_Lamothe2003.Rd +++ /dev/null @@ -1,168 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_Lamothe2003.R -\name{calc_Lamothe2003} -\alias{calc_Lamothe2003} -\title{Apply fading correction after Lamothe et al., 2003} -\usage{ -calc_Lamothe2003( - object, - dose_rate.envir, - dose_rate.source, - g_value, - tc = NULL, - tc.g_value = tc, - verbose = TRUE, - plot = TRUE, - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum.Results} \link{data.frame} (\strong{required}): Input data for applying the -fading correction. Allow are (1) \link{data.frame} with three columns (\code{dose}, \code{LxTx}, \verb{LxTx error}; see details), (2) -\linkS4class{RLum.Results} object created by the function \link{analyse_SAR.CWOSL} or \link{analyse_pIRIRSequence}} - -\item{dose_rate.envir}{\link{numeric} vector of length 2 (\strong{required}): Environmental dose rate in mGy/a} - -\item{dose_rate.source}{\link{numeric} vector of length 2 (\strong{required}): Irradiation source dose rate in Gy/s, -which is, according to Lamothe et al. (2003) De/t*.} - -\item{g_value}{\link{numeric} vector of length 2 (\strong{required}): g_value in \\%/decade \emph{recalculated at the moment} -the equivalent dose was calculated, i.e. \code{tc} is either similar for the \emph{g}-value measurement \strong{and} the De measurement or -needs be to recalculated (cf. \link{calc_FadingCorr}). Inserting a normalised g-value, e.g., normalised to 2-days , will -lead to wrong results} - -\item{tc}{\link{numeric} (optional): time in seconds between the \strong{end} of the irradiation and -the prompt measurement used in the equivalent dose estimation (cf. Huntley & Lamothe 2001). -If set to \code{NULL} it is assumed that \code{tc} is similar for the equivalent dose -estimation and the \emph{g}-value estimation} - -\item{tc.g_value}{\link{numeric} (with default): the time in seconds between irradiation and the -prompt measurement estimating the \emph{g}-value. If the \emph{g}-value was normalised to, e.g., 2 days, -this time in seconds (i.e., \code{172800}) should be entered here along with the time used for the -equivalent dose estimation. If nothing is provided the time is set to \code{tc}, which is the -usual case for \emph{g}-values obtained using the SAR method and \emph{g}-values that had been not normalised to 2 days. -Note: If this value is not \code{NULL} the functions expects a \link{numeric} value for \code{tc}.} - -\item{verbose}{\link{logical} (with default): Enables/disables terminal verbose mode} - -\item{plot}{\link{logical} (with default): Enables/disables plot output} - -\item{...}{further arguments passed to the function \link{plot_GrowthCurve}} -} -\value{ -The function returns are graphical output produced by the function \link{plot_GrowthCurve} and -an \linkS4class{RLum.Results}. - ------------------------------------\cr -\verb{[ NUMERICAL OUTPUT ]}\cr ------------------------------------\cr - -\strong{\code{RLum.Results}}-object - -\strong{slot:} \strong{\verb{@data}} - -\tabular{lll}{ -\strong{Element} \tab \strong{Type} \tab \strong{Description}\cr -\verb{$data} \tab \code{data.frame} \tab the fading corrected values \cr -\verb{$fit} \tab \code{nls} \tab the object returned by the dose response curve fitting \cr -} - -'\strong{slot:} \strong{\verb{@info}} - -The original function call -} -\description{ -This function applies the fading correction for the prediction of long-term fading as suggested -by Lamothe et al., 2003. The function basically adjusts the $L_n/T_n$ values and fits a new dose-response -curve using the function \link{plot_GrowthCurve}. -} -\details{ -\strong{Format of \code{object} if \code{data.frame}} - -If \code{object} is of type \link{data.frame}, all input values most be of type \link{numeric}. -Dose values are excepted in seconds (s) not Gray (Gy). No \code{NA} values are allowed and -the value for the natural dose (first row) should be \code{0}. Example for three dose points, -column names are arbitrary: - -\if{html}{\out{
}}\preformatted{ object <- data.frame( - dose = c(0,25,50), - LxTx = c(4.2, 2.5, 5.0), - LxTx_error = c(0.2, 0.1, 0.2)) -}\if{html}{\out{
}} - -\strong{Note on the g-value and \code{tc}} - -Users new to R and fading measurements are often confused about what to -enter for \code{tc} and why it may differ from \code{tc.g_value}. The \code{tc} value -is, by convention (Huntley & Lamothe 2001), the time elapsed between the end of the irradiation and the prompt -measurement. Usually there is no reason for having a \code{tc} value different for the equivalent dose measurement -and the \emph{g}-value measurement, except if different equipment was used. -However, if, for instance, the \emph{g}-value measurement sequence was analysed -with the \emph{Analyst} (Duller 2015) and the \verb{'Luminescence} is used to correct for fading, -there is a high chance that the value returned by the \emph{Analyst} comes normalised to 2-days; -even the \code{tc} values of the measurement were identical. -In such cases, the fading correction cannot be correct until the \code{tc.g_value} was manually -set to 2-days (\code{172800} s) because the function will internally recalculate values -to an identical \code{tc} value. -} -\section{Function version}{ - 0.1.0 -} - -\examples{ - -##load data -##ExampleData.BINfileData contains two BINfileData objects -##CWOSL.SAR.Data and TL.SAR.Data -data(ExampleData.BINfileData, envir = environment()) - -##transform the values from the first position in a RLum.Analysis object -object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) - -##perform SAR analysis and set rejection criteria -results <- analyse_SAR.CWOSL( -object = object, -signal.integral.min = 1, -signal.integral.max = 2, -background.integral.min = 900, -background.integral.max = 1000, -verbose = FALSE, -plot = FALSE, -onlyLxTxTable = TRUE -) - -##run fading correction -results_corr <- calc_Lamothe2003( - object = results, - dose_rate.envir = c(1.676 , 0.180), - dose_rate.source = c(0.184, 0.003), - g_value = c(2.36, 0.6), - plot = TRUE, - fit.method = "EXP") - - -} - -\section{How to cite}{ -Kreutzer, S., Mercier, N., 2024. calc_Lamothe2003(): Apply fading correction after Lamothe et al., 2003. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Huntley, D.J., Lamothe, M., 2001. Ubiquity of anomalous fading in K-feldspars and the measurement -and correction for it in optical dating. Canadian Journal of Earth Sciences 38, 1093-1106. - -Duller, G.A.T., 2015. The Analyst software package for luminescence data: overview and recent improvements. -Ancient TL 33, 35–42. - -Lamothe, M., Auclair, M., Hamzaoui, C., Huot, S., 2003. -Towards a prediction of long-term anomalous fading of feldspar IRSL. Radiation Measurements 37, -493-498. -} -\seealso{ -\link{plot_GrowthCurve}, \link{calc_FadingCorr}, \link{analyse_SAR.CWOSL}, \link{analyse_pIRIRSequence} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany), Norbert Mercier, -IRAMAT-CRP2A, Université Bordeaux Montaigne (France) -, RLum Developer Team} -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_MaxDose.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_MaxDose.Rd deleted file mode 100644 index 0833c865f..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_MaxDose.Rd +++ /dev/null @@ -1,152 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_MaxDose.R -\name{calc_MaxDose} -\alias{calc_MaxDose} -\title{Apply the maximum age model to a given De distribution} -\usage{ -calc_MaxDose( - data, - sigmab, - log = TRUE, - par = 3, - bootstrap = FALSE, - init.values, - plot = TRUE, - ... -) -} -\arguments{ -\item{data}{\linkS4class{RLum.Results} or \link{data.frame} (\strong{required}): -for \link{data.frame}: two columns with De \code{(data[ ,1])} and De error \code{(data[ ,2])}.} - -\item{sigmab}{\link{numeric} (\strong{required}): -additional spread in De values. -This value represents the expected overdispersion in the data should the sample be -well-bleached (Cunningham & Walling 2012, p. 100). -\strong{NOTE}: For the logged model (\code{log = TRUE}) this value must be -a fraction, e.g. 0.2 (= 20 \\%). If the un-logged model is used (\code{log = FALSE}), -sigmab must be provided in the same absolute units of the De values (seconds or Gray). -See details (\link{calc_MinDose}.} - -\item{log}{\link{logical} (\emph{with default}): -fit the (un-)logged three parameter minimum dose model to De data} - -\item{par}{\link{numeric} (\emph{with default}): -apply the 3- or 4-parameter minimum age model (\code{par=3} or \code{par=4}).} - -\item{bootstrap}{\link{logical} (\emph{with default}): -apply the recycled bootstrap approach of Cunningham & Wallinga (2012).} - -\item{init.values}{\link{numeric} (\emph{with default}): -starting values for gamma, sigma, p0 and mu. Custom values need to be provided in a vector of -length three in the form of \code{c(gamma, sigma, p0)}.} - -\item{plot}{\link{logical} (\emph{with default}): -plot output (\code{TRUE}/\code{FALSE})} - -\item{...}{further arguments for bootstrapping (\verb{bs.M, bs.N, bs.h, sigmab.sd}). -See details for their usage.} -} -\value{ -Please see \link{calc_MinDose}. -} -\description{ -Function to fit the maximum age model to De data. This is a wrapper function -that calls \link{calc_MinDose} and applies a similar approach as described in -Olley et al. (2006). -} -\details{ -\strong{Data transformation} - -To estimate the maximum dose population -and its standard error, the three parameter minimum age model of Galbraith -et al. (1999) is adapted. The measured De values are transformed as follows: -\enumerate{ -\item convert De values to natural logs -\item multiply the logged data to create a mirror image of the De distribution -\item shift De values along x-axis by the smallest x-value found to obtain only positive values -\item combine in quadrature the measurement error associated with each De value -with a relative error specified by \code{sigmab} -\item apply the MAM to these data -} - -When all calculations are done the results are then converted as follows -\enumerate{ -\item subtract the x-offset -\item multiply the natural logs by -1 -\item take the exponent to obtain the maximum dose estimate in Gy -} - -\strong{Further documentation} - -Please see \link{calc_MinDose}. -} -\section{Function version}{ - 0.3.1 -} - -\examples{ - -## load example data -data(ExampleData.DeValues, envir = environment()) - -# apply the maximum dose model -calc_MaxDose(ExampleData.DeValues$CA1, sigmab = 0.2, par = 3) - -} - -\section{How to cite}{ -Burow, C., 2024. calc_MaxDose(): Apply the maximum age model to a given De distribution. Function version 0.3.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Arnold, L.J., Roberts, R.G., Galbraith, R.F. & DeLong, S.B., -2009. A revised burial dose estimation procedure for optical dating of young -and modern-age sediments. Quaternary Geochronology 4, 306-325. - -Galbraith, R.F. & Laslett, G.M., 1993. Statistical models for mixed fission -track ages. Nuclear Tracks Radiation Measurements 4, 459-470. - -Galbraith, R.F., Roberts, R.G., Laslett, G.M., Yoshida, H. & Olley, J.M., -1999. Optical dating of single grains of quartz from Jinmium rock shelter, -northern Australia. Part I: experimental design and statistical models. -Archaeometry 41, 339-364. - -Galbraith, R.F., 2005. Statistics for -Fission Track Analysis, Chapman & Hall/CRC, Boca Raton. - -Galbraith, R.F. & Roberts, R.G., 2012. Statistical aspects of equivalent dose and error -calculation and display in OSL dating: An overview and some recommendations. -Quaternary Geochronology 11, 1-27. - -Olley, J.M., Roberts, R.G., Yoshida, H., Bowler, J.M., 2006. Single-grain optical dating of grave-infill -associated with human burials at Lake Mungo, Australia. Quaternary Science -Reviews 25, 2469-2474 - -\strong{Further reading} - -Arnold, L.J. & Roberts, R.G., 2009. Stochastic modelling of multi-grain equivalent dose -(De) distributions: Implications for OSL dating of sediment mixtures. -Quaternary Geochronology 4, 204-230. - -Bailey, R.M. & Arnold, L.J., 2006. Statistical modelling of single grain quartz De distributions and an -assessment of procedures for estimating burial dose. Quaternary Science -Reviews 25, 2475-2502. - -Cunningham, A.C. & Wallinga, J., 2012. Realizing the potential of fluvial archives using robust OSL chronologies. -Quaternary Geochronology 12, 98-106. - -Rodnight, H., Duller, G.A.T., Wintle, A.G. & Tooth, S., 2006. Assessing the reproducibility and accuracy -of optical dating of fluvial deposits. Quaternary Geochronology 1, 109-120. - -Rodnight, H., 2008. How many equivalent dose values are needed to -obtain a reproducible distribution?. Ancient TL 26, 3-10. -} -\seealso{ -\link{calc_CentralDose}, \link{calc_CommonDose}, \link{calc_FiniteMixture}, -\link{calc_FuchsLang2001}, \link{calc_MinDose} -} -\author{ -Christoph Burow, University of Cologne (Germany) \cr -Based on a rewritten S script of Rex Galbraith, 2010 -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_MinDose.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_MinDose.Rd deleted file mode 100644 index 7f5f5f406..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_MinDose.Rd +++ /dev/null @@ -1,357 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_MinDose.R -\name{calc_MinDose} -\alias{calc_MinDose} -\title{Apply the (un-)logged minimum age model (MAM) after Galbraith et al. (1999) -to a given De distribution} -\usage{ -calc_MinDose( - data, - sigmab, - log = TRUE, - par = 3, - bootstrap = FALSE, - init.values, - level = 0.95, - log.output = FALSE, - plot = TRUE, - multicore = FALSE, - ... -) -} -\arguments{ -\item{data}{\linkS4class{RLum.Results} or \link{data.frame} (\strong{required}): -for \link{data.frame}: two columns with De \code{(data[ ,1])} and De error \code{(data[ ,2])}.} - -\item{sigmab}{\link{numeric} (\strong{required}): -additional spread in De values. -This value represents the expected overdispersion in the data should the sample be -well-bleached (Cunningham & Walling 2012, p. 100). -\strong{NOTE}: For the logged model (\code{log = TRUE}) this value must be -a fraction, e.g. 0.2 (= 20 \\%). If the un-logged model is used (\code{log = FALSE}), -sigmab must be provided in the same absolute units of the De values (seconds or Gray). -See details.} - -\item{log}{\link{logical} (\emph{with default}): -fit the (un-)logged minimum dose model to De data.} - -\item{par}{\link{numeric} (\emph{with default}): -apply the 3- or 4-parameter minimum age model (\code{par=3} or \code{par=4}). The MAM-3 is -used by default.} - -\item{bootstrap}{\link{logical} (\emph{with default}): -apply the recycled bootstrap approach of Cunningham & Wallinga (2012).} - -\item{init.values}{\link{numeric} (\emph{optional}): -a named list with starting values for gamma, sigma, p0 and mu -(e.g. \code{list(gamma=100, sigma=1.5, p0=0.1, mu=100)}). If no values are provided reasonable values -are tried to be estimated from the data. \strong{NOTE} that the initial values must always be given -in the absolute units. The the logged model is applied (\code{log = TRUE}), the provided \code{init.values} -are automatically log transformed.} - -\item{level}{\link{logical} (\emph{with default}): -the confidence level required (defaults to 0.95).} - -\item{log.output}{\link{logical} (\emph{with default}): -If \code{TRUE} the console output will also show the logged values of the final parameter estimates -and confidence intervals (only applicable if \code{log = TRUE}).} - -\item{plot}{\link{logical} (\emph{with default}): -plot output (\code{TRUE}/\code{FALSE})} - -\item{multicore}{\link{logical} (\emph{with default}): -enable parallel computation of the bootstrap by creating a multicore SNOW cluster. Depending -on the number of available logical CPU cores this may drastically reduce -the computation time. Note that this option is highly experimental and may not -work on all machines. (\code{TRUE}/\code{FALSE})} - -\item{...}{(\emph{optional}) further arguments for bootstrapping -(\verb{bs.M, bs.N, bs.h, sigmab.sd}). See details for their usage. -Further arguments are -\itemize{ -\item \code{verbose} to de-/activate console output (logical), -\item \code{debug} for extended console output (logical) and -\item \code{cores} (integer) to manually specify the number of cores to be used when \code{multicore=TRUE}. -}} -} -\value{ -Returns a plot (\emph{optional}) and terminal output. In addition an -\linkS4class{RLum.Results} object is returned containing the -following elements: - -\item{.$summary}{\link{data.frame} summary of all relevant model results.} -\item{.$data}{\link{data.frame} original input data} -\item{args}{\link{list} used arguments} -\item{call}{\link{call} the function call} -\item{.$mle}{\link[bbmle:mle2]{bbmle::mle2} object containing the maximum log likelihood functions for all parameters} -\item{BIC}{\link{numeric} BIC score} -\item{.$confint}{\link{data.frame} confidence intervals for all parameters} -\item{.$profile}{\link[stats:profile]{stats::profile} the log likelihood profiles} -\item{.$bootstrap}{\link{list} bootstrap results} - -The output should be accessed using the function \link{get_RLum} -} -\description{ -Function to fit the (un-)logged three or four parameter minimum dose model -(MAM-3/4) to De data. -} -\details{ -\strong{Parameters} - -This model has four parameters: -\tabular{rl}{ -\code{gamma}: \tab minimum dose on the log scale \cr -\code{mu}: \tab mean of the non-truncated normal distribution \cr -\code{sigma}: \tab spread in ages above the minimum \cr -\code{p0}: \tab proportion of grains at gamma \cr } - -If \code{par=3} (default) the 3-parameter minimum age model is applied, -where \code{gamma=mu}. For \code{par=4} the 4-parameter model is applied instead. - -\strong{(Un-)logged model} - -In the original version of the minimum dose model, the basic data are the natural -logarithms of the De estimates and relative standard errors of the De -estimates. The value for \code{sigmab} must be provided as a ratio -(e.g, 0.2 for 20 \\%). This model will be applied if \code{log = TRUE}. - -If \code{log=FALSE}, the modified un-logged model will be applied instead. This -has essentially the same form as the original version. \code{gamma} and -\code{sigma} are in Gy and \code{gamma} becomes the minimum true dose in the -population. -\strong{Note} that the un-logged model requires \code{sigmab} to be in the same -absolute unit as the provided De values (seconds or Gray). - -While the original (logged) version of the minimum dose -model may be appropriate for most samples (i.e. De distributions), the -modified (un-logged) version is specially designed for modern-age and young -samples containing negative, zero or near-zero De estimates (Arnold et al. -2009, p. 323). - -\strong{Initial values & boundaries} - -The log likelihood calculations use the \link{nlminb} function for box-constrained -optimisation using PORT routines. Accordingly, initial values for the four -parameters can be specified via \code{init.values}. If no values are -provided for \code{init.values} reasonable starting values are estimated -from the input data. If the final estimates of \emph{gamma}, \emph{mu}, -\emph{sigma} and \emph{p0} are totally off target, consider providing custom -starting values via \code{init.values}. -In contrast to previous versions of this function the boundaries for the -individual model parameters are no longer required to be explicitly specified. -If you want to override the default boundary values use the arguments -\code{gamma.lower}, \code{gamma.upper}, \code{sigma.lower}, \code{sigma.upper}, \code{p0.lower}, \code{p0.upper}, -\code{mu.lower} and \code{mu.upper}. - -\strong{Bootstrap} - -When \code{bootstrap=TRUE} the function applies the bootstrapping method as -described in Wallinga & Cunningham (2012). By default, the minimum age model -produces 1000 first level and 3000 second level bootstrap replicates -(actually, the number of second level bootstrap replicates is three times -the number of first level replicates unless specified otherwise). The -uncertainty on sigmab is 0.04 by default. These values can be changed by -using the arguments \code{bs.M} (first level replicates), \code{bs.N} -(second level replicates) and \code{sigmab.sd} (error on sigmab). With -\code{bs.h} the bandwidth of the kernel density estimate can be specified. -By default, \code{h} is calculated as - -\deqn{h = (2*\sigma_{DE})/\sqrt{n}} - -\strong{Multicore support} - -This function supports parallel computing and can be activated by \code{multicore=TRUE}. -By default, the number of available logical CPU cores is determined -automatically, but can be changed with \code{cores}. The multicore support -is only available when \code{bootstrap=TRUE} and spawns \code{n} R instances -for each core to get MAM estimates for each of the N and M bootstrap -replicates. Note that this option is highly experimental and may or may not -work for your machine. Also the performance gain increases for larger number -of bootstrap replicates. Also note that with each additional core and hence -R instance and depending on the number of bootstrap replicates the memory -usage can significantly increase. Make sure that memory is always available, -otherwise there will be a massive performance hit. - -\strong{Likelihood profiles} - -The likelihood profiles are generated and plotted by the \code{bbmle} package. -The profile likelihood plots look different to ordinary profile likelihood as - -"\verb{[...]} the plot method for likelihood profiles displays the square root of -the the deviance difference (twice the difference in negative log-likelihood from -the best fit), so it will be V-shaped for cases where the quadratic approximation -works well \verb{[...]}." (Bolker 2016). - -For more details on the profile likelihood -calculations and plots please see the vignettes of the \code{bbmle} package -(also available here: \url{https://CRAN.R-project.org/package=bbmle}). -} -\note{ -The default starting values for \emph{gamma}, \emph{mu}, \emph{sigma} -and \emph{p0} may only be appropriate for some De data sets and may need to -be changed for other data. This is especially true when the un-logged -version is applied. \cr -Also note that all R warning messages are suppressed -when running this function. If the results seem odd consider re-running the -model with \code{debug=TRUE} which provides extended console output and -forwards all internal warning messages. -} -\section{Function version}{ - 0.4.4 -} - -\examples{ - -## Load example data -data(ExampleData.DeValues, envir = environment()) - -# (1) Apply the minimum age model with minimum required parameters. -# By default, this will apply the un-logged 3-parameter MAM. -calc_MinDose(data = ExampleData.DeValues$CA1, sigmab = 0.1) - -\dontrun{ -# (2) Re-run the model, but save results to a variable and turn -# plotting of the log-likelihood profiles off. -mam <- calc_MinDose( - data = ExampleData.DeValues$CA1, - sigmab = 0.1, - plot = FALSE) - -# Show structure of the RLum.Results object -mam - -# Show summary table that contains the most relevant results -res <- get_RLum(mam, "summary") -res - -# Plot the log likelihood profiles retroactively, because before -# we set plot = FALSE -plot_RLum(mam) - -# Plot the dose distribution in an abanico plot and draw a line -# at the minimum dose estimate -plot_AbanicoPlot(data = ExampleData.DeValues$CA1, - main = "3-parameter Minimum Age Model", - line = mam,polygon.col = "none", - hist = TRUE, - rug = TRUE, - summary = c("n", "mean", "mean.weighted", "median", "in.ci"), - centrality = res$de, - line.col = "red", - grid.col = "none", - line.label = paste0(round(res$de, 1), "\U00B1", - round(res$de_err, 1), " Gy"), - bw = 0.1, - ylim = c(-25, 18), - summary.pos = "topleft", - mtext = bquote("Parameters: " ~ - sigma[b] == .(get_RLum(mam, "args")$sigmab) ~ ", " ~ - gamma == .(round(log(res$de), 1)) ~ ", " ~ - sigma == .(round(res$sig, 1)) ~ ", " ~ - rho == .(round(res$p0, 2)))) - - - -# (3) Run the minimum age model with bootstrap -# NOTE: Bootstrapping is computationally intensive -# (3.1) run the minimum age model with default values for bootstrapping -calc_MinDose(data = ExampleData.DeValues$CA1, - sigmab = 0.15, - bootstrap = TRUE) - -# (3.2) Bootstrap control parameters -mam <- calc_MinDose(data = ExampleData.DeValues$CA1, - sigmab = 0.15, - bootstrap = TRUE, - bs.M = 300, - bs.N = 500, - bs.h = 4, - sigmab.sd = 0.06, - plot = FALSE) - -# Plot the results -plot_RLum(mam) - -# save bootstrap results in a separate variable -bs <- get_RLum(mam, "bootstrap") - -# show structure of the bootstrap results -str(bs, max.level = 2, give.attr = FALSE) - -# print summary of minimum dose and likelihood pairs -summary(bs$pairs$gamma) - -# Show polynomial fits of the bootstrap pairs -bs$poly.fits$poly.three - -# Plot various statistics of the fit using the generic plot() function -par(mfcol=c(2,2)) -plot(bs$poly.fits$poly.three, ask = FALSE) - -# Show the fitted values of the polynomials -summary(bs$poly.fits$poly.three$fitted.values) -} - -} - -\section{How to cite}{ -Burow, C., 2024. calc_MinDose(): Apply the (un-)logged minimum age model (MAM) after Galbraith et al. (1999) to a given De distribution. Function version 0.4.4. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Arnold, L.J., Roberts, R.G., Galbraith, R.F. & DeLong, S.B., -2009. A revised burial dose estimation procedure for optical dating of young -and modern-age sediments. Quaternary Geochronology 4, 306-325. - -Galbraith, R.F. & Laslett, G.M., 1993. Statistical models for mixed fission -track ages. Nuclear Tracks Radiation Measurements 4, 459-470. - -Galbraith, R.F., Roberts, R.G., Laslett, G.M., Yoshida, H. & Olley, J.M., -1999. Optical dating of single grains of quartz from Jinmium rock shelter, -northern Australia. Part I: experimental design and statistical models. -Archaeometry 41, 339-364. - -Galbraith, R.F., 2005. Statistics for -Fission Track Analysis, Chapman & Hall/CRC, Boca Raton. - -Galbraith, R.F. & Roberts, R.G., 2012. Statistical aspects of equivalent dose and error -calculation and display in OSL dating: An overview and some recommendations. -Quaternary Geochronology 11, 1-27. - -Olley, J.M., Roberts, R.G., Yoshida, H., Bowler, J.M., 2006. Single-grain optical dating of grave-infill -associated with human burials at Lake Mungo, Australia. Quaternary Science -Reviews 25, 2469-2474. - -\strong{Further reading} - -Arnold, L.J. & Roberts, R.G., 2009. Stochastic modelling of multi-grain equivalent dose -(De) distributions: Implications for OSL dating of sediment mixtures. -Quaternary Geochronology 4, 204-230. - -Bolker, B., 2016. Maximum likelihood estimation analysis with the bbmle package. -In: Bolker, B., R Development Core Team, 2016. bbmle: Tools for General Maximum Likelihood Estimation. -R package version 1.0.18. \url{https://CRAN.R-project.org/package=bbmle} - -Bailey, R.M. & Arnold, L.J., 2006. Statistical modelling of single grain quartz De distributions and an -assessment of procedures for estimating burial dose. Quaternary Science -Reviews 25, 2475-2502. - -Cunningham, A.C. & Wallinga, J., 2012. Realizing the potential of fluvial archives using robust OSL chronologies. -Quaternary Geochronology 12, 98-106. - -Rodnight, H., Duller, G.A.T., Wintle, A.G. & Tooth, S., 2006. Assessing the reproducibility and accuracy -of optical dating of fluvial deposits. Quaternary Geochronology 1, 109-120. - -Rodnight, H., 2008. How many equivalent dose values are needed to -obtain a reproducible distribution?. Ancient TL 26, 3-10. -} -\seealso{ -\link{calc_CentralDose}, \link{calc_CommonDose}, \link{calc_FiniteMixture}, -\link{calc_FuchsLang2001}, \link{calc_MaxDose} -} -\author{ -Christoph Burow, University of Cologne (Germany) \cr -Based on a rewritten S script of Rex Galbraith, 2010 \cr -The bootstrap approach is based on a rewritten MATLAB script of Alastair Cunningham. \cr -Alastair Cunningham is thanked for his help in implementing and cross-checking the code. -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_OSLLxTxDecomposed.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_OSLLxTxDecomposed.Rd deleted file mode 100644 index 46b1466ad..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_OSLLxTxDecomposed.Rd +++ /dev/null @@ -1,83 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_OSLLxTxDecomposed.R -\name{calc_OSLLxTxDecomposed} -\alias{calc_OSLLxTxDecomposed} -\title{Calculate Lx/Tx ratio for decomposed CW-OSL signal components} -\usage{ -calc_OSLLxTxDecomposed( - Lx.data, - Tx.data = NULL, - OSL.component = 1L, - sig0 = 0, - digits = NULL -) -} -\arguments{ -\item{Lx.data}{\link{data.frame} (\strong{required}): Component table created by -\verb{[OSLdecomposition::RLum.OSL_decomposition]} and per default located -at \code{object@records[[...]]@info$COMPONENTS}.The value of \verb{$n[OSL.component]} -is set as \code{LnLx}. The value of \verb{$n.error[OSL.component]} is set as \code{LnLx.error}} - -\item{Tx.data}{\link{data.frame} (\emph{optional}): Component table created by -\verb{[OSLdecomposition::RLum.OSL_decomposition]} and per default located at -\code{object@records[[...]]@info$COMPONENTS}. The value of \verb{$n[OSL.component]} -is set as \code{TnTx}. The value of \verb{$n.error[OSL.component]} is set as \code{TnTx.error}} - -\item{OSL.component}{\link{integer} or \link{character} (\emph{optional}): -a single index or a name describing which OSL signal component shall be evaluated. -This argument can either be the name of the OSL component assigned by -\verb{[OSLdecomposition::RLum.OSL_global_fitting]} or the index of component. -Then \code{'1'} selects the fastest decaying component, \code{'2'} the -second fastest and so on. If not defined, the fastest decaying component is selected.} - -\item{sig0}{\link{numeric} (\emph{with default}): allows adding an extra error component -to the final \code{Lx/Tx} error value (e.g., instrumental error).} - -\item{digits}{\link{integer} (\emph{with default}): round numbers to the specified digits. -If digits is set to \code{NULL} nothing is rounded.} -} -\value{ -Returns an S4 object of type \linkS4class{RLum.Results}. - -Slot \code{data} contains a \link{list} with the following structure: - -\strong{@data} - -\if{html}{\out{
}}\preformatted{$LxTx.table (data.frame) -.. $ LnLx -.. $ TnTx -.. $ Net_LnLx -.. $ Net_LnLx.Error -.. $ Net_TnTx -.. $ Net_TnTx.Error -.. $ LxTx -.. $ LxTx.relError -.. $ LxTx.Error -}\if{html}{\out{
}} -} -\description{ -Calculate \code{Lx/Tx} ratios from a given set of decomposed -CW-OSL curves decomposed by \verb{[OSLdecomposition::RLum.OSL_decomposition]} -} -\section{Function version}{ - 0.1.0 -} - - -\section{How to cite}{ -Mittelstrass, D., 2024. calc_OSLLxTxDecomposed(): Calculate Lx/Tx ratio for decomposed CW-OSL signal components. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Mittelstrass D., Schmidt C., Beyer J., Straessner A., 2019. -Automated identification and separation of quartz CW-OSL signal components with R. -talk presented at DLED 2019, Bingen, Germany -\url{http://luminescence.de/OSLdecomp_talk.pdf}\cr -} -\seealso{ -\linkS4class{RLum.Data.Curve}, \link{plot_GrowthCurve}, \link{analyse_SAR.CWOSL} -} -\author{ -Dirk Mittelstrass -, RLum Developer Team} -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_OSLLxTxRatio.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_OSLLxTxRatio.Rd deleted file mode 100644 index 0a49aee60..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_OSLLxTxRatio.Rd +++ /dev/null @@ -1,197 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_OSLLxTxRatio.R -\name{calc_OSLLxTxRatio} -\alias{calc_OSLLxTxRatio} -\title{Calculate \code{Lx/Tx} ratio for CW-OSL curves} -\usage{ -calc_OSLLxTxRatio( - Lx.data, - Tx.data = NULL, - signal.integral, - signal.integral.Tx = NULL, - background.integral, - background.integral.Tx = NULL, - background.count.distribution = "non-poisson", - use_previousBG = FALSE, - sigmab = NULL, - sig0 = 0, - digits = NULL -) -} -\arguments{ -\item{Lx.data}{\linkS4class{RLum.Data.Curve} or \link{data.frame} (\strong{required}): -requires a CW-OSL shine down curve (x = time, y = counts)} - -\item{Tx.data}{\linkS4class{RLum.Data.Curve} or \link{data.frame} (\emph{optional}): -requires a CW-OSL shine down curve (x = time, y = counts). If no -input is given the \code{Tx.data} will be treated as \code{NA} and no \code{Lx/Tx} ratio -is calculated.} - -\item{signal.integral}{\link{numeric} (\strong{required}): vector with the limits for the signal integral. -Can be set to \code{NA} than now integrals are considered and all other integrals are set to \code{NA} as well.} - -\item{signal.integral.Tx}{\link{numeric} (\emph{optional}): -vector with the limits for the signal integral for the \code{Tx}-curve. If nothing is provided the -value from \code{signal.integral} is used.} - -\item{background.integral}{\link{numeric} (\strong{required}): -vector with the bounds for the background integral. -Can be set to \code{NA} than now integrals are considered and all other integrals are set to \code{NA} as well.} - -\item{background.integral.Tx}{\link{numeric} (\emph{optional}): -vector with the limits for the background integral for the \code{Tx} curve. -If nothing is provided the value from \code{background.integral} is used.} - -\item{background.count.distribution}{\link{character} (\emph{with default}): -sets the count distribution assumed for the error calculation. -Possible arguments \code{poisson} or \code{non-poisson}. See details for further information} - -\item{use_previousBG}{\link{logical} (\emph{with default}): -If set to \code{TRUE} the background of the \code{Lx}-signal is subtracted also -from the \code{Tx}-signal. Please note that in this case separate -signal integral limits for the \code{Tx}-signal are not allowed and will be reset.} - -\item{sigmab}{\link{numeric} (\emph{optional}): -option to set a manual value for the overdispersion (for \code{LnTx} and \code{TnTx}), -used for the \code{Lx/Tx} error calculation. The value should be provided as -absolute squared count values, e.g. \code{sigmab = c(300,300)}. -\strong{Note:} If only one value is provided this value is taken for both (\code{LnTx} and \code{TnTx}) signals.} - -\item{sig0}{\link{numeric} (\emph{with default}): -allow adding an extra component of error to the final \code{Lx/Tx} error value -(e.g., instrumental error, see details).} - -\item{digits}{\link{integer} (\emph{with default}): -round numbers to the specified digits. -If digits is set to \code{NULL} nothing is rounded.} -} -\value{ -Returns an S4 object of type \linkS4class{RLum.Results}. - -Slot \code{data} contains a \link{list} with the following structure: - -\strong{@data} - -\if{html}{\out{
}}\preformatted{$LxTx.table (data.frame) -.. $ LnLx -.. $ LnLx.BG -.. $ TnTx -.. $ TnTx.BG -.. $ Net_LnLx -.. $ Net_LnLx.Error -.. $ Net_TnTx -.. $ Net_TnTx.Error -.. $ LxTx -.. $ LxTx.Error -$ calc.parameters (list) -.. $ sigmab.LnTx -.. $ sigmab.TnTx -.. $ k -}\if{html}{\out{
}} - -\strong{@info} - -\if{html}{\out{
}}\preformatted{$ call (original function call) -}\if{html}{\out{
}} -} -\description{ -Calculate \code{Lx/Tx} ratios from a given set of CW-OSL curves assuming late light -background subtraction. -} -\details{ -The integrity of the chosen values for the signal and background integral is -checked by the function; the signal integral limits have to be lower than -the background integral limits. If a \link{vector} is given as input instead -of a \link{data.frame}, an artificial \link{data.frame} is produced. The -error calculation is done according to Galbraith (2002). - -\strong{Please note:} In cases where the calculation results in \code{NaN} values (for -example due to zero-signal, and therefore a division of 0 by 0), these \code{NaN} -values are replaced by 0. - -\strong{\code{sigmab}} - -The default value of \code{sigmab} is calculated assuming the background is -constant and \strong{would not} applicable when the background varies as, -e.g., as observed for the early light subtraction method. - -\strong{sig0} - -This argument allows to add an extra component of error to the final \code{Lx/Tx} -error value. The input will be treated as factor that is multiplied with -the already calculated \code{LxTx} and the result is add up by: - -\deqn{se(LxTx) = \sqrt(se(LxTx)^2 + (LxTx * sig0)^2)} - -\strong{background.count.distribution} - -This argument allows selecting the distribution assumption that is used for -the error calculation. According to Galbraith (2002, 2014) the background -counts may be overdispersed (i.e. do not follow a Poisson distribution, -which is assumed for the photomultiplier counts). In that case (might be the -normal case) it has to be accounted for the overdispersion by estimating -\eqn{\sigma^2} (i.e. the overdispersion value). Therefore the relative -standard error is calculated as: -\itemize{ -\item \code{poisson} -\deqn{rse(\mu_{S}) \approx \sqrt(Y_{0} + Y_{1}/k^2)/Y_{0} - Y_{1}/k} -\item \code{non-poisson} -\deqn{rse(\mu_{S}) \approx \sqrt(Y_{0} + Y_{1}/k^2 + \sigma^2(1+1/k))/Y_{0} - Y_{1}/k} -} - -\strong{Please note} that when using the early background subtraction method in -combination with the 'non-poisson' distribution argument, the corresponding \code{Lx/Tx} error -may considerably increase due to a high \code{sigmab} value. -Please check whether this is valid for your data set and if necessary -consider to provide an own \code{sigmab} value using the corresponding argument \code{sigmab}. -} -\note{ -The results of this function have been cross-checked with the Analyst -(version 3.24b). Access to the results object via \link{get_RLum}. - -\strong{Caution:} If you are using early light subtraction (EBG), please either provide your -own \code{sigmab} value or use \code{background.count.distribution = "poisson"}. -} -\section{Function version}{ - 0.8.0 -} - -\examples{ - -##load data -data(ExampleData.LxTxOSLData, envir = environment()) - -##calculate Lx/Tx ratio -results <- calc_OSLLxTxRatio( - Lx.data = Lx.data, - Tx.data = Tx.data, - signal.integral = c(1:2), - background.integral = c(85:100)) - -##get results object -get_RLum(results) - -} - -\section{How to cite}{ -Kreutzer, S., 2024. calc_OSLLxTxRatio(): Calculate Lx/Tx ratio for CW-OSL curves. Function version 0.8.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Duller, G., 2018. Analyst v4.57 - User Manual. -\verb{https://users.aber.ac.uk/ggd}\cr - -Galbraith, R.F., 2002. A note on the variance of a background-corrected OSL -count. Ancient TL, 20 (2), 49-51. - -Galbraith, R.F., 2014. A further note on the variance of a -background-corrected OSL count. Ancient TL, 31 (2), 1-3. -} -\seealso{ -\linkS4class{RLum.Data.Curve}, \link{Analyse_SAR.OSLdata}, \link{plot_GrowthCurve}, -\link{analyse_SAR.CWOSL} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_SourceDoseRate.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_SourceDoseRate.Rd deleted file mode 100644 index c355b0373..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_SourceDoseRate.Rd +++ /dev/null @@ -1,155 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_SourceDoseRate.R -\name{calc_SourceDoseRate} -\alias{calc_SourceDoseRate} -\title{Calculation of the source dose rate via the date of measurement} -\usage{ -calc_SourceDoseRate( - measurement.date = Sys.Date(), - calib.date, - calib.dose.rate, - calib.error, - source.type = "Sr-90", - dose.rate.unit = "Gy/s", - predict = NULL -) -} -\arguments{ -\item{measurement.date}{\link{character} or \link{Date} (with default): Date of measurement in \code{"YYYY-MM-DD"}. -If no value is provided, the date will be set to today. The argument can be provided as vector.} - -\item{calib.date}{\link{character} or \link{Date} (\strong{required}): -date of source calibration in \code{"YYYY-MM-DD"}} - -\item{calib.dose.rate}{\link{numeric} (\strong{required}): -dose rate at date of calibration in Gy/s or Gy/min} - -\item{calib.error}{\link{numeric} (\strong{required}): -error of dose rate at date of calibration Gy/s or Gy/min} - -\item{source.type}{\link{character} (\emph{with default}): -specify irradiation source (\code{Sr-90}, \code{Co-60}, \code{Cs-137}, \code{Am-214}), -see details for further information} - -\item{dose.rate.unit}{\link{character} (\emph{with default}): -specify dose rate unit for input (\code{Gy/min} or \code{Gy/s}), the output is given in -Gy/s as valid for the function \link{Second2Gray}} - -\item{predict}{\link{integer} (\emph{with default}): -option allowing to predict the dose rate of the source over time in days -set by the provided value. Starting date is the value set with -\code{measurement.date}, e.g., \code{calc_SourceDoseRate(..., predict = 100)} calculates -the source dose rate for the next 100 days.} -} -\value{ -Returns an S4 object of type \linkS4class{RLum.Results}. -Slot \code{data} contains a \link{list} with the following structure: - -\if{html}{\out{
}}\preformatted{$ dose.rate (data.frame) -.. $ dose.rate -.. $ dose.rate.error -.. $ date (corresponding measurement date) -$ parameters (list) -.. $ source.type -.. $ halflife -.. $ dose.rate.unit -$ call (the original function call) -}\if{html}{\out{
}} - -The output should be accessed using the function \link{get_RLum}.\cr -A plot method of the output is provided via \link{plot_RLum} -} -\description{ -Calculating the dose rate of the irradiation source via the date of -measurement based on: source calibration date, source dose rate, dose rate -error. The function returns a data.frame that provides the input argument -dose_rate for the function \link{Second2Gray}. -} -\details{ -Calculation of the source dose rate based on the time elapsed since the last -calibration of the irradiation source. Decay parameters assume a Sr-90 beta -source. \deqn{dose.rate = D0 * exp(-log(2) / T.1/2 * t)} \cr with: D0 <- -calibration dose rate T.1/2 <- half-life of the source nuclide (here in -days) t <- time since source calibration (in days) log(2) / T.1/2 equals the -decay constant lambda - -Information on the date of measurements may be taken from the data's -original .BIN file (using e.g., \code{BINfile <- readBIN2R()} and the slot -\code{BINfile@METADATA$DATE}) - -\strong{Allowed source types and related values} - -\tabular{rllll}{ -\strong{#} \tab \strong{Source type} \tab \strong{T.1/2} \tab \strong{Reference} \cr -\verb{[1]} \tab Sr-90 \tab 28.90 y \tab NNDC, Brookhaven National Laboratory \cr -\verb{[2]}\tab Am-214 \tab 432.6 y \tab NNDC, Brookhaven National Laboratory \cr -\verb{[3]} \tab Co-60 \tab 5.274 y \tab NNDC, Brookhaven National Laboratory \cr -\verb{[4} \tab Cs-137 \tab 30.08 y \tab NNDC, Brookhaven National Laboratory} -} -\note{ -Please be careful when using the option \code{predict}, especially when a multiple set -for \code{measurement.date} and \code{calib.date} is provided. For the source dose rate prediction -the function takes the last value \code{measurement.date} and predicts from that the the source -source dose rate for the number of days requested, -means: the (multiple) original input will be replaced. However, the function -do not change entries for the calibration dates, but mix them up. Therefore, -it is not recommended to use this option when multiple calibration dates (\code{calib.date}) -are provided. -} -\section{Function version}{ - 0.3.2 -} - -\examples{ - - -##(1) Simple function usage -##Basic calculation of the dose rate for a specific date -dose.rate <- calc_SourceDoseRate(measurement.date = "2012-01-27", - calib.date = "2014-12-19", - calib.dose.rate = 0.0438, - calib.error = 0.0019) - -##show results -get_RLum(dose.rate) - -##(2) Usage in combination with another function (e.g., Second2Gray() ) -## load example data -data(ExampleData.DeValues, envir = environment()) - -## use the calculated variable dose.rate as input argument -## to convert De(s) to De(Gy) -Second2Gray(ExampleData.DeValues$BT998, dose.rate) - -##(3) source rate prediction and plotting -dose.rate <- calc_SourceDoseRate(measurement.date = "2012-01-27", - calib.date = "2014-12-19", - calib.dose.rate = 0.0438, - calib.error = 0.0019, - predict = 1000) -plot_RLum(dose.rate) - - -##(4) export output to a LaTeX table (example using the package 'xtable') -\dontrun{ -xtable::xtable(get_RLum(dose.rate)) - -} - -} - -\section{How to cite}{ -Fuchs, M.C., Kreutzer, S., 2024. calc_SourceDoseRate(): Calculation of the source dose rate via the date of measurement. Function version 0.3.2. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -NNDC, Brookhaven National Laboratory \verb{http://www.nndc.bnl.gov/} -} -\seealso{ -\link{Second2Gray}, \link{get_RLum}, \link{plot_RLum} -} -\author{ -Margret C. Fuchs, HZDR, Helmholtz-Institute Freiberg for Resource Technology (Germany) \cr -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{manip} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_Statistics.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_Statistics.Rd deleted file mode 100644 index b3c2de2ad..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_Statistics.Rd +++ /dev/null @@ -1,87 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_Statistics.R -\name{calc_Statistics} -\alias{calc_Statistics} -\title{Function to calculate statistic measures} -\usage{ -calc_Statistics( - data, - weight.calc = "square", - digits = NULL, - n.MCM = NULL, - na.rm = TRUE -) -} -\arguments{ -\item{data}{\link{data.frame} or \linkS4class{RLum.Results} object (\strong{required}): -for \link{data.frame} two columns: De (\code{data[,1]}) and De error (\code{data[,2]}). -To plot several data sets in one plot the data sets must be provided -as \code{list}, e.g. \code{list(data.1, data.2)}.} - -\item{weight.calc}{\link{character}: -type of weight calculation. One out of \code{"reciprocal"} (weight is 1/error), -\code{"square"} (weight is 1/error^2). Default is \code{"square"}.} - -\item{digits}{\link{integer} (\emph{with default}): -round numbers to the specified digits. -If digits is set to \code{NULL} nothing is rounded.} - -\item{n.MCM}{\link{numeric} (\emph{with default}): -number of samples drawn for Monte Carlo-based statistics. -\code{NULL} (the default) disables MC runs.} - -\item{na.rm}{\link{logical} (\emph{with default}): -indicating whether \code{NA} values should be stripped before the computation proceeds.} -} -\value{ -Returns a list with weighted and unweighted statistic measures. -} -\description{ -This function calculates a number of descriptive statistics for estimates -with a given standard error (SE), most fundamentally using error-weighted approaches. -} -\details{ -The option to use Monte Carlo Methods (\code{n.MCM}) allows calculating -all descriptive statistics based on random values. The distribution of these -random values is based on the Normal distribution with \code{De} values as -means and \code{De_error} values as one standard deviation. Increasing the -number of MCM-samples linearly increases computation time. On a Lenovo X230 -machine evaluation of 25 Aliquots with n.MCM = 1000 takes 0.01 s, with -n = 100000, ca. 1.65 s. It might be useful to work with logarithms of these -values. See Dietze et al. (2016, Quaternary Geochronology) and the function -\link{plot_AbanicoPlot} for details. -} -\section{Function version}{ - 0.1.7 -} - -\examples{ - -## load example data -data(ExampleData.DeValues, envir = environment()) - -## show a rough plot of the data to illustrate the non-normal distribution -plot_KDE(ExampleData.DeValues$BT998) - -## calculate statistics and show output -str(calc_Statistics(ExampleData.DeValues$BT998)) - -\dontrun{ -## now the same for 10000 normal distributed random numbers with equal errors -x <- as.data.frame(cbind(rnorm(n = 10^5, mean = 0, sd = 1), - rep(0.001, 10^5))) - -## note the congruent results for weighted and unweighted measures -str(calc_Statistics(x)) -} - -} -\author{ -Michael Dietze, GFZ Potsdam (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Dietze, M., 2024. calc_Statistics(): Function to calculate statistic measures. Function version 0.1.7. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_TLLxTxRatio.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_TLLxTxRatio.Rd deleted file mode 100644 index 407167a86..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_TLLxTxRatio.Rd +++ /dev/null @@ -1,112 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_TLLxTxRatio.R -\name{calc_TLLxTxRatio} -\alias{calc_TLLxTxRatio} -\title{Calculate the Lx/Tx ratio for a given set of TL curves -beta version-} -\usage{ -calc_TLLxTxRatio( - Lx.data.signal, - Lx.data.background = NULL, - Tx.data.signal, - Tx.data.background = NULL, - signal.integral.min, - signal.integral.max -) -} -\arguments{ -\item{Lx.data.signal}{\linkS4class{RLum.Data.Curve} or \link{data.frame} (\strong{required}): -TL data (x = temperature, y = counts) (TL signal)} - -\item{Lx.data.background}{\linkS4class{RLum.Data.Curve} or \link{data.frame} (\emph{optional}): -TL data (x = temperature, y = counts). -If no data are provided no background subtraction is performed.} - -\item{Tx.data.signal}{\linkS4class{RLum.Data.Curve} or \link{data.frame} (\strong{required}): -TL data (x = temperature, y = counts) (TL test signal)} - -\item{Tx.data.background}{\linkS4class{RLum.Data.Curve} or \link{data.frame} (\emph{optional}): -TL data (x = temperature, y = counts). -If no data are provided no background subtraction is performed.} - -\item{signal.integral.min}{\link{integer} (\strong{required}): -channel number for the lower signal integral bound -(e.g. \code{signal.integral.min = 100})} - -\item{signal.integral.max}{\link{integer} (\strong{required}): -channel number for the upper signal integral bound -(e.g. \code{signal.integral.max = 200})} -} -\value{ -Returns an S4 object of type \linkS4class{RLum.Results}. -Slot \code{data} contains a \link{list} with the following structure: - -\if{html}{\out{
}}\preformatted{$ LxTx.table -.. $ LnLx -.. $ LnLx.BG -.. $ TnTx -.. $ TnTx.BG -.. $ Net_LnLx -.. $ Net_LnLx.Error -}\if{html}{\out{
}} -} -\description{ -Calculate Lx/Tx ratio for a given set of TL curves. -} -\details{ -\strong{Uncertainty estimation} - -The standard errors are calculated using the following generalised equation: - -\deqn{SE_{signal} = abs(Signal_{net} * BG_f /BG_{signal})} - -where \eqn{BG_f} is a term estimated by calculating the standard deviation of the sum of -the \eqn{L_x} background counts and the sum of the \eqn{T_x} background counts. However, -if both signals are similar the error becomes zero. -} -\note{ -\strong{This function has still BETA status!} Please further note that a similar -background for both curves results in a zero error and is therefore set to \code{NA}. -} -\section{Function version}{ - 0.3.3 -} - -\examples{ - -##load package example data -data(ExampleData.BINfileData, envir = environment()) - -##convert Risoe.BINfileData into a curve object -temp <- Risoe.BINfileData2RLum.Analysis(TL.SAR.Data, pos = 3) - - -Lx.data.signal <- get_RLum(temp, record.id=1) -Lx.data.background <- get_RLum(temp, record.id=2) -Tx.data.signal <- get_RLum(temp, record.id=3) -Tx.data.background <- get_RLum(temp, record.id=4) -signal.integral.min <- 210 -signal.integral.max <- 230 - -output <- calc_TLLxTxRatio( - Lx.data.signal, - Lx.data.background, - Tx.data.signal, - Tx.data.background, - signal.integral.min, - signal.integral.max) -get_RLum(output) - -} -\seealso{ -\linkS4class{RLum.Results}, \link{analyse_SAR.TL} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) \cr -Christoph Schmidt, University of Bayreuth (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., Schmidt, C., 2024. calc_TLLxTxRatio(): Calculate the Lx/Tx ratio for a given set of TL curves -beta version-. Function version 0.3.3. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_ThermalLifetime.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_ThermalLifetime.Rd deleted file mode 100644 index 3a0b1f15e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_ThermalLifetime.Rd +++ /dev/null @@ -1,166 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_ThermalLifetime.R -\name{calc_ThermalLifetime} -\alias{calc_ThermalLifetime} -\title{Calculates the Thermal Lifetime using the Arrhenius equation} -\usage{ -calc_ThermalLifetime( - E, - s, - T = 20, - output_unit = "Ma", - profiling = FALSE, - profiling_config = NULL, - verbose = TRUE, - plot = TRUE, - ... -) -} -\arguments{ -\item{E}{\link{numeric} (\strong{required}): -vector of trap depths in eV, -if \code{profiling = TRUE} only the first two elements are considered} - -\item{s}{\link{numeric} (\strong{required}): -vector of frequency factor in 1/s, -if \code{profiling = TRUE} only the first two elements are considered} - -\item{T}{\link{numeric} (\emph{with default}): -temperature in deg. C for which the lifetime(s) will be calculated. -A vector can be provided.} - -\item{output_unit}{\link{character} (\emph{with default}): -output unit of the calculated lifetimes, accepted -entries are: \code{"Ma"}, \code{"ka"}, \code{"a"}, \code{"d"}, \code{"h"}, \code{"min"}, \code{"s"}} - -\item{profiling}{\link{logical} (\emph{with default}): -this option allows to estimate uncertainties based on -given E and s parameters and their corresponding standard error -(cf. details and examples section)} - -\item{profiling_config}{\link{list} (\emph{optional}): -allows to set configuration parameters used for the profiling -(and only have an effect here). Supported parameters are: -\itemize{ -\item \code{n} (number of MC runs), -\item \code{E.distribution} (distribution used for the re-sampling for E) and -\item \code{s.distribution} (distribution used for the re-sampling for s). -} - -Currently only the normal distribution is supported -(e.g., \code{profiling_config = list(E.distribution = "norm")}} - -\item{verbose}{\link{logical}: -enables/disables verbose mode} - -\item{plot}{\link{logical}: -enables/disables output plot, currently only in combination with \code{profiling = TRUE}.} - -\item{...}{further arguments that can be passed in combination with the plot output. -Standard plot parameters are supported (\link{plot.default})} -} -\value{ -A \linkS4class{RLum.Results} object is returned a along with a plot (for -\code{profiling = TRUE}). The output object contain the following slots: - -\strong{\verb{@data}} - -\tabular{lll}{ -\strong{Object} \tab \strong{Type} \tab \strong{Description} \cr -\code{lifetimes} \tab \link{array} or \link{numeric} \tab calculated lifetimes \cr -\code{profiling_matrix} \tab \link{matrix} \tab profiling matrix used for the MC runs -} - -\strong{\verb{@info}} - -\tabular{lll}{ -\strong{Object} \tab \strong{Type} \tab \strong{Description} \cr -\code{call} \tab \code{call} \tab the original function call -} -} -\description{ -The function calculates the thermal lifetime of charges for given E (in eV), s (in 1/s) and -T (in deg. C.) parameters. The function can be used in two operational modes: -} -\details{ -\strong{Mode 1 \code{(profiling = FALSE)}} - -An arbitrary set of input parameters (E, s, T) can be provided and the -function calculates the thermal lifetimes using the Arrhenius equation for -all possible combinations of these input parameters. An array with 3-dimensions -is returned that can be used for further analyses or graphical output (see example 1) - -\strong{Mode 2 \code{(profiling = TRUE)}} - -This mode tries to profile the variation of the thermal lifetime for a chosen -temperature by accounting for the provided E and s parameters and their corresponding -standard errors, e.g., \code{E = c(1.600, 0.001)} -The calculation based on a Monte Carlo simulation, where values are sampled from a normal -distribution (for E and s). - -\strong{Used equation (Arrhenius equation)} - -\deqn{\tau = 1/s exp(E/kT)} -where: -\eqn{\tau} in s as the mean time an electron spends in the trap for a given \eqn{T}, -\eqn{E} trap depth in eV, -\eqn{s} the frequency factor in 1/s, -\eqn{T} the temperature in K and \eqn{k} the Boltzmann constant in eV/K (cf. Furetta, 2010). -} -\note{ -The profiling is currently based on re-sampling from a normal distribution, this -distribution assumption might be, however, not valid for given E and s parameters. -} -\section{Function version}{ - 0.1.0 -} - -\examples{ - -##EXAMPLE 1 -##calculation for two trap-depths with similar frequency factor for different temperatures -E <- c(1.66, 1.70) -s <- 1e+13 -T <- 10:20 -temp <- calc_ThermalLifetime( - E = E, - s = s, - T = T, - output_unit = "Ma" -) -contour(x = E, y = T, z = temp$lifetimes[1,,], - ylab = "Temperature [\u00B0C]", - xlab = "Trap depth [eV]", - main = "Thermal Lifetime Contour Plot" -) -mtext(side = 3, "(values quoted in Ma)") - -##EXAMPLE 2 -##profiling of thermal life time for E and s and their standard error -E <- c(1.600, 0.003) -s <- c(1e+13,1e+011) -T <- 20 -calc_ThermalLifetime( - E = E, - s = s, - T = T, - profiling = TRUE, - output_unit = "Ma" -) - -} - -\section{How to cite}{ -Kreutzer, S., 2024. calc_ThermalLifetime(): Calculates the Thermal Lifetime using the Arrhenius equation. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Furetta, C., 2010. Handbook of Thermoluminescence, Second Edition. World Scientific. -} -\seealso{ -\link[graphics:matplot]{graphics::matplot}, \link[stats:Normal]{stats::rnorm}, \link{get_RLum} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_WodaFuchs2008.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_WodaFuchs2008.Rd deleted file mode 100644 index 06292438d..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_WodaFuchs2008.Rd +++ /dev/null @@ -1,67 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_WodaFuchs2008.R -\name{calc_WodaFuchs2008} -\alias{calc_WodaFuchs2008} -\title{Obtain the equivalent dose using the approach by Woda and Fuchs 2008} -\usage{ -calc_WodaFuchs2008(data, breaks = NULL, plot = TRUE, ...) -} -\arguments{ -\item{data}{\link{data.frame} \link{vector}, or \linkS4class{RLum.Results} object (\strong{required}): -for \link{data.frame}: either two columns: De (\code{values[,1]}) and De error -(\code{values[,2]}), or one: De (\code{values[,1]}). If a numeric vector or a -single-column data frame is provided, De error is set to \code{NA}. -For plotting multiple data sets, these must be provided as \code{list} -(e.g. \code{list(dataset1, dataset2)}).} - -\item{breaks}{\link{numeric}: -Either number or locations of breaks. See \verb{[hist]} for details. -If missing, the number of breaks will be estimated based on the bin width -(as function of median error).} - -\item{plot}{\link{logical} (\emph{with default}): -enable plot output.} - -\item{...}{Further plot arguments passed to the function.} -} -\description{ -The function generates a histogram-like reorganisation of the data, to -assess counts per bin. The log-transformed counts per bin are used to -calculate the second derivative of the data (i.e., the curvature of the -curve) and to find the central value of the bin hosting the distribution -maximum. A normal distribution model is fitted to the counts per bin -data to estimate the dose distribution parameters. The uncertainty of the -model is estimated based on all input equivalent doses smaller that of the -modelled central value. -} -\section{Function version}{ - 0.2.0 -} - -\examples{ - -## read example data set -data(ExampleData.DeValues, envir = environment()) - -results <- calc_WodaFuchs2008( - data = ExampleData.DeValues$CA1, - xlab = expression(paste(D[e], " [Gy]")) - ) - -} - -\section{How to cite}{ -Kreutzer, S., Dietze, M., 2024. calc_WodaFuchs2008(): Obtain the equivalent dose using the approach by Woda and Fuchs 2008. Function version 0.2.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Woda, C., Fuchs, M., 2008. On the applicability of the leading edge method to -obtain equivalent doses in OSL dating and dosimetry. Radiation Measurements 43, 26-37. -} -\seealso{ -\link{calc_FuchsLang2001}, \link{calc_CentralDose} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany),\cr -Michael Dietze, GFZ Potsdam (Germany) -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_gSGC.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_gSGC.Rd deleted file mode 100644 index dc21b11c0..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_gSGC.Rd +++ /dev/null @@ -1,98 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_gSGC.R -\name{calc_gSGC} -\alias{calc_gSGC} -\title{Calculate De value based on the gSGC by Li et al., 2015} -\usage{ -calc_gSGC( - data, - gSGC.type = "0-250", - gSGC.parameters, - n.MC = 100, - verbose = TRUE, - plot = TRUE, - ... -) -} -\arguments{ -\item{data}{\link{data.frame} (\strong{required}): -input data of providing the following columns: \code{LnTn}, \code{LnTn.error}, \code{Lr1Tr1}, \code{Lr1Tr1.error}, \code{Dr1} -\strong{Note:} column names are not required. The function expects the input data in the given order} - -\item{gSGC.type}{\link{character} (\emph{with default}): -define the function parameters that -should be used for the iteration procedure: Li et al., 2015 (Table 2) -presented function parameters for two dose ranges: \code{"0-450"} and \code{"0-250"}} - -\item{gSGC.parameters}{\link{list} (\emph{optional}): -option to provide own function parameters used for fitting as named list. -Nomenclature follows Li et al., 2015, i.e. \code{list(A,A.error,D0,D0.error,c,c.error,Y0,Y0.error,range)}, -range requires a vector for the range the function is considered as valid, e.g. \code{range = c(0,250)}\cr -Using this option overwrites the default parameter list of the gSGC, meaning the argument -\code{gSGC.type} will be without effect} - -\item{n.MC}{\link{integer} (\emph{with default}): -number of Monte Carlo simulation runs for error estimation, see details.} - -\item{verbose}{\link{logical}: -enable or disable terminal output} - -\item{plot}{\link{logical}: -enable or disable graphical feedback as plot} - -\item{...}{parameters will be passed to the plot output} -} -\value{ -Returns an S4 object of type \linkS4class{RLum.Results}. - -\strong{\verb{@data}}\cr -\verb{$ De.value} (\link{data.frame}) \cr -\code{.. $ De} \cr -\code{.. $ De.error} \cr -\code{.. $ Eta} \cr -\verb{$ De.MC} (\link{list}) contains the matrices from the error estimation.\cr -\verb{$ uniroot} (\link{list}) contains the \link{uniroot} outputs of the De estimations\cr - -\strong{\verb{@info}}\cr -`$ call`` (\link{call}) the original function call -} -\description{ -Function returns De value and De value error using the global standardised growth -curve (gSGC) assumption proposed by Li et al., 2015 for OSL dating of sedimentary quartz -} -\details{ -The error of the De value is determined using a Monte Carlo simulation approach. -Solving of the equation is realised using \link{uniroot}. -Large values for \code{n.MC} will significantly increase the computation time. -} -\section{Function version}{ - 0.1.1 -} - -\examples{ - -results <- calc_gSGC(data = data.frame( -LnTn = 2.361, LnTn.error = 0.087, -Lr1Tr1 = 2.744, Lr1Tr1.error = 0.091, -Dr1 = 34.4)) - -get_RLum(results, data.object = "De") - -} - -\section{How to cite}{ -Kreutzer, S., 2024. calc_gSGC(): Calculate De value based on the gSGC by Li et al., 2015. Function version 0.1.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Li, B., Roberts, R.G., Jacobs, Z., Li, S.-H., 2015. Potential of establishing -a 'global standardised growth curve' (gSGC) for optical dating of quartz from sediments. -Quaternary Geochronology 27, 94-104. doi:10.1016/j.quageo.2015.02.011 -} -\seealso{ -\linkS4class{RLum.Results}, \link{get_RLum}, \link{uniroot} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_gSGC_feldspar.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_gSGC_feldspar.Rd deleted file mode 100644 index fe36d3ba5..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/calc_gSGC_feldspar.Rd +++ /dev/null @@ -1,93 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_gSGC_feldspar.R -\name{calc_gSGC_feldspar} -\alias{calc_gSGC_feldspar} -\title{Calculate Global Standardised Growth Curve (gSGC) for Feldspar MET-pIRIR} -\usage{ -calc_gSGC_feldspar( - data, - gSGC.type = "50LxTx", - gSGC.parameters, - n.MC = 100, - plot = FALSE -) -} -\arguments{ -\item{data}{\link{data.frame} (\strong{required}): data frame with five columns per sample -\code{c("LnTn", "LnTn.error", "Lr1Tr1", "Lr1Tr1.error","Dr1")}} - -\item{gSGC.type}{\link{character} (\emph{with default}): growth curve type to be selected -according to Table 3 in Li et al. (2015). Allowed options are -\code{"50LxTx"}, \code{"50Lx"}, \code{"50Tx"}, \code{"100LxTx"}, \code{"100Lx"}, \code{"100Tx"}, \code{"150LxTx"}, -\code{"150Lx"}, \code{"150Tx"}, \code{"200LxTx"}, \code{"200Lx"}, \code{"200Tx"}, \code{"250LxTx"}, \code{"250Lx"}, -\code{"250Tx"}} - -\item{gSGC.parameters}{\link{data.frame} (\emph{optional}): an own parameter set for the -gSGC with the following columns \code{y1}, \code{y1_err}, \code{D1} -\code{D1_err}, \code{y2}, \code{y2_err}, \code{y0}, \code{y0_err}.} - -\item{n.MC}{\link{numeric} (\emph{with default}): number of Monte-Carlo runs for the -error calculation} - -\item{plot}{\link{logical} (\emph{with default}): enables/disables the control plot output} -} -\value{ -Returns an S4 object of type \linkS4class{RLum.Results}. - -\strong{\verb{@data}}\cr -\verb{$ df} (\link{data.frame}) \cr -\code{.. $DE} the calculated equivalent dose\cr -\code{.. $DE.ERROR} error on the equivalent dose, which is the standard deviation of the MC runs\cr -\code{.. $HPD95_LOWER} lower boundary of the highest probability density (95\%)\cr -\code{.. $HPD95_UPPER} upper boundary of the highest probability density (95\%)\cr -\verb{$ m.MC} (\link{list}) numeric vector with results from the MC runs.\cr - -\strong{\verb{@info}}\cr -`$ call`` (\link{call}) the original function call -} -\description{ -Implementation of the gSGC approach for feldspar MET-pIRIR by Li et al. (2015) -} -\details{ -##TODO -} -\section{Function version}{ - 0.1.0 -} - -\examples{ - -##test on a generated random sample -n_samples <- 10 -data <- data.frame( - LnTn = rnorm(n=n_samples, mean=1.0, sd=0.02), - LnTn.error = rnorm(n=n_samples, mean=0.05, sd=0.002), - Lr1Tr1 = rnorm(n=n_samples, mean=1.0, sd=0.02), - Lr1Tr1.error = rnorm(n=n_samples, mean=0.05, sd=0.002), - Dr1 = rep(100,n_samples)) - -results <- calc_gSGC_feldspar( - data = data, gSGC.type = "50LxTx", - plot = FALSE) - -plot_AbanicoPlot(results) - -} - -\section{How to cite}{ -Gray, H.J., Kreutzer, S., 2024. calc_gSGC_feldspar(): Calculate Global Standardised Growth Curve (gSGC) for Feldspar MET-pIRIR. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Li, B., Roberts, R.G., Jacobs, Z., Li, S.-H., Guo, Y.-J., 2015. -Construction of a “global standardised growth curve” (gSGC) for infrared -stimulated luminescence dating of K-feldspar 27, 119–130. \doi{10.1016/j.quageo.2015.02.010} -} -\seealso{ -\linkS4class{RLum.Results}, \link{get_RLum}, \link{uniroot}, \link{calc_gSGC} -} -\author{ -Harrison Gray, USGS (United States), -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/combine_De_Dr.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/combine_De_Dr.Rd deleted file mode 100644 index 0db5ca6c3..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/combine_De_Dr.Rd +++ /dev/null @@ -1,184 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/combine_De_Dr.R -\name{combine_De_Dr} -\alias{combine_De_Dr} -\title{Combine Dose Rate and Equivalent Dose Distribution} -\usage{ -combine_De_Dr( - De, - s, - Dr, - int_OD, - Age_range = c(1, 300), - outlier_threshold = 0.05, - outlier_method = "default", - outlier_analysis_plot = FALSE, - method_control = list(), - par_local = TRUE, - verbose = TRUE, - plot = TRUE, - ... -) -} -\arguments{ -\item{De}{\link{numeric} (\strong{required}): a equivalent dose sample} - -\item{s}{\link{numeric} (\strong{required}): a vector of measurement errors on the equivalent dose} - -\item{Dr}{\link{numeric} (\strong{required}): a dose rate sample} - -\item{int_OD}{\link{numeric} (\strong{required}): the intrinsic overdispersion, typically the standard deviation -characterizing a dose-recovery test distribution} - -\item{Age_range}{\link{numeric} (\emph{with default}): the age range to be investigated by the algorithm, the larger -the value the more iterations are needed and the longer it takes. Should not be set too narrow, cut -the algorithm some slack.} - -\item{outlier_threshold}{\link{numeric} (\emph{with default}): the required significance level used -for the outlier detection. If set to \code{1}, no outliers are removed. If -\code{outlier_method = "RousseeuwCroux1993"}, the median distance is used as outlier threshold. -Please see details for further information.} - -\item{outlier_method}{\link{character} (\emph{with default}): select the outlier detection -method, either \code{"default"} or \code{"RousseeuwCroux1993"}. See details for further information.} - -\item{outlier_analysis_plot}{\link{logical} (\emph{with default}): enables/disables the outlier analysis plot. Note: the outlier analysis will happen with or without plot output} - -\item{method_control}{\link{list} (\emph{with default}): named \link{list} of further parameters passed down -to the \link[rjags:rjags-package]{rjags::rjags} modelling} - -\item{par_local}{\link{logical} (\emph{with default}): if set to \code{TRUE} the function uses its -own \link[graphics:par]{graphics::par} settings (which will end in two plots next to each other)} - -\item{verbose}{\link{logical} (\emph{with default}): enable/disable terminal feedback} - -\item{plot}{\link{logical} (\emph{with default}): enable/disable plot output} - -\item{...}{a few further arguments to fine-tune the plot output such as -\code{cdf_ADr_quantiles} (\code{TRUE}/\code{FALSE}), \code{legend.pos}, \code{legend} (\code{TRUE}/\code{FALSE})} -} -\value{ -The function returns a plot if \code{plot = TRUE} and an \linkS4class{RLum.Results} -object with the following slots: - -\verb{@data}\cr -\code{.. $Ages}: a \link{numeric} vector with the modelled ages to be further analysed or visualised\cr -\code{.. $Ages_stats}: a \link{data.frame} with sum HPD, CI 68\% and CI 95\% for the ages \cr -\code{.. $outliers_index}: the index with the detected outliers\cr -\code{.. $cdf_ADr_mean} : empirical cumulative density distribution A * Dr (mean)\cr -\code{.. $cdf_ADr_quantiles} : empirical cumulative density distribution A * Dr (quantiles .025,.975)\cr -\code{.. $cdf_De_no_outlier} : empirical cumulative density distribution of the De with no outliers\cr -\code{.. $cdf_De_initial} : empirical cumulative density distribution of the initial De\cr -\code{.. $mcmc_IAM} : the MCMC list of the Individual Age Model, only of \code{method_control = list(return_mcmc = TRUE)} otherwise \code{NULL}\cr -\code{.. $mcmc_BCAM} : the MCMC list of the Bayesian Central Age Model, only of \code{method_control = list(return_mcmc = TRUE)} otherwise \code{NULL}\cr - -\verb{@info}\cr -\code{.. $call}: the original function call\cr -\code{.. $model_IAM}: the BUGS model used to derive the individual age\cr -\code{.. $model_BCAM}: the BUGS model used to calculate the Bayesian Central Age\cr -} -\description{ -A Bayesian statistical analysis of OSL age requiring dose rate sample. -Estimation contains a preliminary step for detecting outliers in the equivalent -dose sample. -} -\details{ -\strong{Outlier detection} - -Two different outlier detection methods are implemented (full details are given -in the cited literature). -\enumerate{ -\item The \emph{default} and recommend method, uses quantiles to compare prior and -posterior distributions of the individual variances of the equivalent doses. -If the corresponding quantile in the corresponding posterior distribution is larger -than the quantile in the prior distribution, the value is marked -as outlier (cf. Galharret et al., preprint) -\item The alternative method employs the method suggested by Rousseeuw and Croux (1993) -using the absolute median distance. -} - -\strong{Parameters available for \code{method_control}} - -The parameters listed below are used to granular control Bayesian modelling using -\link[rjags:rjags-package]{rjags::rjags}. Internally the functions \code{.calc_IndividualAgeModel()} and -\code{.calc_BayesianCentraAgelModel()}. The parameter settings affect both models. -Note: \code{method_control} expects a \strong{named} list of parameters - -\tabular{llll}{ -\strong{PARAMETER} \tab \strong{TYPE} \tab \strong{DEFAULT} \tab \strong{REMARKS} \cr -\code{variable.names_IAM} \tab \link{character} \tab \code{c('A', 'a', 'sig_a')} \tab variables names to be monitored in the modelling process using the internal function \code{.calc_IndividualAgeModel()}\cr -\code{variable.names_BCAM} \tab \link{character} \tab \code{c('A', 'D_e')} \tab variables names to be monitored in the modelling process using the internal function \code{.calc_BayesianCentraAgelModel()}\cr -\code{n.chains} \tab \link{integer} \tab \code{4} \tab number of MCMC chains\cr -\code{n.adapt} \tab \link{integer} \tab \code{1000} \tab number of iterations for the adaptation\cr -\code{n.iter} \tab \link{integer} \tab \code{5000} \tab number of iterations to monitor cf. \link[rjags:coda.samples]{rjags::coda.samples}\cr -\code{thin} \tab \link{numeric} \tab \code{1} \tab thinning interval for the monitoring cf. \link[rjags:coda.samples]{rjags::coda.samples}\cr -\code{diag} \tab \link{logical} \tab \code{FALSE} \tab additional terminal convergence diagnostic. -\code{FALSE} if \code{verbose = FALSE}\cr -\code{progress.bar} \tab \link{logical} \tab \code{FALSE} \tab enable/disable progress bar. \code{FALSE} if \code{verbose = FALSE}\cr -\code{quiet} \tab \link{logical} \tab \code{TRUE} \tab silence terminal output. Set to \code{TRUE} if \code{verbose = FALSE}\cr -\code{return_mcmc}\tab \link{logical} \tab \code{FALSE} \tab return additional MCMC diagnostic information\cr -} -} -\section{Function version}{ - 0.1.0 -} - -\examples{ -## set parameters -Dr <- stats::rlnorm (1000, 0, 0.3) -De <- 50*sample(Dr, 50, replace = TRUE) -s <- stats::rnorm(50, 10, 2) - -## run modelling -## note: modify parameters for more realistic results -\dontrun{ -results <- combine_De_Dr( - Dr = Dr, - int_OD = 0.1, - De, - s, - Age_range = c(0,100), - method_control = list( - n.iter = 100, - n.chains = 1)) - -## show models used -writeLines(results@info$model_IAM) -writeLines(results@info$model_BCAM) -} - -} - -\section{How to cite}{ -Philippe, A., Galharret, J., Mercier, N., Kreutzer, S., 2024. combine_De_Dr(): Combine Dose Rate and Equivalent Dose Distribution. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Mercier, N., Galharret, J.-M., Tribolo, C., Kreutzer, S., Philippe, A., preprint. -Luminescence age calculation through Bayesian convolution of equivalent dose and -dose-rate distributions: the De_Dr model. Geochronology, 1-22. - -Galharret, J-M., Philippe, A., Mercier, N., preprint. Detection of outliers with -a Bayesian hierarchical model: application to the single-grain luminescence dating method. -Electronic Journal of Applied Statistics - -\strong{Further reading} - -Rousseeuw, P.J., Croux, C., 1993. Alternatives to the median absolute deviation. -Journal of the American Statistical Association 88, 1273–1283. \doi{10.2307/2291267} - -Rousseeuw, P.J., Debruyne, M., Engelen, S., Hubert, M., 2006. Robustness and outlier detection in chemometrics. -Critical Reviews in Analytical Chemistry 36, 221–242. \doi{10.1080/10408340600969403} -} -\seealso{ -\link{plot_OSLAgeSummary}, \link[rjags:rjags-package]{rjags::rjags}, \link[mclust:mclust-package]{mclust::mclust-package} -} -\author{ -Anne Philippe, Université de Nantes (France), -Jean-Michel Galharret, Université de Nantes (France), -Norbert Mercier, IRAMAT-CRP2A, Université Bordeaux Montaigne (France), -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{datagen} -\keyword{distribution} -\keyword{dplot} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_Activity2Concentration.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_Activity2Concentration.Rd deleted file mode 100644 index 9f266084d..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_Activity2Concentration.Rd +++ /dev/null @@ -1,120 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/convert_Activity2Concentration.R -\name{convert_Activity2Concentration} -\alias{convert_Activity2Concentration} -\title{Convert Nuclide Activities to Abundance and Vice Versa} -\usage{ -convert_Activity2Concentration(data, input_unit = "activity", verbose = TRUE) -} -\arguments{ -\item{data}{\link{data.frame} \strong{(required)}: -provide dose rate data (activity or concentration) in three columns. -The first column indicates the nuclide, the 2nd column measured value and -in the 3rd column its error value. Allowed nuclide data are -\code{'U-238'}, \code{'Th-232'} and \code{'K-40'}. See examples for an example.} - -\item{input_unit}{\link{character} (\emph{with default}): -specify unit of input data given in the dose rate data frame, choose between -\code{"activity"} (considered as given Bq/kg) and \code{"abundance"} (considered as given in mug/g or mass. \%). -The default value is \code{"activity"}} - -\item{verbose}{\link{logical} (\emph{with default}): -enable or disable verbose mode} -} -\value{ -Returns an \linkS4class{RLum.Results} object with a \link{data.frame} containing -input and newly calculated values. Please not that in the column header µg/g -is written as \code{mug/g} due to the R requirement to maintain packages portable using -ASCII characters only. -} -\description{ -The function performs the conversion of the specific activities into -mass abundance and vice versa for the radioelements U, Th, and K to -harmonise the measurement unit with the required data input unit of -potential analytical tools for, e.g. dose rate calculation or related -functions such as \link{use_DRAC}. -} -\details{ -The conversion from nuclide activity of a sample to nuclide concentration -is performed using conversion factors that are based on the mass-related -specific activity of the respective nuclide. - -Constants used in this function were obtained from \verb{https://physics.nist.gov/cuu/Constants/} -all atomic weights and composition values from -\verb{https://www.nist.gov/pml/atomic-weights-and-isotopic-compositions-relative-atomic-masses} -and the nuclide data from \verb{https://www.iaea.org/resources/databases/livechart-of-nuclides-advanced-version} - -The factors can be calculated using the equation: - -\deqn{ -A = N_A \frac{N_{abund}}{N_{mol.mass}} ln(2) / N.half.life -} - -to convert in µg/g we further use: - -\deqn{ -f = A / 10^6 -} - -where: -\itemize{ -\item \code{N_A} - Avogadro constant in 1/mol -\item \code{A} - specific activity of the nuclide in Bq/kg -\item \code{N.abund} - relative natural abundance of the isotope -\item \code{N.mol.mass} molar mass in kg/mol -\item \code{N.half.life} half-life of the nuclide in s -} - -example for calculating the activity of the radionuclide U-238: -\itemize{ -\item \code{N_A} = 6.02214076e+23 (1/mol) -\item \code{T_0.5} = 1.41e+17 (s) -\item \code{m_U_238} = 0.23802891 (kg/mol) -\item \code{U_abund} = 0.992745 (unitless) -} - -\deqn{A_{U} = N_{A} * U_{abund} / m_{U_238} * ln(2) / T_{1/2} = 2347046} (Bq/kg) - -\deqn{f.U = A_{U} / 10^6} -} -\note{ -Although written otherwise for historical reasons. Input values must be element values. -For instance, if a value is provided for U-238 the function assumes that this value -represents the sum (activity or abundance) of U-238, U-235 and U-234. -In other words, 1 µg/g of U means that this is the composition of 0.992 parts of U-238, -0.000054 parts of U-234, and 0.00072 parts of U-235. -} -\section{Function version}{ - 0.1.2 -} - -\examples{ - -##construct data.frame -data <- data.frame( - NUCLIDES = c("U-238", "Th-232", "K-40"), - VALUE = c(40,80,100), - VALUE_ERROR = c(4,8,10), - stringsAsFactors = FALSE) - -##perform analysis -convert_Activity2Concentration(data) - -} - -\section{How to cite}{ -Fuchs, M.C., 2024. convert_Activity2Concentration(): Convert Nuclide Activities to Abundance and Vice Versa. Function version 0.1.2. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Debertin, K., Helmer, R.G., 1988. Gamma- and X-ray Spectrometry with -Semiconductor Detectors, Elsevier Science Publishers, p.283 - -Wiechen, A., Ruehle, H., Vogl, K., 2013. Bestimmung der massebezogenen -Aktivitaet von Radionukliden. AEQUIVAL/MASSAKT, ISSN 1865-8725, -\url{https://www.bmuv.de/fileadmin/Daten_BMU/Download_PDF/Strahlenschutz/aequival-massakt_v2013-07_bf.pdf} -} -\author{ -Margret C. Fuchs, Helmholtz-Institute Freiberg for Resource Technology (Germany) -, RLum Developer Team} -\keyword{IO} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_BIN2CSV.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_BIN2CSV.Rd deleted file mode 100644 index 2a9078bed..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_BIN2CSV.Rd +++ /dev/null @@ -1,58 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/convert_BIN2CSV.R -\name{convert_BIN2CSV} -\alias{convert_BIN2CSV} -\title{Export Risoe BIN-file(s) to CSV-files} -\usage{ -convert_BIN2CSV(file, ...) -} -\arguments{ -\item{file}{\link{character} (\strong{required}): -name of the BIN-file to be converted to CSV-files} - -\item{...}{further arguments that will be passed to the function -\link{read_BIN2R} and \link{write_RLum2CSV}} -} -\value{ -The function returns either a CSV-file (or many of them) or for the -option \code{export == FALSE} a list comprising objects of type \link{data.frame} and \link{matrix} -} -\description{ -This function is a wrapper function around the functions \link{read_BIN2R} and -\link{write_RLum2CSV} and it imports a Risoe BIN-file and directly exports its -content to CSV-files. If nothing is set for the argument \code{path} -(\link{write_RLum2CSV}) the input folder will become the output folder. -} -\section{Function version}{ - 0.1.0 -} - -\examples{ - -##transform Risoe.BINfileData values to a list -data(ExampleData.BINfileData, envir = environment()) -convert_BIN2CSV(subset(CWOSL.SAR.Data, POSITION == 1), export = FALSE) - -\dontrun{ -##select your BIN-file -file <- file.choose() - -##convert -convert_BIN2CSV(file) - -} - -} -\seealso{ -\linkS4class{RLum.Analysis}, \linkS4class{RLum.Data}, \linkS4class{RLum.Results}, -\link[utils:write.table]{utils::write.table}, \link{write_RLum2CSV}, \link{read_BIN2R} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. convert_BIN2CSV(): Export Risoe BIN-file(s) to CSV-files. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{IO} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_Concentration2DoseRate.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_Concentration2DoseRate.Rd deleted file mode 100644 index bf7345e43..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_Concentration2DoseRate.Rd +++ /dev/null @@ -1,114 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/convert_Concentration2DoseRate.R -\name{convert_Concentration2DoseRate} -\alias{convert_Concentration2DoseRate} -\title{Dose-rate conversion function} -\usage{ -convert_Concentration2DoseRate(input, conversion = "Guerinetal2011") -} -\arguments{ -\item{input}{\link{data.frame} (\emph{optional}): a table containing all relevant information -for each individual layer if nothing is provided, the function returns a template \link{data.frame} -Please note that until one dataset per input is supported!} - -\item{conversion}{\link{character} (\emph{with default}): which dose rate conversion factors to use, -defaults uses Guérin et al. (2011). For accepted values see \link{BaseDataSet.ConversionFactors}} -} -\value{ -The function returns an \linkS4class{RLum.Results} object for which the first -element is \link{matrix} with the converted values. If no input is provided, the -function returns a template \link{data.frame} that can be used as input. -} -\description{ -This function converts radionuclide concentrations -(K in \%, Th and U in ppm) into dose rates (Gy/ka). Beta-dose rates are also -attenuated for the grain size. Beta and gamma-dose rates are corrected -for the water content. This function converts concentrations into dose rates -(Gy/ka) and corrects for grain size attenuation and water content - -Dose rate conversion factors can be chosen from Adamiec and Aitken (1998), -Guerin et al. (2011), Liritzis et al. (201) and Cresswell et al. (2018). -Default is Guerin et al. (2011). - -Grain size correction for beta dose rates is achieved using the correction -factors published by Guérin et al. (2012). - -Water content correction is based on factors provided by Aitken (1985), -with the factor for beta dose rate being 1.25 and for gamma 1.14. -} -\details{ -\strong{The input data} - -\tabular{lll}{ -COLUMN \tab DATA TYPE \tab DESCRIPTION\cr -\code{Mineral} \tab \code{character} \tab \code{'FS'} for feldspar, \code{'Q'} for quartz\cr -\code{K} \tab \code{numeric} \tab K nuclide content in \%\cr -\code{K_SE} \tab \code{numeric} \tab error on K nuclide content in \%\cr -\code{Th} \tab \code{numeric} \tab Th nuclide content in ppm\cr -\code{Th_SE} \tab \code{numeric} error on Th nuclide content in ppm\cr -\code{U} \tab \code{numeric} U nuclide content in ppm\cr -\code{U_SE} \tab \code{numeric} \tab error on U nuclide content in ppm\cr -\code{GrainSize} \tab \code{numeric} \tab average grain size in µm\cr -\code{WaterContent} \tab \code{numeric} \tab mean water content in \%\cr -\code{WaterContent_SE} \tab \code{numeric} \tab relative error on water content -} - -\strong{Water content} -The water content provided by the user should be calculated according to: - -\deqn{(Wet_weight - Dry_weight) / Dry_weight * 100} - -The unit for the weight is gram (g). -} -\section{Function version}{ - 0.1.0 -} - -\examples{ - -## create input template -input <- convert_Concentration2DoseRate() - -## fill input -input$Mineral <- "FS" -input$K <- 2.13 -input$K_SE <- 0.07 -input$Th <- 9.76 -input$Th_SE <- 0.32 -input$U <- 2.24 -input$U_SE <- 0.12 -input$GrainSize <- 200 -input$WaterContent <- 30 -input$WaterContent_SE <- 5 - -## convert -convert_Concentration2DoseRate(input) - -} - -\section{How to cite}{ -Riedesel, S., Autzen, M., 2024. convert_Concentration2DoseRate(): Dose-rate conversion function. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Adamiec, G., Aitken, M.J., 1998. Dose-rate conversion factors: update. Ancient TL 16, 37-46. - -Cresswell., A.J., Carter, J., Sanderson, D.C.W., 2018. Dose rate conversion parameters: -Assessment of nuclear data. Radiation Measurements 120, 195-201. - -Guerin, G., Mercier, N., Adamiec, G., 2011. Dose-rate conversion factors: update. -Ancient TL, 29, 5-8. - -Guerin, G., Mercier, N., Nathan, R., Adamiec, G., Lefrais, Y., 2012. On the use -of the infinite matrix assumption and associated concepts: A critical review. -Radiation Measurements, 47, 778-785. - -Liritzis, I., Stamoulis, K., Papachristodoulou, C., Ioannides, K., 2013. -A re-evaluation of radiation dose-rate conversion factors. Mediterranean -Archaeology and Archaeometry 13, 1-15. -} -\author{ -Svenja Riedesel, Aberystwyth University (United Kingdom) \cr -Martin Autzen, DTU NUTECH Center for Nuclear Technologies (Denmark) -, RLum Developer Team} -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_Daybreak2CSV.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_Daybreak2CSV.Rd deleted file mode 100644 index 6197b28ec..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_Daybreak2CSV.Rd +++ /dev/null @@ -1,54 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/convert_Daybreak2CSV.R -\name{convert_Daybreak2CSV} -\alias{convert_Daybreak2CSV} -\title{Export measurement data produced by a Daybreak luminescence reader to CSV-files} -\usage{ -convert_Daybreak2CSV(file, ...) -} -\arguments{ -\item{file}{\link{character} (\strong{required}): -name of the Daybreak-file (TXT-file, DAT-file) to be converted to CSV-files} - -\item{...}{further arguments that will be passed to the function -\link{read_Daybreak2R} and \link{write_RLum2CSV}} -} -\value{ -The function returns either a CSV-file (or many of them) or for the option \code{export = FALSE} -a list comprising objects of type \link{data.frame} and \link{matrix} -} -\description{ -This function is a wrapper function around the functions \link{read_Daybreak2R} and -\link{write_RLum2CSV} and it imports a Daybreak-file (TXT-file, DAT-file) -and directly exports its content to CSV-files. If nothing is set for the -argument \code{path} (\link{write_RLum2CSV}) the input folder will become the output folder. -} -\section{Function version}{ - 0.1.0 -} - -\examples{ - -\dontrun{ -##select your BIN-file -file <- file.choose() - -##convert -convert_Daybreak2CSV(file) - -} - -} -\seealso{ -\linkS4class{RLum.Analysis}, \linkS4class{RLum.Data}, \linkS4class{RLum.Results}, -\link[utils:write.table]{utils::write.table}, \link{write_RLum2CSV}, \link{read_Daybreak2R} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. convert_Daybreak2CSV(): Export measurement data produced by a Daybreak luminescence reader to CSV-files. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{IO} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_PSL2CSV.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_PSL2CSV.Rd deleted file mode 100644 index 2437bcd84..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_PSL2CSV.Rd +++ /dev/null @@ -1,69 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/convert_PSL2CSV.R -\name{convert_PSL2CSV} -\alias{convert_PSL2CSV} -\title{Export PSL-file(s) to CSV-files} -\usage{ -convert_PSL2CSV(file, extract_raw_data = FALSE, single_table = FALSE, ...) -} -\arguments{ -\item{file}{\link{character} (\strong{required}): -name of the PSL-file to be converted to CSV-files} - -\item{extract_raw_data}{\link{logical} (\emph{with default}): enable/disable raw data -extraction. The PSL files imported into R contain an element \verb{$raw_data}, which -provides a few more information (e.g., count errors), sometimes it makes -sense to use this data of the more compact standard values created by \link{read_PSL2R}} - -\item{single_table}{\link{logical} (\emph{with default}): enable/disable the creation -of single table with n rows and n columns, instead of separate \link{data.frame} -objects. Each curve will be represented by two columns for time and counts} - -\item{...}{further arguments that will be passed to the function -\link{read_PSL2R} and \link{write_RLum2CSV}} -} -\value{ -The function returns either a CSV-file (or many of them) or for the option -\code{export = FALSE} a list comprising objects of type \link{data.frame} and \link{matrix} -} -\description{ -This function is a wrapper function around the functions \link{read_PSL2R} and -\link{write_RLum2CSV} and it imports an PSL-file (SUERC portable OSL reader file format) -and directly exports its content to CSV-files. -If nothing is set for the argument \code{path} (\link{write_RLum2CSV}) the input folder will -become the output folder. -} -\section{Function version}{ - 0.1.2 -} - -\examples{ - -## export into single data.frame -file <- system.file("extdata/DorNie_0016.psl", package="Luminescence") -convert_PSL2CSV(file, export = FALSE, single_table = TRUE) - - -\dontrun{ -##select your BIN-file -file <- file.choose() - -##convert -convert_PSL2CSV(file) - -} - -} -\seealso{ -\linkS4class{RLum.Analysis}, \linkS4class{RLum.Data}, \linkS4class{RLum.Results}, -\link[utils:write.table]{utils::write.table}, \link{write_RLum2CSV}, \link{read_PSL2R} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. convert_PSL2CSV(): Export PSL-file(s) to CSV-files. Function version 0.1.2. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{IO} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_RLum2Risoe.BINfileData.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_RLum2Risoe.BINfileData.Rd deleted file mode 100644 index d65f04a41..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_RLum2Risoe.BINfileData.Rd +++ /dev/null @@ -1,51 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/convert_RLum2Risoe.BINfileData.R -\name{convert_RLum2Risoe.BINfileData} -\alias{convert_RLum2Risoe.BINfileData} -\title{Converts RLum.Analysis-objects and RLum.Data.Curve-objects to RLum2Risoe.BINfileData-objects} -\usage{ -convert_RLum2Risoe.BINfileData(object, keep.position.number = FALSE) -} -\arguments{ -\item{object}{\linkS4class{RLum.Analysis} or \linkS4class{RLum.Data.Curve} (\strong{required}): input object to -be converted} - -\item{keep.position.number}{\link{logical} (with default): keeps the original position number or re-calculate -the numbers to avoid doubling} -} -\value{ -The function returns a \linkS4class{Risoe.BINfileData} object. -} -\description{ -The functions converts \linkS4class{RLum.Analysis} and \linkS4class{RLum.Data.Curve} objects and a \link{list} of those -to \linkS4class{Risoe.BINfileData} objects. The function intends to provide a minimum of compatibility -between both formats. The created \linkS4class{RLum.Analysis} object can be later exported to a -BIN-file using the function \link{write_R2BIN}. -} -\note{ -The conversion can be never perfect. The \code{RLum} objects may contain information which are -not part of the \linkS4class{Risoe.BINfileData} definition. -} -\section{Function version}{ - 0.1.3 -} - -\examples{ - -##simple conversion using the example dataset -data(ExampleData.RLum.Analysis, envir = environment()) -convert_RLum2Risoe.BINfileData(IRSAR.RF.Data) - -} -\seealso{ -\linkS4class{RLum.Analysis}, \linkS4class{RLum.Data.Curve}, \link{write_R2BIN} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. convert_RLum2Risoe.BINfileData(): Converts RLum.Analysis-objects and RLum.Data.Curve-objects to RLum2Risoe.BINfileData-objects. Function version 0.1.3. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{IO} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_SG2MG.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_SG2MG.Rd deleted file mode 100644 index 48846c6c2..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_SG2MG.Rd +++ /dev/null @@ -1,49 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/convert_SG2MG.R -\name{convert_SG2MG} -\alias{convert_SG2MG} -\title{Converts Single-Grain Data to Multiple-Grain Data} -\usage{ -convert_SG2MG(object, write_file = FALSE, ...) -} -\arguments{ -\item{object}{\linkS4class{Risoe.BINfileData} \link{character} (\strong{required}): \linkS4class{Risoe.BINfileData} -object or BIN/BINX-file name} - -\item{write_file}{\link{logical} (\emph{with default}): if the input was a path to a file, the -output can be written to a file if \code{TRUE}. The multiple grain file will be written into the -same folder and with extension \code{-SG} to the file name.} - -\item{...}{further arguments passed down to \link{read_BIN2R} if input is file path} -} -\value{ -\linkS4class{Risoe.BINfileData} object and if \code{write_file = TRUE} and the input -was a file path, a file is written to origin folder. -} -\description{ -Conversion of single-grain data to multiple-grain data by adding signals -from grains belonging to one disc (unique pairs of position, set and run). -} -\section{Function version}{ - 0.1.0 -} - -\examples{ -## simple run -## (please not that the example is not using SG data) -data(ExampleData.BINfileData, envir = environment()) -convert_SG2MG(CWOSL.SAR.Data) - -} -\seealso{ -\linkS4class{Risoe.BINfileData}, \link{read_BIN2R}, \link{write_R2BIN} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany), Norbert Mercier, IRAMAT-CRP2A, UMR 5060, CNRS-Université Bordeaux Montaigne (France); -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., Mercier, N., 2024. convert_SG2MG(): Converts Single-Grain Data to Multiple-Grain Data. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{IO} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_Wavelength2Energy.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_Wavelength2Energy.Rd deleted file mode 100644 index d4b42791f..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_Wavelength2Energy.Rd +++ /dev/null @@ -1,138 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/convert_Wavelength2Energy.R -\name{convert_Wavelength2Energy} -\alias{convert_Wavelength2Energy} -\title{Emission Spectra Conversion from Wavelength to Energy Scales (Jacobian Conversion)} -\usage{ -convert_Wavelength2Energy(object, digits = 3L, order = FALSE) -} -\arguments{ -\item{object}{\linkS4class{RLum.Data.Spectrum}, \link{data.frame}, \link{matrix} (\strong{required}): input object to be converted. -If the input is not an \linkS4class{RLum.Data.Spectrum}, the first column is always treated as the wavelength -column. The function supports a list of allowed input objects.} - -\item{digits}{\link{integer} (\emph{with default}): set the number of digits on the returned energy axis} - -\item{order}{\link{logical} (\emph{with default}): enables/disables sorting of the values in ascending energy -order. After the conversion the longest wavelength has the lowest energy value and the shortest -wavelength the highest. While this is correct, some R functions expect increasing x-values.} -} -\value{ -The same object class as provided as input is returned. -} -\description{ -The function provides a convenient and fast way to convert emission spectra wavelength -to energy scales. The function works on \linkS4class{RLum.Data.Spectrum}, \link{data.frame} and \link{matrix} and -a \link{list} of such objects. The function was written to smooth the workflow while analysing -emission spectra data. This is in particular useful if you want to further treat your data -and apply, e.g., a signal deconvolution. -} -\details{ -The intensity of the spectrum is re-calculated using the following approach to recalculate -wavelength and corresponding intensity values -(e.g., Appendix 4 in Blasse and Grabmeier, 1994; Mooney and Kambhampati, 2013): - -\deqn{\phi_{E} = \phi_{\lambda} * \lambda^2 / (hc)} - -with -\eqn{\phi_{E}} the intensity per interval of energy \eqn{E} (1/eV), -\eqn{\phi_{\lambda}} the intensity per interval of wavelength \eqn{\lambda} -(1/nm) and -\eqn{h} (eV * s) the Planck constant and \eqn{c} (nm/s) the velocity of light. - -For transforming the wavelength axis (x-values) the equation as follow is used - -\deqn{E = hc/\lambda} -} -\note{ -This conversion works solely for emission spectra. In case of absorption spectra only -the x-axis has to be converted. -} -\section{Function version}{ - 0.1.1 -} - -\examples{ - -##=====================## -##(1) Literature example after Mooney et al. (2013) -##(1.1) create matrix -m <- matrix( - data = c(seq(400, 800, 50), rep(1, 9)), ncol = 2) - -##(1.2) set plot function to reproduce the -##literature figure -p <- function(m) { - plot(x = m[, 1], y = m[, 2]) - polygon( - x = c(m[, 1], rev(m[, 1])), - y = c(m[, 2], rep(0, nrow(m)))) - for (i in 1:nrow(m)) { - lines(x = rep(m[i, 1], 2), y = c(0, m[i, 2])) - } -} - -##(1.3) plot curves -par(mfrow = c(1,2)) -p(m) -p(convert_Wavelength2Energy(m)) - -##=====================## -##(2) Another example using density curves -##create dataset -xy <- density( - c(rnorm(n = 100, mean = 500, sd = 20), - rnorm(n = 100, mean = 800, sd = 20))) -xy <- data.frame(xy$x, xy$y) - -##plot -par(mfrow = c(1,2)) -plot( - xy, - type = "l", - xlim = c(150, 1000), - xlab = "Wavelength [nm]", - ylab = "Luminescence [a.u.]" -) -plot( - convert_Wavelength2Energy(xy), - xy$y, - type = "l", - xlim = c(1.23, 8.3), - xlab = "Energy [eV]", - ylab = "Luminescence [a.u.]" -) - -} - -\section{How to cite}{ -Kreutzer, S., 2024. convert_Wavelength2Energy(): Emission Spectra Conversion from Wavelength to Energy Scales (Jacobian Conversion). Function version 0.1.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Blasse, G., Grabmaier, B.C., 1994. Luminescent Materials. Springer. - -Mooney, J., Kambhampati, P., 2013. Get the Basics Right: Jacobian Conversion of Wavelength and -Energy Scales for Quantitative Analysis of Emission Spectra. J. Phys. Chem. Lett. 4, 3316–3318. -\doi{10.1021/jz401508t} - -Mooney, J., Kambhampati, P., 2013. Correction to “Get the Basics Right: Jacobian Conversion of -Wavelength and Energy Scales for Quantitative Analysis of Emission Spectra.” J. Phys. Chem. Lett. 4, -3316–3318. \doi{10.1021/jz401508t} - -\strong{Further reading} - -Angulo, G., Grampp, G., Rosspeintner, A., 2006. Recalling the appropriate representation of -electronic spectra. Spectrochimica Acta Part A: Molecular and Biomolecular Spectroscopy 65, -727–731. \doi{10.1016/j.saa.2006.01.007} - -Wang, Y., Townsend, P.D., 2013. Potential problems in collection and data processing of -luminescence signals. Journal of Luminescence 142, 202–211. \doi{10.1016/j.jlumin.2013.03.052} -} -\seealso{ -\linkS4class{RLum.Data.Spectrum}, \link{plot_RLum} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{IO} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_XSYG2CSV.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_XSYG2CSV.Rd deleted file mode 100644 index 359c4334a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/convert_XSYG2CSV.Rd +++ /dev/null @@ -1,58 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/convert_XSYG2CSV.R -\name{convert_XSYG2CSV} -\alias{convert_XSYG2CSV} -\title{Export XSYG-file(s) to CSV-files} -\usage{ -convert_XSYG2CSV(file, ...) -} -\arguments{ -\item{file}{\link{character} (\strong{required}): -name of the XSYG-file to be converted to CSV-files} - -\item{...}{further arguments that will be passed to the function -\link{read_XSYG2R} and \link{write_RLum2CSV}} -} -\value{ -The function returns either a CSV-file (or many of them) or for the option \code{export = FALSE} -a list comprising objects of type \link{data.frame} and \link{matrix} -} -\description{ -This function is a wrapper function around the functions \link{read_XSYG2R} and -\link{write_RLum2CSV} and it imports an XSYG-file and directly exports its content -to CSV-files. If nothing is set for the argument \code{path} (\link{write_RLum2CSV}) -the input folder will become the output folder. -} -\section{Function version}{ - 0.1.0 -} - -\examples{ - -##transform XSYG-file values to a list -data(ExampleData.XSYG, envir = environment()) -convert_XSYG2CSV(OSL.SARMeasurement$Sequence.Object[1:10], export = FALSE) - -\dontrun{ -##select your BIN-file -file <- file.choose() - -##convert -convert_XSYG2CSV(file) - -} - -} -\seealso{ -\linkS4class{RLum.Analysis}, \linkS4class{RLum.Data}, \linkS4class{RLum.Results}, -\link[utils:write.table]{utils::write.table}, \link{write_RLum2CSV}, \link{read_XSYG2R} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. convert_XSYG2CSV(): Export XSYG-file(s) to CSV-files. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{IO} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/extdata.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/extdata.Rd deleted file mode 100644 index a070c2b4e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/extdata.Rd +++ /dev/null @@ -1,62 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Luminescence-package.R -\name{extdata} -\alias{extdata} -\title{Collection of External Data} -\description{ -Description and listing of data provided in the folder \code{data/extdata} -} -\details{ -The \strong{R} package \code{Luminescence} includes a number of raw data files, which are mostly used in -the example sections of appropriate functions. They are also used internally for testing corresponding -functions using the \code{testthat} package (see files in \verb{tests/testthat/}) to ensure their operational -reliability. - -\strong{Accessibility} - -If the \strong{R} package \code{Luminescence} is installed correctly the preferred way to access and use these -data from within \strong{R} is as follows: - -\code{system.file("extdata/", package = "Luminescence")} - -\strong{Individual file descriptions} - -\emph{>>Daybreak_TestFile.DAT/.txt<<} - -\strong{Type:} raw measurement data \cr -\strong{Device:} Daybreak OSL/TL reader\cr -\strong{Measurement date:} unknown\cr -\strong{Location:} unknown\cr -\strong{Provided by:} unknown\cr -\strong{Related R function(s):} \code{read_Daybreak2R()}\cr -\strong{Reference:} unknown - -\emph{>>DorNie_0016.psl<<} - -\strong{Type:} raw measurement data \cr -\strong{Device:} SUERC portable OSL reader \cr -\strong{Measurement date:} 19/05/2016 \cr -\strong{Location:} Dormagen-Nievenheim, Germany \cr -\strong{Provided by:} Christoph Burow (University of Cologne) \cr -\strong{Related R function(s):} \code{read_PSL2R()} \cr -\strong{Reference:} unpublished \cr -\strong{Additional information:} Sample measured at an archaeological site near \cr -Dormagen-Nievenheim (Germany) during a practical course on Luminescence dating in 2016. \cr - -\emph{>>QNL84_2_bleached.txt}, \emph{QNL84_2_unbleached.txt<<} - -\strong{Type:} Test data for exponential fits \cr -\strong{Reference:} Berger, G.W., Huntley, D.J., 1989. Test data for exponential fits. Ancient TL 7, 43-46. \cr - -\emph{>>STRB87_1_bleached.txt}, \emph{STRB87_1_unbleached.txt<<} - -\strong{Type:} Test data for exponential fits \cr -\strong{Reference:} Berger, G.W., Huntley, D.J., 1989. Test data for exponential fits. Ancient TL 7, 43-46. - -\emph{>>XSYG_file.xsyg} - -\strong{Type:} XSYG-file stump \cr -**Info: ** XSYG-file with some basic curves to test functions \cr -\strong{Reference:} no reference available -} -\keyword{datasets} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/extract_IrradiationTimes.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/extract_IrradiationTimes.Rd deleted file mode 100644 index c74ffe9b4..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/extract_IrradiationTimes.Rd +++ /dev/null @@ -1,156 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/extract_IrradiationTimes.R -\name{extract_IrradiationTimes} -\alias{extract_IrradiationTimes} -\title{Extract Irradiation Times from an XSYG-file} -\usage{ -extract_IrradiationTimes( - object, - file.BINX, - recordType = c("irradiation (NA)", "IRSL (UVVIS)", "OSL (UVVIS)", "TL (UVVIS)"), - compatibility.mode = TRUE, - txtProgressBar = TRUE -) -} -\arguments{ -\item{object}{\link{character}, \linkS4class{RLum.Analysis} or \link{list} (\strong{required}): -path and file name of the XSYG file or an \linkS4class{RLum.Analysis} -produced by the function \link{read_XSYG2R}; -alternatively a \code{list} of \linkS4class{RLum.Analysis} can be provided. - -\strong{Note}: If an \linkS4class{RLum.Analysis} is used, any input for -the arguments \code{file.BINX} and \code{recordType} will be ignored!} - -\item{file.BINX}{\link{character} (\emph{optional}): -path and file name of an existing BINX-file. If a file name is provided the -file will be updated with the information from the XSYG file in the same -folder as the original BINX-file. - -\strong{Note:} The XSYG and the BINX-file must originate from the -same measurement!} - -\item{recordType}{\link{character} (\emph{with default}): -select relevant curves types from the XSYG file or \linkS4class{RLum.Analysis} -object. As the XSYG-file format comprises much more information than usually -needed for routine data analysis and allowed in the BINX-file format, only -the relevant curves are selected by using the function -\link{get_RLum}. The argument \code{recordType} works as -described for this function. - -\strong{Note:} A wrong selection will causes a function error. Please change this -argument only if you have reasons to do so.} - -\item{compatibility.mode}{\link{logical} (\emph{with default}): -this option is parsed only if a BIN/BINX file is produced and it will reset all position -values to a max. value of 48, cf.\link{write_R2BIN}} - -\item{txtProgressBar}{\link{logical} (\emph{with default}): -enables \code{TRUE} or disables \code{FALSE} the progress bars during import and export} -} -\value{ -An \linkS4class{RLum.Results} object is returned with the -following structure: - -\if{html}{\out{
}}\preformatted{.. $irr.times (data.frame) -}\if{html}{\out{
}} - -If a BINX-file path and name is set, the output will be additionally -transferred into a new BINX-file with the function name as suffix. For the -output the path of the input BINX-file itself is used. Note that this will -not work if the input object is a file path to an XSYG-file, instead of a -link to only one file. In this case the argument input for \code{file.BINX} is ignored. - -In the self call mode (input is a \code{list} of \linkS4class{RLum.Analysis} objects -a list of \linkS4class{RLum.Results} is returned. -} -\description{ -Extracts irradiation times, dose and times since last irradiation, from a -Freiberg Instruments XSYG-file. These information can be further used to -update an existing BINX-file. -} -\details{ -The function was written to compensate missing information in the BINX-file -output of Freiberg Instruments lexsyg readers. As all information are -available within the XSYG-file anyway, these information can be extracted -and used for further analysis or/and to stored in a new BINX-file, which can -be further used by other software, e.g., Analyst (Geoff Duller). - -Typical application example: g-value estimation from fading measurements -using the Analyst or any other self-written script. - -Beside some simple data transformation steps, the function applies -functions \link{read_XSYG2R}, \link{read_BIN2R}, \link{write_R2BIN} for data import and export. -} -\note{ -The function can be also used to extract irradiation times from \linkS4class{RLum.Analysis} objects -previously imported via \link{read_BIN2R} (\code{fastForward = TRUE}) or in combination with \link{Risoe.BINfileData2RLum.Analysis}. -Unfortunately the timestamp might not be very precise (or even invalid), -but it allows to essentially treat different formats in a similar manner. - -The produced output object contains still the irradiation steps to -keep the output transparent. However, for the BINX-file export this steps -are removed as the BINX-file format description does not allow irradiations -as separate sequences steps. - -\strong{BINX-file 'Time Since Irradiation' value differs from the table output?} - -The way the value 'Time Since Irradiation' is defined differs. In the BINX-file the -'Time Since Irradiation' is calculated as the 'Time Since Irradiation' plus the 'Irradiation -Time'. The table output returns only the real 'Time Since Irradiation', i.e. time between the -end of the irradiation and the next step. - -\strong{Negative values for \code{TIMESINCELAST.STEP}?} - -Yes, this is possible and no bug, as in the XSYG-file multiple curves are stored for one step. -Example: TL step may comprise three curves: -\itemize{ -\item (a) counts vs. time, -\item (b) measured temperature vs. time and -\item (c) predefined temperature vs. time. -} - -Three curves, but they are all belonging to one TL measurement step, but with regard to -the time stamps this could produce negative values as the important function -(\link{read_XSYG2R}) do not change the order of entries for one step -towards a correct time order. -} -\section{Function version}{ - 0.3.3 -} - -\examples{ -## (1) - example for your own data -## -## set files and run function -# -# file.XSYG <- file.choose() -# file.BINX <- file.choose() -# -# output <- extract_IrradiationTimes(file.XSYG = file.XSYG, file.BINX = file.BINX) -# get_RLum(output) -# -## export results additionally to a CSV.file in the same directory as the XSYG-file -# write.table(x = get_RLum(output), -# file = paste0(file.BINX,"_extract_IrradiationTimes.csv"), -# sep = ";", -# row.names = FALSE) - -} - -\section{How to cite}{ -Kreutzer, S., 2024. extract_IrradiationTimes(): Extract Irradiation Times from an XSYG-file. Function version 0.3.3. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Duller, G.A.T., 2015. The Analyst software package for luminescence data: overview and -recent improvements. Ancient TL 33, 35-42. -} -\seealso{ -\linkS4class{RLum.Analysis}, \linkS4class{RLum.Results}, \linkS4class{Risoe.BINfileData}, -\link{read_XSYG2R}, \link{read_BIN2R}, \link{write_R2BIN} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{IO} -\keyword{manip} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/extract_ROI.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/extract_ROI.Rd deleted file mode 100644 index 6ab41a84d..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/extract_ROI.Rd +++ /dev/null @@ -1,69 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/extract_ROI.R -\name{extract_ROI} -\alias{extract_ROI} -\title{Extract Pixel Values through Circular Region-of-Interests (ROI) from an Image} -\usage{ -extract_ROI(object, roi, roi_summary = "mean", plot = FALSE) -} -\arguments{ -\item{object}{\linkS4class{RLum.Data.Image}, \link{array} or \link{matrix} (\strong{required}): input image data} - -\item{roi}{\link{matrix} (\strong{required}): matrix with three columns containing the centre coordinates -of the ROI (first two columns) and the diameter of the circular ROI. All numbers must by of type \link{integer} -and will forcefully coerced into such numbers using \code{as.integer()} regardless.} - -\item{roi_summary}{(\strong{with default}): if \code{"mean"} (the default) defines what is returned -in the element \code{roi_summary}; alternatively \code{"mean"}, \code{"median"}, \code{"sd"} or \code{"sum"} can be chosen. -Pixel values are conveniently summarised using the above defined keyword.} - -\item{plot}{\link{logical} (\emph{optional}): enables/disables control plot. Only the first -image frame is shown} -} -\value{ -\linkS4class{RLum.Results} object with the following elements: -\code{..$roi_signals}: a named \link{list} with all ROI values and their coordinates -\code{..$roi_summary}: an \link{matrix} where rows are frames from the image, and columns are different ROI -The element has two attributes: \code{summary} (the method used to summarise pixels) and \code{area} (the pixel area) -\code{..$roi_coord}: a \link{matrix} that can be passed to \link{plot_ROI} - -If \code{plot = TRUE} a control plot is returned. -} -\description{ -Light-weighted function to extract pixel values from pre-defined regions-of-interest (ROI) from -\linkS4class{RLum.Data.Image}, \link{array} or \link{matrix} objects and provide simple image processing -capacity. The function is limited to circular ROIs. -} -\details{ -The function uses a cheap approach to decide whether a pixel lies within -a circle or not. It assumes that pixel coordinates are integer values and -that a pixel centring within the circle is satisfied by: - -\deqn{x^2 + y^2 <= (d/2)^2} - -where \eqn{x} and \eqn{y} are integer pixel coordinates and \eqn{d} is the integer -diameter of the circle in pixel. -} -\section{Function version}{ - 0.1.0 -} - -\examples{ - -m <- matrix(runif(100,0,255), ncol = 10, nrow = 10) -roi <- matrix(c(2.,4,2,5,6,7,3,1,1), ncol = 3) -extract_ROI(object = m, roi = roi, plot = TRUE) - -} -\seealso{ -\linkS4class{RLum.Data.Image} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. extract_ROI(): Extract Pixel Values through Circular Region-of-Interests (ROI) from an Image. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{manip} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/figures/Luminescence_logo.png b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/figures/Luminescence_logo.png deleted file mode 100644 index 3e326e235..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/figures/Luminescence_logo.png and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/figures/README-Screenshot_AddIn.png b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/figures/README-Screenshot_AddIn.png deleted file mode 100644 index be4723f3d..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/figures/README-Screenshot_AddIn.png and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/fit_CWCurve.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/fit_CWCurve.Rd deleted file mode 100644 index aaa7ed915..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/fit_CWCurve.Rd +++ /dev/null @@ -1,222 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fit_CWCurve.R -\name{fit_CWCurve} -\alias{fit_CWCurve} -\title{Nonlinear Least Squares Fit for CW-OSL curves -beta version-} -\usage{ -fit_CWCurve( - values, - n.components.max, - fit.failure_threshold = 5, - fit.method = "port", - fit.trace = FALSE, - fit.calcError = FALSE, - LED.power = 36, - LED.wavelength = 470, - cex.global = 0.6, - sample_code = "Default", - output.terminal = TRUE, - output.terminalAdvanced = TRUE, - plot = TRUE, - ... -) -} -\arguments{ -\item{values}{\linkS4class{RLum.Data.Curve} or \link{data.frame} (\strong{required}): -x, y data of measured values (time and counts). See examples.} - -\item{n.components.max}{\link{vector} (\emph{optional}): -maximum number of components that are to be used for fitting. -The upper limit is 7.} - -\item{fit.failure_threshold}{\link{vector} (\emph{with default}): -limits the failed fitting attempts.} - -\item{fit.method}{\link{character} (\emph{with default}): -select fit method, allowed values: \code{'port'} and \code{'LM'}. \code{'port'} uses the 'port' -routine from the function \link{nls} \code{'LM'} utilises the function \code{nlsLM} from -the package \code{minpack.lm} and with that the Levenberg-Marquardt algorithm.} - -\item{fit.trace}{\link{logical} (\emph{with default}): -traces the fitting process on the terminal.} - -\item{fit.calcError}{\link{logical} (\emph{with default}): -calculate 1-sigma error range of components using \link[stats:confint]{stats::confint}} - -\item{LED.power}{\link{numeric} (\emph{with default}): -LED power (max.) used for intensity ramping in mW/cm^2. -\strong{Note:} The value is used for the calculation of the absolute -photoionisation cross section.} - -\item{LED.wavelength}{\link{numeric} (\emph{with default}): -LED wavelength used for stimulation in nm. -\strong{Note:} The value is used for the calculation of the absolute -photoionisation cross section.} - -\item{cex.global}{\link{numeric} (\emph{with default}): -global scaling factor.} - -\item{sample_code}{\link{character} (\emph{optional}): -sample code used for the plot and the optional output table (\code{mtext}).} - -\item{output.terminal}{\link{logical} (\emph{with default}): -terminal output with fitting results.} - -\item{output.terminalAdvanced}{\link{logical} (\emph{with default}): -enhanced terminal output. Requires \code{output.terminal = TRUE}. -If \code{output.terminal = FALSE} no advanced output is possible.} - -\item{plot}{\link{logical} (\emph{with default}): -returns a plot of the fitted curves.} - -\item{...}{further arguments and graphical parameters passed to \link{plot}.} -} -\value{ -\strong{plot (\emph{optional})} - -the fitted CW-OSL curves are returned as plot. - -\strong{RLum.Results} - -Beside the plot and table output options, an \linkS4class{RLum.Results} object is -returned. - -\code{fit}: -an \code{nls} object (\verb{$fit}) for which generic R functions are -provided, e.g. \link{summary}, \link[stats:confint]{stats::confint}, \link{profile}. For more -details, see \link{nls}. - -\code{output.table}: -a \link{data.frame} containing the summarised parameters including the error - -\code{component.contribution.matrix}: -\link{matrix} containing the values for the component to sum contribution plot -(\verb{$component.contribution.matrix}). - -Matrix structure:\cr -Column 1 and 2: time and \code{rev(time)} values \cr -Additional columns are used for the components, two for each component, -containing I0 and n0. The last columns \code{cont.} provide information on -the relative component contribution for each time interval including the row -sum for this values. - -\strong{object} - -beside the plot and table output options, an \linkS4class{RLum.Results} object -is returned. - -\code{fit}: -an \code{nls} object (\verb{$fit}) for which generic R functions -are provided, e.g. \link{summary}, \link{confint}, \link{profile}. For more -details, see \link{nls}. - -\code{output.table}: -a \link{data.frame} containing the summarised parameters including the error\cr -\code{component.contribution.matrix}: \link{matrix} containing the values -for the component to sum contribution plot (\verb{$component.contribution.matrix}).\cr - -Matrix structure:\cr -Column 1 and 2: time and \code{rev(time)} values\cr -Additional columns are used for the components, two for each component, -containing I0 and n0. The last columns \code{cont.} provide information on -the relative component contribution for each time interval including the row -sum for this values. -} -\description{ -The function determines the weighted least-squares estimates of the -component parameters of a CW-OSL signal for a given maximum number of -components and returns various component parameters. The fitting procedure -uses the \link{nls} function with the \code{port} algorithm. -} -\details{ -\strong{Fitting function} - -The function for the CW-OSL fitting has the general form: - -\deqn{y = I0_{1}*\lambda_{1}*exp(-\lambda_1*x) + ,\ldots, + I0_{i}*\lambda_{i}*exp(-\lambda_i*x) } - -where \eqn{0 < i < 8} - -and \eqn{\lambda} is the decay constant \cr -and \eqn{I0} the initial number of trapped electrons. - -\emph{(for the used equation cf. Boetter-Jensen et al., 2003, Eq. 2.31)} - -\strong{Start values} - -Start values are estimated automatically by fitting a linear function to the -logarithmized input data set. Currently, there is no option to manually -provide start parameters. - -\strong{Goodness of fit} - -The goodness of the fit is given as pseudoR^2 value (pseudo coefficient of -determination). According to Lave (1970), the value is calculated as: - -\deqn{pseudoR^2 = 1 - RSS/TSS} - -where \eqn{RSS = Residual~Sum~of~Squares} \cr -and \eqn{TSS = Total~Sum~of~Squares} - -\strong{Error of fitted component parameters} - -The 1-sigma error for the -components is calculated using the function \link[stats:confint]{stats::confint}. Due to -considerable calculation time, this option is deactivated by default. In -addition, the error for the components can be estimated by using internal R -functions like \link{summary}. See the \link{nls} help page -for more information. - -\emph{For details on the nonlinear regression in R, see Ritz & Streibig (2008).} -} -\note{ -\strong{Beta version - This function has not been properly tested yet and} -\strong{should therefore not be used for publication purposes!} - -The pseudo-R^2 may not be the best parameter to describe the goodness of the -fit. The trade off between the \code{n.components} and the pseudo-R^2 value -is currently not considered. - -The function \strong{does not} ensure that the fitting procedure has reached a -global minimum rather than a local minimum! -} -\section{Function version}{ - 0.5.3 -} - -\examples{ - -##load data -data(ExampleData.CW_OSL_Curve, envir = environment()) - -##fit data -fit <- fit_CWCurve(values = ExampleData.CW_OSL_Curve, - main = "CW Curve Fit", - n.components.max = 4, - log = "x") - -} - -\section{How to cite}{ -Kreutzer, S., 2024. fit_CWCurve(): Nonlinear Least Squares Fit for CW-OSL curves -beta version-. Function version 0.5.3. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Boetter-Jensen, L., McKeever, S.W.S., Wintle, A.G., 2003. -Optically Stimulated Luminescence Dosimetry. Elsevier Science B.V. - -Lave, C.A.T., 1970. The Demand for Urban Mass Transportation. The Review of -Economics and Statistics, 52 (3), 320-323. - -Ritz, C. & Streibig, J.C., 2008. Nonlinear Regression with R. In: R. -Gentleman, K. Hornik, G. Parmigiani, eds., Springer, p. 150. -} -\seealso{ -\link{fit_LMCurve}, \link{plot},\link{nls}, \linkS4class{RLum.Data.Curve}, -\linkS4class{RLum.Results}, \link{get_RLum}, \link[minpack.lm:nlsLM]{minpack.lm::nlsLM} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{dplot} -\keyword{models} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/fit_EmissionSpectra.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/fit_EmissionSpectra.Rd deleted file mode 100644 index 500638b6a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/fit_EmissionSpectra.Rd +++ /dev/null @@ -1,192 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fit_EmissionSpectra.R -\name{fit_EmissionSpectra} -\alias{fit_EmissionSpectra} -\title{Luminescence Emission Spectra Deconvolution} -\usage{ -fit_EmissionSpectra( - object, - frame = NULL, - n_components = NULL, - start_parameters = NULL, - sub_negative = 0, - input_scale = NULL, - method_control = list(), - verbose = TRUE, - plot = TRUE, - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum.Data.Spectrum}, \link{matrix} (\strong{required}): input -object. Please note that an energy spectrum is expected} - -\item{frame}{\link{numeric} (\emph{optional}): defines the frame to be analysed} - -\item{n_components}{\link{numeric} (\emph{optional}): allows a number of the aimed number of -components. However, it defines rather a maximum than than a minimum. Can be combined with -other parameters.} - -\item{start_parameters}{\link{numeric} (\emph{optional}): allows to provide own start parameters for a -semi-automated procedure. Parameters need to be provided in eV. Every value provided replaces a -value from the automated peak finding algorithm (in ascending order).} - -\item{sub_negative}{\link{numeric} (\emph{with default}): substitute negative values in the input object -by the number provided here (default: \code{0}). Can be set to \code{NULL}, i.e. negative values are kept.} - -\item{input_scale}{\link{character} (\emph{optional}): defines whether your x-values define wavelength or -energy values. For the analysis an energy scale is expected, allowed values are \code{'wavelength'} and -\code{'energy'}. If nothing (\code{NULL}) is defined, the function tries to understand the input -automatically.} - -\item{method_control}{\link{list} (\emph{optional}): options to control the fit method, see details} - -\item{verbose}{\link{logical} (\emph{with default}): enable/disable verbose mode} - -\item{plot}{\link{logical} (\emph{with default}): enable/disable plot output} - -\item{...}{further arguments to be passed to control the plot output -(supported: \code{main}, \code{xlab}, \code{ylab}, \code{xlim}, \code{ylim}, \code{log}, \code{mtext}, \code{legend} (\code{TRUE} or \code{FALSE}), -\code{legend.text}, \code{legend.pos})} -} -\value{ ------------------------------------\cr -\verb{[ NUMERICAL OUTPUT ]}\cr ------------------------------------\cr - -\strong{\code{RLum.Results}}-object - -\strong{slot:} \strong{\verb{@data}} - -\tabular{lll}{ -\strong{Element} \tab \strong{Type} \tab \strong{Description}\cr -\verb{$data} \tab \code{matrix} \tab the final fit matrix \cr -\verb{$fit} \tab \code{nls} \tab the fit object returned by \link[minpack.lm:nls.lm]{minpack.lm::nls.lm} \cr -\verb{$fit_info} \tab \code{list} \tab a few additional parameters that can be used to asses the quality -of the fit -} - -\strong{slot:} \strong{\verb{@info}} - -The original function call - ----------------------------------\cr -\verb{[ TERMINAL OUTPUT ]} \cr ----------------------------------\cr - -The terminal output provides brief information on the -deconvolution process and the obtained results. -Terminal output is only shown of the argument \code{verbose = TRUE}. - ----------------------------\cr -\verb{[ PLOT OUTPUT ]} \cr ----------------------------\cr - -The function returns a plot showing the raw signal with the -detected components. If the fitting failed, a basic plot is returned -showing the raw data and indicating the peaks detected for the start -parameter estimation. The grey band in the residual plot indicates the -10\% deviation from 0 (means no residual). -} -\description{ -Luminescence spectra deconvolution on \linkS4class{RLum.Data.Spectrum} and \link{matrix} objects -on an \strong{energy scale}. The function is optimised for emission spectra typically -obtained in the context of TL, OSL and RF measurements detected between 200 and 1000 nm. -The function is not prepared to deconvolve TL curves (counts against temperature; -no wavelength scale). If you are interested in such analysis, please check, e.g., -the package \code{'tgcd'}. -} -\details{ -\strong{Used equation} - -The emission spectra (on an energy scale) can be best described as the sum of multiple -Gaussian components: - -'\deqn{ -y = \Sigma Ci * 1/(\sigma_{i} * \sqrt(2 * \pi)) * exp(-1/2 * ((x - \mu_{i})/\sigma_{i}))^2) -} - -with the parameters \eqn{\sigma} (peak width) and \eqn{\mu} (peak centre) and \eqn{C} -(scaling factor). - -\strong{Start parameter estimation and fitting algorithm} - -The spectrum deconvolution consists of the following steps: -\enumerate{ -\item Peak finding \cr -\item Start parameter estimation \cr -\item Fitting via \link[minpack.lm:nls.lm]{minpack.lm::nls.lm}\cr -} - -The peak finding is realised by an approach (re-)suggested by Petr Pikal via the R-help -mailing list (\verb{https://stat.ethz.ch/pipermail/r-help/2005-November/thread.html}) in November 2005. -This goes back to even earlier discussion in 2001 based on Prof Brian Ripley's idea. -It smartly uses the functions \link[stats:embed]{stats::embed} and \link{max.col} to identify peaks positions. -For the use in this context, the algorithm has been further modified to scale on the -input data resolution (cf. source code).\cr - -The start parameter estimation uses random sampling from a range of meaningful parameters -and repeats the fitting until 1000 successful fits have been produced or the set \code{max.runs} value -is exceeded. - -Currently the best fit is the one with the lowest number for squared residuals, but -other parameters are returned as well. If a series of curves needs to be analysed, -it is recommended to make few trial runs, then fix the number of components and -run at least 10,000 iterations (parameter \code{method_control = list(max.runs = 10000)}). - -\strong{Supported \code{method_control} settings} - -\tabular{llll}{ -\strong{Parameter} \tab \strong{Type} \tab \strong{Default} \tab \strong{Description}\cr -\code{max.runs} \tab \link{integer} \tab \code{10000} \tab maximum allowed search iterations, if exceed -the searching stops \cr -\code{graining} \tab \link{numeric} \tab \code{15} \tab gives control over how coarse or fine the spectrum is split into search intervals for the peak finding algorithm \cr -\code{norm} \tab \link{logical} \tab \code{TRUE} \tab normalises data to the highest count value before fitting \cr -\code{trace} \tab \link{logical} \tab \code{FALSE} \tab enables/disables the tracing of the minimisation routine -} -} -\section{Function version}{ - 0.1.1 -} - -\examples{ - -##load example data -data(ExampleData.XSYG, envir = environment()) - -##subtract background -TL.Spectrum@data <- TL.Spectrum@data[] - TL.Spectrum@data[,15] - -results <- fit_EmissionSpectra( - object = TL.Spectrum, - frame = 5, - method_control = list(max.runs = 10) -) - -##deconvolution of a TL spectrum -\dontrun{ - -##load example data - -##replace 0 values -results <- fit_EmissionSpectra( - object = TL.Spectrum, - frame = 5, main = "TL spectrum" -) - -} - -} -\seealso{ -\linkS4class{RLum.Data.Spectrum}, \linkS4class{RLum.Results}, \link{plot_RLum}, -\link{convert_Wavelength2Energy}, \link[minpack.lm:nls.lm]{minpack.lm::nls.lm} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. fit_EmissionSpectra(): Luminescence Emission Spectra Deconvolution. Function version 0.1.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/fit_LMCurve.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/fit_LMCurve.Rd deleted file mode 100644 index 761c0476a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/fit_LMCurve.Rd +++ /dev/null @@ -1,275 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fit_LMCurve.R -\name{fit_LMCurve} -\alias{fit_LMCurve} -\title{Nonlinear Least Squares Fit for LM-OSL curves} -\usage{ -fit_LMCurve( - values, - values.bg, - n.components = 3, - start_values, - input.dataType = "LM", - fit.method = "port", - sample_code = "", - sample_ID = "", - LED.power = 36, - LED.wavelength = 470, - fit.trace = FALSE, - fit.advanced = FALSE, - fit.calcError = FALSE, - bg.subtraction = "polynomial", - verbose = TRUE, - plot = TRUE, - plot.BG = FALSE, - ... -) -} -\arguments{ -\item{values}{\linkS4class{RLum.Data.Curve} or \link{data.frame} (\strong{required}): -x,y data of measured values (time and counts). See examples.} - -\item{values.bg}{\linkS4class{RLum.Data.Curve} or \link{data.frame} (\emph{optional}): -x,y data of measured values (time and counts) for background subtraction.} - -\item{n.components}{\link{integer} (\emph{with default}): -fixed number of components that are to be recognised during fitting -(min = 1, max = 7).} - -\item{start_values}{\link{data.frame} (\emph{optional}): -start parameters for \code{lm} and \code{xm} data for the fit. If no start values are given, -an automatic start value estimation is attempted (see details).} - -\item{input.dataType}{\link{character} (\emph{with default}): -alter the plot output depending on the input data: \code{"LM"} or \code{"pLM"} (pseudo-LM). -See: \link{CW2pLM}} - -\item{fit.method}{\link{character} (\emph{with default}): -select fit method, allowed values: \code{'port'} and \code{'LM'}. \code{'port'} uses the 'port' -routine from the function \link{nls} \code{'LM'} utilises the function \code{nlsLM} from -the package \code{minpack.lm} and with that the Levenberg-Marquardt algorithm.} - -\item{sample_code}{\link{character} (\emph{optional}): -sample code used for the plot and the optional output table (mtext).} - -\item{sample_ID}{\link{character} (\emph{optional}): -additional identifier used as column header for the table output.} - -\item{LED.power}{\link{numeric} (\emph{with default}): -LED power (max.) used for intensity ramping in mW/cm^2. -\strong{Note:} This value is used for the calculation of the absolute -photoionisation cross section.} - -\item{LED.wavelength}{\link{numeric} (\emph{with default}): -LED wavelength in nm used for stimulation. -\strong{Note:} This value is used for the calculation of the absolute -photoionisation cross section.} - -\item{fit.trace}{\link{logical} (\emph{with default}): -traces the fitting process on the terminal.} - -\item{fit.advanced}{\link{logical} (\emph{with default}): -enables advanced fitting attempt for automatic start parameter recognition. -Works only if no start parameters are provided. -\strong{Note:} It may take a while and it is not compatible with \code{fit.method = "LM"}.} - -\item{fit.calcError}{\link{logical} (\emph{with default}): -calculate 1-sigma error range of components using \link[stats:confint]{stats::confint}.} - -\item{bg.subtraction}{\link{character} (\emph{with default}): -specifies method for background subtraction (\code{polynomial}, \code{linear}, \code{channel}, -see Details). \strong{Note:} requires input for \code{values.bg}.} - -\item{verbose}{\link{logical} (\emph{with default}): -terminal output with fitting results.} - -\item{plot}{\link{logical} (\emph{with default}): -returns a plot of the fitted curves.} - -\item{plot.BG}{\link{logical} (\emph{with default}): -returns a plot of the background values with the fit used for the -background subtraction.} - -\item{...}{Further arguments that may be passed to the plot output, e.g. -\code{xlab}, \code{xlab}, \code{main}, \code{log}.} -} -\value{ -Various types of plots are returned. For details see above. Furthermore an -\code{RLum.Results} object is returned with the following structure: - -\strong{\verb{@data:}} - -\code{.. $data} : \link{data.frame} with fitting results\cr -\code{.. $fit} : nls (\link{nls} object)\cr -\code{.. $component_matrix} : \link{matrix} with numerical xy-values of the single fitted components with the resolution of the input data -\code{.. $component.contribution.matrix} : \link{list} component distribution matrix - -\strong{\verb{info:}} - -\code{.. $call} : \link{call} the original function call - -Matrix structure for the distribution matrix: - -Column 1 and 2: time and \code{rev(time)} values\cr -Additional columns are used for the components, two for each component, -containing I0 and n0. The last columns \code{cont.} provide information on -the relative component contribution for each time interval including the row -sum for this values. -} -\description{ -The function determines weighted nonlinear least-squares estimates of the -component parameters of an LM-OSL curve (Bulur 1996) for a given number of -components and returns various component parameters. The fitting procedure -uses the function \link{nls} with the \code{port} algorithm. -} -\details{ -\strong{Fitting function} - -The function for the fitting has the general -form: - -\deqn{y = (exp(0.5)*Im_1*x/xm_1)*exp(-x^2/(2*xm_1^2)) + ,\ldots, + exp(0.5)*Im_i*x/xm_i)*exp(-x^2/(2*xm_i^2))} - -where \eqn{1 < i < 8} - -This function and the equations for the conversion to b (detrapping probability) -and n0 (proportional to initially trapped charge) have been taken from Kitis -et al. (2008): - -\deqn{xm_i=\sqrt{max(t)/b_i}} -\deqn{Im_i=exp(-0.5)n0/xm_i} - -\strong{Background subtraction} - -Three methods for background subtraction -are provided for a given background signal (\code{values.bg}). -\itemize{ -\item \code{polynomial}: default method. A polynomial function is fitted using \link{glm} -and the resulting function is used for background subtraction: -\deqn{y = a*x^4 + b*x^3 + c*x^2 + d*x + e} -\item \code{linear}: a linear function is fitted using \link{glm} and the resulting function -is used for background subtraction: -\deqn{y = a*x + b} -\item \code{channel}: the measured -background signal is subtracted channel wise from the measured signal. -} - -\strong{Start values} - -The choice of the initial parameters for the \code{nls}-fitting is a crucial -point and the fitting procedure may mainly fail due to ill chosen start -parameters. Here, three options are provided: - -\strong{(a)} -If no start values (\code{start_values}) are provided by the user, a cheap guess is made -by using the detrapping values found by Jain et al. (2003) for quartz for a -maximum of 7 components. Based on these values, the pseudo start parameters -\code{xm} and \code{Im} are recalculated for the given data set. In all cases, the fitting -starts with the ultra-fast component and (depending on \code{n.components}) -steps through the following values. If no fit could be achieved, an error -plot (for \code{plot = TRUE}) with the pseudo curve (based on the -pseudo start parameters) is provided. This may give the opportunity to -identify appropriate start parameters visually. - -\strong{(b)} -If start values are provided, the function works like a simple \link{nls} -fitting approach. - -\strong{(c)} -If no start parameters are provided and -the option \code{fit.advanced = TRUE} is chosen, an advanced start parameter -estimation is applied using a stochastic attempt. Therefore, the -recalculated start parameters \strong{(a)} are used to construct a normal -distribution. The start parameters are then sampled randomly from this -distribution. A maximum of 100 attempts will be made. \strong{Note:} This -process may be time consuming. - -\strong{Goodness of fit} - -The goodness of the fit is given by a pseudo-R^2 value (pseudo coefficient of -determination). According to Lave (1970), the value is calculated as: - -\deqn{pseudoR^2 = 1 - RSS/TSS} - -where \eqn{RSS = Residual~Sum~of~Squares} -and \eqn{TSS = Total~Sum~of~Squares} - -\strong{Error of fitted component parameters} - -The 1-sigma error for the components is calculated using -the function \link[stats:confint]{stats::confint}. Due to considerable calculation time, this -option is deactivated by default. In addition, the error for the components -can be estimated by using internal R functions like \link{summary}. See the -\link{nls} help page for more information. - -\emph{For more details on the nonlinear regression in R, see Ritz & Streibig (2008).} -} -\note{ -The pseudo-R^2 may not be the best parameter to describe the goodness -of the fit. The trade off between the \code{n.components} and the pseudo-R^2 -value currently remains unconsidered. - -The function \strong{does not} ensure that the fitting procedure has reached a -global minimum rather than a local minimum! In any case of doubt, the use of -manual start values is highly recommended. -} -\section{Function version}{ - 0.3.4 -} - -\examples{ - -##(1) fit LM data without background subtraction -data(ExampleData.FittingLM, envir = environment()) -fit_LMCurve(values = values.curve, n.components = 3, log = "x") - -##(2) fit LM data with background subtraction and export as JPEG -## -alter file path for your preferred system -##jpeg(file = "~/Desktop/Fit_Output\\%03d.jpg", quality = 100, -## height = 3000, width = 3000, res = 300) -data(ExampleData.FittingLM, envir = environment()) -fit_LMCurve(values = values.curve, values.bg = values.curveBG, - n.components = 2, log = "x", plot.BG = TRUE) -##dev.off() - -##(3) fit LM data with manual start parameters -data(ExampleData.FittingLM, envir = environment()) -fit_LMCurve(values = values.curve, - values.bg = values.curveBG, - n.components = 3, - log = "x", - start_values = data.frame(Im = c(170,25,400), xm = c(56,200,1500))) - -} - -\section{How to cite}{ -Kreutzer, S., 2024. fit_LMCurve(): Nonlinear Least Squares Fit for LM-OSL curves. Function version 0.3.4. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Bulur, E., 1996. An Alternative Technique For Optically -Stimulated Luminescence (OSL) Experiment. Radiation Measurements, 26, 5, -701-709. - -Jain, M., Murray, A.S., Boetter-Jensen, L., 2003. Characterisation of -blue-light stimulated luminescence components in different quartz samples: -implications for dose measurement. Radiation Measurements, 37 (4-5), -441-449. - -Kitis, G. & Pagonis, V., 2008. Computerized curve deconvolution analysis for -LM-OSL. Radiation Measurements, 43, 737-741. - -Lave, C.A.T., 1970. The Demand for Urban Mass Transportation. The Review of -Economics and Statistics, 52 (3), 320-323. - -Ritz, C. & Streibig, J.C., 2008. Nonlinear Regression with R. R. Gentleman, -K. Hornik, & G. Parmigiani, eds., Springer, p. 150. -} -\seealso{ -\link{fit_CWCurve}, \link{plot}, \link{nls}, \link[minpack.lm:nlsLM]{minpack.lm::nlsLM}, \link{get_RLum} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{dplot} -\keyword{models} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/fit_OSLLifeTimes.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/fit_OSLLifeTimes.Rd deleted file mode 100644 index 85ed2b7ac..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/fit_OSLLifeTimes.Rd +++ /dev/null @@ -1,197 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fit_OSLLifeTimes.R -\name{fit_OSLLifeTimes} -\alias{fit_OSLLifeTimes} -\title{Fitting and Deconvolution of OSL Lifetime Components} -\usage{ -fit_OSLLifeTimes( - object, - tp = 0, - signal_range = NULL, - n.components = NULL, - method_control = list(), - plot = TRUE, - plot_simple = FALSE, - verbose = TRUE, - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum.Data.Curve}, \linkS4class{RLum.Analysis}, \link{data.frame} or \link{matrix} \strong{(required)}: -Input object containing the data to be analysed. All objects can be provided also as list for an automated -processing. Please note: \code{NA} values are automatically removed and the dataset should comprise at least 5 data points (possibly more if \code{n.components} is -set to a value greater than 1)} - -\item{tp}{\link{numeric} (\emph{with default}): option to account for the stimulation pulse width. For off-time measurements -the default value is 0. \code{tp} has the same unit as the measurement data, e.g., µs. Please set this parameter -carefully, if it all, otherwise you may heavily bias your fit results.} - -\item{signal_range}{\link{numeric} (\emph{optional}): allows to set a channel range, by default all channels are used, e.g. -\code{signal_range = c(2,100)} considers only channels 2 to 100 and \code{signal_range = c(2)} considers only channels -from channel 2 onwards.} - -\item{n.components}{\link{numeric} (\emph{optional}): Fix the number of components. If set the algorithm will try -to fit the number of predefined components. If nothing is set, the algorithm will try to find the best number -of components.} - -\item{method_control}{\link{list} (\emph{optional}): Named to allow a more fine control of the fitting process. See details -for allowed options.} - -\item{plot}{\link{logical} (\emph{with default}): Enable/disable plot output} - -\item{plot_simple}{\link{logical} (\emph{with default}): Enable/disable reduced plot output. If \code{TRUE}, no -residual plot is shown, however, plot output can be combined using the standard R layout options, -such as \code{par(mfrow = c(2,2))}.} - -\item{verbose}{\link{logical} (\emph{with default}): Enable/disable terminal feedback} - -\item{...}{parameters passed to \link{plot.default} to control the plot output, supported are: -\code{main}, \code{xlab}, \code{ylab}, \code{log}, \code{xlim}, \code{ylim}, \code{col}, \code{lty}, \code{legend.pos}, \code{legend.text}. If the input -object is of type \linkS4class{RLum.Analysis} this arguments can be provided as a \link{list}.} -} -\value{ ------------------------------------\cr -\verb{[ NUMERICAL OUTPUT ]}\cr ------------------------------------\cr - -\strong{\code{RLum.Results}}-object - -\strong{slot:} \strong{\verb{@data}} - -\tabular{lll}{ -\strong{Element} \tab \strong{Type} \tab \strong{Description}\cr -\verb{$data} \tab \code{matrix} \tab the final fit matrix \cr -\verb{$start_matrix} \tab \code{matrix} \tab the start matrix used for the fitting \cr -\verb{$total_counts} \tab \code{integer} \tab Photon count sum \cr -\verb{$fit} \tab \code{nls} \tab the fit object returned by \link[minpack.lm:nls.lm]{minpack.lm::nls.lm} \cr -} - -\strong{slot:} \strong{\verb{@info}} - -The original function call - -------------------------\cr -\verb{[ TERMINAL OUTPUT ]}\cr -------------------------\cr - -Terminal output is only shown of the argument \code{verbose = TRUE}. - -\emph{(1) Start parameter and component adaption}\cr -Trave of the parameter adaptation process - -\emph{(2) Fitting results (sorted by ascending tau)}\cr -The fitting results sorted by ascending tau value. Please note -that if you access the \code{nls} fitting object, the values are not sorted. - -\emph{(3) Further information}\cr -\itemize{ -\item The photon count sum -\item Durbin-Watson residual statistic to asses whether the residuals are correlated, ideally -the residuals should be not correlated at all. Rough measures are: \cr -D = 0: the residuals are systematically correlated \cr -D = 2: the residuals are randomly distributed \cr -D = 4: the residuals are systematically anti-correlated\cr -} - -You should be suspicious if D differs largely from 2. - -------------------------\cr -\verb{[ PLOT OUTPUT ]}\cr -------------------------\cr - -A plot showing the original data and the fit so far possible. The lower plot shows the -residuals of the fit. -} -\description{ -Fitting and Deconvolution of OSL Lifetime Components -} -\details{ -The function intends to provide an easy access to pulsed optically stimulated luminescence (POSL) data, -in order determine signal lifetimes. The fitting is currently optimised to work with the off-time flank of POSL measurements -only. For the signal deconvolution, a differential evolution optimisation is combined with nonlinear least-square fitting -following the approach by Bluszcz & Adamiec (2006). - -\strong{Component deconvolution algorithm} - -The component deconvolution consists of two steps: - -(1) Adaptation phase - -In the adaptation phase the function tries to figure out the optimal and statistically justified -number of signal components following roughly the approach suggested by Bluszcz & Adamiec (2006). In -contrast to their work, for the optimisation by differential evolution here the package \code{'DEoptim'} is used. - -The function to be optimized has the form: - -\deqn{\chi^2 = \sum(w * (n_i/c - \sum(A_i * exp(-x/(tau_i + t_p))))^2)} - -with \eqn{w = 1} for unweighted regression analysis (\code{method_control = list(weights = FALSE)}) or -\eqn{w = c^2/n_i} for weighted regression analysis. The default values is \code{TRUE}. - -\deqn{F = (\Delta\chi^2 / 2) / (\chi^2/(N - 2*m - 2))} - -(2) Final fitting - -\strong{\code{method_control}} - -\tabular{lll}{ -\strong{Parameter} \tab \strong{Type} \tab \strong{Description}\cr -\code{p} \tab \link{numeric} \tab controls the probability for the F statistic reference values. For a significance level of 5 \% a value of 0.95 (the default) should be added, for 1 \%, a value of 0.99 is sufficient: 1 > p > 0 (cf. \link[stats:Fdist]{stats::FDist})\cr -\code{seed} \tab \link{numeric} \tab set the seed for the random number generator, provide a value here to get reproducible results \cr -\code{DEoptim.trace} \tab \link{logical} \tab enables/disables the tracing of the differential evolution (cf. \link[DEoptim:DEoptim.control]{DEoptim::DEoptim.control}) \cr -\code{DEoptim.itermax} \tab \link{logical} \tab controls the number of the allowed generations (cf. \link[DEoptim:DEoptim.control]{DEoptim::DEoptim.control}) \cr -\code{weights} \tab \link{logical} \tab enables/disables the weighting for the start parameter estimation and fitting (see equations above). -The default values is \code{TRUE} \cr -\code{nlsLM.trace} \tab \link{logical} \tab enables/disables trace mode for the nls fitting (\link[minpack.lm:nlsLM]{minpack.lm::nlsLM}), can be used to identify convergence problems, default is \code{FALSE} \cr -\code{nlsLM.upper} \tab \link{logical} \tab enables/disables upper parameter boundary, default is \code{TRUE} \cr -\code{nlsLM.lower} \tab \link{logical} \tab enables/disables lower parameter boundary, default is \code{TRUE} -} -} -\section{Function version}{ - 0.1.5 -} - -\examples{ - -##load example data -data(ExampleData.TR_OSL, envir = environment()) - -##fit lifetimes (short run) -fit_OSLLifeTimes( - object = ExampleData.TR_OSL, - n.components = 1) - -##long example -\dontrun{ -fit_OSLLifeTimes( -object = ExampleData.TR_OSL) -} - -} - -\section{How to cite}{ -Kreutzer, S., Schmidt, C., 2024. fit_OSLLifeTimes(): Fitting and Deconvolution of OSL Lifetime Components. Function version 0.1.5. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Bluszcz, A., Adamiec, G., 2006. Application of differential evolution to fitting OSL decay curves. -Radiation Measurements 41, 886-891. \doi{10.1016/j.radmeas.2006.05.016}\cr - -Durbin, J., Watson, G.S., 1950. Testing for Serial Correlation in Least Squares Regression: I. -Biometrika 37, 409-21. doi:10.2307/2332391 - -\strong{Further reading} - -Hughes, I., Hase, T., 2010. Measurements and Their Uncertainties. Oxford University Press. - -Storn, R., Price, K., 1997. Differential Evolution – -A Simple and Efficient Heuristic for Global Optimization over Continuous Spaces. -Journal of Global Optimization 11, 341–359. -} -\seealso{ -\link[minpack.lm:nls.lm]{minpack.lm::nls.lm}, \link[DEoptim:DEoptim]{DEoptim::DEoptim} -} -\author{ -Sebastian Kreutzer, Geography & Earth Sciences, Aberystwyth University, -Christoph Schmidt, University of Bayreuth (Germany) -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/fit_SurfaceExposure.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/fit_SurfaceExposure.Rd deleted file mode 100644 index 9954edaa9..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/fit_SurfaceExposure.Rd +++ /dev/null @@ -1,239 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fit_SurfaceExposure.R -\name{fit_SurfaceExposure} -\alias{fit_SurfaceExposure} -\title{Nonlinear Least Squares Fit for OSL surface exposure data} -\usage{ -fit_SurfaceExposure( - data, - sigmaphi = NULL, - mu = NULL, - age = NULL, - Ddot = NULL, - D0 = NULL, - weights = FALSE, - plot = TRUE, - legend = TRUE, - error_bars = TRUE, - coord_flip = FALSE, - ... -) -} -\arguments{ -\item{data}{\link{data.frame} or \link{list} (\strong{required}): -Measured OSL surface exposure data with the following structure: - -\if{html}{\out{
}}\preformatted{ (optional) - | depth (a.u.)| intensity | error | - | [ ,1] | [ ,2] | [ ,3] | - |-------------|-----------|-------| -[1, ]| ~~~~ | ~~~~ | ~~~~ | -[2, ]| ~~~~ | ~~~~ | ~~~~ | - ... | ... | ... | ... | -[x, ]| ~~~~ | ~~~~ | ~~~~ | - -}\if{html}{\out{
}} - -Alternatively, a \link{list} of \code{data.frames} can be provided, where each -\code{data.frame} has the same structure as shown above, with the exception that -they must \strong{not} include the optional error column. Providing a \link{list} as -input automatically activates the global fitting procedure (see details).} - -\item{sigmaphi}{\link{numeric} (\emph{optional}): -A numeric value for \code{sigmaphi}, i.e. the charge detrapping rate. -Example: \code{sigmaphi = 5e-10}} - -\item{mu}{\link{numeric} (\emph{optional}): -A numeric value for mu, i.e. the light attenuation coefficient. -Example: \code{mu = 0.9}} - -\item{age}{\link{numeric} (\emph{optional}): -The age (a) of the sample, if known. If \code{data} is a \link{list} of \emph{x} samples, -then \code{age} must be a numeric vector of length \emph{x}. -Example: \code{age = 10000}, or \code{age = c(1e4, 1e5, 1e6)}.} - -\item{Ddot}{\link{numeric} (\emph{optional}): -A numeric value for the environmental dose rate (Gy/ka). For this argument -to be considered a value for \code{D0} must also be provided; otherwise it will be -ignored.} - -\item{D0}{\link{numeric} (\emph{optional}): -A numeric value for the characteristic saturation dose (Gy). For this argument -to be considered a value for \code{Ddot} must also be provided; otherwise it will be -ignored.} - -\item{weights}{\link{logical} (\emph{optional}): -If \code{TRUE} the fit will be weighted by the inverse square of the error. -Requires \code{data} to be a \link{data.frame} with three columns.} - -\item{plot}{\link{logical} (\emph{optional}): -Show or hide the plot.} - -\item{legend}{\link{logical} (\emph{optional}): -Show or hide the equation inside the plot.} - -\item{error_bars}{\link{logical} (\emph{optional}): -Show or hide error bars (only applies if errors were provided).} - -\item{coord_flip}{\link{logical} (\emph{optional}): -Flip the coordinate system.} - -\item{...}{Further parameters passed to \link{plot}. -Custom parameters include: -\itemize{ -\item \code{verbose} (\link{logical}): show or hide console output -\item \code{line_col}: Colour of the fitted line -\item \code{line_lty}: Type of the fitted line (see \code{lty} in \code{?par}) -\item \code{line_lwd}: Line width of the fitted line (see \code{lwd} in \code{?par}) -}} -} -\value{ -Function returns results numerically and graphically: - ------------------------------------\cr -\verb{[ NUMERICAL OUTPUT ]}\cr ------------------------------------\cr - -\strong{\code{RLum.Results}}-object - -\strong{slot:} \strong{\verb{@data}} - -\tabular{lll}{ -\strong{Element} \tab \strong{Type} \tab \strong{Description}\cr -\verb{$summary} \tab \code{data.frame} \tab summary of the fitting results \cr -\verb{$data} \tab \code{data.frame} \tab the original input data \cr -\verb{$fit} \tab \code{nls} \tab the fitting object produced by \link[minpack.lm:nlsLM]{minpack.lm::nlsLM} \cr -\verb{$args} \tab \code{character} \tab arguments of the call \cr -\verb{$call} \tab \code{call} \tab the original function call \cr -} - -\strong{slot:} \strong{\verb{@info}} - -Currently unused. - -------------------------\cr -\verb{[ PLOT OUTPUT ]}\cr -------------------------\cr - -A scatter plot of the provided depth-intensity OSL surface exposure data -with the fitted model. -} -\description{ -This function determines the (weighted) least-squares estimates of the -parameters of either equation 1 in \emph{Sohbati et al. (2012a)} or equation 12 in -\emph{Sohbati et al. (2012b)} for a given OSL surface exposure data set (\strong{BETA}). -} -\details{ -\strong{Weighted fitting} - -If \code{weights = TRUE} the function will use the inverse square of the error (\eqn{1/\sigma^2}) -as weights during fitting using \link[minpack.lm:nlsLM]{minpack.lm::nlsLM}. Naturally, for this to -take effect individual errors must be provided in the third column of the -\code{data.frame} for \code{data}. Weighted fitting is \strong{not} supported if \code{data} -is a list of multiple \code{data.frame}s, i.e., it is not available for global -fitting. - -\strong{Dose rate} -If any of the arguments \code{Ddot} or \code{D0} is at its default value (\code{NULL}), -this function will fit equation 1 in Sohbati et al. (2012a) to the data. If -the effect of dose rate (i.e., signal saturation) needs to be considered, -numeric values for the dose rate (\code{Ddot}) (in Gy/ka) and the characteristic -saturation dose (\code{D0}) (in Gy) must be provided. The function will then fit -equation 12 in Sohbati et al. (2012b) to the data. - -\strong{NOTE}: Currently, this function does \strong{not} consider the variability -of the dose rate with sample depth (\code{x})! In the original equation the dose -rate \code{D} is an arbitrary function of \code{x} (term \code{D(x)}), but here \code{D} is assumed -constant. - -\strong{Global fitting} -If \code{data} is \link{list} of multiple \code{data.frame}s, each representing a separate -sample, the function automatically performs a global fit to the data. This -may be useful to better constrain the parameters \code{sigmaphi} or \code{mu} and -\strong{requires} that known ages for each sample is provided -(e.g., \code{age = c(100, 1000)} if \code{data} is a list with two samples). -} -\note{ -\strong{This function has BETA status. If possible, results should be} -\strong{cross-checked.} -} -\section{Function version}{ - 0.1.0 -} - -\examples{ - -## Load example data -data("ExampleData.SurfaceExposure") - -## Example 1 - Single sample -# Known parameters: 10000 a, mu = 0.9, sigmaphi = 5e-10 -sample_1 <- ExampleData.SurfaceExposure$sample_1 -head(sample_1) -results <- fit_SurfaceExposure( - data = sample_1, - mu = 0.9, - sigmaphi = 5e-10) -get_RLum(results) - - -## Example 2 - Single sample and considering dose rate -# Known parameters: 10000 a, mu = 0.9, sigmaphi = 5e-10, -# dose rate = 2.5 Gy/ka, D0 = 40 Gy -sample_2 <- ExampleData.SurfaceExposure$sample_2 -head(sample_2) -results <- fit_SurfaceExposure( - data = sample_2, - mu = 0.9, - sigmaphi = 5e-10, - Ddot = 2.5, - D0 = 40) -get_RLum(results) - -## Example 3 - Multiple samples (global fit) to better constrain 'mu' -# Known parameters: ages = 1e3, 1e4, 1e5, 1e6 a, mu = 0.9, sigmaphi = 5e-10 -set_1 <- ExampleData.SurfaceExposure$set_1 -str(set_1, max.level = 2) -results <- fit_SurfaceExposure( - data = set_1, - age = c(1e3, 1e4, 1e5, 1e6), - sigmaphi = 5e-10) -get_RLum(results) - - -## Example 4 - Multiple samples (global fit) and considering dose rate -# Known parameters: ages = 1e2, 1e3, 1e4, 1e5, 1e6 a, mu = 0.9, sigmaphi = 5e-10, -# dose rate = 1.0 Ga/ka, D0 = 40 Gy -set_2 <- ExampleData.SurfaceExposure$set_2 -str(set_2, max.level = 2) -results <- fit_SurfaceExposure( - data = set_2, - age = c(1e2, 1e3, 1e4, 1e5, 1e6), - sigmaphi = 5e-10, - Ddot = 1, - D0 = 40) -get_RLum(results) - -} - -\section{How to cite}{ -Burow, C., 2024. fit_SurfaceExposure(): Nonlinear Least Squares Fit for OSL surface exposure data. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Sohbati, R., Murray, A.S., Chapot, M.S., Jain, M., Pederson, J., 2012a. -Optically stimulated luminescence (OSL) as a chronometer for surface exposure -dating. Journal of Geophysical Research 117, B09202. doi: -\doi{10.1029/2012JB009383} - -Sohbati, R., Jain, M., Murray, A.S., 2012b. Surface exposure dating of -non-terrestrial bodies using optically stimulated luminescence: A new method. -Icarus 221, 160-166. -} -\seealso{ -\link{ExampleData.SurfaceExposure}, \link[minpack.lm:nlsLM]{minpack.lm::nlsLM} -} -\author{ -Christoph Burow, University of Cologne (Germany) -, RLum Developer Team} -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/fit_ThermalQuenching.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/fit_ThermalQuenching.Rd deleted file mode 100644 index 1dd47c3f8..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/fit_ThermalQuenching.Rd +++ /dev/null @@ -1,145 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fit_ThermalQuenching.R -\name{fit_ThermalQuenching} -\alias{fit_ThermalQuenching} -\title{Fitting Thermal Quenching Data} -\usage{ -fit_ThermalQuenching( - data, - start_param = list(), - method_control = list(), - n.MC = 100, - verbose = TRUE, - plot = TRUE, - ... -) -} -\arguments{ -\item{data}{\link{data.frame} (\strong{required}): input data with three columns, the first column contains -temperature values in deg. C, columns 2 and 3 the dependent values with its error} - -\item{start_param}{\link{list} (optional): option to provide own start parameters for the fitting, see -details} - -\item{method_control}{\link{list} (optional): further options to fine tune the fitting, see details for -further information} - -\item{n.MC}{\link{numeric} (\emph{with default}): number of Monte Carlo runs for the error estimation. If \code{n.MC} is -\code{NULL} or \verb{<=1}, the error estimation is skipped} - -\item{verbose}{\link{logical} (\emph{with default}): enables/disables terminal output} - -\item{plot}{\link{logical} (\emph{with default}): enables/disables plot output} - -\item{...}{further arguments that can be passed to control the plotting, support are \code{main}, \code{pch}, -\code{col_fit}, \code{col_points}, \code{lty}, \code{lwd}, \code{xlab}, \code{ylab}, \code{xlim}, \code{ylim}, \code{xaxt}} -} -\value{ -The function returns numerical output and an (\emph{optional}) plot. - ------------------------------------\cr -\verb{[ NUMERICAL OUTPUT ]}\cr ------------------------------------\cr - -\strong{\code{RLum.Results}}-object - -\strong{slot:} \strong{\verb{@data}} - -\verb{[.. $data : data.frame]}\cr - -A table with all fitting parameters and the number of Monte Carlo runs used for the error estimation. - -\verb{[.. $fit : nls object]} \cr - -The nls \link[stats:nls]{stats::nls} object returned by the function \link[minpack.lm:nlsLM]{minpack.lm::nlsLM}. This object -can be further passed to other functions supporting an nls object (cf. details section -in \link[stats:nls]{stats::nls}) - -\strong{slot:} \strong{\verb{@info}} - -\verb{[.. $call : call]}\cr - -The original function call. - ------------------------------------\cr -\verb{[ GAPHICAL OUTPUT ]}\cr ------------------------------------\cr - -Plotted are temperature against the signal and their uncertainties. -The fit is shown as dashed-line (can be modified). Please note that for the fitting the absolute -temperature values are used but are re-calculated to deg. C for the plot. -} -\description{ -Applying a nls-fitting to thermal quenching data. -} -\details{ -\strong{Used equation}\cr - -The equation used for the fitting is - -\deqn{y = (A / (1 + C * (exp(-W / (k * x))))) + c} - -\emph{W} is the energy depth in eV and \emph{C} is dimensionless constant. \emph{A} and \emph{c} are used to -adjust the curve for the given signal. \emph{k} is the Boltzmann in eV/K and \emph{x} is the absolute -temperature in K. - -\strong{Error estimation}\cr - -The error estimation is done be varying the input parameters using the given uncertainties in -a Monte Carlo simulation. Errors are assumed to follow a normal distribution. - -\strong{\code{start_param}} \cr - -The function allows the injection of own start parameters via the argument \code{start_param}. The -parameters needs to be provided as names list. The names are the parameters to be optimised. -Examples: \code{start_param = list(A = 1, C = 1e+5, W = 0.5, c = 0)} - -\strong{\code{method_control}} \cr - -The following arguments can be provided via \code{method_control}. Please note that arguments provided -via \code{method_control} are not further tested, i.e., if the function crashes your input was probably -wrong. - -\tabular{lll}{ -\strong{ARGUMENT} \tab \strong{TYPE} \tab \strong{DESCRIPTION}\cr -\code{upper} \tab named \link{vector} \tab sets upper fitting boundaries, if provided boundaries for all arguments -are required, e.g., \code{c(A = 0, C = 0, W = 0, c = 0)} \cr -\code{lower} \tab names \link{vector} \tab sets lower fitting boundaries (see \code{upper} for details) \cr -\code{trace} \tab \link{logical} \tab enables/disables progression trace for \link[minpack.lm:nlsLM]{minpack.lm::nlsLM}\cr -\code{weights} \tab \link{numeric} \tab option to provide own weights for the fitting, the length of this -vector needs to be equal to the number for rows of the input \code{data.frame}. If set to \code{NULL} no weights -are applied. The weights are defined by the third column of the input \code{data.frame}. -} -} -\section{Function version}{ - 0.1.0 -} - -\examples{ - -##create short example dataset -data <- data.frame( - T = c(25, 40, 50, 60, 70, 80, 90, 100, 110), - V = c(0.06, 0.058, 0.052, 0.051, 0.041, 0.034, 0.035, 0.033, 0.032), - V_X = c(0.012, 0.009, 0.008, 0.008, 0.007, 0.006, 0.005, 0.005, 0.004)) - -##fit -fit_ThermalQuenching( - data = data, - n.MC = NULL) - -} - -\section{How to cite}{ -Kreutzer, S., 2024. fit_ThermalQuenching(): Fitting Thermal Quenching Data. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Wintle, A.G., 1975. Thermal Quenching of Thermoluminescence in Quartz. Geophys. J. R. astr. Soc. 41, 107–113. -} -\seealso{ -\link[minpack.lm:nlsLM]{minpack.lm::nlsLM} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/get_Layout.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/get_Layout.Rd deleted file mode 100644 index 567093012..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/get_Layout.Rd +++ /dev/null @@ -1,66 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_Layout.R -\name{get_Layout} -\alias{get_Layout} -\title{Collection of layout definitions} -\usage{ -get_Layout(layout) -} -\arguments{ -\item{layout}{\link{character} or \link{list} object (\strong{required}): -name of the layout definition to be returned. If name is provided the -respective definition is returned. One of the following -supported layout definitions is possible: \code{"default"}, -\code{"journal.1"}, \code{"small"}, \code{"empty"}. - -User-specific layout definitions must be provided as a list object of -predefined structure, see details.} -} -\value{ -A list object with layout definitions for plot functions. -} -\description{ -This helper function returns a list with layout definitions for homogeneous -plotting. -} -\details{ -The easiest way to create a user-specific layout definition is perhaps to -create either an empty or a default layout object and fill/modify the -definitions (\code{user.layout <- get_Layout(data = "empty")}). -} -\section{Function version}{ - 0.1 -} - -\examples{ - -## read example data set -data(ExampleData.DeValues, envir = environment()) - -## show structure of the default layout definition -layout.default <- get_Layout(layout = "default") -str(layout.default) - -## show colour definitions for Abanico plot, only -layout.default$abanico$colour - -## set Abanico plot title colour to orange -layout.default$abanico$colour$main <- "orange" - -## create Abanico plot with modofied layout definition -plot_AbanicoPlot(data = ExampleData.DeValues, - layout = layout.default) - -## create Abanico plot with predefined layout "journal" -plot_AbanicoPlot(data = ExampleData.DeValues, - layout = "journal") - -} -\author{ -Michael Dietze, GFZ Potsdam (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Dietze, M., 2024. get_Layout(): Collection of layout definitions. Function version 0.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/get_Quote.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/get_Quote.Rd deleted file mode 100644 index 68f71525b..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/get_Quote.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_Quote.R -\name{get_Quote} -\alias{get_Quote} -\title{Function to return essential quotes} -\usage{ -get_Quote(ID, separated = FALSE) -} -\arguments{ -\item{ID}{\link{character} (\emph{optional}): quote ID to be returned.} - -\item{separated}{\link{logical} (\emph{with default}): return result in separated form.} -} -\value{ -Returns a character with quote and respective (false) author. -} -\description{ -This function returns one of the collected essential quotes in the -growing library. If called without any parameters, a random quote is -returned. -} -\section{Function version}{ - 0.1.5 -} - -\examples{ - -## ask for an arbitrary quote -get_Quote() - -} -\author{ -Quote credits: Michael Dietze, GFZ Potsdam (Germany), Sebastian Kreutzer, Geography & Earth Science, Aberystwyth University (United Kingdom), Dirk Mittelstraß, TU Dresden (Germany), Jakob Wallinga (Wageningen University, Netherlands) -, RLum Developer Team} - -\section{How to cite}{ -Dietze, M., Kreutzer, S., 2024. get_Quote(): Function to return essential quotes. Function version 0.1.5. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/get_RLum.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/get_RLum.Rd deleted file mode 100644 index f42a98749..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/get_RLum.Rd +++ /dev/null @@ -1,81 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_RLum.R -\name{get_RLum} -\alias{get_RLum} -\alias{get_RLum,list-method} -\alias{get_RLum,NULL-method} -\title{General accessors function for RLum S4 class objects} -\usage{ -get_RLum(object, ...) - -\S4method{get_RLum}{list}(object, class = NULL, null.rm = FALSE, ...) - -\S4method{get_RLum}{NULL}(object, ...) -} -\arguments{ -\item{object}{\linkS4class{RLum} (\strong{required}): -S4 object of class \code{RLum} or an object of type \link{list} containing only objects -of type \linkS4class{RLum}} - -\item{...}{further arguments that will be passed to the object specific methods. For -further details on the supported arguments please see the class -documentation: \linkS4class{RLum.Data.Curve}, \linkS4class{RLum.Data.Spectrum}, -\linkS4class{RLum.Data.Image}, \linkS4class{RLum.Analysis} and \linkS4class{RLum.Results}} - -\item{class}{\link{character} (\emph{optional}): allows to define the class that gets selected if -applied to a list, e.g., if a list consists of different type of RLum-class objects, this -arguments allows to make selection. If nothing is provided, all RLum-objects are treated.} - -\item{null.rm}{\link{logical} (\emph{with default}): option to get rid of empty and NULL objects} -} -\value{ -Return is the same as input objects as provided in the list. -} -\description{ -Function calls object-specific get functions for RLum S4 class objects. -} -\details{ -The function provides a generalised access point for specific -\linkS4class{RLum} objects.\cr -Depending on the input object, the corresponding get function will be selected. -Allowed arguments can be found in the documentations of the corresponding -\linkS4class{RLum} class. -} -\section{Functions}{ -\itemize{ -\item \code{get_RLum(list)}: Returns a list of \linkS4class{RLum} objects that had been passed to \link{get_RLum} - -\item \code{get_RLum(`NULL`)}: Returns NULL - -}} -\section{Function version}{ - 0.3.3 -} - -\examples{ - -##Example based using data and from the calc_CentralDose() function - -##load example data -data(ExampleData.DeValues, envir = environment()) - -##apply the central dose model 1st time -temp1 <- calc_CentralDose(ExampleData.DeValues$CA1) - -##get results and store them in a new object -temp.get <- get_RLum(object = temp1) - -} -\seealso{ -\linkS4class{RLum.Data.Curve}, \linkS4class{RLum.Data.Image}, -\linkS4class{RLum.Data.Spectrum}, \linkS4class{RLum.Analysis}, \linkS4class{RLum.Results} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. get_RLum(): General accessors function for RLum S4 class objects. Function version 0.3.3. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{utilities} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/get_Risoe.BINfileData.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/get_Risoe.BINfileData.Rd deleted file mode 100644 index 4c3670325..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/get_Risoe.BINfileData.Rd +++ /dev/null @@ -1,44 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_Risoe.BINfileData.R -\name{get_Risoe.BINfileData} -\alias{get_Risoe.BINfileData} -\title{General accessor function for RLum S4 class objects} -\usage{ -get_Risoe.BINfileData(object, ...) -} -\arguments{ -\item{object}{\linkS4class{Risoe.BINfileData} (\strong{required}): -S4 object of class \code{RLum}} - -\item{...}{further arguments that one might want to pass to the specific -get function} -} -\value{ -Return is the same as input objects as provided in the list -} -\description{ -Function calls object-specific get functions for RisoeBINfileData S4 class objects. -} -\details{ -The function provides a generalised access point for specific -\linkS4class{Risoe.BINfileData} objects. \cr -Depending on the input object, the corresponding get function will be selected. -Allowed arguments can be found in the documentations of the corresponding -\linkS4class{Risoe.BINfileData} class. -} -\section{Function version}{ - 0.1.0 -} - -\seealso{ -\linkS4class{Risoe.BINfileData} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. get_Risoe.BINfileData(): General accessor function for RLum S4 class objects. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{utilities} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/get_rightAnswer.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/get_rightAnswer.Rd deleted file mode 100644 index e865abc85..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/get_rightAnswer.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_rightAnswer.R -\name{get_rightAnswer} -\alias{get_rightAnswer} -\title{Function to get the right answer} -\usage{ -get_rightAnswer(...) -} -\arguments{ -\item{...}{you can pass an infinite number of further arguments} -} -\value{ -Returns the right answer -} -\description{ -This function returns just the right answer -} -\section{Function version}{ - 0.1.0 -} - -\examples{ - -## you really want to know? -get_rightAnswer() - -} -\author{ -inspired by R.G. -, RLum Developer Team} - -\section{How to cite}{ -NA, NA, , , 2024. get_rightAnswer(): Function to get the right answer. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/import_Data.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/import_Data.Rd deleted file mode 100644 index a37f2ea24..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/import_Data.Rd +++ /dev/null @@ -1,51 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/import_Data.R -\name{import_Data} -\alias{import_Data} -\title{Import Luminescence Data into R} -\usage{ -import_Data(file, ..., fastForward = TRUE, verbose = FALSE) -} -\arguments{ -\item{file}{\link{character} (\strong{required}): file to be imported, can be a \link{list}} - -\item{...}{arguments to be further passed down to supported functions (please check the functions -to determine the correct arguments)} - -\item{fastForward}{\link{logical} (\emph{with default}): option to create \linkS4class{RLum} objects -during import or a \link{list} of such objects} - -\item{verbose}{\link{logical} (\emph{with default}): enable/disable verbose mode} -} -\description{ -Convenience wrapper function to provide a quicker and more standardised way of -reading data into R by looping through all in the package available data import functions starting with \code{read_}. -} -\section{Function version}{ - 0.1.1 -} - -\examples{ - -## import BINX/BIN -file <- system.file("extdata/BINfile_V8.binx", package = "Luminescence") -temp <- import_Data(file) - -## RF data -file <- system.file("extdata", "RF_file.rf", package = "Luminescence") -temp <- import_Data(file) - -} -\seealso{ -\link{read_BIN2R}, \link{read_XSYG2R}, \link{read_PSL2R}, \link{read_SPE2R}, \link{read_TIFF2R}, \link{read_RF2R}, -\link{read_Daybreak2R} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. import_Data(): Import Luminescence Data into R. Function version 0.1.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/install_DevelopmentVersion.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/install_DevelopmentVersion.Rd deleted file mode 100644 index 7525ecf1b..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/install_DevelopmentVersion.Rd +++ /dev/null @@ -1,44 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/install_DevelopmentVersion.R -\name{install_DevelopmentVersion} -\alias{install_DevelopmentVersion} -\title{Attempts to install the development version of the 'Luminescence' package} -\usage{ -install_DevelopmentVersion(force_install = FALSE) -} -\arguments{ -\item{force_install}{\link{logical} (\emph{optional}): -If \code{FALSE} (the default) the function produces and prints the required -code to the console for the user to run manually afterwards. When \code{TRUE} -and all requirements are fulfilled (see details) this function attempts to install -the package itself.} -} -\value{ -This function requires user input at the command prompt to choose the -desired development branch to be installed. The required R code to install -the package is then printed to the console. -} -\description{ -This function is a convenient method for installing the development -version of the R package 'Luminescence' directly from GitHub. -} -\details{ -This function uses \link[=GitHub-API]{Luminescence::github_branches} to check -which development branches of the R package 'Luminescence' are currently -available on GitHub. The user is then prompted to choose one of the branches -to be installed. It further checks whether the R package 'devtools' is -currently installed and available on the system. Finally, it prints R code -to the console that the user can copy and paste to the R console in order -to install the desired development version of the package. - -If \code{force_install = TRUE} the functions checks if 'devtools' is available -and then attempts to install the chosen development branch via -\link[devtools:remote-reexports]{devtools::install_github}. -} -\examples{ - -\dontrun{ -install_DevelopmentVersion() -} - -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/length_RLum.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/length_RLum.Rd deleted file mode 100644 index e31c50009..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/length_RLum.Rd +++ /dev/null @@ -1,46 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/length_RLum.R -\name{length_RLum} -\alias{length_RLum} -\title{General accessor function for RLum S4 class objects} -\usage{ -length_RLum(object) -} -\arguments{ -\item{object}{\linkS4class{RLum} (\strong{required}): -S4 object of class \code{RLum}} -} -\value{ -Return is the same as input objects as provided in the list. -} -\description{ -Function calls object-specific get functions for RLum S4 class objects. -} -\details{ -The function provides a generalised access point for specific -\linkS4class{RLum} objects.\cr -Depending on the input object, the corresponding get function will be selected. -Allowed arguments can be found in the documentations of the corresponding -\linkS4class{RLum} class. -} -\section{Function version}{ - 0.1.0 -} - -\seealso{ -\linkS4class{RLum.Data.Curve}, -\linkS4class{RLum.Data.Image}, -\linkS4class{RLum.Data.Spectrum}, -\linkS4class{RLum.Analysis}, -\linkS4class{RLum.Results} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -(France) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. length_RLum(): General accessor function for RLum S4 class objects. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{utilities} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/merge_RLum.Analysis.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/merge_RLum.Analysis.Rd deleted file mode 100644 index aac2cf167..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/merge_RLum.Analysis.Rd +++ /dev/null @@ -1,67 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/merge_RLum.Analysis.R -\name{merge_RLum.Analysis} -\alias{merge_RLum.Analysis} -\title{Merge function for RLum.Analysis S4 class objects} -\usage{ -merge_RLum.Analysis(objects) -} -\arguments{ -\item{objects}{\link{list} of \linkS4class{RLum.Analysis} (\strong{required}): -list of S4 objects of class \code{RLum.Analysis}. Furthermore other objects of -class \linkS4class{RLum} can be added, see details.} -} -\value{ -Return an \linkS4class{RLum.Analysis} object. -} -\description{ -Function allows merging of RLum.Analysis objects and adding of allowed -objects to an RLum.Analysis. -} -\details{ -This function simply allows to merge \linkS4class{RLum.Analysis} -objects. Moreover, other \linkS4class{RLum} objects can be added -to an existing \linkS4class{RLum.Analysis} object. Supported objects -to be added are: \linkS4class{RLum.Data.Curve}, -\linkS4class{RLum.Data.Spectrum} and -\linkS4class{RLum.Data.Image}. - -The order in the new \linkS4class{RLum.Analysis} object is the object -order provided with the input list. -} -\note{ -The information for the slot 'protocol' is taken from the first -\linkS4class{RLum.Analysis} object in the input list. Therefore at -least one object of type \linkS4class{RLum.Analysis} has to be provided. -} -\section{Function version}{ - 0.2.0 -} - -\examples{ - - -##merge different RLum objects from the example data -data(ExampleData.RLum.Analysis, envir = environment()) -data(ExampleData.BINfileData, envir = environment()) - -object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) -curve <- get_RLum(object)[[2]] - -temp.merged <- merge_RLum.Analysis(list(curve, IRSAR.RF.Data, IRSAR.RF.Data)) - -} -\seealso{ -\link{merge_RLum}, \linkS4class{RLum.Analysis}, \linkS4class{RLum.Data.Curve}, -\linkS4class{RLum.Data.Spectrum}, \linkS4class{RLum.Data.Image}, \linkS4class{RLum} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. merge_RLum.Analysis(): Merge function for RLum.Analysis S4 class objects. Function version 0.2.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{internal} -\keyword{utilities} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/merge_RLum.Data.Curve.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/merge_RLum.Data.Curve.Rd deleted file mode 100644 index 0b03d9db1..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/merge_RLum.Data.Curve.Rd +++ /dev/null @@ -1,137 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/merge_RLum.Data.Curve.R -\name{merge_RLum.Data.Curve} -\alias{merge_RLum.Data.Curve} -\title{Merge function for RLum.Data.Curve S4 class objects} -\usage{ -merge_RLum.Data.Curve(object, merge.method = "mean", method.info) -} -\arguments{ -\item{object}{\link{list} of \linkS4class{RLum.Data.Curve} (\strong{required}): -list of S4 objects of class \code{RLum.Curve}.} - -\item{merge.method}{\link{character} (\strong{required}): -method for combining of the objects, e.g. \code{'mean'}, \code{'sum'}, see details for -further information and allowed methods. Note: Elements in slot info will -be taken from the first curve in the list.} - -\item{method.info}{\link{numeric} (\emph{optional}): -allows to specify how info elements of the input objects are combined, -e.g. \code{1} means that just the elements from the first object are kept, -\code{2} keeps only the info elements from the 2 object etc. -If nothing is provided all elements are combined.} -} -\value{ -Returns an \linkS4class{RLum.Data.Curve} object. -} -\description{ -Function allows merging of RLum.Data.Curve objects in different ways -} -\details{ -This function simply allowing to merge \linkS4class{RLum.Data.Curve} -objects without touching the objects itself. Merging is always applied on -the 2nd column of the data matrix of the object. - -\strong{Supported merge operations are \linkS4class{RLum.Data.Curve}} - -\code{"sum"} - -All count values will be summed up using the function \link{rowSums}. - -\code{"mean"} - -The mean over the count values is calculated using the function -\link{rowMeans}. - -\code{"median"} - -The median over the count values is calculated using the function -\link[matrixStats:rowMedians]{matrixStats::rowMedians}. - -\code{"sd"} - -The standard deviation over the count values is calculated using the function -\link[matrixStats:rowSds]{matrixStats::rowSds}. - -\code{"var"} - -The variance over the count values is calculated using the function -\link[matrixStats:rowVars]{matrixStats::rowVars}. - -\code{"min"} - -The min values from the count values is chosen using the function -\link[matrixStats:rowRanges]{matrixStats::rowMins}. - -\code{"max"} - -The max values from the count values is chosen using the function -\link[matrixStats:rowRanges]{matrixStats::rowMins}. - -\code{"append"} - -Appends count values of all curves to one combined data curve. The channel width -is automatically re-calculated, but requires a constant channel width of the -original data. - -\code{"-"} - -The row sums of the last objects are subtracted from the first object. - -\code{"*"} - -The row sums of the last objects are multiplied with the first object. - -\code{"/"} - -Values of the first object are divided by row sums of the last objects. -} -\note{ -The information from the slot \code{recordType} is taken from the first -\linkS4class{RLum.Data.Curve} object in the input list. The slot -'curveType' is filled with the name \code{merged}. -} -\section{S3-generic support}{ - - -This function is fully operational via S3-generics: -\code{+}, \code{-}, \code{/}, \code{*}, \code{merge} -} - -\section{Function version}{ - 0.2.1 -} - -\examples{ - - -##load example data -data(ExampleData.XSYG, envir = environment()) - -##grep first and 3d TL curves -TL.curves <- get_RLum(OSL.SARMeasurement$Sequence.Object, recordType = "TL (UVVIS)") -TL.curve.1 <- TL.curves[[1]] -TL.curve.3 <- TL.curves[[3]] - -##plot single curves -plot_RLum(TL.curve.1) -plot_RLum(TL.curve.3) - -##subtract the 1st curve from the 2nd and plot -TL.curve.merged <- merge_RLum.Data.Curve(list(TL.curve.3, TL.curve.1), merge.method = "/") -plot_RLum(TL.curve.merged) - -} -\seealso{ -\link{merge_RLum}, \linkS4class{RLum.Data.Curve} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. merge_RLum.Data.Curve(): Merge function for RLum.Data.Curve S4 class objects. Function version 0.2.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{internal} -\keyword{utilities} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/merge_RLum.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/merge_RLum.Rd deleted file mode 100644 index a12f51396..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/merge_RLum.Rd +++ /dev/null @@ -1,72 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/merge_RLum.R -\name{merge_RLum} -\alias{merge_RLum} -\title{General merge function for RLum S4 class objects} -\usage{ -merge_RLum(objects, ...) -} -\arguments{ -\item{objects}{\link{list} of \linkS4class{RLum} (\strong{required}): -list of S4 object of class \code{RLum}} - -\item{...}{further arguments that one might want to pass to the specific merge function} -} -\value{ -Return is the same as input objects as provided in the list. -} -\description{ -Function calls object-specific merge functions for RLum S4 class objects. -} -\details{ -The function provides a generalised access point for merging specific -\linkS4class{RLum} objects. Depending on the input object, the -corresponding merge function will be selected. Allowed arguments can be -found in the documentation of each merge function. -Empty list elements (\code{NULL}) are automatically removed from the input \code{list}. - -\tabular{lll}{ -\strong{object} \tab \tab \strong{corresponding merge function} \cr -\linkS4class{RLum.Data.Curve} \tab : \tab \code{merge_RLum.Data.Curve} \cr -\linkS4class{RLum.Analysis} \tab : \tab \code{merge_RLum.Analysis} \cr -\linkS4class{RLum.Results} \tab : \tab \code{merge_RLum.Results} -} -} -\note{ -So far not for every \code{RLum} object a merging function exists. -} -\section{Function version}{ - 0.1.3 -} - -\examples{ - - -##Example based using data and from the calc_CentralDose() function - -##load example data -data(ExampleData.DeValues, envir = environment()) - -##apply the central dose model 1st time -temp1 <- calc_CentralDose(ExampleData.DeValues$CA1) - -##apply the central dose model 2nd time -temp2 <- calc_CentralDose(ExampleData.DeValues$CA1) - -##merge the results and store them in a new object -temp.merged <- get_RLum(merge_RLum(objects = list(temp1, temp2))) - -} -\seealso{ -\linkS4class{RLum.Data.Curve}, \linkS4class{RLum.Data.Image}, -\linkS4class{RLum.Data.Spectrum}, \linkS4class{RLum.Analysis}, \linkS4class{RLum.Results} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. merge_RLum(): General merge function for RLum S4 class objects. Function version 0.1.3. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{utilities} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/merge_RLum.Results.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/merge_RLum.Results.Rd deleted file mode 100644 index 09efa142f..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/merge_RLum.Results.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/merge_RLum.Results.R -\name{merge_RLum.Results} -\alias{merge_RLum.Results} -\title{Merge function for RLum.Results S4-class objects} -\usage{ -merge_RLum.Results(objects) -} -\arguments{ -\item{objects}{\link{list} (\strong{required}): -a list of \linkS4class{RLum.Results} objects} -} -\description{ -Function merges objects of class \linkS4class{RLum.Results}. The slots in the objects -are combined depending on the object type, e.g., for \link{data.frame} and \link{matrix} -rows are appended. -} -\details{ -Elements are appended where possible and attributes are preserved if -not of similar name as the default attributes of, e.g., a \link{data.frame} -} -\note{ -The \code{originator} is taken from the first element and not reset to \code{merge_RLum} -} -\section{Function version}{ - 0.2.1 -} - -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. merge_RLum.Results(): Merge function for RLum.Results S4-class objects. Function version 0.2.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{internal} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/merge_Risoe.BINfileData.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/merge_Risoe.BINfileData.Rd deleted file mode 100644 index 717dd23fa..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/merge_Risoe.BINfileData.Rd +++ /dev/null @@ -1,99 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/merge_Risoe.BINfileData.R -\name{merge_Risoe.BINfileData} -\alias{merge_Risoe.BINfileData} -\title{Merge Risoe.BINfileData objects or Risoe BIN-files} -\usage{ -merge_Risoe.BINfileData( - input.objects, - output.file, - keep.position.number = FALSE, - position.number.append.gap = 0 -) -} -\arguments{ -\item{input.objects}{\link{character} with \linkS4class{Risoe.BINfileData} objects (\strong{required}): -Character vector with path and files names -(e.g. \code{input.objects = c("path/file1.bin", "path/file2.bin")} or -\linkS4class{Risoe.BINfileData} objects (e.g. \code{input.objects = c(object1, object2)}). -Alternatively a \code{list} is supported.} - -\item{output.file}{\link{character} (\emph{optional}): -File output path and name. If no value is given, a \linkS4class{Risoe.BINfileData} is -returned instead of a file.} - -\item{keep.position.number}{\link{logical} (\emph{with default}): -Allows keeping the original position numbers of the input objects. -Otherwise the position numbers are recalculated.} - -\item{position.number.append.gap}{\link{integer} (\emph{with default}): -Set the position number gap between merged BIN-file sets, if the option -\code{keep.position.number = FALSE} is used. See details for further -information.} -} -\value{ -Returns a \code{file} or a \linkS4class{Risoe.BINfileData} object. -} -\description{ -Function allows merging Risoe BIN/BINX files or \linkS4class{Risoe.BINfileData} objects. -} -\details{ -The function allows merging different measurements to one file or one -object. The record IDs are recalculated for the new object. Other values -are kept for each object. The number of input objects is not limited. - -\code{position.number.append.gap} option - -If the option \code{keep.position.number = FALSE} is used, the position -numbers of the new data set are recalculated by adding the highest position -number of the previous data set to the each position number of the next data -set. For example: The highest position number is 48, then this number will -be added to all other position numbers of the next data set (e.g. 1 + 48 = -49) - -However, there might be cases where an additional addend (summand) is needed -before the next position starts. Example: -\itemize{ -\item Position number set (A): \verb{1,3,5,7} -\item Position number set (B): \verb{1,3,5,7} -} - -With no additional summand the new position numbers would be: -\verb{1,3,5,7,8,9,10,11}. That might be unwanted. Using the argument -\code{position.number.append.gap = 1} it will become: -\verb{1,3,5,7,9,11,13,15,17}. -} -\note{ -The validity of the output objects is not further checked. -} -\section{Function version}{ - 0.2.9 -} - -\examples{ - -##merge two objects -data(ExampleData.BINfileData, envir = environment()) - -object1 <- CWOSL.SAR.Data -object2 <- CWOSL.SAR.Data - -object.new <- merge_Risoe.BINfileData(c(object1, object2)) - -} - -\section{How to cite}{ -Kreutzer, S., 2024. merge_Risoe.BINfileData(): Merge Risoe.BINfileData objects or Risoe BIN-files. Function version 0.2.9. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Duller, G.A.T., 2007. Analyst (Version 3.24) (manual). Aberystwyth University, Aberystwyth. -} -\seealso{ -\linkS4class{Risoe.BINfileData}, \link{read_BIN2R}, \link{write_R2BIN} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{IO} -\keyword{manip} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/methods_RLum.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/methods_RLum.Rd deleted file mode 100644 index cf500730e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/methods_RLum.Rd +++ /dev/null @@ -1,294 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/methods_RLum.R -\name{methods_RLum} -\alias{methods_RLum} -\alias{plot.list} -\alias{plot.RLum.Results} -\alias{plot.RLum.Analysis} -\alias{plot.RLum.Data.Curve} -\alias{plot.RLum.Data.Spectrum} -\alias{plot.RLum.Data.Image} -\alias{plot.Risoe.BINfileData} -\alias{hist.RLum.Results} -\alias{hist.RLum.Data.Image} -\alias{hist.RLum.Data.Curve} -\alias{hist.RLum.Analysis} -\alias{summary.RLum.Results} -\alias{summary.RLum.Analysis} -\alias{summary.RLum.Data.Image} -\alias{summary.RLum.Data.Curve} -\alias{subset.Risoe.BINfileData} -\alias{subset.RLum.Analysis} -\alias{bin} -\alias{bin.RLum.Data.Curve} -\alias{bin.RLum.Data.Spectrum} -\alias{length.RLum.Results} -\alias{length.RLum.Analysis} -\alias{length.RLum.Data.Curve} -\alias{length.Risoe.BINfileData} -\alias{dim.RLum.Data.Curve} -\alias{dim.RLum.Data.Spectrum} -\alias{rep.RLum} -\alias{names.RLum.Data.Curve} -\alias{names.RLum.Data.Spectrum} -\alias{names.RLum.Data.Image} -\alias{names.RLum.Analysis} -\alias{names.RLum.Results} -\alias{names.Risoe.BINfileData} -\alias{row.names.RLum.Data.Spectrum} -\alias{as.data.frame.RLum.Data.Curve} -\alias{as.data.frame.RLum.Data.Spectrum} -\alias{as.data.frame.Risoe.BINfileData} -\alias{as.list.RLum.Results} -\alias{as.list.RLum.Data.Curve} -\alias{as.list.RLum.Data.Image} -\alias{as.list.RLum.Analysis} -\alias{as.matrix.RLum.Data.Curve} -\alias{as.matrix.RLum.Data.Spectrum} -\alias{as.matrix.RLum.Data.Image} -\alias{is.RLum} -\alias{is.RLum.Data} -\alias{is.RLum.Data.Curve} -\alias{is.RLum.Data.Spectrum} -\alias{is.RLum.Data.Image} -\alias{is.RLum.Analysis} -\alias{is.RLum.Results} -\alias{merge.RLum} -\alias{unlist.RLum.Analysis} -\alias{+.RLum.Data.Curve} -\alias{-.RLum.Data.Curve} -\alias{*.RLum.Data.Curve} -\alias{/.RLum.Data.Curve} -\alias{[.RLum.Data.Curve} -\alias{[.RLum.Data.Spectrum} -\alias{[.RLum.Data.Image} -\alias{[.RLum.Analysis} -\alias{[.RLum.Results} -\alias{[<-.RLum.Data.Curve} -\alias{[[.RLum.Analysis} -\alias{[[.RLum.Results} -\alias{$.RLum.Data.Curve} -\alias{$.RLum.Analysis} -\alias{$.RLum.Results} -\title{methods_RLum} -\usage{ -\method{plot}{list}(x, y, ...) - -\method{plot}{RLum.Results}(x, y, ...) - -\method{plot}{RLum.Analysis}(x, y, ...) - -\method{plot}{RLum.Data.Curve}(x, y, ...) - -\method{plot}{RLum.Data.Spectrum}(x, y, ...) - -\method{plot}{RLum.Data.Image}(x, y, ...) - -\method{plot}{Risoe.BINfileData}(x, y, ...) - -\method{hist}{RLum.Results}(x, ...) - -\method{hist}{RLum.Data.Image}(x, ...) - -\method{hist}{RLum.Data.Curve}(x, ...) - -\method{hist}{RLum.Analysis}(x, ...) - -\method{summary}{RLum.Results}(object, ...) - -\method{summary}{RLum.Analysis}(object, ...) - -\method{summary}{RLum.Data.Image}(object, ...) - -\method{summary}{RLum.Data.Curve}(object, ...) - -\method{subset}{Risoe.BINfileData}(x, subset, records.rm = TRUE, ...) - -\method{subset}{RLum.Analysis}(x, subset = NULL, ...) - -bin(x, ...) - -\method{bin}{RLum.Data.Curve}(x, bin_size = 2, ...) - -\method{bin}{RLum.Data.Spectrum}(x, bin_size.row = 1, bin_size.col = 1, ...) - -\method{length}{RLum.Results}(x, ...) - -\method{length}{RLum.Analysis}(x, ...) - -\method{length}{RLum.Data.Curve}(x, ...) - -\method{length}{Risoe.BINfileData}(x, ...) - -\method{dim}{RLum.Data.Curve}(x) - -\method{dim}{RLum.Data.Spectrum}(x) - -\method{rep}{RLum}(x, ...) - -\method{names}{RLum.Data.Curve}(x, ...) - -\method{names}{RLum.Data.Spectrum}(x, ...) - -\method{names}{RLum.Data.Image}(x, ...) - -\method{names}{RLum.Analysis}(x, ...) - -\method{names}{RLum.Results}(x, ...) - -\method{names}{Risoe.BINfileData}(x) - -\method{row.names}{RLum.Data.Spectrum}(x, ...) - -\method{as.data.frame}{RLum.Data.Curve}(x, row.names = NULL, optional = FALSE, ...) - -\method{as.data.frame}{RLum.Data.Spectrum}(x, row.names = NULL, optional = FALSE, ...) - -\method{as.data.frame}{Risoe.BINfileData}(x, row.names = NULL, optional = FALSE, ...) - -\method{as.list}{RLum.Results}(x, ...) - -\method{as.list}{RLum.Data.Curve}(x, ...) - -\method{as.list}{RLum.Data.Image}(x, ...) - -\method{as.list}{RLum.Analysis}(x, ...) - -\method{as.matrix}{RLum.Data.Curve}(x, ...) - -\method{as.matrix}{RLum.Data.Spectrum}(x, ...) - -\method{as.matrix}{RLum.Data.Image}(x, ...) - -is.RLum(x, ...) - -is.RLum.Data(x, ...) - -is.RLum.Data.Curve(x, ...) - -is.RLum.Data.Spectrum(x, ...) - -is.RLum.Data.Image(x, ...) - -is.RLum.Analysis(x, ...) - -is.RLum.Results(x, ...) - -\method{merge}{RLum}(x, y, ...) - -\method{unlist}{RLum.Analysis}(x, recursive = TRUE, ...) - -\method{+}{RLum.Data.Curve}(x, y) - -\method{-}{RLum.Data.Curve}(x, y) - -\method{*}{RLum.Data.Curve}(x, y) - -\method{/}{RLum.Data.Curve}(x, y) - -\method{[}{RLum.Data.Curve}(x, y, z, drop = TRUE) - -\method{[}{RLum.Data.Spectrum}(x, y, z, drop = TRUE) - -\method{[}{RLum.Data.Image}(x, y, z, drop = TRUE) - -\method{[}{RLum.Analysis}(x, i, drop = FALSE) - -\method{[}{RLum.Results}(x, i, drop = TRUE) - -\method{[}{RLum.Data.Curve}(x, i, j) <- value - -\method{[[}{RLum.Analysis}(x, i) - -\method{[[}{RLum.Results}(x, i) - -\method{$}{RLum.Data.Curve}(x, i) - -\method{$}{RLum.Analysis}(x, i) - -\method{$}{RLum.Results}(x, i) -} -\arguments{ -\item{x}{\linkS4class{RLum} or \linkS4class{Risoe.BINfileData} (\strong{required}): -input object} - -\item{y}{\link{integer} (\emph{optional}): -the row index of the matrix, data.frame} - -\item{...}{further arguments that can be passed to the method} - -\item{object}{\linkS4class{RLum} (\strong{required}): -input object} - -\item{subset}{\verb{[subset]} \link{expression} (\strong{required}): -logical expression indicating elements or rows to keep, this function works -in \linkS4class{Risoe.BINfileData} objects like \link{subset.data.frame}, but takes care -of the object structure. Works also on \linkS4class{RLum.Analysis} objects.} - -\item{records.rm}{\link{subset} \link{logical} (\emph{with default}): -remove records from data set, can be disabled, to just set the column \code{SET} to \code{TRUE} or \code{FALSE}} - -\item{row.names}{\link{logical} (\emph{with default}): -enables or disables row names (\code{as.data.frame})} - -\item{optional}{\link{logical} (\emph{with default}): -logical. If TRUE, setting row names and converting column names -(to syntactic names: see make.names) is optional (see \link[base:as.data.frame]{base::as.data.frame})} - -\item{recursive}{\link{logical} (\emph{with default}): -enables or disables further sub-setting (\code{unlist})} - -\item{z}{\link{integer} (\emph{optional}): -the column index of the matrix, data.frame} - -\item{drop}{\link{logical} (\emph{with default}): -keep object structure or drop it} - -\item{i}{\link{character} (\emph{optional}): -name of the wanted record type or data object or row in the \code{RLum.Data.Curve} object} - -\item{j}{\link{integer} (\emph{optional}): -column of the data matrix in the \code{RLum.Data.Curve} object} - -\item{value}{\link{numeric} \strong{(required)}: -numeric value which replace the value in the \code{RLum.Data.Curve} object} -} -\description{ -Methods for S3-generics implemented for the package 'Luminescence'. -This document summarises all implemented S3-generics. The name of the function -is given before the first dot, after the dot the name of the object that is -supported by this method is given, e.g. \code{plot.RLum.Data.Curve} can be called -by \code{plot(object, ...)}, where \code{object} is the \code{RLum.Data.Curve} object. -} -\details{ -The term S3-generics sounds complicated, however, it just means that something -has been implemented in the package to increase the usability for users new -in R and who are not familiar with the underlying \code{RLum}-object structure of -the package. The practical outcome is that operations and functions presented -in standard books on R can be used without knowing the specifics of the R -package \code{'Luminescence'}. For examples see the example section. -} -\note{ -\code{methods_RLum} are not really new functions, everything given here are mostly just -surrogates for existing functions in the package. -} -\examples{ - -##load example data -data(ExampleData.RLum.Analysis, envir = environment()) - - -##combine curve is various ways -curve1 <- IRSAR.RF.Data[[1]] -curve2 <- IRSAR.RF.Data[[1]] -curve1 + curve2 -curve1 - curve2 -curve1 / curve2 -curve1 * curve2 - - -##`$` access curves -IRSAR.RF.Data$RF - -} -\keyword{internal} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/names_RLum.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/names_RLum.Rd deleted file mode 100644 index 679b10d3f..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/names_RLum.Rd +++ /dev/null @@ -1,50 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/names_RLum.R -\name{names_RLum} -\alias{names_RLum} -\alias{names_RLum,list-method} -\title{S4-names function for RLum S4 class objects} -\usage{ -names_RLum(object) - -\S4method{names_RLum}{list}(object) -} -\arguments{ -\item{object}{\linkS4class{RLum} (\strong{required}): -S4 object of class \code{RLum}} -} -\value{ -Returns a \link{character} -} -\description{ -Function calls object-specific names functions for RLum S4 class objects. -} -\details{ -The function provides a generalised access point for specific -\linkS4class{RLum} objects.\cr -Depending on the input object, the corresponding 'names' function will be -selected. Allowed arguments can be found in the documentations of the -corresponding \linkS4class{RLum} class. -} -\section{Functions}{ -\itemize{ -\item \code{names_RLum(list)}: Returns a list of \linkS4class{RLum} objects that had been passed to \link{names_RLum} - -}} -\section{Function version}{ - 0.1.0 -} - -\seealso{ -\linkS4class{RLum.Data.Curve}, \linkS4class{RLum.Data.Image}, -\linkS4class{RLum.Data.Spectrum}, \linkS4class{RLum.Analysis}, \linkS4class{RLum.Results} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. names_RLum(): S4-names function for RLum S4 class objects. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{utilities} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_AbanicoPlot.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_AbanicoPlot.Rd deleted file mode 100644 index dabb1c85d..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_AbanicoPlot.Rd +++ /dev/null @@ -1,491 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_AbanicoPlot.R -\name{plot_AbanicoPlot} -\alias{plot_AbanicoPlot} -\title{Function to create an Abanico Plot.} -\usage{ -plot_AbanicoPlot( - data, - na.rm = TRUE, - log.z = TRUE, - z.0 = "mean.weighted", - dispersion = "qr", - plot.ratio = 0.75, - rotate = FALSE, - mtext, - summary, - summary.pos, - summary.method = "MCM", - legend, - legend.pos, - stats, - rug = FALSE, - kde = TRUE, - hist = FALSE, - dots = FALSE, - boxplot = FALSE, - y.axis = TRUE, - error.bars = FALSE, - bar, - bar.col, - polygon.col, - line, - line.col, - line.lty, - line.label, - grid.col, - frame = 1, - bw = "SJ", - interactive = FALSE, - ... -) -} -\arguments{ -\item{data}{\link{data.frame} or \linkS4class{RLum.Results} object (\strong{required}): -for \code{data.frame} two columns: De (\code{data[,1]}) and De error (\code{data[,2]}). -To plot several data sets in one plot the data sets must be provided as -\code{list}, e.g. \code{list(data.1, data.2)}.} - -\item{na.rm}{\link{logical} (\emph{with default}): -exclude NA values from the data set prior to any further operations.} - -\item{log.z}{\link{logical} (\emph{with default}): -Option to display the z-axis in logarithmic scale. Default is \code{TRUE}.} - -\item{z.0}{\link{character} or \link{numeric}: -User-defined central value, used for centring of data. One out of \code{"mean"}, -\code{"mean.weighted"} and \code{"median"} or a numeric value (not its logarithm). -Default is \code{"mean.weighted"}.} - -\item{dispersion}{\link{character} (\emph{with default}): -measure of dispersion, used for drawing the scatter polygon. One out of -\itemize{ -\item \code{"qr"} (quartile range), -\item \code{"pnn"} (symmetric percentile range with \code{nn} the lower percentile, e.g. -\item \code{"p05"} depicting the range between 5 and 95 \%), -\item \code{"sd"} (standard deviation) and -\item \code{"2sd"} (2 standard deviations), -} - -The default is \code{"qr"}. Note that \code{"sd"} and \code{"2sd"} are only meaningful in -combination with \code{"z.0 = 'mean'"} because the unweighted mean is used to -centre the polygon.} - -\item{plot.ratio}{\link{numeric}: -Relative space, given to the radial versus the cartesian plot part, -default is \code{0.75}.} - -\item{rotate}{\link{logical}: -Option to turn the plot by 90 degrees.} - -\item{mtext}{\link{character}: -additional text below the plot title.} - -\item{summary}{\link{character} (\emph{optional}): -add statistic measures of centrality and dispersion to the plot. -Can be one or more of several keywords. See details for available keywords. -Results differ depending on the log-option for the z-scale (see details).} - -\item{summary.pos}{\link{numeric} or \link{character} (\emph{with default}): -optional position coordinates or keyword (e.g. \code{"topright"}) for the -statistical summary. Alternatively, the keyword \code{"sub"} may be -specified to place the summary below the plot header. However, this latter -option in only possible if \code{mtext} is not used.} - -\item{summary.method}{\link{character} (\emph{with default}): -keyword indicating the method used to calculate the statistic summary. -One out of -\itemize{ -\item \code{"unweighted"}, -\item \code{"weighted"} and -\item \code{"MCM"}. -} - -See \link{calc_Statistics} for details.} - -\item{legend}{\link{character} vector (\emph{optional}): -legend content to be added to the plot.} - -\item{legend.pos}{\link{numeric} or \link{character} (\emph{with default}): -optional position coordinates or keyword (e.g. \code{"topright"}) -for the legend to be plotted.} - -\item{stats}{\link{character}: -additional labels of statistically important values in the plot. -One or more out of the following: -\itemize{ -\item \code{"min"}, -\item \code{"max"}, -\item \code{"median"}. -}} - -\item{rug}{\link{logical}: -Option to add a rug to the KDE part, to indicate the location of individual values.} - -\item{kde}{\link{logical}: -Option to add a KDE plot to the dispersion part, default is \code{TRUE}.} - -\item{hist}{\link{logical}: -Option to add a histogram to the dispersion part. Only meaningful when not -more than one data set is plotted.} - -\item{dots}{\link{logical}: -Option to add a dot plot to the dispersion part. If number of dots exceeds -space in the dispersion part, a square indicates this.} - -\item{boxplot}{\link{logical}: -Option to add a boxplot to the dispersion part, default is \code{FALSE}.} - -\item{y.axis}{\link{logical}: Option to hide standard y-axis labels and show 0 only. -Useful for data with small scatter. If you want to suppress the y-axis entirely -please use \code{yaxt == 'n'} (the standard \link[graphics:par]{graphics::par} setting) instead.} - -\item{error.bars}{\link{logical}: -Option to show De-errors as error bars on De-points. Useful in combination -with \verb{y.axis = FALSE, bar.col = "none"}.} - -\item{bar}{\link{numeric} (\emph{with default}): -option to add one or more dispersion bars (i.e., bar showing the 2-sigma range) -centred at the defined values. By default a bar is drawn according to \code{"z.0"}. -To omit the bar set \code{"bar = FALSE"}.} - -\item{bar.col}{\link{character} or \link{numeric} (\emph{with default}): -colour of the dispersion bar. Default is \code{"grey60"}.} - -\item{polygon.col}{\link{character} or \link{numeric} (\emph{with default}): -colour of the polygon showing the data scatter. Sometimes this -polygon may be omitted for clarity. To disable it use \code{FALSE} or -\code{polygon = FALSE}. Default is \code{"grey80"}.} - -\item{line}{\link{numeric}: -numeric values of the additional lines to be added.} - -\item{line.col}{\link{character} or \link{numeric}: -colour of the additional lines.} - -\item{line.lty}{\link{integer}: -line type of additional lines} - -\item{line.label}{\link{character}: -labels for the additional lines.} - -\item{grid.col}{\link{character} or \link{numeric} (\emph{with default}): -colour of the grid lines (originating at \verb{[0,0]} and stretching to -the z-scale). To disable grid lines use \code{FALSE}. Default is \code{"grey"}.} - -\item{frame}{\link{numeric} (\emph{with default}): -option to modify the plot frame type. Can be one out of -\itemize{ -\item \code{0} (no frame), -\item \code{1} (frame originates at 0,0 and runs along min/max isochrons), -\item \code{2} (frame embraces the 2-sigma bar), -\item \code{3} (frame embraces the entire plot as a rectangle). -} - -Default is \code{1}.} - -\item{bw}{\link{character} (\emph{with default}): -bin-width for KDE, choose a numeric value for manual setting.} - -\item{interactive}{\link{logical} (\emph{with default}): -create an interactive abanico plot (requires the \code{'plotly'} package)} - -\item{...}{Further plot arguments to pass (see \link[graphics:plot.default]{graphics::plot.default}). -Supported are: \code{main}, \code{sub}, \code{ylab}, \code{xlab}, \code{zlab}, \code{zlim}, \code{ylim}, \code{cex}, -\code{lty}, \code{lwd}, \code{pch}, \code{col}, \code{tck}, \code{tcl}, \code{at}, \code{breaks}. \code{xlab} must be -a vector of length two, specifying the upper and lower x-axis labels.} -} -\value{ -returns a plot object and, optionally, a list with plot calculus data. -} -\description{ -A plot is produced which allows comprehensive presentation of data precision -and its dispersion around a central value as well as illustration of a -kernel density estimate, histogram and/or dot plot of the dose values. -} -\details{ -The Abanico Plot is a combination of the classic Radial Plot -(\code{plot_RadialPlot}) and a kernel density estimate plot (e.g -\code{plot_KDE}). It allows straightforward visualisation of data precision, -error scatter around a user-defined central value and the combined -distribution of the values, on the actual scale of the measured data (e.g. -seconds, equivalent dose, years). The principle of the plot is shown in -Galbraith & Green (1990). The function authors are thankful for the -thought-provoking figure in this article. - -The semi circle (z-axis) of the classic Radial Plot is bent to a straight -line here, which actually is the basis for combining this polar (radial) -part of the plot with any other Cartesian visualisation method -(KDE, histogram, PDF and so on). Note that the plot allows displaying -two measures of distribution. One is the 2-sigma -bar, which illustrates the spread in value errors, and the other is the -polygon, which stretches over both parts of the Abanico Plot (polar and -Cartesian) and illustrates the actual spread in the values themselves. - -Since the 2-sigma-bar is a polygon, it can be (and is) filled with shaded -lines. To change density (lines per inch, default is 15) and angle (default -is 45 degrees) of the shading lines, specify these parameters. See -\code{?polygon()} for further help. - -The Abanico Plot supports other than the weighted mean as measure of -centrality. When it is obvious that the data -is not (log-)normally distributed, the mean (weighted or not) cannot be a -valid measure of centrality and hence central dose. Accordingly, the median -and the weighted median can be chosen as well to represent a proper measure -of centrality (e.g. \code{centrality = "median.weighted"}). Also -user-defined numeric values (e.g. from the central age model) can be used if -this appears appropriate. - -The proportion of the polar part and the cartesian part of the Abanico Plot -can be modified for display reasons (\code{plot.ratio = 0.75}). By default, -the polar part spreads over 75 \\% and leaves 25 \\% for the part that -shows the KDE graph. - -A statistic summary, i.e. a collection of statistic measures of -centrality and dispersion (and further measures) can be added by specifying -one or more of the following keywords: -\itemize{ -\item \code{"n"} (number of samples) -\item \code{"mean"} (mean De value) -\item \code{"median"} (median of the De values) -\item \code{"sd.rel"} (relative standard deviation in percent) -\item \code{"sd.abs"} (absolute standard deviation) -\item \code{"se.rel"} (relative standard error) -\item \code{"se.abs"} (absolute standard error) -\item \code{"in.2s"} (percent of samples in 2-sigma range) -\item \code{"kurtosis"} (kurtosis) -\item \code{"skewness"} (skewness) -} - -\strong{Note} that the input data for the statistic summary is sent to the function -\code{calc_Statistics()} depending on the log-option for the z-scale. If -\code{"log.z = TRUE"}, the summary is based on the logarithms of the input -data. If \code{"log.z = FALSE"} the linearly scaled data is used. - -\strong{Note} as well, that \code{"calc_Statistics()"} calculates these statistic -measures in three different ways: \code{unweighted}, \code{weighted} and -\code{MCM-based} (i.e., based on Monte Carlo Methods). By default, the -MCM-based version is used. If you wish to use another method, indicate this -with the appropriate keyword using the argument \code{summary.method}. - -The optional parameter \code{layout} allows more sophisticated ways to modify -the entire plot. Each element of the plot can be addressed and its properties -can be defined. This includes font type, size and decoration, colours and -sizes of all plot items. To infer the definition of a specific layout style -cf. \code{get_Layout()} or type e.g., for the layout type \code{"journal"} -\code{get_Layout("journal")}. A layout type can be modified by the user by -assigning new values to the list object. - -It is possible for the z-scale to specify where ticks are to be drawn -by using the parameter \code{at}, e.g. \code{at = seq(80, 200, 20)}, cf. function -documentation of \code{axis}. Specifying tick positions manually overrides a -\code{zlim}-definition. -} -\section{Function version}{ - 0.1.17 -} - -\examples{ - -## load example data and recalculate to Gray -data(ExampleData.DeValues, envir = environment()) -ExampleData.DeValues <- ExampleData.DeValues$CA1 - -## plot the example data straightforward -plot_AbanicoPlot(data = ExampleData.DeValues) - -## now with linear z-scale -plot_AbanicoPlot(data = ExampleData.DeValues, - log.z = FALSE) - -## now with output of the plot parameters -plot1 <- plot_AbanicoPlot(data = ExampleData.DeValues, - output = TRUE) -str(plot1) -plot1$zlim - -## now with adjusted z-scale limits -plot_AbanicoPlot(data = ExampleData.DeValues, - zlim = c(10, 200)) - -## now with adjusted x-scale limits -plot_AbanicoPlot(data = ExampleData.DeValues, - xlim = c(0, 20)) - -## now with rug to indicate individual values in KDE part -plot_AbanicoPlot(data = ExampleData.DeValues, - rug = TRUE) - -## now with a smaller bandwidth for the KDE plot -plot_AbanicoPlot(data = ExampleData.DeValues, - bw = 0.04) - -## now with a histogram instead of the KDE plot -plot_AbanicoPlot(data = ExampleData.DeValues, - hist = TRUE, - kde = FALSE) - -## now with a KDE plot and histogram with manual number of bins -plot_AbanicoPlot(data = ExampleData.DeValues, - hist = TRUE, - breaks = 20) - -## now with a KDE plot and a dot plot -plot_AbanicoPlot(data = ExampleData.DeValues, - dots = TRUE) - -## now with user-defined plot ratio -plot_AbanicoPlot(data = ExampleData.DeValues, - plot.ratio = 0.5) -## now with user-defined central value -plot_AbanicoPlot(data = ExampleData.DeValues, - z.0 = 70) - -## now with median as central value -plot_AbanicoPlot(data = ExampleData.DeValues, - z.0 = "median") - -## now with the 17-83 percentile range as definition of scatter -plot_AbanicoPlot(data = ExampleData.DeValues, - z.0 = "median", - dispersion = "p17") - -## now with user-defined green line for minimum age model -CAM <- calc_CentralDose(ExampleData.DeValues, - plot = FALSE) - -plot_AbanicoPlot(data = ExampleData.DeValues, - line = CAM, - line.col = "darkgreen", - line.label = "CAM") - -## now create plot with legend, colour, different points and smaller scale -plot_AbanicoPlot(data = ExampleData.DeValues, - legend = "Sample 1", - col = "tomato4", - bar.col = "peachpuff", - pch = "R", - cex = 0.8) - -## now without 2-sigma bar, polygon, grid lines and central value line -plot_AbanicoPlot(data = ExampleData.DeValues, - bar.col = FALSE, - polygon.col = FALSE, - grid.col = FALSE, - y.axis = FALSE, - lwd = 0) - -## now with direct display of De errors, without 2-sigma bar -plot_AbanicoPlot(data = ExampleData.DeValues, - bar.col = FALSE, - ylab = "", - y.axis = FALSE, - error.bars = TRUE) - -## now with user-defined axes labels -plot_AbanicoPlot(data = ExampleData.DeValues, - xlab = c("Data error (\%)", - "Data precision"), - ylab = "Scatter", - zlab = "Equivalent dose [Gy]") - -## now with minimum, maximum and median value indicated -plot_AbanicoPlot(data = ExampleData.DeValues, - stats = c("min", "max", "median")) - -## now with a brief statistical summary as subheader -plot_AbanicoPlot(data = ExampleData.DeValues, - summary = c("n", "in.2s")) - -## now with another statistical summary -plot_AbanicoPlot(data = ExampleData.DeValues, - summary = c("mean.weighted", "median"), - summary.pos = "topleft") - -## now a plot with two 2-sigma bars for one data set -plot_AbanicoPlot(data = ExampleData.DeValues, - bar = c(30, 100)) - -## now the data set is split into sub-groups, one is manipulated -data.1 <- ExampleData.DeValues[1:30,] -data.2 <- ExampleData.DeValues[31:62,] * 1.3 - -## now a common dataset is created from the two subgroups -data.3 <- list(data.1, data.2) - -## now the two data sets are plotted in one plot -plot_AbanicoPlot(data = data.3) - -## now with some graphical modification -plot_AbanicoPlot(data = data.3, - z.0 = "median", - col = c("steelblue4", "orange4"), - bar.col = c("steelblue3", "orange3"), - polygon.col = c("steelblue1", "orange1"), - pch = c(2, 6), - angle = c(30, 50), - summary = c("n", "in.2s", "median")) - -## create Abanico plot with predefined layout definition -plot_AbanicoPlot(data = ExampleData.DeValues, - layout = "journal") - -## now with predefined layout definition and further modifications -plot_AbanicoPlot( - data = data.3, - z.0 = "median", - layout = "journal", - col = c("steelblue4", "orange4"), - bar.col = adjustcolor(c("steelblue3", "orange3"), - alpha.f = 0.5), - polygon.col = c("steelblue3", "orange3")) - -## for further information on layout definitions see documentation -## of function get_Layout() - -## now with manually added plot content -## create empty plot with numeric output -AP <- plot_AbanicoPlot(data = ExampleData.DeValues, - pch = NA, - output = TRUE) - -## identify data in 2 sigma range -in_2sigma <- AP$data[[1]]$data.in.2s - -## restore function-internal plot parameters -par(AP$par) - -## add points inside 2-sigma range -points(x = AP$data[[1]]$precision[in_2sigma], - y = AP$data[[1]]$std.estimate.plot[in_2sigma], - pch = 16) - -## add points outside 2-sigma range -points(x = AP$data[[1]]$precision[!in_2sigma], - y = AP$data[[1]]$std.estimate.plot[!in_2sigma], - pch = 1) - -} - -\section{How to cite}{ -Dietze, M., Kreutzer, S., 2024. plot_AbanicoPlot(): Function to create an Abanico Plot.. Function version 0.1.17. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Galbraith, R. & Green, P., 1990. Estimating the component ages -in a finite mixture. International Journal of Radiation Applications and -Instrumentation. Part D. Nuclear Tracks and Radiation Measurements, 17 (3), -197-206. - -Dietze, M., Kreutzer, S., Burow, C., Fuchs, M.C., Fischer, M., Schmidt, C., 2015. -The abanico plot: visualising chronometric data with individual standard errors. -Quaternary Geochronology. doi:10.1016/j.quageo.2015.09.003 -} -\seealso{ -\link{plot_RadialPlot}, \link{plot_KDE}, \link{plot_Histogram}, \link{plot_ViolinPlot} -} -\author{ -Michael Dietze, GFZ Potsdam (Germany)\cr -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -Inspired by a plot introduced by Galbraith & Green (1990) -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_DRCSummary.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_DRCSummary.Rd deleted file mode 100644 index 689524832..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_DRCSummary.Rd +++ /dev/null @@ -1,101 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_DRCSummary.R -\name{plot_DRCSummary} -\alias{plot_DRCSummary} -\title{Create a Dose-Response Curve Summary Plot} -\usage{ -plot_DRCSummary( - object, - source_dose_rate = NULL, - sel_curves = NULL, - show_dose_points = FALSE, - show_natural = FALSE, - n = 51L, - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum.Results} object (\strong{required}): input object created by the function \link{analyse_SAR.CWOSL}. The input object can be provided as \link{list}.} - -\item{source_dose_rate}{\link{numeric} (\emph{optional}): allows to modify the axis and show values in Gy, instead seconds. Only a single numerical value is allowed.} - -\item{sel_curves}{\link{numeric} (optional): id of the curves to be plotting in its occurring order. A sequence can -be provided for selecting, e.g., only every 2nd curve from the input object} - -\item{show_dose_points}{\link{logical} (with default): enable or disable plot of dose points in the graph} - -\item{show_natural}{\link{logical} (with default): enable or disable the plot of the natural \code{Lx/Tx} values} - -\item{n}{\link{integer} (with default): the number of x-values used to evaluate one curve object. Large numbers slow -down the plotting process and are usually not needed} - -\item{...}{Further arguments and graphical parameters to be passed. In particular: \code{main}, \code{xlab}, \code{ylab}, \code{xlim}, \code{ylim}, \code{lty}, \code{lwd}, \code{pch}, \code{col.pch}, \code{col.lty}, \code{mtext}} -} -\value{ -An \linkS4class{RLum.Results} object is returned: - -Slot: \strong{@data}\cr - -\tabular{lll}{ -\strong{OBJECT} \tab \strong{TYPE} \tab \strong{COMMENT}\cr -\code{results} \tab \link{data.frame} \tab with dose and LxTx values \cr -\code{data} \tab \linkS4class{RLum.Results} \tab original input data \cr -} - -Slot: \strong{@info}\cr - -\tabular{lll}{ -\strong{OBJECT} \tab \strong{TYPE} \tab \strong{COMMENT} \cr -\code{call} \tab \code{call} \tab the original function call \cr -\code{args} \tab \code{list} \tab arguments of the original function call \cr -} - -\emph{Note: If the input object is a \link{list} a list of \linkS4class{RLum.Results} objects is returned.} -} -\description{ -While analysing OSL SAR or pIRIR-data the view on the data is limited usually to one -dose-response curve (DRC) at the time for one aliquot. This function overcomes this limitation -by plotting all DRC from an \linkS4class{RLum.Results} object created by the function \link{analyse_SAR.CWOSL} -in one single plot. -} -\details{ -If you want plot your DRC on an energy scale (dose in Gy), you can either use the option \code{source_dose_rate} provided -below or your can SAR analysis with the dose points in Gy (better axis scaling). -} -\section{Function version}{ - 0.2.3 -} - -\examples{ - -#load data example data -data(ExampleData.BINfileData, envir = environment()) - -#transform the values from the first position in a RLum.Analysis object -object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) - -results <- analyse_SAR.CWOSL( - object = object, - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - plot = FALSE - ) - -##plot only DRC -plot_DRCSummary(results) - -} -\seealso{ -\linkS4class{RLum.Results}, \link{analyse_SAR.CWOSL} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) \cr -Christoph Burow, University of Cologne (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., Burow, C., 2024. plot_DRCSummary(): Create a Dose-Response Curve Summary Plot. Function version 0.2.3. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_DRTResults.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_DRTResults.Rd deleted file mode 100644 index 5b9c63fec..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_DRTResults.Rd +++ /dev/null @@ -1,212 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_DRTResults.R -\name{plot_DRTResults} -\alias{plot_DRTResults} -\title{Visualise dose recovery test results} -\usage{ -plot_DRTResults( - values, - given.dose = NULL, - error.range = 10, - preheat, - boxplot = FALSE, - mtext, - summary, - summary.pos, - legend, - legend.pos, - par.local = TRUE, - na.rm = FALSE, - ... -) -} -\arguments{ -\item{values}{\linkS4class{RLum.Results} or \link{data.frame} (\strong{required}): -input values containing at least De and De error. To plot -more than one data set in one figure, a \code{list} of the individual data -sets must be provided (e.g. \code{list(dataset.1, dataset.2)}).} - -\item{given.dose}{\link{numeric} (\emph{optional}): -given dose used for the dose recovery test to normalise data. -If only one given dose is provided this given dose is valid for all input -data sets (i.e., \code{values} is a list). Otherwise a given dose for each input -data set has to be provided (e.g., \code{given.dose = c(100,200)}). -If \code{given.dose} in \code{NULL} the values are plotted without normalisation -(might be useful for preheat plateau tests). -\strong{Note:} Unit has to be the same as from the input values (e.g., Seconds or -Gray).} - -\item{error.range}{\link{numeric}: -symmetric error range in percent will be shown as dashed lines in the plot. -Set \code{error.range} to 0 to void plotting of error ranges.} - -\item{preheat}{\link{numeric}: -optional vector of preheat temperatures to be used for grouping the De values. -If specified, the temperatures are assigned to the x-axis.} - -\item{boxplot}{\link{logical}: -optionally plot values, that are grouped by preheat temperature as boxplots. -Only possible when \code{preheat} vector is specified.} - -\item{mtext}{\link{character}: -additional text below the plot title.} - -\item{summary}{\link{character} (\emph{optional}): -adds numerical output to the plot. Can be one or more out of: -\itemize{ -\item \code{"n"} (number of samples), -\item \code{"mean"} (mean De value), -\item \code{"weighted$mean"} (error-weighted mean), -\item \code{"median"} (median of the De values), -\item \code{"sd.rel"} (relative standard deviation in percent), -\item \code{"sd.abs"} (absolute standard deviation), -\item \code{"se.rel"} (relative standard error) and -\item \code{"se.abs"} (absolute standard error) -} - -and all other measures returned by the function \link{calc_Statistics}.} - -\item{summary.pos}{\link{numeric} or \link{character} (\emph{with default}): -optional position coordinates or keyword (e.g. \code{"topright"}) -for the statistical summary. Alternatively, the keyword \code{"sub"} may be -specified to place the summary below the plot header. However, this latter -option in only possible if \code{mtext} is not used.} - -\item{legend}{\link{character} vector (\emph{optional}): -legend content to be added to the plot.} - -\item{legend.pos}{\link{numeric} or \link{character} (\emph{with default}): -optional position coordinates or keyword (e.g. \code{"topright"}) for the -legend to be plotted.} - -\item{par.local}{\link{logical} (\emph{with default}): -use local graphical parameters for plotting, e.g. the plot is shown in one -column and one row. If \code{par.local = FALSE}, global parameters are inherited, -i.e. parameters provided via \code{par()} work} - -\item{na.rm}{\link{logical}: indicating whether \code{NA} values are -removed before plotting from the input data set} - -\item{...}{further arguments and graphical parameters passed to \link{plot}, supported are: -\code{xlab}, \code{ylab}, \code{xlim}, \code{ylim}, \code{main}, \code{cex}, \code{las} and `pch``} -} -\value{ -A plot is returned. -} -\description{ -The function provides a standardised plot output for dose recovery test -measurements. -} -\details{ -Procedure to test the accuracy of a measurement protocol to reliably -determine the dose of a specific sample. Here, the natural signal is erased -and a known laboratory dose administered which is treated as unknown. Then -the De measurement is carried out and the degree of congruence between -administered and recovered dose is a measure of the protocol's accuracy for -this sample.\cr -In the plot the normalised De is shown on the y-axis, i.e. obtained De/Given Dose. -} -\note{ -Further data and plot arguments can be added by using the appropriate R -commands. -} -\section{Function version}{ - 0.1.14 -} - -\examples{ - -## read example data set and misapply them for this plot type -data(ExampleData.DeValues, envir = environment()) - -## plot values -plot_DRTResults( - values = ExampleData.DeValues$BT998[7:11,], - given.dose = 2800, - mtext = "Example data") - -## plot values with legend -plot_DRTResults( - values = ExampleData.DeValues$BT998[7:11,], - given.dose = 2800, - legend = "Test data set") - -## create and plot two subsets with randomised values -x.1 <- ExampleData.DeValues$BT998[7:11,] -x.2 <- ExampleData.DeValues$BT998[7:11,] * c(runif(5, 0.9, 1.1), 1) - -plot_DRTResults( - values = list(x.1, x.2), - given.dose = 2800) - -## some more user-defined plot parameters -plot_DRTResults( - values = list(x.1, x.2), - given.dose = 2800, - pch = c(2, 5), - col = c("orange", "blue"), - xlim = c(0, 8), - ylim = c(0.85, 1.15), - xlab = "Sample aliquot") - -## plot the data with user-defined statistical measures as legend -plot_DRTResults( - values = list(x.1, x.2), - given.dose = 2800, - summary = c("n", "weighted$mean", "sd.abs")) - -## plot the data with user-defined statistical measures as sub-header -plot_DRTResults( - values = list(x.1, x.2), - given.dose = 2800, - summary = c("n", "weighted$mean", "sd.abs"), - summary.pos = "sub") - -## plot the data grouped by preheat temperatures -plot_DRTResults( - values = ExampleData.DeValues$BT998[7:11,], - given.dose = 2800, - preheat = c(200, 200, 200, 240, 240)) - -## read example data set and misapply them for this plot type -data(ExampleData.DeValues, envir = environment()) - -## plot values -plot_DRTResults( - values = ExampleData.DeValues$BT998[7:11,], - given.dose = 2800, - mtext = "Example data") - -## plot two data sets grouped by preheat temperatures -plot_DRTResults( - values = list(x.1, x.2), - given.dose = 2800, - preheat = c(200, 200, 200, 240, 240)) - -## plot the data grouped by preheat temperatures as boxplots -plot_DRTResults( - values = ExampleData.DeValues$BT998[7:11,], - given.dose = 2800, - preheat = c(200, 200, 200, 240, 240), - boxplot = TRUE) - -} - -\section{How to cite}{ -Kreutzer, S., Dietze, M., 2024. plot_DRTResults(): Visualise dose recovery test results. Function version 0.1.14. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Wintle, A.G., Murray, A.S., 2006. A review of quartz optically -stimulated luminescence characteristics and their relevance in -single-aliquot regeneration dating protocols. Radiation Measurements, 41, -369-391. -} -\seealso{ -\link{plot} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -Michael Dietze, GFZ Potsdam (Germany) -, RLum Developer Team} -\keyword{dplot} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_DetPlot.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_DetPlot.Rd deleted file mode 100644 index 57725bc5e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_DetPlot.Rd +++ /dev/null @@ -1,178 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_DetPlot.R -\name{plot_DetPlot} -\alias{plot_DetPlot} -\title{Create De(t) plot} -\usage{ -plot_DetPlot( - object, - signal.integral.min, - signal.integral.max, - background.integral.min, - background.integral.max, - method = "shift", - signal_integral.seq = NULL, - analyse_function = "analyse_SAR.CWOSL", - analyse_function.control = list(), - n.channels = NULL, - show_ShineDownCurve = TRUE, - respect_RC.Status = FALSE, - multicore = TRUE, - verbose = TRUE, - plot = TRUE, - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum.Analysis} (\strong{required}): input object containing data for analysis -Can be provided as a \link{list} of such objects.} - -\item{signal.integral.min}{\link{integer} (\strong{required}): -lower bound of the signal integral.} - -\item{signal.integral.max}{\link{integer} (\strong{required}): -upper bound of the signal integral. Must be strictly greater than -\code{signal.integral.min}.} - -\item{background.integral.min}{\link{integer} (\strong{required}): -lower bound of the background integral.} - -\item{background.integral.max}{\link{integer} (\strong{required}): -upper bound of the background integral.} - -\item{method}{\link{character} (\emph{with default}): -method applied for constructing the De(t) plot. -\itemize{ -\item \code{shift} (\emph{the default}): the chosen signal integral is shifted the shine down curve, -\item \code{expansion}: the chosen signal integral is expanded each time by its length -}} - -\item{signal_integral.seq}{\link{numeric} (\emph{optional}): -argument to provide an own signal integral sequence for constructing the De(t) plot} - -\item{analyse_function}{\link{character} (\emph{with default}): -name of the analyse function to be called. Supported functions are: -\link{analyse_SAR.CWOSL}, \link{analyse_pIRIRSequence}} - -\item{analyse_function.control}{\link{list} (\emph{optional}): -selected arguments to be passed to the supported analyse functions -(\link{analyse_SAR.CWOSL}, \link{analyse_pIRIRSequence}). The arguments must be provided -as named \link{list}, e.g., \verb{list(dose.points = c(0,10,20,30,0,10)} will set the -regeneration dose points.} - -\item{n.channels}{\link{integer} (\emph{optional}): -number of channels used for the De(t) plot. If nothing is provided all -De-values are calculated and plotted until the start of the background -integral.} - -\item{show_ShineDownCurve}{\link{logical} (\emph{with default}): -enables or disables shine down curve in the plot output} - -\item{respect_RC.Status}{\link{logical} (\emph{with default}): -remove De-values with 'FAILED' RC.Status from the plot -(cf. \link{analyse_SAR.CWOSL} and \link{analyse_pIRIRSequence})} - -\item{multicore}{\link{logical} (\emph{with default}) : enables/disables multi core -calculation if \code{object} is a \link{list} of \linkS4class{RLum.Analysis} objects. Can be an -\link{integer} specifying the number of cores} - -\item{verbose}{\link{logical} (\emph{with default}): -enables or disables terminal feedback} - -\item{plot}{\link{logical} (\emph{with default}): enables/disables plot output -Disabling the plot is useful in cases where the output need to be processed -differently.} - -\item{...}{further arguments and graphical parameters passed to -\link{plot.default}, \link{analyse_SAR.CWOSL} and \link{analyse_pIRIRSequence} (see details for further information). -Plot control parameters are: \code{ylim}, \code{xlim}, \code{ylab}, \code{xlab}, \code{main}, \code{pch}, \code{mtext}, \code{cex}, \code{legend}, -\code{legend.text}, \code{legend.pos}} -} -\value{ -A plot and an \linkS4class{RLum.Results} object with the produced \eqn{D_e} values - -\verb{@data}: - -\tabular{lll}{ -\strong{Object} \tab \strong{Type} \tab \strong{Description}\cr -\code{De.values} \tab \code{data.frame} \tab table with De values \cr -\code{signal_integral.seq} \tab \code{numeric} \tab integral sequence used for the calculation -} - -\verb{@info}: - -\tabular{lll}{ -\strong{Object} \tab \strong{Type} \tab \strong{Description}\cr -call \tab \code{call} \tab the original function call -} -} -\description{ -Plots the equivalent dose (\eqn{D_e}) in dependency of the chosen signal integral -(cf. Bailey et al., 2003). The function is simply passing several arguments -to the function \link{plot} and the used analysis functions and runs it in a loop. -Example: \code{legend.pos} for legend position, \code{legend} for legend text. -} -\details{ -\strong{method} - -The original method presented by Bailey et al., 2003 shifted the signal integrals and slightly -extended them accounting for changes in the counting statistics. Example: \code{c(1:3, 3:5, 5:7)}. -However, here also another method is provided allowing to expand the signal integral by -consecutively expanding the integral by its chosen length. Example: \code{c(1:3, 1:5, 1:7)} - -Note that in both cases the integral limits are overlap. The finally applied limits are part -of the function output. - -\strong{analyse_function.control} - -The argument \code{analyse_function.control} currently supports the following arguments -\code{sequence.structure}, \code{dose.points}, \code{mtext.outer}, \code{fit.method}, \code{fit.force_through_origin}, \code{plot}, \code{plot.single} -} -\note{ -The entire analysis is based on the used analysis functions, namely -\link{analyse_SAR.CWOSL} and \link{analyse_pIRIRSequence}. However, the integrity -checks of this function are not that thoughtful as in these functions itself. -It means, that every sequence should be checked carefully before running long -calculations using several hundreds of channels. -} -\section{Function version}{ - 0.1.7 -} - -\examples{ - -\dontrun{ -##load data -##ExampleData.BINfileData contains two BINfileData objects -##CWOSL.SAR.Data and TL.SAR.Data -data(ExampleData.BINfileData, envir = environment()) - -##transform the values from the first position in a RLum.Analysis object -object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) - -plot_DetPlot( - object, - signal.integral.min = 1, - signal.integral.max = 3, - background.integral.min = 900, - background.integral.max = 1000, - n.channels = 5) -} - -} - -\section{How to cite}{ -Kreutzer, S., 2024. plot_DetPlot(): Create De(t) plot. Function version 0.1.7. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Bailey, R.M., Singarayer, J.S., Ward, S., Stokes, S., 2003. Identification of partial resetting -using De as a function of illumination time. Radiation Measurements 37, 511-518. -doi:10.1016/S1350-4487(03)00063-5 -} -\seealso{ -\link{plot}, \link{analyse_SAR.CWOSL}, \link{analyse_pIRIRSequence} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Ruprecht-Karl University of Heidelberg (Germany) -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_FilterCombinations.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_FilterCombinations.Rd deleted file mode 100644 index 5f74dadff..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_FilterCombinations.Rd +++ /dev/null @@ -1,176 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_FilterCombinations.R -\name{plot_FilterCombinations} -\alias{plot_FilterCombinations} -\title{Plot filter combinations along with the (optional) net transmission window} -\usage{ -plot_FilterCombinations( - filters, - wavelength_range = 200:1000, - show_net_transmission = TRUE, - interactive = FALSE, - plot = TRUE, - ... -) -} -\arguments{ -\item{filters}{\link{list} (\strong{required}): -a named list of filter data for each filter to be shown. -The filter data itself should be either provided as \link{data.frame} or \link{matrix}. -(for more options s. Details)} - -\item{wavelength_range}{\link{numeric} (\emph{with default}): -wavelength range used for the interpolation} - -\item{show_net_transmission}{\link{logical} (\emph{with default}): -show net transmission window as polygon.} - -\item{interactive}{\link{logical} (\emph{with default}): -enable/disable interactive plot} - -\item{plot}{\link{logical} (\emph{with default}): -enables or disables the plot output} - -\item{...}{further arguments that can be passed to control the plot output. -Supported are \code{main}, \code{xlab}, \code{ylab}, \code{xlim}, \code{ylim}, \code{type}, \code{lty}, \code{lwd}. -For non common plotting parameters see the details section.} -} -\value{ -Returns an S4 object of type \linkS4class{RLum.Results}. - -\strong{@data} - -\tabular{lll}{ -\strong{\code{Object}} \tab \strong{\code{Type}} \strong{\code{Description}} \cr -\code{net_transmission_window} \tab \code{matrix} \tab the resulting net transmission window \cr -\code{OD_total} \tab \code{matrix} \tab the total optical density\cr -\code{filter_matrix} \tab \code{matrix} \tab the filter matrix used for plotting -} - -\strong{@info} - -\tabular{lll}{ -\strong{Object} \tab \strong{Type} \strong{Description} \cr -\code{call} \tab \link{call} \tab the original function call -} -} -\description{ -The function allows to plot transmission windows for different filters. Missing data for specific -wavelengths are automatically interpolated for the given filter data using the function \link{approx}. -With that a standardised output is reached and a net transmission window can be shown. -} -\details{ -\strong{Calculations} - -\strong{Net transmission window} - -The net transmission window of two filters is approximated by - -\deqn{T_{final} = T_{1} * T_{2}} - -\strong{Optical density} - -\deqn{OD = -log10(T)} - -\strong{Total optical density} - -\deqn{OD_{total} = OD_{1} + OD_{2}} - -Please consider using own calculations for more precise values. - -\strong{How to provide input data?} - -\emph{CASE 1} - -The function expects that all filter values are either of type \code{matrix} or \code{data.frame} -with two columns. The first columns contains the wavelength, the second the relative transmission -(but not in percentage, i.e. the maximum transmission can be only become 1). - -In this case only the transmission window is show as provided. Changes in filter thickness and -reflection factor are not considered. - -\emph{CASE 2} - -The filter data itself are provided as list element containing a \code{matrix} or -\code{data.frame} and additional information on the thickness of the filter, e.g., -\code{list(filter1 = list(filter_matrix, d = 2))}. -The given filter data are always considered as standard input and the filter thickness value -is taken into account by - -\deqn{Transmission = Transmission^(d)} - -with d given in the same dimension as the original filter data. - -\emph{CASE 3} - -Same as CASE 2 but additionally a reflection factor P is provided, e.g., -\code{list(filter1 = list(filter_matrix, d = 2, P = 0.9))}. -The final transmission becomes: - -\deqn{Transmission = Transmission^(d) * P} - -\strong{Advanced plotting parameters} - -The following further non-common plotting parameters can be passed to the function: - -\tabular{lll}{ -\strong{\code{Argument}} \tab \strong{\code{Datatype}} \tab \strong{\code{Description}}\cr -\code{legend} \tab \code{logical} \tab enable/disable legend \cr -\code{legend.pos} \tab \code{character} \tab change legend position (\link[graphics:legend]{graphics::legend}) \cr -\code{legend.text} \tab \code{character} \tab same as the argument \code{legend} in (\link[graphics:legend]{graphics::legend}) \cr -\code{net_transmission.col} \tab \code{col} \tab colour of net transmission window polygon \cr -\code{net_transmission.col_lines} \tab \code{col} \tab colour of net transmission window polygon lines \cr -\code{net_transmission.density} \tab \code{numeric} \tab specify line density in the transmission polygon \cr -\code{grid} \tab \code{list} \tab full list of arguments that can be passed to the function \link[graphics:grid]{graphics::grid} -} - -For further modifications standard additional R plot functions are recommend, e.g., the legend -can be fully customised by disabling the standard legend and use the function \link[graphics:legend]{graphics::legend} -instead. -} -\section{Function version}{ - 0.3.2 -} - -\examples{ - -## (For legal reasons no real filter data are provided) - -## Create filter sets -filter1 <- density(rnorm(100, mean = 450, sd = 20)) -filter1 <- matrix(c(filter1$x, filter1$y/max(filter1$y)), ncol = 2) -filter2 <- matrix(c(200:799,rep(c(0,0.8,0),each = 200)), ncol = 2) - -## Example 1 (standard) -plot_FilterCombinations(filters = list(filter1, filter2)) - -## Example 2 (with d and P value and name for filter 2) -results <- plot_FilterCombinations( -filters = list(filter_1 = filter1, Rectangle = list(filter2, d = 2, P = 0.6))) -results - -## Example 3 show optical density -plot(results$OD_total) - -\dontrun{ -##Example 4 -##show the filters using the interactive mode -plot_FilterCombinations(filters = list(filter1, filter2), interactive = TRUE) - -} - - -} -\seealso{ -\linkS4class{RLum.Results}, \link{approx} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. plot_FilterCombinations(): Plot filter combinations along with the (optional) net transmission window. Function version 0.3.2. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{aplot} -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_GrowthCurve.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_GrowthCurve.Rd deleted file mode 100644 index d2214f52b..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_GrowthCurve.Rd +++ /dev/null @@ -1,336 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_GrowthCurve.R -\name{plot_GrowthCurve} -\alias{plot_GrowthCurve} -\title{Fit and plot a dose-response curve for luminescence data (Lx/Tx against dose)} -\usage{ -plot_GrowthCurve( - sample, - mode = "interpolation", - fit.method = "EXP", - fit.force_through_origin = FALSE, - fit.weights = TRUE, - fit.includingRepeatedRegPoints = TRUE, - fit.NumberRegPoints = NULL, - fit.NumberRegPointsReal = NULL, - fit.bounds = TRUE, - NumberIterations.MC = 100, - output.plot = TRUE, - output.plotExtended = TRUE, - output.plotExtended.single = FALSE, - cex.global = 1, - txtProgressBar = TRUE, - verbose = TRUE, - ... -) -} -\arguments{ -\item{sample}{\link{data.frame} (\strong{required}): -data frame with three columns for \code{x = Dose},\code{y = LxTx},\code{z = LxTx.Error}, \code{y1 = TnTx}. -The column for the test dose response is optional, but requires \code{'TnTx'} as -column name if used. For exponential fits at least three dose points -(including the natural) should be provided.} - -\item{mode}{\link{character} (\emph{with default}): -selects calculation mode of the function. -\itemize{ -\item \code{"interpolation"} (default) calculates the De by interpolation, -\item \code{"extrapolation"} calculates the equivalent dose by extrapolation (useful for MAAD measurements) and -\item \code{"alternate"} calculates no equivalent dose and just fits the data points. -} - -Please note that for option \code{"regenerative"} the first point is considered -as natural dose} - -\item{fit.method}{\link{character} (\emph{with default}): -function used for fitting. Possible options are: -\itemize{ -\item \code{LIN}, -\item \code{QDR}, -\item \code{EXP}, -\item \verb{EXP OR LIN}, -\item \code{EXP+LIN}, -\item \code{EXP+EXP}, -\item \code{GOK}, -\item \code{LambertW} -} - -See details.} - -\item{fit.force_through_origin}{\link{logical} (\emph{with default}) -allow to force the fitted function through the origin. -For \code{method = "EXP+EXP"} the function will be fixed through -the origin in either case, so this option will have no effect.} - -\item{fit.weights}{\link{logical} (\emph{with default}): -option whether the fitting is done with or without weights. See details.} - -\item{fit.includingRepeatedRegPoints}{\link{logical} (\emph{with default}): -includes repeated points for fitting (\code{TRUE}/\code{FALSE}).} - -\item{fit.NumberRegPoints}{\link{integer} (\emph{optional}): -set number of regeneration points manually. By default the number of all (!) -regeneration points is used automatically.} - -\item{fit.NumberRegPointsReal}{\link{integer} (\emph{optional}): -if the number of regeneration points is provided manually, the value of the -real, regeneration points = all points (repeated points) including reg 0, -has to be inserted.} - -\item{fit.bounds}{\link{logical} (\emph{with default}): -set lower fit bounds for all fitting parameters to 0. Limited for the use -with the fit methods \code{EXP}, \code{EXP+LIN}, \verb{EXP OR LIN}, \code{GOK}, \code{LambertW} -Argument to be inserted for experimental application only!} - -\item{NumberIterations.MC}{\link{integer} (\emph{with default}): -number of Monte Carlo simulations for error estimation. See details.} - -\item{output.plot}{\link{logical} (\emph{with default}): -plot output (\code{TRUE/FALSE}).} - -\item{output.plotExtended}{\link{logical} (\emph{with default}): -If' \code{TRUE}, 3 plots on one plot area are provided: -\enumerate{ -\item growth curve, -\item histogram from Monte Carlo error simulation and -\item a test dose response plot. -} - -If \code{FALSE}, just the growth curve will be plotted. -\strong{Requires:} \code{output.plot = TRUE}.} - -\item{output.plotExtended.single}{\link{logical} (\emph{with default}): -single plot output (\code{TRUE/FALSE}) to allow for plotting the results in -single plot windows. Requires \code{output.plot = TRUE} and -\code{output.plotExtended = TRUE}.} - -\item{cex.global}{\link{numeric} (\emph{with default}): -global scaling factor.} - -\item{txtProgressBar}{\link{logical} (\emph{with default}): -enables or disables \code{txtProgressBar}. If \code{verbose = FALSE} also no -\code{txtProgressBar} is shown.} - -\item{verbose}{\link{logical} (\emph{with default}): -enables or disables terminal feedback.} - -\item{...}{Further arguments and graphical parameters to be passed. Note: -Standard arguments will only be passed to the growth curve plot. Supported: -\code{xlim}, \code{ylim}, \code{main}, \code{xlab}, \code{ylab}} -} -\value{ -Along with a plot (so far wanted) an \code{RLum.Results} object is returned containing, -the slot \code{data} contains the following elements: - -\tabular{lll}{ -\strong{DATA.OBJECT} \tab \strong{TYPE} \tab \strong{DESCRIPTION} \cr -\code{..$De} : \tab \code{data.frame} \tab Table with De values \cr -\code{..$De.MC} : \tab \code{numeric} \tab Table with De values from MC runs \cr -\code{..$Fit} : \tab \link{nls} or \link{lm} \tab object from the fitting for \code{EXP}, \code{EXP+LIN} and \code{EXP+EXP}. -In case of a resulting linear fit when using \code{LIN}, \code{QDR} or \verb{EXP OR LIN} \cr -\code{..$Formula} : \tab \link{expression} \tab Fitting formula as R expression \cr -\code{..$call} : \tab \code{call} \tab The original function call\cr -} -} -\description{ -A dose-response curve is produced for luminescence measurements using a -regenerative or additive protocol. The function supports interpolation and -extrapolation to calculate the equivalent dose. -} -\details{ -\strong{Fitting methods} - -For all options (except for the \code{LIN}, \code{QDR} and the \verb{EXP OR LIN}), -the \link[minpack.lm:nlsLM]{minpack.lm::nlsLM} function with the \code{LM} (Levenberg-Marquardt algorithm) -algorithm is used. Note: For historical reasons for the Monte Carlo -simulations partly the function \link{nls} using the \code{port} algorithm. - -The solution is found by transforming the function or using \link{uniroot}. - -\code{LIN}: fits a linear function to the data using -\link{lm}: \deqn{y = mx + n} - -\code{QDR}: fits a linear function to the data using -\link{lm}: \deqn{y = a + bx + cx^2} - -\code{EXP}: tries to fit a function of the form -\deqn{y = a(1 - exp(-\frac{(x+c)}{b}))} -Parameters b and c are approximated by a linear fit using \link{lm}. Note: b = D0 - -\verb{EXP OR LIN}: works for some cases where an \code{EXP} fit fails. -If the \code{EXP} fit fails, a \code{LIN} fit is done instead. - -\code{EXP+LIN}: tries to fit an exponential plus linear function of the -form: -\deqn{y = a(1-exp(-\frac{x+c}{b}) + (gx))} -The \eqn{D_e} is calculated by iteration. - -\strong{Note:} In the context of luminescence dating, this -function has no physical meaning. Therefore, no D0 value is returned. - -\code{EXP+EXP}: tries to fit a double exponential function of the form -\deqn{y = (a_1 (1-exp(-\frac{x}{b_1}))) + (a_2 (1 - exp(-\frac{x}{b_2})))} -This fitting procedure is not robust against wrong start parameters and -should be further improved. - -\code{GOK}: tries to fit the general-order kinetics function after -Guralnik et al. (2015) of the form of - -\deqn{y = a (d - (1 + (\frac{1}{b}) x c)^{(-1/c)})} - -where \strong{c > 0} is a kinetic order modifier -(not to be confused with \strong{c} in \code{EXP} or \code{EXP+LIN}!). - -\code{LambertW}: tries to fit a dose-response curve based on the Lambert W function -according to Pagonis et al. (2020). The function has the form - -\deqn{y ~ (1 + (W((R - 1) * exp(R - 1 - ((x + D_{int}) / D_{c}))) / (1 - R))) * N} - -with \eqn{W} the Lambert W function, calculated using the package \link[lamW:lamW]{lamW::lambertW0}, -\eqn{R} the dimensionless retrapping ratio, \eqn{N} the total concentration -of trappings states in cm^-3 and \eqn{D_{c} = N/R} a constant. \eqn{D_{int}} is -the offset on the x-axis. Please not that finding the root in \code{mode = "extrapolation"} -is a non-easy task due to the shape of the function and the results might be -unexpected. - -\strong{Fit weighting} - -If the option \code{fit.weights = TRUE} is chosen, weights are calculated using -provided signal errors (Lx/Tx error): -\deqn{fit.weights = \frac{\frac{1}{error}}{\Sigma{\frac{1}{error}}}} - -\strong{Error estimation using Monte Carlo simulation} - -Error estimation is done using a parametric bootstrapping approach. A set of -\code{Lx/Tx} values is constructed by randomly drawing curve data sampled from normal -distributions. The normal distribution is defined by the input values (\code{mean = value}, \code{sd = value.error}). Then, a dose-response curve fit is attempted for each -dataset resulting in a new distribution of single \code{De} values. The standard -deviation of this distribution is becomes then the error of the \code{De}. With increasing -iterations, the error value becomes more stable. However, naturally the error -will not decrease with more MC runs. - -Alternatively, the function returns highest probability density interval -estimates as output, users may find more useful under certain circumstances. - -\strong{Note:} It may take some calculation time with increasing MC runs, -especially for the composed functions (\code{EXP+LIN} and \code{EXP+EXP}).\cr -Each error estimation is done with the function of the chosen fitting method. - -\strong{Subtitle information} - -To avoid plotting the subtitle information, provide an empty user \code{mtext} -\code{mtext = ""}. To plot any other subtitle text, use \code{mtext}. -} -\section{Function version}{ - 1.11.13 -} - -\examples{ - -##(1) plot growth curve for a dummy data.set and show De value -data(ExampleData.LxTxData, envir = environment()) -temp <- plot_GrowthCurve(LxTxData) -get_RLum(temp) - -##(1b) horizontal plot arrangement -layout(mat = matrix(c(1,1,2,3), ncol = 2)) -plot_GrowthCurve(LxTxData, output.plotExtended.single = TRUE) - -##(1c) to access the fitting value try -get_RLum(temp, data.object = "Fit") - -##(2) plot the growth curve only - uncomment to use -##pdf(file = "~/Desktop/Growth_Curve_Dummy.pdf", paper = "special") -plot_GrowthCurve(LxTxData) -##dev.off() - -##(3) plot growth curve with pdf output - uncomment to use, single output -##pdf(file = "~/Desktop/Growth_Curve_Dummy.pdf", paper = "special") -plot_GrowthCurve(LxTxData, output.plotExtended.single = TRUE) -##dev.off() - -##(4) plot resulting function for given interval x -x <- seq(1,10000, by = 100) -plot( - x = x, - y = eval(temp$Formula), - type = "l" -) - -##(5) plot using the 'extrapolation' mode -LxTxData[1,2:3] <- c(0.5, 0.001) -print(plot_GrowthCurve(LxTxData,mode = "extrapolation")) - -##(6) plot using the 'alternate' mode -LxTxData[1,2:3] <- c(0.5, 0.001) -print(plot_GrowthCurve(LxTxData,mode = "alternate")) - -##(7) import and fit test data set by Berger & Huntley 1989 -QNL84_2_unbleached <- -read.table(system.file("extdata/QNL84_2_unbleached.txt", package = "Luminescence")) - -results <- plot_GrowthCurve( - QNL84_2_unbleached, - mode = "extrapolation", - plot = FALSE, - verbose = FALSE) - -#calculate confidence interval for the parameters -#as alternative error estimation -confint(results$Fit, level = 0.68) - - -\dontrun{ -QNL84_2_bleached <- -read.table(system.file("extdata/QNL84_2_bleached.txt", package = "Luminescence")) -STRB87_1_unbleached <- -read.table(system.file("extdata/STRB87_1_unbleached.txt", package = "Luminescence")) -STRB87_1_bleached <- -read.table(system.file("extdata/STRB87_1_bleached.txt", package = "Luminescence")) - -print( - plot_GrowthCurve( - QNL84_2_bleached, - mode = "alternate", - plot = FALSE, - verbose = FALSE)$Fit) - -print( - plot_GrowthCurve( - STRB87_1_unbleached, - mode = "alternate", - plot = FALSE, - verbose = FALSE)$Fit) - -print( - plot_GrowthCurve( - STRB87_1_bleached, - mode = "alternate", - plot = FALSE, - verbose = FALSE)$Fit) - } - -} - -\section{How to cite}{ -Kreutzer, S., Dietze, M., 2024. plot_GrowthCurve(): Fit and plot a dose-response curve for luminescence data (Lx/Tx against dose). Function version 1.11.13. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Berger, G.W., Huntley, D.J., 1989. Test data for exponential fits. Ancient TL 7, 43-46. - -Guralnik, B., Li, B., Jain, M., Chen, R., Paris, R.B., Murray, A.S., Li, S.-H., Pagonis, P., -Herman, F., 2015. Radiation-induced growth and isothermal decay of infrared-stimulated luminescence -from feldspar. Radiation Measurements 81, 224-231. - -Pagonis, V., Kitis, G., Chen, R., 2020. A new analytical equation for the dose response of dosimetric materials, -based on the Lambert W function. Journal of Luminescence 225, 117333. \doi{10.1016/j.jlumin.2020.117333} -} -\seealso{ -\link{nls}, \linkS4class{RLum.Results}, \link{get_RLum}, \link[minpack.lm:nlsLM]{minpack.lm::nlsLM}, -\link{lm}, \link{uniroot}, \link[lamW:lamW]{lamW::lambertW0} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -Michael Dietze, GFZ Potsdam (Germany) -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_Histogram.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_Histogram.Rd deleted file mode 100644 index ad2044a3c..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_Histogram.Rd +++ /dev/null @@ -1,147 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_Histogram.R -\name{plot_Histogram} -\alias{plot_Histogram} -\title{Plot a histogram with separate error plot} -\usage{ -plot_Histogram( - data, - na.rm = TRUE, - mtext, - cex.global, - se, - rug, - normal_curve, - summary, - summary.pos, - colour, - interactive = FALSE, - ... -) -} -\arguments{ -\item{data}{\link{data.frame} or \linkS4class{RLum.Results} object (\strong{required}): -for \code{data.frame}: two columns: De (\code{data[,1]}) and De error (\code{data[,2]})} - -\item{na.rm}{\link{logical} (\emph{with default}): -excludes \code{NA} values from the data set prior to any further operations.} - -\item{mtext}{\link{character} (\emph{optional}): -further sample information (\link{mtext}).} - -\item{cex.global}{\link{numeric} (\emph{with default}): -global scaling factor.} - -\item{se}{\link{logical} (\emph{optional}): -plots standard error points over the histogram, default is \code{FALSE}.} - -\item{rug}{\link{logical} (\emph{optional}): -adds rugs to the histogram, default is \code{TRUE}.} - -\item{normal_curve}{\link{logical} (\emph{with default}): -adds a normal curve to the histogram. Mean and standard deviation are calculated from the -input data. More see details section.} - -\item{summary}{\link{character} (\emph{optional}): -add statistic measures of centrality and dispersion to the plot. -Can be one or more of several keywords. See details for available keywords.} - -\item{summary.pos}{\link{numeric} or \link{character} (\emph{with default}): -optional position coordinates or keyword (e.g. \code{"topright"}) -for the statistical summary. Alternatively, the keyword \code{"sub"} may be -specified to place the summary below the plot header. However, this latter -option in only possible if \code{mtext} is not used. In case of coordinate -specification, y-coordinate refers to the right y-axis.} - -\item{colour}{\link{numeric} or \link{character} (\emph{with default}): -optional vector of length 4 which specifies the colours of the following -plot items in exactly this order: histogram bars, rug lines, normal -distribution curve and standard error points -(e.g., \code{c("grey", "black", "red", "grey")}).} - -\item{interactive}{\link{logical} (\emph{with default}): -create an interactive histogram plot (requires the 'plotly' package)} - -\item{...}{further arguments and graphical parameters passed to \link{plot} or -\link{hist}. If y-axis labels are provided, these must be specified as a vector -of length 2 since the plot features two axes -(e.g. \code{ylab = c("axis label 1", "axis label 2")}). Y-axes limits -(\code{ylim}) must be provided as vector of length four, with the first two -elements specifying the left axes limits and the latter two elements giving -the right axis limits.} -} -\description{ -Function plots a predefined histogram with an accompanying error plot as -suggested by Rex Galbraith at the UK LED in Oxford 2010. -} -\details{ -If the normal curve is added, the y-axis in the histogram will show the -probability density. - -A statistic summary, i.e. a collection of statistic measures of -centrality and dispersion (and further measures) can be added by specifying -one or more of the following keywords: -\itemize{ -\item \code{"n"} (number of samples), -\item \code{"mean"} (mean De value), -\item \code{"mean.weighted"} (error-weighted mean), -\item \code{"median"} (median of the De values), -\item \code{"sdrel"} (relative standard deviation in percent), -\item \code{"sdrel.weighted"} (error-weighted relative standard deviation in percent), -\item \code{"sdabs"} (absolute standard deviation), -\item \code{"sdabs.weighted"} (error-weighted absolute standard deviation), -\item \code{"serel"} (relative standard error), -\item \code{"serel.weighted"} (error-weighted relative standard error), -\item \code{"seabs"} (absolute standard error), -\item \code{"seabs.weighted"} (error-weighted absolute standard error), -\item \code{"kurtosis"} (kurtosis) and -\item \code{"skewness"} (skewness). -} -} -\note{ -The input data is not restricted to a special type. -} -\section{Function version}{ - 0.4.5 -} - -\examples{ - -## load data -data(ExampleData.DeValues, envir = environment()) -ExampleData.DeValues <- - Second2Gray(ExampleData.DeValues$BT998, dose.rate = c(0.0438,0.0019)) - -## plot histogram the easiest way -plot_Histogram(ExampleData.DeValues) - -## plot histogram with some more modifications -plot_Histogram(ExampleData.DeValues, - rug = TRUE, - normal_curve = TRUE, - cex.global = 0.9, - pch = 2, - colour = c("grey", "black", "blue", "green"), - summary = c("n", "mean", "sdrel"), - summary.pos = "topleft", - main = "Histogram of De-values", - mtext = "Example data set", - ylab = c(expression(paste(D[e], " distribution")), - "Standard error"), - xlim = c(100, 250), - ylim = c(0, 0.1, 5, 20)) - - -} -\seealso{ -\link{hist}, \link{plot} -} -\author{ -Michael Dietze, GFZ Potsdam (Germany)\cr -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Dietze, M., Kreutzer, S., 2024. plot_Histogram(): Plot a histogram with separate error plot. Function version 0.4.5. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_KDE.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_KDE.Rd deleted file mode 100644 index 5bc3bb0a3..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_KDE.Rd +++ /dev/null @@ -1,191 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_KDE.R -\name{plot_KDE} -\alias{plot_KDE} -\title{Plot kernel density estimate with statistics} -\usage{ -plot_KDE( - data, - na.rm = TRUE, - values.cumulative = TRUE, - order = TRUE, - boxplot = TRUE, - rug = TRUE, - summary, - summary.pos, - summary.method = "MCM", - bw = "nrd0", - output = TRUE, - ... -) -} -\arguments{ -\item{data}{\link{data.frame}, \link{vector} or \linkS4class{RLum.Results} object (\strong{required}): -for \code{data.frame}: either two columns: De (\code{values[,1]}) and De error -(\code{values[,2]}), or one: De (\code{values[,1]}). If a numeric vector or a -single-column data frame is provided, De error is assumed to be 10^-9 -for all measurements and error bars are not drawn. -For plotting multiple data sets, these must be provided as -\code{list} (e.g. \code{list(dataset1, dataset2)}).} - -\item{na.rm}{\link{logical} (\emph{with default}): -exclude NA values from the data set prior to any further operation.} - -\item{values.cumulative}{\link{logical} (\emph{with default}): -show cumulative individual data.} - -\item{order}{\link{logical}: -Order data in ascending order.} - -\item{boxplot}{\link{logical} (\emph{with default}): -optionally show a boxplot (depicting median as thick central line, -first and third quartile as box limits, whiskers denoting +/- 1.5 -interquartile ranges and dots further outliers).} - -\item{rug}{\link{logical} (\emph{with default}): -optionally add rug.} - -\item{summary}{\link{character} (\emph{optional}): -add statistic measures of centrality and dispersion to the plot. Can be one -or more of several keywords. See details for available keywords.} - -\item{summary.pos}{\link{numeric} or \link{character} (\emph{with default}): -optional position coordinates or keyword (e.g. \code{"topright"}) -for the statistical summary. Alternatively, the keyword \code{"sub"} may be -specified to place the summary below the plot header. However, this latter -option in only possible if \code{mtext} is not used. In case of coordinate -specification, y-coordinate refers to the right y-axis.} - -\item{summary.method}{\link{character} (\emph{with default}): -keyword indicating the method used to calculate the statistic summary. -One out of \code{"unweighted"}, \code{"weighted"} and \code{"MCM"}. -See \link{calc_Statistics} for details.} - -\item{bw}{\link{character} (\emph{with default}): -bin-width, chose a numeric value for manual setting.} - -\item{output}{\link{logical}: -Optional output of numerical plot parameters. These can be useful to -reproduce similar plots. Default is \code{TRUE}.} - -\item{...}{further arguments and graphical parameters passed to \link{plot}.} -} -\description{ -Plot a kernel density estimate of measurement values in combination with the -actual values and associated error bars in ascending order. If enabled, the -boxplot will show the usual distribution parameters (median as -bold line, box delimited by the first and third quartile, whiskers defined -by the extremes and outliers shown as points) and also the mean and -standard deviation as pale bold line and pale polygon, respectively. -} -\details{ -The function allows passing several plot arguments, such as \code{main}, -\code{xlab}, \code{cex}. However, as the figure is an overlay of two -separate plots, \code{ylim} must be specified in the order: c(ymin_axis1, -ymax_axis1, ymin_axis2, ymax_axis2) when using the cumulative values plot -option. See examples for some further explanations. For details on the -calculation of the bin-width (parameter \code{bw}) see -\link{density}. - -A statistic summary, i.e. a collection of statistic measures of -centrality and dispersion (and further measures) can be added by specifying -one or more of the following keywords: -\itemize{ -\item \code{"n"} (number of samples) -\item \code{"mean"} (mean De value) -\item \code{"median"} (median of the De values) -\item \code{"sd.rel"} (relative standard deviation in percent) -\item \code{"sd.abs"} (absolute standard deviation) -\item \code{"se.rel"} (relative standard error) -\item \code{"se.abs"} (absolute standard error) -\item \code{"in.2s"} (percent of samples in 2-sigma range) -\item \code{"kurtosis"} (kurtosis) -\item \code{"skewness"} (skewness) -} - -\strong{Note} that the input data for the statistic summary is sent to the function -\code{calc_Statistics()} depending on the log-option for the z-scale. If -\code{"log.z = TRUE"}, the summary is based on the logarithms of the input -data. If \code{"log.z = FALSE"} the linearly scaled data is used. - -\strong{Note} as well, that \code{"calc_Statistics()"} calculates these statistic -measures in three different ways: \code{unweighted}, \code{weighted} and -\code{MCM-based} (i.e., based on Monte Carlo Methods). By default, the -MCM-based version is used. If you wish to use another method, indicate this -with the appropriate keyword using the argument \code{summary.method}. -} -\note{ -The plot output is no 'probability density' plot (cf. the discussion -of Berger and Galbraith in Ancient TL; see references)! -} -\section{Function version}{ - 3.6.0 -} - -\examples{ - -## read example data set -data(ExampleData.DeValues, envir = environment()) -ExampleData.DeValues <- - Second2Gray(ExampleData.DeValues$BT998, c(0.0438,0.0019)) - -## create plot straightforward -plot_KDE(data = ExampleData.DeValues) - -## create plot with logarithmic x-axis -plot_KDE(data = ExampleData.DeValues, - log = "x") - -## create plot with user-defined labels and axes limits -plot_KDE(data = ExampleData.DeValues, - main = "Dose distribution", - xlab = "Dose (s)", - ylab = c("KDE estimate", "Cumulative dose value"), - xlim = c(100, 250), - ylim = c(0, 0.08, 0, 30)) - -## create plot with boxplot option -plot_KDE(data = ExampleData.DeValues, - boxplot = TRUE) - -## create plot with statistical summary below header -plot_KDE(data = ExampleData.DeValues, - summary = c("n", "median", "skewness", "in.2s")) - -## create plot with statistical summary as legend -plot_KDE(data = ExampleData.DeValues, - summary = c("n", "mean", "sd.rel", "se.abs"), - summary.pos = "topleft") - -## split data set into sub-groups, one is manipulated, and merge again -data.1 <- ExampleData.DeValues[1:15,] -data.2 <- ExampleData.DeValues[16:25,] * 1.3 -data.3 <- list(data.1, data.2) - -## create plot with two subsets straightforward -plot_KDE(data = data.3) - -## create plot with two subsets and summary legend at user coordinates -plot_KDE(data = data.3, - summary = c("n", "median", "skewness"), - summary.pos = c(110, 0.07), - col = c("blue", "orange")) - -## example of how to use the numerical output of the function -## return plot output to draw a thicker KDE line -KDE_out <- plot_KDE(data = ExampleData.DeValues, -output = TRUE) - -} -\seealso{ -\link{density}, \link{plot} -} -\author{ -Michael Dietze, GFZ Potsdam (Germany)\cr -Geography & Earth Sciences, Aberystwyth University (United Kingdom) -, RLum Developer Team} - -\section{How to cite}{ -Dietze, M., 2024. plot_KDE(): Plot kernel density estimate with statistics. Function version 3.6.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_NRt.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_NRt.Rd deleted file mode 100644 index 3e77c5c88..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_NRt.Rd +++ /dev/null @@ -1,146 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_NRt.R -\name{plot_NRt} -\alias{plot_NRt} -\title{Visualise natural/regenerated signal ratios} -\usage{ -plot_NRt( - data, - log = FALSE, - smooth = c("none", "spline", "rmean"), - k = 3, - legend = TRUE, - legend.pos = "topright", - ... -) -} -\arguments{ -\item{data}{\link{list}, \link{data.frame}, \link{matrix} or \linkS4class{RLum.Analysis} (\strong{required}): -X,Y data of measured values (time and counts). See details on individual data structure.} - -\item{log}{\link{character} (\emph{optional}): -logarithmic axes (\code{c("x", "y", "xy")}).} - -\item{smooth}{\link{character} (\emph{optional}): -apply data smoothing. Use \code{"rmean"} to calculate the rolling where \code{k} -determines the width of the rolling window (see \link[zoo:rollmean]{zoo::rollmean}). \code{"spline"} -applies a smoothing spline to each curve (see \link[stats:smooth.spline]{stats::smooth.spline})} - -\item{k}{\link{integer} (\emph{with default}): -integer width of the rolling window.} - -\item{legend}{\link{logical} (\emph{with default}): -show or hide the plot legend.} - -\item{legend.pos}{\link{character} (\emph{with default}): -keyword specifying the position of the legend (see \link{legend}).} - -\item{...}{further parameters passed to \link{plot} (also see \link{par}).} -} -\value{ -Returns a plot and \linkS4class{RLum.Analysis} object. -} -\description{ -This function creates a Natural/Regenerated signal vs. time (NR(t)) plot -as shown in Steffen et al. 2009 -} -\details{ -This function accepts the individual curve data in many different formats. If -\code{data} is a \code{list}, each element of the list must contain a two -column \code{data.frame} or \code{matrix} containing the \code{XY} data of the curves -(time and counts). Alternatively, the elements can be objects of class -\linkS4class{RLum.Data.Curve}. - -Input values can also be provided as a \code{data.frame} or \code{matrix} where -the first column contains the time values and each following column contains -the counts of each curve. -} -\examples{ - -## load example data -data("ExampleData.BINfileData", envir = environment()) - -## EXAMPLE 1 - -## convert Risoe.BINfileData object to RLum.Analysis object -data <- Risoe.BINfileData2RLum.Analysis(object = CWOSL.SAR.Data, pos = 8, ltype = "OSL") - -## extract all OSL curves -allCurves <- get_RLum(data) - -## keep only the natural and regenerated signal curves -pos <- seq(1, 9, 2) -curves <- allCurves[pos] - -## plot a standard NR(t) plot -plot_NRt(curves) - -## re-plot with rolling mean data smoothing -plot_NRt(curves, smooth = "rmean", k = 10) - -## re-plot with a logarithmic x-axis -plot_NRt(curves, log = "x", smooth = "rmean", k = 5) - -## re-plot with custom axes ranges -plot_NRt(curves, smooth = "rmean", k = 5, - xlim = c(0.1, 5), ylim = c(0.4, 1.6), - legend.pos = "bottomleft") - -## re-plot with smoothing spline on log scale -plot_NRt(curves, smooth = "spline", log = "x", - legend.pos = "top") - -## EXAMPLE 2 - -# you may also use this function to check whether all -# TD curves follow the same shape (making it a TnTx(t) plot). -posTD <- seq(2, 14, 2) -curves <- allCurves[posTD] - -plot_NRt(curves, main = "TnTx(t) Plot", - smooth = "rmean", k = 20, - ylab = "TD natural / TD regenerated", - xlim = c(0, 20), legend = FALSE) - -## EXAMPLE 3 - -# extract data from all positions -data <- lapply(1:24, FUN = function(pos) { - Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = pos, ltype = "OSL") -}) - -# get individual curve data from each aliquot -aliquot <- lapply(data, get_RLum) - -# set graphical parameters -par(mfrow = c(2, 2)) - -# create NR(t) plots for all aliquots -for (i in 1:length(aliquot)) { - plot_NRt(aliquot[[i]][pos], - main = paste0("Aliquot #", i), - smooth = "rmean", k = 20, - xlim = c(0, 10), - cex = 0.6, legend.pos = "bottomleft") -} - -# reset graphical parameters -par(mfrow = c(1, 1)) - - -} - -\section{How to cite}{ -Burow, C., 2024. plot_NRt(): Visualise natural/regenerated signal ratios. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Steffen, D., Preusser, F., Schlunegger, F., 2009. OSL quartz underestimation due to -unstable signal components. Quaternary Geochronology, 4, 353-362. -} -\seealso{ -\link{plot} -} -\author{ -Christoph Burow, University of Cologne (Germany) -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_OSLAgeSummary.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_OSLAgeSummary.Rd deleted file mode 100644 index c18ded86a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_OSLAgeSummary.Rd +++ /dev/null @@ -1,58 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_OSLAgeSummary.R -\name{plot_OSLAgeSummary} -\alias{plot_OSLAgeSummary} -\title{Plot Posterior OSL-Age Summary} -\usage{ -plot_OSLAgeSummary(object, level = 0.95, digits = 1L, verbose = TRUE, ...) -} -\arguments{ -\item{object}{\linkS4class{RLum.Results}, \link{numeric} (\strong{required}): an object produced -by \link{combine_De_Dr}. Alternatively, a \link{numeric} vector of a parameter from an MCMC process} - -\item{level}{\link{numeric} (\emph{with default}): probability of shown credible interval} - -\item{digits}{\link{integer} (\emph{with default}): number of digits considered for the calculation} - -\item{verbose}{\link{logical} (\emph{with default}): enable/disable additional terminal output} - -\item{...}{further arguments to modify the plot, supported: \code{xlim}, \code{ylim}, \code{xlab}, \code{ylab}, -\code{main}, \code{lwd}, \code{lty}, \code{col}, \code{polygon_col}, \code{polygon_density}, \code{rug}} -} -\value{ -A posterior distribution plot and an \linkS4class{RLum.Results} -object with the credible interval. -} -\description{ -A graphical summary of the statistical inference of an OSL age -} -\details{ -The function is called automatically by \link{combine_De_Dr} -} -\section{Function version}{ - 0.1.0 -} - -\examples{ -##generate random data -set.seed(1234) -object <- rnorm(1000, 100, 10) -plot_OSLAgeSummary(object) - -} -\seealso{ -\link{combine_De_Dr}, \link{plot.default}, \link[rjags:rjags-package]{rjags::rjags} -} -\author{ -Anne Philippe, Université de Nantes (France), -Jean-Michel Galharret, Université de Nantes (France), -Norbert Mercier, IRAMAT-CRP2A, Université Bordeaux Montaigne (France), -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Philippe, A., Galharret, J., Mercier, N., Kreutzer, S., 2024. plot_OSLAgeSummary(): Plot Posterior OSL-Age Summary. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{dplot} -\keyword{hplot} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_RLum.Analysis.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_RLum.Analysis.Rd deleted file mode 100644 index 8b5135f1f..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_RLum.Analysis.Rd +++ /dev/null @@ -1,145 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_RLum.Analysis.R -\name{plot_RLum.Analysis} -\alias{plot_RLum.Analysis} -\title{Plot function for an RLum.Analysis S4 class object} -\usage{ -plot_RLum.Analysis( - object, - subset = NULL, - nrows, - ncols, - abline = NULL, - combine = FALSE, - records_max = NULL, - curve.transformation, - plot.single = FALSE, - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum.Analysis} (\strong{required}): -S4 object of class \code{RLum.Analysis}} - -\item{subset}{named \link{list} (\emph{optional}): -subsets elements for plotting. The arguments in the named \link{list} will be -directly passed to the function \link{get_RLum} -(e.g., \code{subset = list(curveType = "measured")})} - -\item{nrows}{\link{integer} (\emph{optional}): -sets number of rows for plot output, if nothing is set the function -tries to find a value.} - -\item{ncols}{\link{integer} (\emph{optional}): -sets number of columns for plot output, if nothing is set the function -tries to find a value.} - -\item{abline}{\link{list} (\emph{optional}): -allows to add ab-lines to the plot. Argument are provided -in a list and will be forward to the function \link{abline}, -e.g., \code{list(v = c(10, 100))} adds two vertical lines add 10 and 100 to all -plots. In contrast \verb{list(v = c(10), v = c(100)} adds a vertical at 10 to -the first and a vertical line at 100 to the 2nd plot.} - -\item{combine}{\link{logical} (\emph{with default}): -allows to combine all \linkS4class{RLum.Data.Curve} objects in one single plot.} - -\item{records_max}{\link{numeric} (\emph{optional}): limits number of records -shown if \code{combine = TRUE}. Shown are always the first and the last curve, -the other number of curves to be shown a distributed evenly, this may result -in fewer curves plotted as specified. This parameter has only -an effect for n > 2.} - -\item{curve.transformation}{\link{character} (\emph{optional}): -allows transforming CW-OSL and CW-IRSL curves to pseudo-LM curves via -transformation functions. Allowed values are: \code{CW2pLM}, \code{CW2pLMi}, -\code{CW2pHMi} and \code{CW2pPMi}. See details.} - -\item{plot.single}{\link{logical} (\emph{with default}): -global par settings are considered, normally this should end in one plot per page} - -\item{...}{further arguments and graphical parameters will be passed to -the \code{plot} function. - -Supported arguments: \code{main}, \code{mtext}, \code{log}, \code{lwd}, \code{lty} \code{type}, \code{pch}, \code{col}, -\code{norm} (see \link{plot_RLum.Data.Curve}), \code{xlim},\code{ylim}, \code{xlab}, \code{ylab}, ... - -and for \code{combine = TRUE} also: \code{sub_title}, \code{legend}, \code{legend.text}, \code{legend.pos} -(typical plus 'outside'), \code{legend.col}, \code{smooth}. - -All arguments can be provided as \code{vector} or \code{list} to gain in full control -of all plot settings.} -} -\value{ -Returns multiple plots. -} -\description{ -The function provides a standardised plot output for curve data of an -RLum.Analysis S4 class object - -The function produces a multiple plot output. A file output is recommended -(e.g., \link{pdf}). - -\strong{curve.transformation} - -This argument allows transforming continuous wave (CW) curves to pseudo -(linear) modulated curves. For the transformation, the functions of the -package are used. Currently, it is not possible to pass further arguments to -the transformation functions. The argument works only for \code{ltype} -\code{OSL} and \code{IRSL}. - -Please note: The curve transformation within this functions works roughly, -i.e. every IRSL or OSL curve is transformed, without considering whether it -is measured with the PMT or not! However, for a fast look it might be -helpful. -} -\note{ -Not all arguments available for \link{plot} will be passed and they partly do not behave in the -way you might expect them to work. This function was designed to serve as an overview -plot, if you want to have more control, extract the objects and plot them individually. -} -\section{Function version}{ - 0.3.15 -} - -\examples{ - -##load data -data(ExampleData.BINfileData, envir = environment()) - -##convert values for position 1 -temp <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) - -##(1) plot (combine) TL curves in one plot -plot_RLum.Analysis( -temp, -subset = list(recordType = "TL"), -combine = TRUE, -norm = TRUE, -abline = list(v = c(110)) -) - -##(2) same as example (1) but using -## the argument smooth = TRUE -plot_RLum.Analysis( -temp, -subset = list(recordType = "TL"), -combine = TRUE, -norm = TRUE, -smooth = TRUE, -abline = list(v = c(110)) -) - -} -\seealso{ -\link{plot}, \link{plot_RLum}, \link{plot_RLum.Data.Curve} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. plot_RLum.Analysis(): Plot function for an RLum.Analysis S4 class object. Function version 0.3.15. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{aplot} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_RLum.Data.Curve.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_RLum.Data.Curve.Rd deleted file mode 100644 index 3db1aef97..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_RLum.Data.Curve.Rd +++ /dev/null @@ -1,97 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_RLum.Data.Curve.R -\name{plot_RLum.Data.Curve} -\alias{plot_RLum.Data.Curve} -\title{Plot function for an RLum.Data.Curve S4 class object} -\usage{ -plot_RLum.Data.Curve( - object, - par.local = TRUE, - norm = FALSE, - smooth = FALSE, - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum.Data.Curve} (\strong{required}): -S4 object of class \code{RLum.Data.Curve}} - -\item{par.local}{\link{logical} (\emph{with default}): -use local graphical parameters for plotting, e.g. the plot is shown in one -column and one row. If \code{par.local = FALSE}, global parameters are inherited.} - -\item{norm}{\link{logical} \link{character} (\emph{with default}): allows curve normalisation to the -highest count value ('default'). Alternatively, the function offers the -modes \code{"max"}, \code{"min"} and \code{"huot"} for a background corrected normalisation, see details.} - -\item{smooth}{\link{logical} (\emph{with default}): -provides an automatic curve smoothing based on \link[zoo:rollmean]{zoo::rollmean}} - -\item{...}{further arguments and graphical parameters that will be passed -to the \code{plot} function} -} -\value{ -Returns a plot. -} -\description{ -The function provides a standardised plot output for curve data of an -\code{RLum.Data.Curve} S4-class object. -} -\details{ -Only single curve data can be plotted with this function. Arguments -according to \link{plot}. - -\strong{Curve normalisation} - -The argument \code{norm} normalises all count values. To date the following -options are supported: - -\code{norm = TRUE} or \code{norm = "max"}: Curve values are normalised to the highest -count value in the curve - -\code{norm = "last"}: Curves values are normalised to the last count value -(this can be useful in particular for radiofluorescence curves) - -\code{norm = "huot"}: Curve values are normalised as suggested by Sébastien Huot -via GitHub: -\deqn{ -y = (observed - median(background)) / (max(observed) - median(background)) -} - -The background of the curve is defined as the last 20\% of the count values -of a curve. -} -\note{ -Not all arguments of \link{plot} will be passed! -} -\section{Function version}{ - 0.2.6 -} - -\examples{ - -##plot curve data - -#load Example data -data(ExampleData.CW_OSL_Curve, envir = environment()) - -#transform data.frame to RLum.Data.Curve object -temp <- as(ExampleData.CW_OSL_Curve, "RLum.Data.Curve") - -#plot RLum.Data.Curve object -plot_RLum.Data.Curve(temp) - - -} -\seealso{ -\link{plot}, \link{plot_RLum} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. plot_RLum.Data.Curve(): Plot function for an RLum.Data.Curve S4 class object. Function version 0.2.6. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{aplot} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_RLum.Data.Image.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_RLum.Data.Image.Rd deleted file mode 100644 index 784b56764..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_RLum.Data.Image.Rd +++ /dev/null @@ -1,88 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_RLum.Data.Image.R -\name{plot_RLum.Data.Image} -\alias{plot_RLum.Data.Image} -\title{Plot function for an \code{RLum.Data.Image} S4 class object} -\usage{ -plot_RLum.Data.Image( - object, - frames = NULL, - par.local = TRUE, - plot.type = "plot.raster", - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum.Data.Image} (\strong{required}): S4 -object of class \code{RLum.Data.Image}} - -\item{frames}{\link{numeric} (\emph{optional}): sets the frames to be set, by default all -frames are plotted. Can be sequence of numbers, as long as the frame number is valid.} - -\item{par.local}{\link{logical} (\emph{with default}): use local graphical -parameters for plotting, e.g. the plot is shown in one column and one row. -If \code{par.local = FALSE} global parameters are inherited.} - -\item{plot.type}{\link{character} (\emph{with default}): plot types. -Supported types are \code{plot.raster}, \code{contour}} - -\item{...}{further arguments and graphical parameters that will be passed -to the specific plot functions. Standard supported parameters are \code{xlim}, \code{ylim}, \code{zlim}, -\code{xlab}, \code{ylab}, \code{main}, \code{legend} (\code{TRUE} or \code{FALSE}), \code{col}, \code{cex}, \code{axes} (\code{TRUE} or \code{FALSE}), -\code{zlim_image} (adjust the z-scale over different images), \code{stretch}} -} -\value{ -Returns a plot -} -\description{ -The function provides very basic plot functionality for image data of an -\linkS4class{RLum.Data.Image} object. For more sophisticated plotting it is recommended -to use other very powerful packages for image processing. - -\strong{Details on the plot functions} - -Supported plot types: - -\strong{\code{plot.type = "plot.raster"}} - -Uses the standard plot function of R \link[graphics:image]{graphics::image}. If wanted, the image -is enhanced, using the argument \code{stretch}. Possible values are \code{hist}, \code{lin}, and -\code{NULL}. The latter does nothing. The argument \code{useRaster = TRUE} is used by default, but -can be set to \code{FALSE}. - -\strong{\code{plot.type = "contour"}} - -This uses the function \link[graphics:contour]{graphics::contour} -} -\note{ -The axes limitations (\code{xlim}, \code{zlim}, \code{zlim}) work directly on the object, -so that regardless of the chosen limits the image parameters can be adjusted for -best visibility. However, in particular for z-scale limitations this is not always -wanted, please use \code{zlim_image} to maintain a particular value range over a -series of images. -} -\section{Function version}{ - 0.2.1 -} - -\examples{ - -##load data -data(ExampleData.RLum.Data.Image, envir = environment()) - -##plot data -plot_RLum.Data.Image(ExampleData.RLum.Data.Image) - -} -\seealso{ -\linkS4class{RLum.Data.Image}, \link{plot}, \link{plot_RLum}, \link[graphics:image]{graphics::image}, \link[graphics:contour]{graphics::contour} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. plot_RLum.Data.Image(): Plot function for an RLum.Data.Image S4 class object. Function version 0.2.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{aplot} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_RLum.Data.Spectrum.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_RLum.Data.Spectrum.Rd deleted file mode 100644 index 26b7cdc16..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_RLum.Data.Spectrum.Rd +++ /dev/null @@ -1,270 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_RLum.Data.Spectrum.R -\name{plot_RLum.Data.Spectrum} -\alias{plot_RLum.Data.Spectrum} -\title{Plot function for an RLum.Data.Spectrum S4 class object} -\usage{ -plot_RLum.Data.Spectrum( - object, - par.local = TRUE, - plot.type = "contour", - optical.wavelength.colours = TRUE, - bg.spectrum = NULL, - bg.channels = NULL, - bin.rows = 1, - bin.cols = 1, - norm = NULL, - rug = TRUE, - limit_counts = NULL, - xaxis.energy = FALSE, - legend.text, - plot = TRUE, - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum.Data.Spectrum} or \link{matrix} (\strong{required}): -S4 object of class \code{RLum.Data.Spectrum} or a \code{matrix} containing count -values of the spectrum.\cr -Please note that in case of a matrix row names and col names are set -automatically if not provided.} - -\item{par.local}{\link{logical} (\emph{with default}): -use local graphical parameters for plotting, e.g. the plot is shown in one column and one row. -If \code{par.local = FALSE} global parameters are inherited.} - -\item{plot.type}{\link{character} (\emph{with default}): plot type, for -3D-plot use \code{persp}, or \code{interactive}, for a 2D-plot \code{image}, \code{contour}, -\code{single} or \code{multiple.lines} (along the time or temperature axis) -or \code{transect} (along the wavelength axis) \cr} - -\item{optical.wavelength.colours}{\link{logical} (\emph{with default}): -use optical wavelength colour palette. Note: For this, the spectrum range is -limited: \code{c(350,750)}. Own colours can be set with the argument \code{col}. If you provide already -binned spectra, the colour assignment is likely to be wrong, since the colour gradients are calculated -using the bin number.} - -\item{bg.spectrum}{\linkS4class{RLum.Data.Spectrum} or \link{matrix} (\emph{optional}): Spectrum -used for the background subtraction. By definition, the background spectrum should have been -measured with the same setting as the signal spectrum. If a spectrum is provided, the -argument \code{bg.channels} works only on the provided background spectrum.} - -\item{bg.channels}{\link{vector} (\emph{optional}): -defines channel for background subtraction If a vector is provided the mean -of the channels is used for subtraction. If a spectrum is provided via \code{bg.spectrum}, this -argument only works on the \code{bg.spectrum}. - -\strong{Note:} Background subtraction is applied prior to channel binning} - -\item{bin.rows}{\link{integer} (\emph{with default}): -allow summing-up wavelength channels (horizontal binning), -e.g. \code{bin.rows = 2} two channels are summed up. -Binning is applied after the background subtraction.} - -\item{bin.cols}{\link{integer} (\emph{with default}): -allow summing-up channel counts (vertical binning) for plotting, -e.g. \code{bin.cols = 2} two channels are summed up. -Binning is applied after the background subtraction.} - -\item{norm}{\link{character} (\emph{optional}): Normalise data to the maximum (\code{norm = "max"}) or -minimum (\code{norm = "min"}) count values. The normalisation is applied after the binning.} - -\item{rug}{\link{logical} (\emph{with default}): -enables or disables colour rug. Currently only implemented for plot -type \code{multiple.lines} and \code{single}} - -\item{limit_counts}{\link{numeric} (\emph{optional}): -value to limit all count values to this value, i.e. all count values above -this threshold will be replaced by this threshold. This is helpful -especially in case of TL-spectra.} - -\item{xaxis.energy}{\link{logical} (\emph{with default}): enables or disables energy instead of -wavelength axis. For the conversion the function \link{convert_Wavelength2Energy} is used. - -\strong{Note:} This option means not only simply redrawing the axis, -instead the spectrum in terms of intensity is recalculated, s. details.} - -\item{legend.text}{\link{character} (\emph{with default}): -possibility to provide own legend text. This argument is only considered for -plot types providing a legend, e.g. \code{plot.type="transect"}} - -\item{plot}{\link{logical} (\emph{with default}): enables/disables plot output. If the plot -output is disabled, the \link{matrix} used for the plotting and the calculated colour values -(as attributes) are returned. This way, the (binned, transformed etc.) output can -be used in other functions and packages, such as plotting with the package \code{'plot3D'}} - -\item{...}{further arguments and graphical parameters that will be passed -to the \code{plot} function.} -} -\value{ -Returns a plot and the transformed \code{matrix} used for plotting with some useful -attributes such as the \code{colour} and \code{pmat} (the transpose matrix from \link[graphics:persp]{graphics::persp}) -} -\description{ -The function provides a standardised plot output for spectrum data of an -\linkS4class{RLum.Data.Spectrum} class object. The purpose of this function is to provide -easy and straight-forward spectra plotting, not provide a full customised access to -all plot parameters. If this is wanted, standard R plot functionality should be used -instead. - -\strong{Matrix structure} \cr (cf. \linkS4class{RLum.Data.Spectrum}) -\itemize{ -\item \code{rows} (x-values): wavelengths/channels (\code{xlim}, \code{xlab}) -\item \code{columns} (y-values): time/temperature (\code{ylim}, \code{ylab}) -\item \code{cells} (z-values): count values (\code{zlim}, \code{zlab}) -} - -\emph{Note: This nomenclature is valid for all plot types of this function!} - -\strong{Nomenclature for value limiting} -\itemize{ -\item \code{xlim}: Limits values along the wavelength axis -\item \code{ylim}: Limits values along the time/temperature axis -\item \code{zlim}: Limits values along the count value axis -} - -\strong{Details on the plot functions} - -Spectrum is visualised as 3D or 2D plot. Both plot types are based on -internal R plot functions. - -\strong{\code{plot.type = "persp"}} - -Arguments that will be passed to \link[graphics:persp]{graphics::persp}: -\itemize{ -\item \code{shade}: default is \code{0.4} -\item \code{phi}: default is \code{15} -\item \code{theta}: default is \code{-30} -\item \code{expand}: default is \code{1} -\item \code{axes}: default is \code{TRUE} -\item \code{box}: default is \code{TRUE}; accepts \code{"alternate"} for a custom plot design -\item \code{ticktype}: default is \code{detailed}, \code{r}: default is \code{10} -} - -\strong{Note:} Further parameters can be adjusted via \code{par}. For example -to set the background transparent and reduce the thickness of the lines use: -\code{par(bg = NA, lwd = 0.7)} previous the function call. - -\strong{\code{plot.type = "single"}} - -Per frame a single curve is returned. Frames are time or temperature -steps. - --\code{frames}: pick the frames to be plotted (depends on the binning!). Check without -this setting before plotting. - -\strong{\code{plot.type = "multiple.lines"}} - -All frames plotted in one frame. - --\code{frames}: pick the frames to be plotted (depends on the binning!). Check without -this setting before plotting. - -'**\code{plot.type = "image"} or `plot.type = "contour" ** - -These plot types use the R functions \link[graphics:image]{graphics::image} or \link[graphics:contour]{graphics::contour}. -The advantage is that many plots can be arranged conveniently using standard -R plot functionality. If \code{plot.type = "image"} a contour is added by default, -which can be disabled using the argument \code{contour = FALSE} to add own contour -lines of choice. - -\strong{\code{plot.type = "transect"}} - -Depending on the selected wavelength/channel range a transect over the -time/temperature (y-axis) will be plotted along the wavelength/channels -(x-axis). If the range contains more than one channel, values (z-values) are -summed up. To select a transect use the \code{xlim} argument, e.g. -\code{xlim = c(300,310)} plot along the summed up count values of channel -300 to 310. - -\strong{Further arguments that will be passed (depending on the plot type)} - -\code{xlab}, \code{ylab}, \code{zlab}, \code{xlim}, \code{ylim}, \code{box}, -\code{zlim}, \code{main}, \code{mtext}, \code{pch}, \code{type} (\code{"single"}, \code{"multiple.lines"}, \code{"interactive"}), -\code{col}, \code{border}, \code{lwd}, \code{bty}, \code{showscale} (\code{"interactive"}, \code{"image"}) -\code{contour}, \code{contour.col} (\code{"image"}) -} -\note{ -Not all additional arguments (\code{...}) will be passed similarly! -} -\section{Function version}{ - 0.6.8 -} - -\examples{ - -##load example data -data(ExampleData.XSYG, envir = environment()) - -##(1)plot simple spectrum (2D) - image -plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type="image", - xlim = c(310,750), - ylim = c(0,300), - bin.rows=10, - bin.cols = 1) - -##(2) plot spectrum (3D) -plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type="persp", - xlim = c(310,750), - ylim = c(0,100), - bin.rows=10, - bin.cols = 1) - -##(3) plot spectrum on energy axis -##please note the background subtraction -plot_RLum.Data.Spectrum(TL.Spectrum, -plot.type="persp", -ylim = c(0,200), -bin.rows=10, -bg.channels = 10, -bin.cols = 1, -xaxis.energy = TRUE) - -##(4) plot multiple lines (2D) - multiple.lines (with ylim) -plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type="multiple.lines", - xlim = c(310,750), - ylim = c(0,100), - bin.rows=10, - bin.cols = 1) - -\dontrun{ - ##(4) interactive plot using the package plotly ("surface") - plot_RLum.Data.Spectrum(TL.Spectrum, plot.type="interactive", - xlim = c(310,750), ylim = c(0,300), bin.rows=10, - bin.cols = 1) - - ##(5) interactive plot using the package plotly ("contour") - plot_RLum.Data.Spectrum(TL.Spectrum, plot.type="interactive", - xlim = c(310,750), ylim = c(0,300), bin.rows=10, - bin.cols = 1, - type = "contour", - showscale = TRUE) - - ##(6) interactive plot using the package plotly ("heatmap") - plot_RLum.Data.Spectrum(TL.Spectrum, plot.type="interactive", - xlim = c(310,750), ylim = c(0,300), bin.rows=10, - bin.cols = 1, - type = "heatmap", - showscale = TRUE) - -} - -} -\seealso{ -\linkS4class{RLum.Data.Spectrum}, \link{convert_Wavelength2Energy}, \link{plot}, \link{plot_RLum}, \link[graphics:persp]{graphics::persp}, \link[plotly:plot_ly]{plotly::plot_ly}, \link[graphics:contour]{graphics::contour}, \link[graphics:image]{graphics::image} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. plot_RLum.Data.Spectrum(): Plot function for an RLum.Data.Spectrum S4 class object. Function version 0.6.8. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{aplot} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_RLum.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_RLum.Rd deleted file mode 100644 index 88f0d3da8..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_RLum.Rd +++ /dev/null @@ -1,76 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_RLum.R -\name{plot_RLum} -\alias{plot_RLum} -\title{General plot function for RLum S4 class objects} -\usage{ -plot_RLum(object, ...) -} -\arguments{ -\item{object}{\linkS4class{RLum} (\strong{required}): -S4 object of class \code{RLum}. Optional a \link{list} containing objects of -class \linkS4class{RLum} can be provided. In this case the function tries to plot -every object in this list according to its \code{RLum} class. Non-RLum objects are -removed.} - -\item{...}{further arguments and graphical parameters that will be passed -to the specific plot functions. The only argument that is supported directly is \code{main} -(setting the plot title). In contrast to the normal behaviour \code{main} can be here provided as -\link{list} and the arguments in the list will dispatched to the plots if the \code{object} -is of type \code{list} as well.} -} -\value{ -Returns a plot. -} -\description{ -Function calls object specific plot functions for RLum S4 class objects. -} -\details{ -The function provides a generalised access point for plotting specific -\linkS4class{RLum} objects.\cr -Depending on the input object, the -corresponding plot function will be selected. Allowed arguments can be -found in the documentations of each plot function. - -\tabular{lll}{ -\strong{object} \tab \tab \strong{corresponding plot function} \cr -\linkS4class{RLum.Data.Curve} \tab : \tab \link{plot_RLum.Data.Curve} \cr -\linkS4class{RLum.Data.Spectrum} \tab : \tab \link{plot_RLum.Data.Spectrum}\cr -\linkS4class{RLum.Data.Image} \tab : \tab \link{plot_RLum.Data.Image}\cr -\linkS4class{RLum.Analysis} \tab : \tab \link{plot_RLum.Analysis}\cr -\linkS4class{RLum.Results} \tab : \tab \link{plot_RLum.Results} -} -} -\note{ -The provided plot output depends on the input object. -} -\section{Function version}{ - 0.4.4 -} - -\examples{ -#load Example data -data(ExampleData.CW_OSL_Curve, envir = environment()) - -#transform data.frame to RLum.Data.Curve object -temp <- as(ExampleData.CW_OSL_Curve, "RLum.Data.Curve") - -#plot RLum object -plot_RLum(temp) - -} -\seealso{ -\link{plot_RLum.Data.Curve}, \linkS4class{RLum.Data.Curve}, \link{plot_RLum.Data.Spectrum}, -\linkS4class{RLum.Data.Spectrum}, \link{plot_RLum.Data.Image}, \linkS4class{RLum.Data.Image}, -\link{plot_RLum.Analysis}, \linkS4class{RLum.Analysis}, \link{plot_RLum.Results}, -\linkS4class{RLum.Results} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. plot_RLum(): General plot function for RLum S4 class objects. Function version 0.4.4. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{dplot} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_RLum.Results.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_RLum.Results.Rd deleted file mode 100644 index a80f51fcd..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_RLum.Results.Rd +++ /dev/null @@ -1,71 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_RLum.Results.R -\name{plot_RLum.Results} -\alias{plot_RLum.Results} -\title{Plot function for an RLum.Results S4 class object} -\usage{ -plot_RLum.Results(object, single = TRUE, ...) -} -\arguments{ -\item{object}{\linkS4class{RLum.Results} (\strong{required}): -S4 object of class \code{RLum.Results}} - -\item{single}{\link{logical} (\emph{with default}): -single plot output (\code{TRUE/FALSE}) to allow for plotting the results in as -few plot windows as possible.} - -\item{...}{further arguments and graphical parameters will be passed to -the \code{plot} function.} -} -\value{ -Returns multiple plots. -} -\description{ -The function provides a standardised plot output for data of an RLum.Results -S4 class object -} -\details{ -The function produces a multiple plot output. A file output is recommended -(e.g., \link{pdf}). -} -\note{ -Not all arguments available for \link{plot} will be passed! -Only plotting of \code{RLum.Results} objects are supported. -} -\section{Function version}{ - 0.2.1 -} - -\examples{ - - -###load data -data(ExampleData.DeValues, envir = environment()) - -# apply the un-logged minimum age model -mam <- calc_MinDose(data = ExampleData.DeValues$CA1, sigmab = 0.2, log = TRUE, plot = FALSE) - -##plot -plot_RLum.Results(mam) - -# estimate the number of grains on an aliquot -grains<- calc_AliquotSize(grain.size = c(100,150), sample.diameter = 1, plot = FALSE, MC.iter = 100) - -##plot -plot_RLum.Results(grains) - - -} -\seealso{ -\link{plot}, \link{plot_RLum} -} -\author{ -Christoph Burow, University of Cologne (Germany) \cr -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Burow, C., Kreutzer, S., 2024. plot_RLum.Results(): Plot function for an RLum.Results S4 class object. Function version 0.2.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{aplot} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_ROI.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_ROI.Rd deleted file mode 100644 index 4d7a4cd18..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_ROI.Rd +++ /dev/null @@ -1,87 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_ROI.R -\name{plot_ROI} -\alias{plot_ROI} -\title{Create Regions of Interest (ROI) Graphic} -\usage{ -plot_ROI( - object, - exclude_ROI = c(1), - dist_thre = -Inf, - dim.CCD = NULL, - bg_image = NULL, - plot = TRUE, - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum.Analysis}, \linkS4class{RLum.Results} or a \link{list} of such objects (\strong{required}): -data input. Please note that to avoid function errors, only input created -by the functions \link{read_RF2R} or \link{extract_ROI} is accepted} - -\item{exclude_ROI}{\link{numeric} (\emph{with default}): option to remove particular ROIs from the -analysis. Those ROIs are plotted but not coloured and not taken into account -in distance analysis. \code{NULL} excludes nothing.} - -\item{dist_thre}{\link{numeric} (\emph{optional}): euclidean distance threshold in pixel -distance. All ROI for which the euclidean distance is smaller are marked. This -helps to identify ROIs that might be affected by signal cross-talk. Note: -the distance is calculated from the centre of an ROI, e.g., the threshold -should include consider the ROIs or grain radius.} - -\item{dim.CCD}{\link{numeric} (\emph{optional}): metric x and y for the recorded (chip) -surface in µm. For instance \code{c(8192,8192)}, if set additional x and y-axes are shown} - -\item{bg_image}{\linkS4class{RLum.Data.Image} (\emph{optional}): background image object -please note that the dimensions are not checked.} - -\item{plot}{\link{logical} (\emph{with default}): enable or disable plot output to use -the function only to extract the ROI data} - -\item{...}{further parameters to manipulate the plot. On top of all arguments of -\link[graphics:plot.default]{graphics::plot.default} the following arguments are supported: \code{lwd.ROI}, \code{lty.ROI}, -\code{col.ROI}, \code{col.pixel}, \code{text.labels}, \code{text.offset}, \code{grid} (\code{TRUE/FALSE}), \code{legend} (\code{TRUE/FALSE}), -\code{legend.text}, \code{legend.pos}} -} -\value{ -An ROI plot and an \linkS4class{RLum.Results} object with a matrix containing -the extracted ROI data and a object produced by \link[stats:dist]{stats::dist} containing -the euclidean distance between the ROIs. -} -\description{ -Create ROI graphic with data extracted from the data imported -via \link{read_RF2R}. This function is used internally by \link{analyse_IRSAR.RF} but -might be of use to work with reduced data from spatially resolved measurements. -The plot dimensions mimic the original image dimensions -} -\section{Function version}{ - 0.2.0 -} - -\examples{ - -## simple example -file <- system.file("extdata", "RF_file.rf", package = "Luminescence") -temp <- read_RF2R(file) -plot_ROI(temp) - -## in combination with extract_ROI() -m <- matrix(runif(100,0,255), ncol = 10, nrow = 10) -roi <- matrix(c(2.,4,2,5,6,7,3,1,1), ncol = 3) -t <- extract_ROI(object = m, roi = roi) -plot_ROI(t, bg_image = m) - -} -\seealso{ -\link{read_RF2R}, \link{analyse_IRSAR.RF} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. plot_ROI(): Create Regions of Interest (ROI) Graphic. Function version 0.2.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{datagen} -\keyword{plot} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_RadialPlot.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_RadialPlot.Rd deleted file mode 100644 index 350c31ab3..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_RadialPlot.Rd +++ /dev/null @@ -1,315 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_RadialPlot.R -\name{plot_RadialPlot} -\alias{plot_RadialPlot} -\title{Function to create a Radial Plot} -\usage{ -plot_RadialPlot( - data, - na.rm = TRUE, - log.z = TRUE, - central.value, - centrality = "mean.weighted", - mtext, - summary, - summary.pos, - legend, - legend.pos, - stats, - rug = FALSE, - plot.ratio, - bar.col, - y.ticks = TRUE, - grid.col, - line, - line.col, - line.label, - output = FALSE, - ... -) -} -\arguments{ -\item{data}{\link{data.frame} or \linkS4class{RLum.Results} object (\strong{required}): -for \code{data.frame}: either two columns: De (\code{data[,1]}) and De error -(\code{data[,2]}), or one: De (\code{values[,1]}). If a single-column data frame -is provided, De error is assumed to be 10^-9 for all measurements. -To plot several data sets in one plot, the data sets must be provided as -\code{list}, e.g. \code{list(data.1, data.2)}.} - -\item{na.rm}{\link{logical} (\emph{with default}): -excludes \code{NA} values from the data set prior to any further operations.} - -\item{log.z}{\link{logical} (\emph{with default}): -Option to display the z-axis in logarithmic scale. Default is \code{TRUE}.} - -\item{central.value}{\link{numeric}: -User-defined central value, primarily used for horizontal centring -of the z-axis.} - -\item{centrality}{\link{character} or \link{numeric} (\emph{with default}): -measure of centrality, used for automatically centring the plot and drawing -the central line. Can either be one out of -\itemize{ -\item \code{"mean"}, -\item \code{"median"}, -\item \code{"mean.weighted"} and -\item \code{"median.weighted"} or a -\item numeric value used for the standardisation. -}} - -\item{mtext}{\link{character}: -additional text below the plot title.} - -\item{summary}{\link{character} (\emph{optional}): -add statistic measures of centrality and dispersion to the plot. -Can be one or more of several keywords. See details for available keywords.} - -\item{summary.pos}{\link{numeric} or \link{character} (\emph{with default}): -optional position coordinates or keyword (e.g. \code{"topright"}) -for the statistical summary. Alternatively, the keyword \code{"sub"} may be -specified to place the summary below the plot header. However, this latter -option is only possible if \code{mtext} is not used.} - -\item{legend}{\link{character} vector (\emph{optional}): -legend content to be added to the plot.} - -\item{legend.pos}{\link{numeric} or \link{character} (with -default): optional position coordinates or keyword (e.g. \code{"topright"}) -for the legend to be plotted.} - -\item{stats}{\link{character}: additional labels of statistically -important values in the plot. One or more out of the following: -\itemize{ -\item \code{"min"}, -\item \code{"max"}, -\item \code{"median"}. -}} - -\item{rug}{\link{logical}: -Option to add a rug to the z-scale, to indicate the location of individual values} - -\item{plot.ratio}{\link{numeric}: -User-defined plot area ratio (i.e. curvature of the z-axis). If omitted, -the default value (\code{4.5/5.5}) is used and modified automatically to optimise -the z-axis curvature. The parameter should be decreased when data points -are plotted outside the z-axis or when the z-axis gets too elliptic.} - -\item{bar.col}{\link{character} or \link{numeric} (\emph{with default}): -colour of the bar showing the 2-sigma range around the central -value. To disable the bar, use \code{"none"}. Default is \code{"grey"}.} - -\item{y.ticks}{\link{logical}: -Option to hide y-axis labels. Useful for data with small scatter.} - -\item{grid.col}{\link{character} or \link{numeric} (\emph{with default}): -colour of the grid lines (originating at \verb{[0,0]} and stretching to -the z-scale). To disable grid lines, use \code{"none"}. Default is \code{"grey"}.} - -\item{line}{\link{numeric}: -numeric values of the additional lines to be added.} - -\item{line.col}{\link{character} or \link{numeric}: -colour of the additional lines.} - -\item{line.label}{\link{character}: -labels for the additional lines.} - -\item{output}{\link{logical}: -Optional output of numerical plot parameters. These can be useful to -reproduce similar plots. Default is \code{FALSE}.} - -\item{...}{Further plot arguments to pass. \code{xlab} must be a vector of -length 2, specifying the upper and lower x-axes labels.} -} -\value{ -Returns a plot object. -} -\description{ -A Galbraith's radial plot is produced on a logarithmic or a linear scale. -} -\details{ -Details and the theoretical background of the radial plot are given in the -cited literature. This function is based on an S script of Rex Galbraith. To -reduce the manual adjustments, the function has been rewritten. Thanks to -Rex Galbraith for useful comments on this function. \cr -Plotting can be disabled by adding the argument \code{plot = "FALSE"}, e.g. -to return only numeric plot output. - -Earlier versions of the Radial Plot in this package had the 2-sigma-bar -drawn onto the z-axis. However, this might have caused misunderstanding in -that the 2-sigma range may also refer to the z-scale, which it does not! -Rather it applies only to the x-y-coordinate system (standardised error vs. -precision). A spread in doses or ages must be drawn as lines originating at -zero precision (x0) and zero standardised estimate (y0). Such a range may be -drawn by adding lines to the radial plot ( \code{line}, \code{line.col}, -\code{line.label}, cf. examples). - -A statistic summary, i.e. a collection of statistic measures of -centrality and dispersion (and further measures) can be added by specifying -one or more of the following keywords: -\itemize{ -\item \code{"n"} (number of samples), -\item \code{"mean"} (mean De value), -\item \code{"mean.weighted"} (error-weighted mean), -\item \code{"median"} (median of the De values), -\item \code{"sdrel"} (relative standard deviation in percent), -\item \code{"sdrel.weighted"} (error-weighted relative standard deviation in percent), -\item \code{"sdabs"} (absolute standard deviation), -\item \code{"sdabs.weighted"} (error-weighted absolute standard deviation), -\item \code{"serel"} (relative standard error), -\item \code{"serel.weighted"} (error-weighted relative standard error), -\item \code{"seabs"} (absolute standard error), -\item \code{"seabs.weighted"} (error-weighted absolute standard error), -\item \code{"in.2s"} (percent of samples in 2-sigma range), -\item \code{"kurtosis"} (kurtosis) and -\item \code{"skewness"} (skewness). -} -} -\section{Function version}{ - 0.5.9 -} - -\examples{ - -## load example data -data(ExampleData.DeValues, envir = environment()) -ExampleData.DeValues <- Second2Gray( - ExampleData.DeValues$BT998, c(0.0438,0.0019)) - -## plot the example data straightforward -plot_RadialPlot(data = ExampleData.DeValues) - -## now with linear z-scale -plot_RadialPlot( - data = ExampleData.DeValues, - log.z = FALSE) - -## now with output of the plot parameters -plot1 <- plot_RadialPlot( - data = ExampleData.DeValues, - log.z = FALSE, - output = TRUE) -plot1 -plot1$zlim - -## now with adjusted z-scale limits -plot_RadialPlot( - data = ExampleData.DeValues, - log.z = FALSE, - xlim = c(0, 5), - zlim = c(100, 200)) - -## now the two plots with serious but seasonally changing fun -#plot_RadialPlot(data = data.3, fun = TRUE) - -## now with user-defined central value, in log-scale again -plot_RadialPlot( - data = ExampleData.DeValues, - central.value = 150) - -## now with a rug, indicating individual De values at the z-scale -plot_RadialPlot( - data = ExampleData.DeValues, - rug = TRUE) - -## now with legend, colour, different points and smaller scale -plot_RadialPlot( - data = ExampleData.DeValues, - legend.text = "Sample 1", - col = "tomato4", - bar.col = "peachpuff", - pch = "R", - cex = 0.8) - -## now without 2-sigma bar, y-axis, grid lines and central value line -plot_RadialPlot( - data = ExampleData.DeValues, - bar.col = "none", - grid.col = "none", - y.ticks = FALSE, - lwd = 0) - -## now with user-defined axes labels -plot_RadialPlot( - data = ExampleData.DeValues, - xlab = c("Data error (\%)", "Data precision"), - ylab = "Scatter", - zlab = "Equivalent dose [Gy]") - -## now with minimum, maximum and median value indicated -plot_RadialPlot( - data = ExampleData.DeValues, - central.value = 150, - stats = c("min", "max", "median")) - -## now with a brief statistical summary -plot_RadialPlot( - data = ExampleData.DeValues, - summary = c("n", "in.2s")) - -## now with another statistical summary as subheader -plot_RadialPlot( - data = ExampleData.DeValues, - summary = c("mean.weighted", "median"), - summary.pos = "sub") - -## now the data set is split into sub-groups, one is manipulated -data.1 <- ExampleData.DeValues[1:15,] -data.2 <- ExampleData.DeValues[16:25,] * 1.3 - -## now a common dataset is created from the two subgroups -data.3 <- list(data.1, data.2) - -## now the two data sets are plotted in one plot -plot_RadialPlot(data = data.3) - -## now with some graphical modification -plot_RadialPlot( - data = data.3, - col = c("darkblue", "darkgreen"), - bar.col = c("lightblue", "lightgreen"), - pch = c(2, 6), - summary = c("n", "in.2s"), - summary.pos = "sub", - legend = c("Sample 1", "Sample 2")) - -} - -\section{How to cite}{ -Dietze, M., Kreutzer, S., 2024. plot_RadialPlot(): Function to create a Radial Plot. Function version 0.5.9. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Galbraith, R.F., 1988. Graphical Display of Estimates Having -Differing Standard Errors. Technometrics, 30 (3), 271-281. - -Galbraith, R.F., 1990. The radial plot: Graphical assessment of spread in -ages. International Journal of Radiation Applications and Instrumentation. -Part D. Nuclear Tracks and Radiation Measurements, 17 (3), 207-214. - -Galbraith, R. & Green, P., 1990. Estimating the component ages in a finite -mixture. International Journal of Radiation Applications and -Instrumentation. Part D. Nuclear Tracks and Radiation Measurements, 17 (3) -197-206. - -Galbraith, R.F. & Laslett, G.M., 1993. Statistical models for mixed fission -track ages. Nuclear Tracks And Radiation Measurements, 21 (4), 459-470. - -Galbraith, R.F., 1994. Some Applications of Radial Plots. Journal of the -American Statistical Association, 89 (428), 1232-1242. - -Galbraith, R.F., 2010. On plotting OSL equivalent doses. Ancient TL, 28 (1), -1-10. - -Galbraith, R.F. & Roberts, R.G., 2012. Statistical aspects of equivalent -dose and error calculation and display in OSL dating: An overview and some -recommendations. Quaternary Geochronology, 11, 1-27. -} -\seealso{ -\link{plot}, \link{plot_KDE}, \link{plot_Histogram}, \link{plot_AbanicoPlot} -} -\author{ -Michael Dietze, GFZ Potsdam (Germany)\cr -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -Based on a rewritten S script of Rex Galbraith, 2010 -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_Risoe.BINfileData.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_Risoe.BINfileData.Rd deleted file mode 100644 index b92261bfc..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_Risoe.BINfileData.Rd +++ /dev/null @@ -1,133 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_Risoe.BINfileData.R -\name{plot_Risoe.BINfileData} -\alias{plot_Risoe.BINfileData} -\title{Plot single luminescence curves from a BIN file object} -\usage{ -plot_Risoe.BINfileData( - BINfileData, - position, - run, - set, - sorter = "POSITION", - ltype = c("IRSL", "OSL", "TL", "RIR", "RBR", "RL"), - curve.transformation, - dose_rate, - temp.lab, - cex.global = 1, - ... -) -} -\arguments{ -\item{BINfileData}{\linkS4class{Risoe.BINfileData} (\strong{required}): -requires an S4 object returned by the \link{read_BIN2R} function.} - -\item{position}{\link{vector} (\emph{optional}): -option to limit the plotted curves by position -(e.g. \code{position = 1}, \code{position = c(1,3,5)}).} - -\item{run}{\link{vector} (\emph{optional}): -option to limit the plotted curves by run -(e.g., \code{run = 1}, \code{run = c(1,3,5)}).} - -\item{set}{\link{vector} (\emph{optional}): -option to limit the plotted curves by set -(e.g., \code{set = 1}, \code{set = c(1,3,5)}).} - -\item{sorter}{\link{character} (\emph{with default}): -the plot output can be ordered by "POSITION","SET" or "RUN". -POSITION, SET and RUN are options defined in the Risoe Sequence Editor.} - -\item{ltype}{\link{character} (\emph{with default}): -option to limit the plotted curves by the type of luminescence stimulation. -Allowed values: \code{"IRSL"}, \code{"OSL"},\code{"TL"}, \code{"RIR"}, \code{"RBR"} -(corresponds to LM-OSL), \code{"RL"}. All type of curves are plotted by -default.} - -\item{curve.transformation}{\link{character} (\emph{optional}): -allows transforming CW-OSL and CW-IRSL curves to pseudo-LM curves via -transformation functions. Allowed values are: \code{CW2pLM}, \code{CW2pLMi}, \code{CW2pHMi} and -\code{CW2pPMi}. See details.} - -\item{dose_rate}{\link{numeric} (\emph{optional}): -dose rate of the irradiation source at the measurement date. -If set, the given irradiation dose will be shown in Gy. See details.} - -\item{temp.lab}{\link{character} (\emph{optional}): -option to allow for different temperature units. If no value is set deg. C is chosen.} - -\item{cex.global}{\link{numeric} (\emph{with default}): -global scaling factor.} - -\item{...}{further undocumented plot arguments.} -} -\value{ -Returns a plot. -} -\description{ -Plots single luminescence curves from an object returned by the -\link{read_BIN2R} function. -} -\details{ -\strong{Nomenclature} - -See \linkS4class{Risoe.BINfileData} - -\strong{curve.transformation} - -This argument allows transforming continuous wave (CW) curves to pseudo -(linear) modulated curves. For the transformation, the functions of the -package are used. Currently, it is not possible to pass further arguments -to the transformation functions. The argument works only for \code{ltype} -\code{OSL} and \code{IRSL}. - -\strong{Irradiation time} - -Plotting the irradiation time (s) or the given dose (Gy) requires that the -variable \code{IRR_TIME} has been set within the BIN-file. This is normally -done by using the 'Run Info' option within the Sequence Editor or by editing -in R. -} -\note{ -The function has been successfully tested for the Sequence Editor file -output version 3 and 4. -} -\section{Function version}{ - 0.4.1 -} - -\examples{ - -##load data -data(ExampleData.BINfileData, envir = environment()) - -##plot all curves from the first position to the desktop -#pdf(file = "~/Desktop/CurveOutput.pdf", paper = "a4", height = 11, onefile = TRUE) - -##example - load from *.bin file -#BINfile<- file.choose() -#BINfileData<-read_BIN2R(BINfile) - -#par(mfrow = c(4,3), oma = c(0.5,1,0.5,1)) -#plot_Risoe.BINfileData(CWOSL.SAR.Data,position = 1) -#mtext(side = 4, BINfile, outer = TRUE, col = "blue", cex = .7) -#dev.off() - -} - -\section{How to cite}{ -Kreutzer, S., Dietze, M., 2024. plot_Risoe.BINfileData(): Plot single luminescence curves from a BIN file object. Function version 0.4.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Duller, G., 2007. Analyst. pp. 1-45. -} -\seealso{ -\linkS4class{Risoe.BINfileData},\link{read_BIN2R}, \link{CW2pLM}, \link{CW2pLMi}, -\link{CW2pPMi}, \link{CW2pHMi} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -Michael Dietze, GFZ Potsdam (Germany) -, RLum Developer Team} -\keyword{dplot} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_ViolinPlot.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_ViolinPlot.Rd deleted file mode 100644 index 5e869f2f0..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/plot_ViolinPlot.Rd +++ /dev/null @@ -1,105 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_ViolinPlot.R -\name{plot_ViolinPlot} -\alias{plot_ViolinPlot} -\title{Create a violin plot} -\usage{ -plot_ViolinPlot( - data, - boxplot = TRUE, - rug = TRUE, - summary = NULL, - summary.pos = "sub", - na.rm = TRUE, - ... -) -} -\arguments{ -\item{data}{\link{numeric} or \linkS4class{RLum.Results} (\strong{required}): -input data for plotting. Alternatively a \link{data.frame} or a \link{matrix} can -be provided, but only the first column will be considered by the -function} - -\item{boxplot}{\link{logical} (\emph{with default}): -enable or disable boxplot} - -\item{rug}{\link{logical} (\emph{with default}): -enable or disable rug} - -\item{summary}{\link{character} (\emph{optional}): -add statistic measures of centrality and dispersion to the plot. -Can be one or more of several keywords. See details for available keywords.} - -\item{summary.pos}{\link{numeric} or \link{character} (\emph{with default}): -optional position keywords (cf. \link{legend}) for the statistical summary. -Alternatively, the keyword \code{"sub"} may be specified to place the summary -below the plot header. However, this latter option in only possible if -\code{mtext} is not used.} - -\item{na.rm}{\link{logical} (\emph{with default}): -exclude NA values from the data set prior to any further operations.} - -\item{...}{further arguments and graphical parameters passed to -\link{plot.default}, \link[stats:density]{stats::density} and \link{boxplot}. See details for further information} -} -\description{ -Draws a kernel density plot in combination with a boxplot in its middle. The shape of the violin -is constructed using a mirrored density curve. This plot is especially designed for cases -where the individual errors are zero or too small to be visualised. The idea for this plot is -based on the the 'volcano plot' in the ggplot2 package by Hadley Wickham and Winston Chang. -The general idea for the violin plot seems to have been introduced by -Hintze and Nelson (1998). - -The function is passing several arguments to the functions \link{plot}, -\link[stats:density]{stats::density}, \link[graphics:boxplot]{graphics::boxplot}: - -Supported arguments are: -\code{xlim}, \code{main}, \code{xlab}, \code{ylab}, \code{col.violin}, \code{col.boxplot}, \code{mtext}, \code{cex}, \code{mtext} - -\strong{\verb{Valid summary keywords}} - -\code{'n'}, \code{'mean'}, \code{'median'}, \code{'sd.abs'}, \code{'sd.rel'}, \code{'se.abs'}, \code{'se.rel'}. -\code{'skewness'}, \code{'kurtosis'} -} -\note{ -Although the code for this function was developed independently and just the idea for the plot -was based on the 'ggplot2' package plot type 'volcano', it should be mentioned that, beyond this, -two other R packages exist providing a possibility to produces this kind of plot, namely: -\code{'vioplot'} and \code{'violinmplot'} (see references for details). -} -\section{Function version}{ - 0.1.4 -} - -\examples{ - -## read example data set -data(ExampleData.DeValues, envir = environment()) -ExampleData.DeValues <- Second2Gray(ExampleData.DeValues$BT998, c(0.0438,0.0019)) - -## create plot straightforward -plot_ViolinPlot(data = ExampleData.DeValues) - -} - -\section{How to cite}{ -Kreutzer, S., 2024. plot_ViolinPlot(): Create a violin plot. Function version 0.1.4. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Daniel Adler (2005). vioplot: A violin plot is a combination of a box plot and a kernel density plot. -R package version 0.2 http://CRAN.R-project.org/package=violplot - -Hintze, J.L., Nelson, R.D., 1998. A Box Plot-Density Trace Synergism. The American Statistician 52, 181-184. - -Raphael W. Majeed (2012). violinmplot: Combination of violin plot with mean and standard deviation. -R package version 0.2.1. http://CRAN.R-project.org/package=violinmplot - -Wickham. H (2009). ggplot2: elegant graphics for data analysis. Springer New York. -} -\seealso{ -\link[stats:density]{stats::density}, \link{plot}, \link{boxplot}, \link{rug}, \link{calc_Statistics} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_BIN2R.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_BIN2R.Rd deleted file mode 100644 index 4b0e298a5..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_BIN2R.Rd +++ /dev/null @@ -1,149 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/read_BIN2R.R -\name{read_BIN2R} -\alias{read_BIN2R} -\title{Import Risø BIN/BINX-files into R} -\usage{ -read_BIN2R( - file, - show.raw.values = FALSE, - position = NULL, - n.records = NULL, - zero_data.rm = TRUE, - duplicated.rm = FALSE, - fastForward = FALSE, - show.record.number = FALSE, - txtProgressBar = TRUE, - forced.VersionNumber = NULL, - ignore.RECTYPE = FALSE, - pattern = NULL, - verbose = TRUE, - ... -) -} -\arguments{ -\item{file}{\link{character} or \link{list} (\strong{required}): path and file name of the -BIN/BINX file (URLs are supported). If input is a \code{list} it should comprise -only \code{character}s representing each valid path and BIN/BINX-file names. -Alternatively the input character can be just a directory (path), in this case the -the function tries to detect and import all BIN/BINX files found in the directory.} - -\item{show.raw.values}{\link{logical} (\emph{with default}): -shows raw values from BIN-file for \code{LTYPE}, \code{DTYPE} and \code{LIGHTSOURCE} without -translation in characters. Can be provided as \code{list} if \code{file} is a \code{list}.} - -\item{position}{\link{numeric} (\emph{optional}): -imports only the selected position. Note: the import performance will not -benefit by any selection made here. -Can be provided as \code{list} if \code{file} is a \code{list}.} - -\item{n.records}{\link{numeric} (\emph{optional}): limits the number of imported records -to the provided record id (e.g., \code{n.records = 1:10} imports the first ten records, -while \code{n.records = 3} imports only record number 3. Can be used in combination with -\code{show.record.number} for debugging purposes, e.g. corrupt BIN-files. -Can be provided as \code{list} if \code{file} is a \code{list}.} - -\item{zero_data.rm}{\link{logical} (\emph{with default}): -remove erroneous data with no count values. As such data are usually not -needed for the subsequent data analysis they will be removed by default. -Can be provided as \code{list} if \code{file} is a \code{list}.} - -\item{duplicated.rm}{\link{logical} (\emph{with default}): -remove duplicated entries if \code{TRUE}. This may happen due to an erroneous -produced BIN/BINX-file. This option compares only predecessor and successor. -Can be provided as \code{list} if \code{file} is a \code{list}.} - -\item{fastForward}{\link{logical} (\emph{with default}): -if \code{TRUE} for a more efficient data processing only a list of \code{RLum.Analysis} -objects is returned instead of a \linkS4class{Risoe.BINfileData} object. -Can be provided as \code{list} if \code{file} is a \code{list}.} - -\item{show.record.number}{\link{logical} (\emph{with default}): -shows record number of the imported record, for debugging usage only. -Can be provided as \code{list} if \code{file} is a \code{list}.} - -\item{txtProgressBar}{\link{logical} (\emph{with default}): -enables or disables \link{txtProgressBar}.} - -\item{forced.VersionNumber}{\link{integer} (\emph{optional}): -allows to cheat the version number check in the function by own values for -cases where the BIN-file version is not supported. -Can be provided as \code{list} if \code{file} is a \code{list}. - -\strong{Note:} The usage is at own risk, only supported BIN-file versions have been tested.} - -\item{ignore.RECTYPE}{\link{logical} or \link{numeric} (\emph{with default}): -this argument allows to ignore values in the byte 'RECTYPE' (BIN-file version 08), -in case there are not documented or faulty set. In this case the corrupted records are skipped. -If the setting is \link{numeric} (e.g., \code{ignore.RECTYPE = 128}), records of those type are ignored -for import.} - -\item{pattern}{\link{character} (\emph{optional}): -argument that is used if only a path is provided. The argument will than be -passed to the function \link{list.files} used internally to construct a \code{list} -of wanted files} - -\item{verbose}{\link{logical} (\emph{with default}): -enables or disables verbose mode} - -\item{...}{further arguments that will be passed to the function -\link{Risoe.BINfileData2RLum.Analysis}. Please note that any matching argument -automatically sets \code{fastForward = TRUE}} -} -\value{ -Returns an S4 \linkS4class{Risoe.BINfileData} object containing two -slots: - -\item{METADATA}{A \link{data.frame} containing all variables stored in the BIN-file.} -\item{DATA}{A \link{list} containing a numeric \link{vector} of the measured data. -The ID corresponds to the record ID in METADATA.} - -If \code{fastForward = TRUE} a list of \linkS4class{RLum.Analysis} object is returned. The -internal coercing is done using the function \link{Risoe.BINfileData2RLum.Analysis} -} -\description{ -Import a \verb{*.bin} or a \verb{*.binx} file produced by a Risø DA15 and DA20 TL/OSL -reader into R. -} -\details{ -The binary data file is parsed byte by byte following the data structure -published in the Appendices of the Analyst manual p. 42. - -For the general BIN/BINX-file structure, the reader is referred to the -Risø website: \url{https://www.fysik.dtu.dk} -} -\note{ -The function works for BIN/BINX-format versions 03, 04, 05, 06, 07 and 08. The -version number depends on the used Sequence Editor. -} -\section{Function version}{ - 0.17.3 -} - -\examples{ - -file <- system.file("extdata/BINfile_V8.binx", package = "Luminescence") -temp <- read_BIN2R(file) -temp - -} - -\section{How to cite}{ -Kreutzer, S., Fuchs, M.C., 2024. read_BIN2R(): Import Risø BIN/BINX-files into R. Function version 0.17.3. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -DTU Nutech, 2016. The Sequence Editor, Users Manual, February, 2016. -\url{https://www.fysik.dtu.dk} -} -\seealso{ -\link{write_R2BIN}, \linkS4class{Risoe.BINfileData}, -\link[base:readBin]{base::readBin}, \link{merge_Risoe.BINfileData}, \linkS4class{RLum.Analysis} -\link[utils:txtProgressBar]{utils::txtProgressBar}, \link{list.files} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -Margret C. Fuchs, HZDR Freiberg, (Germany) \cr -based on information provided by Torben Lapp and Karsten Bracht Nielsen (Risø DTU, Denmark) -, RLum Developer Team} -\keyword{IO} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_Daybreak2R.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_Daybreak2R.Rd deleted file mode 100644 index 3dd2fa10f..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_Daybreak2R.Rd +++ /dev/null @@ -1,67 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/read_Daybreak2R.R -\name{read_Daybreak2R} -\alias{read_Daybreak2R} -\title{Import measurement data produced by a Daybreak TL/OSL reader into R} -\usage{ -read_Daybreak2R(file, raw = FALSE, verbose = TRUE, txtProgressBar = TRUE, ...) -} -\arguments{ -\item{file}{\link{character} or \link{list} (\strong{required}): -path and file name of the file to be imported. Alternatively a list of file -names can be provided or just the path a folder containing measurement data. -Please note that the specific, common, file extension (txt) is likely -leading to function failures during import when just a path is provided.} - -\item{raw}{\link{logical} (\emph{with default}): -if the input is a DAT-file (binary) a \link[data.table:data.table]{data.table::data.table} instead of -the \linkS4class{RLum.Analysis} object can be returned for debugging purposes.} - -\item{verbose}{\link{logical} (\emph{with default}): -enables or disables terminal feedback} - -\item{txtProgressBar}{\link{logical} (\emph{with default}): -enables or disables \link{txtProgressBar}.} - -\item{...}{not in use, for compatibility reasons only} -} -\value{ -A list of \linkS4class{RLum.Analysis} objects (each per position) is provided. -} -\description{ -Import a TXT-file (ASCII file) or a DAT-file (binary file) produced by a -Daybreak reader into R. The import of the DAT-files is limited to the file -format described for the software TLAPLLIC v.3.2 used for a Daybreak, model 1100. -} -\note{ -\strong{\verb{[BETA VERSION]}} -This function still needs to be tested properly. In particular -the function has underwent only very rough rests using a few files. -} -\section{Function version}{ - 0.3.2 -} - -\examples{ - -\dontrun{ -file <- system.file("extdata/Daybreak_TestFile.txt", package = "Luminescence") -temp <- read_Daybreak2R(file) -} - -} -\seealso{ -\linkS4class{RLum.Analysis}, \linkS4class{RLum.Data.Curve}, \link[data.table:data.table]{data.table::data.table} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -Antoine Zink, C2RMF, Palais du Louvre, Paris (France) - -The ASCII-file import is based on a suggestion by Willian Amidon and Andrew Louis Gorin -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., Zink, A., 2024. read_Daybreak2R(): Import measurement data produced by a Daybreak TL/OSL reader into R. Function version 0.3.2. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{IO} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_HeliosOSL2R.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_HeliosOSL2R.Rd deleted file mode 100644 index ac88ae0dc..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_HeliosOSL2R.Rd +++ /dev/null @@ -1,47 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/read_HeliosOSL2R.R -\name{read_HeliosOSL2R} -\alias{read_HeliosOSL2R} -\title{Import Luminescence Data from Helios Luminescence Reader} -\usage{ -read_HeliosOSL2R(file, verbose = TRUE, ...) -} -\arguments{ -\item{file}{\link{character} (\strong{required}): path to file to be imported. Can be a \link{list} -for further processing} - -\item{verbose}{\link{logical}: enable/disable terminal feedback} - -\item{...}{not in use, for compatibility reasons only} -} -\value{ -\linkS4class{RLum.Analysis} object -} -\description{ -Straightforward import of files with the ending \code{.osl} produced -by the zero rad Helios luminescence reader and conversion to \linkS4class{RLum.Analysis} objects. -} -\note{ -Thanks to Krzysztof Maternicki for providing example data. -} -\section{Function version}{ - 0.1.0 -} - -\examples{ -file <- system.file("extdata/HeliosOSL_Example.osl", package = "Luminescence") -read_HeliosOSL2R(file) - -} -\seealso{ -\linkS4class{RLum.Data.Curve}, \linkS4class{RLum.Analysis} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. read_HeliosOSL2R(): Import Luminescence Data from Helios Luminescence Reader. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{IO} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_PSL2R.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_PSL2R.Rd deleted file mode 100644 index 286209ba6..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_PSL2R.Rd +++ /dev/null @@ -1,86 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/read_PSL2R.R -\name{read_PSL2R} -\alias{read_PSL2R} -\title{Import PSL files to R} -\usage{ -read_PSL2R( - file, - drop_bg = FALSE, - as_decay_curve = TRUE, - smooth = FALSE, - merge = FALSE, - ... -) -} -\arguments{ -\item{file}{\link{character} (\strong{required}): -path and file name of the PSL file. If input is a \code{vector} it should comprise -only \code{character}s representing valid paths and PSL file names. -Alternatively the input character can be just a directory (path). In this case the -the function tries to detect and import all PSL files found in the directory.} - -\item{drop_bg}{\link{logical} (\emph{with default}): -\code{TRUE} to automatically remove all non-OSL/IRSL curves.} - -\item{as_decay_curve}{\link{logical} (\emph{with default}): -Portable OSL Reader curves are often given as cumulative light sum curves. -Use \code{TRUE} (default) to convert the curves to the more usual decay form.} - -\item{smooth}{\link{logical} (\emph{with default}): -\code{TRUE} to apply Tukey's Running Median Smoothing for OSL and IRSL decay curves. -Smoothing is encouraged if you see random signal drops within the decay curves related -to hardware errors.} - -\item{merge}{\link{logical} (\emph{with default}): -\code{TRUE} to merge all \code{RLum.Analysis} objects. Only applicable if multiple -files are imported.} - -\item{...}{currently not used.} -} -\value{ -Returns an S4 \linkS4class{RLum.Analysis} object containing -\linkS4class{RLum.Data.Curve} objects for each curve. -} -\description{ -Imports PSL files produced by a SUERC portable OSL reader into R. -} -\details{ -This function provides an import routine for the SUERC portable OSL Reader PSL -format (measurement data and sequence). PSL files are just plain text and can be -viewed with any text editor. Due to the formatting of PSL files this import -function relies heavily on regular expression to find and extract all relevant information. See \strong{note}. -} -\note{ -Because this function relies heavily on regular expressions to parse -PSL files it is currently only in beta status. If the routine fails to import -a specific PSL file please report to \verb{} so the -function can be updated. -} -\section{Function version}{ - 0.1.1 -} - -\examples{ - -# (1) Import PSL file to R - -file <- system.file("extdata", "DorNie_0016.psl", package = "Luminescence") -psl <- read_PSL2R(file, drop_bg = FALSE, as_decay_curve = TRUE, smooth = TRUE, merge = FALSE) -print(str(psl, max.level = 3)) -plot(psl, combine = TRUE) - -} -\seealso{ -\linkS4class{RLum.Analysis}, \linkS4class{RLum.Data.Curve}, \linkS4class{RLum.Data.Curve} -} -\author{ -Christoph Burow, University of Cologne (Germany), -Sebastian Kreutzer, Institut of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Burow, C., Kreutzer, S., 2024. read_PSL2R(): Import PSL files to R. Function version 0.1.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{IO} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_RF2R.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_RF2R.Rd deleted file mode 100644 index ae5f2f88b..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_RF2R.Rd +++ /dev/null @@ -1,54 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/read_RF2R.R -\name{read_RF2R} -\alias{read_RF2R} -\title{Import RF-files to R} -\usage{ -read_RF2R(file, ...) -} -\arguments{ -\item{file}{\link{character} (\strong{required}): path and file name of the RF file. Alternatively a list of file -names can be provided.} - -\item{...}{not used, only for compatible reasons} -} -\value{ -Returns an S4 \linkS4class{RLum.Analysis} object containing -\linkS4class{RLum.Data.Curve} objects for each curve. -} -\description{ -Import files produced by the IR-RF 'ImageJ' macro (\code{SR-RF.ijm}; Mittelstraß and Kreutzer, 2021) into R and create a list of \linkS4class{RLum.Analysis} -objects -} -\details{ -The results of spatially resolved IR-RF data are summarised in so-called RF-files ((Mittelstraß and Kreutzer, 2021). -This functions provides an easy import to process the data seamlessly with the R package 'Luminescence'. -The output of the function can be passed to the function \link{analyse_IRSAR.RF} -} -\section{Function version}{ - 0.1.1 -} - -\examples{ - -##Import -file <- system.file("extdata", "RF_file.rf", package = "Luminescence") -temp <- read_RF2R(file) - -} - -\section{How to cite}{ -Kreutzer, S., 2024. read_RF2R(): Import RF-files to R. Function version 0.1.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Mittelstraß, D., Kreutzer, S., 2021. Spatially resolved infrared radiofluorescence: -single-grain K-feldspar dating using CCD imaging. Geochronology 3, 299–319. \doi{10.5194/gchron-3-299-2021} -} -\seealso{ -\linkS4class{RLum.Analysis}, \linkS4class{RLum.Data.Curve}, \link{analyse_IRSAR.RF} -} -\author{ -Sebastian Kreutzer, Geography & Earth Science, Aberystwyth University (United Kingdom) -, RLum Developer Team} -\keyword{IO} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_SPE2R.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_SPE2R.Rd deleted file mode 100644 index 78f537269..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_SPE2R.Rd +++ /dev/null @@ -1,129 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/read_SPE2R.R -\name{read_SPE2R} -\alias{read_SPE2R} -\title{Import Princeton Instruments (TM) SPE-file into R} -\usage{ -read_SPE2R( - file, - output.object = "RLum.Data.Image", - frame.range, - txtProgressBar = TRUE, - verbose = TRUE, - ... -) -} -\arguments{ -\item{file}{\link{character} (\strong{required}): -SPE-file name (including path), e.g. -\itemize{ -\item \verb{[WIN]}: \code{read_SPE2R("C:/Desktop/test.spe")} -\item \verb{[MAC/LINUX]}: \code{read_SPE2R("/User/test/Desktop/test.spe")}. -Additionally, it can be a URL starting with http:// or https://. -}} - -\item{output.object}{\link{character} (\emph{with default}): -set \code{RLum} output object. Allowed types are \code{"RLum.Data.Spectrum"}, -\code{"RLum.Data.Image"} or \code{"matrix"}} - -\item{frame.range}{\link{vector} (\emph{optional}): -limit frame range, e.g. select first 100 frames by \code{frame.range = c(1,100)}} - -\item{txtProgressBar}{\link{logical} (\emph{with default}): -enables or disables \link{txtProgressBar}.} - -\item{verbose}{\link{logical} (\emph{with default}): enables or disables verbose mode} - -\item{...}{not used, for compatibility reasons only} -} -\value{ -Depending on the chosen option the functions returns three different -type of objects: - -\code{output.object} - -\code{RLum.Data.Spectrum} - -An object of type \linkS4class{RLum.Data.Spectrum} is returned. Row -sums are used to integrate all counts over one channel. - -\code{RLum.Data.Image} - -An object of type \linkS4class{RLum.Data.Image} is returned. Due to -performance reasons the import is aborted for files containing more than 100 -frames. This limitation can be overwritten manually by using the argument -\code{frame.range}. - -\code{matrix} - -Returns a matrix of the form: Rows = Channels, columns = Frames. For the -transformation the function \link{get_RLum} is used, -meaning that the same results can be obtained by using the function -\link{get_RLum} on an \code{RLum.Data.Spectrum} or \code{RLum.Data.Image} object. -} -\description{ -Function imports Princeton Instruments (TM) SPE-files into R environment and -provides \linkS4class{RLum.Data.Image} objects as output. -} -\details{ -Function provides an R only import routine for the Princeton Instruments -SPE format. Import functionality is based on the file format description provided by -Princeton Instruments and a MatLab script written by Carl Hall (see -references). -} -\note{ -\strong{The function does not test whether the input data are spectra or pictures for spatial resolved analysis!} - -The function has been successfully tested for SPE format versions 2.x. - -\emph{Currently not all information provided by the SPE format are supported.} -} -\section{Function version}{ - 0.1.5 -} - -\examples{ - -## to run examples uncomment lines and run the code - -##(1) Import data as RLum.Data.Spectrum object -#file <- file.choose() -#temp <- read_SPE2R(file) -#temp - -##(2) Import data as RLum.Data.Image object -#file <- file.choose() -#temp <- read_SPE2R(file, output.object = "RLum.Data.Image") -#temp - -##(3) Import data as matrix object -#file <- file.choose() -#temp <- read_SPE2R(file, output.object = "matrix") -#temp - -##(4) Export raw data to csv, if temp is a RLum.Data.Spectrum object -# write.table(x = get_RLum(temp), -# file = "[your path and filename]", -# sep = ";", row.names = FALSE) - - -} - -\section{How to cite}{ -Kreutzer, S., 2024. read_SPE2R(): Import Princeton Instruments (TM) SPE-file into R. Function version 0.1.5. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Princeton Instruments, 2014. Princeton Instruments SPE 3.0 File -Format Specification, Version 1.A (for document URL please use an internet search machine) - -Hall, C., 2012: readSPE.m. -\verb{https://www.mathworks.com/matlabcentral/fileexchange/35940-readspe} -} -\seealso{ -\link{readBin}, \linkS4class{RLum.Data.Spectrum} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{IO} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_TIFF2R.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_TIFF2R.Rd deleted file mode 100644 index bfbc6aded..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_TIFF2R.Rd +++ /dev/null @@ -1,45 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/read_TIFF2R.R -\name{read_TIFF2R} -\alias{read_TIFF2R} -\title{Import TIFF Image Data into R} -\usage{ -read_TIFF2R(file, ...) -} -\arguments{ -\item{file}{\link{character} (\strong{required}): file name} - -\item{...}{not in use, for compatibility reasons only} -} -\value{ -\linkS4class{RLum.Data.Image} object -} -\description{ -Simple wrapper around \link[tiff:readTIFF]{tiff::readTIFF} to import TIFF images -and TIFF image stacks to be further processed within the package \code{'Luminescence'} -} -\section{Function version}{ - 0.1.2 -} - -\examples{ - -\dontrun{ -file <- file.choose() -image <- read_TIFF2R(file) - -} - -} -\seealso{ -\link[tiff:readTIFF]{tiff::readTIFF}, \linkS4class{RLum.Data.Image} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. read_TIFF2R(): Import TIFF Image Data into R. Function version 0.1.2. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{IO} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_XSYG2R.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_XSYG2R.Rd deleted file mode 100644 index 5e3d3ab3f..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/read_XSYG2R.Rd +++ /dev/null @@ -1,196 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/read_XSYG2R.R -\name{read_XSYG2R} -\alias{read_XSYG2R} -\title{Import XSYG files to R} -\usage{ -read_XSYG2R( - file, - recalculate.TL.curves = TRUE, - fastForward = FALSE, - import = TRUE, - pattern = ".xsyg", - verbose = TRUE, - txtProgressBar = TRUE -) -} -\arguments{ -\item{file}{\link{character} or \link{list} (\strong{required}): -path and file name of the XSYG file. If input is a \code{list} it should comprise -only \code{character}s representing each valid path and XSYG-file names. -Alternatively the input character can be just a directory (path), in this case the -the function tries to detect and import all XSYG-files found in the directory.} - -\item{recalculate.TL.curves}{\link{logical} (\emph{with default}): -if set to \code{TRUE}, TL curves are returned as temperature against count values -(see details for more information) Note: The option overwrites the time vs. -count TL curve. Select \code{FALSE} to import the raw data delivered by the -lexsyg. Works for TL curves and spectra.} - -\item{fastForward}{\link{logical} (\emph{with default}): -if \code{TRUE} for a more efficient data processing only a list of \linkS4class{RLum.Analysis} -objects is returned.} - -\item{import}{\link{logical} (\emph{with default}): -if set to \code{FALSE}, only the XSYG file structure is shown.} - -\item{pattern}{\link{regex} (\emph{with default}): -optional regular expression if \code{file} is a link to a folder, to select just -specific XSYG-files} - -\item{verbose}{\link{logical} (\emph{with default}): enable or disable verbose mode. If verbose is \code{FALSE} -the \code{txtProgressBar} is also switched off} - -\item{txtProgressBar}{\link{logical} (\emph{with default}): -enables \code{TRUE} or disables \code{FALSE} the progress bar during import} -} -\value{ -\strong{Using the option \code{import = FALSE}} - -A list consisting of two elements is shown: -\itemize{ -\item \link{data.frame} with information on file. -\item \link{data.frame} with information on the sequences stored in the XSYG file. -} - -\strong{Using the option \code{import = TRUE} (default)} - -A list is provided, the list elements -contain: \item{Sequence.Header}{\link{data.frame} with information on the -sequence.} \item{Sequence.Object}{\linkS4class{RLum.Analysis} -containing the curves.} -} -\description{ -Imports XSYG-files produced by a Freiberg Instruments lexsyg reader into R. -} -\details{ -\strong{How does the import function work?} - -The function uses the \code{'XML'} package to parse the file structure. Each -sequence is subsequently translated into an \linkS4class{RLum.Analysis} object. - -\strong{General structure XSYG format} - -\if{html}{\out{
}}\preformatted{ - - - - - x0 , y0 ; x1 , y1 ; x2 , y2 ; x3 , y3 - - - -}\if{html}{\out{
}} - -So far, each -XSYG file can only contain one \verb{}, but multiple -sequences. - -Each record may comprise several curves. - -\strong{TL curve recalculation} - -On the FI lexsyg device TL curves are recorded as time against count values. -Temperature values are monitored on the heating plate and stored in a -separate curve (time vs. temperature). If the option -\code{recalculate.TL.curves = TRUE} is chosen, the time values for each TL -curve are replaced by temperature values. - -Practically, this means combining two matrices (Time vs. Counts and Time vs. -Temperature) with different row numbers by their time values. Three cases -are considered: -\enumerate{ -\item HE: Heating element -\item PMT: Photomultiplier tube -\item Interpolation is done using the function \link{approx} -} - -CASE (1): \code{nrow(matrix(PMT))} > \code{nrow(matrix(HE))} - -Missing temperature values from the heating element are calculated using -time values from the PMT measurement. - -CASE (2): \code{nrow(matrix(PMT))} < \code{nrow(matrix(HE))} - -Missing count values from the PMT are calculated using time values from the -heating element measurement. - -CASE (3): \code{nrow(matrix(PMT))} == \code{nrow(matrix(HE))} - -A new matrix is produced using temperature values from the heating element -and count values from the PMT. - -\strong{Note:} -Please note that due to the recalculation of the temperature -values based on values delivered by the heating element, it may happen that -multiple count values exists for each temperature value and temperature -values may also decrease during heating, not only increase. - -\strong{Advanced file import} - -To allow for a more efficient usage of the function, instead of single path -to a file just a directory can be passed as input. In this particular case -the function tries to extract all XSYG-files found in the directory and import -them all. Using this option internally the function constructs as list of -the XSYG-files found in the directory. Please note no recursive detection -is supported as this may lead to endless loops. -} -\note{ -This function is a beta version as the XSYG file format is not yet -fully specified. Thus, further file operations (merge, export, write) should -be done using the functions provided with the package \code{'XML'}. - -\strong{So far, no image data import is provided!} \cr -Corresponding values in the XSXG file are skipped. -} -\section{Function version}{ - 0.6.12 -} - -\examples{ - -##(1) import XSYG file to R (uncomment for usage) - -#FILE <- file.choose() -#temp <- read_XSYG2R(FILE) - -##(2) additional examples for pure XML import using the package XML -## (uncomment for usage) - - ##import entire XML file - #FILE <- file.choose() - #temp <- XML::xmlRoot(XML::xmlTreeParse(FILE)) - - ##search for specific subnodes with curves containing 'OSL' - #getNodeSet(temp, "//Sample/Sequence/Record[@recordType = 'OSL']/Curve") - -##(2) How to extract single curves ... after import -data(ExampleData.XSYG, envir = environment()) - -##grep one OSL curves and plot the first curve -OSLcurve <- get_RLum(OSL.SARMeasurement$Sequence.Object, recordType="OSL")[[1]] - -##(3) How to see the structure of an object? -structure_RLum(OSL.SARMeasurement$Sequence.Object) - -} - -\section{How to cite}{ -Kreutzer, S., 2024. read_XSYG2R(): Import XSYG files to R. Function version 0.6.12. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Grehl, S., Kreutzer, S., Hoehne, M., 2013. Documentation of the -XSYG file format. Unpublished Technical Note. Freiberg, Germany - -\strong{Further reading} - -XML: \url{https://en.wikipedia.org/wiki/XML} -} -\seealso{ -\code{'XML'}, \linkS4class{RLum.Analysis}, \linkS4class{RLum.Data.Curve}, \link{approx} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{IO} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/replicate_RLum.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/replicate_RLum.Rd deleted file mode 100644 index 2d191123f..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/replicate_RLum.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/replicate_RLum.R -\name{replicate_RLum} -\alias{replicate_RLum} -\title{General replication function for RLum S4 class objects} -\usage{ -replicate_RLum(object, times = NULL) -} -\arguments{ -\item{object}{\linkS4class{RLum} (\strong{required}): -an \linkS4class{RLum} object} - -\item{times}{\link{integer} (\emph{optional}): -number for times each element is repeated element} -} -\value{ -Returns a \link{list} of the object to be repeated -} -\description{ -Function replicates RLum S4 class objects and returns a list for this objects -} -\section{Function version}{ - 0.1.0 -} - -\seealso{ -\linkS4class{RLum} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. replicate_RLum(): General replication function for RLum S4 class objects. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{utilities} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/report_RLum.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/report_RLum.Rd deleted file mode 100644 index 552049f58..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/report_RLum.Rd +++ /dev/null @@ -1,210 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/report_RLum.R -\name{report_RLum} -\alias{report_RLum} -\title{Create a HTML-report for (RLum) objects} -\usage{ -report_RLum( - object, - file = tempfile(), - title = "RLum.Report", - compact = TRUE, - timestamp = TRUE, - show_report = TRUE, - launch.browser = FALSE, - css.file = NULL, - quiet = TRUE, - clean = TRUE, - ... -) -} -\arguments{ -\item{object}{(\strong{required}): -The object to be reported on, preferably of any \code{RLum}-class.} - -\item{file}{\link{character} (\emph{with default}): -A character string naming the output file. If no filename is provided a -temporary file is created.} - -\item{title}{\link{character} (\emph{with default}): -A character string specifying the title of the document.} - -\item{compact}{\link{logical} (\emph{with default}): -When \code{TRUE} the following report components are hidden: -\verb{@.pid}, \verb{@.uid}, \code{'Object structure'}, \code{'Session Info'} -and only the first and last 5 rows of long matrices and data frames are shown. -See details.} - -\item{timestamp}{\link{logical} (\emph{with default}): -\code{TRUE} to add a timestamp to the filename (suffix).} - -\item{show_report}{\link{logical} (\emph{with default}): If set to \code{TRUE} the function tries to display -the report output in the local viewer, e.g., within \emph{RStudio} after rendering.} - -\item{launch.browser}{\link{logical} (\emph{with default}): -\code{TRUE} to open the HTML file in the system's default web browser after -it has been rendered.} - -\item{css.file}{\link{character} (\emph{optional}): -Path to a CSS file to change the default styling of the HTML document.} - -\item{quiet}{\link{logical} (\emph{with default}): -\code{TRUE} to suppress printing of the pandoc command line.} - -\item{clean}{\link{logical} (\emph{with default}): -\code{TRUE} to clean intermediate files created during rendering.} - -\item{...}{further arguments passed to or from other methods and to control -the document's structure (see details).} -} -\value{ -Writes a HTML and .Rds file. -} -\description{ -Create a HTML-report for (RLum) objects -} -\details{ -This function creates a HTML-report for a given object, listing its complete -structure and content. The object itself is saved as a serialised .Rds file. -The report file serves both as a convenient way of browsing through objects with -complex data structures as well as a mean of properly documenting and saving -objects. - -The HTML report is created with \link[rmarkdown:render]{rmarkdown::render} and has the -following structure: - -\tabular{ll}{ -\strong{Section} \tab \strong{Description} \cr -\code{Header} \tab A summary of general characteristics of the object \cr -\verb{Object content} \tab A comprehensive list of the complete structure and content of the provided object. \cr -\verb{Object structure} \tab Summary of the objects structure given as a table \cr -\code{File} \tab Information on the saved RDS file \cr -\verb{Session Info} \tab Captured output from \code{sessionInfo()} \cr -\code{Plots} \tab (\emph{optional}) For \code{RLum-class} objects a variable number of plots \cr -} - -The structure of the report can be controlled individually by providing one or more of the -following arguments (all \code{logical}): - -\tabular{ll}{ -\strong{Argument} \tab \strong{Description} \cr -\code{header} \tab Hide or show general information on the object \cr -\code{main} \tab Hide or show the object's content \cr -\code{structure} \tab Hide or show object's structure \cr -\code{rds} \tab Hide or show information on the saved RDS file \cr -\code{session} \tab Hide or show the session info \cr -\code{plot} \tab Hide or show the plots (depending on object) \cr -} - -Note that these arguments have higher precedence than \code{compact}. - -Further options that can be provided via the \code{...} argument: - -\tabular{ll}{ -\strong{Argument} \tab \strong{Description} \cr -\code{short_table} \tab If \code{TRUE} only show the first and last 5 rows of long tables. \cr -\code{theme} \tab Specifies the Bootstrap -theme to use for the report. Valid themes include \code{"default"}, \code{"cerulean"}, \code{"journal"}, \code{"flatly"}, -\code{"readable"}, \code{"spacelab"}, \code{"united"}, \code{"cosmo"}, \code{"lumen"}, \code{"paper"}, \code{"sandstone"}, -\code{"simplex"}, and \code{"yeti"}. \cr -\code{highlight} \tab Specifies the syntax highlighting style. -Supported styles include \code{"default"}, \code{"tango"}, \code{"pygments"}, \code{"kate"}, \code{"monochrome"}, -\code{"espresso"}, \code{"zenburn"}, \code{"haddock"}, and \code{"textmate"}. \cr -\code{css} \tab \code{TRUE} or \code{FALSE} to enable/disable custom CSS styling \cr -} - -The following arguments can be used to customise the report via CSS (Cascading Style Sheets): - -\tabular{ll}{ -\strong{Argument} \tab \strong{Description} \cr -\code{font_family} \tab Define the font family of the HTML document (default: \code{"arial"}) \cr -\code{headings_size} \tab Size of the \verb{

} to \verb{

} tags used to define HTML headings (default: 166\%). \cr -\code{content_color} \tab Colour of the object's content (default: #a72925). \cr -} - -Note that these arguments must all be of class \link{character} and follow standard CSS syntax. -For exhaustive CSS styling you can provide a custom CSS file for argument \code{css.file}. -CSS styling can be turned of using \code{css = FALSE}. -} -\note{ -This function requires the R packages 'rmarkdown', 'pander' and 'rstudioapi'. -} -\section{Function version}{ - 0.1.5 -} - -\examples{ - -\dontrun{ -## Example: RLum.Results ---- - -# load example data -data("ExampleData.DeValues") - -# apply the MAM-3 age model and save results -mam <- calc_MinDose(ExampleData.DeValues$CA1, sigmab = 0.2) - -# create the HTML report -report_RLum(object = mam, file = "~/CA1_MAM.Rmd", - timestamp = FALSE, - title = "MAM-3 for sample CA1") - -# when creating a report the input file is automatically saved to a -# .Rds file (see saveRDS()). -mam_report <- readRDS("~/CA1_MAM.Rds") -all.equal(mam, mam_report) - - -## Example: Temporary file & Viewer/Browser ---- - -# (a) -# Specifying a filename is not necessarily required. If no filename is provided, -# the report is rendered in a temporary file. If you use the RStudio IDE, the -# temporary report is shown in the interactive Viewer pane. -report_RLum(object = mam) - -# (b) -# Additionally, you can view the HTML report in your system's default web browser. -report_RLum(object = mam, launch.browser = TRUE) - - -## Example: RLum.Analysis ---- - -data("ExampleData.RLum.Analysis") - -# create the HTML report (note that specifying a file -# extension is not necessary) -report_RLum(object = IRSAR.RF.Data, file = "~/IRSAR_RF") - - -## Example: RLum.Data.Curve ---- - -data.curve <- get_RLum(IRSAR.RF.Data)[[1]] - -# create the HTML report -report_RLum(object = data.curve, file = "~/Data_Curve") - -## Example: Any other object ---- -x <- list(x = 1:10, - y = runif(10, -5, 5), - z = data.frame(a = LETTERS[1:20], b = dnorm(0:9)), - NA) - -report_RLum(object = x, file = "~/arbitray_list") -} - -} -\seealso{ -\link[rmarkdown:render]{rmarkdown::render}, \link[pander:pander_return]{pander::pander_return}, -\link[pander:openFileInOS]{pander::openFileInOS}, \link[rstudioapi:viewer]{rstudioapi::viewer}, -\link{browseURL} -} -\author{ -Christoph Burow, University of Cologne (Germany), -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) \cr -, RLum Developer Team} - -\section{How to cite}{ -Burow, C., Kreutzer, S., 2024. report_RLum(): Create a HTML-report for (RLum) objects. Function version 0.1.5. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/sTeve.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/sTeve.Rd deleted file mode 100644 index e7217edf1..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/sTeve.Rd +++ /dev/null @@ -1,51 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/zzz.R -\name{sTeve} -\alias{sTeve} -\title{sTeve - sophisticated tool for efficient data validation and evaluation} -\usage{ -sTeve(n_frames = 10, t_animation = 2, n.tree = 7, type) -} -\arguments{ -\item{n_frames}{\link{integer} (\emph{with default}): -n frames} - -\item{t_animation}{\link{integer} (\emph{with default}): -t animation} - -\item{n.tree}{\link{integer} (\emph{with default}): -how many trees do you want to cut?} - -\item{type}{\link{integer} (\emph{optional}): -Make a decision: 1, 2 or 3} -} -\value{ -Validates your data. -} -\description{ -This function provides a sophisticated routine for comprehensive -luminescence dating data analysis. -} -\details{ -This amazing sophisticated function validates your data seriously. -} -\note{ -This function should not be taken too seriously. -} -\examples{ - -##no example available - -} -\seealso{ -\link{plot_KDE} -} -\author{ -R Luminescence Team, 2012-2046 -, RLum Developer Team} - -\section{How to cite}{ -NA, NA, , , 2024. sTeve(): sTeve - sophisticated tool for efficient data validation and evaluation. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{manip} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/scale_GammaDose.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/scale_GammaDose.Rd deleted file mode 100644 index 8c7385853..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/scale_GammaDose.Rd +++ /dev/null @@ -1,269 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/scale_GammaDose.R -\name{scale_GammaDose} -\alias{scale_GammaDose} -\title{Calculate the gamma dose deposited within a sample taking layer-to-layer -variations in radioactivity into account (according to Aitken, 1985)} -\usage{ -scale_GammaDose( - data, - conversion_factors = c("Cresswelletal2018", "Guerinetal2011", "AdamiecAitken1998", - "Liritzisetal2013")[1], - fractional_gamma_dose = c("Aitken1985")[1], - verbose = TRUE, - plot = TRUE, - plot_single = TRUE, - ... -) -} -\arguments{ -\item{data}{\link{data.frame} (\strong{required}): -A table containing all relevant information for each individual layer. The -table must have the following named columns: -\itemize{ -\item \code{id} (\link{character}): an arbitrary id or name of each layer -\item \code{thickness} (\link{numeric}): vertical extent of each layer in cm -\item \code{sample_offset} (\link{logical}): distance of the sample in cm, -\strong{measured from the BOTTOM OF THE TARGET LAYER}. Except for the target layer -all values must be \code{NA}. -\item \code{K} (\link{numeric}): K nuclide content in \% -\item \code{K_se} (\link{numeric}): error on the K content -\item \code{Th} (\link{numeric}): Th nuclide content in ppm -\item \code{Th_se} (\link{numeric}): error on the Th content -\item \code{U} (\link{numeric}): U nuclide content in ppm -\item \code{U_se} (\link{numeric}): error on the U content -\item \code{water_content} (\link{numeric}): water content of each layer in \% -\item \code{water_content_se} (\link{numeric}): error on the water content -\item \code{density} (\link{numeric}): bulk density of each layer in g/cm^-3 -}} - -\item{conversion_factors}{\link{character} (\emph{optional}): -The conversion factors used to calculate the dose rate from sediment -nuclide contents. Valid options are: -\itemize{ -\item \code{"Cresswelletal2018"} (default) -\item \code{"Liritzisetal2013"} -\item \code{"Guerinetal2011"} -\item \code{"AdamiecAitken1998"} -}} - -\item{fractional_gamma_dose}{\link{character} (\emph{optional}): -Factors to scale gamma dose rate values. Valid options are: -\itemize{ -\item \code{"Aitken1985"} (default): Table H1 in the appendix -}} - -\item{verbose}{\link{logical} (\emph{optional}): -Show or hide console output (defaults to \code{TRUE}).} - -\item{plot}{\link{logical} (\emph{optional}): -Show or hide the plot (defaults to \code{TRUE}).} - -\item{plot_single}{\link{logical} (\emph{optional}): -Show all plots in one panel (defaults to \code{TRUE}).} - -\item{...}{Further parameters passed to \link{barplot}.} -} -\value{ -After performing the calculations the user is provided with different outputs. -\enumerate{ -\item The total gamma dose rate received by the sample (+/- uncertainties) as a -print in the console. -\item A plot showing the sediment sequence, the user input sample information -and the contribution to total gamma dose rate. -\item RLum Results. If the user wishes to save these results, writing a script -to run the function and to save the results would look like this: -} - -\if{html}{\out{
}}\preformatted{mydata <- read.table("c:/path/to/input/file.txt") -results <- scale_GammaDose(mydata) -table <- get_RLum(results) -write.csv(table, "c:/path/to/results.csv") -}\if{html}{\out{
}} - ------------------------------------\cr -\verb{[ NUMERICAL OUTPUT ]}\cr ------------------------------------\cr - -\strong{\code{RLum.Results}}-object - -\strong{slot:} \strong{\verb{@data}} - -\tabular{lll}{ -\strong{Element} \tab \strong{Type} \tab \strong{Description}\cr -\verb{$summary} \tab \code{data.frame} \tab summary of the model results \cr -\verb{$data} \tab \code{data.frame} \tab the original input data \cr -\verb{$dose_rates} \tab \code{list} \tab two \code{data.frames} for the scaled and infinite matrix dose rates \cr -\verb{$tables} \tab \code{list} \tab several \code{data.frames} containing intermediate results \cr -\verb{$args} \tab \code{character} \tab arguments of the call \cr -\verb{$call} \tab \code{call} \tab the original function call \cr -} - -\strong{slot:} \strong{\verb{@info}} - -Currently unused. - -------------------------\cr -\verb{[ PLOT OUTPUT ]}\cr -------------------------\cr - -Three plots are produced: -\itemize{ -\item A visualisation of the provided sediment layer structure to quickly -assess whether the data was provided and interpreted correctly. -\item A scatter plot of the nuclide contents per layer (K, Th, U) as well as the -water content. This may help to correlate the dose rate contribution of -specific layers to the layer of interest. -\item A barplot visualising the contribution of each layer to the total dose rate -received by the sample in the target layer. -} -} -\description{ -This function calculates the gamma dose deposited in a luminescence sample -taking into account layer-to-layer variations in sediment radioactivity. -The function scales user inputs of uranium, thorium and potassium based on -input parameters for sediment density, water content and given layer -thicknesses and distances to the sample. -} -\details{ -\strong{User Input} - -To calculate the gamma dose which is deposited in a sample, the user needs -to provide information on those samples influencing the luminescence sample. -As a rule of thumb, all sediment layers within at least 30 cm radius from -the luminescence sample taken should be taken into account when calculating -the gamma dose rate. However, the actual range of gamma radiation might be -different, depending on the emitting radioelement, the water content and the -sediment density of each layer (Aitken, 1985). Therefore the user is -advised to provide as much detail as possible and physically sensible. - -The function requires a \link{data.frame} that is to be structured -in columns and rows, with samples listed in rows. The first column contains -information on the layer/sample ID, the second on the thickness (in cm) of -each layer, whilst column 3 should contain \code{NA} for all layers that are not -sampled for OSL/TL. For the layer the OSL/TL sample was taken from a numerical -value must be provided, which is the distance (in cm) measured from \strong{bottom} -of the layer of interest. If the whole layer was sampled insert \code{0}. If the -sample was taken from \emph{within} the layer, insert a numerical value \verb{>0}, -which describes the distance from the middle of the sample to the bottom of -the layer in cm. Columns 4 to 9 should contain radionuclide concentrations -and their standard errors for -potassium (in \%), thorium (in ppm) and uranium (in ppm). Columns 10 and 11 -give information on the water content and its uncertainty (standard error) -in \%. The layer density (in g/cm3) should be given in column 12. No cell -should be left blank. Please ensure to keep the column titles as given in -the example dataset (\code{data('ExampleData.ScaleGammaDose')}, see examples). - -The user can decide which dose rate -conversion factors should be used to calculate the gamma dose rates. -The options are: -\itemize{ -\item \code{"Cresswelletal2018"} (Cresswell et al., 2018) -\item \code{"Liritzisetal2013"} (Liritzis et al., 2013) -\item \code{"Guerinetal2011"} (Guerin et al., 2011) -\item \code{"AdamiecAitken1998"} (Adamiec and Aitken, 1998) -} - -\strong{Water content} - -The water content provided by the user should be calculated according to: - -\deqn{ ( Wet weight [g] - Dry weight [g] ) / Dry weight [g] * 100 } - -\strong{Calculations} - -After converting the radionuclide concentrations into dose rates, the -function will scale the dose rates based on the thickness of the layers, -the distances to the sample, the water content and the density of the sediment. -The calculations are based on Aitken (1985, Appendix H). As an example -(equivalent to Aitken, 1985), assuming three layers of sediment, where \strong{L} is -inert and positioned in between the infinite thick and equally active -layers \strong{A} and \strong{B}, the dose in \strong{L} and \strong{B} due to \strong{A} is given by - -\deqn{ {1-f(x)}D_A } - -Where \code{x} is the distance into the inert medium, so \code{f(x)} is the weighted -average fractional dose at \code{x} and \code{D_A} denotes that the dose is delivered by \strong{A}. -\code{f(x)} is derived from table H1 (Aitken, 1985), when setting \code{z = x}. -Consequently, the dose in \strong{A} and \strong{L} due to \strong{B} is given by - -\deqn{ {1 - f(t-x)}D_B } - -Here \code{t} is the thickness of \strong{L} and the other parameters are denoted as above, -just for the dose being delivered by B. \code{f(t-x)} is derived from table H1 -(Aitken, 1985), when setting \code{z} equal to \code{t-x}. Following this, the dose in \strong{L} -delivered by \strong{A} and \strong{B} is given by - -\deqn{ {2 - f(x) - f(t-x)}D_{AB} } - -Since \strong{A} and \strong{B} are equally active \verb{D_\{AB\} = D_A = D_B}. - -The function uses the value of the fractional dose rate at the layer -boundary to start the calculation for the next layer. This way, the function -is able to scale the gamma dose rate accurately for distant layers when the -density and water content is not constant for the entire section. -} -\note{ -\strong{This function has BETA status. If possible, results should be} -\strong{cross-checked.} -} -\section{Function version}{ - 0.1.2 -} - -\section{Acknowledgements}{ - - -We thank Dr Ian Bailiff for the provision of an excel spreadsheet, which has -been very helpful when writing this function. -} - -\examples{ - -# Load example data -data("ExampleData.ScaleGammaDose", envir = environment()) -x <- ExampleData.ScaleGammaDose - -# Scale gamma dose rate -results <- scale_GammaDose(data = x, - conversion_factors = "Cresswelletal2018", - fractional_gamma_dose = "Aitken1985", - verbose = TRUE, - plot = TRUE) - -get_RLum(results) - -} - -\section{How to cite}{ -Riedesel, S., Autzen, M., Burow, C., 2024. scale_GammaDose(): Calculate the gamma dose deposited within a sample taking layer-to-layer variations in radioactivity into account (according to Aitken, 1985). Function version 0.1.2. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Aitken, M.J., 1985. Thermoluminescence Dating. Academic Press, London. - -Adamiec, G., Aitken, M.J., 1998. Dose-rate conversion factors: update. -Ancient TL 16, 37-46. - -Cresswell., A.J., Carter, J., Sanderson, D.C.W., 2018. -Dose rate conversion parameters: Assessment of nuclear data. -Radiation Measurements 120, 195-201. - -Guerin, G., Mercier, N., Adamiec, G., 2011. Dose-rate conversion -factors: update. Ancient TL, 29, 5-8. - -Liritzis, I., Stamoulis, K., Papachristodoulou, C., Ioannides, K., 2013. -A re-evaluation of radiation dose-rate conversion factors. Mediterranean -Archaeology and Archaeometry 13, 1-15. -} -\seealso{ -\link{ExampleData.ScaleGammaDose}, -\link{BaseDataSet.ConversionFactors}, \link{approx}, \link{barplot} -} -\author{ -Svenja Riedesel, Aberystwyth University (United Kingdom) \cr -Martin Autzen, DTU NUTECH Center for Nuclear Technologies (Denmark) \cr -Christoph Burow, University of Cologne (Germany) \cr -Based on an excel spreadsheet and accompanying macro written by Ian Bailiff. -, RLum Developer Team} -\keyword{datagen} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/set_RLum.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/set_RLum.Rd deleted file mode 100644 index eb394469a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/set_RLum.Rd +++ /dev/null @@ -1,81 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/set_RLum.R -\name{set_RLum} -\alias{set_RLum} -\title{General set function for RLum S4 class objects} -\usage{ -set_RLum(class, originator, .uid = create_UID(), .pid = NA_character_, ...) -} -\arguments{ -\item{class}{\linkS4class{RLum} (\strong{required}): -name of the S4 class to create} - -\item{originator}{\link{character} (\emph{automatic}): -contains the name of the calling function (the function that produces this object); -can be set manually.} - -\item{.uid}{\link{character} (\emph{automatic}): -sets an unique ID for this object using the internal C++ function \code{create_UID}.} - -\item{.pid}{\link{character} (\emph{with default}): -option to provide a parent id for nesting at will.} - -\item{...}{further arguments that one might want to pass to the specific set method} -} -\value{ -Returns an object of the specified class. -} -\description{ -Function calls object-specific set functions for RLum S4 class objects. -} -\details{ -The function provides a generalised access point for specific -\linkS4class{RLum} objects.\cr -Depending on the given class, the corresponding method to create an object -from this class will be selected. Allowed additional arguments can be found -in the documentations of the corresponding \linkS4class{RLum} class: -\itemize{ -\item \linkS4class{RLum.Data.Curve}, -\item \linkS4class{RLum.Data.Image}, -\item \linkS4class{RLum.Data.Spectrum}, -\item \linkS4class{RLum.Analysis}, -\item \linkS4class{RLum.Results} -} -} -\section{Function version}{ - 0.3.0 -} - -\examples{ - -##produce empty objects from each class -set_RLum(class = "RLum.Data.Curve") -set_RLum(class = "RLum.Data.Spectrum") -set_RLum(class = "RLum.Data.Spectrum") -set_RLum(class = "RLum.Analysis") -set_RLum(class = "RLum.Results") - -##produce a curve object with arbitrary curve values -object <- set_RLum( -class = "RLum.Data.Curve", -curveType = "arbitrary", -recordType = "OSL", -data = matrix(c(1:100,exp(-c(1:100))),ncol = 2)) - -##plot this curve object -plot_RLum(object) - -} -\seealso{ -\linkS4class{RLum.Data.Curve}, \linkS4class{RLum.Data.Image}, -\linkS4class{RLum.Data.Spectrum}, \linkS4class{RLum.Analysis}, \linkS4class{RLum.Results} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. set_RLum(): General set function for RLum S4 class objects. Function version 0.3.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{utilities} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/set_Risoe.BINfileData.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/set_Risoe.BINfileData.Rd deleted file mode 100644 index 5e500fbc8..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/set_Risoe.BINfileData.Rd +++ /dev/null @@ -1,48 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/set_Risoe.BINfileData.R -\name{set_Risoe.BINfileData} -\alias{set_Risoe.BINfileData} -\title{General accessor function for RLum S4 class objects} -\usage{ -set_Risoe.BINfileData( - METADATA = data.frame(), - DATA = list(), - .RESERVED = list() -) -} -\arguments{ -\item{METADATA}{x} - -\item{DATA}{x} - -\item{.RESERVED}{x} -} -\value{ -Return is the same as input objects as provided in the list. -} -\description{ -Function calls object-specific get functions for RisoeBINfileData S4 class objects. -} -\details{ -The function provides a generalised access point for specific -\linkS4class{Risoe.BINfileData} objects.\cr -Depending on the input object, the corresponding get function will be selected. -Allowed arguments can be found in the documentations of the corresponding -\linkS4class{Risoe.BINfileData} class. -} -\section{Function version}{ - 0.1 -} - -\seealso{ -\linkS4class{Risoe.BINfileData} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. set_Risoe.BINfileData(): General accessor function for RLum S4 class objects. Function version 0.1. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{utilities} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/smooth_RLum.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/smooth_RLum.Rd deleted file mode 100644 index db924d39b..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/smooth_RLum.Rd +++ /dev/null @@ -1,74 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/smooth_RLum.R -\name{smooth_RLum} -\alias{smooth_RLum} -\alias{smooth_RLum,list-method} -\title{Smoothing of data} -\usage{ -smooth_RLum(object, ...) - -\S4method{smooth_RLum}{list}(object, ...) -} -\arguments{ -\item{object}{\linkS4class{RLum} (\strong{required}): -S4 object of class \code{RLum}} - -\item{...}{further arguments passed to the specific class method} -} -\value{ -An object of the same type as the input object is provided -} -\description{ -Function calls the object-specific smooth functions for provided RLum S4-class objects. -} -\details{ -The function provides a generalised access point for specific -\linkS4class{RLum} objects.\cr -Depending on the input object, the corresponding function will be selected. -Allowed arguments can be found in the documentations of the corresponding -\linkS4class{RLum} class. The smoothing is based on an internal function -called \code{.smoothing}. -} -\section{Functions}{ -\itemize{ -\item \code{smooth_RLum(list)}: Returns a list of \linkS4class{RLum} objects that had been passed to \link{smooth_RLum} - -}} -\note{ -Currently only \code{RLum} objects of class \code{RLum.Data.Curve} and \code{RLum.Analysis} -(with curve data) are supported! -} -\section{Function version}{ - 0.1.0 -} - -\examples{ - -##load example data -data(ExampleData.CW_OSL_Curve, envir = environment()) - -##create RLum.Data.Curve object from this example -curve <- - set_RLum( - class = "RLum.Data.Curve", - recordType = "OSL", - data = as.matrix(ExampleData.CW_OSL_Curve) - ) - -##plot data without and with smoothing -plot_RLum(curve) -plot_RLum(smooth_RLum(curve)) - -} -\seealso{ -\linkS4class{RLum.Data.Curve}, \linkS4class{RLum.Analysis} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. smooth_RLum(): Smoothing of data. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{utilities} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/structure_RLum.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/structure_RLum.Rd deleted file mode 100644 index 9604e1390..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/structure_RLum.Rd +++ /dev/null @@ -1,62 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/structure_RLum.R -\name{structure_RLum} -\alias{structure_RLum} -\alias{structure_RLum,list-method} -\title{General structure function for RLum S4 class objects} -\usage{ -structure_RLum(object, ...) - -\S4method{structure_RLum}{list}(object, ...) -} -\arguments{ -\item{object}{\linkS4class{RLum} (\strong{required}): -S4 object of class \code{RLum}} - -\item{...}{further arguments that one might want to pass to the specific -structure method} -} -\value{ -Returns a \link{data.frame} with structure of the object. -} -\description{ -Function calls object-specific get functions for RLum S4 class objects. -} -\details{ -The function provides a generalised access point for specific -\linkS4class{RLum} objects.\cr -Depending on the input object, the corresponding structure function will -be selected. Allowed arguments can be found in the documentations of the -corresponding \linkS4class{RLum} class. -} -\section{Functions}{ -\itemize{ -\item \code{structure_RLum(list)}: Returns a list of \linkS4class{RLum} objects that had been passed to \link{structure_RLum} - -}} -\section{Function version}{ - 0.2.0 -} - -\examples{ - -##load example data -data(ExampleData.XSYG, envir = environment()) - -##show structure -structure_RLum(OSL.SARMeasurement$Sequence.Object) - -} -\seealso{ -\linkS4class{RLum.Data.Curve}, \linkS4class{RLum.Data.Image}, -\linkS4class{RLum.Data.Spectrum}, \linkS4class{RLum.Analysis}, \linkS4class{RLum.Results} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. structure_RLum(): General structure function for RLum S4 class objects. Function version 0.2.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{utilities} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/subset_SingleGrainData.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/subset_SingleGrainData.Rd deleted file mode 100644 index cddc97055..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/subset_SingleGrainData.Rd +++ /dev/null @@ -1,52 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/subset_SingleGrainData.R -\name{subset_SingleGrainData} -\alias{subset_SingleGrainData} -\title{Simple Subsetting of Single Grain Data from Risø BIN/BINX files} -\usage{ -subset_SingleGrainData(object, selection) -} -\arguments{ -\item{object}{\linkS4class{Risoe.BINfileData} (\strong{required}): input object with the -data to subset} - -\item{selection}{\link{data.frame} (\strong{required}): selection table with two columns -for position (1st column) and grain (2nd column) (columns names do not matter)} -} -\value{ -A subset \linkS4class{Risoe.BINfileData} object -} -\description{ -Most measured single grains do not exhibit light and it makes -usually sense to subset single grain datasets using a table of -position and grain pairs -} -\section{Function version}{ - 0.1.0 -} - -\examples{ - -## load example data -data(ExampleData.BINfileData, envir = environment()) - -## set POSITION/GRAIN pair dataset -selection <- data.frame(POSITION = c(1,5,7), GRAIN = c(0,0,0)) - -##subset -subset_SingleGrainData(object = CWOSL.SAR.Data, selection = selection) - -} -\seealso{ -\linkS4class{Risoe.BINfileData}, \link{read_BIN2R}, \link{verify_SingleGrainData} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. subset_SingleGrainData(): Simple Subsetting of Single Grain Data from Risø BIN/BINX files. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{datagen} -\keyword{manip} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/template_DRAC.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/template_DRAC.Rd deleted file mode 100644 index 2d305ad6c..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/template_DRAC.Rd +++ /dev/null @@ -1,105 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/template_DRAC.R -\name{template_DRAC} -\alias{template_DRAC} -\title{Create a DRAC input data template (v1.2)} -\usage{ -template_DRAC(nrow = 1L, preset = NULL, notification = TRUE) -} -\arguments{ -\item{nrow}{\link{integer} (\emph{with default}): -specifies the number of rows of the template (i.e., the number of data -sets you want to submit).} - -\item{preset}{\link{character} (\emph{optional}): -By default, all values of the template are set to \code{NA}, which means that -the user needs to fill in \strong{all} data first before submitting to DRAC -using \code{use_DRAC()}. To reduce the number of values that need to be -provided, \code{preset} can be used to create a template with at least -a minimum of reasonable preset values. - -\code{preset} can be one of the following: -\itemize{ -\item \code{quartz_coarse} -\item \code{quartz_fine} -\item \code{feldspar_coarse} -\item \code{polymineral_fine} -\item \code{DRAC-example_quartz} -\item \code{DRAC-example_feldspar} -\item \code{DRAC-example_polymineral} -} - -Note that the last three options can be used to produce a template -with values directly taken from the official DRAC input \code{.csv} file.} - -\item{notification}{\link{logical} (\emph{with default}): -show or hide the notification} -} -\value{ -A list. -} -\description{ -This function returns a DRAC input template (v1.2) to be used in conjunction -with the \link{use_DRAC} function -} -\examples{ - -# create a new DRAC input input -input <- template_DRAC(preset = "DRAC-example_quartz") - -# show content of the input -print(input) -print(input$`Project ID`) -print(input[[4]]) - - -## Example: DRAC Quartz example -# note that you only have to assign new values where they -# are different to the default values -input$`Project ID` <- "DRAC-Example" -input$`Sample ID` <- "Quartz" -input$`Conversion factors` <- "AdamiecAitken1998" -input$`External U (ppm)` <- 3.4 -input$`errExternal U (ppm)` <- 0.51 -input$`External Th (ppm)` <- 14.47 -input$`errExternal Th (ppm)` <- 1.69 -input$`External K (\%)` <- 1.2 -input$`errExternal K (\%)` <- 0.14 -input$`Calculate external Rb from K conc?` <- "N" -input$`Calculate internal Rb from K conc?` <- "N" -input$`Scale gammadoserate at shallow depths?` <- "N" -input$`Grain size min (microns)` <- 90 -input$`Grain size max (microns)` <- 125 -input$`Water content ((wet weight - dry weight)/dry weight) \%` <- 5 -input$`errWater content \%` <- 2 -input$`Depth (m)` <- 2.2 -input$`errDepth (m)` <- 0.22 -input$`Overburden density (g cm-3)` <- 1.8 -input$`errOverburden density (g cm-3)` <- 0.1 -input$`Latitude (decimal degrees)` <- 30.0000 -input$`Longitude (decimal degrees)` <- 70.0000 -input$`Altitude (m)` <- 150 -input$`De (Gy)` <- 20 -input$`errDe (Gy)` <- 0.2 - -# use DRAC -\dontrun{ -output <- use_DRAC(input) -} - -} - -\section{How to cite}{ -Burow, C., Kreutzer, S., 2024. template_DRAC(): Create a DRAC input data template (v1.2). In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Durcan, J.A., King, G.E., Duller, G.A.T., 2015. DRAC: Dose Rate and Age Calculator for trapped charge dating. -Quaternary Geochronology 28, 54-61. doi:10.1016/j.quageo.2015.03.012 -} -\seealso{ -\link{as.data.frame}, \link{list} -} -\author{ -Christoph Burow, University of Cologne (Germany), Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/trim_RLum.Data.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/trim_RLum.Data.Rd deleted file mode 100644 index 1508cdd31..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/trim_RLum.Data.Rd +++ /dev/null @@ -1,84 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/trim_RLum.Data.R -\name{trim_RLum.Data} -\alias{trim_RLum.Data} -\title{Trim Channels of RLum.Data-class Objects} -\usage{ -trim_RLum.Data(object, recordType = NULL, trim_range = NULL) -} -\arguments{ -\item{object}{\linkS4class{RLum.Data} \linkS4class{RLum.Analysis} (\strong{required}): input object, -can be a \link{list} of objects. Please note that in the latter case the function works -only isolated on each element of the \link{list}.} - -\item{recordType}{\link{character} (\emph{optional}): type of the record where the trim -should be applied. If not set, the types are determined automatically and applied -for each record type classes. Can be provided as \link{list}.} - -\item{trim_range}{\link{numeric} (\emph{optional}): sets the trim range (everything -within the range + 1 is kept). If nothing is set all curves are trimmed to a similar -maximum length. Can be provided as \link{list}.} -} -\value{ -A trimmed object or \link{list} of such objects similar to the input objects -} -\description{ -Trim off the number of channels of \linkS4class{RLum.Data} objects of similar record type -on the time domain. This function is useful in cases where objects have different lengths (short/longer -measurement time) but should be analysed jointly by other functions. -} -\details{ -The function has two modes of operation: -\enumerate{ -\item Single \linkS4class{RLum.Data} objects or a \link{list} of such objects -The function is applied separately over each object. -\item Multiple curves via \linkS4class{RLum.Analysis} or a \link{list} of such objects -In this mode, the function first determines the minimum number of channels for -each category of records and then jointly processes them. -For instance, the object contains one TL curve with 100 channels and two -OSL curves with 100 and 99 channels, respectively. Than the minimum for TL would be set -to 100 channels and 99 for the OSL curves. If no further parameters are applied, the -function will shorten all OSL curves to 99 channels, but leave the TL curve untouched. -} -} -\section{Function version}{ - 0.1.0 -} - -\examples{ -## trim all TL curves in the object to channels 10 to 20 -data(ExampleData.BINfileData, envir = environment()) -temp <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = 1) - -c <- trim_RLum.Data( -object = temp, -recordType = "TL", -trim_range = c(10,20)) - -plot_RLum.Analysis( -object = c, -combine = TRUE, -subset = list(recordType = "TL")) - -## simulate a situation where one OSL curve -## in the dataset has only 999 channels instead of 1000 -## all curves should be limited to 999 -temp@records[[2]]@data <- temp@records[[2]]@data[-nrow(temp[[2]]@data),] - -c <- trim_RLum.Data(object = temp) -nrow(c@records[[4]]@data) - - -} -\seealso{ -\linkS4class{RLum.Data}, \linkS4class{RLum.Analysis} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. trim_RLum.Data(): Trim Channels of RLum.Data-class Objects. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{manip} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/tune_Data.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/tune_Data.Rd deleted file mode 100644 index 4af119e7b..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/tune_Data.Rd +++ /dev/null @@ -1,60 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/tune_Data.R -\name{tune_Data} -\alias{tune_Data} -\title{Tune data for experimental purpose} -\usage{ -tune_Data(data, decrease.error = 0, increase.data = 0) -} -\arguments{ -\item{data}{\link{data.frame} (\strong{required}): -input values, structure: data (\code{values[,1]}) and data error (\code{values [,2]}) -are required} - -\item{decrease.error}{\link{numeric}: -factor by which the error is decreased, ranges between 0 and 1.} - -\item{increase.data}{\link{numeric}: -factor by which the error is decreased, ranges between 0 and \code{Inf}.} -} -\value{ -Returns a \link{data.frame} with tuned values. -} -\description{ -The error can be reduced and sample size increased for specific purpose. -} -\note{ -You should not use this function to improve your poor data set! -} -\section{Function version}{ - 0.5.0 -} - -\examples{ - -## load example data set -data(ExampleData.DeValues, envir = environment()) -x <- ExampleData.DeValues$CA1 - -## plot original data -plot_AbanicoPlot(data = x, - summary = c("n", "mean")) - -## decrease error by 10 \% -plot_AbanicoPlot(data = tune_Data(x, decrease.error = 0.1), - summary = c("n", "mean")) - -## increase sample size by 200 \% -#plot_AbanicoPlot(data = tune_Data(x, increase.data = 2) , -# summary = c("n", "mean")) - -} -\author{ -Michael Dietze, GFZ Potsdam (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Dietze, M., 2024. tune_Data(): Tune data for experimental purpose. Function version 0.5.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{manip} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/use_DRAC.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/use_DRAC.Rd deleted file mode 100644 index a0b37da5c..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/use_DRAC.Rd +++ /dev/null @@ -1,126 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/use_DRAC.R -\name{use_DRAC} -\alias{use_DRAC} -\title{Use DRAC to calculate dose rate data} -\usage{ -use_DRAC(file, name, print_references = TRUE, citation_style = "text", ...) -} -\arguments{ -\item{file}{\link{character} (\strong{required}): -spreadsheet to be passed to the DRAC website for calculation. Can also be a -DRAC template object obtained from \code{template_DRAC()}.} - -\item{name}{\link{character} (\emph{with default}): -Optional user name submitted to DRAC. If omitted, a random name will be generated} - -\item{print_references}{(\emph{with default}): -Print all references used in the input data table to the console.} - -\item{citation_style}{(\emph{with default}): -If \code{print_references = TRUE} this argument determines the output style of the -used references. Valid options are \code{"Bibtex"}, \code{"citation"}, \code{"html"}, \code{"latex"} -or \code{"R"}. Default is \code{"text"}.} - -\item{...}{Further arguments. -\itemize{ -\item \code{url} \link{character}: provide an alternative URL to DRAC -\item \code{verbose} \link{logical}: show or hide console output -}} -} -\value{ -Returns an \linkS4class{RLum.Results} object containing the following elements: - -\item{DRAC}{\link{list}: a named list containing the following elements in slot \verb{@data}: - -\tabular{lll}{ -\verb{$highlights} \tab \link{data.frame} \tab summary of 25 most important input/output fields \cr -\verb{$header} \tab \link{character} \tab HTTP header from the DRAC server response \cr -\verb{$labels} \tab \link{data.frame} \tab descriptive headers of all input/output fields \cr -\verb{$content} \tab \link{data.frame} \tab complete DRAC input/output table \cr -\verb{$input} \tab \link{data.frame} \tab DRAC input table \cr -\verb{$output} \tab \link{data.frame} \tab DRAC output table \cr -\code{references}\tab \link{list} \tab A list of bib entries of used references \cr -} - -} -\item{data}{\link{character} or \link{list} path to the input spreadsheet or a DRAC template} -\item{call}{\link{call} the function call} -\item{args}{\link{list} used arguments} - -The output should be accessed using the function \link{get_RLum}. -} -\description{ -The function provides an interface from R to DRAC. An R-object or a -pre-formatted XLS/XLSX file is passed to the DRAC website and the -results are re-imported into R. -} -\section{Function version}{ - 0.14 -} - -\examples{ - -## (1) Method using the DRAC spreadsheet - -file <- "/PATH/TO/DRAC_Input_Template.csv" - -# send the actual IO template spreadsheet to DRAC -\dontrun{ -use_DRAC(file = file) -} - - - -## (2) Method using an R template object - -# Create a template -input <- template_DRAC(preset = "DRAC-example_quartz") - -# Fill the template with values -input$`Project ID` <- "DRAC-Example" -input$`Sample ID` <- "Quartz" -input$`Conversion factors` <- "AdamiecAitken1998" -input$`External U (ppm)` <- 3.4 -input$`errExternal U (ppm)` <- 0.51 -input$`External Th (ppm)` <- 14.47 -input$`errExternal Th (ppm)` <- 1.69 -input$`External K (\%)` <- 1.2 -input$`errExternal K (\%)` <- 0.14 -input$`Calculate external Rb from K conc?` <- "N" -input$`Calculate internal Rb from K conc?` <- "N" -input$`Scale gammadoserate at shallow depths?` <- "N" -input$`Grain size min (microns)` <- 90 -input$`Grain size max (microns)` <- 125 -input$`Water content ((wet weight - dry weight)/dry weight) \%` <- 5 -input$`errWater content \%` <- 2 -input$`Depth (m)` <- 2.2 -input$`errDepth (m)` <- 0.22 -input$`Overburden density (g cm-3)` <- 1.8 -input$`errOverburden density (g cm-3)` <- 0.1 -input$`Latitude (decimal degrees)` <- 30.0000 -input$`Longitude (decimal degrees)` <- 70.0000 -input$`Altitude (m)` <- 150 -input$`De (Gy)` <- 20 -input$`errDe (Gy)` <- 0.2 - -# use DRAC -\dontrun{ -output <- use_DRAC(input) -} - -} - -\section{How to cite}{ -Kreutzer, S., Dietze, M., Burow, C., 2024. use_DRAC(): Use DRAC to calculate dose rate data. Function version 0.14. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -Durcan, J.A., King, G.E., Duller, G.A.T., 2015. DRAC: Dose Rate and Age Calculator for trapped charge dating. -Quaternary Geochronology 28, 54-61. doi:10.1016/j.quageo.2015.03.012 -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)\cr -Michael Dietze, GFZ Potsdam (Germany)\cr -Christoph Burow, University of Cologne (Germany) -, RLum Developer Team} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/verify_SingleGrainData.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/verify_SingleGrainData.Rd deleted file mode 100644 index d6c3cf998..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/verify_SingleGrainData.Rd +++ /dev/null @@ -1,163 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/verify_SingleGrainData.R -\name{verify_SingleGrainData} -\alias{verify_SingleGrainData} -\title{Verify single grain data sets and check for invalid grains, i.e. -zero-light level grains} -\usage{ -verify_SingleGrainData( - object, - threshold = 10, - cleanup = FALSE, - cleanup_level = "aliquot", - verbose = TRUE, - plot = FALSE, - ... -) -} -\arguments{ -\item{object}{\linkS4class{Risoe.BINfileData} or \linkS4class{RLum.Analysis} (\strong{required}): -input object. The function also accepts a list with objects of allowed type.} - -\item{threshold}{\link{numeric} (\emph{with default}): -numeric threshold value for the allowed difference between the \code{mean} and -the \code{var} of the count values (see details)} - -\item{cleanup}{\link{logical} (\emph{with default}): -if set to \code{TRUE}, curves identified as zero light level curves are -automatically removed. Output is an object as same type as the input, i.e. -either \linkS4class{Risoe.BINfileData} or \linkS4class{RLum.Analysis}} - -\item{cleanup_level}{\link{character} (\emph{with default}): -selects the level for the clean-up of the input data sets. -Two options are allowed: \code{"curve"} or \code{"aliquot"}: -\itemize{ -\item If \code{"curve"} is selected, every single curve marked as \code{invalid} is removed. -\item If \code{"aliquot"} is selected, curves of one aliquot (grain or disc) can be -marked as invalid, but will not be removed. An aliquot will be only removed -if all curves of this aliquot are marked as invalid. -}} - -\item{verbose}{\link{logical} (\emph{with default}): -enables or disables the terminal feedback} - -\item{plot}{\link{logical} (\emph{with default}): -enables or disables the graphical feedback} - -\item{...}{further parameters to control the plot output; if selected. -Supported arguments \code{main}, \code{ylim}} -} -\value{ -The function returns - ------------------------------------\cr -\verb{[ NUMERICAL OUTPUT ]}\cr ------------------------------------\cr - -\strong{\code{RLum.Results}}-object - -\strong{slot:****\verb{@data}} - -\tabular{lll}{ -\strong{Element} \tab \strong{Type} \tab \strong{Description}\cr -\verb{$unique_pairs} \tab \code{data.frame} \tab the unique position and grain pairs \cr -\verb{$selection_id} \tab \code{numeric} \tab the selection as record ID \cr -\verb{$selection_full} \tab \code{data.frame} \tab implemented models used in the baSAR-model core \cr -} - -\strong{slot:****\verb{@info}} - -The original function call - -\strong{Output variation} - -For \code{cleanup = TRUE} the same object as the input is returned, but cleaned up -(invalid curves were removed). This means: Either a \linkS4class{Risoe.BINfileData} -or an \linkS4class{RLum.Analysis} object is returned in such cases. -A \linkS4class{Risoe.BINfileData} object can be exported to a BIN-file by -using the function \link{write_R2BIN}. -} -\description{ -This function tries to identify automatically zero-light level curves (grains) -from single grain data measurements. -} -\details{ -\strong{How does the method work?} - -The function compares the expected values (\eqn{E(X)}) and the variance -(\eqn{Var(X)}) of the count values for each curve. Assuming that the -background roughly follows a Poisson distribution, the absolute difference -of both values should be zero or at least around zero as - -\deqn{E(x) = Var(x) = \lambda} - -Thus the function checks for: - -\deqn{abs(E(x) - Var(x)) >= \Theta} - -With \eqn{\Theta} an arbitrary, user defined, threshold. Values above the -threshold indicate curves comprising a signal. - -Note: the absolute difference of \eqn{E(X)} and \eqn{Var(x)} instead of the -ratio was chosen as both terms can become 0 which would result in 0 or \code{Inf}, -if the ratio is calculated. -} -\note{ -This function can work with \linkS4class{Risoe.BINfileData} objects or -\linkS4class{RLum.Analysis} objects (or a list of it). However, the function is -highly optimised for \linkS4class{Risoe.BINfileData} objects as it make sense to -remove identify invalid grains before the conversion to an -\linkS4class{RLum.Analysis} object. - -The function checking for invalid curves works rather robust and it is likely -that Reg0 curves within a SAR cycle are removed as well. Therefore it is -strongly recommended to use the argument \code{cleanup = TRUE} carefully. -} -\section{Function version}{ - 0.2.3 -} - -\examples{ - -##01 - basic example I -##just show how to apply the function -data(ExampleData.XSYG, envir = environment()) - -##verify and get data.frame out of it -verify_SingleGrainData(OSL.SARMeasurement$Sequence.Object)$selection_full - -##02 - basic example II -data(ExampleData.BINfileData, envir = environment()) -id <- verify_SingleGrainData(object = CWOSL.SAR.Data, -cleanup_level = "aliquot")$selection_id - -\dontrun{ -##03 - advanced example I -##importing and exporting a BIN-file - -##select and import file -file <- file.choose() -object <- read_BIN2R(file) - -##remove invalid aliquots(!) -object <- verify_SingleGrainData(object, cleanup = TRUE) - -##export to new BIN-file -write_R2BIN(object, paste0(dirname(file),"/", basename(file), "_CLEANED.BIN")) -} - -} -\seealso{ -\linkS4class{Risoe.BINfileData}, \linkS4class{RLum.Analysis}, \link{write_R2BIN}, -\link{read_BIN2R} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. verify_SingleGrainData(): Verify single grain data sets and check for invalid grains, i.e. zero-light level grains. Function version 0.2.3. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{datagen} -\keyword{manip} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/write_R2BIN.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/write_R2BIN.Rd deleted file mode 100644 index f32e05289..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/write_R2BIN.Rd +++ /dev/null @@ -1,109 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/write_R2BIN.R -\name{write_R2BIN} -\alias{write_R2BIN} -\title{Export Risoe.BINfileData into Risø BIN/BINX-file} -\usage{ -write_R2BIN( - object, - file, - version, - compatibility.mode = FALSE, - txtProgressBar = TRUE -) -} -\arguments{ -\item{object}{\linkS4class{Risoe.BINfileData} (\strong{required}): -input object to be stored in a bin file.} - -\item{file}{\link{character} (\strong{required}): -file name and path of the output file -\itemize{ -\item \verb{[WIN]}: \code{write_R2BIN(object, "C:/Desktop/test.bin")} -\item \verb{[MAC/LINUX]}: \code{write_R2BIN("/User/test/Desktop/test.bin")} -}} - -\item{version}{\link{character} (\emph{optional}): -version number for the output file. If no value is provided, the highest -version number from the \linkS4class{Risoe.BINfileData} is taken automatically. - -\strong{Note:} -This argument can be used to convert BIN-file versions.} - -\item{compatibility.mode}{\link{logical} (\emph{with default}): -this option recalculates the position values if necessary and set the max. -value to 48. The old position number is appended as comment (e.g., 'OP: 70). -This option accounts for potential compatibility problems with the Analyst software. -It further limits the maximum number of points per curve to 9,999. If a curve contains more -data the curve data get binned using the smallest possible bin width.} - -\item{txtProgressBar}{\link{logical} (\emph{with default}): -enables or disables \link{txtProgressBar}.} -} -\value{ -Write a binary file. -} -\description{ -Exports a \code{Risoe.BINfileData} object in a \verb{*.bin} or \verb{*.binx} file that can be -opened by the Analyst software or other Risø software. -} -\details{ -The structure of the exported binary data follows the data structure -published in the Appendices of the \emph{Analyst} manual p. 42. - -If -\code{LTYPE}, \code{DTYPE} and \code{LIGHTSOURCE} are not of type -\link{character}, no transformation into numeric values is done. -} -\note{ -The function just roughly checks the data structures. The validity of -the output data depends on the user. - -The validity of the file path is not further checked. BIN-file conversions -using the argument \code{version} may be a lossy conversion, depending on the -chosen input and output data (e.g., conversion from version 08 to 07 to 06 to 05 to 04 or 03). - -\strong{Warning} - -Although the coding was done carefully, it seems that the BIN/BINX-files -produced by Risø DA 15/20 TL/OSL readers slightly differ on the byte level. -No obvious differences are observed in the METADATA, however, the -BIN/BINX-file may not fully compatible, at least not similar to the ones -directly produced by the Risø readers! - -ROI definitions (introduced in BIN-file version 8) are not supported! -There are furthermore ignored by the function \link{read_BIN2R}. -} -\section{Function version}{ - 0.5.2 -} - -\examples{ -##load example dataset -file <- system.file("extdata/BINfile_V8.binx", package = "Luminescence") -temp <- read_BIN2R(file) - -##create temporary file path -##(for usage replace by own path) -temp_file <- tempfile(pattern = "output", fileext = ".binx") - -##export to temporary file path -write_R2BIN(temp, file = temp_file) - -} - -\section{How to cite}{ -Kreutzer, S., 2024. write_R2BIN(): Export Risoe.BINfileData into Risø BIN/BINX-file. Function version 0.5.2. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\references{ -DTU Nutech, 2016. The Sequence Editor, Users Manual, February, 2016. -\url{https://www.fysik.dtu.dk} -} -\seealso{ -\link{read_BIN2R}, \linkS4class{Risoe.BINfileData}, \link{writeBin} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} -\keyword{IO} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/write_R2TIFF.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/write_R2TIFF.Rd deleted file mode 100644 index f7f4e61d6..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/write_R2TIFF.Rd +++ /dev/null @@ -1,49 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/write_R2TIFF.R -\name{write_R2TIFF} -\alias{write_R2TIFF} -\title{Export RLum.Data.Image and RLum.Data.Spectrum objects to TIFF Images} -\usage{ -write_R2TIFF(object, file = tempfile(), norm = 65535, ...) -} -\arguments{ -\item{object}{\linkS4class{RLum.Data.Image} or \linkS4class{RLum.Data.Spectrum} object (\strong{required}): -input object, can be a \link{list} of such objects} - -\item{file}{\link{character} (\strong{required}): the file name and path} - -\item{norm}{\link{numeric} (\emph{with default}): normalisation values. Values in TIFF files must range between 0-1, however, usually -in imaging applications the pixel values are real integer count values. The normalisation to the -to the highest 16-bit integer values -1 ensures that the numerical values are retained in the exported -image. If \code{1} nothing is normalised.} - -\item{...}{further arguments to be passed to \link[tiff:writeTIFF]{tiff::writeTIFF}.} -} -\value{ -A TIFF file -} -\description{ -Simple wrapper around \link[tiff:writeTIFF]{tiff::writeTIFF} to export suitable -RLum-class objects to TIFF images. Per default 16-bit TIFF files are exported. -} -\section{Function version}{ - 0.1.0 -} - -\examples{ -data(ExampleData.RLum.Data.Image, envir = environment()) -write_R2TIFF(ExampleData.RLum.Data.Image, file = tempfile()) - -} -\seealso{ -\link[tiff:writeTIFF]{tiff::writeTIFF}, \linkS4class{RLum.Data.Image}, \linkS4class{RLum.Data.Spectrum} -} -\author{ -Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. write_R2TIFF(): Export RLum.Data.Image and RLum.Data.Spectrum objects to TIFF Images. Function version 0.1.0. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{IO} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/write_RLum2CSV.Rd b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/write_RLum2CSV.Rd deleted file mode 100644 index 8367a1596..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/man/write_RLum2CSV.Rd +++ /dev/null @@ -1,98 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/write_RLum2CSV.R -\name{write_RLum2CSV} -\alias{write_RLum2CSV} -\title{Export RLum-objects to CSV} -\usage{ -write_RLum2CSV( - object, - path = NULL, - prefix = "", - export = TRUE, - compact = TRUE, - ... -) -} -\arguments{ -\item{object}{\linkS4class{RLum} or a \link{list} of \code{RLum} objects (\strong{required}): -objects to be written. Can be a \link{data.frame} if needed internally.} - -\item{path}{\link{character} (\emph{optional}): -character string naming folder for the output to be written. If nothing -is provided \code{path} will be set to the working directory. -\strong{Note:} this argument is ignored if the the argument \code{export} is set to \code{FALSE}.} - -\item{prefix}{\link{character} (\emph{with default}): -optional prefix to name the files. This prefix is valid for all written files} - -\item{export}{\link{logical} (\emph{with default}): -enable or disable the file export. If set to \code{FALSE} nothing is written to -the file connection, but a list comprising objects of type \link{data.frame} and \link{matrix} -is returned instead} - -\item{compact}{\link{logical} (\emph{with default}): if \code{TRUE} (the default) the output will be more -simple but less comprehensive, means not all elements in the objects will be fully broken down. -This is in particular useful for writing \code{RLum.Results} objects to CSV-files, such objects -can be rather complex and not all information are needed in a CSV-file or can be meaningful translated -to it.} - -\item{...}{further arguments that will be passed to the function -\link[utils:write.table]{utils::write.table}. All arguments except the argument \code{file} are supported} -} -\value{ -The function returns either a CSV-file (or many of them) or for the -option \code{export == FALSE} a list comprising objects of type \link{data.frame} and \link{matrix} -} -\description{ -This function exports \linkS4class{RLum}-objects to CSV-files using the R function -\link[utils:write.table]{utils::write.table}. All \linkS4class{RLum}-objects are supported, but the -export is lossy, i.e. the pure numerical values are exported only. Information -that cannot be coerced to a \link{data.frame} or a \link{matrix} are discarded as well as -metadata. -} -\details{ -However, in combination with the implemented import functions, nearly every -supported import data format can be exported to CSV-files, this gives a great -deal of freedom in terms of compatibility with other tools. - -\strong{Input is a list of objects} - -If the input is a \link{list} of objects all explicit function arguments can be provided -as \link{list}. -} -\section{Function version}{ - 0.2.2 -} - -\examples{ - -##transform values to a list (and do not write) -data(ExampleData.BINfileData, envir = environment()) -object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data)[[1]] -write_RLum2CSV(object, export = FALSE) - -\dontrun{ - -##create temporary filepath -##(for usage replace by own path) -temp_file <- tempfile(pattern = "output", fileext = ".csv") - -##write CSV-file to working directory -write_RLum2CSV(temp_file) - -} - -} -\seealso{ -\linkS4class{RLum.Analysis}, \linkS4class{RLum.Data}, \linkS4class{RLum.Results}, -\link[utils:write.table]{utils::write.table} -} -\author{ -Sebastian Kreutzer, Geography & Earth Science, Aberystwyth University (United Kingdom) -, RLum Developer Team} - -\section{How to cite}{ -Kreutzer, S., 2024. write_RLum2CSV(): Export RLum-objects to CSV. Function version 0.2.2. In: Kreutzer, S., Burow, C., Dietze, M., Fuchs, M.C., Schmidt, C., Fischer, M., Friedrich, J., Mercier, N., Philippe, A., Riedesel, S., Autzen, M., Mittelstrass, D., Gray, H.J., Galharret, J., Colombo, M., 2024. Luminescence: Comprehensive Luminescence Dating Data Analysis. R package version 0.9.25. https://r-lum.github.io/Luminescence/ -} - -\keyword{IO} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/Luminescence.so b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/Luminescence.so deleted file mode 100755 index 319af9bbe..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/Luminescence.so and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/Makevars b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/Makevars deleted file mode 100644 index ae7a8ab28..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/Makevars +++ /dev/null @@ -1,2 +0,0 @@ -PKG_CPPFLAGS=-I../inst/include -CXX_STD = CXX17 diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/Makevars.win b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/Makevars.win deleted file mode 100644 index ae7a8ab28..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/Makevars.win +++ /dev/null @@ -1,2 +0,0 @@ -PKG_CPPFLAGS=-I../inst/include -CXX_STD = CXX17 diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/RcppExports.cpp b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/RcppExports.cpp deleted file mode 100644 index dcd2757a7..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/RcppExports.cpp +++ /dev/null @@ -1,82 +0,0 @@ -// Generated by using Rcpp::compileAttributes() -> do not edit by hand -// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 - -#include -#include - -using namespace Rcpp; - -#ifdef RCPP_USE_GLOBAL_ROSTREAM -Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); -Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); -#endif - -// create_UID -CharacterVector create_UID(); -RcppExport SEXP _Luminescence_create_UID() { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - rcpp_result_gen = Rcpp::wrap(create_UID()); - return rcpp_result_gen; -END_RCPP -} -// analyse_IRSARRF_SRS -RcppExport SEXP analyse_IRSARRF_SRS(arma::vec values_regenerated_limited, arma::vec values_natural_limited, arma::vec vslide_range, int n_MC, bool trace); -RcppExport SEXP _Luminescence_analyse_IRSARRF_SRS(SEXP values_regenerated_limitedSEXP, SEXP values_natural_limitedSEXP, SEXP vslide_rangeSEXP, SEXP n_MCSEXP, SEXP traceSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< arma::vec >::type values_regenerated_limited(values_regenerated_limitedSEXP); - Rcpp::traits::input_parameter< arma::vec >::type values_natural_limited(values_natural_limitedSEXP); - Rcpp::traits::input_parameter< arma::vec >::type vslide_range(vslide_rangeSEXP); - Rcpp::traits::input_parameter< int >::type n_MC(n_MCSEXP); - Rcpp::traits::input_parameter< bool >::type trace(traceSEXP); - rcpp_result_gen = Rcpp::wrap(analyse_IRSARRF_SRS(values_regenerated_limited, values_natural_limited, vslide_range, n_MC, trace)); - return rcpp_result_gen; -END_RCPP -} -// create_RLumDataCurve_matrix -NumericMatrix create_RLumDataCurve_matrix(NumericVector DATA, double VERSION, int NPOINTS, String LTYPE, double LOW, double HIGH, double AN_TEMP, int TOLDELAY, int TOLON, int TOLOFF); -RcppExport SEXP _Luminescence_create_RLumDataCurve_matrix(SEXP DATASEXP, SEXP VERSIONSEXP, SEXP NPOINTSSEXP, SEXP LTYPESEXP, SEXP LOWSEXP, SEXP HIGHSEXP, SEXP AN_TEMPSEXP, SEXP TOLDELAYSEXP, SEXP TOLONSEXP, SEXP TOLOFFSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< NumericVector >::type DATA(DATASEXP); - Rcpp::traits::input_parameter< double >::type VERSION(VERSIONSEXP); - Rcpp::traits::input_parameter< int >::type NPOINTS(NPOINTSSEXP); - Rcpp::traits::input_parameter< String >::type LTYPE(LTYPESEXP); - Rcpp::traits::input_parameter< double >::type LOW(LOWSEXP); - Rcpp::traits::input_parameter< double >::type HIGH(HIGHSEXP); - Rcpp::traits::input_parameter< double >::type AN_TEMP(AN_TEMPSEXP); - Rcpp::traits::input_parameter< int >::type TOLDELAY(TOLDELAYSEXP); - Rcpp::traits::input_parameter< int >::type TOLON(TOLONSEXP); - Rcpp::traits::input_parameter< int >::type TOLOFF(TOLOFFSEXP); - rcpp_result_gen = Rcpp::wrap(create_RLumDataCurve_matrix(DATA, VERSION, NPOINTS, LTYPE, LOW, HIGH, AN_TEMP, TOLDELAY, TOLON, TOLOFF)); - return rcpp_result_gen; -END_RCPP -} -// src_get_XSYG_curve_values -NumericMatrix src_get_XSYG_curve_values(std::string s); -RcppExport SEXP _Luminescence_src_get_XSYG_curve_values(SEXP sSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< std::string >::type s(sSEXP); - rcpp_result_gen = Rcpp::wrap(src_get_XSYG_curve_values(s)); - return rcpp_result_gen; -END_RCPP -} - -static const R_CallMethodDef CallEntries[] = { - {"_Luminescence_create_UID", (DL_FUNC) &_Luminescence_create_UID, 0}, - {"_Luminescence_analyse_IRSARRF_SRS", (DL_FUNC) &_Luminescence_analyse_IRSARRF_SRS, 5}, - {"_Luminescence_create_RLumDataCurve_matrix", (DL_FUNC) &_Luminescence_create_RLumDataCurve_matrix, 10}, - {"_Luminescence_src_get_XSYG_curve_values", (DL_FUNC) &_Luminescence_src_get_XSYG_curve_values, 1}, - {NULL, NULL, 0} -}; - -RcppExport void R_init_Luminescence(DllInfo *dll) { - R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); - R_useDynamicSymbols(dll, FALSE); -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/RcppExports.o b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/RcppExports.o deleted file mode 100644 index f13f69b3f..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/RcppExports.o and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/create_UID.cpp b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/create_UID.cpp deleted file mode 100644 index 5784ed572..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/create_UID.cpp +++ /dev/null @@ -1,35 +0,0 @@ -// +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -// Title: create_UID() -// Author: Sebastian Kreutzer, Geography & Earth Science, Aberystwyth University (United Kingdom) -// Contact: sebastian.kreutzer@aber.ac.uk -// Version: 0.1.0 [2016-01-26] -// Purpose: The purpose of this function is to create a unique ID for RLum -// objects based on the system time and a random number. -// +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - -#include -#include - -using namespace Rcpp; - -// [[Rcpp::export("create_UID")]] -CharacterVector create_UID() { - - //define variables - CharacterVector random; - time_t rawtime; - struct tm * timeinfo; - char timestamp [80]; - - //set date + timestamp (code snippet taken from C++ reference page) - time (&rawtime); - timeinfo = localtime (&rawtime); - strftime (timestamp,80,"%Y-%m-%d-%I:%M.",timeinfo); - - //get time information and add a random number - //according to the CRAN policy the standard C-function, rand(), even sufficient here, is not allowed - random = runif(1); - - //combine and return results - return timestamp + Rcpp::as(random); -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/create_UID.o b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/create_UID.o deleted file mode 100644 index e9ff64baa..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/create_UID.o and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/src_analyse_IRSARRF_SRS.cpp b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/src_analyse_IRSARRF_SRS.cpp deleted file mode 100644 index b19359874..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/src_analyse_IRSARRF_SRS.cpp +++ /dev/null @@ -1,186 +0,0 @@ -// +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -// Title: src_analyse_IRSARRF_SRS() -// Author: Sebastian Kreutzer, Geography & Earth Science,Aberystwyth University (United Kingdom) -// Contact: sebastian.kreutzer@aber.ac.uk -// Version: 0.4.0 [2020-08-17] -// Purpose: -// -// Function calculates the squared residuals for the R function analyse_IRSAR.RF() -// including MC runs for the obtained minimum. The function allows a horizontal and -// a vertical sliding of the curve -// +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - -#include -#include - -// [[Rcpp::depends(RcppArmadillo)]] -using namespace Rcpp; - -// [[Rcpp::export("src_analyse_IRSARRF_SRS")]] -RcppExport SEXP analyse_IRSARRF_SRS(arma::vec values_regenerated_limited, - arma::vec values_natural_limited, - arma::vec vslide_range, - int n_MC, - bool trace = false -){ - - //check for the vslide_range() - if(vslide_range.size() > 1e+07){ - stop("[:::src_analyse_IRSAR_SRS()] 'vslide_range' exceeded maximum size (1e+07)!"); - } - - - //pre-define variables - arma::vec residuals(values_natural_limited.size()); - arma::vec results(values_regenerated_limited.size() - values_natural_limited.size()); - arma::vec results_vector_min_MC(n_MC); - - - //variables for the algorithm - int v_length; - int v_index; - arma::vec v_leftright(2); //the virtual vector - arma::vec t_leftright(2); //the test points - arma::vec c_leftright(2); //the calculation - - //(1) calculate sum of the squared residuals - // this will be used to find the best fit of the curves (which is the minimum) - - //initialise values - v_length = vslide_range.size(); - v_index = 0; - - v_leftright[0] = 0; - v_leftright[1] = vslide_range.size() - 1; - - if(v_length == 1){ - t_leftright[0] = 0; - t_leftright[1] = 0; - - }else{ - t_leftright[0] = v_length/3; - t_leftright[1] = 2 * v_length/3; - - } - - //***TRACE**** - if(trace == true){ - Rcout << "\n\n [:::src_analyse_IRSAR_SRS()]"; - Rcout << "\n\n--- Inititalisation --- \n "; - Rcout << "\n >> v_leftright: " << v_leftright; - Rcout << "\n >> t_leftright: " << t_leftright; - Rcout << "\n\n --- Optimisation --- \n "; - Rcout << "\n ---------------------------------------------------------------------------------------------------------"; - Rcout << "\n v_length \t\t v_leftright \t\t c_leftright \t\t\t\t absolute offset"; - Rcout << "\n ---------------------------------------------------------------------------------------------------------"; - - } - - //start loop - do { - - for (int t=0;t(t_leftright.size()); t++){ - - //HORIZONTAL SLIDING CORE -------------------------------------------------------------(start) - //slide the curves against each other - for (int i=0; i(results.size()); ++i){ - - //calculate squared residuals along one curve - for (int j=0; j(values_natural_limited.size()); ++j){ - residuals[j] = pow((values_regenerated_limited[j+i] - (values_natural_limited[j] + vslide_range[t_leftright[t]])),2); - - } - - //sum results and fill the results vector - results[i] = sum(residuals); - - } - - //HORIZONTAL SLIDING CORE ---------------------------------------------------------------(end) - c_leftright[t] = min(results); - - - } - //compare results and re-initialise variables - - if(c_leftright[0] < c_leftright[1]){ - v_index = v_leftright[0]; //set index to left test index - - //update vector window (the left remains the same) - v_leftright[1] = t_leftright[1]; - - //update window length - v_length = v_leftright[1] - v_leftright[0]; - - }else if (c_leftright[0] > c_leftright[1]){ - v_index = v_leftright[1]; //set index to right test index - - //update vector window (the right remains the same this time) - v_leftright[0] = t_leftright[0]; - - //update window length - v_length = v_leftright[1] - v_leftright[0]; - - }else{ - v_length = 1; - - } - - //update test point index - t_leftright[0] = v_leftright[0] + v_length/3; - t_leftright[1] = v_leftright[0] + (2 * (v_length/3)); - - //***TRACE**** - if(trace == true){ - Rcout << "\n " << v_length << " \t\t\t " << v_leftright << " \t\t " << c_leftright << " \t\t\t " << vslide_range[v_index]; - - } - - } while (v_length > 1); - - //***TRACE**** - if(trace == true){ - Rcout << "\n ---------------------------------------------------------------------------------------------------------"; - Rcout << "\n >> SRS minimum: \t\t " << c_leftright[0]; - Rcout << "\n >> Vertical offset index: \t " << v_index + 1; - Rcout << "\n >> Vertical offset absolute: \t " << vslide_range[v_index] << "\n\n"; - - } - - //(2) error calculation - //use this values to bootstrap and find minimum values and to account for the variation - //that may result from this method itself (the minimum lays within a valley of minima) - // - //using the obtained sliding vector and the function RcppArmadillo::sample() (which equals the - //function sample() in R, but faster) - //http://gallery.rcpp.org/articles/using-the-Rcpp-based-sample-implementation - - - //this follows the way described in Frouin et al., 2017 ... still ... - for (int i=0; i(results_vector_min_MC.size()); ++i){ - results_vector_min_MC[i] = min( - RcppArmadillo::sample( - results, - results.size(), - TRUE, - NumericVector::create() - ) - ); - } - - //build list with four elements - //sliding_vector: the original results_vector (this can be used to reproduced the results in R) - //sliding_vector_min_index: the index of the minimum, it is later also calculated in R, however, sometimes we may need it directly - //sliding_vector_min_MC: minimum values based on bootstrapping - //vslide_index: this is the index where the minimum was identified for the vertical sliding - //vslide_minimum: return the identified minimum value, this helps to re-run the function, as the - //algorithm might got trapped in the local minimum - List results_list; - results_list["sliding_vector"] = results; - results_list["sliding_vector_min_index"] = (int)results.index_min() + 1; - results_list["sliding_vector_min_MC"] = results_vector_min_MC; - results_list["vslide_index"] = v_index + 1; - results_list["vslide_minimum"] = c_leftright[0]; //left and right should be similar - - return results_list; -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/src_analyse_IRSARRF_SRS.o b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/src_analyse_IRSARRF_SRS.o deleted file mode 100644 index 7014cb47e..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/src_analyse_IRSARRF_SRS.o and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/src_create_RLumDataCurve_matrix.cpp b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/src_create_RLumDataCurve_matrix.cpp deleted file mode 100644 index b37296d7c..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/src_create_RLumDataCurve_matrix.cpp +++ /dev/null @@ -1,117 +0,0 @@ -// +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -// Title: src_create_RLumDataCurve_matrix() -// Author: Sebastian Kreutzer, Geography & Earth Science,Aberystwyth University (United Kingdom) -// Contact: sebastian.kreutzer@aber.ac.uk -// Version: 0.1.3 [2019-09-19] -// Purpose: Function to create the RLum.Data.Curve() matrix ... faster than in R itself -// - Mainly used by the function Risoe.BINfileData2RLum.Data.Curve() -// +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - -#include -using namespace Rcpp; - -// ----------------------------------------------------------------------------------------------- -// Define own function to create a sequence for the x-axis -// .. but we do not export them to avoid side effects, as this function is not the same as the -// .. base R function seq() -// .. no export -NumericVector seq_RLum(double from, double to, double length_out) { - - //calculate by - double by = (to - from) / length_out; - - //set sequence vector and so set the first channel - NumericVector sequence(static_cast(length_out), (from + by)); - - //loop and create sequence - for (int i=1; i < static_cast(length_out); i++) - sequence[i] = sequence[i-1] + by; - - - return sequence; -} - -// ----------------------------------------------------------------------------------------------- -// The function we want to export -// [[Rcpp::export("src_create_RLumDataCurve_matrix")]] -NumericMatrix create_RLumDataCurve_matrix( - NumericVector DATA, - double VERSION, - int NPOINTS, - String LTYPE, - double LOW, - double HIGH, - double AN_TEMP, - int TOLDELAY, - int TOLON, - int TOLOFF - -){ - - //generate X vectors - if(NPOINTS > 0){ - - //set needed vectors and predefine matrix - NumericVector X(NPOINTS); - NumericMatrix curve_matrix(NPOINTS,2); - - //fill x column for the case we have a TL curve - if(LTYPE == "TL" && VERSION >= 4.0){ - - //provide a fallback for non-conform BIN/BINX-files, otherwise the - //the TL curves are wrong withouth having a reason. - if((TOLON == 0) & (TOLOFF == 0) & (TOLDELAY == 0)){ - Rcout << "[src_create_RLumDataCurve_matrix()] BIN/BINX-file non-conform. TL curve may be wrong!\n"; - TOLOFF = NPOINTS; - } - - //the heating curve consists of three vectors that needed to - //be combined - // - //(A) - the start ramping - NumericVector heat_ramp_start = seq_RLum(LOW,AN_TEMP,static_cast(TOLDELAY)); - // - //(B) - the plateau - //B is simply TOLON - // - //(C) - the end ramping - NumericVector heat_ramp_end = seq_RLum(AN_TEMP, HIGH, static_cast(TOLOFF)); - - //set index counters - int c = 0; - - //fill vector for temperature - for(int i = 0; i < X.length(); i++){ - if(i < heat_ramp_start.length()){ - X[i] = heat_ramp_start[i]; - - }else if(i >= heat_ramp_start.length() && i < heat_ramp_start.length() + static_cast(TOLON)){ - X[i] = AN_TEMP; - - }else if(i >= heat_ramp_start.length() + TOLON){ - X[i] = heat_ramp_end[c]; - c++; - } - } - }else{ - X = seq_RLum(LOW, HIGH, static_cast(NPOINTS)); - } - - //set final matrix - curve_matrix.column(0) = X; - curve_matrix.column(1) = DATA; - - return(curve_matrix); - - }else{ - - //set final matrix for the case NPOINTS <= 0 - //fill this with NA values - NumericMatrix curve_matrix(1,2); - curve_matrix(0,0) = NumericVector::get_na(); - curve_matrix(0,1) = NumericVector::get_na(); - - return(curve_matrix); - - } -} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/src_create_RLumDataCurve_matrix.o b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/src_create_RLumDataCurve_matrix.o deleted file mode 100644 index 9f17ff6f0..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/src_create_RLumDataCurve_matrix.o and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/src_get_XSYG_curve_values.cpp b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/src_get_XSYG_curve_values.cpp deleted file mode 100644 index 115a3e32f..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/src_get_XSYG_curve_values.cpp +++ /dev/null @@ -1,50 +0,0 @@ -// +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -// Title: src_get_XSYG_curve_values() -// Author: Sebastian Kreutzer, Geography & Earth Science,Aberystwyth University (United Kingdom) -// Contact: sebastian.kreutzer@aber.ac.uk -// Version: 0.1.0 [2017-07-07] -// Usage: used within the function read_XSYG2R() to extract curve values more efficiently -// +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - -#include -#include -#include -#include - -using namespace Rcpp; - -// [[Rcpp::export]] -NumericMatrix src_get_XSYG_curve_values(std::string s) { - - //00: count pairs - int pairs = std::count(s.begin(), s.end(), ';') + 1; - - //01: replace all ; by , - std::replace(s.begin(), s.end(), ';', ','); - - //02: set needed matrix - NumericMatrix m(pairs, 2); - - //03: set variables - std::istringstream ss(s); - std::string value; - int i = 0; - int sw = 0; - - //04: loop over string and convert to double - while (std::getline(ss, value, ',')) { - if (sw % 2 == 0){ - m(i,0) = atof(value.c_str()); - - }else{ - m(i,1) = atof(value.c_str()); - i++; - - } - sw++; - - } - return m; - -} - diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/src_get_XSYG_curve_values.o b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/src_get_XSYG_curve_values.o deleted file mode 100644 index 6562cd0af..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/src_get_XSYG_curve_values.o and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/symbols.rds b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/symbols.rds deleted file mode 100644 index c4f0d5145..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/src/symbols.rds and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/spelling.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/spelling.R deleted file mode 100644 index 427bbea71..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/spelling.R +++ /dev/null @@ -1,5 +0,0 @@ -if (requireNamespace('spelling', quietly = TRUE)) - spelling::spell_check_test( - vignettes = TRUE, - error = FALSE, - skip_on_cran = TRUE) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat.R deleted file mode 100644 index b8d60c88a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat.R +++ /dev/null @@ -1,4 +0,0 @@ -library(testthat) -library(Luminescence) - -test_check("Luminescence") diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/_data/BINfile_V3.bin b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/_data/BINfile_V3.bin deleted file mode 100644 index 5602514e9..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/_data/BINfile_V3.bin and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/_data/BINfile_V4.bin b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/_data/BINfile_V4.bin deleted file mode 100644 index 3d5f6c7c7..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/_data/BINfile_V4.bin and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/_data/BINfile_V5.binx b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/_data/BINfile_V5.binx deleted file mode 100644 index cf00747c7..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/_data/BINfile_V5.binx and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/_data/BINfile_V6.binx b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/_data/BINfile_V6.binx deleted file mode 100644 index e22b5d0ad..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/_data/BINfile_V6.binx and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/_data/BINfile_V7.binx b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/_data/BINfile_V7.binx deleted file mode 100644 index f78e0e94d..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/_data/BINfile_V7.binx and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/_data/DRAC_Input_Template.csv b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/_data/DRAC_Input_Template.csv deleted file mode 100644 index 2589336e9..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/_data/DRAC_Input_Template.csv +++ /dev/null @@ -1,13 +0,0 @@ -DRAC v.1.2 Inputs,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, -,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, -Full details of the inputs required for a DRAC dose rate calculation and the calculation process can be found in the paper and the DRAC website (www.aber.ac.uk/alrl/drac).,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, -,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, -"Please cite all uses of DRAC, including the version number, as Durcan, J.A., King, G.E., and Duller, G.A.T., 2015. DRAC: Dose rate and age calculator for trapped charge dating. Quaternary Geochronology, 28, 54-61. Corresponding authors: Julie Durcan (julie.durcan@ouce.ox.ac.uk) and Georgina King (georgina.king@uni-koeln.de).",,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, -,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, -"To calculate dose rates using DRAC, the data table below (excluding headers) can be copied and pasted into the calculator box on the DRAC website (www.aber.ac.uk/alrl/DRAC). Once 'calculate' has been clicked, DRAC will generate an output file, which can be saved by the user.",,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, -,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, -TI:1,TI:2,TI:3,TI:4,TI:5,TI:6,TI:7,TI:8,TI:9,TI:10,TI:11,TI:12,TI:13,TI:14,TI:15,TI:16,TI:17,TI:18,TI:19,TI:20,TI:21,TI:22,TI:23,TI:24,TI:25,TI:26,TI:27,TI:28,TI:29,TI:30,TI:31,TI:32,TI:33,TI:34,TI:35,TI:36,TI:37,TI:38,TI:39,TI:40,TI:41,TI:42,TI:43,TI:44,TI:45,TI:46,TI:47,TI:48,TI:49,TI:50,TI:51,TI:52,TI:53 -Project ID,Sample ID,Mineral,Conversion factors,ExternalU (ppm),errExternal U (ppm),External Th (ppm),errExternal Th (ppm),External K (%),errExternal K (%),External Rb (ppm),errExternal Rb (ppm),Calculate external Rb from K conc?,Internal U (ppm),errInternal U (ppm),Internal Th (ppm),errInternal Th (ppm),Internal K (%),errInternal K (%),Internal Rb (ppm),errInternal Rb (ppm),Calculate internal Rb from K conc?,User external alphadoserate (Gy.ka-1),errUser external alphadoserate (Gy.ka-1),User external betadoserate (Gy.ka-1),errUser external betadoserate (Gy.ka-1),User external gamma doserate (Gy.ka-1),errUser external gammadoserate (Gy.ka-1),User internal doserate (Gy.ka-1),errUser internal doserate (Gy.ka-1),Scale gammadoserate at shallow depths?,Grain size min (microns),Grain size max (microns),alpha-Grain size attenuation,beta-Grain size attenuation ,Etch depth min (microns),Etch depth max (microns),beta-Etch depth attenuation factor,a-value,erra-value,Water content ((wet weight - dry weight)/dry weight) %,errWater content %,Depth (m),errDepth (m),Overburden density (g cm-3),errOverburden density (g cm-3),Latitude (decimal degrees),Longitude (decimal degrees),Altitude (m),User cosmicdoserate (Gy.ka-1),errUser cosmicdoserate (Gy.ka-1),De (Gy),errDe (Gy) -DRAC-example,Quartz,Q,Guerinetal2011,3.40,0.51,14.47,1.69,1.20,0.14,0.00,0.00,N,X,X,X,X,X,X,X,X,X,X,X,X,X,X,X,X,X,N,90.00,125.00,Brennanetal1991,Guerinetal2012-Q,8.00,10.00,Bell1979,0.00,0.000,5.00,2.00,2.22,0.05,1.80,0.10,30.00,70.00,150.00,X,X,20.00,0.20 -DRAC-example,Feldspar,F,AdamiecAitken1998,2.00,0.20,8.00,0.40,1.75,0.05,0.00,0.00,Y,X,X,X,X,12.50,0.50,X,X,N,X,X,X,X,X,X,X,X,Y,180.00,212.00,Bell1980,Mejdahl1979,0.00,0.00,Bell1979,0.15,0.050,10.00,3.00,0.15,0.02,1.80,0.10,60.00,100.00,200.00,X,X,15.00,1.50 -DRAC-example,Polymineral,PM,AdamiecAitken1998,4.00,0.40,12.00,0.12,0.83,0.08,0.00,0.00,Y,X,X,X,X,12.50,0.50,X,X,N,X,X,2.50,0.15,X,X,X,X,Y,4.00,11.00,Bell1980,Mejdahl1979,0.00,0.00,Bell1979,0.086,0.0038,10.00,5.00,0.20,0.02,1.80,0.10,46.00,118.00,200.00,0.20,0.10,204.47,2.69 diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/_data/SPEfile.SPE b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/_data/SPEfile.SPE deleted file mode 100755 index a384fd5ea..000000000 Binary files a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/_data/SPEfile.SPE and /dev/null differ diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_Analyse_SAROSLdata.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_Analyse_SAROSLdata.R deleted file mode 100644 index 7ea13798a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_Analyse_SAROSLdata.R +++ /dev/null @@ -1,38 +0,0 @@ -test_that("full example test", { - testthat::skip_on_cran() - - data(ExampleData.BINfileData, envir = environment()) - output <- Analyse_SAR.OSLdata(input.data = CWOSL.SAR.Data, - signal.integral = c(1:5), - background.integral = c(900:1000), - position = c(1:1), - output.plot = FALSE) - - ##checks - expect_type(output, "list") - expect_length(output, 3) - - ## errors - expect_error({ Analyse_SAR.OSLdata() }, - regexp = "No input data given") - expect_error({ Analyse_SAR.OSLdata(input.data = CWOSL.SAR.Data) }, - regexp = "No signal integral is given") - expect_error({ Analyse_SAR.OSLdata(input.data = CWOSL.SAR.Data, signal.integral = 1:3) }, - regexp = "No background integral is given") - expect_error({ Analyse_SAR.OSLdata(input.data = subset(CWOSL.SAR.Data, LTYPE == "IRSL"), - signal.integral = 1:3, - background.integral = 200:250) }, - regexp = "No 'OSL' curves found") - - ## should work - SW({ - expect_type(Analyse_SAR.OSLdata(input.data = CWOSL.SAR.Data, signal.integral = 1:3, - background.integral = 200:250, position = 1, - background.count.distribution = "non-poisson", - sigmab = 0.1, output.plot = TRUE), "list") - tmp <- subset(CWOSL.SAR.Data, LTYPE == "OSL" & POSITION == 1 & ID <= 457) - expect_type( - Analyse_SAR.OSLdata(tmp, 1:3, 200:250, output.plot = TRUE, output.plot.single = TRUE), - "list") - }) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_CW2pX.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_CW2pX.R deleted file mode 100644 index 4f6715048..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_CW2pX.R +++ /dev/null @@ -1,70 +0,0 @@ -##load data -data(ExampleData.CW_OSL_Curve, envir = environment()) -values <- CW_Curve.BosWallinga2012 - -test_that("Check the example and the numerical values", { - testthat::skip_on_cran() - - values_pLM <- CW2pLM(values) - values_pLMi <- CW2pLMi(values, P = 1/20) - values_pLMi_alt <- CW2pLMi(values) - values_pHMi <- suppressWarnings(CW2pHMi(values, delta = 40)) - values_pHMi_alt <- suppressWarnings(CW2pHMi(values)) - values_pHMi_alt1 <- suppressWarnings(CW2pHMi(values, delta = 2)) - values_pPMi <- suppressWarnings(CW2pPMi(values, P = 1/10)) - - ##check conversion sum values - expect_equal(round(sum(values_pLM), digits = 0),90089) - expect_equal(round(sum(values_pLMi[,1:2]), digits = 0),197522) - expect_equal(round(sum(values_pLMi_alt[,1:2]), digits = 0),197522) - expect_equal(round(sum(values_pHMi[,1:2]), digits = 0),217431) - expect_equal(round(sum(values_pHMi_alt[,1:2]), digits = 0),217519) - expect_equal(round(sum(values_pHMi_alt1[,1:2]), digits = 0), 221083) - expect_equal(round(sum(values_pPMi[,1:2]), digits = 0),196150) - - -}) - -test_that("Test RLum.Types", { - testthat::skip_on_cran() - - ##load CW-OSL curve data - data(ExampleData.CW_OSL_Curve, envir = environment()) - object <- - set_RLum( - class = "RLum.Data.Curve", - data = as.matrix(ExampleData.CW_OSL_Curve), - curveType = "measured", - recordType = "OSL" - ) - - - ##transform values - expect_s4_class(CW2pLM(object), class = "RLum.Data.Curve") - expect_s4_class(CW2pLMi(object), class = "RLum.Data.Curve") - expect_s4_class(CW2pHMi(object), class = "RLum.Data.Curve") - expect_s4_class(suppressWarnings(CW2pPMi(object)), class = "RLum.Data.Curve") - - ##test error handling - expect_error(CW2pLMi(values, P = 0), regexp = "[CW2pLMi] P has to be > 0!", fixed = TRUE) - expect_warning(CW2pLMi(values, P = 10)) - expect_error(object = CW2pLM(values = matrix(0, 2))) - expect_error(object = CW2pLMi(values = matrix(0, 2))) - expect_error(object = CW2pHMi(values = matrix(0, 2))) - expect_error(object = CW2pPMi(values = matrix(0, 2))) - - object@recordType <- "RF" - expect_error(CW2pLM(values = object), - "recordType RF is not allowed for the transformation") - expect_error(object = CW2pLMi(values = object), - regexp = "[CW2pLMi()] recordType RF is not allowed for the transformation!", - fixed = TRUE) - expect_error(object = CW2pHMi(values = object), - regexp = "[CW2pHMi()] recordType RF is not allowed for the transformation!", - fixed = TRUE) - expect_error(object = CW2pPMi(values = object), - regexp = "[CW2pPMi()] recordType RF is not allowed for the transformation!", - fixed = TRUE) - - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_PSL2RisoeBINfiledata.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_PSL2RisoeBINfiledata.R deleted file mode 100644 index bc495afd3..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_PSL2RisoeBINfiledata.R +++ /dev/null @@ -1,27 +0,0 @@ -test_that("simple test", { - testthat::skip_on_cran() - - data("ExampleData.portableOSL", envir = environment()) - merged <- merge_RLum(ExampleData.portableOSL) - bin <- PSL2Risoe.BINfileData(merged) - - ##checks - expect_s4_class(bin, "Risoe.BINfileData") - expect_equal(length(bin), 70) - - ## input validation - expect_error(PSL2Risoe.BINfileData("wrong-class"), - "Only objects of class 'RLum.Analysis' are allowed") - - ## manipulate the object to trigger other errors - fake <- merged - fake@records[20] <- "unexpected-subclass" - expect_error(PSL2Risoe.BINfileData(fake), - "must only contain objects of class 'RLum.Data.Curve'") - - fake <- merged - fake@records[10][[1]]@originator <- "unexpected-originator" - expect_error(PSL2Risoe.BINfileData(fake), - "Only objects originating from 'read_PSL2R()' are allowed", - fixed=TRUE) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_RLum.Analysis-class.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_RLum.Analysis-class.R deleted file mode 100644 index 723311b5d..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_RLum.Analysis-class.R +++ /dev/null @@ -1,184 +0,0 @@ -data(ExampleData.RLum.Analysis, envir = environment()) -obj <- IRSAR.RF.Data - -##construct empty object -tmp <- set_RLum( - "RLum.Analysis", - protocol = "testthat", - records = lapply(1:20, function(x) { - set_RLum( - "RLum.Data.Curve", - recordType = "test", - data = matrix(1:10, ncol = 2), - info = list(el = as.character(x)) - ) - }), - info = list(el = "test") -) - -test_that("Check the example and the numerical values", { - testthat::skip_on_cran() - - ## set_RLum() - expect_s4_class(tmp, "RLum.Analysis") - - ##overwrite object - expect_s4_class(set_RLum("RLum.Analysis", records = tmp), "RLum.Analysis") - - ## as() - expect_type(as(tmp, "list"), "list") - expect_s4_class(as(list(), "RLum.Analysis"), "RLum.Analysis") - - ## output - expect_output(print(as(list(), "RLum.Analysis")), regexp = "This is an empty object") - expect_s4_class( - set_RLum( - "RLum.Analysis", - protocol = "testthat", - records = set_RLum( - "RLum.Analysis", - protocol = "nest", - records = list(matrix(1:10, ncol = 2)) - ), - info = list(el = "test") - ), - "RLum.Analysis" - ) - - ## show() - expect_output(print(tmp)) - - ## names() - expect_type(names(tmp), "character") -}) - -test_that("get_RLum", { - testthat::skip_on_cran() - - ## input validation - expect_error(get_RLum(obj, subset = "error"), - "[get_RLum()] 'subset' must contain a logical expression", - fixed = TRUE) - expect_error(get_RLum(obj, subset = (error == "OSL")), - "[get_RLum()] Invalid subset expression, valid terms are:", - fixed = TRUE) - expect_error(get_RLum(tmp, record.id = "character"), - "'record.id' has to be of type 'numeric' or 'logical'") - expect_error(get_RLum(tmp, recordType = 1L), - "'recordType' has to be of type 'character'") - expect_error(get_RLum(tmp, curveType = 1L), - "'curveType' has to be of type 'character'") - expect_error(get_RLum(tmp, RLum.type = 1L), - "'RLum.type' has to be of type 'character'") - expect_error(get_RLum(tmp, get.index = "a"), - "'get.index' has to be of type 'logical'") - - ## check functionality - expect_length(get_RLum(obj, subset = (recordType == "RF")), 2) - expect_length(get_RLum(tmp, subset = (el == "2")), 1) - expect_s4_class(get_RLum(tmp, subset = (el == "2")), "RLum.Analysis") - expect_type(get_RLum(tmp, info.object = "el"), "character") - - expect_type(get_RLum(obj, get.index = FALSE), "list") - expect_type(get_RLum(obj, get.index = NULL), "list") - expect_type(get_RLum(obj, get.index = TRUE), "integer") - expect_s4_class(get_RLum(obj, get.index = FALSE, drop = FALSE), - "RLum.Analysis") - expect_type(get_RLum(obj, get.index = TRUE, drop = FALSE), - "integer") - expect_type(get_RLum(tmp, record.id = c(3, 5), get.index = FALSE), - "list") - - expect_s4_class(get_RLum(obj, record.id = 1), - "RLum.Data.Curve") - expect_s4_class(get_RLum(obj, record.id = 1, drop = FALSE), - "RLum.Analysis") - expect_type(get_RLum(obj, record.id = 1, get.index = TRUE), - "integer") - expect_message(expect_null(get_RLum(obj, record.id = 99)), - "[get_RLum()] Error: At least one 'record.id' is invalid", - fixed = TRUE) - - expect_warning(get_RLum(tmp, info.object = "missing"), - "[get_RLum()] Invalid 'info.object' name, valid names are:", - fixed = TRUE) - expect_warning(expect_null(get_RLum(set_RLum("RLum.Analysis"), - info = "test")), - "[get_RLum()] This 'RLum.Analysis' object has no info objects", - fixed = TRUE) - SW({ - expect_message(expect_null(get_RLum(obj, subset = (recordType == "error"))), - "'subset' expression produced an empty selection, NULL returned") - }) -}) - -test_that("structure_RLum", { - testthat::skip_on_cran() - - ## input validation - expect_error(structure_RLum( - set_RLum("RLum.Analysis", - records = list(set_RLum("RLum.Data.Image")))), - "Only 'RLum.Data.Curve' objects are allowed") - - ## full functionality - - ## object with empty info - expect_s3_class(res <- structure_RLum(obj), - "data.frame") - expect_equal(nrow(res), length(obj@records)) - expect_equal(ncol(res), 13) - expect_equal(res$n.channels, c(5, 524)) - expect_equal(res$recordType, c("RF", "RF")) - expect_equal(res$info, c(NA, NA)) - - expect_s3_class(res2 <- structure_RLum(obj, fullExtent = TRUE), - "data.frame") - expect_equal(names(res2), names(res)) - expect_equal(res2$info, c(NA, NA)) - - ## object with some info - data(ExampleData.BINfileData, envir = environment()) - d1 <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = 1) - res <- structure_RLum(d1) - expect_equal(nrow(res), length(d1@records)) - expect_equal(ncol(res), 13) - - res2 <- structure_RLum(d1, fullExtent = TRUE) - expect_equal(nrow(res2), length(d1@records)) - expect_equal(ncol(res2), 12 + length(d1@records[[1]]@info)) - expect_null(res2$info) - expect_equal(names(res2)[-c(1:12)], - paste0("info.", names(d1@records[[1]]@info))) - - ## on an empty object with some info - res <- structure_RLum(tmp) - expect_equal(nrow(res), length(tmp@records)) - expect_equal(ncol(res), 13) - expect_equal(res$n.channels, rep(5, 20)) - - res2 <- structure_RLum(tmp, fullExtent = TRUE) - expect_equal(nrow(res2), length(tmp@records)) - expect_equal(ncol(res2), 12 + length(tmp@records[[1]]@info)) - expect_null(res2$info) ## since @info contains only one - expect_equal(names(res2)[-c(1:12)], ## element named `el`, the last - names(tmp@records[[1]]@info)) ## column in res2 is also named - expect_equal(res2$el, as.character(1:20)) ## `el` rather than `info.el` - - ## on an even emptier object empty info - empty <- set_RLum("RLum.Analysis", - records = list(set_RLum("RLum.Data.Curve"))) - - expect_s3_class(res <- structure_RLum(empty), - "data.frame") - expect_equal(nrow(res), length(empty@records)) - expect_equal(ncol(res), 13) - expect_equal(res$n.channels, 1) - expect_equal(res$info, NA) - - res2 <- structure_RLum(empty, fullExtent = TRUE) - expect_equal(nrow(res2), length(empty@records)) - expect_equal(ncol(res2), 13) - expect_equal(names(res2), names(res)) - expect_equal(res2$info, NA) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_RLum.Data.Curve.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_RLum.Data.Curve.R deleted file mode 100644 index f1fdddc52..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_RLum.Data.Curve.R +++ /dev/null @@ -1,26 +0,0 @@ -test_that("check class", { - testthat::skip_on_cran() - - ##set empty curve object and show it - expect_output(show(set_RLum(class = "RLum.Data.Curve"))) - - ##check replacements fo - object <- set_RLum(class = "RLum.Data.Curve") - expect_s4_class(set_RLum(class = "RLum.Data.Curve", data = object), class = "RLum.Data.Curve") - - ##check get_RLum - object <- set_RLum(class = "RLum.Data.Curve", data = object, info = list(a = "test")) - expect_warning(get_RLum(object, info.object = "est"), regexp = "Invalid info.object name") - - ##test names - expect_type(names(object), "character") - - ##test bin - expect_warning(bin_RLum.Data(object, bin_size = -2), "Argument 'bin_size' invalid, nothing was done!") - - ##check conversions - expect_s4_class(as(object = list(1:10), Class = "RLum.Data.Curve"), "RLum.Data.Curve") - expect_type(as(object = object, Class = "list"), "list") - expect_s4_class(as(object = matrix(1:10,ncol = 2), Class = "RLum.Data.Curve"), "RLum.Data.Curve") - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_RLum.Data.Image.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_RLum.Data.Image.R deleted file mode 100644 index c8eea3de5..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_RLum.Data.Image.R +++ /dev/null @@ -1,49 +0,0 @@ -test_that("check class ", { - testthat::skip_on_cran() - - ##load example data - data(ExampleData.RLum.Data.Image, envir = environment()) - - ##set-method - ##set empty class - expect_s4_class(set_RLum(class = "RLum.Data.Image"), "RLum.Data.Image") - - ##overwrite only data - expect_s4_class(set_RLum(class = "RLum.Data.Image", data = set_RLum("RLum.Data.Image")), "RLum.Data.Image") - - ##show-method - ##show example data - expect_output(show(ExampleData.RLum.Data.Image)) - - ##get-method - expect_error(get_RLum(ExampleData.RLum.Data.Image, info.object = 1), regexp = "'info.object' has to be a character!") - expect_error(get_RLum(ExampleData.RLum.Data.Image, info.object = "unknown")) - expect_type(get_RLum(ExampleData.RLum.Data.Image, info.object = "NumFrames"), "integer") - - ##names - expect_type(names_RLum(ExampleData.RLum.Data.Image), "character") - - ##conversions - ##from matrix and to matrix - expect_s4_class(as(matrix(1:10, ncol = 2), "RLum.Data.Image"), "RLum.Data.Image") - expect_type(as(ExampleData.RLum.Data.Image, "matrix"), "integer") - - ##from data.frame and to data.frame - df <- as.data.frame(as(ExampleData.RLum.Data.Image, "matrix")) - expect_s4_class(as(df, "RLum.Data.Image"), "RLum.Data.Image") - expect_s3_class(as(ExampleData.RLum.Data.Image, "data.frame"), "data.frame") - - ## to and from array - expect_type(as(ExampleData.RLum.Data.Image, "array"), "integer") - from_array <- expect_s4_class(as(array(1,dim = c(10,10,2)), "RLum.Data.Image"), "RLum.Data.Image") - - ## to and from list - expect_s4_class(as(list(matrix(1, nrow = 10, ncol = 5), matrix(1, nrow = 10, ncol = 5)), "RLum.Data.Image"), - "RLum.Data.Image") - expect_type(as(ExampleData.RLum.Data.Image, "list"), "list") - - ## check edge cases - expect_error(as(from_array, "matrix"), "No viable coercion to matrix, object contains multiple frames. Please convert to array instead.") - expect_error(as(from_array, "data.frame"), "No viable coercion to data.frame, object contains multiple frames.") - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_RLum.Data.Spectrum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_RLum.Data.Spectrum.R deleted file mode 100644 index b92cc077e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_RLum.Data.Spectrum.R +++ /dev/null @@ -1,35 +0,0 @@ -test_that("check class", { - testthat::skip_on_cran() - - ##set empty spectrum object and show it - expect_output(show(set_RLum(class = "RLum.Data.Spectrum"))) - - ##check replacements - object <- set_RLum(class = "RLum.Data.Spectrum") - expect_s4_class(set_RLum(class = "RLum.Data.Spectrum", data = object), class = "RLum.Data.Spectrum") - - ##check get_RLum - object <- set_RLum(class = "RLum.Data.Spectrum", data = object, info = list(a = "test")) - expect_error(get_RLum(object, info.object = "est"), regexp = "Invalid element name. Valid names are: a") - expect_error(get_RLum(object, info.object = 1L), "'info.object' has to be a character!") - expect_type(get_RLum(object, info.object = "a"), "character") - - ##test method names - expect_type(names(object), "character") - - ##test bin_RLum() - expect_error(bin_RLum.Data(object, bin_size.col = "test"), - "'bin_size.row' and 'bin_size.col' must be of class 'numeric'!") - object@data <- matrix(data = rep(1:20, each = 10), ncol = 20) - rownames(object@data) <- 1:10 - colnames(object@data) <- 1:20 - expect_s4_class(object = bin_RLum.Data(object, bin_size.row = 2), "RLum.Data.Spectrum") - - expect_s4_class(object = bin_RLum.Data(object, bin_size.row = 1, bin_size.col = 2), "RLum.Data.Spectrum") - - ##check conversions - expect_s4_class(as(object = data.frame(x = 1:10), Class = "RLum.Data.Spectrum"), "RLum.Data.Spectrum") - expect_s3_class(as(set_RLum("RLum.Data.Spectrum"), "data.frame"), "data.frame") - expect_s4_class(as(object = matrix(1:10,ncol = 2), Class = "RLum.Data.Spectrum"), "RLum.Data.Spectrum") - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_RLum.Results-class.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_RLum.Results-class.R deleted file mode 100644 index f1ef3f265..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_RLum.Results-class.R +++ /dev/null @@ -1,59 +0,0 @@ -data(ExampleData.DeValues, envir = environment()) -obj <- calc_FuchsLang2001(ExampleData.DeValues$BT998, cvThreshold = 5, - plot = FALSE, verbose = FALSE) -empty <- set_RLum("RLum.Results") - -test_that("check class", { - testthat::skip_on_cran() - - ## set_RLum() - expect_s4_class(obj, "RLum.Results") - - ## as() - expect_type(as(obj, "list"), - "list") - expect_s4_class(as(list(), "RLum.Results"), - "RLum.Results") - - ## show() - expect_output(show(obj)) - expect_output(show(empty)) - - ## names() - expect_equal(names_RLum(obj), - c("summary", "data", "args", "usedDeValues")) -}) - -test_that("get_RLum", { - testthat::skip_on_cran() - - ## input validation - expect_error(get_RLum(obj, "error"), - "unknown 'data.object', valid names are:") - expect_error(get_RLum(obj, FALSE), - "'data.object' has to be of type character or numeric") - expect_error(get_RLum(obj, 100), - "'data.object' index out of bounds") - expect_warning(expect_null(get_RLum(obj, info.object = "error")), - "[get_RLum()] Invalid 'info.object' name, valid names are:", - fixed = TRUE) - expect_warning(expect_null(get_RLum(empty, info.object = "error")), - "[get_RLum()] This 'RLum.Results' object has no info objects", - fixed = TRUE) - - ## full functionality - expect_s3_class(get_RLum(obj), - "data.frame") - expect_s3_class(get_RLum(obj, data.object = 2), - "data.frame") - expect_s3_class(get_RLum(obj, data.object = c(1, 2)), - "data.frame") - expect_s3_class(get_RLum(obj, data.object = "summary"), - "data.frame") - expect_s3_class(get_RLum(obj, data.object = c("summary", "data")), - "data.frame") - expect_s4_class(get_RLum(obj, data.object = c("summary", "data"), drop = FALSE), - "RLum.Results") - expect_type(get_RLum(obj, info.object = "call"), - "list") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_Risoe.BINfileData2RLum.Analysis.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_Risoe.BINfileData2RLum.Analysis.R deleted file mode 100644 index 130a0b9ea..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_Risoe.BINfileData2RLum.Analysis.R +++ /dev/null @@ -1,66 +0,0 @@ -data(ExampleData.BINfileData, envir = environment()) - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(Risoe.BINfileData2RLum.Analysis("test"), - "Input object is not of type 'Risoe.BINfileData") - expect_error(Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = "test"), - "'pos' has to be of type numeric") - expect_error(Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, run = 10:12), - "run = 10,11,12 contains invalid runs") - expect_error(Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, set = 10:12), - "set = 10,11,12 contains invalid sets") - expect_error(Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, ltype = 10:12), - "ltype = 10,11,12 contains invalid ltypes") - expect_error(Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, dtype = 10:12), - "dtype = 10,11,12 contains invalid dtypes") - - expect_warning(Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = 1:30), - "Invalid position number skipped") - expect_warning(Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, grain = 1:10), - "Invalid grain number skipped") -}) - -test_that("check functionality", { - testthat::skip_on_cran() - - SW({ - res <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, - txtProgressBar = TRUE) - }) - expect_type(res, "list") - expect_length(res, 24) - - SW({ - res <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = 1:3, - txtProgressBar = TRUE) - }) - expect_type(res, "list") - expect_length(res, 3) - - res <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = 1, - txtProgressBar = TRUE) - expect_s4_class(res, "RLum.Analysis") - - ## FI readers like to write a NA instead of 0 in the grain column - obj <- CWOSL.SAR.Data - obj@METADATA[["GRAIN"]] <- rep(NA, length(obj@METADATA[["GRAIN"]])) - res <- Risoe.BINfileData2RLum.Analysis(obj, pos = 1) - expect_s4_class(res, "RLum.Analysis") - - ## reading an empty object - zero <- read_BIN2R(test_path("_data/BINfile_V3.bin"), n.records = 999, - verbose = FALSE) - expect_message(res <- Risoe.BINfileData2RLum.Analysis(zero), - "Empty Risoe.BINfileData object detected") - expect_s4_class(res, "RLum.Analysis") - expect_length(res, 0) - expect_message(res <- Risoe.BINfileData2RLum.Analysis(zero, pos = 0), - "Empty Risoe.BINfileData object detected") - expect_s4_class(res, "RLum.Analysis") - expect_length(res, 0) - expect_message(expect_null( - Risoe.BINfileData2RLum.Analysis(zero, keep.empty = FALSE)), - "Empty Risoe.BINfileData object detected") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_Risoe.BINfileData2RLum.Data.Curve.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_Risoe.BINfileData2RLum.Data.Curve.R deleted file mode 100644 index 082d79c92..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_Risoe.BINfileData2RLum.Data.Curve.R +++ /dev/null @@ -1,18 +0,0 @@ -test_that("check functionality", { - testthat::skip_on_cran() - - data(ExampleData.BINfileData, envir = environment()) - - res <- .Risoe.BINfileData2RLum.Data.Curve(CWOSL.SAR.Data, id = 1) - expect_s4_class(res, "RLum.Data.Curve") - expect_length(res@data, 500) - expect_length(res@info, 44) - expect_equal(res@originator, ".Risoe.BINfileData2RLum.Data.Curve") - - res1 <- .Risoe.BINfileData2RLum.Data.Curve(CWOSL.SAR.Data, - pos = 1, set = 2, run = 1) - expect_s4_class(res1, "RLum.Data.Curve") - expect_equal(res1@data, res@data) - expect_equal(res1@info, res@info) - expect_equal(res1@originator, res@originator) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_RisoeBINfileData-class.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_RisoeBINfileData-class.R deleted file mode 100644 index db7b3887e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_RisoeBINfileData-class.R +++ /dev/null @@ -1,37 +0,0 @@ -test_that("Check the example and the numerical values", { - testthat::skip_on_cran() - - ##construct empty object - temp <- - set_Risoe.BINfileData(METADATA = data.frame(), DATA = list(), .RESERVED = list()) - - ##get function and check whether we get NULL - expect_output(expect_null( - get_Risoe.BINfileData(temp)), - "No direct access is provided for this object type.") - - ##check object - expect_s4_class(temp, class = "Risoe.BINfileData") - expect_output(show(temp), - "This object is empty!") - - ##show method - data(ExampleData.BINfileData, envir = environment()) - expect_output(show(CWOSL.SAR.Data)) - - ##as.data.frame - expect_s3_class(as.data.frame(CWOSL.SAR.Data), "data.frame") - - ## metadata provided - meta <- data.frame(ID = 1, VERSION = 7, RECTYPE = 128) - temp <- set_Risoe.BINfileData(METADATA = meta, DATA = list(), - .RESERVED = list()) - expect_equal(temp@METADATA, meta) - expect_output(show(temp)) - - meta$RECTYPE <- NULL - temp <- set_Risoe.BINfileData(METADATA = meta, DATA = list(), - .RESERVED = list()) - expect_equal(temp@METADATA, meta) - expect_output(show(temp)) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_Second2Gray.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_Second2Gray.R deleted file mode 100644 index 826b2a1ab..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_Second2Gray.R +++ /dev/null @@ -1,42 +0,0 @@ -data(ExampleData.DeValues, envir = environment()) -results <- Second2Gray(ExampleData.DeValues$BT998, c(0.2,0.01)) -results_alt1 <- Second2Gray(ExampleData.DeValues$BT998, c(0.2,0.01), error.propagation = "gaussian") -results_alt2 <- Second2Gray(ExampleData.DeValues$BT998, c(0.2,0.01), error.propagation = "absolute") -dose.rate <- calc_SourceDoseRate(calib.date = "2014-12-19", - calib.dose.rate = 0.2, calib.error = 0.01) -results_alt3 <- Second2Gray(ExampleData.DeValues$BT998, dose.rate = dose.rate) - -Second2Gray(ExampleData.DeValues$BT998, results, error.prop = "gaussian") -Second2Gray(ExampleData.DeValues$BT998, results, error.prop = "absolute") - - -test_that("check class and length of output", { - testthat::skip_on_cran() - - expect_s3_class(results, class = "data.frame") - - expect_error(Second2Gray("test"), - "'data' object has to be of type 'data.frame'") - expect_error(Second2Gray(ExampleData.DeValues$BT998, dose.rate = FALSE), - "'dose.rate' object has to be of type") - expect_error(Second2Gray(ExampleData.DeValues$BT998, - dose.rate = results[1:5, ]), - "'data' and 'dose.rate' need to be of similar length") - expect_error(Second2Gray(ExampleData.DeValues$BT998, - dose.rate = results, - error.propagation = "test"), - "unsupported error propagation method") - dose.rate@originator <- "unexpected-originator" - expect_error(Second2Gray(ExampleData.DeValues$BT998, dose.rate = dose.rate), - "Wrong originator for dose.rate 'RLum.Results' object") -}) - -test_that("check values from output example", { - testthat::skip_on_cran() - - expect_equal(sum(results[[1]]), 14754.09) - expect_equal(sum(results[[2]]), 507.692) - expect_equal(sum(results_alt1[[2]]), 895.911) - expect_equal(sum(results_alt2[[2]]), 1245.398) - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_Al2O3C_CrossTalk.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_Al2O3C_CrossTalk.R deleted file mode 100644 index 0cf8170d8..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_Al2O3C_CrossTalk.R +++ /dev/null @@ -1,43 +0,0 @@ -test_that("Full check", { - skip_on_cran() - - ##load data - data(ExampleData.Al2O3C, envir = environment()) - - ## run analysis - expect_s4_class(analyse_Al2O3C_CrossTalk(data_CrossTalk), "RLum.Results") - res <- expect_s4_class( - analyse_Al2O3C_CrossTalk(data_CrossTalk, - method_control = list(fit.method = "LIN")), - "RLum.Results") - - ## input validation - expect_error(analyse_Al2O3C_CrossTalk("test"), - "The elements in 'object' are not all of type 'RLum.Analysis'") - expect_error(analyse_Al2O3C_CrossTalk(data_CrossTalk, - method_control = "EXP"), - "'method_control' is expected to be a list") - expect_error(analyse_Al2O3C_CrossTalk(data_CrossTalk, - irradiation_time_correction = FALSE), - "'irradiation_time_correction' is expected to be") - expect_error(analyse_Al2O3C_CrossTalk(data_CrossTalk, - irradiation_time_correction = res), - "was created by an unsupported function") - expect_warning(analyse_Al2O3C_CrossTalk(data_CrossTalk, - signal_integral = 0), - "Input for 'signal_integral' corrected to") - - ## irradiation_time_correction - SW({ - corr <- analyse_Al2O3C_ITC(data_ITC) - }) - expect_s4_class( - analyse_Al2O3C_CrossTalk(data_CrossTalk, - irradiation_time_correction = corr), - "RLum.Results") - corr@data$data <- rbind(corr@data$data, corr@data$data) - expect_s4_class( - analyse_Al2O3C_CrossTalk(data_CrossTalk, - irradiation_time_correction = corr), - "RLum.Results") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_Al2O3C_ITC.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_Al2O3C_ITC.R deleted file mode 100644 index ec12fcf08..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_Al2O3C_ITC.R +++ /dev/null @@ -1,40 +0,0 @@ -##load data -data(ExampleData.Al2O3C, envir = environment()) - -test_that("input validation", { - skip_on_cran() - - a <- set_RLum(class = "RLum.Data.Curve", recordType = "OSL", - data = matrix(1:20, ncol = 2)) - b <- set_RLum(class = "RLum.Data.Curve", recordType = "TL") - object <- set_RLum(class = "RLum.Analysis", records = list(a,b)) - - expect_error(analyse_Al2O3C_ITC("test"), - "'object' must be of type 'RLum.Analysis'") - expect_error(analyse_Al2O3C_ITC(list(data_ITC, "test")), - "All elements in the 'object' list must be of type 'RLum.Analysis'") - expect_error(analyse_Al2O3C_ITC(data_ITC, method_control = "EXP"), - "'method_control' is expected to be a list") -# expect_error(analyse_Al2O3C_ITC(data_ITC, dose_points = list(NA)), -# "At least three regeneration points are required") XXX! - - SW({ - expect_warning(analyse_Al2O3C_ITC(data_ITC, signal_integral = 0), - "Input for 'signal_integral' corrected to 1:99") - }) -}) - -test_that("Full check", { - skip_on_cran() - - ##run analysis - SW({ - expect_s4_class(analyse_Al2O3C_ITC(data_ITC), "RLum.Results") - expect_s4_class(analyse_Al2O3C_ITC(list(data_ITC), signal_integral = 2, - method_control = list(fit.method = "EXP")), - "RLum.Results") - expect_warning(expect_null(analyse_Al2O3C_ITC(list(data_ITC), - dose_points = list(2))), - "Nothing was merged as the object list was found to be empty") - }) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_Al2O3C_Measurement.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_Al2O3C_Measurement.R deleted file mode 100644 index 7618a830e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_Al2O3C_Measurement.R +++ /dev/null @@ -1,75 +0,0 @@ -## load data -data(ExampleData.Al2O3C, envir = environment()) - -test_that("input validation", { - skip_on_cran() - - SW({ - expect_error(analyse_Al2O3C_Measurement(), - "is missing, with no default") - expect_error(analyse_Al2O3C_Measurement("error"), - "'object' must be an 'RLum.Analysis' object or a list of such objects") - expect_error(analyse_Al2O3C_Measurement(list(data_CrossTalk, "error")), - "Elements in 'object' are not all of type 'RLum.Analysis'") - suppressWarnings( - expect_error(analyse_Al2O3C_Measurement(data_CrossTalk, - travel_dosimeter = "error"), - "Input for 'travel_dosimeter' is not numeric") - ) - expect_error(analyse_Al2O3C_Measurement(data_CrossTalk, - irradiation_time_correction = 7), - "must have length 2") - expect_error(analyse_Al2O3C_Measurement(data_CrossTalk, - irradiation = set_RLum("RLum.Results")), - "was created by an unsupported function") - expect_error(analyse_Al2O3C_Measurement(data_CrossTalk, - irradiation_time_correction = "a"), - "must be a numeric vector or an 'RLum.Results' object") - expect_error(analyse_Al2O3C_Measurement(data_CrossTalk, - cross_talk_correction = "a"), - "'cross_talk_correction' was created by an unsupported function") - - expect_warning(Luminescence:::.warningCatcher( - analyse_Al2O3C_Measurement(object = data_CrossTalk, signal_integral = 1000))) - }) -}) - -test_that("analyse_Al2O3C_Measurements", { - skip_on_cran() - - ## run analysis - SW({ - expect_s4_class(suppressWarnings(analyse_Al2O3C_Measurement(data_CrossTalk)), "RLum.Results") - expect_s4_class(suppressWarnings(analyse_Al2O3C_Measurement(data_CrossTalk, calculate_TL_dose = TRUE)), - "RLum.Results") - }) - expect_output(analyse_Al2O3C_Measurement(data_CrossTalk[[2]], - test_parameter = list(stimulation_power = 0.01))) - expect_output(analyse_Al2O3C_Measurement(data_CrossTalk[[2]], - dose_points = list(3))) - - ## tests without TL curves - temp <- get_RLum(data_CrossTalk, recordType = "OSL", drop = FALSE) - SW({ - expect_s4_class(analyse_Al2O3C_Measurement(temp), - "RLum.Results") - expect_output(analyse_Al2O3C_Measurement(temp, travel_dosimeter = 2), - "travel dosimeter correction applied") - expect_message(analyse_Al2O3C_Measurement(temp, travel_dosimeter = 1:2), - "'travel_dosimeter' specifies every position") - expect_message(analyse_Al2O3C_Measurement(temp, travel_dosimeter = 2000), - "Invalid position in 'travel_dosimeter', nothing corrected") - }) - - ## irradiation_time_correction - it.corr <- analyse_Al2O3C_ITC(data_ITC, verbose = FALSE) - analyse_Al2O3C_Measurement(temp, irradiation_time_correction = list(it.corr), - plot = 1, verbose = FALSE) - - ## cross_talk_correction - ct.corr <- analyse_Al2O3C_CrossTalk(data_CrossTalk) - suppressWarnings( # FIXME(mcol): warnings come from a poorly fitted ct.corr - analyse_Al2O3C_Measurement(temp, cross_talk_correction = list(ct.corr), - plot = FALSE, verbose = FALSE) - ) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_FadingMeasurement.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_FadingMeasurement.R deleted file mode 100644 index 7e1c3d359..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_FadingMeasurement.R +++ /dev/null @@ -1,149 +0,0 @@ -## load example data (sample UNIL/NB123, see ?ExampleData.Fading) -data("ExampleData.Fading", envir = environment()) -fading_data <- ExampleData.Fading$fading.data$IR50 - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(analyse_FadingMeasurement(object = "test"), - "'object' must be an 'RLum.Analysis' object or a 'list' of such objects") - expect_error(expect_warning( - analyse_FadingMeasurement(list(fading_data, "test")), - "2 non-supported records removed"), - "'object' must be an 'RLum.Analysis' object or a 'list' of such objects") - expect_error(analyse_FadingMeasurement(cbind(fading_data, fading_data[, 1])), - "if you provide a data.frame as input, the number of columns") -}) - -test_that("general test", { - testthat::skip_on_cran() - - ## run routine analysis - SW({ - expect_s4_class(analyse_FadingMeasurement( - fading_data, - plot = TRUE, - verbose = TRUE, - n.MC = 10), class = "RLum.Results") - }) - - ##no plot not verbose - expect_s4_class(analyse_FadingMeasurement( - fading_data, - plot = FALSE, - verbose = FALSE, - n.MC = 10), class = "RLum.Results") - - ## test merging of objects if combined in a list - ## this crashed before and was fixed - expect_s4_class(merge_RLum( - list(analyse_FadingMeasurement( - fading_data[1,], - plot = FALSE, - verbose = FALSE, - n.MC = 10), - analyse_FadingMeasurement( - fading_data[1:10,], - plot = FALSE, - verbose = FALSE, - n.MC = 10))), "RLum.Results") - -}) - -test_that("test XSYG file fading data", { - testthat::skip_on_cran() - - # Create artificial object ------------------------------------------------ - l <- list() - time <- 0 - for(x in runif(3, 120,130)) { - ## set irr - irr <- - set_RLum( - "RLum.Data.Curve", - data = matrix(c(1:x, rep(1,x)), ncol = 2), - originator = "read_XSYG2R", - recordType = "irradiation (NA)", - curveType = "simulated", - info = list( - startDate = format(Sys.time() + time, "%Y%m%d%H%M%S"), - position = 1) - ) - - ## set lum - lum <- - set_RLum( - "RLum.Data.Curve", - data = matrix(c(1:40, exp(-c(1:40)/ x * 10)), ncol = 2), - originator = "read_XSYG2R", - recordType = "IRSL", - curveType = "measured", - info = list( - startDate = format(Sys.time() + time + x + 30, "%Y%m%d%H%M%S"), - position = 1) - ) - - time <- time + x + 60 - l <- c(l, irr, lum) - - } - - ## generate object - object <- set_RLum("RLum.Analysis", records = l, originator = "read_XSYG2R") - - # Test -------------------------------------------------------------------- - SW({ - expect_s4_class(analyse_FadingMeasurement( - object, - signal.integral = 1:2, - background.integral = 10:40, - structure = "Lx" - ), "RLum.Results") - }) - - ## check various for t_star - ## stop t_star - expect_error(analyse_FadingMeasurement( - object, - t_star = "error", - ), "\\[analyse_FadingMeasurement\\(\\)\\] Invalid input for t_star.") - - SW({ - expect_s4_class(analyse_FadingMeasurement( - object, - signal.integral = 1:2, - t_star = "half_complex", - background.integral = 10:40, - structure = "Lx", - plot = FALSE - ), "RLum.Results") - expect_s4_class(analyse_FadingMeasurement( - object, - signal.integral = 1:2, - t_star = "end", - background.integral = 10:40, - structure = "Lx", - plot = FALSE - ), "RLum.Results") - }) - - expect_error(analyse_FadingMeasurement(object, signal.integral = 1:2, - background.integral = 2), - "Overlapping of 'signal.integral' and 'background.integral'") - - SW({ - expect_warning(analyse_FadingMeasurement(object, signal.integral = 1:2, - background.integral = 3, - structure = "Lx"), - "Number of background channels for Lx < 25") - - expect_warning(analyse_FadingMeasurement(object, signal.integral = 1:2, - background.integral = 3), - "Lx and Tx have different sizes: skipped sample 2") - - expect_warning(analyse_FadingMeasurement(object, signal.integral = 1:2, - background.integral = 3, - structure = c("Lx", "error")), - "Nothing to combine, object contains a single curve") - }) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_IRSAR.RF.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_IRSAR.RF.R deleted file mode 100644 index 4170a7a5a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_IRSAR.RF.R +++ /dev/null @@ -1,160 +0,0 @@ -data(ExampleData.RLum.Analysis, envir = environment()) - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(analyse_IRSAR.RF(), - "is missing, with no default") - expect_error(analyse_IRSAR.RF("test"), - "Input object must be of type 'RLum.Analysis'") - expect_error(analyse_IRSAR.RF(IRSAR.RF.Data, sequence_structure = FALSE), - "'sequence_structure' must be of type 'character'") - expect_error(analyse_IRSAR.RF(IRSAR.RF.Data, n.MC = 0), - "'n.MC' must be a positive integer scalar") - expect_error(analyse_IRSAR.RF(IRSAR.RF.Data, method.control = 3), - "'method.control' has to be of type 'list'") - - SW({ - expect_warning(analyse_IRSAR.RF(IRSAR.RF.Data, - method.control = list(unknown = "test")), - "'unknown' not supported for 'method.control'") - - ## disable test that produces this error on CI: - ## Error in `.check_ncores(length(names))`: 4 simultaneous processes spawned - if (FALSE) { - expect_warning(analyse_IRSAR.RF(IRSAR.RF.Data, method = "VSLIDE", - method.control = list(cores = 10000)), - "Your machine has only [0-9]* cores") - } - - expect_warning(analyse_IRSAR.RF(IRSAR.RF.Data, method = "VSLIDE", - method.control = list(vslide_range = 1:4)), - "'vslide_range' in 'method.control' has more than 2 elements") - - expect_message(analyse_IRSAR.RF(IRSAR.RF.Data, method = "VSLIDE", - method.control = list(cores = "4")), - "Invalid value for control argument 'cores'") - - expect_warning(analyse_IRSAR.RF(IRSAR.RF.Data, method = "UNKNOWN"), - "Analysis skipped: Unknown method or threshold of test") - }) -}) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - set.seed(1) - SW({ - results_fit <- analyse_IRSAR.RF(object = IRSAR.RF.Data, plot = TRUE, method = "FIT") - results_slide <- suppressWarnings( - analyse_IRSAR.RF(object = IRSAR.RF.Data, plot = TRUE, method = "SLIDE", n.MC = NULL)) - results_slide_alt <- expect_s4_class( - analyse_IRSAR.RF( - object = IRSAR.RF.Data, - plot = FALSE, - method = "SLIDE", - n.MC = 10, - method.control = list(vslide_range = 'auto', trace_vslide = TRUE), - txtProgressBar = FALSE - ), class = "RLum.Results") - - results_slide_alt2 <- expect_s4_class( - analyse_IRSAR.RF( - object = IRSAR.RF.Data, - plot = FALSE, - method = "VSLIDE", - n.MC = 10, - method.control = list(vslide_range = 'auto', trace_vslide = FALSE), - txtProgressBar = FALSE - ), class = "RLum.Results") - }) - - expect_equal(is(results_fit), c("RLum.Results", "RLum")) - expect_equal(length(results_fit), 5) - expect_equal(length(results_slide), 5) - expect_s3_class(results_fit$fit, class = "nls") - expect_s3_class(results_slide$fit, class = "nls") - expect_length(results_slide$slide, 10) - - expect_equal(results_fit$data$DE, 623.25) - expect_equal(results_fit$data$DE.LOWER, 600.63) - expect_equal(results_slide$data$DE, 610.17) - expect_equal(round(results_slide_alt$data$DE, digits = 0), 384) - expect_equal(round(results_slide_alt2$data$DE, digits = 0), 384) - -}) - -test_that("test controlled crash conditions", { - testthat::skip_on_cran() - - ##the sliding range should not exceed a certain value ... test it - expect_error( - analyse_IRSAR.RF( - object = IRSAR.RF.Data, - method = "SLIDE", - method.control = list(vslide_range = c(0,1e+07)), - ), regexp = "[:::src_analyse_IRSAR_SRS()] 'vslide_range' exceeded maximum size (1e+07)!", fixed = TRUE) -}) - -test_that("test support for IR-RF data", { - testthat::skip_on_cran() - - ## get needed data - file <- system.file("extdata", "RF_file.rf", package = "Luminescence") - temp <- read_RF2R(file) - - SW({ - expect_warning(expect_s4_class( - analyse_IRSAR.RF(object = temp[1:3], method = "SLIDE", - plot_reduced = TRUE, n.MC = 1), - "RLum.Results"), - "Narrow density distribution, no density distribution plotted") - }) -}) - -test_that("test edge cases", { - testthat::skip_on_cran() - - data(ExampleData.RLum.Analysis, envir = environment()) - RF_nat <- RF_reg <- IRSAR.RF.Data[[2]] - RF_reg@data[,2] <- runif(length(RF_reg@data[,2]), 0.007557956, 0.05377426 ) - RF_nat@data[,2] <- runif(length(RF_nat@data[,2]), 65.4, 76.7) - RF_nat@data <- RF_nat@data[1:50,] - - SW({ - expect_s4_class(suppressWarnings(analyse_IRSAR.RF( - set_RLum("RLum.Analysis", records = list(RF_nat, RF_reg)), - method = "SLIDE", - method.control = list(vslide_range = 'auto', correct_onset = FALSE, - show_fit = TRUE, trace = TRUE), - RF_nat.lim = 2, - RF_reg.lim = 2, - plot = TRUE, - mtext = "Subtitle", - txtProgressBar = FALSE - )), "RLum.Results") - }) - - ## this RF_nat.lim after - ## 'length = 2' in coercion to 'logical(1)' error - expect_s4_class(suppressWarnings(analyse_IRSAR.RF( - set_RLum("RLum.Analysis", records = list(RF_nat, RF_reg)), - method = "SLIDE", - method.control = list(vslide_range = 'auto', correct_onset = FALSE), - RF_nat.lim = c(10,100), - #RF_reg.lim = c(), - plot = TRUE, - txtProgressBar = FALSE - )), "RLum.Results") - - expect_s4_class(suppressWarnings(analyse_IRSAR.RF( - set_RLum("RLum.Analysis", records = list(RF_nat, RF_reg)), - method = "SLIDE", - method.control = list(vslide_range = 'auto', correct_onset = FALSE), - #RF_nat.lim = c(10,100), - RF_reg.lim = c(10,100), - plot = TRUE, - txtProgressBar = FALSE - )), "RLum.Results") - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_SAR.CWOSL.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_SAR.CWOSL.R deleted file mode 100644 index fb9272aa3..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_SAR.CWOSL.R +++ /dev/null @@ -1,510 +0,0 @@ -##prepare test file for regression test -set.seed(1) -data(ExampleData.BINfileData, envir = environment()) -object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = 1:2) - -results <- analyse_SAR.CWOSL( - object = object[[1]], - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - plot = FALSE, - verbose = FALSE -) - - -##generate different datasets removing TL curves -object_CH_TL <- get_RLum(object, record.id = -seq(1,30,4), drop = FALSE) -object_NO_TL <- get_RLum(object, record.id = -seq(1,30,2), drop = FALSE) - -test_that("tests class elements", { - testthat::skip_on_cran() - - expect_s4_class(results, "RLum.Results") - expect_equal(length(results), 4) - expect_s3_class(results$data, "data.frame") - expect_s3_class(results$LnLxTnTx.table, "data.frame") - expect_s3_class(results$rejection.criteria, "data.frame") - expect_type(results$Formula, "expression") -}) - -test_that("regression tests De values", { - testthat::skip_on_cran() - - expect_equal(object = round(sum(results$data[1:2]), digits = 0), 1716) -}) - -test_that("regression test LxTx table", { - testthat::skip_on_cran() - - expect_equal(object = round(sum(results$LnLxTnTx.table$LxTx), digits = 5), 20.92051) - expect_equal(object = round(sum(results$LnLxTnTx.table$LxTx.Error), digits = 2), 0.34) - - expect_type(object = results$data$POS, "integer") - expect_equal(object = results$data$POS, 1) - expect_type(object = results$data$ALQ, "double") - -}) - -test_that("regression test - check rejection criteria", { - testthat::skip_on_cran() - - expect_equal(round(sum(results$rejection.criteria$Value), digits = 0), - 1669) -}) - -test_that("simple run", { - testthat::skip_on_cran() - - ##verbose and plot off - t <- expect_s4_class( - analyse_SAR.CWOSL( - object = object[1:2], - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - fit.method = "LIN", - plot = FALSE, - verbose = FALSE - ), - class = "RLum.Results" - ) - - ## check aliquot numbers - expect_equal(sum(t@data$data$ALQ), 3) - - ##remove position information from the curve - ##data - object_f <- object[[1]] - object_f@records <- lapply(object_f@records, function(x){ - x@info$POSITION <- NULL - x - - }) - t <- expect_s4_class( - analyse_SAR.CWOSL( - object = object_f, - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - fit.method = "LIN", - plot = FALSE, - verbose = FALSE - ), - class = "RLum.Results" - ) - - expect_type(t@data$data$POS, "logical") - - ##signal integral set to NA - expect_warning( - analyse_SAR.CWOSL( - object = object[1], - signal.integral.min = NA, - signal.integral.max = NA, - background.integral.min = NA, - background.integral.max = NA, - fit.method = "EXP", - plot = FALSE, - verbose = FALSE, - fit.weights = FALSE - ), "\\[analyse_SAR.CWOSL\\(\\)\\] No signal or background integral applied, because they were set to NA\\!") - - - expect_s4_class( - suppressWarnings(analyse_SAR.CWOSL( - object = object[1], - signal.integral.min = NA, - signal.integral.max = NA, - background.integral.min = NA, - background.integral.max = NA, - fit.method = "EXP", - plot = FALSE, - verbose = FALSE - )), - class = "RLum.Results" - ) - - ##verbose and plot on - ##full dataset - SW({ - expect_s4_class( - analyse_SAR.CWOSL( - object = object[[1]], - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - fit.method = "LIN", - log = "x", - ), - class = "RLum.Results" - ) - - ##only CH TL - expect_s4_class( - analyse_SAR.CWOSL( - object = object_CH_TL[[1]], - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - fit.method = "LIN", - log = "x", - plot_onePage = TRUE - ), - class = "RLum.Results" - ) - - ##no TL - expect_s4_class( - analyse_SAR.CWOSL( - object = object_NO_TL[[1]], - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - fit.method = "LIN", - log = "x", - plot_onePage = TRUE - ), - class = "RLum.Results" - ) - - ##plot single - expect_s4_class( - analyse_SAR.CWOSL( - object = object[[1]], - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - fit.method = "EXP", - plot = TRUE, - plot.single = TRUE - ), - class = "RLum.Results" - ) - - ##check rejection criteria - expect_s4_class( - analyse_SAR.CWOSL( - object = object[[1]], - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - fit.method = "LIN", - rejection.criteria= list( - recycling.ratio = NA, - recuperation.rate = 1, - palaeodose.error = 1, - testdose.error = 1, - test = "new", - exceed.max.regpoint = FALSE), - plot = TRUE, - ), - class = "RLum.Results" - ) - - ##check recuperation point selection - t <- expect_s4_class( - analyse_SAR.CWOSL( - object = object[[1]], - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - fit.method = "LIN", - rejection.criteria= list( - recycling.ratio = NA, - recuperation.rate = 1, - palaeodose.error = 1, - testdose.error = 1, - recuperation_reference = "R1", - test = "new", - exceed.max.regpoint = FALSE), - plot = TRUE, - ), - class = "RLum.Results" - ) - }) - - ## check if a different point was selected - expect_equal(round(t$rejection.criteria$Value[2],2), expected = 0.01) - - ## trigger stop of recuperation reference point - expect_error( - analyse_SAR.CWOSL( - object = object[[1]], - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - fit.method = "LIN", - rejection.criteria= list( - recycling.ratio = NA, - recuperation.rate = 1, - palaeodose.error = 1, - testdose.error = 1, - recuperation_reference = "stop", - test = "new", - exceed.max.regpoint = FALSE), - plot = TRUE, - ), - regexp = "\\[analyse\\_SAR.CWOSL\\(\\)\\] Recuperation reference invalid, valid are") - - # Trigger stops ----------------------------------------------------------- - ##trigger stops for parameters - ##object - expect_error(analyse_SAR.CWOSL("fail"), - "Input object is not of type 'RLum.Analysis'") - - expect_error(analyse_SAR.CWOSL(object[[1]], - signal.integral.min = 1.2, - signal.integral.max = 3.5, - background.integral.min = 900, - background.integral.max = 1000), - "'signal.integral' or 'background.integral' is not of type integer") - - ## check stop for OSL.components ... failing - SW({ - expect_null(analyse_SAR.CWOSL( - object = object[[1]], - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - dose.points = c(0,1,2), - fit.method = "LIN", - OSL.component = 1, - plot = FALSE, - verbose = FALSE - )) - }) - - expect_error(analyse_SAR.CWOSL( - object = object[[1]], - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - dose.points = c(0,1,2), - fit.method = "LIN", - plot = FALSE, - verbose = FALSE - ), regexp = "Length of 'dose.points' differs from number of curves") - - - expect_message( - expect_null(analyse_SAR.CWOSL( - object = set_RLum("RLum.Analysis",records = list(set_RLum("RLum.Data.Curve", recordType = "false"))), - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 800, - background.integral.max = 900, - fit.method = "LIN", - plot = FALSE, - verbose = FALSE - )), - "No record of type 'OSL', 'IRSL', 'POSL' detected") - - ##check background integral - expect_warning(analyse_SAR.CWOSL( - object = object[[1]], - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 800, - background.integral.max = 9900, - fit.method = "LIN", - plot = FALSE, - verbose = FALSE - ), regexp = "Background integral out of bounds") - - expect_warning(analyse_SAR.CWOSL( - object = object[[1]], - signal.integral.min = 1, - signal.integral.max = 1, - background.integral.min = 800, - background.integral.max = 1000, - fit.method = "LIN", - plot = FALSE, - verbose = FALSE - ), "Integral signal limits cannot be equal") - - expect_warning(analyse_SAR.CWOSL( - object = object[[1]], - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = c(600, 800), - background.integral.max = c(900, 1000), - fit.method = "LIN", - plot = FALSE, - verbose = FALSE - ), "Background integral for Tx curves set, but not for the signal integral") - - expect_warning(expect_message( - analyse_SAR.CWOSL( - object = object[[1]], - signal.integral.min = c(1, 1500), - signal.integral.max = c(2, 2000), - background.integral.min = 800, - background.integral.max = 1000, - fit.method = "LIN", - plot = FALSE, - verbose = FALSE - ), "Something went wrong while generating the LxTx table"), - "Signal integral for Tx curves set, but not for the background integral") - - ## this generates multiple warnings - warnings <- capture_warnings(analyse_SAR.CWOSL( - object = object[[1]], - signal.integral.min = c(1, 70), - signal.integral.max = c(2, 80), - background.integral.min = 800, - background.integral.max = 1200, - fit.method = "LIN", - plot = FALSE, - verbose = FALSE)) - expect_match(warnings, all = FALSE, - "Background integral for Tx out of bounds") - - ## plot.single - expect_error(analyse_SAR.CWOSL(object[[1]], - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - plot.single = list()), - "Invalid data type for 'plot.single'") - - ## check different curve numbers by shorten one OSL curve - object_short <- object - object_short[[1]]@records[[2]]@data <- object_short[[1]]@records[[2]]@data[-nrow(object_short[[1]]@records[[2]]@data),] - - ## without fix - t <- testthat::expect_warning( - object = analyse_SAR.CWOSL( - object = object_short[[1]], - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 800, - background.integral.max = 9900, - fit.method = "LIN", - plot = FALSE, - verbose = FALSE), - regexp = "\\[analyse\\_SAR.CWOSL\\(\\)\\] Input curves lengths differ\\.") - - ## with new parameter - testthat::expect_s4_class( - object = analyse_SAR.CWOSL( - object = object_short[[1]], - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 800, - background.integral.max = 999, - fit.method = "LIN", - trim_channels = TRUE, - plot = FALSE, - verbose = FALSE), - class = "RLum.Results") - -}) - -test_that("advance tests run", { - testthat::skip_on_cran() - - ##this tests basically checks the parameter expansion and make - ##sure everything is evaluated properly - # signal.integral.min <- 1 - # signal.integral.max <- 2 - - ##test with variables for signal integral - # expect_s4_class( - # analyse_SAR.CWOSL( - # object = object[1:2], - # signal.integral.min = signal.integral.min, - # signal.integral.max = signal.integral.max, - # background.integral.min = 900, - # background.integral.max = 1000, - # fit.method = "LIN", - # rejection.criteria = list( - # recycling.ratio = NA, - # recuperation.rate = 1, - # palaeodose.error = 1, - # testdose.error = 1, - # test = "new", - # exceed.max.regpoint = FALSE), - # plot = FALSE, - # verbose = FALSE - # ), - # class = "RLum.Results" - # ) - - - ##test rejection criteria is a list without(!) names, - ##this should basically lead to no fail - test_failed <- - analyse_SAR.CWOSL( - object = object[1], - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 200, - background.integral.max = 1000, - fit.method = "LIN", - rejection.criteria = list(recycling.ratio = 0), - plot = FALSE, - verbose = FALSE) - expect_equal(object = test_failed$data$RC.Status, "FAILED") - - ##the same test but without a named list >>> OK - test_ok <- - analyse_SAR.CWOSL( - object = object[1], - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 200, - background.integral.max = 1000, - fit.method = "LIN", - rejection.criteria = list(1), - plot = FALSE, - verbose = FALSE) - - expect_equal(object = test_ok$data$RC.Status, "OK") - - ##test multi parameter settings - expect_s4_class( - analyse_SAR.CWOSL( - object = object[1:2], - signal.integral.min = 1, - signal.integral.max = list(10,20), - background.integral.min = 900, - background.integral.max = 1000, - fit.method = "LIN", - plot = FALSE, - verbose = FALSE - ), - class = "RLum.Results" - ) - - ##test rejection criteria list in list + test unknown argument - expect_s4_class( - analyse_SAR.CWOSL( - object = object[1:2], - signal.integral.min = 1, - signal.integral.max = list(10,20), - background.integral.min = 900, - background.integral.max = 1000, - rejection.criteria = list(list(recycling.ratio = 0)), - fit.method = "LIN", - unknown_argument = "hallo", - main = "Title", - plot = TRUE, - verbose = FALSE - ), - class = "RLum.Results" - ) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_SAR.TL.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_SAR.TL.R deleted file mode 100644 index 6d39cd101..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_SAR.TL.R +++ /dev/null @@ -1,68 +0,0 @@ -## load data -data(ExampleData.BINfileData, envir = environment()) - -## transform the values from the first position in a RLum.Analysis object -object <- Risoe.BINfileData2RLum.Analysis(TL.SAR.Data, pos = 3) - -test_that("Input validation", { - skip_on_cran() - - expect_error(analyse_SAR.TL(), - "No value set for 'object'") - expect_error(analyse_SAR.TL("test"), - "Input object is not of type 'RLum.Analyis'") - expect_error(analyse_SAR.TL(object), - "No value set for 'signal.integral.min'") - expect_error(analyse_SAR.TL(object, signal.integral.min = 1), - "No value set for 'signal.integral.max'") - expect_error(analyse_SAR.TL(list(object, "test")), - "elements in the input list must be of class 'RLum.Analysis'") - expect_error(analyse_SAR.TL(object, signal.integral.min = 1, - signal.integral.max = 2), - "Input TL curves are not a multiple of the sequence structure") -}) - -test_that("Test examples", { - skip_on_cran() - - ##perform analysis - SW({ - expect_s4_class( - analyse_SAR.TL( - object, - signal.integral.min = 210, - signal.integral.max = 220, - fit.method = "EXP OR LIN", - sequence.structure = c("SIGNAL", "BACKGROUND") - ), - "RLum.Results" - ) - - expect_s4_class( - analyse_SAR.TL( - list(object, object), - signal.integral.min = 210, - signal.integral.max = 220, - dose.points = 1:7, - integral_input = "temperature", - sequence.structure = c("SIGNAL", "BACKGROUND")), - "RLum.Results" - ) - - expect_warning( - analyse_SAR.TL( - list(object), - signal.integral.min = 210, - signal.integral.max = 220, - dose.points = 1:7, - log = "x", - sequence.structure = c("SIGNAL", "BACKGROUND")), - "log-scale needs positive values; log-scale disabled" - ) - - expect_warning( - analyse_SAR.TL(object, signal.integral.min = 2, signal.integral.max = 3, - sequence.structure = c("SIGNAL", "EXCLUDE")), - "'fit.weights' ignored since the error column is invalid or 0") - }) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_baSAR.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_baSAR.R deleted file mode 100644 index b64aa93d3..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_baSAR.R +++ /dev/null @@ -1,240 +0,0 @@ -##(1) load package test data set -data(ExampleData.BINfileData, envir = environment()) - -##(2) selecting relevant curves, and limit dataset -CWOSL.sub <- subset(CWOSL.SAR.Data, - subset = POSITION %in% c(1:3) & LTYPE == "OSL") - -test_that("input validation", { - skip_on_cran() - - expect_error(analyse_baSAR("error", verbose = FALSE), - "File does not exist") - expect_error(analyse_baSAR(list("error"), verbose = FALSE), - "File does not exist") - expect_error(analyse_baSAR(data.frame(), verbose = FALSE), - "'data.frame' as input is not supported") - expect_error(analyse_baSAR(list(data.frame()), verbose = FALSE), - "Unsupported data type in the input list provided for 'object'") - expect_error(analyse_baSAR(list(data.frame(), matrix()), verbose = FALSE), - "'object' only accepts a list with objects of similar type") - expect_error(analyse_baSAR(CWOSL.sub, n.MCMC = NULL), - "'n.MCMC' must be a positive integer scalar") - - expect_error(analyse_baSAR(CWOSL.sub, verbose = FALSE), - "'source_doserate' is missing, but the current implementation") - expect_error(analyse_baSAR(CWOSL.sub, fit.method = "error"), - "'fit.method' not recognised, supported methods are") - expect_error(analyse_baSAR(CWOSL.sub, verbose = FALSE, - source_doserate = c(0.04, 0.001)), - 'argument "signal.integral" is missing, with no default') - expect_error(analyse_baSAR(CWOSL.sub, verbose = FALSE, - source_doserate = c(0.04, 0.001), - signal.integral = c(1:2)), - 'argument "background.integral" is missing, with no default') - - ## XLS_file - expect_error(analyse_baSAR(CWOSL.sub, verbose = FALSE, - source_doserate = c(0.04, 0.001), - signal.integral = c(1:2), - background.integral = c(80:100), - XLS_file = list()), - "Input type for 'XLS_file' not supported") - expect_error(analyse_baSAR(CWOSL.sub, verbose = FALSE, - source_doserate = c(0.04, 0.001), - signal.integral = c(1:2), - background.integral = c(80:100), - XLS_file = "error"), - "XLS_file does not exist") - expect_error(analyse_baSAR(CWOSL.sub, verbose = FALSE, - source_doserate = c(0.04, 0.001), - signal.integral = c(1:2), - background.integral = c(80:100), - XLS_file = system.file("extdata/clippy.xls", - package = "readxl")), - "The XLS_file requires at least 3 columns") - SW({ - expect_error(analyse_baSAR(CWOSL.sub, verbose = FALSE, - source_doserate = c(0.04, 0.001), - signal.integral = c(1:2), - background.integral = c(80:100), - XLS_file = system.file("extdata/deaths.xls", - package = "readxl")), - "One of the first 3 columns in your XLS_file has no header") - }) - expect_error(analyse_baSAR(CWOSL.sub, verbose = FALSE, - source_doserate = c(0.04, 0.001), - signal.integral = c(1:2), - background.integral = c(80:100), - XLS_file = data.frame(a = NA, b = NA)), - "The data.frame provided via 'XLS_file' must have at least 3") - expect_warning(expect_error( - analyse_baSAR(CWOSL.sub, verbose = FALSE, - source_doserate = c(0.04, 0.001), - signal.integral = c(1:2), - background.integral = c(80:100), - XLS_file = data.frame(a = "error", b = 1, c = 2)), - "BIN-file names in XLS_file do not match the loaded BIN-files", - fixed = TRUE), - "'error' not recognised or not loaded, skipped") - - expect_error(analyse_baSAR(CWOSL.sub, verbose = FALSE, - source_doserate = c(0.04, 0.001), - signal.integral = c(1:2), - background.integral = c(80:100), - XLS_file = data.frame(a = NA, b = 1, c = 2)), - "Number of discs/grains = 0") - - expect_error(suppressWarnings( - analyse_baSAR(Risoe.BINfileData2RLum.Analysis(CWOSL.sub), - verbose = FALSE)), - "No records of the appropriate type were found") - - expect_warning(expect_output( - analyse_baSAR(CWOSL.sub, verbose = FALSE, - source_doserate = c(0.04, 0.001), - signal.integral = c(1:2), - background.integral = c(80:100), - fit.method = "LIN", fit.force_through_origin = FALSE, - distribution = "error"), - "[analyse_baSAR()] No pre-defined model for the requested distribution", - fixed = TRUE), - "Only multiple grain data provided, automatic selection skipped") - - expect_warning(expect_output( - analyse_baSAR(CWOSL.sub, verbose = FALSE, - source_doserate = c(0.04, 0.001), - signal.integral = c(1:2), - background.integral = c(80:100), - distribution = "user_defined"), - "[analyse_baSAR()] You specified a 'user_defined' distribution", - fixed = TRUE), - "Only multiple grain data provided, automatic selection skipped") - - expect_message(expect_output(suppressWarnings( - analyse_baSAR(CWOSL.sub, verbose = FALSE, - source_doserate = c(0.04, 0.001), - signal.integral = c(1:2), - background.integral = c(80:100), - distribution = "cauchy", - baSAR_model = "error")), - "Error parsing model file"), - "'baSAR_model' provided, setting distribution to 'user_defined'") - - expect_error(suppressWarnings( - analyse_baSAR(CWOSL.SAR.Data, verbose = FALSE, - source_doserate = c(0.04, 0.001), - signal.integral = c(1:2), - background.integral = c(80:100), - distribution = "user_defined")), - "Channel numbers of Lx and Tx data differ") - - data(ExampleData.RLum.Analysis, envir = environment()) - expect_error(analyse_baSAR(list(IRSAR.RF.Data), verbose = FALSE), - "At least two aliquots are needed for the calculation") -}) - -test_that("Full check of analyse_baSAR function", { - skip_on_cran() - - set.seed(1) - - ##(3) run analysis - ##please not that the here selected parameters are - ##chosen for performance, not for reliability - SW({ - results <- suppressWarnings(analyse_baSAR( - object = CWOSL.sub, - source_doserate = c(0.04, 0.001), - signal.integral = c(1:2), - background.integral = c(80:100), - fit.method = "EXP", - method_control = list(inits = list( - list(.RNG.name = "base::Wichmann-Hill", .RNG.seed = 1), - list(.RNG.name = "base::Wichmann-Hill", .RNG.seed = 2), - list(.RNG.name = "base::Wichmann-Hill", .RNG.seed = 3) - )), - plot = TRUE, - verbose = TRUE, - n.MCMC = 100, - txtProgressBar = TRUE - )) - }) - - expect_s4_class(results, class = "RLum.Results") - expect_s3_class(results$summary, "data.frame") - expect_s3_class(results$mcmc, "mcmc.list") - expect_type(results$models, "list") - expect_type(round(sum(results$summary[, c(6:9)]), 2),type = "double") - - ## rerun with previous results as input - SW({ - results2 <- analyse_baSAR( - object = results, - plot = FALSE, - verbose = FALSE, - txtProgressBar = FALSE, - n.MCMC = 100) - - expect_warning(analyse_baSAR( - object = results, - plot = FALSE, - verbose = FALSE, - txtProgressBar = FALSE, - method_control = list(upper_centralD = 200), - n.MCMC = 100), - "You have modified the upper central_D boundary") - - expect_warning(analyse_baSAR( - object = results, - plot = FALSE, - verbose = FALSE, - txtProgressBar = FALSE, - method_control = list(lower_centralD = 0), - n.MCMC = 100), - "You have modified the lower central_D boundary") - - suppressWarnings(expect_warning(analyse_baSAR( - object = results, - plot = FALSE, - verbose = FALSE, - txtProgressBar = FALSE, - method_control = list(upper_centralD = 2), - n.MCMC = 100), - "Your lower_centralD and/or upper_centralD values seem not to fit", - fixed = TRUE)) - - analyse_baSAR( - object = results, - plot = TRUE, - verbose = TRUE, - txtProgressBar = FALSE, - fit.method = "EXP+LIN", - fit.includingRepeatedRegPoints = FALSE, - fit.force_through_origin = FALSE, - distribution = "log_normal", - aliquot_range = 1:3, - distribution_plot = "abanico", - method_control = list(n.chains = 2, thin = 25), - n.MCMC = 100) - - expect_warning(expect_error( - analyse_baSAR( - object = results, - plot = TRUE, - verbose = TRUE, - txtProgressBar = FALSE, - source_doserate = 2, - fit.method = "LIN", - distribution = "log_normal", - method_control = list(n.chains = 2, variable.names = "Q"), - n.MCMC = 100), - "Plots for 'central_D' and 'sigma_D' could not be produced", - fixed = TRUE), - "'source_doserate' is ignored in this mode as it was already set") - }) - - results2@originator <- "unknown" - expect_error(analyse_baSAR(object = results2), - "'object' is of type 'RLum.Results', but was not produced by") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_pIRIRSequence.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_pIRIRSequence.R deleted file mode 100644 index 1b2adfaa2..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_pIRIRSequence.R +++ /dev/null @@ -1,97 +0,0 @@ -set.seed(1) -data(ExampleData.BINfileData, envir = environment()) -object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = 1) -object <- get_RLum(object, record.id = c(-29, -30)) -sequence.structure <- c(1, 2, 2, 3, 4, 4) -sequence.structure <- - as.vector(sapply(seq(0, length(object) - 1, by = 4), - function(x) { - sequence.structure + x - })) - -object <- sapply(1:length(sequence.structure), function(x) { - object[[sequence.structure[x]]] - -}) - -object <- - set_RLum(class = "RLum.Analysis", - records = object, - protocol = "pIRIR") - -SW({ -results <- analyse_pIRIRSequence( - object, - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - fit.method = "EXP", - sequence.structure = c("TL", "pseudoIRSL1", "pseudoIRSL2"), - main = "Pseudo pIRIR data set based on quartz OSL", - plot = FALSE, - plot.single = TRUE, - verbose = FALSE -) - -## plot.single = FALSE && plot == TRUE -suppressWarnings( # warnings thrown by analyse_SAR.CWOSL and plot_GrowthCurve - analyse_pIRIRSequence( - object, - signal.integral.min = c(1, 2), - signal.integral.max = c(2, 3), - background.integral.min = 900, - background.integral.max = 1000, - fit.method = "EXP", - sequence.structure = c("TL", "pseudoIRSL1", "pseudoIRSL2"), - main = "Pseudo pIRIR data set based on quartz OSL", - plot = TRUE, - plot.single = FALSE, - verbose = FALSE - ) -) -}) - -test_that("input validation", { - expect_error(analyse_pIRIRSequence(), - "No value set for 'object'") - expect_error(analyse_pIRIRSequence("test"), - "Input object is not of type 'RLum.Analyis'") - expect_error(analyse_pIRIRSequence(list("test"), - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000), - "Input object is not of type 'RLum.Analyis'") - - SW({ - expect_warning(analyse_pIRIRSequence(list(object), - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000), - "'signal.integral.min' missing, set to 1") - expect_warning(analyse_pIRIRSequence(list(object), - signal.integral.min = 1, - background.integral.min = 900, - background.integral.max = 1000), - "'signal.integral.max' missing, set to 2") - }) -}) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - expect_s4_class(results, "RLum.Results") - expect_equal(length(results), 4) - expect_s3_class(results$LnLxTnTx.table, "data.frame") - expect_s3_class(results$rejection.criteria, "data.frame") - - -}) - -test_that("check output", { - testthat::skip_on_cran() - - expect_equal(round(sum(results$data[1:2, 1:4]), 0),7584) - expect_equal(round(sum(results$rejection.criteria$Value), 2),3338.69) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_portableOSL.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_portableOSL.R deleted file mode 100644 index 3495ce3a4..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_analyse_portableOSL.R +++ /dev/null @@ -1,178 +0,0 @@ -data(ExampleData.portableOSL, envir = environment()) - -## generate test data set for profile -merged <- surface <- merge_RLum(ExampleData.portableOSL) - -## generate dataset for surface -surface@records <- lapply(surface@records, function(x){ - x@info$settings$Sample <- paste0("Test_x:", runif(1), "|y:", runif(1)) - x -}) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - ## standard run profile - results <- expect_s4_class( - analyse_portableOSL( - merged, - signal.integral = 1:5, - invert = FALSE, - mode = "profile", - normalise = TRUE, - plot = TRUE - ), "RLum.Results") - - ## check standard with coordinates - coord <- as.matrix(results$summary[,c("COORD_X", "COORD_Y")]) - - ## standard run profile no plot even with plot activated - results <- expect_s4_class( - analyse_portableOSL( - merged, - signal.integral = 1:5, - invert = FALSE, - normalise = TRUE, - mode = NULL, - coord = coord, - plot = TRUE - ), "RLum.Results") - - ## verify output - expect_equal(length(results), 3) - expect_s3_class(results$summary, "data.frame") - expect_s4_class(results$data, "RLum.Analysis") - - ## standard surface - results <- expect_s4_class( - analyse_portableOSL( - surface, - signal.integral = 1:5, - invert = FALSE, - mode = "surface", - normalise = TRUE, - plot = TRUE - ), "RLum.Results") - - ## surface with options - set.seed(1234) - results <- expect_s4_class( - analyse_portableOSL( - surface, - signal.integral = 1:5, - invert = TRUE, - mode = "surface", - xlim = c(0.1, 0.4), - ylim = c(0.1, 0.4), - zlim = c(0.1, 2), - zlim_image = c(1, 2), - col_ramp = "red", - surface_values = c("BSL", "IRSL"), - normalise = TRUE, - plot = TRUE - ), "RLum.Results") - - ## check list input - expect_s4_class( - suppressWarnings(analyse_portableOSL(ExampleData.portableOSL)), - "RLum.Results") - - ## check additional argument sample - expect_s4_class(analyse_portableOSL( - merged, - signal.integral = 1:5, - invert = FALSE, - normalise = TRUE, - ylim = c(1,2), - zlim = list(BSL = c(0,1.1), IRSL = c(0,1)), - plot = TRUE, - sample = "test" - ), - "RLum.Results") -}) - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(analyse_portableOSL("error"), - "Only objects of class 'RLum.Analysis' are allowed") - - ## Only RLum.Data.Curves - tmp <- merged - tmp@records <- list(tmp@records, "error") - expect_error(analyse_portableOSL(tmp), - regexp = "\\[analyse\\_portableOSL\\(\\)\\] The 'RLum.Analysis' object must contain only.+") - - ## Check originator - tmp <- merged - tmp@records[[1]]@originator <- "error" - expect_error(analyse_portableOSL(tmp), - regexp = "\\[analyse\\_portableOSL\\(\\)\\] Only objects originating from .+") - - ## Sequence pattern - tmp <- merged - tmp@records <- tmp@records[-1] - expect_error(analyse_portableOSL(tmp), - "Sequence pattern not supported") - - ## coordinates not list or matrix - expect_error(analyse_portableOSL(surface, signal.integral = 1:5, - coord = "error"), - "'coord' must be a matrix or a list") - - ## coordinates are not of the correct size - expect_error(analyse_portableOSL(surface, signal.integral = 1:5, - coord = list(COORD_X = c(0, 0), - COORD_Y = c(1, 2))), - "Number of coordinates differ from the number of samples") - - ## trigger warning - expect_warning( - analyse_portableOSL( - merged, - signal.integral = 1:5, - invert = FALSE, - normalise = TRUE, - mode = "surface", - surface_value = c("BSL"), - plot = TRUE, - sample = "test"), - "Surface interpolation failed: this happens when all points are") - - expect_warning( - analyse_portableOSL( - merged, - signal.integral = 1:5, - invert = FALSE, - normalise = TRUE, - mode = "profile", - zlim = c(1,2), - plot = TRUE, - sample = "test"), - regexp = "\\[analyse\\_portableOSL\\(\\)\\] In profile mode, zlim.+") - - suppressWarnings( # generated the same warning twice - expect_warning(analyse_portableOSL(merged[1:5], - signal.integral = c(1, 102)), - "'signal.integral' (1, 102) exceeded the number", - fixed = TRUE) - ) -}) - -test_that("check output", { - testthat::skip_on_cran() - - data("ExampleData.portableOSL", envir = environment()) - merged <- merge_RLum(ExampleData.portableOSL) - results <- - analyse_portableOSL( - merged, - signal.integral = 1:5, - invert = FALSE, - normalise = TRUE, - plot = FALSE - ) - - expect_equal(round(sum(results$summary[,c(-1, -2, -10,-11)]), digits = 2), 175.44) - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_apply_CosmicRayRemoval.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_apply_CosmicRayRemoval.R deleted file mode 100644 index a83de1b7f..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_apply_CosmicRayRemoval.R +++ /dev/null @@ -1,40 +0,0 @@ -test_that("check function", { - testthat::skip_on_cran() - - ##load data - data(ExampleData.XSYG, envir = environment()) - - ##crash the function - expect_error( - apply_CosmicRayRemoval("error"), - regexp = "An object of class 'character' is not supported as input; please read the manual!") - expect_error(apply_CosmicRayRemoval(TL.Spectrum, method = "error"), - "Unknown method for cosmic ray removal") - - ##run basic tests - expect_silent(apply_CosmicRayRemoval(TL.Spectrum, method = "Pych")) - expect_silent(apply_CosmicRayRemoval(TL.Spectrum, method = "smooth")) - expect_silent(apply_CosmicRayRemoval(TL.Spectrum, method = "smooth", MARGIN = 1)) - expect_output(apply_CosmicRayRemoval(TL.Spectrum, method = "Pych", MARGIN = 2, verbose = TRUE, plot = TRUE)) - expect_silent(apply_CosmicRayRemoval(TL.Spectrum, method = "Pych", - method.Pych.smoothing = 2, method.Pych.threshold_factor = 2)) - expect_silent(apply_CosmicRayRemoval(TL.Spectrum, method = "smooth.spline", - kind = "3RS3R", twiceit = TRUE, - spar = NULL, MARGIN = 1)) - - ##construct objects for different tests - RLum_list <- list(TL.Spectrum) - RLum.Analysis <- set_RLum("RLum.Analysis", records = RLum_list) - RLum.Analysis_list <- list(RLum.Analysis) - RLum_list_mixed <- list(TL.Spectrum, set_RLum("RLum.Data.Curve")) - RLum.Analysis_mixed <- set_RLum("RLum.Analysis", records = RLum_list_mixed ) - RLum.Analysis_mixed_list <- list(RLum.Analysis_mixed) - - ##run tests - expect_type(apply_CosmicRayRemoval(RLum_list),"list") - expect_s4_class(apply_CosmicRayRemoval(RLum.Analysis), class = "RLum.Analysis") - expect_type(apply_CosmicRayRemoval(RLum.Analysis_list), "list") - expect_error(apply_CosmicRayRemoval(RLum_list_mixed)) - expect_s4_class(apply_CosmicRayRemoval(RLum.Analysis_mixed), class = "RLum.Analysis") - expect_type(apply_CosmicRayRemoval(RLum.Analysis_mixed_list), "list") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_apply_EfficiencyCorrection.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_apply_EfficiencyCorrection.R deleted file mode 100644 index 95645352a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_apply_EfficiencyCorrection.R +++ /dev/null @@ -1,49 +0,0 @@ -test_that("check function", { - testthat::skip_on_cran() - - ##load data - data(ExampleData.XSYG, envir = environment()) - - ##create efficiency data - eff_data <- data.frame(WAVELENGTH = 1:1000, runif(1000)) - - ##break function - expect_error(apply_EfficiencyCorrection(object = "ERROR"), - regexp = "Input object is not of type RLum.Data.Spectrum") - - expect_error(apply_EfficiencyCorrection(object = TL.Spectrum, spectral.efficiency = "ERROR"), - regexp = "'spectral.efficiency' is not of type data.frame") - - eff_data_false <- eff_data - eff_data_false[1,2] <- 2 - expect_error(apply_EfficiencyCorrection( - object = TL.Spectrum, - spectral.efficiency = eff_data_false), - regexp = "Relative quantum efficiency values > 1 are not allowed.") - - - ##run tests - expect_s4_class(apply_EfficiencyCorrection(TL.Spectrum,spectral.efficiency = eff_data), - "RLum.Data.Spectrum") - - ##run list test - expect_warning( - apply_EfficiencyCorrection(list(a = "test", TL.Spectrum), spectral.efficiency = eff_data), - regexp = "Skipping character object in input list.") - - ##run test with RLum.Analysis objects - expect_s4_class( - apply_EfficiencyCorrection(set_RLum("RLum.Analysis", - records = list(TL.Spectrum)), spectral.efficiency = eff_data), - "RLum.Analysis") - expect_warning( - apply_EfficiencyCorrection(set_RLum("RLum.Analysis", - records = list(TL.Spectrum, "test")), - spectral.efficiency = eff_data), - regexp = "Skipping character object in input list.") - - ##run test with everything combined - input <- list(a = "test", TL.Spectrum,set_RLum("RLum.Analysis", records = list(TL.Spectrum))) - expect_warning(apply_EfficiencyCorrection(input, eff_data), "Skipping character object in input list") - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_as_latex_table.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_as_latex_table.R deleted file mode 100644 index ba2ce8c9a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_as_latex_table.R +++ /dev/null @@ -1,39 +0,0 @@ -test_that("Check .as.latex.table()", { - testthat::skip_on_cran() - - ## data.frame - df <- data.frame(x = "test", y = 1:10, z = as.factor(letters[1:10])) - expect_error(.as.latex.table(df, select = 2), - "Undefined columns selected") - - expect_output(.as.latex.table(df)) - expect_output(.as.latex.table(df, select = "x")) - - ## RLum.Results - expect_null(.as.latex.table(as(object = list(1:10), - Class = "RLum.Results"))) - - ## DRAC highlights - dh <- use_DRAC(template_DRAC(preset = "DRAC-example_quartz", - notification = FALSE), verbose = FALSE) - expect_output(.as.latex.table(dh)) - -}) - -test_that("Check .as.latex.table.data.frame()", { - testthat::skip_on_cran() - - expect_error(.as.latex.table.data.frame("error"), - "'x' must be a data frame") - - df <- data.frame(x = "test", y = 1:10) - expect_error(.as.latex.table.data.frame(df, col.names = "col1"), - "Length of 'col.names' does not match the number of columns") - expect_error(.as.latex.table.data.frame(df, row.names = "row1"), - "Length of 'row.names' does not match the number of rows") - expect_error(.as.latex.table.data.frame(df, pos = c("pos1", "pos2")), - "Length of 'pos' does not match the number of columns") - - expect_output(.as.latex.table.data.frame(df, tabular_only = TRUE)) - expect_output(.as.latex.table.data.frame(df[, 1, drop = FALSE])) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_bin_RLumData.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_bin_RLumData.R deleted file mode 100644 index f854390a0..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_bin_RLumData.R +++ /dev/null @@ -1,24 +0,0 @@ -data(ExampleData.CW_OSL_Curve, envir = environment()) -curve <- - set_RLum( - class = "RLum.Data.Curve", - recordType = "OSL", - data = as.matrix(ExampleData.CW_OSL_Curve) - ) - - -test_that("check class and length of output", { - testthat::skip_on_cran() - - expect_s4_class(bin_RLum.Data(curve), class = "RLum.Data.Curve") - expect_length(bin_RLum.Data(curve)[,1], 500) - -}) - -test_that("check values from output example", { - testthat::skip_on_cran() - - expect_equal(sum(bin_RLum.Data(curve)[,2]), 119200) - expect_equal(sum(bin_RLum.Data(curve, bin = 5)[1,2]), 41146) - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_AliquotSize.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_AliquotSize.R deleted file mode 100644 index 9830c034a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_AliquotSize.R +++ /dev/null @@ -1,74 +0,0 @@ -set.seed(1) -temp <- calc_AliquotSize( - grain.size = c(100,150), - sample.diameter = 1, - MC.iter = 100, - plot = FALSE, - verbose = FALSE) - -test_that("consistency checks", { - testthat::skip_on_cran() - - expect_error(calc_AliquotSize(), - "Please provide the mean grain size or a range of grain sizes") - expect_error(calc_AliquotSize(grain.size = 1:3), - "Please provide the mean grain size or a range of grain sizes") - expect_error(calc_AliquotSize(grain.size = 100, packing.density = 2), - "'packing.density' expects values between 0 and 1") - expect_error(calc_AliquotSize(grain.size = 100, packing.density = 1, sample.diameter = -1), - "'sample.diameter' must be a positive scalar") - expect_error(calc_AliquotSize(grain.size = 100, sample.diameter = 9.8, - MC = TRUE), - "'grain.size' must be a vector containing the min and max") - expect_output(calc_AliquotSize(grain.size = 100, packing.density = 1, sample.diameter = 9.8, grains.counted = 30, MC = TRUE), - regexp = "Monte Carlo simulation is only available for estimating the amount of grains on the sample disc.") - - SW({ - expect_s4_class( - calc_AliquotSize( - grain.size = 100, packing.density = "inf", sample.diameter = 9.8, MC = FALSE), "RLum.Results") - expect_s4_class( - calc_AliquotSize( - grain.size = c(100, 150), grains.counted = 1000, sample.diameter = 9.8, MC = FALSE), "RLum.Results") - expect_s4_class( - suppressWarnings(calc_AliquotSize( - grain.size = c(100, 150), grains.counted = c(1000, 1100, 900), sample.diameter = 10, MC = FALSE)), - "RLum.Results") - }) -}) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - expect_equal(is(temp), c("RLum.Results", "RLum")) - expect_equal(length(temp), 2) - expect_s3_class(temp$summary, "data.frame") - expect_type(temp$MC, "list") - -}) - -test_that("check summary output", { - testthat::skip_on_cran() - - result <- get_RLum(temp) - - expect_equal(result$grain.size, 125) - expect_equal(result$sample.diameter, 1) - expect_equal(result$packing.density, 0.65) - expect_equal(result$n.grains, 42) - expect_equal(result$grains.counted, NA) -}) - -test_that("check MC run", { - testthat::skip_on_cran() - - expect_equal(round(temp$MC$statistics$n), 100) - expect_equal(round(temp$MC$statistics$mean), 43) - expect_equal(round(temp$MC$statistics$median), 39) - expect_equal(round(temp$MC$statistics$sd.abs), 19) - expect_equal(round(temp$MC$statistics$sd.rel), 45) - expect_equal(round(temp$MC$statistics$se.abs), 2) - expect_equal(round(temp$MC$statistics$se.rel), 5) - expect_length(temp$MC$kde$x, 10000) - expect_length(temp$MC$kde$y, 10000) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_AverageDose.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_AverageDose.R deleted file mode 100644 index a9bbbb524..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_AverageDose.R +++ /dev/null @@ -1,52 +0,0 @@ -data(ExampleData.DeValues, envir = environment()) -temp <- calc_AverageDose(ExampleData.DeValues$CA1[1:56,], - sigma_m = 0.1, - plot = FALSE, - verbose = FALSE) - -test_that("input validation", { - testthat::skip_on_cran() - - data <- ExampleData.DeValues$CA1 - expect_error(calc_AverageDose(), - "is missing, with no default") - expect_error(calc_AverageDose("test"), - "Input must be of type 'RLum.Results' or 'data.frame'") - expect_error(calc_AverageDose(data), - "\"sigma_m\" is missing, with no default") - expect_error(calc_AverageDose(data, sigma_m = NULL), - "'sigma_m' must be a positive scalar") - expect_error(calc_AverageDose(data, sigma_m = 0.1, Nb_BE = NULL), - "'Nb_BE' must be a positive integer scalar") - expect_message(expect_null( - calc_AverageDose(data[, 1, drop = FALSE], sigma_m = 0.1)), - "Error: data set contains < 2 columns") - expect_message(expect_null( - calc_AverageDose(data[0, ], sigma_m = 0.1)), - "Error: data set contains 0 rows") - - SW({ - expect_warning(calc_AverageDose(cbind(data, data), sigma_m = 0.1), - "number of columns in data set > 2") - expect_warning(calc_AverageDose(rbind(data, NA), sigma_m = 0.1), - "NA values in data set detected") - }) -}) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - expect_s4_class(temp, "RLum.Results") - expect_equal(length(temp), 3) - -}) - -test_that("check summary output", { - testthat::skip_on_cran() - - results <- get_RLum(temp) - - expect_equal(round(results$AVERAGE_DOSE, digits = 4), 65.3597) - expect_equal(round(results$SIGMA_D, digits = 4), 0.3092) - expect_equal(round(results$L_MAX, digits = 5), -19.25096) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_CentralDose.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_CentralDose.R deleted file mode 100644 index 4761ae971..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_CentralDose.R +++ /dev/null @@ -1,50 +0,0 @@ -data(ExampleData.DeValues, envir = environment()) - -temp <- calc_CentralDose( - ExampleData.DeValues$CA1, - plot = FALSE, - verbose = FALSE) - -temp_NA <- data.frame(rnorm(10)+5, rnorm(10)+5) -temp_NA[1,1] <- NA - -test_that("errors and warnings function", { - testthat::skip_on_cran() - - expect_error(calc_CentralDose(data = "error"), "'data' has to be of type 'data.frame' or 'RLum.Results'!") - expect_error(calc_CentralDose(temp, sigmab = 10), "sigmab needs to be given as a fraction between 0 and 1") - expect_error(calc_CentralDose(data.frame()), - "should have at least two columns and two rows") - - SW({ - expect_s4_class(calc_CentralDose(temp_NA), "RLum.Results") - expect_warning(calc_CentralDose(temp_NA, na.rm = TRUE)) - }) -}) - - -test_that("standard and output", { - testthat::skip_on_cran() - - expect_equal(is(temp), c("RLum.Results", "RLum")) - expect_equal(length(temp), 4) - - ##log and trace - SW({ - expect_s4_class(calc_CentralDose(ExampleData.DeValues$CA1, log = FALSE, trace = TRUE), "RLum.Results") - }) -}) - -test_that("check summary output", { - testthat::skip_on_cran() - - results <- get_RLum(temp) - - expect_equal(round(results$de, digits = 5), 65.70929) - expect_equal(round(results$de_err, digits = 6), 3.053443) - expect_equal(round(results$OD, digits = 5), 22.79495) - expect_equal(round(results$OD_err, digits = 6), 2.272736) - expect_equal(round(results$rel_OD, digits = 5), 34.69061) - expect_equal(round(results$rel_OD_err, digits = 6), 3.458774) - expect_equal(round(results$Lmax, digits = 5), 31.85046) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_CobbleDoseRate.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_CobbleDoseRate.R deleted file mode 100644 index b5d641f18..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_CobbleDoseRate.R +++ /dev/null @@ -1,13 +0,0 @@ -test_that("basic checks", { - testthat::skip_on_cran() - - ## simple run with example data - data("ExampleData.CobbleData", envir = environment()) - expect_s4_class(calc_CobbleDoseRate(ExampleData.CobbleData), "RLum.Results") - - ## break the function - df <- ExampleData.CobbleData - df$Distance[[14]] <- 50000 - expect_error(calc_CobbleDoseRate(df), - "Slices outside of cobble. Please check your distances and make sure they are in mm and diameter is in cm!") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_CommonDose.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_CommonDose.R deleted file mode 100644 index 7a2677361..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_CommonDose.R +++ /dev/null @@ -1,45 +0,0 @@ -data(ExampleData.DeValues, envir = environment()) -SW({ -temp <- calc_CommonDose(ExampleData.DeValues$CA1, plot = FALSE, verbose = TRUE) -temp.nolog <- calc_CommonDose(ExampleData.DeValues$CA1, log = FALSE, - plot = FALSE, verbose = TRUE) -}) - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(calc_CommonDose(), - "is missing, with no default") - expect_error(calc_CommonDose("test"), - "object has to be of type 'data.frame' or 'RLum.Results'") - expect_error(calc_CommonDose(data.frame(col = 1:10)), - "'data' object must have two columns") - expect_error(calc_CommonDose(data.frame(col = 1:10)), - "'data' object must have two columns") - expect_error(calc_CommonDose(ExampleData.DeValues$CA1, sigmab = 2), - "'sigmab' must be a value between 0 and 1") -}) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - expect_s4_class(temp, "RLum.Results") - expect_equal(length(temp), 4) - -}) - -test_that("check values from output", { - testthat::skip_on_cran() - - all.equal(calc_CommonDose(temp, verbose = FALSE), - temp) - - results <- get_RLum(temp) - expect_equal(round(results$de, digits = 5), 62.15999) - expect_equal(round(results$de_err, digits = 7), 0.7815117) - expect_true(temp@data$args$log) - expect_equal(temp@data$args$sigmab, 0) - - results <- get_RLum(temp.nolog) - expect_false(temp.nolog@data$args$log) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_CosmicDoseRate.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_CosmicDoseRate.R deleted file mode 100644 index 27a29e5ef..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_CosmicDoseRate.R +++ /dev/null @@ -1,95 +0,0 @@ -SW({ -temp <- calc_CosmicDoseRate(depth = 2.78, density = 1.7, - latitude = 38.06451, longitude = 1.49646, - altitude = 364, error = 10) -}) - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(calc_CosmicDoseRate(depth = -2), - "No negative values allowed for depth and density") - expect_error(calc_CosmicDoseRate(depth = 2.78, density = 1.7, - corr.fieldChanges = TRUE), - "requires an age estimate") - expect_error(calc_CosmicDoseRate(depth = 2.78, density = 1.7, - corr.fieldChanges = TRUE, est.age = 20, - latitude = 38.06451), - "is missing, with no default") - expect_error(calc_CosmicDoseRate(depth = 2.78, density = 1.7, - corr.fieldChanges = TRUE, est.age = 20, - latitude = 38.06451, longitude = 1.49646), - "is missing, with no default") - expect_error(calc_CosmicDoseRate(depth = 2.78, density = c(1.7, 2.9), - corr.fieldChanges = TRUE, est.age = 20, - latitude = 38.06451, longitude = 1.49646, - altitude = 364), - "If you provide more than one value for density") - expect_output(calc_CosmicDoseRate(depth = 2.78, density = 1.7, - corr.fieldChanges = TRUE, est.age = 100, - latitude = 38.0645, longitude = 1.4964, - altitude = 364), - "No geomagnetic field change correction for samples older >80 ka possible") - expect_output(calc_CosmicDoseRate(depth = 2.78, density = 1.7, - corr.fieldChanges = TRUE, est.age = 20, - latitude = 38.0645, longitude = 1.4964, - altitude = 364, half.depth = TRUE), - "No geomagnetic field change correction necessary for geomagnetic latitude >35 degrees") -}) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - expect_s4_class(temp, "RLum.Results") - expect_equal(length(temp), 3) - - ## length(depth) > length(density), half.depth - SW({ - calc_CosmicDoseRate(depth = c(2.78, 3.12), density = 1.7, - corr.fieldChanges = TRUE, est.age = 20, - latitude = 28.06451, longitude = 1.49646, - altitude = 364, half.depth = TRUE) - }) -}) - -test_that("check values from output example 1", { - testthat::skip_on_cran() - - results <- get_RLum(temp) - - expect_equal(results$depth, 2.78) - expect_equal(results$density, 1.7) - expect_equal(results$latitude, 38.06451) - expect_equal(results$longitude, 1.49646) - expect_equal(results$altitude, 364) - expect_equal(round(results$total_absorber.gcm2, digits = 0), 473) - expect_equal(round(results$d0, digits = 3), 0.152) - expect_equal(round(results$geom_lat, digits = 1), 41.1) - expect_equal(round(results$dc, digits = 3), 0.161) -}) - - -test_that("check values from output example 2b", { - testthat::skip_on_cran() - - SW({ - temp <- calc_CosmicDoseRate(depth = c(5.0, 2.78), density = c(2.65, 1.7), - latitude = 12.04332, longitude = 4.43243, - altitude = 364, corr.fieldChanges = TRUE, - est.age = 67, error = 15) - }) - results <- get_RLum(temp) - - expect_equal(results$depth.1, 5) - expect_equal(results$depth.2, 2.78) - expect_equal(results$density.1, 2.65) - expect_equal(results$density.2, 1.7) - expect_equal(results$latitude, 12.04332) - expect_equal(results$longitude, 4.43243) - expect_equal(results$altitude, 364) - expect_equal(round(results$total_absorber.gcm2, digits = 0), 1798) - expect_equal(round(results$d0, digits = 4), 0.0705) - expect_equal(round(results$geom_lat, digits = 1), 15.1) - expect_equal(round(results$dc, digits = 3), 0.072) - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_FadingCorr.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_FadingCorr.R deleted file mode 100644 index 349673cd8..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_FadingCorr.R +++ /dev/null @@ -1,86 +0,0 @@ -set.seed(1) -temp <- calc_FadingCorr( - age.faded = c(0.1,0), - g_value = c(5.0, 1.0), - tc = 2592000, - tc.g_value = 172800, - n.MC = 100, verbose = FALSE) - - - -test_that("check class and length of output", { - testthat::skip_on_cran() - - ##trigger some errors - expect_error(calc_FadingCorr(age.faded = "test", g_value = "test"), - "\\[calc_FadingCorr\\(\\)\\] 'tc' needs to be set!") - - expect_error( - calc_FadingCorr(age.faded = "test", g_value = "test", tc = 200), - "\\[calc\\_FadingCorr\\(\\)\\] 'age.faded', 'g_value' and 'tc' need be of type numeric\\!") - - ##check message - expect_message(calc_FadingCorr( - age.faded = c(6.404856, 0.51), - g_value = c(17.5,1.42), - tc = 462, - n.MC = 100), "\\[calc_FadingCorr\\(\\)\\] No solution found, return NULL. This usually happens for very large, unrealistic g-values") - - expect_s4_class(temp, "RLum.Results") - expect_equal(length(temp), 2) - - ##check the verbose mode - SW({ - expect_s4_class(calc_FadingCorr( - age.faded = c(0.1,0), - g_value = c(5.0, 1.0), - tc = 2592000, - tc.g_value = 172800, - n.MC = 1, verbose = TRUE), class = "RLum.Results") - - ## g_value provided as RLum.Results object - data("ExampleData.Fading", envir = environment()) - fading <- analyse_FadingMeasurement(ExampleData.Fading$fading.data$IR50, - plot = FALSE) - expect_s4_class(calc_FadingCorr(age.faded = c(0.1,0), - g_value = fading, tc = 2592000), - "RLum.Results") - }) - - fading@originator <- "unexpected" - expect_message( - expect_null(calc_FadingCorr(age.faded = c(0.1,0), - g_value = fading, tc = 2592000)), - "Unknown originator for the provided RLum.Results object") - - ## auto, seed (Note: this is slow!) - SW({ - calc_FadingCorr( - age.faded = c(0.1,0), - g_value = c(5.0, 1.0), - tc = 2592000, - seed = 1, - n.MC = "auto") - }) -}) - -test_that("check values from output example 1", { - testthat::skip_on_cran() - - results <- get_RLum(temp) - - expect_equal(results$AGE, 0.1169) - expect_equal(results$AGE.ERROR, 0.0035) - expect_equal(results$AGE_FADED, 0.1) - expect_equal(results$AGE_FADED.ERROR, 0) - expect_equal(results$G_VALUE, 5.312393) - expect_equal(round(results$G_VALUE.ERROR, 5), 1.01190) - expect_equal(round(results$KAPPA, 3), 0.0230) - expect_equal(round(results$KAPPA.ERROR,3), 0.004) - expect_equal(results$TC, 8.213721e-05) - expect_equal(results$TC.G_VALUE, 5.475814e-06) - expect_equal(results$n.MC, 100) - expect_equal(results$OBSERVATIONS, 100) - expect_equal(results$SEED, NA) - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_FastRatio.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_FastRatio.R deleted file mode 100644 index c96167ab1..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_FastRatio.R +++ /dev/null @@ -1,104 +0,0 @@ -data(ExampleData.CW_OSL_Curve, envir = environment()) -temp <- calc_FastRatio(ExampleData.CW_OSL_Curve, plot = FALSE, verbose = FALSE) - - -test_that("input validation", { - testthat::skip_on_cran() - - obj <- ExampleData.CW_OSL_Curve - expect_error(calc_FastRatio(obj, Ch_L1 = NULL), - "'Ch_L1' must be a positive integer scalar") - expect_error(calc_FastRatio(obj, Ch_L1 = 0), - "'Ch_L1' must be a positive integer scalar") - expect_error(calc_FastRatio(obj, Ch_L1 = c(1, 2)), - "'Ch_L1' must be a positive integer scalar") - - expect_error(calc_FastRatio(obj, Ch_L2 = 0), - "'Ch_L2' must be a positive integer scalar") - expect_error(calc_FastRatio(obj, Ch_L2 = c(1, 2)), - "'Ch_L2' must be a positive integer scalar") - - expect_error(calc_FastRatio(ExampleData.CW_OSL_Curve, - Ch_L3 = 50), - "Input for 'Ch_L3' must be a vector of length 2") - expect_error(calc_FastRatio(ExampleData.CW_OSL_Curve, - Ch_L3 = c(40, 50, 60)), - "Input for 'Ch_L3' must be a vector of length 2") - expect_error(calc_FastRatio(obj, Ch_L3 = list(4, 5)), - "Input for 'Ch_L3' must be a vector of length 2") - expect_error(calc_FastRatio(obj, Ch_L3 = c(0, 2)), - "'Ch_L3[1]' must be a positive integer scalar", - fixed = TRUE) - expect_error(calc_FastRatio(obj, Ch_L3 = c(5, 2)), - "Ch_L3[2] must be greater than or equal to Ch_L3[1]", - fixed = TRUE) - expect_error(calc_FastRatio(obj, Ch_L3 = c(5, 1001)), - "Value in Ch_L3 (5, 1001) exceeds number of available channels", - fixed = TRUE) - - expect_warning(expect_null(calc_FastRatio(ExampleData.CW_OSL_Curve, - Ch_L2 = 1)), - "Calculated time/channel for L2 is too small (0, 1)", - fixed = TRUE) - expect_warning(expect_null(calc_FastRatio(ExampleData.CW_OSL_Curve, - Ch_L2 = 2000)), - "The calculated channel for L2 (2000) exceeds the number", - fixed = TRUE) - SW({ - expect_warning(calc_FastRatio(ExampleData.CW_OSL_Curve, - Ch_L3 = c(1000, 1000)), - "The calculated channels for L3 (1000, 1000) exceed", - fixed = TRUE) - }) -}) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - expect_s4_class(temp, "RLum.Results") - expect_equal(length(temp), 5) - - ## fitCW.sigma and fitCW.curve - SW({ - calc_FastRatio(ExampleData.CW_OSL_Curve, plot = FALSE, - fitCW.sigma = TRUE, fitCW.curve = TRUE) - - ## RLum.Analysis object - data(ExampleData.XSYG, envir = environment()) - calc_FastRatio(get_RLum(OSL.SARMeasurement$Sequence.Object)[[1]]) - - expect_warning(calc_FastRatio(get_RLum(TL.Spectrum)), - "L3 contains more counts (566) than L2 (562)", - fixed = TRUE) - }) -}) - -test_that("check values from output", { - testthat::skip_on_cran() - - results <- get_RLum(temp) - - expect_equal(round(results$fast.ratio, digits = 3), 405.122) - expect_equal(round(results$fast.ratio.se, digits = 4), 119.7442) - expect_equal(round(results$fast.ratio.rse, digits = 5), 29.55756) - expect_equal(results$channels, 1000) - expect_equal(round(results$channel.width, digits = 2), 0.04) - expect_equal(results$dead.channels.start, 0) - expect_equal(results$dead.channels.end, 0) - expect_equal(results$sigmaF, 2.6e-17) - expect_equal(results$sigmaM, 4.28e-18) - expect_equal(results$stimulation.power, 30.6) - expect_equal(results$wavelength, 470) - expect_equal(results$t_L1, 0) - expect_equal(round(results$t_L2, digits = 6), 2.446413) - expect_equal(round(results$t_L3_start, digits = 5), 14.86139) - expect_equal(round(results$t_L3_end, digits = 5), 22.29208) - expect_equal(results$Ch_L1, 1) - expect_equal(results$Ch_L2, 62) - expect_equal(results$Ch_L3_start, 373) - expect_equal(results$Ch_L3_end, 558) - expect_equal(results$Cts_L1, 11111) - expect_equal(results$Cts_L2, 65) - expect_equal(round(results$Cts_L3, digits = 5), 37.66667) - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_FiniteMixture.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_FiniteMixture.R deleted file mode 100644 index a97065c5a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_FiniteMixture.R +++ /dev/null @@ -1,60 +0,0 @@ -test_that("check class and length of output", { - testthat::skip_on_cran() - - ## load example data - data(ExampleData.DeValues, envir = environment()) - - ## input validation - expect_error(calc_FiniteMixture("test"), - "object has to be of type 'data.frame' or 'RLum.Results'") - expect_error(calc_FiniteMixture(data.frame(col = 1:10)), - "'data' object must have two columns") - expect_error(calc_FiniteMixture(), - "argument .* is missing, with no default") - expect_error(calc_FiniteMixture(ExampleData.DeValues$CA1), - "argument .* is missing, with no default") - expect_error(calc_FiniteMixture(ExampleData.DeValues$CA1, sigmab = 0.2), - "argument .* is missing, with no default") - expect_error(calc_FiniteMixture(ExampleData.DeValues$CA1, sigmab = -1), - "'sigmab' must be a value between 0 and 1") - expect_error(calc_FiniteMixture(ExampleData.DeValues$CA1, sigmab = 0.2, - n.components = 1), - "At least two components need to be fitted") - expect_error(calc_FiniteMixture(ExampleData.DeValues$CA1, sigmab = 0.2, - n.components = 2, pdf.sigma = "test"), - "Only 'se' or 'sigmab' allowed for the pdf.sigma argument") - - ## simple run - SW({ - temp <- expect_s4_class(calc_FiniteMixture( - ExampleData.DeValues$CA1, - sigmab = 0.2, - n.components = 2, - grain.probability = TRUE, - verbose = TRUE), "RLum.Results") - }) - - ## check length of output - expect_equal(length(temp), 10) - - ## check for numerical regression - results <- get_RLum(temp) - expect_equal(results$de[1], 31.5299) - expect_equal(results$de[2], 72.0333) - expect_equal(results$de_err[1], 3.6387) - expect_equal(results$de_err[2], 2.4082) - expect_equal(results$proportion[1], 0.1096) - expect_equal(results$proportion[2], 0.8904) - - ## test plot - SW({ - expect_s4_class(calc_FiniteMixture( - ExampleData.DeValues$CA1, - sigmab = 0.2, - n.components = 2:3, - grain.probability = TRUE, - trace = TRUE, - main = "Plot title", - verbose = TRUE), "RLum.Results") - }) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_FuchsLang2001.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_FuchsLang2001.R deleted file mode 100755 index 1c9558ded..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_FuchsLang2001.R +++ /dev/null @@ -1,50 +0,0 @@ -test_that("check class and length of output", { - testthat::skip_on_cran() - - ##load example data - data(ExampleData.DeValues, envir = environment()) - - ##break function - expect_error(calc_FuchsLang2001( - data = "ExampleData.DeValues$BT998", - cvThreshold = 5, - plot = FALSE, - verbose = FALSE), - "\\[calc_FuchsLang2001\\(\\)\\] 'data' has to be of type 'data.frame' or 'RLum.Results'\\!") - - ##the simple and silent run - temp <- expect_s4_class( - calc_FuchsLang2001( - data = ExampleData.DeValues$BT998, - cvThreshold = 5, - plot = FALSE, - verbose = FALSE), - "RLum.Results") - - ##regression tests - expect_equal(length(temp), 4) - expect_equal(get_RLum(temp)$de, 2866.11) - expect_equal(get_RLum(temp)$de_err, 157.35) - expect_equal(get_RLum(temp)$de_weighted, 2846.66) - expect_equal(get_RLum(temp)$de_weighted_err, 20.58) - expect_equal(get_RLum(temp)$n.usedDeValues, 22) - - ## using an RLum.Results object as input - SW({ - expect_s4_class(calc_FuchsLang2001(data = temp, startDeValue = 24, - plot = FALSE), - "RLum.Results") - }) - - ##the check output - SW({ - output <- expect_s4_class( - calc_FuchsLang2001( - data = ExampleData.DeValues$BT998, - cvThreshold = 5, - plot = TRUE, - verbose = TRUE - - ), "RLum.Results") - }) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_HomogeneityTest.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_HomogeneityTest.R deleted file mode 100755 index faa4d1bdf..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_HomogeneityTest.R +++ /dev/null @@ -1,42 +0,0 @@ -##use the data example given by Galbraith (2003) -df <- - data.frame( - x = c(30.1, 53.8, 54.3, 29.0, 47.6, 44.2, 43.1), - y = c(4.8, 7.1, 6.8, 4.3, 5.2, 5.9, 3.0)) - -temp <- calc_HomogeneityTest(df, verbose = FALSE) - - -test_that("check class and length of output", { - testthat::skip_on_cran() - - expect_error(calc_HomogeneityTest(TRUE), - "'data' object has to be of type 'data.frame' or 'RLum.Results'") - - expect_s4_class(temp, "RLum.Results") - expect_equal(length(temp), 3) - - ## using an RLum.Results object as input - SW({ - expect_s4_class(calc_HomogeneityTest(temp), - "RLum.Results") - }) -}) - -test_that("check values from output example", { - testthat::skip_on_cran() - - results <- get_RLum(temp) - - ##test the normal - expect_equal(results$n, 7) - expect_equal(round(results$g.value, 4), 19.2505) - expect_equal(results$df, 6) - expect_equal(round(results$P.value,3), 0.004) - - ##test the unlogged version - SW({ - temp <- calc_HomogeneityTest(df, log = FALSE)$summary - }) - expect_equal(round(temp$P.value,3),0.001) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_Huntley2006.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_Huntley2006.R deleted file mode 100644 index 2557ce72e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_Huntley2006.R +++ /dev/null @@ -1,260 +0,0 @@ -set.seed(1) -data("ExampleData.Fading", envir = environment()) -fading_data <- ExampleData.Fading$fading.data$IR50 -data <- ExampleData.Fading$equivalentDose.data$IR50 -ddot <- c(7.00, 0.004) -readerDdot <- c(0.134, 0.0067) - -rhop <- - analyse_FadingMeasurement(fading_data, - plot = FALSE, - verbose = FALSE, - n.MC = 10) -huntley <- calc_Huntley2006( - data = data, - rhop = rhop, - ddot = ddot, - readerDdot = readerDdot, - n.MC = 50, - plot = FALSE, - verbose = FALSE -) - -test_that("input validation", { - testthat::skip_on_cran() - - rhop.test <- rhop - rhop.test@originator <- "unexpected" - - expect_error(calc_Huntley2006(), - "\"data\" is missing, with no default") - expect_error(calc_Huntley2006("test"), - "'data' must be a data frame") - - expect_error(calc_Huntley2006(data, fit.method = "test"), - "Invalid fit option 'test'") - expect_error(calc_Huntley2006(data, fit.method = "GOK", lower.bounds = 0), - "Argument 'lower.bounds' must be of length 4") - - expect_error(calc_Huntley2006(data, LnTn = list()), - "'LnTn' must be a data frame with 2 columns") - expect_error(calc_Huntley2006(data, LnTn = data), - "'LnTn' must be a data frame with 2 columns") - expect_error(calc_Huntley2006(cbind(data, data), LnTn = data[, 1:2]), - "When 'LnTn' is specified, the 'data' data frame must have") - expect_error(calc_Huntley2006(cbind(data, data[, 1])), - "The number of columns in 'data' must be a multiple of 3") - - expect_error(calc_Huntley2006(data, rhop = 1), - "'rhop' must be a vector of length 2") - expect_error(calc_Huntley2006(data, rhop = "test"), - "'rhop' must be a numeric vector or an RLum.Results object") - expect_error(calc_Huntley2006(data, rhop = rhop.test), - "'rhop' accepts RLum.Results objects only if produced by") - expect_error(calc_Huntley2006(data, rhop = c(-1, 4.9e-7)), - "'rhop' must be a positive number") - - expect_error(calc_Huntley2006(data, rhop = rhop), - "\"ddot\" is missing, with no default") - expect_error(calc_Huntley2006(data, rhop = rhop, ddot = ddot), - "\"readerDdot\" is missing, with no default") - expect_error(calc_Huntley2006(data, rhop = rhop, - ddot = "test", readerDdot = readerDdot), - "'ddot' and 'readerDdot' must be numeric vectors") - expect_error(calc_Huntley2006(data, rhop = rhop, - ddot = ddot, readerDdot = "test"), - "'ddot' and 'readerDdot' must be numeric vectors") - - SW({ - expect_warning(calc_Huntley2006(data[, 1:2], rhop = rhop, n.MC = 2, - ddot = ddot, readerDdot = readerDdot, - fit.method = "GOK"), - "'data' only had two columns") - }) -}) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - ##rhop - expect_s4_class(rhop, class = "RLum.Results") - expect_s3_class(rhop$fading_results, "data.frame") - expect_s3_class(rhop$fit, "lm") - expect_s3_class(rhop$rho_prime, "data.frame") - - ##kars - expect_s4_class(huntley, class = "RLum.Results") - expect_s3_class(huntley$results, class = "data.frame") - expect_s3_class(huntley$data, class = "data.frame") - expect_type(huntley$Ln, "double") - expect_type(huntley$fits, "list") - -}) - -test_that("check values from analyse_FadingMeasurement()", { - expect_equal(round(sum(rhop$fading_results[,1:9]),0),415) - expect_equal(round(sum(rhop$rho_prime),5),2e-05) - expect_equal(round(sum(rhop$irr.times)), 2673108) - -}) - -test_that("check values from calc_Huntley2008()", { - testthat::skip_on_cran() - - expect_equal(round(huntley$results$Sim_Age, 1), 34) - expect_equal(round(huntley$results$Sim_Age_2D0, 0), 175) - expect_equal(round(sum(huntley$Ln),2), 0.16) - - expect_equal(round(sum(huntley$data),0), 191530) - expect_equal(round(sum(residuals(huntley$fits$simulated)),1), 0.8) - expect_equal(round(sum(residuals(huntley$fits$measured)),4), 0.1894) - expect_equal(round(sum(residuals(huntley$fits$unfaded)),2), 0) -}) - -## COMPARE calc_Kars2008 (deprecated) vs. re-named calc_Huntley2006 -test_that("compare deprecated calc_Kars2008 and calc_Huntley2006", { - testthat::skip_on_cran() - - expect_identical({ - set.seed(1) - calc_Huntley2006( - data = data, - rhop = rhop, - ddot = ddot, - readerDdot = readerDdot, - n.MC = 50, - fit.method = "EXP", - plot = FALSE, verbose = FALSE)$results - }, { - set.seed(1) - suppressWarnings( - calc_Kars2008( - data = data, - rhop = rhop, - ddot = ddot, - readerDdot = readerDdot, - n.MC = 50, - fit.method = "EXP", - plot = FALSE, verbose = FALSE)$results - ) - })#EndOf::expect_identical - - expect_identical({ - set.seed(1) - calc_Huntley2006( - data = data, - rhop = rhop, - ddot = ddot, - readerDdot = readerDdot, - n.MC = 500, - fit.method = "GOK", - plot = FALSE, verbose = FALSE)$results - }, { - set.seed(1) - suppressWarnings( - calc_Kars2008( - data = data, - rhop = rhop, - ddot = ddot, - readerDdot = readerDdot, - n.MC = 500, - fit.method = "GOK", - plot = FALSE, verbose = FALSE)$results - ) - })#EndOf::expect_identical -}) - -test_that("Further tests calc_Huntley2006", { - testthat::skip_on_cran() - - ## check extrapolation - set.seed(1) - expect_s4_class( - object = suppressWarnings( - calc_Huntley2006( - data = data, - rhop = rhop, - ddot = ddot, - readerDdot = readerDdot, - n.MC = 500, - fit.method = "GOK", - mode = "extrapolation", - plot = FALSE, verbose = FALSE)), - class = "RLum.Results") - - ## check force through origin EXP with wrong mode settings - set.seed(1) - expect_s4_class( - object = suppressWarnings( - calc_Huntley2006( - data = data, - rhop = rhop, - ddot = ddot, - readerDdot = readerDdot, - n.MC = 500, - fit.method = "EXP", - fit.force_through_origin = TRUE, - mode = "extrapolation", - plot = FALSE, - verbose = FALSE)), - class = "RLum.Results") - - ## EXP ... normal - set.seed(1) - expect_s4_class( - object = suppressWarnings( - calc_Huntley2006( - data = data, - rhop = rhop, - ddot = ddot, - readerDdot = readerDdot, - n.MC = 500, - fit.method = "EXP", - fit.force_through_origin = TRUE, - mode = "interpolation", - plot = FALSE, - verbose = FALSE)), - class = "RLum.Results") - - ## GOK normal - set.seed(1) - expect_s4_class( - object = suppressWarnings( - calc_Huntley2006( - data = data, - rhop = rhop, - ddot = ddot, - readerDdot = readerDdot, - n.MC = 500, - fit.method = "GOK", - fit.force_through_origin = TRUE, - mode = "interpolation", - plot = FALSE, - verbose = FALSE)), - class = "RLum.Results") - - ## check warning for failed fits - ## dataset provided by Christine Neudorf - df <- structure(list(V1 = c(0L, 0L, 200L, 800L, 1500L, 3000L, 8000L - ), V2 = c(0.439, -0.046720922, 1.988131642, 7.577744961, 12.87699795, - 18.50187874, 32.72443771), - V3 = c(0.029, 0.01269548, 0.090232208, - 0.322242141, 0.546595156, 0.739308178, 1.285979033)), - class = "data.frame", row.names = c(NA, -7L)) - - set.seed(1) - SW({ - expect_warning(calc_Huntley2006( - data = df, - LnTn = NULL, - rhop = c(0.0000121549740899913, 4.91596040125088E-07), - ddot = c(6.96, 0.29), - readerDdot = c(0.094, 0.01), - normalise = FALSE, - fit.method = "EXP", - summary = TRUE, - plot = FALSE, - n.MC = 100), - regexp = "\\[calc\\_Huntley2006\\(\\)\\] Ln\\/Tn is smaller than the minimum computed LxTx value.") - }) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_IEU.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_IEU.R deleted file mode 100755 index 1e09b2bef..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_IEU.R +++ /dev/null @@ -1,74 +0,0 @@ -data(ExampleData.DeValues, envir = environment()) -temp <- calc_IEU(ExampleData.DeValues$CA1, - a = 0.2, - b = 1.9, - interval = 1, verbose = FALSE, plot = FALSE) - -test_that("Test general behaviour", { - testthat::skip_on_cran() - - data(ExampleData.DeValues, envir = environment()) - - ##standard - expect_silent(calc_IEU( - ExampleData.DeValues$CA1, - a = 0.2, - b = 1.9, - interval = 1, - verbose = FALSE, plot =FALSE - )) - - ##enable plot - SW({ - expect_message(calc_IEU( - ExampleData.DeValues$CA1, - a = 0.2, - b = 1.9, - interval = 1, - trace = TRUE, - verbose = TRUE, plot = TRUE - )) - }) - - ##verbose without setting - expect_message(calc_IEU( - ExampleData.DeValues$CA1, - a = 0.2, - b = 1.9, - interval = 1, - plot = FALSE - )) - - ##cause stop - expect_error(calc_IEU( - "ExampleData.DeValues$CA1", - a = 0.2, - b = 1.9, - interval = 1, - plot = FALSE - )) - - ##provide RLum.Results - ##cause stop - expect_silent(calc_IEU( - set_RLum(class = "RLum.Results", data = list(test = ExampleData.DeValues$CA1)), - a = 0.2, - b = 1.9, - interval = 1, - verbose = FALSE, plot = FALSE - )) -}) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - expect_s4_class(temp, "RLum.Results") - expect_equal(length(temp), 5) - - results <- get_RLum(temp) - - expect_equal(results$de, 46.67) - expect_equal(results$de_err, 2.55) - expect_equal(results$n, 24) - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_Lamothe2003.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_Lamothe2003.R deleted file mode 100644 index 3fa2a9881..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_Lamothe2003.R +++ /dev/null @@ -1,152 +0,0 @@ -test_that("Force function to break", { - testthat::skip_on_cran() - - ##argument check - - ##object - expect_error(calc_Lamothe2003(), regexp = "Input for 'object' missing but required!") - - ##dose_rate.envir - expect_error(calc_Lamothe2003(object = NULL), regexp = "Input for 'dose_rate.envir' missing but required!") - expect_error(calc_Lamothe2003(object = NULL, dose_rate.envir = 1, dose_rate.source = 1, g_value = 1), - regexp = "Input for 'dose_rate.envir' is not of type 'numeric' and/or of length < 2!") - - ##dose_rate.source - expect_error(calc_Lamothe2003(object = NULL, dose_rate.envir = NULL), regexp = "Input for 'dose_rate.source' missing but required!") - expect_error(calc_Lamothe2003(object = NULL, dose_rate.envir = c(1,1), dose_rate.source = 1, g_value = 1), - regexp = "Input for 'dose_rate.source' is not of type 'numeric' and/or of length < 2!") - - ##check warnings - SW({ - expect_s4_class( - suppressWarnings(calc_Lamothe2003( - object = data.frame( - x = c(0,10,20), y = c(1.4,0.7,2.3), z = c(0.01,0.02, 0.03)), - dose_rate.envir = c(1,2,3), dose_rate.source = c(1,2,3), g_value = c(1,1,1))), - "RLum.Results") - }) - - ##g_value - expect_error( - calc_Lamothe2003( - object = NULL, - dose_rate.envir = NULL, - dose_rate.source = NULL - ), - regexp = "Input for 'g_value' missing but required!" - ) - expect_error( - calc_Lamothe2003(object = NULL, dose_rate.envir = c(1,2), - dose_rate.source = c(1,2), g_value = 1), - "Input for 'g_value' is not of type 'numeric' and/or of length < 2" - ) - - ##object - expect_error(suppressWarnings( - calc_Lamothe2003( - object = NULL, - dose_rate.envir = c(1, 2, 3), - dose_rate.source = c(1, 2, 3), - g_value = c(1, 2) - )), - regexp = "Unsupported data type for 'object'" - ) - - expect_error(suppressWarnings( - calc_Lamothe2003( - object = set_RLum("RLum.Results"), - dose_rate.envir = c(1, 2, 3), - dose_rate.source = c(1, 2, 3), - g_value = c(1, 2) - )), - regexp = "Input for 'object' created by" - ) - - ##tc - expect_error( - suppressWarnings(calc_Lamothe2003( - object = set_RLum("RLum.Results"), - dose_rate.envir = c(1, 2, 3), - dose_rate.source = c(1, 2, 3), - g_value = c(1, 1), - tc.g_value = 1000 - )), - "If you set 'tc.g_value' you have to provide a value for 'tc' too!" - ) - - -}) - -test_that("Test the function itself", { - testthat::skip_on_cran() - - ##This is based on the package example - ##load data - ##ExampleData.BINfileData contains two BINfileData objects - ##CWOSL.SAR.Data and TL.SAR.Data - data(ExampleData.BINfileData, envir = environment()) - - ##transform the values from the first position in a RLum.Analysis object - object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) - - ##perform SAR analysis and set rejection criteria - results <- analyse_SAR.CWOSL( - object = object, - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - verbose = FALSE, - plot = FALSE, - onlyLxTxTable = TRUE - ) - - ##run fading correction - SW({ - expect_s4_class(calc_Lamothe2003( - object = results, - dose_rate.envir = c(1.676 , 0.180), - dose_rate.source = c(0.184, 0.003), - g_value = c(2.36, 0.6), - plot = TRUE, - fit.method = "EXP"), class = "RLum.Results") - }) - - ##run fading correction - SW({ - expect_s4_class(calc_Lamothe2003( - object = results, - dose_rate.envir = c(1.676 , 0.180), - dose_rate.source = c(0.184, 0.003), - g_value = c(2.36, 0.6), - tc = 1000, - tc.g_value = 1200, - plot = TRUE, - fit.method = "EXP"), class = "RLum.Results") - }) - - ## pretend to have an analyse_pIRIRSequence originator to increase coverage - results.mod <- results - results.mod@originator <- "analyse_pIRIRSequence" - results.mod@data$LnLxTnTx.table$Signal <- 1 - SW({ - expect_s4_class(calc_Lamothe2003( - object = results.mod, - dose_rate.envir = c(1.676 , 0.180), - dose_rate.source = c(0.184, 0.003), - g_value = c(2.36, 0.6), - plot = FALSE, - fit.method = "EXP"), class = "RLum.Results") - }) - - ## signal information present - SW({ - res <- suppressWarnings( - calc_Lamothe2003( - object = data.frame(x = c(0,10,20), y = c(1.4,0.7,2.3), - z = c(0.01,0.02, 0.03), Signal=1:3), - dose_rate.envir = c(1,2), dose_rate.source = c(1,2), - g_value = c(1,1))) - }) - expect_equal(res$data$SIGNAL, 1:3) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_MaxDose.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_MaxDose.R deleted file mode 100755 index 03f328852..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_MaxDose.R +++ /dev/null @@ -1,33 +0,0 @@ -data(ExampleData.DeValues, envir = environment()) -temp <- calc_MaxDose(ExampleData.DeValues$CA1, - sigmab = 0.2, - par = 3, - plot = TRUE, - verbose = FALSE) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - expect_s4_class(temp, "RLum.Results") - expect_equal(length(temp), 9) - -}) - -test_that("check values from output example", { - testthat::skip_on_cran() - - results <- get_RLum(temp) - - expect_equal(round(results$de, digits = 2), 76.58) - expect_equal(round(results$de_err, digits = 2), 7.57) - expect_equal(results$ci_level, 0.95) - expect_equal(round(results$ci_lower, digits = 2), 69.65) - expect_equal(round(results$ci_upper, digits = 2), 99.33) - expect_equal(results$par, 3) - expect_equal(round(results$sig, digits = 2), 1.71) - expect_equal(round(results$p0, digits = 2), 0.65) - expect_equal(results$mu, NA) - expect_equal(round(results$Lmax, digits = 2), -19.79) - expect_equal(round(results$BIC, digits = 2), 58.87) - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_MinDose.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_MinDose.R deleted file mode 100644 index 7bac4d48d..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_MinDose.R +++ /dev/null @@ -1,83 +0,0 @@ -data(ExampleData.DeValues, envir = environment()) -temp <- calc_MinDose(data = ExampleData.DeValues$CA1, - sigmab = 0.1, - verbose = FALSE, - plot = FALSE) - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(calc_MinDose(), - "is missing, with no default") - expect_error(calc_MinDose("test"), - "'data' object must be of type 'data.frame' or 'RLum.Results'") - expect_error(calc_MinDose(ExampleData.DeValues$CA1), - "is missing, with no default") - expect_error(calc_MinDose(ExampleData.DeValues$CA1, init.values = 1:4), - "'init.values' is expected to be a named list") - expect_error(calc_MinDose(ExampleData.DeValues$CA1, - init.values = list(1, 2, 3)), - "Please provide initial values for all model parameters") - expect_error(calc_MinDose(ExampleData.DeValues$CA1, - init.values = list(p0 = 0, p1 = 1, p2 = 2, mu = 3)), - "Missing parameters: gamma, sigma") - expect_error(calc_MinDose(ExampleData.DeValues$CA1, par = "error"), - "'par' must be a positive integer scalar") - expect_error(calc_MinDose(ExampleData.DeValues$CA1, par = 2), - "'par' can only be set to 3 or 4") -}) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - expect_s4_class(temp, "RLum.Results") - expect_equal(length(temp), 9) - - ## invert - expect_silent(calc_MinDose(ExampleData.DeValues$CA1, sigmab = 0.1, - invert = TRUE, verbose = FALSE, plot = FALSE)) - SW({ - expect_output(calc_MinDose(ExampleData.DeValues$CA1, sigmab = 0.1, - invert = TRUE, log = FALSE, log.output = TRUE, - verbose = TRUE, plot = FALSE), - "'log' was automatically changed to TRUE") - - ## bootstrap - expect_message(calc_MinDose(ExampleData.DeValues$CA1, sigmab = 0.1, - bootstrap = TRUE, bs.M = 10, bs.N = 5), - "Recycled Bootstrap") - expect_message(calc_MinDose(ExampleData.DeValues$CA1, sigmab = 0.1, - bootstrap = TRUE, bs.M = 10, bs.N = 5, bs.h = 5, - sigmab.sd = 0.04, debug = TRUE, - multicore = TRUE, cores = 2), - "Spawning 2 instances of R for parallel computation") - }) - - ## RLum.Results object - calc_MinDose(temp, sigmab = 0.1, verbose = FALSE, log = FALSE, par = 4, - init.values = list(gamma = 54, sigma = 1, p0 = 0.01, mu = 70)) - - ## missing values - data.na <- ExampleData.DeValues$CA1 - data.na[1, 1] <- NA - expect_message(calc_MinDose(data.na, sigmab = 0.1, verbose = FALSE), - "Input data contained NA/NaN values, which were removed") -}) - -test_that("check values from output example", { - testthat::skip_on_cran() - - results <- get_RLum(temp) - - expect_equal(round(results$de, digits = 5), 34.31834) - expect_equal(round(results$de_err, digits = 6), 2.550964) - expect_equal(results$ci_level, 0.95) - expect_equal(round(results$ci_lower, digits = 5), 29.37526) - expect_equal(round(results$ci_upper, digits = 5), 39.37503) - expect_equal(results$par, 3) - expect_equal(round(results$sig, digits = 2), 2.07) - expect_equal(round(results$p0, digits = 8), 0.01053938) - expect_equal(results$mu, NA) - expect_equal(round(results$Lmax, digits = 5), -43.57969) - expect_equal(round(results$BIC, digits = 4), 106.4405) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_OSLLxTxDecomposed.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_OSLLxTxDecomposed.R deleted file mode 100644 index 68fdcebea..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_OSLLxTxDecomposed.R +++ /dev/null @@ -1,36 +0,0 @@ -data(ExampleData.LxTxOSLData, envir = environment()) -colnames(Lx.data) <- colnames(Tx.data) <- c("n", "n.error") - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(calc_OSLLxTxDecomposed(), - "is missing, with no default") - expect_error(calc_OSLLxTxDecomposed("test"), - "No valid component data.frame for Lx value") - expect_error(calc_OSLLxTxDecomposed(data.frame(col = integer(0))), - "No valid component data.frame for Lx value") - expect_error(calc_OSLLxTxDecomposed(Lx.data, "test"), - "No valid component data.frame for Tx value") - expect_error(calc_OSLLxTxDecomposed(Lx.data, data.frame(col = integer(0))), - "No valid component data.frame for Tx value") - expect_error(calc_OSLLxTxDecomposed(Lx.data, Tx.data, - OSL.component = NA), - "Invalid data type for OSL component") - expect_error(calc_OSLLxTxDecomposed(Lx.data, Tx.data, - OSL.component = "error"), - "Invalid OSL component name, valid names are:") - expect_error(calc_OSLLxTxDecomposed(Lx.data, Tx.data, - OSL.component = 1000), - "Invalid OSL component index, component table has 100 rows") - expect_error(calc_OSLLxTxDecomposed(Lx.data, digits = NA), - "'digits' must be a positive integer scalar") -}) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - res <- calc_OSLLxTxDecomposed(Lx.data, Tx.data, digits = 2) - expect_equal(is(res), c("RLum.Results", "RLum")) - expect_equal(length(res), 1) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_OSLLxTxRatio.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_OSLLxTxRatio.R deleted file mode 100755 index 48da57aec..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_OSLLxTxRatio.R +++ /dev/null @@ -1,325 +0,0 @@ -##preloads -data(ExampleData.LxTxOSLData, envir = environment()) -temp <- calc_OSLLxTxRatio( - Lx.data = Lx.data, - Tx.data = Tx.data, - signal.integral = c(1:2), - background.integral = c(85:100)) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - expect_equal(is(temp), c("RLum.Results", "RLum")) - expect_equal(length(temp), 2) - -}) - -test_that("test arguments", { - testthat::skip_on_cran() - - ##digits - expect_silent(calc_OSLLxTxRatio( - Lx.data, - Tx.data, - signal.integral = c(1:2), - background.integral = c(85:100), - digits = 1)) - - ##sigmab - expect_silent(calc_OSLLxTxRatio( - Lx.data, - Tx.data, - signal.integral = c(1:2), - background.integral = c(85:100), - sigmab = c(1000,100) - )) - - ##poisson - expect_silent(calc_OSLLxTxRatio( - Lx.data, - Tx.data, - signal.integral = c(1:2), - background.integral = c(85:100), - background.count.distribution = "poisson" - )) - -}) - - -test_that("test input", { - testthat::skip_on_cran() - - ##RLum.Curve - expect_silent(calc_OSLLxTxRatio( - set_RLum(class = "RLum.Data.Curve", data = as.matrix(Lx.data)), - set_RLum(class = "RLum.Data.Curve", data = as.matrix(Tx.data)), - signal.integral = c(1:2), - background.integral = c(70:100))) - - ##matrix - expect_silent(calc_OSLLxTxRatio( - as.matrix(Lx.data), - as.matrix(Tx.data), - signal.integral = c(1:2), - background.integral = c(70:100))) - - ##numeric - expect_silent(calc_OSLLxTxRatio( - as.numeric(Lx.data[,2]), - as.numeric(Tx.data[,2]), - signal.integral = c(1:2), - background.integral = c(70:100))) - - - ##RLum.Curve - expect_silent(calc_OSLLxTxRatio( - set_RLum(class = "RLum.Data.Curve", data = as.matrix(Lx.data)), - Tx.data = NULL, - signal.integral = c(1:2), - background.integral = c(70:100))) - - ##matrix - expect_silent(calc_OSLLxTxRatio( - as.matrix(Lx.data), - Tx.data = NULL, - signal.integral = c(1:2), - background.integral = c(70:100))) - - ##numeric - expect_silent(calc_OSLLxTxRatio( - as.numeric(Lx.data[,2]), - Tx.data = NULL, - signal.integral = c(1:2), - background.integral = c(70:100))) - -}) - -test_that("force function break", { - testthat::skip_on_cran() - - expect_error(calc_OSLLxTxRatio( - Lx.data[1:10,], - Tx.data, - signal.integral = c(1:2), - background.integral = c(85:100) - ), "Channel numbers of Lx and Tx data differ!") - - expect_error(calc_OSLLxTxRatio( - "Lx.data", - Tx.data, - signal.integral = c(1:2), - background.integral = c(85:100) - ), "Data type of Lx and Tx data differs!") - - expect_error(calc_OSLLxTxRatio( - "Lx.data", - "Tx.data", - signal.integral = c(1:2), - background.integral = c(85:100) - ), "Data type error! Required types are data.frame or numeric vector.") - - - expect_error(calc_OSLLxTxRatio( - Lx.data, - Tx.data, - signal.integral = c(1:2000), - background.integral = c(85:100) - ), "signal.integral is not valid!") - - expect_error(calc_OSLLxTxRatio( - Lx.data, - Tx.data, - signal.integral = c(1:90), - background.integral = c(85:100) - ), "Overlapping of 'signal.integral' and 'background.integral' is not permitted!") - - expect_error(calc_OSLLxTxRatio( - Lx.data, - Tx.data, - signal.integral = c(1:10), - signal.integral.Tx = c(1:90), - background.integral = c(85:100), - background.integral.Tx = c(85:100) - ), "Overlapping of 'signal.integral.Tx' and 'background.integral.Tx' is not permitted!") - - expect_error(calc_OSLLxTxRatio( - Lx.data, - Tx.data, - signal.integral = c(1:20), - background.integral = c(85:1000) - ), "background.integral is not valid! Max: 100") - - expect_error(calc_OSLLxTxRatio( - Lx.data, - Tx.data, - signal.integral = c(1:10), - signal.integral.Tx = c(1:10), - background.integral = c(85:100), - background.integral.Tx = c(85:10000) - ), "background.integral.Tx is not valid! Max: 100") - - expect_error(calc_OSLLxTxRatio( - Lx.data, - Tx.data, - signal.integral = c(1:10), - signal.integral.Tx = c(1:1000), - background.integral = c(85:100), - background.integral.Tx = c(85:100) - ), "signal.integral.Tx is not valid!") - - expect_error(calc_OSLLxTxRatio( - Lx.data, - Tx.data, - signal.integral = c(1:20), - signal.integral.Tx = c(1:20), - background.integral = 80:100, - background.integral.Tx = NULL - ), "You have to provide both: signal.integral.Tx and background.integral.Tx!") - - expect_error(calc_OSLLxTxRatio( - Lx.data, - Tx.data, - signal.integral = c(1:20), - background.integral = 80:100, - sigmab = "test" - ), "'sigmab' has to be of type numeric.") - - expect_error(calc_OSLLxTxRatio( - Lx.data, - Tx.data, - signal.integral = c(1:20), - background.integral = 80:100, - sigmab = 1:100 - ), "Maximum allowed vector length for 'sigmab' is 2.") - - -}) - -test_that("create warnings", { - testthat::skip_on_cran() - - expect_warning(calc_OSLLxTxRatio( - Lx.data, - Tx.data, - signal.integral = c(1:20), - signal.integral.Tx = c(1:20), - background.integral = 80:100, - background.integral.Tx = 60:100 - ), "Number of background channels for Lx < 25; error estimation might not be reliable!") - - expect_warning(calc_OSLLxTxRatio( - Lx.data, - Tx.data, - signal.integral = c(1:20), - signal.integral.Tx = c(1:20), - background.integral = 60:100, - background.integral.Tx = 80:100 - ), "Number of background channels for Tx < 25; error estimation might not be reliable!",) - - expect_warning(calc_OSLLxTxRatio( - Lx.data, - Tx.data, - signal.integral = c(1:20), - background.integral = 60:100, - background.count.distribution = "hallo" - ), "Unknown method for background.count.distribution. A non-poisson distribution is assumed!") - - expect_warning(calc_OSLLxTxRatio( - Lx.data, - Tx.data, - signal.integral = c(1:20), - signal.integral.Tx = c(2:20), - background.integral = 60:100, - background.integral.Tx = 40:100, - use_previousBG = TRUE - ), "For option use_previousBG = TRUE independent Lx and Tx integral limits are not allowed. Integral limits of Lx used for Tx.") - -}) - - -test_that("check weird circumstances", { - testthat::skip_on_cran() - - ##(1) - Lx curve 0 - expect_type(calc_OSLLxTxRatio( - data.frame(Lx.data[,1],0), - Tx.data, - signal.integral = c(1:2), - background.integral = c(85:100) - )$LxTx.table, type = "list") - - - ##(2) - Tx curve 0 - expect_type(calc_OSLLxTxRatio( - Lx.data, - data.frame(Tx.data[,1],0), - signal.integral = c(1:2), - background.integral = c(85:100) - )$LxTx.table, type = "list") - - ##(3) - Lx and Tx curve 0 - expect_type(calc_OSLLxTxRatio( - data.frame(Lx.data[,1],0), - data.frame(Tx.data[,1],0), - signal.integral = c(1:2), - background.integral = c(85:100) - )$LxTx.table, type = "list") - - ##(4) - Lx < 0 - expect_type(calc_OSLLxTxRatio( - data.frame(Lx.data[,1],-1000), - data.frame(Tx.data[,1],0), - signal.integral = c(1:2), - background.integral = c(85:100) - )$LxTx.table, type = "list") - - ##(5) - Tx < 0 - expect_type(calc_OSLLxTxRatio( - Lx.data, - data.frame(Lx.data[,1],-1000), - signal.integral = c(1:2), - background.integral = c(85:100) - )$LxTx.table, type = "list") - - ##(6) - Lx & Tx < 0 - expect_type(calc_OSLLxTxRatio( - data.frame(Lx.data[,1],-1000), - data.frame(Tx.data[,1],-1000), - signal.integral = c(1:2), - background.integral = c(85:100) - )$LxTx.table, type = "list") - - -}) - -test_that("check values from output example", { - testthat::skip_on_cran() - - results <- get_RLum(temp) - - expect_equal(results$LnLx, 81709) - expect_equal(results$LnLx.BG, 530) - expect_equal(results$TnTx, 7403) - expect_equal(results$TnTx.BG, 513) - expect_equal(results$Net_LnLx, 81179) - expect_equal(round(results$Net_LnLx.Error, digits = 4), 286.5461) - expect_equal(results$Net_TnTx, 6890) - expect_equal(round(results$Net_TnTx.Error, digits = 5), 88.53581) - expect_equal(round(results$LxTx, digits = 5), 11.78215) - expect_equal(round(results$LxTx.Error, digits = 7), 0.1570077) - -}) - -test_that("test NA mode with no signal integrals", { - testthat::skip_on_cran() - - data(ExampleData.LxTxOSLData, envir = environment()) - temp <- expect_s4_class(calc_OSLLxTxRatio( - Lx.data = Lx.data, - Tx.data = Tx.data, - signal.integral = NA, - background.integral = NA), "RLum.Results") - - expect_equal(round(sum(temp$LxTx.table[1,]),0), 391926) - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_SourceDoseRate.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_SourceDoseRate.R deleted file mode 100755 index 1f3983c5c..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_SourceDoseRate.R +++ /dev/null @@ -1,72 +0,0 @@ -temp <- calc_SourceDoseRate(measurement.date = "2012-01-27", - calib.date = "2014-12-19", - calib.dose.rate = 0.0438, - calib.error = 0.0019) - - -test_that("General tests", { - testthat::skip_on_cran() - - ##simple run - expect_silent(calc_SourceDoseRate( - calib.date = "2014-12-19", - calib.dose.rate = 0.0438, - calib.error = 0.0019 - )) - - ##simple run - expect_silent(calc_SourceDoseRate( - measurement.date = "2018-01-02", - calib.date = "2014-12-19", - calib.dose.rate = 0.0438, - calib.error = 0.0019 - )) - - ##simple run predict - expect_silent(calc_SourceDoseRate( - measurement.date = "2018-01-02", - calib.date = "2014-12-19", - calib.dose.rate = 0.0438, - calib.error = 0.0019, - predict = 10 - )) - - ##Gy/min as unit - expect_silent(calc_SourceDoseRate( - measurement.date = "2018-01-02", - calib.date = "2014-12-19", - calib.dose.rate = 0.0438, - calib.error = 0.0019, dose.rate.unit = "Gy/min" - )) - - - ##cause stop - expect_error(calc_SourceDoseRate( - measurement.date = "2018-01-02", - calib.date = "2014-12-19", - calib.dose.rate = 0.0438, - calib.error = 0.0019, source.type = "SK" - )) - - - -}) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - expect_equal(is(temp), c("RLum.Results", "RLum")) - expect_equal(length(temp), 3) - -}) - -test_that("check values from output example 1", { - testthat::skip_on_cran() - - results <- get_RLum(temp) - - expect_equal(round(results$dose.rate, digits = 8), 0.04695031) - expect_equal(round(results$dose.rate.error, digits = 9), 0.002036657) - expect_equal(results$date, as.Date("2012-01-27")) - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_Statistics.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_Statistics.R deleted file mode 100644 index 3fe93e2c8..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_Statistics.R +++ /dev/null @@ -1,95 +0,0 @@ -## load example data -data(ExampleData.DeValues, envir = environment()) - -## calculate statistics and show output -set.seed(1) -temp <- calc_Statistics(ExampleData.DeValues$BT998, n.MCM = 1000) -temp_alt1 <- calc_Statistics(ExampleData.DeValues$BT998, n.MCM = 1000, digits = 2) -temp_alt2 <- calc_Statistics(ExampleData.DeValues$BT998, n.MCM = 1000, digits = NULL) -temp_RLum <- set_RLum(class = "RLum.Results", data = list(data = ExampleData.DeValues$BT998)) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - expect_type(temp, "list") - expect_equal(length(temp), 3) - -}) - -test_that("Test certain input scenarios", { - expect_type(calc_Statistics(temp_RLum), "list") - - df <- ExampleData.DeValues$BT998 - df[, 2] <- NULL - expect_warning(calc_Statistics(df)) - - df <- ExampleData.DeValues$BT998 - df[,2] <- 0 - expect_warning(calc_Statistics(df)) - - df <- ExampleData.DeValues$BT998 - expect_silent(calc_Statistics(df, weight.calc = "reciprocal")) -}) - - -test_that("check error messages", { - testthat::skip_on_cran() - - df <- ExampleData.DeValues$BT998 - - expect_error(calc_Statistics(data = matrix(0,2)), - regexp = "[calc_Statistics()] Input data is neither of type 'data.frame' nor 'RLum.Results'", - fixed = TRUE) - expect_error(calc_Statistics(data = df, weight.calc = "test")) - -}) - - -test_that("check weighted values from output", { - testthat::skip_on_cran() - - expect_equal(temp$weighted$n, 25) - expect_equal(sum(unlist(temp_alt1)),18558.37) - expect_equal(sum(unlist(temp_alt2)),18555.994) - expect_equal(round(temp$weighted$mean, digits = 3), 2896.036) - expect_equal(round(temp$weighted$median, digits = 2), 2884.46) - expect_equal(round(temp$weighted$sd.abs, digits = 4), 240.2228) - expect_equal(round(temp$weighted$sd.rel, digits = 6), 8.294885) - expect_equal(round(temp$weighted$se.abs, digits = 5), 48.04457) - expect_equal(round(temp$weighted$se.rel, digits = 6), 1.658977) - expect_equal(round(temp$weighted$skewness, digits = 6), 1.342018) - expect_equal(round(temp$weighted$kurtosis, digits = 6), 4.387913) - - -}) - -test_that("check unweighted values from output", { - testthat::skip_on_cran() - - expect_equal(temp$weighted$n, 25) - expect_equal(round(temp$unweighted$mean, digits = 3), 2950.818) - expect_equal(round(temp$unweighted$median, digits = 2), 2884.46) - expect_equal(round(temp$unweighted$sd.abs, digits = 4), 281.6433) - expect_equal(round(temp$unweighted$sd.rel, digits = 6), 9.544584) - expect_equal(round(temp$unweighted$se.abs, digits = 5), 56.32866) - expect_equal(round(temp$unweighted$se.rel, digits = 6), 1.908917) - expect_equal(round(temp$unweighted$skewness, digits = 6), 1.342018) - expect_equal(round(temp$unweighted$kurtosis, digits = 6), 4.387913) - - -}) - -test_that("check MCM values from output", { - - expect_equal(temp$MCM$n, 25) - expect_equal(round(temp$MCM$mean, digits = 3), 2950.992) - expect_equal(round(temp$MCM$median, digits = 3), 2885.622) - expect_equal(round(temp$MCM$sd.abs, digits = 4), 295.0737) - expect_equal(round(temp$MCM$sd.rel, digits = 6), 9.999137) - expect_equal(round(temp$MCM$se.abs, digits = 5), 59.01474) - expect_equal(round(temp$MCM$se.rel, digits = 6), 1.999827) - expect_equal(round(temp$MCM$skewness, digits = 3), 1.286) - expect_equal(round(temp$MCM$kurtosis, digits = 3), 4.757) - - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_TLLxTxRatio.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_TLLxTxRatio.R deleted file mode 100644 index bcce57d93..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_TLLxTxRatio.R +++ /dev/null @@ -1,111 +0,0 @@ -test_that("calc_TLLxTxRatio", { - testthat::skip_on_cran() - - ##load package example data - data(ExampleData.BINfileData, envir = environment()) - - ##convert Risoe.BINfileData into a curve object - temp <- Risoe.BINfileData2RLum.Analysis(TL.SAR.Data, pos = 3) - Lx.data.signal <- get_RLum(temp, record.id = 1) - Lx.data.background <- get_RLum(temp, record.id = 2) - Tx.data.signal <- get_RLum(temp, record.id = 3) - Tx.data.background <- get_RLum(temp, record.id = 4) - signal.integral.min <- 210 - signal.integral.max <- 230 - - ## break the function - ## different data types - expect_error(calc_TLLxTxRatio( - Lx.data.signal, - Lx.data.background, - Tx.data.signal = as.data.frame(Tx.data.signal), - Tx.data.background, - signal.integral.min, - signal.integral.max), - regexp = "\\[calc\\_TLLxTxRatio\\(\\)\\] Data types of Lx and Tx data differ.+") - - ## different data types - expect_error(calc_TLLxTxRatio( - Lx.data.signal, - Lx.data.background, - Tx.data.signal = as.data.frame(Tx.data.signal), - Tx.data.background, - signal.integral.min, - signal.integral.max), - regexp = "\\[calc\\_TLLxTxRatio\\(\\)\\] Data types of Lx and Tx data differ.+") - - ## check for allowed data types - expect_error(calc_TLLxTxRatio( - Lx.data.signal = as.matrix(Tx.data.signal), - Lx.data.background, - Tx.data.signal = as.matrix(Tx.data.signal), - Tx.data.background, - signal.integral.min, - signal.integral.max), - regexp = "\\[calc\\_TLLxTxRatio\\(\\)\\] Input data type for not allowed.+") - - ## check for different channel numbers - expect_error(calc_TLLxTxRatio( - Lx.data.signal = as.data.frame(Tx.data.signal)[1:10,], - Lx.data.background, - Tx.data.signal = as.data.frame(Tx.data.signal), - Tx.data.background, - signal.integral.min, - signal.integral.max), - regexp = "\\[calc\\_TLLxTxRatio\\(\\)\\] Channel numbers differ for Lx and Tx data.+") - - ## use invalid signal integral - expect_error(calc_TLLxTxRatio( - Lx.data.signal, - Lx.data.background, - Tx.data.signal, - Tx.data.background, - signal.integral.min = 10, - signal.integral.max = 1000), - regexp = "\\[calc\\_TLLxTxRatio\\(\\)\\] signal.integral is not valid.+") - - ## trigger warning - expect_warning(calc_TLLxTxRatio( - Lx.data.signal, - Lx.data.background, - Tx.data.signal, - Tx.data.background = Lx.data.background, - signal.integral.min, - signal.integral.max), - regexp = "\\[calc\\_TLLxTxRatio\\(\\)\\] The background signals for Lx and Tx appear to be similar.+") - - ## run function without error - temp <- expect_s4_class(calc_TLLxTxRatio( - Lx.data.signal, - Lx.data.background, - Tx.data.signal, - Tx.data.background, - signal.integral.min, - signal.integral.max), class = "RLum.Results") - - ## check lenght - expect_equal(length(temp), 1) - - ## extract elements - results <- get_RLum(temp) - - expect_equal(length(results), 10) - expect_equal(results$LnLx, 257042) - expect_equal(results$LnLx.BG, 4068) - expect_equal(results$TnTx, 82298) - expect_equal(results$TnTx.BG, 2943) - expect_equal(results$net_LnLx, 252974) - expect_equal(round(results$net_LnLx.Error, digits = 2), 49468.92) - expect_equal(results$net_TnTx, 79355) - expect_equal(round(results$net_TnTx.Error,2), 21449.72) - expect_equal(round(results$LxTx, digits = 6), 3.187877) - expect_equal(round(results$LxTx.Error, digits = 6), 1.485073) - - expect_s4_class(calc_TLLxTxRatio( - Lx.data.signal, - Lx.data.background=NULL, - Tx.data.signal, - Tx.data.background=NULL, - signal.integral.min, - signal.integral.max), class = "RLum.Results") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_ThermalLifetime.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_ThermalLifetime.R deleted file mode 100644 index dce5e3648..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_ThermalLifetime.R +++ /dev/null @@ -1,110 +0,0 @@ -##EXAMPLE 1 -##calculation for two trap-depths with similar frequency factor for different temperatures -set.seed(1) -temp <- calc_ThermalLifetime( - E = c(1.66, 1.70), - s = 1e+13, - T = 10:20, - output_unit = "Ma", - verbose = FALSE -) - -##EXAMPLE 2 -##profiling of thermal life time for E and s and their standard error -temp2 <- calc_ThermalLifetime( - E = c(1.600, 0.003), - s = c(1e+13,1e+011), - T = 20, - profiling = TRUE, - output_unit = "Ma", - verbose = FALSE, - plot = FALSE -) - - -test_that("check class and length of output example 1", { - testthat::skip_on_cran() - - expect_s4_class(temp, "RLum.Results") - expect_equal(length(temp), 2) - -}) -# -test_that("check values from output example 1", { - testthat::skip_on_cran() - - expect_type(temp$lifetimes, "double") - expect_equal(dim(temp$lifetimes), c(1, 2, 11)) - - ##check results for 10 °C - results <- lapply(1:length(10:20), function(x){ - temp$lifetimes[,,x] - }) - - expect_equal(round(results[[1]], digits = 3), c("1.66" = 1115.541, "1.7" = 5747.042)) - expect_equal(round(results[[2]], digits = 4), c("1.66" = 878.0196, "1.7" = 4497.3585)) - expect_equal(round(results[[3]], digits = 4), c("1.66" = 692.2329, "1.7" = 3525.4738)) - expect_equal(round(results[[4]], digits = 4), c("1.66" = 546.6658, "1.7" = 2768.3216)) - expect_equal(round(results[[5]], digits = 4), c("1.66" = 432.4199, "1.7" = 2177.4436)) - expect_equal(round(results[[6]], digits = 4), c("1.66" = 342.6069, "1.7" = 1715.5406)) - expect_equal(round(results[[7]], digits = 4), c("1.66" = 271.8854, "1.7" = 1353.8523)) - expect_equal(round(results[[8]], digits = 4), c("1.66" = 216.1065, "1.7" = 1070.1642)) - expect_equal(round(results[[9]], digits = 4), c("1.66" = 172.0421, "1.7" = 847.2879)) - expect_equal(round(results[[10]], digits = 4), c("1.66" = 137.1765, "1.7" = 671.9020)) - expect_equal(round(results[[11]], digits = 4), c("1.66" = 109.5458, "1.7" = 533.6641)) - -}) - - -test_that("check class and length of output example 2", { - testthat::skip_on_cran() - expect_s4_class(temp2, c("RLum.Results")) - testthat::expect_equal(length(temp2), 2) - -}) - -test_that("check values from output example 2", { - testthat::skip_on_cran() - - testthat::expect_type(temp2$lifetimes, "double") - testthat::expect_equal(class(temp2$lifetimes), "numeric") - testthat::expect_equal(length(temp2$lifetimes), 1000) - testthat::expect_equal(dim(temp2$profiling_matrix), c(1000, 4)) -}) - - -test_that("check arguments", { - testthat::skip_on_cran() - - ##missing E and/or s - expect_error(calc_ThermalLifetime(), - "'E' or 's' or both are missing, but required") - - ##profiling settings - SW({ - expect_warning( - calc_ThermalLifetime(E = 1.4, s = 1e05, profiling_config = list(n = 10)), - "Minimum MC runs are 1000, parameter 'n' in profiling_config reset to 1000") - }) - expect_error(calc_ThermalLifetime( - E = 1.4, - s = 1e05, - profiling = TRUE, - profiling_config = list(E.distribution = "test") - ), "Unknown distribution setting for E profiling") - expect_error(suppressWarnings(calc_ThermalLifetime( - E = 1.4, - s = 1e05, - profiling = TRUE, - profiling_config = list(s.distribution = "test")) - ), "Unknown distribution setting for s profiling") - - ##output - SW({ - expect_warning(calc_ThermalLifetime(E = 1.4, s = 1e05, output_unit = "test"), - "'output_unit' unknown, reset to 's'") - }) - expect_output(calc_ThermalLifetime(E = 1.4, s = 1e05, verbose = TRUE)) - expect_output(calc_ThermalLifetime(E = c(1.4, 0.001), s = c(1e05,1e03), plot = TRUE, profiling = TRUE)) - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_WodaFuchs2008.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_WodaFuchs2008.R deleted file mode 100644 index 88ebbc5bd..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_WodaFuchs2008.R +++ /dev/null @@ -1,47 +0,0 @@ -data(ExampleData.DeValues, envir = environment()) - -test_that("input validation", { - testthat::skip_on_cran() - - expect_warning(expect_null(calc_WodaFuchs2008("error")), - "Input data must be one of 'data.frame', 'RLum.Results' or") - res <- calc_WodaFuchs2008(ExampleData.DeValues$CA1) - expect_error(calc_WodaFuchs2008(res, breaks = 4), - "Insufficient number of data points") -}) - -test_that("Test general functionality", { - testthat::skip_on_cran() - - ##test arguments - expect_s4_class(calc_WodaFuchs2008(ExampleData.DeValues$CA1), - "RLum.Results") - expect_s4_class(calc_WodaFuchs2008(ExampleData.DeValues$CA1, plot = FALSE), - "RLum.Results") - expect_s4_class(calc_WodaFuchs2008(ExampleData.DeValues$CA1, breaks = 20), - "RLum.Results") - expect_warning(calc_WodaFuchs2008(ExampleData.DeValues$CA1[1:40, ]), - "More than one maximum, fit may be invalid") - - ## issue #197 - set.seed(1) - df <- data.frame(rnorm(20, 10), rnorm(20, 0.5)) - expect_silent(calc_WodaFuchs2008(df)) - - ## more coverage - expect_warning(calc_WodaFuchs2008(df, breaks = 3), - "Fewer than 4 bins produced, 'breaks' set to 4") - expect_output(calc_WodaFuchs2008(df, trace = TRUE)) - - ## numeric vector - expect_message(calc_WodaFuchs2008(df[, 1]), - "No errors provided") - - ## single-column data.frame - expect_message(calc_WodaFuchs2008(df[, 1, drop = FALSE]), - "No errors provided") - - ## RLum.Results object - obj <- calc_CommonDose(ExampleData.DeValues$BT998, verbose = FALSE) - expect_silent(calc_WodaFuchs2008(obj)) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_gSGC.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_gSGC.R deleted file mode 100644 index 21cd73e4a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_gSGC.R +++ /dev/null @@ -1,55 +0,0 @@ -df <- data.frame(LnTn = 2.361, LnTn.error = 0.087, - Lr1Tr1 = 2.744, Lr1Tr1.error = 0.091, - Dr1 = 34.4) - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(calc_gSGC(data = NA), - "'data' must be a data.frame") - expect_error(calc_gSGC(data.frame(a = 1, b = 1, c = 1, d = 1, e = 1, f = 1)), - "'data' is expected to have 5 columns") - expect_error(calc_gSGC(df, gSGC.type = 3), - "'gSGC.type' must be of type 'character'") - expect_error(calc_gSGC(df, gSGC.type = "error"), - "Unknown 'gSGC.type'") -}) - -test_that("check functionality", { - testthat::skip_on_cran() - - SW({ - expect_s4_class(calc_gSGC(data = df, - gSGC.type = "0-450", - plot = TRUE, - verbose = TRUE - ), "RLum.Results") - - pars <- list(A = 0, A.error = 0, D0 = 0, D0.error = 0, - c = 0, c.error = 0, Y0 = 0, Y0.error = 0) - expect_s4_class(calc_gSGC(data = df, gSGC.parameters = pars), - "RLum.Results") - }) - - set.seed(seed = 1) - temp <- calc_gSGC(df, plot = FALSE, verbose = FALSE) - - expect_s4_class(temp, "RLum.Results") - expect_s3_class(temp$De, "data.frame") - expect_type(temp$De.MC, "list") - expect_equal(length(temp), 3) - - expect_equal(round(sum(temp$De), digits = 2), 30.39) - expect_equal(round(sum(temp$De.MC[[1]]), 0), 10848) - - ## apply some random values for more coverage - df1 <- data.frame(LnTn = 0.361, LnTn.error = 2.087, - Lr1Tr1 = 0.744, Lr1Tr1.error = 10.091, - Dr1 = 0.4) - expect_silent(calc_gSGC(df1, plot = TRUE, verbose = FALSE)) - - df2 <- data.frame(LnTn = 10.361, LnTn.error = 0.087, - Lr1Tr1 = 0.044, Lr1Tr1.error = 0.091, - Dr1 = 0.04) - expect_silent(calc_gSGC(df2, plot = TRUE, verbose = FALSE)) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_gSGC_feldspar.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_gSGC_feldspar.R deleted file mode 100644 index 304b49b19..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_calc_gSGC_feldspar.R +++ /dev/null @@ -1,77 +0,0 @@ -test_that("test errors", { - testthat::skip_on_cran() - - ##crash function - ##no data.frame - expect_error(calc_gSGC_feldspar( - data = "data", - gSGC.type = "50LxTx", - plot = FALSE), - "\\[calc_gSGC_feldspar\\(\\)\\] 'data' needs to be of type data.frame.") - - ##no character - expect_error(calc_gSGC_feldspar( - data = data.frame(), - gSGC.type = 1, - plot = FALSE), - "\\[calc_gSGC_feldspar\\(\\)\\] 'gSGC.type' needs to be of type character.") - - ## input is somewhat not what we expect for gSGC - expect_error( - calc_gSGC_feldspar( - data = data.frame(a = 1, b = 1, c = 1, d = 1, e = 1), - gSGC.type = "wrong", - plot = FALSE - ), - "\\[calc_gSGC_feldspar\\(\\)\\] 'gSGC.type' needs to be one of the accepted values" - ) - - ## incorrect number of columns - expect_error( - calc_gSGC_feldspar( - data = data.frame(a = 1, b = 1, c = 1, d = 1), - gSGC.type = "50LxTx", - plot = FALSE - ), - "Structure of 'data' does not fit the expectations" - ) - - ##finally run with plot output - #test on a generated random sample - set.seed(1234) - n_samples <- 2 - data <- data.frame( - LnTn = rnorm(n=n_samples, mean=1.0, sd=0.02), - LnTn.error = rnorm(n=n_samples, mean=0.05, sd=0.002), - Lr1Tr1 = rnorm(n=n_samples, mean=1.0, sd=0.02), - Lr1Tr1.error = rnorm(n=n_samples, mean=0.05, sd=0.002), - Dr1 = rep(100,n_samples)) - - results <- expect_s4_class(calc_gSGC_feldspar( - data = data, - gSGC.type = "50LxTx", - plot = TRUE), - "RLum.Results") - - ## test own curve parameters - SW({ - expect_message(results <- calc_gSGC_feldspar( - data = data, - gSGC.parameters = data.frame( - y1 = 0.6, - y1_err = 0.2, - D1 = 250, - D1_err = 50, - y2 = 0.90, - y2_err = 0.10, - y0 = 0.001, - y0_err = 0.0001 - )), - "No solution found for dataset") - }) - - ##regression tests - expect_s4_class(results, "RLum.Results") - expect_true(all(is.na(unlist(results$m.MC)))) - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_combine_De_Dr.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_combine_De_Dr.R deleted file mode 100644 index b1e75ae38..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_combine_De_Dr.R +++ /dev/null @@ -1,94 +0,0 @@ -test_that("Test combine_De_Dr", { - testthat::skip_on_cran() - - ## simple test using the example - ## set parameters - Dr <- stats::rlnorm(1000, 0, 0.3) - De <- 50*sample(Dr, 50, replace = TRUE) - s <- stats::rnorm(50, 10, 2) - - ## set seed - set.seed(1276) - - ## break function - SW({ - expect_error(combine_De_Dr( - Dr = Dr, - int_OD = 0.1, - De, - s[-1]), "\\[combine_De_Dr\\(\\)\\] \\'De\\' and \\'s\\' are not of similar length!") - - ## simple run with standard settings - results <- expect_s4_class(combine_De_Dr( - Dr = Dr, - int_OD = 0.1, - De, - s, - outlier_analysis_plot = TRUE, - Age_range = c(0, 100), - cdf_ADr_quantiles = FALSE, - legend.pos = "topright", - legend = TRUE, - method_control = list(n.iter = 100, - n.chains = 1)), "RLum.Results") - }) - - ## check whether mcmc is NULL - expect_null(results$mcmc_IAM) - expect_null(results$mcmc_BCAM) - - ## run the same with different par settings - oldpar <- par(mfrow = c(2,2)) - SW({ - results <- expect_s4_class(combine_De_Dr( - Dr = Dr, - int_OD = 0.1, - De, - s, - outlier_analysis_plot = TRUE, - par_local = FALSE, - Age_range = c(0, 100), - method_control = list( - n.iter = 100, - n.chains = 1, - return_mcmc = TRUE - )), "RLum.Results") - }) - - ## check the length of the output - expect_length(results, 9) - - ## check whether we have the MCMC plots - expect_s3_class(results$mcmc_IAM, "mcmc.list") - expect_s3_class(results$mcmc_BCAM, "mcmc.list") - - ## try to plot the results again - SW({ - plot_OSLAgeSummary(results) - }) - - ## diag = TRUE - SW({ - expect_error(combine_De_Dr( - Dr = Dr, int_OD = 0.1, De, s, Age_range = c(0, 100), - method_control = list(n.iter = 100, n.chains = 1, diag = TRUE)), - "You need at least two chains") - expect_s4_class(combine_De_Dr( - Dr = Dr, int_OD = 0.1, De, s, Age_range = c(0, 100), - method_control = list(n.iter = 100, n.chains = 2, diag = TRUE)), - "RLum.Results") - }) - - ## cdf_ADr_quantiles = TRUE and outlier_method = "RousseeuwCroux1993" - SW({ - expect_s4_class(combine_De_Dr( - Dr = Dr, int_OD = 0.1, De, s, Age_range = c(0, 100), - cdf_ADr_quantiles = TRUE, - outlier_method = "RousseeuwCroux1993", - method_control = list(n.iter = 100, n.chains = 1)), - "RLum.Results") - }) - - ## reset the graphical parameters to the original values - par(oldpar) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_Activity2Concentration.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_Activity2Concentration.R deleted file mode 100644 index b7721254e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_Activity2Concentration.R +++ /dev/null @@ -1,62 +0,0 @@ -test_that("check class and length of output", { - testthat::skip_on_cran() - - ## set dataframe - data_activity <- data.frame( - NUCLIDES = c("U-238", "Th-232", "K-40"), - VALUE = c(40,80,100), - VALUE_ERROR = c(4,8,10), - stringsAsFactors = FALSE) - - ## set dataframe - data_abundance <- data.frame( - NUCLIDES = c("U-238", "Th-232", "K-40"), - VALUE = c(4,8,1), - VALUE_ERROR = c(0.1,0.1,0.1), - stringsAsFactors = FALSE) - - ## crash function - expect_error( - object = convert_Activity2Concentration(), - regexp = "\\[convert\\_Activity2Concentration\\(\\)\\] I'm still waiting for input data ...") - - expect_error( - object = convert_Activity2Concentration(data = data_activity[,1:2]), - regexp = "\\[convert\\_Activity2Concentration\\(\\)\\] Input data.frame should have at least three columns.") - - expect_error( - object = convert_Activity2Concentration(data = data_activity, input_unit = "stop"), - regexp = "\\[convert\\_Activity2Concentrations\\(\\)\\] Input for parameter 'input_unit' invalid.") - - ## check for standard input - SW({ - results <- expect_s4_class(convert_Activity2Concentration(data_activity), - c("RLum.Results")) - }) - expect_s4_class(convert_Activity2Concentration(data_activity, verbose = FALSE), c("RLum.Results")) - expect_equal(length(results), 1) - - ## this test should flag if constants were changed, so that this is - ## not forgotten in the NEWS - expect_equal(round(sum(results$data$`ABUND. (mug/g or mass. %)`),5), 23.20909) - expect_equal(round(sum(results$data$`ABUND. ERROR (mug/g or mass. %)`),5), 2.32091) - - ## check for concentration input - SW({ - results_abundance <- expect_s4_class( - object = convert_Activity2Concentration(data_abundance, input_unit = "abundance"), - class = "RLum.Results") - }) - - expect_equal(round(sum(results_abundance$data$`ABUND. (mug/g or mass. %)`),5), 13) - expect_equal(round(sum(results_abundance$data$`ABUND. ERROR (mug/g or mass. %)`),5), 0.3) - - ## additional checks for input - ## capitalized input units - SW({ - expect_s4_class(convert_Activity2Concentration(data_activity, input_unit = "ACTIVITY"), c("RLum.Results")) - - ## check backwards compatibility - expect_s4_class(convert_Activity2Concentration(data_activity, input_unit = "Bq/kg"), c("RLum.Results")) - }) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_Concentration2DoseRate.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_Concentration2DoseRate.R deleted file mode 100644 index b0303627e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_Concentration2DoseRate.R +++ /dev/null @@ -1,45 +0,0 @@ -test_that("basic checks", { - testthat::skip_on_cran() - - ## template - SW({ - template <- expect_s3_class(convert_Concentration2DoseRate(), "data.frame") - }) - - ## break function - expect_error(convert_Concentration2DoseRate(input = "fail"), - regexp = "input must be of type 'data.frame or 'matrix'") - - expect_error(convert_Concentration2DoseRate(input = data.frame(x = 1, y = 2)), - regexp = "number of rows/columns in input does not match the requirements. See manual!") - - expect_error( - convert_Concentration2DoseRate(suppressMessages(convert_Concentration2DoseRate()), conversion = "fail"), - regexp = "You have not entered a valid conversion. Please check your spelling and consult the documentation!") - - template[[1]] <- "fail" - expect_error(convert_Concentration2DoseRate(template), regexp = "As mineral only 'FS' or 'Q' is supported!") - - ## run function - ## for FS - df <- - data.frame( - Mineral = "FS", - K = 2.13, - K_SE = 0.07, - Th = 9.76, - Th_SE = 0.32, - U = 2.24, - U_SE = 0.12, - GrainSize = 200, - WaterContent = 30, - WaterContent_SE = 5 - ) - - expect_s4_class(object = convert_Concentration2DoseRate(df), class = "RLum.Results") - - ## for Q - df$Mineral <- "Q" - expect_s4_class(object = convert_Concentration2DoseRate(df), class = "RLum.Results") - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_Daybreak2CSV.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_Daybreak2CSV.R deleted file mode 100644 index 6cdafdcb2..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_Daybreak2CSV.R +++ /dev/null @@ -1,20 +0,0 @@ -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(convert_Daybreak2CSV(), - "file is missing") - expect_error(convert_Daybreak2CSV(""), - "file name does not seem to exist") -}) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - SW({ - res <- read_Daybreak2R(file = system.file("extdata/Daybreak_TestFile.txt", - package = "Luminescence"))[[1]] - }) - expect_null(convert_Daybreak2CSV(res, path = tempdir())) - expect_type(convert_Daybreak2CSV(res, path = tempdir(), export = FALSE), - "list") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_PSL2CSV.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_PSL2CSV.R deleted file mode 100644 index b8aeb5333..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_PSL2CSV.R +++ /dev/null @@ -1,46 +0,0 @@ -test_that("General test", { - testthat::skip_on_cran() - - ##get file - file <- system.file("extdata/DorNie_0016.psl", package = "Luminescence") - - ##stop - expect_error(convert_PSL2CSV()) - - ##the case where we have an object of type RLum - expect_type(convert_PSL2CSV(read_PSL2R(file), export = FALSE), "list") - - ##export FALSE - expect_type(convert_PSL2CSV(file, export = FALSE), "list") - - ##write to temp - expect_silent(convert_PSL2CSV(file, export = TRUE, path = tempdir())) - - ##test single_table argument - expect_type(convert_PSL2CSV(file, export = FALSE, single_table = TRUE), "list") - - ##test raw data extraction - ## simple raw data extraction - t <- expect_type(convert_PSL2CSV(file, export = FALSE, extract_raw_data = TRUE), "list") - expect_length(t, 5) - - ## raw data extraction with single_table - t <- expect_type(convert_PSL2CSV(file, export = FALSE, extract_raw_data = TRUE, single_table = TRUE), "list") - expect_length(t, 1) - expect_equal(nrow(t[[1]]), 100) - - ## test with files export - tmp_path <- tempdir() - expect_silent(convert_PSL2CSV(file, path = tmp_path, extract_raw_data = TRUE, single_table = TRUE, col.names = TRUE)) - - ## test with col.names - df <- read.table(file = rev(list.files(path = tmp_path, pattern = ".csv", full.names = TRUE))[1], sep = ";", header = TRUE) - expect_type(colnames(df), "character") - expect_true(grepl(pattern = "USER", colnames(df)[1])) - - ## test without column names - expect_silent(convert_PSL2CSV(file, path = tmp_path, extract_raw_data = TRUE, single_table = TRUE, col.names = FALSE)) - df <- read.table(file = list.files(path = tmp_path, pattern = ".csv", full.names = TRUE)[1], sep = ";", header = TRUE) - expect_false(grepl(pattern = "USER", colnames(df)[1])) - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_RLum2Risoe.BINfileData.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_RLum2Risoe.BINfileData.R deleted file mode 100644 index 9a3352a82..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_RLum2Risoe.BINfileData.R +++ /dev/null @@ -1,35 +0,0 @@ -test_that("test for errors", { - testthat::skip_on_cran() - - expect_error(convert_RLum2Risoe.BINfileData(object = NA)) - -}) - - -test_that("functionality", { - testthat::skip_on_cran() - - ##load example data - data(ExampleData.RLum.Analysis, envir = environment()) - - ##provide RLum.Analysis - expect_s4_class(convert_RLum2Risoe.BINfileData(IRSAR.RF.Data), "Risoe.BINfileData") - - ##provide RLum.Data.Curve - expect_s4_class(convert_RLum2Risoe.BINfileData(IRSAR.RF.Data@records[[1]]), "Risoe.BINfileData") - - ##provide list - expect_s4_class(convert_RLum2Risoe.BINfileData(list(IRSAR.RF.Data,IRSAR.RF.Data)), "Risoe.BINfileData") - expect_s4_class(convert_RLum2Risoe.BINfileData(list(IRSAR.RF.Data)), - "Risoe.BINfileData") - - ## additional metadata - obj <- IRSAR.RF.Data@records[[1]] - obj@info <- list(version="12", name="test", - startDate="20210101150845") - res <- convert_RLum2Risoe.BINfileData(obj) - expect_equal(res@METADATA$VERSION, "12") - expect_equal(res@METADATA$SAMPLE, "test") - expect_equal(res@METADATA$DATE, "20210101") - expect_equal(res@METADATA$TIME, "150845") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_SG2MG.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_SG2MG.R deleted file mode 100644 index 90628cc0f..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_SG2MG.R +++ /dev/null @@ -1,30 +0,0 @@ -test_that("test conversion from single grain data to multiple grain data", { - testthat::skip_on_cran() - - ## load example dataset - data(ExampleData.BINfileData, envir = environment()) - test_file_MG <- test_file_SG <- CWOSL.SAR.Data - test_file_SG@METADATA$GRAIN <- 1 - - ## test pass through for pure multiple grain data - expect_s4_class(convert_SG2MG(test_file_MG), "Risoe.BINfileData") - - ## test with pseudo single grain data - expect_s4_class(convert_SG2MG(test_file_SG), "Risoe.BINfileData") - - ## test write option - ## create environment - dir <- tempdir() - tmp <- paste0(dir, "/test.bin") - SW({ - write_file_test <- write_R2BIN( - read_BIN2R(file = test_path("_data/BINfile_V4.bin")), - file = tmp) - - expect_s4_class(convert_SG2MG(tmp, write_file = TRUE, txtProgressBar = FALSE), - "Risoe.BINfileData") - }) - - ##clear temp folder otherwise we have a problem with the CRAN check - file.remove(list.files(dir,pattern = ".bin", full.names = TRUE)) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_Wavelength2Energy.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_Wavelength2Energy.R deleted file mode 100644 index a695583e7..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_Wavelength2Energy.R +++ /dev/null @@ -1,67 +0,0 @@ -test_that("test convert functions", { - testthat::skip_on_cran() - - # Set up test scenario ------------------------------------------------------------------------ - #create artifical dataset according to Mooney et al. (2013) - lambda <- seq(400,800,50) - data <- matrix(data = rep(1, 2 * length(lambda)), ncol = 2) - rownames(data) <- lambda - colnames(data) <- 1:ncol(data) - - ##set plot function - p <- function(m) { - plot(x = m[, 1], y = m[, 2]) - polygon(x = c(m[, 1], rev(m[, 1])), y = c(m[, 2], rep(0, nrow(m)))) - for (i in 1:nrow(m)) { - lines(x = rep(m[i, 1], 2), y = c(0, m[i, 2])) - - } - } - - # Test ---------------------------------------------------------------------------------------- - ##crash function - expect_error(convert_Wavelength2Energy("test"), regexp = "Class 'character' not supported as input!") - - ##test all three allowed input objects - expect_type(convert_Wavelength2Energy(data), "double") - expect_s3_class(convert_Wavelength2Energy(as.data.frame(data)), class = "data.frame") - object <- set_RLum(class = "RLum.Data.Spectrum", data = data[,1,drop = FALSE]) - expect_s4_class(convert_Wavelength2Energy(object), class = "RLum.Data.Spectrum") - - ##test the list option - expect_type(convert_Wavelength2Energy(list(data, as.data.frame(data), object)), "list") - - ##test order argument - expect_type(convert_Wavelength2Energy(data, order = TRUE), "double") - res <- convert_Wavelength2Energy(object, order = TRUE) - expect_equal(order(rownames(res@data)), - 1:nrow(res@data)) - - ##test special treatment of RLum.Data.Spectrum objects - object@info[["curveDescripter"]] <- "energy" - expect_message(convert_Wavelength2Energy(object), regexp = "Your object has already an energy scale, nothing done!") - object@info[["curveDescripter"]] <- "wavelength" - res <- convert_Wavelength2Energy(object) - expect_equal(res@info[["curveDescripter"]], - "energy [eV]") - - ##Code below just a cross check if wanted - ##matrix - # m <- cbind(as.numeric(rownames(data)), data) - # par(mfrow = c(1,2)) - # p(m) - # p(convert_Wavelength2Energy(m)) - # - # ##df - # df <- as.data.frame(cbind(as.numeric(rownames(data)), data)) - # p(df) - # p(convert_Wavelength2Energy(df)) - # - # ##RLum.Data.Spectrum - # object <- set_RLum(class = "RLum.Data.Spectrum", data = data[,1,drop = FALSE]) - # par(mfrow = c(1,2)) - # plot_RLum.Data.Spectrum(object, plot.type = "single", par.local = FALSE) - # plot_RLum.Data.Spectrum(convert_Wavelength2Energy(object), plot.type = "single", par.local = FALSE) - - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_XSYG2CSV.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_XSYG2CSV.R deleted file mode 100644 index b383b282f..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_convert_XSYG2CSV.R +++ /dev/null @@ -1,29 +0,0 @@ -test_that("test convert functions", { - testthat::skip_on_cran() - - ##test for errors - expect_error(convert_XSYG2CSV(), - "file is missing") - expect_error(convert_BIN2CSV(), - "file is missing") - expect_error(convert_BIN2CSV(file = "error", export = FALSE), - "File does not exist") - #expect_error(convert_PSL2CSV(file = "", export = FALSE)) - expect_error(expect_message(convert_XSYG2CSV(file = "", export = FALSE), - "XML file not readable, nothing imported"), - "Object needs to be a member of the object class RLum") - - ##test conversion itself - ##BIN2CSV - data(ExampleData.BINfileData, envir = environment()) - expect_type(convert_BIN2CSV(subset(CWOSL.SAR.Data, POSITION == 1), export = FALSE), "list") - expect_null(convert_BIN2CSV(subset(CWOSL.SAR.Data, POSITION == 1), - export = TRUE, path = tempdir())) - - ##XSYG2CSV - data(ExampleData.XSYG, envir = environment()) - expect_type(convert_XSYG2CSV(OSL.SARMeasurement$Sequence.Object[1:10], - export = FALSE), "list") - expect_null(convert_XSYG2CSV(OSL.SARMeasurement$Sequence.Object[1:10], - export = TRUE, path = tempdir())) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_extract_IrradiationTimes.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_extract_IrradiationTimes.R deleted file mode 100644 index f07b8b767..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_extract_IrradiationTimes.R +++ /dev/null @@ -1,49 +0,0 @@ -xsyg <- system.file("extdata/XSYG_file.xsyg", package="Luminescence") -binx <- system.file("extdata/BINfile_V8.binx", package = "Luminescence") - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(extract_IrradiationTimes("fail"), - "Wrong XSYG file name or file does not exist!") - expect_error(extract_IrradiationTimes(tempdir()), - "File is expected to have 'xsyg' or 'XSYG' extension") - expect_error(extract_IrradiationTimes(FALSE), - "neither of type 'character' nor of type 'RLum.Analysis") - expect_error(extract_IrradiationTimes(xsyg, file.BINX = "fail"), - "Wrong BINX file name or file does not exist!") - expect_error(extract_IrradiationTimes(xsyg, file.BINX = tempdir()), - "File is expected to have 'binx' or 'BINX' extension") - - expect_message(extract_IrradiationTimes(xsyg, file.BINX = binx, - txtProgressBar = FALSE), - "XSYG-file and BINX-file do not contain similar entries") - expect_warning(extract_IrradiationTimes(list(xsyg), file.BINX = binx, - txtProgressBar = FALSE), - "'file.BINX' is not supported in self-call mode") -}) - -test_that("Test the extraction of irradiation times", { - testthat::skip_on_cran() - - ##general test - SW({ - res <- expect_s4_class(extract_IrradiationTimes(xsyg, txtProgressBar = FALSE), - "RLum.Results") - }) - - ##check whether it makes sense - expect_equal(sum(res$irr.times$IRR_TIME), 80) - - ## recordType - res <- extract_IrradiationTimes(list(xsyg), recordType = list("OSL (UVVIS)"), - txtProgressBar = FALSE) - expect_true(all(res[[1]]@data$irr.times$STEP == "OSL (UVVIS)")) - - ## apply the function to something previously imported via read_BIN2R - SW({ - temp <- read_BIN2R(binx, fastForward = TRUE) - temp <- expect_s4_class(extract_IrradiationTimes(temp)[[1]], "RLum.Results") - }) - expect_type(temp$irr.times$START, "double") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_extract_ROI.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_extract_ROI.R deleted file mode 100644 index 495e5f8a4..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_extract_ROI.R +++ /dev/null @@ -1,63 +0,0 @@ -test_that("extract_ROI", { - testthat::skip_on_cran() - - ## generate random data - m <- matrix(runif(100,0,255), ncol = 10, nrow = 10) - set.seed(12245) - a <- array(runif(300, 0,255), c(10,10,3)) - RLum <- set_RLum("RLum.Data.Image", data = a) - RLum_list <- list(RLum, RLum) - roi <- matrix(c(2.,4,2,5,6,7,3,1,1), ncol = 3) - - - ## crash the function - expect_error(extract_ROI(object = "error", roi), "\\[extract_ROI\\(\\)\\] Input for argument 'object' not supported\\!") - expect_error(extract_ROI(object = m, "error"), "\\[extract_ROI\\(\\)\\] Please check the format of roi, it looks wrong\\!") - expect_error(extract_ROI(object = m, matrix()), "\\[extract_ROI\\(\\)\\] Please check the format of roi, it looks wrong\\!") - expect_error(extract_ROI(object = m, matrix(ncol = 3, nrow = 0)), "\\[extract_ROI\\(\\)\\] Please check the format of roi, it looks wrong\\!") - - ## run function for all supported input objects - ## matrix - expect_s4_class(extract_ROI(object = m, roi), "RLum.Results") - - ## array - expect_s4_class(extract_ROI(object = a, roi), "RLum.Results") - - ## RLum.Data.Image - expect_s4_class(extract_ROI(object = RLum, roi), "RLum.Results") - - ## list - results <- expect_s4_class(extract_ROI(object = RLum_list, roi), "RLum.Results") - - ## regression test if it fails, we have to amend the documentation - expect_length(results@data$roi_signals, 6) - expect_length(results@data, 3) - - ## with plot output - expect_silent(extract_ROI(object = RLum, roi, plot = TRUE)) - expect_silent(extract_ROI(object = RLum_list, roi, plot = TRUE)) - - ## test with package example dataset - data(ExampleData.RLum.Data.Image, envir = environment()) - roi <- matrix(c(200,400,200,40,60,80,10,10,10), ncol = 3) - expect_s4_class(extract_ROI(object = ExampleData.RLum.Data.Image, roi), "RLum.Results") - - ## test ROI summary options - roi <- matrix(c(2.,4,2,5,6,7,3,1,1), ncol = 3) - t_mean <- expect_type(extract_ROI(object = RLum, roi, roi_summary = "mean")@data$roi_summary, "double") - expect_equal(sum(t_mean),1124, tolerance = 0.001) - - t_median <- expect_type(extract_ROI(object = RLum, roi, roi_summary = "median")@data$roi_summary, "double") - expect_equal(sum(t_median),1104, tolerance = 0.001) - - t_sd <- expect_type(extract_ROI(object = RLum, roi, roi_summary = "sd")@data$roi_summary, "double") - expect_equal(sum(t_sd),730, tolerance = 0.001) - - t_sum <- expect_type(extract_ROI(object = RLum, roi, roi_summary = "sum")@data$roi_summary, "double") - expect_equal(sum(t_sum), 8117, tolerance = 0.001) - - ## crash - expect_error(extract_ROI(object = RLum, roi, roi_summary = "error"), - "\\[extract\\_ROI\\(\\)\\] roi\\_summary method not supported, check manual!") - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_fit_CWCurve.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_fit_CWCurve.R deleted file mode 100644 index 9cc5ef1bc..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_fit_CWCurve.R +++ /dev/null @@ -1,56 +0,0 @@ -data(ExampleData.CW_OSL_Curve, envir = environment()) - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(fit_CWCurve("error"), - "Input object is not of type 'RLum.Data.Curve' or 'data.frame'") - expect_error(fit_CWCurve(ExampleData.CW_OSL_Curve, fit.method = "error"), - "'fit.method' unknown") -}) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - ## data.frame - SW({ - fit <- fit_CWCurve(values = ExampleData.CW_OSL_Curve, - main = "CW Curve Fit", - n.components.max = 4, - log = "x", - plot = FALSE) - }) - expect_s4_class(fit, "RLum.Results") - expect_equal(length(fit), 3) - expect_equal(fit$data$n.components, 3, tolerance = 1) - expect_equal(round(fit$data$I01, digits = 0), 2388, tolerance = 1) - expect_equal(round(fit$data$lambda1, digits = 1), 4.6, tolerance = 1) - expect_equal(round(fit$data$`pseudo-R^2`, digits = 0), 1) - - ## RLum.Data.Curve object - curve <- set_RLum("RLum.Data.Curve", - data = as.matrix(ExampleData.CW_OSL_Curve), - curveType = "measured", - recordType = "OSL") - - SW({ - fit <- fit_CWCurve(values = curve, - main = "CW Curve Fit", - n.components.max = 4, - log = "x", - plot = FALSE) - }) - expect_s4_class(fit, "RLum.Results") - expect_equal(length(fit), 3) - expect_equal(fit$data$n.components, 3, tolerance = 1) - expect_equal(round(fit$data$I01, digits = 0), 2388, tolerance = 1) - expect_equal(round(fit$data$lambda1, digits = 1), 4.6, tolerance = 1) - expect_equal(round(fit$data$`pseudo-R^2`, digits = 0), 1) - - SW({ - expect_warning(fit_CWCurve(ExampleData.CW_OSL_Curve, fit.method = "LM", - fit.calcError = TRUE, xlab = "x", ylab = "y", - output.path = tempdir()), - "Argument 'output.path' no longer supported") - }) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_fit_EmissionSpectra.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_fit_EmissionSpectra.R deleted file mode 100644 index e65b201c4..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_fit_EmissionSpectra.R +++ /dev/null @@ -1,86 +0,0 @@ -test_that("standard check", { - testthat::skip_on_cran() - - ##load example data - data(ExampleData.XSYG, envir = environment()) - - ##subtract background - TL.Spectrum@data <- TL.Spectrum@data[] - TL.Spectrum@data[,15] - - # break function ----------- - ## unwanted list element in list --------- - expect_error(fit_EmissionSpectra(list(TL.Spectrum, "fail")), - "\\[fit\\_EmissionSpectra\\(\\)\\] List elements of different class detected!") - - ## wrong frame range ------- - expect_error(fit_EmissionSpectra(TL.Spectrum, frame = 1000), - "\\[fit\\_EmissionSpectra\\(\\)\\] 'frame' invalid. Allowed range min: 1 and max: 24") - - - ## wrong graining argument ------- - SW({ - expect_error(fit_EmissionSpectra(TL.Spectrum, frame = 5, - method_control = list(graining = 10000)), - "method_control$graining cannot exceed the available channels (1024)", - fixed = TRUE) - }) - - ## for matrix input ------- - expect_error(fit_EmissionSpectra("fail"), - "Objects of type 'character' are not supported") - - mat <- get_RLum(TL.Spectrum)[, 1:4] - expect_error(fit_EmissionSpectra(object = mat, frame = 1000), - "'frame' invalid. Allowed range min: 1 and max: 3") - SW({ - expect_s4_class( - fit_EmissionSpectra(object = mat, plot = FALSE, verbose = FALSE, - method_control = list(max.runs = 5)), - "RLum.Results") - }) - - # plain run ------- - SW({ - results <- expect_s4_class(fit_EmissionSpectra( - object = TL.Spectrum, - frame = 5, - main = "TL spectrum", - n_components = 3, - plot = TRUE, - start_parameters = c(2.17), - method_control = list(max.runs = 100)), "RLum.Results") - }) - - # silent mode ------- - expect_silent(fit_EmissionSpectra( - object = TL.Spectrum, - frame = 5, - main = "TL spectrum", - plot = FALSE, - verbose = FALSE, - method_control = list(max.runs = 10))) - - # regression test ---- - expect_length(results, 3) - expect_s3_class(results$fit[[1]], "nls") - expect_type(results$data, "double") - - ## input_scale - SW({ - expect_s4_class( - fit_EmissionSpectra(object = TL.Spectrum, frame = 5, - input_scale = "wavelength", plot = FALSE, - method_control = list(max.runs = 5)), - "RLum.Results") - }) - - ## plot - set.seed(1) - SW({ - expect_s4_class( - fit_EmissionSpectra(object = TL.Spectrum, frame = 5, plot = TRUE, - n_components = 3, verbose = FALSE, mtext = "Subtitle", - method_control = list(max.runs = 5)), - "RLum.Results") - }) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_fit_LMCurve.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_fit_LMCurve.R deleted file mode 100644 index 72b9dc148..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_fit_LMCurve.R +++ /dev/null @@ -1,94 +0,0 @@ -data(ExampleData.FittingLM, envir = environment()) - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(fit_LMCurve("error"), - "'values' has to be of type 'data.frame' or 'RLum.Data.Curve'") - expect_error(fit_LMCurve(set_RLum("RLum.Data.Curve", recordType = "OSL")), - "recordType should be 'RBR' or 'LM-OSL'") - expect_error(fit_LMCurve(values.curve, values.bg = "error"), - "'values.bg' must be of type 'data.frame' or 'RLum.Data.Curve'") - expect_error(fit_LMCurve(set_RLum("RLum.Data.Curve", recordType = "LM-OSL"), - values.bg = values.curveBG), - "Lengths of 'values' and 'values.bg' differ") - expect_error(fit_LMCurve(values.curve, values.bg = values.curveBG, - bg.subtraction = "error"), - "Invalid method for background subtraction") - expect_error(fit_LMCurve(values.curve, n.components = "error"), - "'n.components' must be a positive integer scalar") - expect_error(fit_LMCurve(values.curve, fit.method = "error"), - "Unknown method for 'fit.method'") - - ## warning for failed confint ...skip on windows because with R >= 4.2 is does not fail anymore - if (!grepl(pattern = "mingw", sessionInfo()$platform) && !grepl(pattern = "linux", sessionInfo()$platform)) - expect_warning(fit_LMCurve(values = values.curve, fit.calcError = TRUE)) -}) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - SW({ - fit <- fit_LMCurve(values.curve, values.bg = values.curveBG, - n.components = 3, log = "x", - start_values = data.frame(Im = c(170,25,400), - xm = c(56,200,1500))) - }) - - expect_s4_class(fit, "RLum.Results") - expect_equal(length(fit), 4) - expect_type(fit$component_matrix, "double") - expect_equal(nrow(fit$component_matrix), 4000) - - expect_equal(fit$data$n.components, 3) - expect_equal(round(fit$data$Im1, digits = 0), 169) - expect_equal(round(fit$data$xm1, digits = 0), 49) - expect_equal(round(fit$data$b1, digits = 0), 2) - expect_equal(round(fit$data$`pseudo-R^2`, digits = 0), 1) - -}) - -## Test 2 with LM -SW({ -fit <- fit_LMCurve(values = values.curve, - values.bg = values.curveBG, - n.components = 3, - log = "x", - fit.method = "LM", - plot = FALSE) -}) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - expect_s4_class(fit, "RLum.Results") - expect_equal(length(fit), 4) - - expect_equal(fit$data$n.components, 3) - expect_equal(round(fit$data$Im1, digits = 0), 169) - expect_equal(round(fit$data$xm1, digits = 0), 49) - expect_equal(round(fit$data$b1, digits = 0), 2) - expect_equal(round(fit$data$`pseudo-R^2`, digits = 0), 1) - - SW({ - expect_message(fit <- fit_LMCurve(values.curve, values.bg = values.curveBG, - start_values = data.frame(Im = c(70,25,400), - xm = c(56,200,10))), - "Fitting Error: Plot without fit produced") - expect_equal(fit@data$component_matrix, NA) - - fit_LMCurve(values.curve, values.bg = values.curveBG, plot.BG = TRUE, - fit.advanced = TRUE) - fit_LMCurve(values.curve, values.bg = values.curveBG, plot.BG = TRUE, - bg.subtraction = "linear") - fit_LMCurve(values.curve, values.bg = values.curveBG, plot.BG = TRUE, - bg.subtraction = "channel") - fit_LMCurve(values.curve, values.bg = values.curveBG, - fit.calcError = TRUE) - suppressWarnings( - expect_warning(fit_LMCurve(values.curve, values.bg = values.curveBG, - fit.advanced = TRUE, fit.calcError = TRUE), - "The computation of the parameter confidence intervals failed") - ) - }) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_fit_OSLLifeTimes.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_fit_OSLLifeTimes.R deleted file mode 100644 index 339cd40d1..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_fit_OSLLifeTimes.R +++ /dev/null @@ -1,123 +0,0 @@ -##load example data -data(ExampleData.TR_OSL, envir = environment()) - -temp_list <- list(ExampleData.TR_OSL, ExampleData.TR_OSL) -temp_analysis <- set_RLum("RLum.Analysis", records = temp_list) -temp_mat <- get_RLum(ExampleData.TR_OSL)[1:200, ] - -test_that("input validation", { - testthat::skip_on_cran() - - expect_message(expect_null(fit_OSLLifeTimes("error")), - "Error: Class 'character' not supported as input, NULL returned") - expect_error(fit_OSLLifeTimes(ExampleData.TR_OSL, n.components = -1), - "'n.components' must be a positive integer scalar") - expect_error(fit_OSLLifeTimes(ExampleData.TR_OSL, signal_range = FALSE), - "'signal_range' must be of type numeric") - expect_error(fit_OSLLifeTimes(set_RLum(class = "RLum.Data.Curve")), - "recordType NA not supported for input object") - - expect_message(expect_null(fit_OSLLifeTimes(temp_mat[1:3, ])), - "For 1 components the dataset must have at least 5 signal points") - expect_message(fit_OSLLifeTimes(temp_mat, n.components = 1, - signal_range = c(1, 3), verbose = FALSE), - "For 1 components the dataset must have at least 5 signal points") - expect_message(fit_OSLLifeTimes(temp_mat, n.components = 2, - signal_range = c(1, 6), verbose = FALSE), - "For 2 components the dataset must have at least 7 signal points") - - expect_warning(fit_OSLLifeTimes(temp_mat, n.components = 1, - signal_range = c(1, 150:200), verbose = FALSE), - "'signal_range' has more than 2 elements") - expect_warning(fit_OSLLifeTimes(temp_mat, n.components = 1, - signal_range = c(1, 300), verbose = FALSE), - "'signal_range' > number of channels, reset to maximum") - expect_warning(fit_OSLLifeTimes(temp_mat, n.components = 1, - signal_range = 300, verbose = FALSE), - "'signal_range' first element > last element, reset to default" - ) - - temp <- temp_mat - temp[100, 2] <- NA - expect_warning(fit_OSLLifeTimes(temp, n.components = 1, verbose = FALSE), - "NA values detected and removed from dataset") - - temp[100:110, 2] <- 0 - expect_warning(fit_OSLLifeTimes(temp, n.components = 1, verbose = FALSE), - "The dataset contains 0, a value of 0.1 has been added") - - expect_warning(fit_OSLLifeTimes(ExampleData.TR_OSL, - method_control = list(seed = 1, - DEoptim.itermax = 15, - nlsLM.lower = FALSE), - plot = FALSE, - verbose = FALSE, - n.components = 1), - "At least one parameter is negative") - -}) - -test_that("standard check", { - testthat::skip_on_cran() - - ## Test different inputs - ##simple run - set.seed(1) - SW({ - expect_s4_class(object = fit_OSLLifeTimes( - object = ExampleData.TR_OSL, - plot = FALSE, - method_control = list(DEoptim.itermax = 15), - n.components = 1), class = "RLum.Results") - - ##simple list - expect_s4_class(object = fit_OSLLifeTimes( - object = temp_list, - plot = FALSE, - log = "x", - method_control = list(DEoptim.itermax = 25), - n.components = 1), class = "RLum.Results") - }) - - ##simple RLum.Analysis - expect_s4_class(object = fit_OSLLifeTimes( - object = temp_analysis, - verbose = FALSE, - plot = FALSE, - n.components = 1), class = "RLum.Results") - - ## simple data.frame - expect_s4_class(fit_OSLLifeTimes( - object = as.data.frame(temp_mat), - method_control = list(seed = 1, weights = FALSE, - DEoptim.itermax = 50), - signal.range = 3, - verbose = FALSE, - plot = FALSE, - n.components = NULL), class = "RLum.Results") - - ##test arguments - ##simple run - expect_s4_class(object = fit_OSLLifeTimes( - object = ExampleData.TR_OSL, - method_control = list(seed = 1, weights = FALSE, - DEoptim.itermax = 25, - nlsLM.upper = FALSE, nlsLM.lower = FALSE), - plot = FALSE, - verbose = FALSE, - n.components = 1), class = "RLum.Results") - - ##warning for log - expect_warning(expect_warning( - fit_OSLLifeTimes( - object = temp_mat, - verbose = FALSE, - plot = TRUE, - plot_simple = TRUE, - log = "xy", - lty = 1, - n.components = 1), - "log-scale requires x-values > 0, set min xlim to 0.01"), - "log-scale requires y-values > 0, set min ylim to 1.69e+10", - fixed = TRUE) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_fit_SurfaceExposure.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_fit_SurfaceExposure.R deleted file mode 100644 index fa1b9d4c6..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_fit_SurfaceExposure.R +++ /dev/null @@ -1,133 +0,0 @@ -data("ExampleData.SurfaceExposure", envir = environment()) -d1 <- ExampleData.SurfaceExposure$sample_1 -d2 <- ExampleData.SurfaceExposure$sample_2 -d3 <- ExampleData.SurfaceExposure$set_1 -d4 <- ExampleData.SurfaceExposure$set_2 - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(fit_SurfaceExposure("test"), - "'data' must be of class data.frame") - expect_error(fit_SurfaceExposure(list(d1)), - "'age' must be of the same length") - expect_error(fit_SurfaceExposure(d4, age = 1e4), - "'age' must be of the same length") - - SW({ - expect_warning(fit_SurfaceExposure(rbind(d1, NA), mu = 0.9), - "\\[fit\\_SurfaceExposure\\(\\)\\] NA values in 'data' were removed") - }) -}) - -## Example data 1 -fit <- fit_SurfaceExposure(data = d1, sigmaphi = 5e-10, mu = 0.9, - plot = TRUE, verbose = FALSE) - -test_that("check values from output example", { - testthat::skip_on_cran() - - expect_equal(is(fit), c("RLum.Results", "RLum")) - expect_equal(length(fit), 5) - expect_equal(is(fit$fit), "nls") - - expect_equal(round(fit$summary$age), 9893) - expect_equal(round(fit$summary$age_error), 369) -}) - -# Sub-test - weighted fitting -fit <- fit_SurfaceExposure(data = d1, sigmaphi = 5e-10, mu = 0.9, weights = TRUE, - plot = FALSE, verbose = FALSE) - - -test_that("check values from output example", { - testthat::skip_on_cran() - - expect_equal(round(fit$summary$age), 9624) - expect_equal(round(fit$summary$age_error), 273) -}) - - -## Example data 2 -fit <- fit_SurfaceExposure(data = data.table(d2), age = 1e4, - sigmaphi = 5e-10, Ddot = 2.5, D0 = 40, - plot = FALSE, verbose = FALSE) - -test_that("check values from output example", { - testthat::skip_on_cran() - - expect_equal(is(fit), c("RLum.Results", "RLum")) - expect_equal(length(fit), 5) - expect_equal(is(fit$fit), "nls") - - expect_equal(round(fit$summary$mu, 3), 0.904) - expect_equal(round(fit$summary$mu_error, 3), 0.007) -}) - - -## Example data 3 -fit <- fit_SurfaceExposure(data = d3, age = c(1e3, 1e4, 1e5, 1e6), sigmaphi = 5e-10, - plot = FALSE, verbose = FALSE) - -test_that("check values from output example", { - testthat::skip_on_cran() - - expect_equal(is(fit), c("RLum.Results", "RLum")) - expect_equal(nrow(fit$summary), 4) - expect_equal(length(fit), 5) - expect_equal(is(fit$fit), "nls") - - expect_equal(round(unique(fit$summary$mu), 3), 0.901) - expect_equal(round(unique(fit$summary$mu_error), 3), 0.002) -}) - - -## Example data 4 -fit <- fit_SurfaceExposure(data = d4, age = c(1e2, 1e3, 1e4, 1e5, 1e6), sigmaphi = 5e-10, - Ddot = 1.0, D0 = 40, - plot = FALSE, verbose = FALSE) - -test_that("check values from output example", { - testthat::skip_on_cran() - expect_equal(is(fit), c("RLum.Results", "RLum")) - expect_equal(nrow(fit$summary), 5) - expect_equal(length(fit), 5) - expect_equal(is(fit$fit), "nls") - - expect_equal(round(unique(fit$summary$mu), 3), 0.899) - expect_equal(round(unique(fit$summary$mu_error), 3), 0.002) -}) - -#### WARNINGS & FAILURES -test_that("not enough parameters provided", { - testthat::skip_on_cran() - - SW({ - expect_message( - fit_SurfaceExposure(data = d1, plot = FALSE, verbose = TRUE), - "Unable to fit the data" - ) - expect_equal( - is(fit_SurfaceExposure(data = d2, plot = FALSE, verbose = FALSE)$fit), - "simpleError" - ) - expect_warning( - fit_SurfaceExposure(data = d4, age = c(1e2, 1e3, 1e4, 1e5, 1e6), sigmaphi = 5e-10, - Ddot = 1.0, D0 = 40, weights = TRUE, - plot = TRUE, coord_flip = TRUE, verbose = TRUE), - "is not supported when" - ) - - expect_message(res <- fit_SurfaceExposure(list(d1, d1), age = c(NA, 1e4), - sigmaphi = NA, mu = NA, - log = "y", plot = TRUE), - "Original error from minpack.lm::nlsLM(): evaluation of fn", - fixed = TRUE) - expect_message(fit_SurfaceExposure(res), - "Original error from minpack.lm::nlsLM(): singular gradient", - fixed = TRUE) - expect_message(fit_SurfaceExposure(as.matrix(d1), log = "y"), - "Original error from minpack.lm::nlsLM(): singular gradient", - fixed = TRUE) - }) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_fit_ThermalQuenching.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_fit_ThermalQuenching.R deleted file mode 100644 index e3bcb1014..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_fit_ThermalQuenching.R +++ /dev/null @@ -1,65 +0,0 @@ -##create example data -data <- data.frame( - T = c(25, 40, 50, 60, 70, 80, 90, 100, 110), - V = c(0.06, 0.058, 0.052, 0.051, 0.041, 0.034, 0.035, 0.033, 0.032), - V_X = c(0.012, 0.009, 0.008, 0.008, 0.007, 0.006, 0.005, 0.005, 0.004)) - -data_list <- list(data, data) -data_NA <- data -data_NA[1,] <- NA - - -test_that("standard check", { - testthat::skip_on_cran() - - ##trigger errors - expect_error(fit_ThermalQuenching(data = "test")) - - ##simple run with error - expect_error(fit_ThermalQuenching( - data = data[,1:2], - n.MC = NULL), regexp = "'data' is empty or has less than three columns!") - - ##simple run with warning - SW({ - expect_warning(fit_ThermalQuenching( - data = cbind(data,data), - n.MC = NULL), regexp = "data' has more than 3 columns, taking only the first three!") - - ##simple run with warning NA - expect_warning(fit_ThermalQuenching( - data = data_NA, - n.MC = NULL), regexp = "NA values in 'data' automatically removed!") - - ##simple run - expect_s4_class(fit_ThermalQuenching( - data = data, - n.MC = NULL), class = "RLum.Results") - }) - - ##simple run with fitting error - expect_message(expect_null(fit_ThermalQuenching( - data = data.frame(T = 1:10, V = 1:10, V_X = 1:10), - n.MC = NULL)), - "Error: Fitting failed, NULL returned") - - # ##switch off weights - SW({ - expect_s4_class(fit_ThermalQuenching( - data = data, - method_control = list(weights = NULL), - n.MC = NULL), class = "RLum.Results") - - ##simple list run - expect_s4_class(fit_ThermalQuenching( - data = data_list, - n.MC = NULL), class = "RLum.Results") - - ##simple run without plot etc - expect_s4_class(fit_ThermalQuenching( - data = data, - verbose = FALSE, - plot = TRUE, - n.MC = 10), class = "RLum.Results") - }) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_get_Layout.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_get_Layout.R deleted file mode 100644 index d6bea1665..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_get_Layout.R +++ /dev/null @@ -1,16 +0,0 @@ -test_that("input validation", { - skip_on_cran() - - expect_type(get_Layout("empty"), - "list") - expect_type(get_Layout("journal"), - "list") - expect_warning(res <- get_Layout("error"), - "Layout definition not supported, default layout is used") - expect_equal(res, - get_Layout("default")) - - input <- list(element = "value") - expect_equal(get_Layout(input), - input) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_get_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_get_RLum.R deleted file mode 100644 index c803c599b..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_get_RLum.R +++ /dev/null @@ -1,45 +0,0 @@ -data(ExampleData.DeValues, envir = environment()) -temp <- calc_CentralDose(ExampleData.DeValues$CA1, plot = FALSE, verbose = FALSE) - -temp_RLumDataCurve <- set_RLum(class = "RLum.Data.Curve") -temp_RLumDataImage <- set_RLum(class = "RLum.Data.Image") -temp_RLumDataSpectrum <- set_RLum(class = "RLum.Data.Spectrum") -temp_RLumAnalysis <- set_RLum(class = "RLum.Analysis") -temp_RLumResults <- set_RLum(class = "RLum.Results") - - - -test_that("check class and length of output", { - testthat::skip_on_cran() - - expect_s3_class(get_RLum(temp), class = "data.frame") - expect_type(get_RLum(temp, data.object = "args"), "list") - - ##test objects - expect_type(get_RLum(temp_RLumDataCurve), "double") - expect_type(get_RLum(temp_RLumDataImage), "logical") - expect_type(get_RLum(temp_RLumDataSpectrum), "logical") - expect_null(suppressWarnings(get_RLum(temp_RLumAnalysis))) - expect_null(get_RLum(temp_RLumResults)) -}) - -test_that("check get_RLum on a list and NULL", { - testthat::skip_on_cran() - - object <- set_RLum(class = "RLum.Analysis", records = rep(set_RLum(class = "RLum.Data.Curve"), 10)) - expect_warning(get_RLum(object, recordType = "test"), - "This request produced an empty list of records") - expect_null(get_RLum(NULL), "NULL") - - expect_warning(res <- get_RLum(list(temp, "test")), - "object #2 in the list was not of type 'RLum'") - expect_length(res, 2) - res <- get_RLum(list(temp, temp_RLumAnalysis), null.rm = TRUE) - expect_length(res, 1) - - ##check class argument - a <- list(set_RLum("RLum.Results"), set_RLum("RLum.Analysis", records = list(set_RLum("RLum.Data.Curve")))) - expect_type(get_RLum(a, class = "test", drop = FALSE), "list") - expect_type(get_RLum(a, class = "RLum.Results", drop = FALSE), "list") - expect_type(get_RLum(list(temp_RLumResults, temp_RLumAnalysis)), "list") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_github.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_github.R deleted file mode 100644 index b8df38af9..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_github.R +++ /dev/null @@ -1,50 +0,0 @@ -## NOTE: -# Unauthenticated requests to the GiHub APIv3 are limited to 60 requests per hour -# (associated with the originating request). Exceeding the rate limit results in a -# 403 Forbidden reply. Since CIs make multiple requests when testing the rate limit -# is easily reached. We check whether we either get a valid response, or at least -# a 403 response. - -test_that("Check github_commits()", { - testthat::skip_on_cran() - - response <- tryCatch(github_commits(), error = function(e) return(e)) - - if (inherits(response, "error")){ - expect_output(print(response), regexp = "status code 403") - } else { - expect_s3_class(response, "data.frame") - } - - rm(response) -}) - -test_that("Check github_branches()", { - testthat::skip_on_cran() - - response <- tryCatch(github_branches(), error = function(e) return(e)) - - if (inherits(response, "error")) { - expect_output(print(response), regexp = "status code 403") - }else { - expect_s3_class(response, "data.frame") - } - - rm(response) -}) - -test_that("Check github_issues()", { - testthat::skip_on_cran() - - SW({ - response <- tryCatch(github_issues(), error = function(e) return(e)) - }) - - if (inherits(response, "error")){ - expect_output(print(response), regexp = "status code 403") - }else{ - expect_type(response, "list") - } - - rm(response) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_import_Data.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_import_Data.R deleted file mode 100644 index 2f62b8bf1..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_import_Data.R +++ /dev/null @@ -1,46 +0,0 @@ -test_that("Test general import", { - testthat::skip_on_cran() - - ## BINX - SW({ - expect_type( - object = import_Data(system.file("extdata/BINfile_V8.binx", package = "Luminescence")), - type = "list") - }) - - ## XSYG - expect_type( - object = import_Data(system.file("extdata/XSYG_file.xsyg", package = "Luminescence")), - type = "list") - - ## PSL - expect_s4_class( - object = import_Data(system.file("extdata/DorNie_0016.psl", package = "Luminescence")), - class = "RLum.Analysis") - - ## DAT (Daybreak) - expect_type( - object = import_Data(system.file("extdata/Daybreak_TestFile.DAT", package = "Luminescence")), - type = "list") - - ## TXT (Daybreak) - expect_type( - object = import_Data(system.file("extdata/Daybreak_TestFile.txt", package = "Luminescence")), - type = "list") - - ## RF - expect_type( - object = import_Data(system.file("extdata/RF_file.rf", package = "Luminescence")), - type = "list") - - ## TIFF - expect_s4_class( - object = import_Data(system.file("extdata/TIFFfile.tif", package = "Luminescence")), - class = "RLum.Data.Image") - - ## OSL - expect_s4_class( - object = import_Data(system.file("extdata/HeliosOSL_Example.osl", package = "Luminescence")), - class = "RLum.Analysis") - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_internals.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_internals.R deleted file mode 100644 index b52f96f6b..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_internals.R +++ /dev/null @@ -1,214 +0,0 @@ -test_that("Test internals", { - testthat::skip_on_cran() - - # .expand_parameters() ------------------------------------------------------ - ##create empty function ... reminder - ##this is an internal function, the first object is always discarded, it - ##might be a list of RLum.Analysis objects is might be super large - f <- function(object, a, b = 1, c = list(), d = NULL) { - Luminescence:::.expand_parameters(len = 3) - - } - - ##test some functions - ##missing arguments must be identified - expect_error(f(), "Argument missing; with no default!") - - ##check whether the objects are properly recycled - expect_type(f(object, a = 1), "list") - expect_length(f(object, a = 1, c = list(a = 1, b = 2, c = 3))$c, 3) - expect_length(f(object, a = (1), c = list(a = 1, b = 2, c = 3))$c, 3) - expect_equal(f(object, a = (1 + 10), c = list(a = 1, b = 2, c = 3))$a[[1]], 11) - - # .calc_HPDI() ------------------------------------------------------------ - set.seed(1234) - test <- expect_type(Luminescence:::.calc_HPDI(rnorm(100), plot = TRUE), "double") - expect_equal(round(sum(test),2), 0.20, tolerance = 1) - - ##create a case where the value cannot be calculated - expect_type(.calc_HPDI(rlnorm(n = 100, meanlog = 10, sdlog = 100)), type = "logical") - - # .warningCatcher() --------------------------------------------------------------------------- - expect_warning(Luminescence:::.warningCatcher(for(i in 1:5) warning("test")), - regexp = "\\(1\\) test\\: This warning occurred 5 times\\!") - - # .smoothing ---------------------------------------------------------------------------------- - expect_silent(Luminescence:::.smoothing(runif(100), k = 5, method = "median")) - suppressWarnings( # suppress second warning: number of items to replace - # is not a multiple of replacement length - expect_warning(.smoothing(runif(100), k = 4, method = "median"), - "'k' must be odd") - ) - expect_silent(.smoothing(runif(200), method = "median")) - expect_silent(.smoothing(runif(100), k = 4, method = "mean")) - expect_error(Luminescence:::.smoothing(runif(100), method = "test")) - - # fancy_scientific ()-------------------------------------------------------------------------- - plot(seq(1e10, 1e20, length.out = 10),1:10, xaxt = "n") - expect_silent(axis(1, at = axTicks(1),labels = Luminescence:::fancy_scientific(axTicks(1)))) - - # .add_fancy_log_axis() ----------------------------------------------------- - y <- c(0.1, 0.001, 0.0001) - plot(1:length(y), y, yaxt = "n", log = "y") - expect_silent(Luminescence:::.add_fancy_log_axis(side = 2, las = 1)) - expect_null(.add_fancy_log_axis(side = 1, las = 1)) - - # .create_StatisticalSummaryText() ------------------------------------------------------------ - stats <- calc_Statistics(data.frame(1:10,1:10)) - expect_silent(Luminescence:::.create_StatisticalSummaryText()) - expect_equal(.create_StatisticalSummaryText(stats, - keywords = "mean"), - "mean = 5.5") - expect_equal(.create_StatisticalSummaryText(stats, - keywords = "unweighted$mean"), - "mean = 5.5") - expect_equal(.create_StatisticalSummaryText(stats, - keywords = "weighted$mean"), - "weighted$mean = 1.89") - - - # .unlist_RLum() ------------------------------------------------------------------------------ - expect_length(Luminescence:::.unlist_RLum(list(a = list(b = list(c = list(d = 1, e = 2))))), 2) - - # .rm_nonRLum() ----------------------------------------------------------- - expect_type( - Luminescence:::.rm_nonRLum(c(list(set_RLum("RLum.Analysis"), set_RLum("RLum.Analysis")), 2)), - "list") - expect_type( - Luminescence:::.rm_nonRLum( - c(list(set_RLum("RLum.Analysis"), set_RLum("RLum.Analysis")), 2), class = "RLum.Analysis"), - "list") - - # .matrix_binning() --------------------------------------------------------------------------- - m <- matrix(data = c(rep(1:20, each = 20)), ncol = 20, nrow = 20) - rownames(m) <- 1:nrow(m) - colnames(m) <- 1:ncol(m) - - ##crash the function - expect_error(Luminescence:::.matrix_binning("none matrix"), - regexp = "Input is not of class 'matrix'!") - - ##test operation modes and arguments - expect_type(Luminescence:::.matrix_binning(m, bin_size = 4, bin_col = FALSE), "integer") - expect_type(Luminescence:::.matrix_binning(m, bin_size = 4, bin_col = TRUE), "integer") - - ##test row / column renaming options - expect_type(Luminescence:::.matrix_binning(m, bin_size = 2, bin_col = FALSE, names = "groups"), - "integer") - expect_type(Luminescence:::.matrix_binning(m, bin_size = 2, bin_col = FALSE, names = "mean"), - "integer") - expect_type(Luminescence:::.matrix_binning(m, bin_size = 2, bin_col = FALSE, names = "sum"), - "integer") - expect_type(Luminescence:::.matrix_binning(m, bin_size = 2, bin_col = FALSE, names = c("test1", "test2")), - "integer") - - ##clean-up - rm(m) - - # .download_file() -------------------------------------------------------- - - ## returns just NULL (no URL detected) - expect_null(.download_file(url = "_url")) - - ## attempts download but fails - url.404 <- "https://raw.githubusercontent.com/R-Lum/rxylib/master/inst/extg" - expect_message( - expect_message( - expect_message(expect_null(.download_file(url = url.404)), - "URL detected:"), - "Attempting download ..."), - "FAILED") - - ## attempts download and succeeds - url.ok <- "https://raw.githubusercontent.com/R-Lum/rxylib/master/codecov.yml" - suppressMessages( # silence other messages already tested above - expect_message(expect_type(.download_file(url = url.ok), - "character"), - "OK") - ) - - # .get_named_list_element ------------------------------------------------ - ## create random named list element - l <- list( - a = list(x = 1:10), - b = list(x = 1:10) - - ) - t <- expect_type(.get_named_list_element(l, element = "x"), type = "list") - expect_equal(sum(unlist(t)), expected = 110) - - ## .throw_error() --------------------------------------------------------- - fun.int <- function() .throw_error("Error message") - fun.ext <- function() fun.int() - expect_error(fun.int(), - "[fun.int()] Error message", fixed = TRUE) - expect_error(fun.ext(), - "[fun.int()] Error message", fixed = TRUE) - - fun.int <- function() .throw_error("Error message", nframe = 2) - fun.ext <- function() fun.int() - expect_error(fun.ext(), - "[fun.ext()] Error message", fixed = TRUE) - - ## .throw_warning() ------------------------------------------------------- - fun.int <- function() .throw_warning("Warning message") - fun.ext <- function() fun.int() - expect_warning(fun.int(), - "[fun.int()] Warning message", fixed = TRUE) - expect_warning(fun.ext(), - "[fun.int()] Warning message", fixed = TRUE) - - fun.int <- function() .throw_warning("Warning message", nframe = 2) - fun.ext <- function() fun.int() - expect_warning(fun.ext(), - "[fun.ext()] Warning message", fixed = TRUE) - - ## SW() ------------------------------------------------------------------ - expect_silent(SW(cat("silenced message"))) - expect_silent(SW(message("silenced message"))) - expect_silent(SW(warning("silenced message"))) - expect_silent(SW(.throw_warning("silenced message"))) - expect_error(SW(stop("error message")), - "error message") - expect_error(SW(.throw_error("error message")), - "error message") - - ## .validate_positive_scalar() -------------------------------------------- - expect_silent(.validate_positive_scalar(1.3)) - expect_silent(.validate_positive_scalar(2, int = TRUE)) - expect_silent(.validate_positive_scalar(NULL, int = TRUE, null.ok = TRUE)) - - expect_error(.validate_positive_scalar(test <- "a"), - "'test' must be a positive scalar") - expect_error(.validate_positive_scalar(test <- NULL), - "'test' must be a positive scalar") - expect_error(.validate_positive_scalar(iris), - "'iris' must be a positive scalar") - expect_error(.validate_positive_scalar(1:2, name = "var"), - "'var' must be a positive scalar") - expect_error(.validate_positive_scalar(0, name = "var"), - "'var' must be a positive scalar") - expect_error(.validate_positive_scalar(-1, name = "var"), - "'var' must be a positive scalar") - expect_error(.validate_positive_scalar(1.5, int = TRUE, name = "var"), - "'var' must be a positive integer") - - ## C++ code ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ## - # src_create_RLumDataCurve_matrix ------------------------------------------------------------- - ##RLum.Data.Curve() ... test src_create_RLumDataCurve_matrix() - expect_output( - Luminescence:::src_create_RLumDataCurve_matrix( - DATA = 1:100, - VERSION = 4, - NPOINTS = 100, - LTYPE = "TL", - LOW = 0, - HIGH = 500, - AN_TEMP = 0, - TOLDELAY = 0, - TOLON = 0, - TOLOFF = 0 - ) - ) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_merge_RLum.Analysis.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_merge_RLum.Analysis.R deleted file mode 100644 index b3e571c1b..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_merge_RLum.Analysis.R +++ /dev/null @@ -1,24 +0,0 @@ -test_that("input validation", { - testthat::skip_on_cran() - - data(ExampleData.RLum.Analysis, envir = environment()) - o1 <- IRSAR.RF.Data - c1 <- as(object = list(1:10), Class = "RLum.Data.Curve") - r1 <- as(object = list(1:10), Class = "RLum.Results") - - expect_error(merge_RLum.Analysis(), - "is missing, with no default") - expect_error(merge_RLum.Analysis(o1), - "At least one input object in the list has to be of class") - expect_error(merge_RLum.Analysis(list(c1)), - "At least one input object in the list has to be of class") - expect_error(merge_RLum.Analysis(list(o1, "test")), - "At least element #2 is not of class 'RLum' or a derivative") - expect_error(merge_RLum.Analysis(list(o1, r1)), - "Object of class 'RLum.Results' not supported") - - expect_s4_class(merge_RLum.Analysis(list(o1)), - "RLum.Analysis") - expect_s4_class(merge_RLum.Analysis(list(c1, o1)), - "RLum.Analysis") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_merge_RLum.Data.Curve.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_merge_RLum.Data.Curve.R deleted file mode 100644 index a6d6ee9f3..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_merge_RLum.Data.Curve.R +++ /dev/null @@ -1,67 +0,0 @@ -test_that("Merge tests", { - testthat::skip_on_cran() - - ##load example data - data(ExampleData.XSYG, envir = environment()) - TL.curves <- get_RLum(OSL.SARMeasurement$Sequence.Object, recordType = "TL (UVVIS)") - TL.curve.1 <- TL.curves[[1]] - TL.curve.3 <- TL.curves[[3]] - TL.curve.3_short <- TL.curves[[3]] - TL.curve.3_short@data <- TL.curve.3_short@data[1:(nrow(TL.curve.3_short@data) - 1),] - TL.curve.3_types <- TL.curves[[3]] - TL.curve.3_types@recordType <- "IRSL" - TL.curve.3_zeros <- TL.curves[[3]] - TL.curve.3_zeros@data[10:12, 2] <- 0 - - ##check for error - expect_error(merge_RLum.Data.Curve("", merge.method = "/"), - "At least object 1 is not of class 'RLum.Data.Curve'") - expect_error(merge_RLum.Data.Curve(list(TL.curve.1, TL.curve.3), - merge.method = "error"), - "Unsupported or unknown merge method") - expect_error(merge_RLum.Data.Curve(list(TL.curve.1, TL.curve.3_types)), - "Only similar record types are supported") - - ## check warning for different curve lengths - expect_warning(merge_RLum.Data.Curve(list(TL.curve.1, TL.curve.3_short), - merge.method = "mean"), - "The number of channels between the curves differs") - - ##check error for different resolution - TL.curve.3_short@data <- TL.curve.3_short@data[-2,] - expect_error(merge_RLum.Data.Curve(list(TL.curve.1, TL.curve.3_short), - merge.method = "mean"), - "The objects do not seem to have the same channel resolution") - - ##check various operations - expect_s4_class(TL.curve.1 + TL.curve.3, "RLum.Data.Curve") - expect_s4_class(TL.curve.1 - TL.curve.3, "RLum.Data.Curve") - expect_s4_class(suppressWarnings(TL.curve.3 / TL.curve.1), "RLum.Data.Curve") - expect_warning(TL.curve.3 / TL.curve.1) - expect_s4_class(TL.curve.1 * TL.curve.3, "RLum.Data.Curve") - - merge_RLum.Data.Curve(list(TL.curve.1, TL.curve.3), - merge.method = "sum", method.info = 1) - merge_RLum.Data.Curve(list(TL.curve.1, TL.curve.3), - merge.method = "median") - merge_RLum.Data.Curve(list(TL.curve.1, TL.curve.3), - merge.method = "sd") - merge_RLum.Data.Curve(list(TL.curve.1, TL.curve.3), - merge.method = "var") - merge_RLum.Data.Curve(list(TL.curve.1, TL.curve.3), - merge.method = "max") - merge_RLum.Data.Curve(list(TL.curve.1, TL.curve.3), - merge.method = "min") - merge_RLum.Data.Curve(list(TL.curve.1, TL.curve.3), - merge.method = "-") - merge_RLum.Data.Curve(list(TL.curve.1, TL.curve.3), - merge.method = "*") - merge_RLum.Data.Curve(list(TL.curve.1, TL.curve.3), - merge.method = "/") - expect_warning(merge_RLum.Data.Curve(list(TL.curve.1, TL.curve.3_zeros), - merge.method = "/"), - "3 'inf' values have been replaced by 0 in the matrix") - expect_warning(merge_RLum.Data.Curve(list(TL.curve.1, TL.curve.3), - merge.method = "append"), - "longer object length is not a multiple of shorter object length") # FIXME(mcol) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_merge_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_merge_RLum.R deleted file mode 100644 index 4f5927df8..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_merge_RLum.R +++ /dev/null @@ -1,48 +0,0 @@ -test_that("Merge tests", { - testthat::skip_on_cran() - - ##load data - data(ExampleData.RLum.Analysis, envir = environment()) - - ## set objects - o1 <- IRSAR.RF.Data - o2 <- IRSAR.RF.Data - c1 <- as(object = list(1:10), Class = "RLum.Data.Curve") - r1 <- as(object = list(1:10), Class = "RLum.Results") - - ## simple test - expect_s4_class(merge_RLum(list(o1,o2)), "RLum.Analysis") - expect_s4_class(merge_RLum(list(c1,c1)), "RLum.Data.Curve") - expect_s4_class(merge_RLum(list(r1,r1)), "RLum.Results") - - ## with null objects - expect_s4_class(merge_RLum(list(o1,o2, NULL)), "RLum.Analysis") - - ## with unwanted objects - expect_error(merge_RLum(list(o1,o2, "test")), - regexp = "\\[merge\\_RLum\\(\\)\\]: At least element \\#3 is not of class 'RLum' or a derivative class\\!") - - ## single object - expect_s4_class( - merge_RLum(list(o1)), "RLum.Analysis") - - ## zero objects produces warnings - expect_warning( - merge_RLum(list(NULL)), - regexp = "\\[merge\\_RLum\\(\\)\\] Nothing was merged as the .+") - - ## crash with non-list - expect_error(merge_RLum("errr"), "\\[merge\\_RLum\\(\\)\\] argument 'objects' .*") - - ## mixed objects - expect_error(merge_RLum(list(r1, c1)), - "So far only similar input objects in the list are supported") - - ## unsupported - data(ExampleData.RLum.Data.Image, envir = environment()) - expect_error(merge_RLum(list(ExampleData.RLum.Data.Image)), - "Merging of 'RLum.Data.Image' objects is currently not supported") - data(ExampleData.XSYG, envir = environment()) - expect_error(merge_RLum(list(TL.Spectrum)), - "Merging of 'RLum.Data.Spectrum' objects is currently not supported") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_merge_RLum.Results.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_merge_RLum.Results.R deleted file mode 100644 index 44eb2c4a1..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_merge_RLum.Results.R +++ /dev/null @@ -1,40 +0,0 @@ -data(ExampleData.DeValues, envir = environment()) -res <- calc_CentralDose(ExampleData.DeValues$CA1, - plot = FALSE, verbose = FALSE) - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(merge_RLum.Results("error"), - "'objects' has to be of type 'list'") - expect_error(merge_RLum.Results(list(res, "error")), - "All objects to be merged must have type 'RLum.Results'") - - res2 <- res - res2@originator <- "unknown" - expect_error(merge_RLum.Results(list(res, res2)), - "Objects cannot be merged, different 'RLum.Results' originators found") - - res2 <- res - res2@data[[1]][, 2] <- NULL - expect_error(merge_RLum.Results(list(res, res2)), - "Objects cannot be merged, different number of columns") -}) - -test_that("Merge RLum.Results", { - testthat::skip_on_cran() - - ## check whether arguments are retained - a <- array(runif(300, 0,255), c(10,10,3)) - roi <- matrix(c(2.,4,2,5,6,7,3,1,1), ncol = 3) - t <- - expect_s4_class(merge_RLum.Results(lapply(list(roi, roi, roi), function(x) - extract_ROI(a, x))), "RLum.Results") - - expect_length(names(attributes(t@data$roi_summary)), 4) - - a <- merge_RLum.Results(list(res, res)) - expect_s3_class(a@data$summary, "data.frame") - - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_merge_Risoe.BINfileData.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_merge_Risoe.BINfileData.R deleted file mode 100644 index 769841bb2..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_merge_Risoe.BINfileData.R +++ /dev/null @@ -1,30 +0,0 @@ -test_that("Test merging", { - testthat::skip_on_cran() - - ##expect error - expect_error(merge_Risoe.BINfileData(input.objects = c("data", "data2")), - "File 'data' does not exist") - expect_error(merge_Risoe.BINfileData(input.objects = list("data", "data2")), - "Input list does not contain Risoe.BINfileData objects!") - expect_error(merge_Risoe.BINfileData(input.objects = c(FALSE, FALSE)), - "Input object is neither a character nor a list") - - ## nothing done - input <- "data" - expect_message(res <- merge_Risoe.BINfileData(input.objects = input), - "Nothing done: at least two input objects are needed") - expect_equal(res, input) - - ## expect success - data(ExampleData.BINfileData, envir = environment()) - object1 <- CWOSL.SAR.Data - object2 <- CWOSL.SAR.Data - expect_s4_class(merge_Risoe.BINfileData(c(object1, object2)), "Risoe.BINfileData") - - binx <- system.file("extdata/BINfile_V8.binx", package = "Luminescence") - output.file <- tempfile() - SW({ - merge_Risoe.BINfileData(c(binx, binx), output.file) - }) - expect_true(file.exists(output.file)) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_methods_DRAC.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_methods_DRAC.R deleted file mode 100644 index 413600114..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_methods_DRAC.R +++ /dev/null @@ -1,77 +0,0 @@ -##Full check -test_that("methods_DRAC", { - testthat::skip_on_cran() - - input <- template_DRAC(notification = FALSE) - - ## print - expect_message( - expect_output(print(input, blueprint = TRUE)), - "You can copy all lines above to your script and fill in the data") - expect_output(print(input, blueprint = FALSE)) - - ## as.data.frame - expect_s3_class(as.data.frame(input), "data.frame") - expect_s3_class(as.data.frame(input), "DRAC.data.frame") - - SW({ - - ## [[<- - expect_warning({ - input <- template_DRAC() - input[[1]] <- 1i - }, regexp = "cannot use objects of class") - expect_warning({ - input <- template_DRAC() - input[[1]] <- c(1, 2) - }, regexp = "Input must be of length") - expect_warning({ - input <- template_DRAC() - input[[5]] <- "1" - }, regexp = "Input must be of class numeric") - - expect_warning({ - input <- template_DRAC() - input[[5]] <- "X" - Luminescence:::.warningCatcher(input[[5]] <- "abc") - }, regexp = "Cannot coerce < abc > to a numeric value") - - expect_warning({ - input <- template_DRAC(nrow = 2) - input[[5]] <- c("X", 1) - Luminescence:::.warningCatcher(input[[5]] <- c("X", "abc")) - }, regexp = "Cannot coerce < abc > to a numeric value") - - expect_warning({ - input <- template_DRAC() - input[[5]] <- 1L - input[[5]] <- "abc" - }, regexp = "Input must be of class integer") - expect_warning({ - input <- template_DRAC() - input[[13]] <- "abc" - }, regexp = "Invalid option") - expect_warning({ - input <- template_DRAC() - input[[13]] <- 1 - }, regexp = "Input must be of class character") - - ## [<- - expect_identical( - object = template_DRAC(), - expected = { - input <- template_DRAC() - input[1] <- NA_character_ - input - }) - - ## $<- - expect_identical( - object = template_DRAC(), - expected = { - input <- template_DRAC() - input$`Project ID` <- NA_character_ - input - }) - }) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_methods_S3.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_methods_S3.R deleted file mode 100644 index 7721ac4c3..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_methods_S3.R +++ /dev/null @@ -1,156 +0,0 @@ -test_that("Test various S3 methods", { - testthat::skip_on_cran() - - ## RLum.Analysis - data(ExampleData.RLum.Analysis, envir = environment()) - analysis <- IRSAR.RF.Data - - expect_silent(plot(analysis)) - expect_silent(hist(analysis)) - expect_type(summary(analysis), "list") - expect_s4_class(subset(analysis), "RLum.Analysis") - expect_equal(length(analysis), 2) - expect_length(rep(analysis, 2), 2) - expect_equal(names(analysis), c("RF", "RF")) - expect_type(as.list(analysis), "list") - expect_equal(is(analysis), c("RLum.Analysis", "RLum")) - expect_s4_class(merge(analysis, analysis), "RLum.Analysis") - expect_length(unlist(analysis, recursive = TRUE), 4) - expect_length(unlist(analysis, recursive = FALSE), 2) - expect_length(analysis[1], 1) - expect_length(analysis["RF"], 2) - expect_s4_class(analysis[[1]], "RLum.Data.Curve") - expect_type(analysis[["RF"]], "list") - expect_length(analysis$RF, 2) - expect_true(is.RLum(analysis)) - expect_true(is.RLum.Analysis(analysis)) - expect_false(is.RLum.Data(analysis)) - - ## RLum.Results - result <- calc_SourceDoseRate( - measurement.date = "2012-01-27", - calib.date = "2014-12-19", - calib.dose.rate = 0.0438, - calib.error = 0.0019) - - expect_silent(plot(result)) - expect_silent(plot(list(result, result))) - expect_silent(hist(result)) - expect_s3_class(summary(result), "data.frame") - expect_equal(length(result), 3) - expect_length(rep(result, 2), 2) - expect_equal(names(result), c("dose.rate", "parameters", "call")) - expect_type(as.list(result), "list") - expect_equal(is(result), c("RLum.Results", "RLum")) - expect_s4_class(merge(result, result), "RLum.Results") - expect_visible(result[1]) - expect_visible(result[[1]]) - expect_visible(result$dose.rate) - expect_true(is.RLum(result)) - expect_true(is.RLum.Results(result)) - expect_false(is.RLum.Data(result)) - - ## RLum.Data.Curve - data(ExampleData.CW_OSL_Curve, envir = environment()) - curve <- set_RLum( - class = "RLum.Data.Curve", - data = as.matrix(ExampleData.CW_OSL_Curve), - curveType = "measured", - recordType = "OSL", - info = list(a = "test") - ) - - expect_silent(plot(curve)) - expect_silent(plot(list(curve, curve))) - expect_silent(hist(curve)) - expect_s3_class(summary(curve), "table") - expect_equal(length(curve), 40) - expect_equal(dim(curve), c(1000, 2)) - expect_s4_class(bin(curve), "RLum.Data.Curve") - expect_length(rep(curve, 2), 2) - expect_equal(names(curve), "a") - expect_s3_class(as.data.frame(curve), "data.frame") - expect_type(as.list(curve), "list") - expect_vector(as.matrix(curve)) - expect_equal(is(curve), c("RLum.Data.Curve", "RLum.Data", "RLum")) - expect_s4_class(merge(curve, curve), "RLum.Data.Curve") - expect_visible(curve + curve) - expect_visible(curve - curve) - expect_visible(curve * curve) - expect_visible(curve / curve) - expect_vector(curve[1]) - expect_equal(curve$a, c(a = "test")) - expect_true(is.RLum(curve)) - expect_true(is.RLum.Data(curve)) - expect_true(is.RLum.Data.Curve(curve)) - - ## RLum.Data.Image - data(ExampleData.RLum.Data.Image, envir = environment()) - image <- ExampleData.RLum.Data.Image - image3 <- set_RLum("RLum.Data.Image", - data = array(runif(300, 0, 255), c(10, 10, 3)), - info = list(NumFrames = 3)) - - expect_silent(plot(image)) - expect_silent(plot(list(image, image))) - expect_silent(plot(image3)) - expect_silent(hist(image)) - expect_silent(hist(image3)) - expect_s3_class(summary(image), "table") - expect_s3_class(summary(image3), "table") - expect_length(rep(image, 2), 2) - expect_equal(names(image)[1:3], - c("ControllerVersion", "LogicOutput", "AmpHiCapLowNoise")) - expect_equal(names(image3), "NumFrames") - expect_type(as.list(image), "list") - expect_length(as.list(image), 1) - expect_length(as.list(image3), 3) - expect_vector(as.matrix(image)) - expect_error(as.matrix(image3), - "No viable coercion to matrix, object contains multiple frames") - expect_equal(is(image), c("RLum.Data.Image", "RLum.Data", "RLum")) - expect_error(merge(image, image), - "Merging of 'RLum.Data.Image' objects is currently not supported") - expect_vector(image[1]) - expect_error(image3[1], - "No viable coercion to matrix, object contains multiple frames") - expect_true(is.RLum(image)) - expect_true(is.RLum.Data(image)) - expect_true(is.RLum.Data.Image(image)) - - ## RLum.Data.Spectrum - data(ExampleData.XSYG, envir = environment()) - spectrum <- TL.Spectrum - - expect_silent(plot(spectrum)) - expect_silent(plot(list(spectrum, spectrum))) - expect_s4_class(bin(spectrum), "RLum.Data.Spectrum") - expect_equal(dim(spectrum), c(1024, 24)) - expect_length(rep(spectrum, 2), 2) - expect_equal(names(spectrum)[1:3], c("state", "parentID", "startDate")) - expect_type(row.names(spectrum), "character") - expect_s3_class(as.data.frame(spectrum), "data.frame") - expect_vector(as.matrix(spectrum)) - expect_equal(is(spectrum), c("RLum.Data.Spectrum", "RLum.Data", "RLum")) - expect_error(merge(spectrum, spectrum), - "Merging of 'RLum.Data.Spectrum' objects is currently not supported") - expect_vector(spectrum[1]) - expect_true(is.RLum(spectrum)) - expect_true(is.RLum.Data(spectrum)) - expect_true(is.RLum.Data.Spectrum(spectrum)) - - ## Risoe.BINfileData - data(ExampleData.BINfileData, envir = environment()) - risoe <- CWOSL.SAR.Data - - expect_silent(plot(risoe)) - expect_error(plot(list(risoe, risoe))) - expect_error(subset(risoe, ERROR == 1)) - expect_warning(subset(risoe, ID == 1, error = TRUE), - "Argument not supported and skipped") - expect_length(subset(risoe, ID == 1), 1) - expect_length(subset(risoe, ID == 1, records.rm = FALSE), 720) - expect_equal(length(risoe), 720) - expect_equal(names(risoe)[1:40], c(rep("TL", 24), rep("OSL", 16))) - expect_s3_class(as.data.frame(risoe), "data.frame") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_names_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_names_RLum.R deleted file mode 100644 index 03df57418..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_names_RLum.R +++ /dev/null @@ -1,11 +0,0 @@ -test_that("Test whether function works", { - testthat::skip_on_cran() - - data(ExampleData.RLum.Analysis, envir = environment()) - expect_silent(names_RLum(IRSAR.RF.Data)) - expect_type(names_RLum(IRSAR.RF.Data), "character") - - ##test a list of such elements - expect_type(names_RLum(list(IRSAR.RF.Data,IRSAR.RF.Data, "a")), "list") - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_AbanicoPlot.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_AbanicoPlot.R deleted file mode 100644 index 5604ac68a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_AbanicoPlot.R +++ /dev/null @@ -1,235 +0,0 @@ -data(ExampleData.DeValues, envir = environment()) -ExampleData.DeValues <- ExampleData.DeValues$CA1 - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(plot_AbanicoPlot(data = "error"), - "Input data format must be 'data.frame' or 'RLum.Results'") - expect_error(plot_AbanicoPlot(ExampleData.DeValues[, 1, drop = FALSE]), - "Data set (1) has fewer than 2 columns: data without errors", - fixed = TRUE) - - expect_message(expect_null(plot_AbanicoPlot(ExampleData.DeValues[0, ])), - "Error: Nothing plotted, your data set is empty") - - expect_warning(expect_message( - expect_null(plot_AbanicoPlot(ExampleData.DeValues[1, ])), - "Error: After removing invalid entries, nothing is plotted"), - "Data sets 1 are found to be empty or consisting of only 1 row") - - expect_error(plot_AbanicoPlot(ExampleData.DeValues, plot = FALSE), - "'plot.ratio' must be a positive scalar") - expect_error(plot_AbanicoPlot(ExampleData.DeValues, xlab = "x"), - "'xlab' must have length 2") - expect_error(plot_AbanicoPlot(ExampleData.DeValues, z.0 = "error"), - "Value for 'z.0' not supported") - expect_error(plot_AbanicoPlot(ExampleData.DeValues, dispersion = "error"), - "Measure of dispersion not supported") - - ## zero-error values - data.zeros <- ExampleData.DeValues - data.zeros[2, 2] <- 0 - expect_warning(plot_AbanicoPlot(data.zeros, grid.col = c(1, 2)), - "Values with zero errors cannot be displayed and were removed") - data.zeros[, 2] <- 0 - expect_error(plot_AbanicoPlot(data.zeros), - "Data set contains only values with zero errors") -}) - -test_that("Test examples from the example page", { - testthat::skip_on_cran() - - ## plot the example data straightforward - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues)) - - ## now with linear z-scale - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - log.z = FALSE)) - - ## now with output of the plot parameters - expect_type(plot_AbanicoPlot(data = ExampleData.DeValues, - output = TRUE), "list") - - ## now with adjusted z-scale limits - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - zlim = c(10, 200))) - - ## now with adjusted x-scale limits - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - xlim = c(0, 20))) - - ## now with rug to indicate individual values in KDE part - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - rug = TRUE)) - - ## now with a smaller bandwidth for the KDE plot - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - bw = 0.04)) - - ## now with a histogram instead of the KDE plot - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - hist = TRUE, - kde = FALSE)) - - ## now with a KDE plot and histogram with manual number of bins - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - hist = TRUE, - breaks = 20)) - - ## now with a KDE plot and a dot plot - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - dots = TRUE)) - - ## now with user-defined plot ratio - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - plot.ratio = 0.5)) - - ## now with user-defined central value - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - z.0 = 70)) - - ## now with median as central value - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - z.0 = "median")) - - ## now with the 17-83 percentile range as definition of scatter - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - z.0 = "median", - dispersion = "p17")) - - ## now with user-defined green line for minimum age model - CAM <- calc_CentralDose(ExampleData.DeValues, - plot = FALSE, verbose = FALSE) - - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - line = CAM, - line.col = "darkgreen", - line.label = "CAM")) - - ## now create plot with legend, colour, different points and smaller scale - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - legend = "Sample 1", - col = "tomato4", - bar.col = "peachpuff", - pch = "R", - cex = 0.8)) - - ## now without 2-sigma bar, polygon, grid lines and central value line - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - bar.col = FALSE, - polygon.col = FALSE, - grid.col = FALSE, - y.axis = FALSE, - lwd = 0)) - - ## now with direct display of De errors, without 2-sigma bar - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - bar.col = FALSE, - ylab = "", - y.axis = FALSE, - error.bars = TRUE)) - - ## now with user-defined axes labels - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - xlab = c("Data error (%)", - "Data precision"), - ylab = "Scatter", - zlab = "Equivalent dose [Gy]")) - - ## now with minimum, maximum and median value indicated - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - stats = c("min", "max", "median"))) - - ## now with a brief statistical summary as subheader - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - summary = c("n", "in.2s"))) - - ## now with another statistical summary - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - summary = c("mean.weighted", "median"), - summary.pos = "topleft")) - - ## now a plot with two 2-sigma bars for one data set - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - bar = c(30, 100))) - - ## now the data set is split into sub-groups, one is manipulated - data.1 <- ExampleData.DeValues[1:30,] - data.2 <- ExampleData.DeValues[31:62,] * 1.3 - data.3 <- list(data.1, data.2) - - ## now the two data sets are plotted in one plot - expect_silent(plot_AbanicoPlot(data = data.3)) - - ## now with some graphical modification - expect_silent(plot_AbanicoPlot(data = data.3, - z.0 = "median", - col = c("steelblue4", "orange4"), - bar.col = c("steelblue3", "orange3"), - polygon.col = c("steelblue1", "orange1"), - pch = c(2, 6), - angle = c(30, 50), - summary = c("n", "in.2s", "median"))) - - ## create Abanico plot with predefined layout definition - expect_silent(plot_AbanicoPlot(data = ExampleData.DeValues, - layout = "journal")) - - ## now with predefined layout definition and further modifications - expect_silent(plot_AbanicoPlot(data = data.3, - z.0 = "median", - layout = "journal", - col = c("steelblue4", "orange4"), - bar.col = adjustcolor(c("steelblue3", "orange3"), - alpha.f = 0.5), - polygon.col = c("steelblue3", "orange3"))) - - ## for further information on layout definitions see documentation - ## of function get_Layout() - - ## now with manually added plot content - ## create empty plot with numeric output - expect_type(plot_AbanicoPlot(data = ExampleData.DeValues, - pch = NA, - output = TRUE), "list") - - ## interactive mode - expect_silent(plot_AbanicoPlot(ExampleData.DeValues, interactive = TRUE)) -}) - -test_that("more coverage", { - testthat::skip_on_cran() - - ## weights - expect_silent(plot_AbanicoPlot(ExampleData.DeValues, weights = FALSE, - boxplot = TRUE, frame = 2)) - suppressWarnings( # additional warning on weights not summing to 1 - expect_warning(plot_AbanicoPlot(ExampleData.DeValues, weights = TRUE, - rotate = TRUE, line = 1, - grid.col = c(1, 2)), - "Selecting bandwidth *not* using 'weights'", - fixed = TRUE) - ) - - ## negative values - data.neg <- ExampleData.DeValues - data.neg[1, 1] <- -1 - expect_silent(plot_AbanicoPlot(data.neg, z.0 = "mean", dispersion = "sd", - boxplot = TRUE, frame = 3, - main = "Title", sub = "Subtitle")) - - ## missing values - data.na <- ExampleData.DeValues - data.na[1, 2] <- NA - expect_message(plot_AbanicoPlot(data.na, rotate = TRUE, boxplot = TRUE, - hist = TRUE, error.bars = TRUE, dots = TRUE, - rug = TRUE, y.axis = FALSE, stats = "min", - legend = "legend", legend.pos = "bottomleft", - summary.pos = "bottomright", log.z = FALSE, - xlab = c("x1", "x2", "x3"), lty = 2, - dispersion = "2sd", - at = seq(20, 120, nrow(data.na) - 1)), - "Data set (1): 1 NA value excluded", - fixed = TRUE) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_DRCSummary.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_DRCSummary.R deleted file mode 100644 index 32db0b579..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_DRCSummary.R +++ /dev/null @@ -1,64 +0,0 @@ -data(ExampleData.BINfileData, envir = environment()) -object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = 1) -results <- analyse_SAR.CWOSL( - object = object, - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - plot = FALSE, - verbose = FALSE -) - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(plot_DRCSummary("test"), - "'object' is not of class 'RLum.Results'") - expect_error(plot_DRCSummary(set_RLum("RLum.Results")), - "'object' was not created by a supported function") - - ## different fit - err <- merge_RLum(list(results, results)) - err@data$data$Fit[2] <- "err" - expect_error(plot_DRCSummary(err), - "I can only visualise dose-response curves based on the same") -}) - -test_that("Test plotting", { - testthat::skip_on_cran() - - ## create LambertW DRC - results_LamW <- analyse_SAR.CWOSL( - object = object, - fit.method = "LambertW", - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - NumberIterations.MC = 2, - plot = FALSE, - verbose = FALSE - ) - - ##simple - expect_silent(plot_DRCSummary(results)) - - ##simple with graphical arguments - expect_silent(plot_DRCSummary(results, col.lty = "red")) - - ##simple with LambertW - expect_silent(plot_DRCSummary(results_LamW)) - - ## list - expect_silent(plot_DRCSummary(list(results, results_LamW), - main = "Title")) - expect_silent(plot_DRCSummary(list(results, results_LamW), - source_dose_rate = 1)) - - ##plus points - expect_silent(plot_DRCSummary(results, show_dose_points = TRUE, show_natural = TRUE)) - - ##expect warning - expect_warning(plot_DRCSummary(results, show_dose_points = TRUE, show_natural = TRUE, sel_curves = 1000)) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_DRTResults.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_DRTResults.R deleted file mode 100644 index 228c617b1..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_DRTResults.R +++ /dev/null @@ -1,77 +0,0 @@ -set.seed(1) -data(ExampleData.DeValues, envir = environment()) -df <- ExampleData.DeValues$BT998[7:11,] -df.list <- list(df, df * c(runif(5, 0.9, 1.1), 1)) - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(plot_DRTResults("error"), - "Input data must be one of 'data.frame' or 'RLum.Results'") - expect_error(plot_DRTResults(list("error")), - "Input data must be one of 'data.frame' or 'RLum.Results'") - expect_error(plot_DRTResults(df, preheat = c(200, 240, 240)), - "Number of preheat temperatures != De values") - expect_error(plot_DRTResults(df, given.dose = c(2800, 3000)), - "'given.dose' > number of input data sets") - expect_warning(plot_DRTResults(df, boxplot = TRUE), - "Option 'boxplot' requires a value in 'preheat'") -}) - -test_that("check functionality", { - testthat::skip_on_cran() - - expect_silent(plot_DRTResults(df)) - expect_silent(plot_DRTResults(df, preheat = c(200, 200, 200, 240, 240))) - expect_silent(plot_DRTResults(df, preheat = c(200, 200, 200, 240, 240), - boxplot = FALSE, given.dose = 2800)) - expect_silent(plot_DRTResults(df, preheat = c(200, 200, 200, 240, 240), - boxplot = TRUE, given.dose = 2800)) - expect_silent(plot_DRTResults(df, preheat = c(200, 200, 200, 240, 240), - boxplot = TRUE, given.dose = 2800, - summary = "mean", summary.pos = "sub")) - expect_silent(plot_DRTResults(df.list, given.dose = c(2800, 2900))) - expect_silent(plot_DRTResults(df.list, preheat = c(200, 200, 200, 240, 240), - boxplot = TRUE)) - - ## more coverage - expect_silent(plot_DRTResults(df, given.dose = 2800, - main = "Title", mtext = "Example data", - xlim = c(0, 6), ylim = c(0.8, 1.2), - xlab = "x", ylab = "y", - summary = "mean", summary.pos = c(0, 1.2), - legend = "legend", legend.pos = c(5, 1.2), - col = 2, cex = 1, pch = 2)) - expect_silent(plot_DRTResults(df, summary = "n", summary.pos = "sub")) - expect_silent(plot_DRTResults(df, summary.pos = "top", - legend.pos = "bottom")) - expect_silent(plot_DRTResults(df, summary.pos = "topright", - legend.pos = "topleft")) - expect_silent(plot_DRTResults(df, summary.pos = "left", - legend.pos = "right")) - expect_silent(plot_DRTResults(df, summary.pos = "center", - legend.pos = "center")) - expect_silent(plot_DRTResults(df, summary.pos = "right", - legend.pos = "left")) - expect_silent(plot_DRTResults(df, summary.pos = "bottomleft", - legend.pos = "bottomright")) - expect_silent(plot_DRTResults(df, summary.pos = "bottom", - legend.pos = "top")) - expect_silent(plot_DRTResults(df, summary.pos = "bottomright", - legend.pos = "bottomleft")) - - - ## plot_DRTResults(df.list, preheat = c(200, 200, 200, 240, 240), - ## given.dose = 2800, boxplot = TRUE) - - - - ## RLum.Results object - expect_silent(plot_DRTResults(calc_CommonDose(df, plot = FALSE, - verbose = FALSE))) - - ## missing values - df.na <- df - df.na[2, 1] <- NA - expect_silent(plot_DRTResults(df, preheat = c(200, 200, 200, 240, 240))) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_DetPlot.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_DetPlot.R deleted file mode 100644 index a3f93beae..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_DetPlot.R +++ /dev/null @@ -1,172 +0,0 @@ -data(ExampleData.BINfileData, envir = environment()) -object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = 1) - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(plot_DetPlot("error"), - "Input must be an 'RLum.Analysis' object") - expect_error(plot_DetPlot(object, signal.integral.min = "error"), - "'signal.integral.min' must be a positive integer scalar") - expect_error(plot_DetPlot(object, signal.integral.min = 1, - signal.integral.max = 1), - "'signal.integral.max' must be greater than 'signal.integral.min'") - expect_error(plot_DetPlot(object, signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - analyse_function = "error", - verbose = FALSE), - "Unknown 'analyse_function'") -}) - -test_that("plot_DetPlot", { - testthat::skip_on_cran() - - ## simple run with default - SW({ - results <- expect_s4_class(plot_DetPlot( - object, - method = "shift", - signal.integral.min = 1, - signal.integral.max = 3, - background.integral.min = 900, - background.integral.max = 1000, - analyse_function.control = list( - fit.method = "LIN"), - n.channels = 2), - "RLum.Results") - }) - - ## simple run with default but no plot - results <- expect_s4_class(plot_DetPlot( - object, - method = "shift", - signal.integral.min = 1, - signal.integral.max = 3, - background.integral.min = 900, - background.integral.max = 1000, - analyse_function.control = list( - fit.method = "LIN"), - n.channels = 2, - verbose = FALSE, - plot = FALSE), - "RLum.Results") - - ## test with trim channels - results <- expect_s4_class(plot_DetPlot( - object, - method = "shift", - signal.integral.min = 1, - signal.integral.max = 3, - background.integral.min = 900, - background.integral.max = 1000, - analyse_function.control = list( - fit.method = "LIN", - trim_channels = TRUE - ), - n.channels = 2, - verbose = FALSE, - plot = FALSE), - "RLum.Results") - - ## test self call with multi core - SW({ - results <- expect_s4_class(plot_DetPlot( - object = list(x = object, y = object), - method = "shift", - signal.integral.min = 1, - signal.integral.max = 3, - background.integral.min = 900, - background.integral.max = 1000, - analyse_function.control = list( - fit.method = "LIN", - trim_channels = TRUE - ), - multicore = 1, - n.channels = 2, - verbose = TRUE, - plot = FALSE), - "RLum.Results") - }) - - ## simple run with default - results <- expect_s4_class(plot_DetPlot( - object, - method = "expansion", - signal.integral.min = 1, - signal.integral.max = 3, - background.integral.min = 900, - background.integral.max = 1000, - analyse_function.control = list( - fit.method = "LIN"), - verbose = FALSE, - n.channels = 2), - "RLum.Results") - - ## try with NA values - object@records[[2]][,2] <- 1 - object@records[[4]][,2] <- 1 - object@records[[6]][,2] <- 1 - object@records[[8]][,2] <- 1 - results <- expect_s4_class(suppressWarnings(plot_DetPlot( - object, - method = "expansion", - signal.integral.min = 1, - signal.integral.max = 3, - background.integral.min = 900, - background.integral.max = 1000, - analyse_function.control = list( - fit.method = "EXP"), - verbose = FALSE, - n.channels = 1)), - "RLum.Results") - - SW({ - ## n.channels not set - expect_message(plot_DetPlot(object, - method = "shift", - signal.integral.min = 5, - signal.integral.max = 6, - background.integral.min = 10, - background.integral.max = 50, - analyse_function.control = list( - fit.method = "LIN"), - verbose = TRUE), - "'n.channels' not specified, set to 3") - - ## analyse_pIRIRSequence - tmp <- subset(object, recordType != "IRSL" & ID != 1) - plot_DetPlot( - tmp, - method = "expansion", - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - analyse_function = "analyse_pIRIRSequence", - analyse_function.control = list( - sequence.structure = c("TL", "IR50"), - fit.method = "LIN"), - respect_RC.Status = TRUE, - n.channels = 2) - - ## analyse_pIRIRSequence on an inconsistent object - suppressWarnings( # ignore additional warnings from plot_GrowthCurve() - expect_error( - expect_warning(plot_DetPlot( - object, - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - analyse_function = "analyse_pIRIRSequence", - analyse_function.control = list( - fit.method = "LIN"), - verbose = FALSE, - n.channels = 1), - "An error occurred, analysis skipped"), - "No valid results produced") - ) - }) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_FilterCombinations.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_FilterCombinations.R deleted file mode 100644 index d55546052..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_FilterCombinations.R +++ /dev/null @@ -1,29 +0,0 @@ -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(plot_FilterCombinations("error"), - "'filters' should be of type 'list'") - expect_error(plot_FilterCombinations(list("error")), - "All elements of 'filter' must be of type") - expect_error(plot_FilterCombinations(list(data.frame(a = c(100, 200), - b = c(0.2, 1.1)))), - "Transmission values > 1 found, check your data") -}) - -test_that("check functionality", { - testthat::skip_on_cran() - - filter1 <- density(rnorm(100, mean = 450, sd = 20)) - filter1 <- matrix(c(filter1$x, filter1$y / max(filter1$y)), ncol = 2) - filter2 <- matrix(c(200:799, rep(c(0, 0.8, 0), each = 200)), ncol = 2) - - expect_silent(plot_FilterCombinations(filters = list(filter1, filter2))) - expect_silent(plot_FilterCombinations(filters = list(filter1, filter2), - interactive = TRUE)) - expect_silent(plot_FilterCombinations(list(list(filter1)))) - - ## filter thickness and reflection factor provided - expect_silent(plot_FilterCombinations(list(list(filter1, d = 2), - list(filter2, d = 2, P = 0.9)))) - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_Functions.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_Functions.R deleted file mode 100644 index a873a0673..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_Functions.R +++ /dev/null @@ -1,109 +0,0 @@ -test_that("test pure success of the plotting without warning or error", { - testthat::skip_on_cran() - - ##distribution plots - data(ExampleData.DeValues, envir = environment()) - ExampleData.DeValues <- ExampleData.DeValues$CA1 - - expect_silent(plot_RadialPlot(ExampleData.DeValues)) - expect_silent(plot_KDE(ExampleData.DeValues)) - - ##plot_Det - data(ExampleData.BINfileData, envir = environment()) - object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) - expect_s4_class( - plot_DetPlot( - object, - signal.integral.min = 1, - signal.integral.max = 3, - background.integral.min = 900, - background.integral.max = 1000, - n.channels = 5, - verbose = FALSE, - ), - "RLum.Results" - ) - - ##various RLum plots - - ##RLum.Data.Curve - data(ExampleData.CW_OSL_Curve, envir = environment()) - temp <- as(ExampleData.CW_OSL_Curve, "RLum.Data.Curve") - expect_silent(plot(temp)) - - ##RLum.Data.Spectrum ------- - data(ExampleData.XSYG, envir = environment()) - expect_silent(plot(TL.Spectrum, - plot.type="contour", - xlim = c(310,750), - ylim = c(0,300))) - - expect_silent(suppressWarnings(plot_RLum.Data.Spectrum(TL.Spectrum, - plot.type="persp", - xlim = c(310,750), - ylim = c(0,100), - bin.rows=10, - bin.cols = 1))) - - expect_silent(suppressWarnings(plot_RLum.Data.Spectrum(TL.Spectrum, - plot.type="multiple.lines", - xlim = c(310,750), - ylim = c(0,100), - bin.rows=10, - bin.cols = 1))) - - expect_silent(suppressWarnings(plot_RLum.Data.Spectrum(TL.Spectrum, plot.type="interactive", - xlim = c(310,750), ylim = c(0,300), bin.rows=10, - bin.cols = 1))) - - - expect_silent(suppressWarnings(plot_RLum.Data.Spectrum(TL.Spectrum, plot.type="interactive", - xlim = c(310,750), ylim = c(0,300), bin.rows=10, - bin.cols = 1, - type = "heatmap", - showscale = TRUE))) - - expect_silent(suppressWarnings(plot_RLum.Data.Spectrum(TL.Spectrum, plot.type="interactive", - xlim = c(310,750), ylim = c(0,300), bin.rows=10, - bin.cols = 1, - type = "contour", - showscale = TRUE))) - - expect_error(plot(TL.Spectrum, - plot.type="contour", - xlim = c(310,750), - ylim = c(0,300), bin.cols = 0)) - - - ##RLum.Analysis - data(ExampleData.BINfileData, envir = environment()) - temp <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) - expect_silent(plot( - temp, - subset = list(recordType = "TL"), - combine = TRUE, - norm = TRUE, - abline = list(v = c(110)) - )) - - ##special plot RLum.Reuslts - data(ExampleData.DeValues, envir = environment()) - mam <- calc_MinDose(data = ExampleData.DeValues$CA1, sigmab = 0.2, - log = TRUE, plot = FALSE, verbose = FALSE) - expect_silent(plot_RLum(mam)) - cdm <- calc_CentralDose(ExampleData.DeValues$CA1, verbose = FALSE) - expect_silent(plot_RLum(cdm)) - FMM <- calc_FiniteMixture(ExampleData.DeValues$CA1, verbose = FALSE, - sigmab = 0.2, n.components = c(2:4), - pdf.weight = TRUE, dose.scale = c(0, 100)) - plot_RLum(FMM) -}) - -test_that("test for return values, if any", { - testthat::skip_on_cran() - - data(ExampleData.DeValues, envir = environment()) - output <- plot_AbanicoPlot(ExampleData.DeValues, output = TRUE) - expect_type(output, "list") - expect_length(output, 10) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_GrowthCurve.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_GrowthCurve.R deleted file mode 100644 index 6a0266615..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_GrowthCurve.R +++ /dev/null @@ -1,526 +0,0 @@ -test_that("plot_GrowthCurve", { - testthat::skip_on_cran() - - ## load data - data(ExampleData.LxTxData, envir = environment()) - - ##fit.method - expect_error( - object = plot_GrowthCurve(LxTxData, fit.method = "FAIL"), - regexp = "\\[plot\\_GrowthCurve\\(\\)\\] Fit method not supported, supported.+") - - ## input object - expect_error( - object = plot_GrowthCurve("test"), - regexp = "\\[plot\\_GrowthCurve\\(\\)\\] Argument 'sample' needs to be of type 'data.frame'\\!") - - ## shorten dataframe - expect_error( - object = plot_GrowthCurve(LxTxData[1:2,]), - regexp = "\\[plot\\_GrowthCurve\\(\\)\\] At least three regeneration points are required!") - - ## wrong argument for mode - expect_error( - object = plot_GrowthCurve(LxTxData, mode = "fail"), - regexp = "\\[plot\\_GrowthCurve\\(\\)\\] Unknown input for argument 'mode'") - - ## wrong combination of fit.method and mode - expect_error( - plot_GrowthCurve(LxTxData, fit.method = "EXP+EXP", - mode = "extrapolation"), - "mode 'extrapolation' for fitting method 'EXP+EXP' currently not supported", - fixed = TRUE) - -# Weird LxTx values -------------------------------------------------------- - - ##set LxTx - LxTx <- structure(list( - Dose = c(0, 250, 500, 750, 1000, 1500, 0, 500, 500), - LxTx = c(1, Inf, 0, -Inf, Inf, 0, Inf, -0.25, 2), - LxTx.Error = c(1.58133646008685, Inf, 0, Inf, Inf, 0, Inf, 1.41146256149428, 3.16267292017369)), - class = "data.frame", row.names = c(NA, -9L)) - - ##fit - SW({ - expect_warning( - plot_GrowthCurve( - sample = LxTx[,c("Dose", "LxTx", "LxTx.Error")], - output.plot = TRUE), - "Inf values found, replaced by NA") - }) - - ##all points have the same dose ... error but NULL - data(ExampleData.LxTxData, envir = environment()) - tmp_LxTx <- LxTxData - tmp_LxTx$Dose <- 10 - - expect_message(expect_null( - object = plot_GrowthCurve(tmp_LxTx)), - "Error: All points have the same dose, NULL returned") - - ## check input objects ... matrix - SW({ - expect_s4_class( - object = plot_GrowthCurve(as.matrix(LxTxData), output.plot = FALSE), - class = "RLum.Results") - }) - - ## check input objects ... list - expect_s4_class( - object = plot_GrowthCurve(as.list(LxTxData), output.plot = FALSE, - verbose = FALSE), - class = "RLum.Results") - - ## test case for only two columns - expect_s4_class( - suppressWarnings(plot_GrowthCurve(LxTxData[,1:2], output.plot = FALSE, - verbose = FALSE)), - class = "RLum.Results") - - ## test case with all NA - tmp_LxTx <- LxTxData - tmp_LxTx$LxTx <- NA - expect_message(expect_null( - suppressWarnings(plot_GrowthCurve(tmp_LxTx, output.plot = FALSE))), - "Error: After NA removal, nothing is left from the data set") - - ## test case without TnTx column - tmp_LxTx <- LxTxData - tmp_LxTx$TnTx <- NULL - SW({ - expect_s4_class( - plot_GrowthCurve(tmp_LxTx, output.plot = TRUE, verbose = FALSE), - "RLum.Results") - }) - - ## do not include reg point - expect_s4_class( - object = plot_GrowthCurve( - sample = LxTxData, - output.plot = FALSE, verbose = FALSE, - fit.includingRepeatedRegPoints = FALSE), - class = "RLum.Results") - - ## use odd data set where the calculated De is negative for EXP - df_odd <- structure(list(dose = c(0, 0, 2.71828182845905, 2.74202785430992, - 2.76598131771852, 2.79014403079188, 2.814517821467, 2.83910453364916, - 2.86390602735137, 2.88892417883514, 2.91416088075237, 2.93961804228855, - 2.96529758930721, 2.99120146449558, 3.01733162751159, 3.04369005513209, - 3.07027874140241, 3.09709969778723, 3.1241549533227, 3.15144655477 - ), LxTx = c(0.439, 0.851865307456887, 0.881530377359027, 0.881788046363334, - 0.882047940677405, 0.882310079298982, 0.882574481384203, 0.882841166248859, - 0.883110153369655, 0.883381462385488, 0.883655113098727, 0.883931125476509, - 0.884209519652028, 0.88449031592586, 0.884773534767266, 0.885059196815536, - 0.885347322881313, 0.885637933947948, 0.885931051172847, 0.886226695888845 - ), LxTx.error = c(0.029, 1e-04, 0.0393190034426231, 0.0393304962836274, - 0.0393420883803856, 0.0393537805802564, 0.0393655737376631, 0.0393774687141504, - 0.03938946637844, 0.0394015676064878, 0.0394137732815415, 0.0394260842941973, - 0.0394385015424588, 0.0394510259317946, 0.0394636583751979, 0.0394763997932453, - 0.0394892511141562, 0.0395022132738537, 0.0395152872160239, 0.0395284738921779 - )), row.names = c(NA, 20L), class = "data.frame") - - ## do not include reg point - t <- expect_s4_class( - object = plot_GrowthCurve( - sample = df_odd, - verbose = FALSE, - output.plot = FALSE), - class = "RLum.Results") - - expect_true(is.na(t$De[[1]])) - -# Check output for regression --------------------------------------------- - set.seed(1) - data(ExampleData.LxTxData, envir = environment()) - SW({ - temp_EXP <- - plot_GrowthCurve( - LxTxData, - fit.method = "EXP", - output.plot = FALSE, - verbose = FALSE, - NumberIterations.MC = 10 - ) - temp_LIN <- - plot_GrowthCurve( - LxTxData, - fit.method = "LIN", - output.plot = FALSE, - verbose = FALSE, - NumberIterations.MC = 10 - ) - temp_LIN <- - plot_GrowthCurve( - LxTxData, - fit.method = "LIN", - mode = "extrapolation", - fit.force_through_origin = TRUE, - output.plot = FALSE, - verbose = FALSE, - NumberIterations.MC = 10 - ) - temp_EXPLIN <- - plot_GrowthCurve( - LxTxData, - fit.method = "EXP+LIN", - fit.bounds = FALSE, - fit.force_through_origin = TRUE, - output.plot = FALSE, - verbose = FALSE, - NumberIterations.MC = 10 - ) - temp_EXPEXP <- - plot_GrowthCurve( - LxTxData, - fit.method = "EXP+EXP", - output.plot = FALSE, - verbose = TRUE, - NumberIterations.MC = 10 - ) - temp_QDR <- - plot_GrowthCurve( - LxTxData, - fit.method = "QDR", - output.plot = FALSE, - verbose = TRUE, - NumberIterations.MC = 10 - ) - temp_QDR <- - plot_GrowthCurve( - LxTxData, - fit.method = "QDR", - output.plot = FALSE, - mode = "extrapolation", - fit.force_through_origin = TRUE, - verbose = TRUE, - NumberIterations.MC = 10 - ) - temp_GOK <- - plot_GrowthCurve( - LxTxData, - fit.method = "GOK", - output.plot = FALSE, - verbose = FALSE, - NumberIterations.MC = 10 - ) - temp_LambertW <- - plot_GrowthCurve( - LxTxData, - fit.method = "LambertW", - output.plot = FALSE, - verbose = FALSE, - NumberIterations.MC = 10 - ) - }) - - expect_s4_class(temp_EXP, class = "RLum.Results") - expect_s3_class(temp_EXP$Fit, class = "nls") - - expect_s4_class(temp_LIN, class = "RLum.Results") - expect_s3_class(temp_LIN$Fit, class = "lm") - - expect_s4_class(temp_EXPLIN, class = "RLum.Results") - expect_s3_class(temp_EXPLIN$Fit, class = "nls") - - expect_s4_class(temp_EXPEXP, class = "RLum.Results") - expect_s3_class(temp_EXPEXP$Fit, class = "nls") - - expect_s4_class(temp_QDR, class = "RLum.Results") - expect_s3_class(temp_QDR$Fit, class = "lm") - - expect_s4_class(temp_GOK, class = "RLum.Results") - expect_s3_class(temp_GOK$Fit, class = "nls") - - expect_s4_class(temp_LambertW, class = "RLum.Results") - expect_s3_class(temp_LambertW$Fit, class = "nls") - - ## check n_N calculation - expect_equal(round(temp_EXP$De$n_N, 1), 0.5) - expect_equal(round(temp_LambertW$De$n_N, 1), 0.6) - -# Check more output ------------------------------------------------------- - data(ExampleData.LxTxData, envir = environment()) - - set.seed(1) - SW({ - temp_EXP <- - plot_GrowthCurve( - LxTxData, - fit.method = "EXP", - output.plot = FALSE, - verbose = FALSE, - NumberIterations.MC = 10 - ) - temp_LIN <- - plot_GrowthCurve( - LxTxData, - fit.method = "LIN", - output.plot = FALSE, - verbose = FALSE, - NumberIterations.MC = 10 - ) - temp_EXPLIN <- - plot_GrowthCurve( - LxTxData, - fit.method = "EXP+LIN", - output.plot = FALSE, - verbose = FALSE, - NumberIterations.MC = 10 - ) - temp_EXPEXP <- - plot_GrowthCurve( - LxTxData, - fit.method = "EXP+EXP", - output.plot = FALSE, - verbose = FALSE, - NumberIterations.MC = 10 - ) - temp_QDR <- - plot_GrowthCurve( - LxTxData, - fit.method = "QDR", - output.plot = FALSE, - verbose = FALSE, - NumberIterations.MC = 10 - ) - temp_GOK <- - plot_GrowthCurve( - LxTxData, - fit.method = "GOK", - output.plot = FALSE, - verbose = FALSE, - NumberIterations.MC = 10) - ## force through the origin - temp_LxTx <-LxTxData - temp_LxTx$LxTx[[7]] <- 1 - expect_s4_class(plot_GrowthCurve( - temp_LxTx, - fit.method = "GOK", - output.plot = FALSE, - verbose = FALSE, - NumberIterations.MC = 10, - fit.force_through_origin = TRUE - ), "RLum.Results") -temp_LambertW <- - plot_GrowthCurve( - LxTxData, - fit.method = "LambertW", - output.plot = FALSE, - verbose = FALSE, - NumberIterations.MC = 10 - ) - }) - - expect_equal(round(temp_EXP$De[[1]], digits = 2), 1737.88) - expect_equal(round(sum(temp_EXP$De.MC, na.rm = TRUE), digits = 0), 17562) - expect_equal(round(temp_LIN$De[[1]], digits = 2), 1811.33) - expect_equal(round(sum(temp_LIN$De.MC, na.rm = TRUE), digits = 0),18398) - expect_equal(round(temp_EXPLIN$De[[1]], digits = 2), 1791.53) - expect_equal(round(sum(temp_EXPLIN$De.MC, na.rm = TRUE), digits = 0),18045) - expect_equal(round(temp_EXPEXP$De[[1]], digits = 2), 1787.15) - expect_equal(round(sum(temp_EXPEXP$De.MC, na.rm = TRUE), digits = 0), 7303, - tolerance = 10) - expect_equal(round(temp_QDR$De[[1]], digits = 2), 1666.2) - expect_equal(round(sum(temp_QDR$De.MC, na.rm = TRUE), digits = 0), 16476) - expect_equal(round(temp_GOK$De[[1]], digits = 0), 1786) - ##fix for different R versions - if (R.version$major > "3"){ - if(any(grepl("aarch64", sessionInfo()$platform))) { - expect_equal(round(sum(temp_GOK$De.MC, na.rm = TRUE), digits = 1), 17796, - tolerance = 0.001) - - } else { - expect_equal(round(sum(temp_GOK$De.MC, na.rm = TRUE), digits = 1), 17828.9, - tolerance = 0.1) - - } - } - - expect_equal(round(temp_LambertW$De[[1]], digits = 2), 1784.78) - expect_equal(round(sum(temp_LambertW$De.MC, na.rm = TRUE), digits = 0), 17422) - - -# Check extrapolation ----------------------------------------------------- - ## load data - data(ExampleData.LxTxData, envir = environment()) - - set.seed(1) - LxTxData[1,2:3] <- c(0.5, 0.001) - SW({ - LIN <- expect_s4_class( - plot_GrowthCurve(LxTxData,mode = "extrapolation", fit.method = "LIN", - main = "Title", xlab = "x-axis", ylab = "y-axis", - xlim = c(0, 10), ylim = c(0, 10), fun = TRUE), - "RLum.Results") - EXP <- expect_s4_class( - plot_GrowthCurve(LxTxData,mode = "extrapolation", fit.method = "EXP"), - "RLum.Results") - EXPLIN <- expect_s4_class( - suppressWarnings( - plot_GrowthCurve( - LxTxData,mode = "extrapolation", fit.method = "EXP+LIN")), - "RLum.Results") - - GOK <- expect_s4_class( - plot_GrowthCurve(LxTxData,mode = "interpolation", fit.method = "GOK"), - "RLum.Results") - - LambertW <- expect_s4_class( - plot_GrowthCurve(LxTxData,mode = "extrapolation", fit.method = "LambertW"), "RLum.Results") - }) - - expect_equal(round(LIN$De$De,0), 165) - expect_equal(round(EXP$De$De,0), 110) - expect_equal(round(LambertW$De$De,0), 114) - - #it fails on some unix platforms for unknown reason. - #expect_equivalent(round(EXPLIN$De$De,0), 110) - -# Check alternate --------------------------------------------------------- - ## load data - data(ExampleData.LxTxData, envir = environment()) - - set.seed(1) - LxTxData[1,2:3] <- c(0.5, 0.001) - - ##LIN - expect_s4_class( - object = plot_GrowthCurve(LxTxData,mode = "alternate", fit.method = "LIN", output.plot = FALSE), - "RLum.Results") - - ## EXP - EXP <- expect_s4_class( - object = plot_GrowthCurve(LxTxData,mode = "alternate", fit.method = "EXP", output.plot = FALSE), - "RLum.Results") - - ## EXP+LIN - EXPLIN <- expect_s4_class( - object = suppressWarnings( - plot_GrowthCurve(LxTxData,mode = "alternate", fit.method = "EXP+LIN", output.plot = FALSE, verbose = FALSE)), - "RLum.Results") - - ## GOK - expect_s4_class( - object = plot_GrowthCurve( - LxTxData, - mode = "alternate", - fit.method = "GOK", - output.plot = FALSE, - verbose = FALSE - ), - "RLum.Results" - ) - - ## LambertW - expect_s4_class( - object = plot_GrowthCurve( - LxTxData, - mode = "alternate", - fit.method = "LambertW", - output.plot = FALSE, - verbose = FALSE - ), - "RLum.Results" - ) - - ## trigger LambertW related warning for - ## extrapolation mode - tmp <- structure(list( - dose = c( - 0, - 1388.88888888889, - 2777.77777777778, - 4166.66666666667, - 8333.33333333333, - 16666.6666666667, - 33333.3333333333, - 0, - 1388.88888888889, - 2777.77777777778, - 4166.66666666667, - 8333.33333333333, - 16666.6666666667, - 33333.3333333333, - 0, - 1388.88888888889, - 2777.77777777778, - 4166.66666666667, - 8333.33333333333, - 16666.6666666667, - 33333.3333333333 - ), - LxTx = c( - 1.54252220145258, - 4.43951568403849, - 6.23268064543138, - 7.84372723139206, - 12.1816246695694, - 16.220421545207, - 19.9805214420208, - 1.5693958789807, - 4.01446969642433, - 6.50442121919275, - 8.13912565845306, - 11.2791435536017, - 14.2739718127927, - 17.7646886436743, - 1.55083317135234, - 4.10327222363961, - 6.1705969614814, - 8.30005789933367, - 12.7612004529065, - 14.807776070804, - 17.1563663039162 - ), - LxTx_X = c( - 0.130074482379272, - 2.59694106608334, - 4.46970034588506, - 3.0630786645803, - 0.744512263874143, - 6.0383153231303, - 0.785060450424326, - 3.16210365279, - 0.0425273193228004, - 2.9667194222907, - 0.187174353876429, - 4.29989597009486, - 4.19802308979151, - 2.77791088935002, - 0.248412040945932, - 0.626745230335262, - 3.80396486752602, - 16.1846310553925, - 4.14921514089229, - 1.40190110413806, - 7.74406545663656 - ) - ), - class = "data.frame", - row.names = c(NA, -21L)) - - expect_warning(plot_GrowthCurve( - tmp, - mode = "extrapolation", - fit.method = "LambertW", - output.plot = FALSE, - verbose = FALSE), - regexp = "\\[plot\\_GrowthCurve\\(\\)\\] Standard root estimation using stats\\:\\:uniroot\\(\\).+") - - ## only two valid points provided: this generates two warnings, hence - ## we cannot use expect_warning(), which can only capture one at a time - SW({ - warnings <- capture_warnings(expect_message(plot_GrowthCurve( - data.frame( - dose = c(0, 1388.88888888889, NA), - LxTx = c(1.54252220145258, 4.43951568403849, NA), - LxTx_X = c(0.130074482379272, 2.59694106608, NA)), - output.plot = FALSE, - verbose = TRUE), - "fit.method set to 'LIN'")) - }) - expect_match(warnings, "1 NA values removed", - all = FALSE, fixed = TRUE) - expect_match(warnings, "Fitting using an exponential term requires", - all = FALSE, fixed = TRUE) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_Histogram.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_Histogram.R deleted file mode 100644 index 5ec86facc..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_Histogram.R +++ /dev/null @@ -1,49 +0,0 @@ -data(ExampleData.DeValues, envir = environment()) -df <- ExampleData.DeValues$CA1 - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(plot_Histogram("error"), - "Input data format is neither 'data.frame' nor 'RLum.Results'") - expect_error(plot_Histogram(df, ylim = c(0, 1)), - "'ylim' must be a vector of length 4") -}) - -test_that("check functionality", { - testthat::skip_on_cran() - - expect_silent(plot_Histogram(df)) - expect_silent(plot_Histogram(df, normal_curve = TRUE)) - - ## more coverage - expect_silent(plot_Histogram(df, main = "Title", xlab = "x", ylab = "y", - xlim = c(0, 120), ylim = c(0, 0.1, 0, 0.1), - pch = 1, breaks = "Sturges", - normal_curve = TRUE, - summary.pos = c(20, 0.017), - summary = c("n", "mean", "mean.weighted", - "median", "sdrel"))) - expect_silent(plot_Histogram(df, summary.pos = "topleft")) - expect_silent(plot_Histogram(df, summary.pos = "top")) - expect_silent(plot_Histogram(df, summary.pos = "topright")) - expect_silent(plot_Histogram(df, summary.pos = "left")) - expect_silent(plot_Histogram(df, summary.pos = "center")) - expect_silent(plot_Histogram(df, summary.pos = "right")) - expect_silent(plot_Histogram(df, summary.pos = "bottomleft")) - expect_silent(plot_Histogram(df, summary.pos = "bottom")) - expect_silent(plot_Histogram(df, summary.pos = "bottomright")) - - ## interactive - expect_silent(plot_Histogram(df, interactive = TRUE, - normal_curve = TRUE, se = TRUE)) - - ## missing values - df.na <- df - df.na[10, 1] <- NA - expect_output(plot_Histogram(df.na), - "1 NA value excluded") - df.na[20, 1] <- NA - expect_output(plot_Histogram(df.na), - "2 NA values excluded") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_KDE.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_KDE.R deleted file mode 100644 index 620d1d018..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_KDE.R +++ /dev/null @@ -1,81 +0,0 @@ -data(ExampleData.DeValues, envir = environment()) -df <- Second2Gray(ExampleData.DeValues$BT998, c(0.0438,0.0019)) - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(plot_KDE("error"), - "Input data must be one of 'data.frame', 'RLum.Results' or") - expect_error(plot_KDE(df[0, ]), - "Input data 1 has 0 rows") - expect_error(plot_KDE(list()), - "'data' is an empty list") - expect_error(expect_warning(plot_KDE(data.frame(a = Inf, b = 1)), - "Inf values removed in rows: 1 in data.frame 1"), - "Your input is empty due to Inf removal") - expect_error(plot_KDE(df, ylim = c(0, 1)), - "'ylim' must be a vector of length 4") - - expect_warning(plot_KDE(df[1, ]), - "Single data point found, no density calculated") - - ## deprecated arguments - expect_warning(plot_KDE(df, centrality = TRUE), - "Argument 'centrality' no longer supported") - expect_warning(plot_KDE(df, dispersion = TRUE), - "Argument 'dispersion' no longer supported") - expect_warning(plot_KDE(df, polygon.col = TRUE), - "Argument 'polygon.col' no longer supported") - expect_warning(plot_KDE(df, weights = TRUE), - "Argument 'weights' no longer supported") -}) - -test_that("check functionality", { - testthat::skip_on_cran() - - ## create plot straightforward - expect_silent(plot_KDE(data = df)) - - ## more coverage - expect_silent(plot_KDE(data = df, summary = "n", summary.pos = c(105, 0.07), - main = "Title", mtext = "Subtitle", - xlab = "x", ylab = "y", layout = "default", log = "x", - xlim = c(100, 180), ylim = c(0, 0.07, 0, 0.01), - col = 2, lty = 2, lwd = 2, cex = 1)) - expect_silent(plot_KDE(data = df, summary.pos = "topleft")) - expect_silent(plot_KDE(data = df, summary.pos = "top")) - expect_silent(plot_KDE(data = df, summary.pos = "topright")) - expect_silent(plot_KDE(data = df, summary.pos = "left")) - expect_silent(plot_KDE(data = df, summary.pos = "center")) - expect_silent(plot_KDE(data = df, summary.pos = "right")) - expect_silent(plot_KDE(data = df, summary.pos = "bottomleft")) - expect_silent(plot_KDE(data = df, summary.pos = "bottom")) - expect_silent(plot_KDE(data = df, summary.pos = "bottomright")) - - ## numeric vector - expect_silent(plot_KDE(df[, 1])) - - ## single-column data.frame - expect_silent(plot_KDE(df[, 1, drop = FALSE])) - - ## RLum.Results object - expect_silent(plot_KDE(calc_CommonDose(df, plot = FALSE, verbose = FALSE))) - - ## infinite values - df.inf <- df - df.inf[9, 1] <- Inf - expect_warning(plot_KDE(df.inf), - "Inf values removed in rows: 9 in data.frame 1") - df.inf[2, 2] <- Inf - expect_warning(plot_KDE(df.inf), - "Inf values removed in rows: 2, 9 in data.frame 1") - - ## missing values - df.na <- df - df.na[2, 1] <- NA - expect_message(plot_KDE(df.na), - "1 NA value excluded from data set 1") - df.na[3, 1] <- NA - expect_message(plot_KDE(df.na), - "2 NA values excluded from data set 1") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_NRt.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_NRt.R deleted file mode 100644 index 24d7ccea5..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_NRt.R +++ /dev/null @@ -1,43 +0,0 @@ -data("ExampleData.BINfileData", envir = environment()) -obj <- Risoe.BINfileData2RLum.Analysis(object = CWOSL.SAR.Data, - pos = 8, ltype = "OSL") -curves <- get_RLum(obj)[seq(1, 9, 2)] - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(plot_NRt("error"), - "'data' is expected to be a list, matrix, data.frame or") - expect_error(plot_NRt(obj[[2]]), - "'data' is expected to be a list, matrix, data.frame or") - expect_error(plot_NRt(curves[1]), - "The provided list only contains curve data of the natural signal") - expect_error(plot_NRt(curves[[1]]@data), - "The provided matrix only contains curve data of the natural signal") - - data(ExampleData.XSYG, envir = environment()) - obj.mixed <- merge_RLum.Analysis(list(obj, TL.Spectrum)) - expect_error(plot_NRt(obj.mixed), - "The provided 'RLum.Analysis' object must exclusively contain") - - data("ExampleData.RLum.Analysis", envir = environment()) - expect_error(plot_NRt(IRSAR.RF.Data), - "The time values for the natural signal don't match those for") - expect_error(plot_NRt(merge_RLum.Analysis(list(obj, IRSAR.RF.Data))), - "The time values for the natural signal don't match those for") -}) - -test_that("check", { - testthat::skip_on_cran() - - ## list - expect_silent(plot_NRt(curves)) - expect_silent(plot_NRt(curves, smooth = "spline", log = "x")) - expect_silent(plot_NRt(curves, smooth = "rmean", k = 10)) - - ## matrix - plot_NRt(cbind(curves[[1]]@data, curves[[1]]@data)) - - ## RLum.Analysis - expect_silent(plot_NRt(obj)) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_OSLAgeSummary.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_OSLAgeSummary.R deleted file mode 100644 index 2ce0dd2b1..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_OSLAgeSummary.R +++ /dev/null @@ -1,38 +0,0 @@ -test_that("Basic test", { - testthat::skip_on_cran() - - ##cause error - expect_error(plot_OSLAgeSummary("error"), - "\\[plot_OSLAgeSummary\\(\\)\\] class character not supported as input for object!") - - ##simple run with example data - set.seed(1234) - object <- rnorm(1000, 100, 10) - - ##run as numeric - SW({ - results <- expect_s4_class(plot_OSLAgeSummary(object), "RLum.Results") - }) - - ##run from S4-class - object1 <- set_RLum("RLum.Results", - data = list(A = object), originator = ".calc_BayesianCentralAgeModel") - object2 <- set_RLum("RLum.Results", - data = list(A = object), originator = ".calc_IndividualAgeModel") - - SW({ - expect_s4_class(plot_OSLAgeSummary(object1), "RLum.Results") - expect_s4_class(plot_OSLAgeSummary(object2), "RLum.Results") - }) - - ##run with no output - expect_silent(plot_OSLAgeSummary(object, verbose = FALSE)) - - ##run with rug option - expect_silent(plot_OSLAgeSummary(object, verbose = FALSE, rug = TRUE)) - - ##check the results - expect_length(results, 3) - - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_RLum.Analysis.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_RLum.Analysis.R deleted file mode 100644 index c5088c7e2..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_RLum.Analysis.R +++ /dev/null @@ -1,128 +0,0 @@ -data(ExampleData.BINfileData, envir = environment()) -data(ExampleData.XSYG, envir = environment()) - -## convert values for position 1 -temp <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = 1) - -## only one curve -c1 <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = 1, - run = 1, set = 6) - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(plot_RLum.Analysis("error"), - "Input object is not of type 'RLum.Analysis'") - - expect_error(plot_RLum.Analysis(temp, nrows = -1), - "'nrows' must be a positive scalar") - expect_error(plot_RLum.Analysis(temp, ncols = -1), - "'ncols' must be a positive scalar") - - expect_error(plot_RLum.Analysis( - set_RLum("RLum.Analysis", records = list(c1@records[[1]], - set_RLum("RLum.Data.Image"))), - combine = TRUE), - "Only 'RLum.Data.Curve' objects are allowed") - - ## this generates multiple warnings - warnings <- capture_warnings(plot_RLum.Analysis(c1, col = 2, - xlim = c(-1, 50), - ylim = c(-1, 3000))) - expect_match(warnings, all = FALSE, fixed = TRUE, - "min('xlim') < x-value range for curve #1, reset to minimum") - expect_match(warnings, all = FALSE, fixed = TRUE, - "max('xlim') > x-value range for curve #1, reset to maximum") - expect_match(warnings, all = FALSE, fixed = TRUE, - "min('ylim') < y-value range for curve #1, reset to minimum") - expect_match(warnings, all = FALSE, fixed = TRUE, - "max('ylim') > y-value range for curve #1, reset to maximum") - - expect_warning(plot_RLum.Analysis(c1, curve.transformation = "error"), - "Function for 'curve.transformation' is unknown") - expect_warning(.warningCatcher( - plot_RLum.Analysis(temp, subset = list(recordType = "TL"), - norm = TRUE, log = "y")), - "12 y values <= 0 omitted from logarithmic plot") - - expect_warning(plot_RLum.Analysis(c1, combine = TRUE, main = "Curve"), - "Nothing to combine, object contains a single curve") -}) - -test_that("Test the basic plot functionality", { - testthat::skip_on_cran() - - ## trigger warning - expect_silent(expect_warning(plot_RLum.Analysis( - set_RLum("RLum.Analysis", records = list( - c1@records[[1]], - set_RLum("RLum.Data.Curve", recordType = "OSL") - )), norm = TRUE, combine = TRUE), - "[plot_RLum.Analysis()] Normalisation led to Inf or NaN values, values replaced by 0", - fixed = TRUE)) - - ##Basic plot - expect_silent(plot_RLum.Analysis( - temp, - subset = list(recordType = "TL"), - combine = TRUE, - norm = TRUE, - abline = list(v = c(110)) - )) - - ## Basic plot with spectrum - expect_silent( - plot_RLum.Analysis( - set_RLum(class = "RLum.Analysis", records = list(TL.Spectrum, temp[[1]])), - plot.type = "persp")) - - ## test norm = "max" - expect_silent(plot_RLum.Analysis( - temp, - subset = list(recordType = "TL"), - combine = TRUE, - norm = "max", - abline = list(v = c(110)) - )) - - ## test norm = "min" - expect_silent(plot_RLum.Analysis( - temp, - subset = list(recordType = "OSL"), - combine = TRUE, - norm = "last", - abline = list(v = c(110)) - )) - - ## test norm = "huot - expect_silent(plot_RLum.Analysis( - temp, - subset = list(recordType = "OSL"), - combine = TRUE, - norm = "huot", - abline = list(v = c(110)) - )) - - ## test records_max - expect_silent(plot_RLum.Analysis( - temp, - subset = list(recordType = "TL"), - combine = TRUE, - norm = TRUE, - sub_title = "(5 K/s)", - records_max = 5, - abline = list(v = c(110)) - )) - - ##test arguments - ##ylim - expect_silent(plot_RLum.Analysis( - temp, - subset = list(recordType = "TL"), - combine = FALSE, - norm = TRUE, - ylim = c(1,100), - xlim = c(1,100), - abline = list(v = c(110)) - )) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_RLum.Data.Curve.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_RLum.Data.Curve.R deleted file mode 100644 index 4897032a0..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_RLum.Data.Curve.R +++ /dev/null @@ -1,35 +0,0 @@ -test_that("Test the basic plot functionality", { - testthat::skip_on_cran() - - ## create dataset - #load Example data - data(ExampleData.CW_OSL_Curve, envir = environment()) - temp <- as(ExampleData.CW_OSL_Curve, "RLum.Data.Curve") - temp_NA <- temp - temp_NA@data[] <- suppressWarnings(NA_real_) - - ## break function - expect_error(plot_RLum.Data.Curve("temp"), regexp = "Input object is not of type RLum.Data.Curve") - - ## trigger warning - expect_warning(expect_null(plot_RLum.Data.Curve(temp_NA)), - "Curve contains only NA-values, nothing plotted") - expect_warning(plot_RLum.Data.Curve(set_RLum("RLum.Data.Curve"), norm = TRUE), "Normalisation led to Inf or NaN values. Values replaced by 0") - - ## run function with various conditions - expect_silent(plot_RLum.Data.Curve(temp)) - expect_silent(plot_RLum.Data.Curve(temp, norm = TRUE)) - expect_silent(plot_RLum.Data.Curve(temp, norm = "max")) - expect_silent(plot_RLum.Data.Curve(temp, norm = "min")) - expect_silent(plot_RLum.Data.Curve(temp, norm = "last")) - expect_silent(plot_RLum.Data.Curve(temp, norm = "huot")) - expect_silent(plot_RLum.Data.Curve(temp, smooth = TRUE)) - expect_silent(plot_RLum.Data.Curve(temp, par.local = FALSE)) - - temp@recordType <- "OSL" - temp@info <- list(interval = 1) - expect_silent(plot_RLum.Data.Curve(temp)) - temp@recordType <- "TL" - temp@info <- list(curveDescripter = "xlab;ylab", RATE = 2) - expect_silent(plot_RLum.Data.Curve(temp)) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_RLum.Data.Image.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_RLum.Data.Image.R deleted file mode 100644 index 85f18af39..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_RLum.Data.Image.R +++ /dev/null @@ -1,31 +0,0 @@ -test_that("Test image plotting", { - testthat::skip_on_cran() - - ## create dataset to test - image <- as(array(rnorm(1000), dim = c(10,10,10)), "RLum.Data.Image") - - ## crash function ---- - ### wrong input ----- - expect_error(plot_RLum.Data.Image("image"), - "\\[plot_RLum.Data.Image\\(\\)\\] Input object is not of type RLum.Data.Image.") - expect_error(plot_RLum.Data.Image(image, plot.type = "error"), - "\\[plot_RLum.Data.Image\\(\\)\\] Unknown plot type.") - - - ## plot.raster --- - expect_silent(plot_RLum.Data.Image(image, plot.type = "plot.raster")) - expect_silent(plot_RLum.Data.Image(image, plot.type = "plot.raster", - stretch = NULL)) - expect_silent(plot_RLum.Data.Image(image, plot.type = "plot.raster", - stretch = "lin")) - expect_silent(plot_RLum.Data.Image(image, plot.type = "plot.raster", - frames = c(2, 4))) - - ## check global z-scale - expect_silent(plot_RLum.Data.Image(image, plot.type = "plot.raster", - stretch = NULL, zlim_image = c(0,1))) - - ## contour --- - expect_silent(plot_RLum.Data.Image(image, plot.type = "contour", - stretch = NULL)) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_RLum.Data.Spectrum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_RLum.Data.Spectrum.R deleted file mode 100644 index 6c2399542..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_RLum.Data.Spectrum.R +++ /dev/null @@ -1,273 +0,0 @@ -data(ExampleData.XSYG, envir = environment()) - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(plot_RLum.Data.Spectrum("error"), - "'object' must be of type 'RLum.Data.Spectrum' or 'matrix'") - expect_error(plot_RLum.Data.Spectrum(TL.Spectrum, plot.type = "error"), - "Unknown plot type") - expect_error(plot_RLum.Data.Spectrum(TL.Spectrum, bg.spectrum = "error"), - "Input for 'bg.spectrum' not supported") - expect_error(plot_RLum.Data.Spectrum(TL.Spectrum, bin.cols = 0), - "'bin.cols' and 'bin.rows' have to be > 1") - - expect_warning(plot_RLum.Data.Spectrum(TL.Spectrum, bg.channels = -2), - "'bg.channels' out of range") -}) - -test_that("check functionality", { - testthat::skip_on_cran() - - ##RLum.Data.Spectrum ------- - m <- TL.Spectrum@data - bg.spectrum <- set_RLum(class = "RLum.Data.Spectrum", data = TL.Spectrum@data[,15:16, drop = FALSE]) - - - ##try a matrix as input - expect_message(plot_RLum.Data.Spectrum(object = m), - regexp = "Input has been converted to a RLum.Data.Spectrum object using set_RLum()") - - ##remove rownames and column names - rownames(m) <- NULL - colnames(m) <- NULL - expect_message(plot_RLum.Data.Spectrum(object = m), - regexp = "Input has been converted to a RLum.Data.Spectrum object using set_RLum()") - - ## test duplicated column names - t <- TL.Spectrum - colnames(t@data) <- rep(50, ncol(t@data)) - expect_warning(plot_RLum.Data.Spectrum(t), - "Duplicated column names found") - - ##standard plot with some settings - expect_silent(plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type = "contour", - main = "Test", - xlab = "test", - ylab = "test", - mtext = "test", - cex = 1.2, - pch = 2, - lwd = 2, - bty = "n", - sub = "est" - )) - - ##no plot - expect_type(plot( - TL.Spectrum, - plot.type = "contour", - main = "Test", - xlab = "test", - ylab = "test", - mtext = "test", - cex = 1.2, - pch = 2, - lwd = 2, - bty = "n", - plot = FALSE, - ), "double") - - ##persp plot - expect_silent(suppressWarnings( - plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type = "persp", - xlim = c(310, 750), - ylim = c(0, 100), - bin.rows = 10, - bin.cols = 2, - zlab = "test") - )) - - ##test background subtraction - expect_warning(plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type = "persp", - xlim = c(310, 750), - ylim = c(0, 300), - bg.spectrum = bg.spectrum, - bin.rows = 10, - bin.cols = 1 - ), "6 channels removed due to row \\(wavelength\\) binning") - - ## check output and limit counts - expect_type(suppressWarnings(plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type = "persp", - xlim = c(310, 750), - limit_counts = 10000, - bg.spectrum = bg.spectrum, - bin.rows = 10, - bin.cols = 1 - )), "double") - - ## check our axes - expect_type(suppressWarnings(plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type = "persp", - xlim = c(310, 750), - limit_counts = 10000, - bg.spectrum = bg.spectrum, - bin.rows = 10, - box = "alternate", - bin.cols = 1 - )), "double") - - ##test energy axis - expect_silent(plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type = "multiple.lines", - xlim = c(1.4, 4), - ylim = c(0, 300), - bg.spectrum = bg.spectrum, - bg.channels = 2, - bin.cols = 1, - xaxis.energy = TRUE - )) - - ## plot: multiple.lines --------- - expect_silent(suppressWarnings( - plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type = "multiple.lines", - xlim = c(310, 750), - ylim = c(0, 100), - bin.rows = 10, - bin.cols = 1 - ) - )) - - expect_silent(suppressWarnings( - plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type = "multiple.lines", - xlim = c(310, 750), - frames = c(1,3), - ylim = c(0, 100), - bin.rows = 10, - bin.cols = 1 - ) - )) - - ## plot: image ------------ - ### plot_image: standard ------- - expect_silent(suppressWarnings( - plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type = "image", - xlim = c(310, 750), - ylim = c(0, 300), - bin.rows = 10, - bin.cols = 1 - ) - )) - - ### plot_image: no contour ------- - expect_silent(suppressWarnings( - plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type = "image", - xlim = c(310, 750), - ylim = c(0, 300), - bin.rows = 10, - bin.cols = 1, - contour = FALSE - ))) - - ## plot: transect ------------ - expect_silent(suppressWarnings( - plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type = "transect", - xlim = c(310, 750), - ylim = c(0, 300), - bin.rows = 10, - bin.cols = 1, - contour = FALSE))) - - ## plot: single ------------ - expect_silent(suppressWarnings( - plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type = "single", - xlim = c(310, 750), - ylim = c(0, 300), - bin.rows = 10, - bin.cols = 6, - contour = FALSE))) - - ## test frames - expect_silent(suppressWarnings( - plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type = "single", - xlim = c(310, 750), - frames = 1, - ylim = c(0, 300), - bin.rows = 10, - bin.cols = 6, - contour = FALSE))) - - ### plot_image: colour changes ------- - expect_silent(suppressWarnings( - plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type = "image", - xlim = c(310, 750), - ylim = c(0, 300), - bin.rows = 10, - bin.cols = 1, - col = grDevices::hcl.colors(20), - contour.col = "yellow" - ) - )) - - ## plot: interactive ------------ - expect_silent(suppressWarnings( - plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type = "interactive", - xlim = c(310, 750), - ylim = c(0, 300), - bin.rows = 10, - bin.cols = 1 - ) - )) - - ## plot: interactive heatmap -------- - expect_silent(suppressWarnings( - plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type = "interactive", - xlim = c(310, 750), - ylim = c(0, 300), - bin.rows = 10, - bin.cols = 1, - type = "heatmap", - showscale = TRUE - ) - )) - - ##interactive contour - expect_silent(suppressWarnings( - plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type = "interactive", - xlim = c(310, 750), - ylim = c(0, 300), - bin.rows = 10, - bin.cols = 1, - type = "contour", - showscale = TRUE - ) - )) - - ## more coverage - plot_RLum.Data.Spectrum(TL.Spectrum, plot.type = "multiple.lines", - phi = 15, theta = -30, r = 10, log = "xyz", - shade = 0.4, expand = 0.5, border = 1, - axes = FALSE, norm = "min", col = 2) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_RLum.R deleted file mode 100644 index 04cdef94c..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_RLum.R +++ /dev/null @@ -1,39 +0,0 @@ -test_that("test_plot_RLum", { - testthat::skip_on_cran() - - ## create dataset to test - image <- as(array(rnorm(1000), dim = c(10,10,10)), "RLum.Data.Image") - expect_silent(plot_RLum(image)) - - ## check list with different dispatched arguments - image_short <- as(array(rnorm(100), dim = c(10, 10, 1)), "RLum.Data.Image") - expect_silent(plot_RLum(list(image_short, image_short), main = list("test1", "test2"), mtext = "test")) - - ## trigger error - expect_error(plot_RLum("error"), "\\[plot_RLum\\(\\)\\] Sorry, I don't know what to do for object of type 'character'.") - - ## test list of RLum.Analysis - l <- list(set_RLum( - class = "RLum.Analysis", - records = list( - set_RLum("RLum.Data.Curve", data = matrix(1:10, ncol = 2)), - set_RLum("RLum.Data.Curve", data = matrix(1:20, ncol = 2))))) - - expect_silent(plot_RLum(l, main = list("test", "test2"), mtext = "test")) - - ## plot results objects - data(ExampleData.BINfileData, envir = environment()) - object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1:3) - results <- analyse_SAR.CWOSL( - object = object, - signal.integral.min = 1, - signal.integral.max = 2, - plot = FALSE, - verbose = FALSE, - background.integral.min = 900, - background.integral.max = 1000, - fit.method = "LIN") - expect_null(plot_RLum.Results(results)) - - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_RLum.Results.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_RLum.Results.R deleted file mode 100644 index 25242bacc..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_RLum.Results.R +++ /dev/null @@ -1,58 +0,0 @@ -data(ExampleData.DeValues, envir = environment()) - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(plot_RLum.Results("error"), - "Input object is not of type 'RLum.Results'") -}) - -test_that("check functionality", { - testthat::skip_on_cran() - - ## calc_MinDose - d1 <- calc_MinDose(ExampleData.DeValues$CA1, sigmab = 0.1, - bootstrap = TRUE, bs.M = 10, bs.N = 10, - plot = FALSE, verbose = FALSE) - expect_silent(plot_RLum.Results(d1, main = "Title")) - expect_silent(plot_RLum.Results(d1, single = FALSE, log = "", lty = 1, - type = "l", col = 2)) - - ## calc_CentralDose - d2 <-calc_CentralDose(ExampleData.DeValues$CA1, - plot = FALSE, verbose = FALSE) - expect_silent(plot_RLum.Results(d2)) - - ## calc_FuchsLang2001 - d3 <- calc_FuchsLang2001(ExampleData.DeValues$BT998, cvThreshold = 5, - plot = FALSE, verbose = FALSE) - expect_silent(plot_RLum.Results(d3)) - expect_silent(plot_RLum.Results(d3, main = "Title", sub = "Subtitle", - xlab = "x", xlim = c(2500, 4000), - ylab = "y", ylim = c(0, 25), mtext = "", - cex = 1, lwd = 1, pch = 1)) - - ## calc_FiniteMixture - d4 <- calc_FiniteMixture(ExampleData.DeValues$CA1, sigmab = 0.2, - n.components = c(2:4), - dose.scale = c(0, 100), - plot = FALSE, verbose = FALSE) - expect_silent(plot_RLum.Results(d4, pdf.colors = "colors")) - expect_silent(plot_RLum.Results(d4, main = "Title", plot.proportions = FALSE, - pdf.weight = FALSE, pdf.sigma = "sigmab")) - - ## calc_AliquotSize - d5 <- calc_AliquotSize(grain.size = c(100, 150), sample.diameter = 1, - MC.iter = 100, plot = FALSE, verbose = FALSE) - expect_silent(plot_RLum.Results(d5)) - - ## calc_SourceDoseRate - d6 <- calc_SourceDoseRate(measurement = "2012-01-27", calib = "2014-12-19", - calib.dose.rate = 0.0438, calib.error = 0.0019) - expect_silent(plot_RLum.Results(d6)) - - ## calc_FastRatio - data(ExampleData.CW_OSL_Curve, envir = environment()) - d7 <- calc_FastRatio(ExampleData.CW_OSL_Curve, plot = FALSE, verbose = FALSE) - expect_silent(plot_RLum.Results(d7)) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_ROI.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_ROI.R deleted file mode 100644 index 680a2aedf..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_ROI.R +++ /dev/null @@ -1,36 +0,0 @@ -test_that("Complete test", { - testthat::skip_on_cran() - - ##create suitable dataset - file <- system.file("extdata", "RF_file.rf", package = "Luminescence") - temp <- read_RF2R(file) - - ##crash function - expect_error(plot_ROI(object = "stop"), - regexp = "\\[plot\\_ROI\\(\\)\\] Input for 'object' not supported, please check documentation!") - - ##test standard cases - expect_silent(plot_ROI(temp)) - expect_silent(plot_ROI(temp, grid = TRUE)) - expect_silent(plot_ROI(temp, dim.CCD = c(8192,8192))) - expect_silent(plot_ROI(temp, dist_thre = 20)) - expect_silent(plot_ROI(temp, exclude_ROI = NULL)) - - ##test non-list case - expect_silent(plot_ROI(temp[[1]])) - expect_silent(plot_ROI(temp[[1]], exclude_ROI = NULL)) - - ##output only case - expect_s4_class(plot_ROI(temp, plot = FALSE), class = "RLum.Results") - - ## test combination with extract_ROI() - m <- matrix(runif(100,0,255), ncol = 10, nrow = 10) - roi <- matrix(c(2.,4,2,5,6,7,3,1,1), ncol = 3) - t <- extract_ROI(object = m, roi = roi) - expect_s4_class(plot_ROI(t, bg_image = m, exclude_ROI = NULL), "RLum.Results") - - ## trigger warning - expect_warning(plot_ROI(t, bg_image = "stop", exclude_ROI = NULL), - "\\[plot\\_ROI\\(\\)] 'bg\\_image' is not of type RLum.Data.Image and cannot be converted into such; background image plot skipped!") - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_RadialPlot.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_RadialPlot.R deleted file mode 100644 index 365167bdb..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_RadialPlot.R +++ /dev/null @@ -1,143 +0,0 @@ -data(ExampleData.DeValues, envir = environment()) - -set.seed(12310) -x <- rnorm(30, 5, 0.5) -y <- x * runif(30, 0.05, 0.10) -df <- data.frame(x, y) - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(plot_RadialPlot("error"), - "Input data must be 'data.frame' or 'RLum.Results'") - expect_error(plot_RadialPlot(list()), - "'data' is an empty list") - expect_error(plot_RadialPlot(df[, 1]), - "Input data must be 'data.frame' or 'RLum.Results'") - expect_error(plot_RadialPlot(df[0, ]), - "Input data 1 has 0 rows") - expect_error(plot_RadialPlot(df, xlab = "x"), - "'xlab' must have length 2") - expect_error(plot_RadialPlot(df, centrality = "error"), - "Measure of centrality not supported") - - expect_warning(plot_RadialPlot(df, xlim = c(-1, 100), show = FALSE), - "Lower x-axis limit not set to zero, corrected") - expect_warning(plot_RadialPlot(ExampleData.DeValues, log.z = FALSE, - xlim = c(0, 5), zlim = c(100, 200), - show = FALSE), - "Option 'log.z' is not set to 'TRUE' altough more than one") -}) - -test_that("dedicated test for the radialplot", { - testthat::skip_on_cran() - - ##distribution plots - - ## standard data - ## simple test - expect_silent( - plot_RadialPlot( - data = df, - centrality = 5)) - - ## standard data with two datasets - ## simple test - expect_silent( - plot_RadialPlot( - data = list(df, df), - centrality = c(5,5))) - - ## simple test - unlogged - expect_silent( - plot_RadialPlot( - data = df, - centrality = 5, - log.z = FALSE)) - - ## simple test - unlogged with statistics - expect_silent( - plot_RadialPlot( - data = df, - summary = c( - "n", "mean", "median", "mean.weighted", "median.weighted", "kdemax", "sdabs", - "sdrel", "seabs", "serel", "skewness", "kurtosis", "in.2s", "sdabs.weighted", - "sdrel.weighted", "seabs.weighted", "serel.weighted"), - log.z = FALSE)) - - ## simple test - unlogged - expect_silent( - plot_RadialPlot( - data = df, - centrality = -1, - log.z = FALSE)) - - ## single-column data frame - expect_message(plot_RadialPlot(df[, 1, drop = FALSE]), - "Attention, small standardised estimate scatter") - - ## data frame with more than 2 columns - expect_silent(plot_RadialPlot(cbind(df, df))) - - ## data frame with negative values - df.neg <- df - df.neg[, 1] <- df.neg[, 1] - 5 - plot_RadialPlot(df.neg) - - ## more coverage - expect_type(plot_RadialPlot(df, main = "Title", sub = "Subtitle", rug = TRUE, - centrality = "mean", log.z = TRUE, - stats = c("min", "max", "median"), - summary = "mean", summary.pos = c(0, 40), - legend = TRUE, legend.pos = c(4, 40), - xlab = c("x1", "x2"), xlim = c(0, 20), - ylab = "y", ylim = c(-10, 10), - zlab = "z", zlim = c(3, 7), - line = c(3.5, 5.5), y.ticks = FALSE, - cex = 0.8, lty = 2, lwd = 2, pch = 2, col = 2, - tck = 1, tcl = 2, output = TRUE), - "list") - - plot_RadialPlot(df, show = FALSE, centrality = c(1, 2, 3)) - plot_RadialPlot(df, show = FALSE, centrality = "median", - summary.pos = "topleft", legend.pos = "topright", - log.z = FALSE, rug = TRUE) - plot_RadialPlot(df, show = FALSE, centrality = "median.weighted", - summary.pos = "top", legend.pos = "bottom") - plot_RadialPlot(df, show = FALSE, - summary.pos = "topright", legend.pos = "topleft") - plot_RadialPlot(df, show = FALSE, - summary.pos = "left", legend.pos = "right") - plot_RadialPlot(df, show = FALSE, - summary.pos = "center", legend.pos = "center") - plot_RadialPlot(df, show = FALSE, - summary.pos = "right", legend.pos = "left") - plot_RadialPlot(df, show = FALSE, - summary.pos = "bottomleft", legend.pos = "bottomright") - plot_RadialPlot(df, show = FALSE, - summary.pos = "bottom", legend.pos = "top") - plot_RadialPlot(df, show = FALSE, - summary.pos = "bottomright", legend.pos = "bottomleft") - - ## RLum.Results object - expect_silent(plot_RadialPlot(calc_CommonDose(ExampleData.DeValues$BT998, - verbose = FALSE))) - - # Messages, Warnings, and Errors ----------------------------------------- - ## trigger message - expect_message( - plot_RadialPlot( - data = data.frame(x = df$x, y = rep(0.0001, nrow(df))), - centrality = -1, - log.z = FALSE), - regexp = "Attention.*") - - ## trigger warning - expect_warning(plot_RadialPlot( - data = df, - #centrality = , - central.value = -1, - log.z = FALSE), - "\\[plot\\_RadialPlot\\(\\)\\] z-scale touches.*" - ) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_Risoe.BINfileData.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_Risoe.BINfileData.R deleted file mode 100644 index 0b178602a..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_Risoe.BINfileData.R +++ /dev/null @@ -1,38 +0,0 @@ -test_that("input validation", { - testthat::skip_on_cran() - - data(ExampleData.BINfileData, envir = environment()) - expect_error(plot_Risoe.BINfileData("error"), - "'object' is expected to be of type 'Risoe.BINfileData'") -}) - -test_that("general test", { - testthat::skip_on_cran() - - data(ExampleData.BINfileData, envir = environment()) - expect_silent(plot_Risoe.BINfileData(CWOSL.SAR.Data, position = 1)) - expect_silent(plot_Risoe.BINfileData(CWOSL.SAR.Data, position = 1, - sorter = "RUN")) - expect_silent(plot_Risoe.BINfileData(CWOSL.SAR.Data, position = 1, - sorter = "SET")) - - expect_silent(plot_Risoe.BINfileData(CWOSL.SAR.Data, position = 1, - curve.transformation = "CW2pLM")) - expect_silent(plot_Risoe.BINfileData(CWOSL.SAR.Data, position = 1, - curve.transformation = "CW2pLMi")) - - expect_warning(plot_Risoe.BINfileData(CWOSL.SAR.Data, position = 1, - curve.transformation = "CW2pHMi"), - "132 values have been found and replaced by the mean") - SW({ - expect_warning(plot_Risoe.BINfileData(CWOSL.SAR.Data, position = 1, - curve.transformation = "CW2pPMi"), - "t' is beyond the time resolution") - expect_warning(plot_Risoe.BINfileData(CWOSL.SAR.Data, position = 1, - curve.transformation = "error"), - "Unknown 'curve.transformation', no transformation performed") - }) - - expect_silent(plot_Risoe.BINfileData(CWOSL.SAR.Data, position = 1, - dose_rate = 3)) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_ViolinPlot.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_ViolinPlot.R deleted file mode 100644 index 380e6b54f..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_plot_ViolinPlot.R +++ /dev/null @@ -1,40 +0,0 @@ -data(ExampleData.DeValues, envir = environment()) -df <- ExampleData.DeValues$CA1 - -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(plot_ViolinPlot(), - "data input needed") - expect_error(plot_ViolinPlot(df, summary.pos = 5), - "'summary.pos' needs to be of type character") - - expect_warning(plot_ViolinPlot(df[0, ]), - "it is rather hard to plot 0 values, returning") - expect_warning(plot_ViolinPlot(df[1, ]), - "Single data point found, no density calculated") - expect_warning(plot_ViolinPlot(df, summary = "error"), - "Only keywords for weighted statistical measures are supported") - expect_warning(plot_ViolinPlot(df, summary.pos = "error"), - "Value provided for 'summary.pos' is not a valid keyword") -}) - -test_that("check functionality", { - testthat::skip_on_cran() - - ## data.frame - expect_silent(plot_ViolinPlot(df, summary.pos = "topleft")) - - ## matrix - expect_silent(plot_ViolinPlot(as.matrix(df))) - - ## RLum.Results object - expect_silent(plot_ViolinPlot(calc_CommonDose(df, plot = FALSE, - verbose = FALSE))) - - ## missing values - df.na <- df - df.na[10:11, 1] <- NA - expect_warning(plot_ViolinPlot(df.na), - "2 NA values removed") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_BIN2R.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_BIN2R.R deleted file mode 100644 index 9bd217f76..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_BIN2R.R +++ /dev/null @@ -1,163 +0,0 @@ -test_that("input validation", { - testthat::skip_on_cran() - - expect_error(read_BIN2R(file = "error"), - "File does not exist") - expect_message(expect_null(read_BIN2R(test_path("test_read_BIN2R.R"))), - "is not a file of type 'BIN' or 'BINX'") - expect_error(read_BIN2R(test_path("_data/BINfile_V3.bin"), verbose = FALSE, - forced.VersionNumber = 1), - "BIN/BINX format version (01) is not supported or file is broken", - fixed = TRUE) - SW({ - expect_warning(read_BIN2R(test_path("_data/BINfile_V3.bin"), position = 99), - "At least one position number is not valid") - expect_message(read_BIN2R(test_path("_data/BINfile_V3.bin"), - forced.VersionNumber = 3), - "'forced.VersionNumber' set to 03, but this version") - }) - - ## check for broken files - zero <- tempfile(pattern = "zero", fileext = ".binx") - file.create(zero) - expect_message(expect_null(read_BIN2R(zero, verbose = FALSE)), - "is a zero-byte file, NULL returned") - write(raw(), zero) - expect_error(read_BIN2R(zero, verbose = FALSE), - "BIN/BINX format version \\(..\\) is not supported or file is") - SW({ - expect_warning( - expect_message(expect_null(read_BIN2R(zero, verbose = TRUE, - forced.VersionNumber = 8)), - "Record #1 skipped due to wrong record length"), - "0 records read, NULL returned") - expect_warning( - expect_message(expect_null(read_BIN2R(zero, verbose = TRUE, - forced.VersionNumber = 3)), - "Record #1 skipped due to wrong record length"), - "0 records read, NULL returned") - }) - - fake <- tempfile(pattern = "fake", fileext = ".binx") - writeBin(as.raw(c( 8, 0, # version - 227, 5, 0, 0, # length - 0, 0, 0, 0, # previous - 250, 0, 0, 0, # npoints - 99) # rectype set to 99 to trigger errors - ), fake) - expect_error(read_BIN2R(fake, verbose = FALSE), - "Byte RECTYPE = 99 is not supported in record #1") - SW({ - expect_message(read_BIN2R(fake, verbose = TRUE, ignore.RECTYPE = TRUE), - "Byte RECTYPE = 99 is not supported in record #1") - }) -}) - -test_that("test the import of various BIN-file versions", { - testthat::skip_on_cran() - - ## this test needs an internet connection ... test for it - github.url <- file.path("https://github.com/R-Lum/Luminescence", - "raw/dev_0.9.x/tests/testthat/_data") - if (!httr::http_error(github.url)) { - ## V3 - expect_s4_class(read_BIN2R(file.path(github.url, "BINfile_V3.bin"), - verbose = FALSE), - class = "Risoe.BINfileData") - } - - ## V4 - expect_s4_class(read_BIN2R(test_path("_data/BINfile_V4.bin"), - verbose = FALSE), - class = "Risoe.BINfileData") - - ## V5 - expect_s4_class(read_BIN2R(test_path("_data/BINfile_V5.binx"), - verbose = FALSE), - class = "Risoe.BINfileData") - - ## V6 - expect_s4_class(read_BIN2R(test_path("_data/BINfile_V6.binx"), - verbose = FALSE), - class = "Risoe.BINfileData") - - ## V7 - expect_s4_class(read_BIN2R(test_path("_data/BINfile_V7.binx"), - verbose = FALSE), - class = "Risoe.BINfileData") - - SW({ - ## V8 - as part of the package - bin.v8 <- system.file("extdata/BINfile_V8.binx", package = "Luminescence") - expect_s4_class(read_BIN2R(bin.v8, txtProgressBar = FALSE), - class = "Risoe.BINfileData") - - ## V8 - as part of the package ... with arguments - expect_type(read_BIN2R(bin.v8, txtProgressBar = FALSE, - position = 1, fastForward = TRUE), - "list") - - ## test n.records argument - t_n.records_1 <- expect_s4_class( - read_BIN2R( - file = bin.v8, - txtProgressBar = FALSE, - n.records = 1), class = "Risoe.BINfileData") - t_n.records_0 <- expect_s4_class( - read_BIN2R( - file = bin.v8, - txtProgressBar = FALSE, - n.records = 0), class = "Risoe.BINfileData") - - t_n.records_1_2 <- expect_s4_class( - read_BIN2R( - file = bin.v8, - txtProgressBar = FALSE, - n.records = 1:2), class = "Risoe.BINfileData") - - ## test length - expect_length(t_n.records_1, n = 1) - expect_length(t_n.records_0, n = 1) - expect_length(t_n.records_1_2, n = 2) - - ## V8 - as part of the package ... with arguments - expect_type(read_BIN2R(bin.v8, txtProgressBar = FALSE, fastForward = TRUE), - "list") - - ## directory - res <- read_BIN2R(test_path("_data"), show_record_number = TRUE) - expect_type(res, "list") - expect_length(res, 5) - - ## test n.records - - ## test further options - ## n.records and fastForward - expect_type(read_BIN2R(test_path("_data/BINfile_V4.bin"), - txtProgressBar = FALSE, n.records = 1, - fastForward = TRUE, verbose = FALSE), - "list") - }) - - SW({ - ## check ignore RECTYPE settings - expect_message(t <- expect_s4_class(read_BIN2R(bin.v8, verbose = TRUE, - ignore.RECTYPE = 1), - class = "Risoe.BINfileData"), - "Record #1 skipped due to ignore.RECTYPE setting") - }) - - ## should be zero now - expect_length(t@DATA, n = 0) - - SW({ - ## this combination of position and n.records creates an empty object - ## at position 2 - res <- read_BIN2R(list(bin.v8, bin.v8), verbose = TRUE, - position = list(1, 2), n.records = list(1, 2), - show.raw.values = list(TRUE), zero_data.rm = list(FALSE), - duplicated.rm = list(TRUE), show.record.number = list(TRUE), - forced.VersionNumber = list(8), fastForward = TRUE) - }) - expect_length(res[[2]], 0) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_Daybreak2R.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_Daybreak2R.R deleted file mode 100644 index 0f4923287..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_Daybreak2R.R +++ /dev/null @@ -1,50 +0,0 @@ -test_that("Test functionality", { - testthat::skip_on_cran() - - txt.file <- system.file("extdata/Daybreak_TestFile.txt", - package = "Luminescence") - dat.file <- system.file("extdata/Daybreak_TestFile.DAT", - package = "Luminescence") - - ## TXT - SW({ - expect_type(read_Daybreak2R(txt.file), "list") - expect_type(read_Daybreak2R(txt.file, txtProgressBar = FALSE), - "list") - }) - expect_silent(read_Daybreak2R(txt.file, verbose = FALSE)) - - ## DAT - SW({ - expect_type(read_Daybreak2R(dat.file), "list") - expect_s3_class(read_Daybreak2R(dat.file, raw = TRUE), - "data.table") - }) - expect_silent(read_Daybreak2R(dat.file, verbose = FALSE)) - - ## list - SW({ - expect_type(read_Daybreak2R(list(dat.file)), "list") - }) - - ## directory - expect_error( - expect_output(read_Daybreak2R( - file = system.file("extdata", package = "Luminescence")), - "Directory detected, trying to extract"), - "file name does not seem to exist") - - ## test presence of non-ascii characters - expect_error(read_Daybreak2R( - file = system.file("extdata/BINfile_V8.binx", package = "Luminescence"), - verbose = FALSE), - "The provided file is no ASCII-file and cannot be imported") - - file.nonascii <- tempfile() - writeLines(gsub("ScriptFile", "ScriptFile ö", - readLines(system.file("extdata/Daybreak_TestFile.txt", - package = "Luminescence"))), - file.nonascii) - expect_error(read_Daybreak2R(file = file.nonascii, verbose = FALSE), - "The provided file is no ASCII-file and cannot be imported") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_HeliosOSL2R.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_HeliosOSL2R.R deleted file mode 100644 index 3066b8128..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_HeliosOSL2R.R +++ /dev/null @@ -1,31 +0,0 @@ -test_that("Test functionality", { - testthat::skip_on_cran() - - ## crash function - expect_error( - object = read_HeliosOSL2R("error"), - regexp = "\\[read\\_HeliosOSL2R\\(\\)\\] File extension") - expect_error( - object = read_HeliosOSL2R("error.err"), - regexp = "\\[read\\_HeliosOSL2R\\(\\)\\] File extension") - - ## standard input - file <- system.file("extdata/HeliosOSL_Example.osl", package = "Luminescence") - SW({ - expect_s4_class( - object = read_HeliosOSL2R(file), - class = "RLum.Analysis") - }) - - ## no verbose - expect_silent( - object = read_HeliosOSL2R(file, verbose = FALSE)) - - ## list input - files <- list(file, file) - SW({ - expect_type( - object = read_HeliosOSL2R(files), - type = "list") - }) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_PSL2R.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_PSL2R.R deleted file mode 100644 index 5d6c459e5..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_PSL2R.R +++ /dev/null @@ -1,39 +0,0 @@ -psl.file <- system.file("extdata/DorNie_0016.psl", package = "Luminescence") - -test_that("Test functionality", { - testthat::skip_on_cran() - - ## default values - expect_s4_class(read_PSL2R( - file = psl.file - ), "RLum.Analysis") - - ## custom values (all inverted), multiple files given to test merge=TRUE - expect_s4_class(read_PSL2R( - file = c(psl.file, psl.file), - drop_bg = TRUE, as_decay_curve = FALSE, smooth = TRUE, merge = TRUE - ), "RLum.Analysis") -}) - -test_that("Input validation", { - testthat::skip_on_cran() - - ## directory given (assumes that we have a .psl file under inst/extdata) - expect_message( - read_PSL2R(file = system.file("extdata", package = "Luminescence")), - "The following files were found and imported" - ) - - ## single file with no .psl extension - expect_error( - read_PSL2R(file = system.file("extdata/RF_file.rf", - package = "Luminescence")), - "No .psl files found" - ) - - ## list of files with a non-existent file - expect_error( - read_PSL2R(file = c(psl.file, "non-existent")), - "The following files do not exist" - ) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_RF2R.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_RF2R.R deleted file mode 100644 index 71609eccb..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_RF2R.R +++ /dev/null @@ -1,37 +0,0 @@ -test_that("Test functionality", { - testthat::skip_on_cran() - - ##load file path - file <- system.file("extdata", "RF_file.rf", package = "Luminescence") - - ##crash function - expect_error(read_RF2R("file"), regexp = "File 'file' does not exist!") - expect_error(read_RF2R(2), regexp = "'file' needs to be of type character!") - - ##simple import - expect_type(read_RF2R(file), type = "list") - - ##import list - expect_type(expect_message(read_RF2R(list(file, "test")), - "Error: Import for file 'test' failed"), - type = "list") - - ##import false list - expect_warning(read_RF2R(c(file, file)), regexp = "'file' has a length > 1. Only the first element was taken!") - - ## create a file with unsupported version - file.wrong <- "RF_wrong_version.Rf" - writeLines(gsub("17-10-2018", "wrong-version", readLines(file)), - file.wrong) - expect_error(read_RF2R(file.wrong), - "File format not supported") - file.remove(file.wrong) - - ## create a file with malformed header - file.wrong <- "RF_wrong_header.Rf" - writeLines(gsub("grain_d=20", "grain_d=", readLines(file)), - file.wrong) - expect_message(read_RF2R(file.wrong), - "Error: Header extraction failed") - file.remove(file.wrong) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_SPE2R.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_SPE2R.R deleted file mode 100644 index fd2e60e75..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_SPE2R.R +++ /dev/null @@ -1,58 +0,0 @@ -## path to the SPE file on github, as it's not included in the package -github.url <- file.path("https://github.com/R-Lum/Luminescence", - "raw/dev_0.9.x/tests/testthat/_data") - -## `read_SPE2R()` calls `download.file()` which, in turn, uses curl to -## perform the actual download. If `verbose = TRUE`, curl is invoked with -## `quiet = FALSE`, and the output it produces cannot be captured by `SW()`, -## nor by other simple R apporaches because curl writes directly to the -## console bypassing R. The workaround is to divert all output to a file, see: -## https://stackoverflow.com/questions/66138345/how-to-suppress-download-file-trying-url-message-in-r -sink.curl.messages <- function(expr) { - nullcon <- file(nullfile(), open = "wb") - sink(nullcon, type = "message") - expr - sink(type = "message") - close(nullcon) -} - -test_that("input validation", { - testthat::skip_on_cran() - - expect_message(expect_null(read_SPE2R("error")), - "Error: File does not exist, NULL returned") - expect_error(read_SPE2R(file.path(github.url, "SPEfile.SPE"), - output.object = "error"), - "'output.object' not supported, valid options are") - - SW({ - expect_message(expect_null(read_SPE2R("http://httpbun.org/status/404")), - "Error: File does not exist, NULL returned") - }) - - wrong <- system.file("extdata/BINfile_V8.binx", package = "Luminescence") - expect_error(read_SPE2R(wrong), - "Unsupported file format") -}) - -test_that("Test general functionality", { - testthat::skip_on_cran() - - ## default values - sink.curl.messages( - expect_output( - expect_s4_class(read_SPE2R(file.path(github.url, "SPEfile.SPE")), - "RLum.Data.Image"), - "URL detected, checking connection") - ) - - ## test output.object - expect_s4_class(read_SPE2R(file.path(github.url, "SPEfile.SPE"), - output.object = "RLum.Data.Spectrum", - verbose = FALSE), - "RLum.Data.Spectrum") - ret <- read_SPE2R(file.path(github.url, "SPEfile.SPE"), - output.object = "matrix", - verbose = FALSE) - expect_true(is.matrix(ret)) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_TIFF2R.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_TIFF2R.R deleted file mode 100644 index 3545a6e0b..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_TIFF2R.R +++ /dev/null @@ -1,13 +0,0 @@ -test_that("Test general functionality", { - testthat::skip_on_cran() - - ##crash function - expect_error(object = read_TIFF2R(file = "text"), - regexp = "\\[read_TIFF2R\\(\\)\\] File does not exist or is not readable!") - - ## test import - file <- system.file("extdata", "TIFFfile.tif", package = "Luminescence") - expect_s4_class(read_TIFF2R(file), "RLum.Data.Image") - - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_XSYG2R.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_XSYG2R.R deleted file mode 100644 index f8b320d2d..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_read_XSYG2R.R +++ /dev/null @@ -1,63 +0,0 @@ -## path to the XSYG file on github -github.url <- file.path("https://raw.githubusercontent.com/R-Lum", - "rxylib/master/inst/extdata/TLSpectrum.xsyg") -SW({ -xsyg.file <- .download_file(github.url, tempfile("test_read_XSYG2R")) -}) - -test_that("test import of XSYG files", { - testthat::skip_on_cran() - - ##force error - expect_message(expect_null(read_XSYG2R("_error_file_")), - "XML file not readable, nothing imported") - expect_message(expect_null(read_XSYG2R("/Test", fastForward = TRUE)), - "XML file not readable, nothing imported") - SW({ - expect_message(expect_null(read_XSYG2R(test_path("_data"))), - "No files matching the given pattern found in directory") - }) - - ## download from github - expect_type(read_XSYG2R(github.url, import = FALSE, verbose = FALSE), - "list") - - ## local file - expect_type(read_XSYG2R(xsyg.file, verbose = FALSE), - "list") - expect_s3_class(read_XSYG2R(xsyg.file, fastForward = TRUE, - import = FALSE, verbose = FALSE), - "data.frame") - expect_silent(read_XSYG2R(xsyg.file, verbose = FALSE, - recalculate.TL.curves = FALSE)) - expect_silent(read_XSYG2R(xsyg.file, verbose = FALSE, pattern = "xsyg", - recalculate.TL.curves = FALSE)) - expect_type(read_XSYG2R(xsyg.file, fastForward = FALSE, - verbose = FALSE), - "list") - results <- expect_type(read_XSYG2R(xsyg.file, fastForward = TRUE, - verbose = FALSE), - type = "list") - expect_type(results[[1]]@info$file, type = "character") - expect_output(print(results)) - - ## list input - expect_type(read_XSYG2R(list(xsyg.file), fastForward = TRUE, - verbose = FALSE), - "list") - expect_s3_class(read_XSYG2R(list(xsyg.file), fastForward = TRUE, - import = FALSE, verbose = FALSE), - "data.frame") - expect_type(read_XSYG2R(list(xsyg.file), fastForward = FALSE, - verbose = FALSE), - "list") - - ## check also internal files - SW({ - expect_type(read_XSYG2R(system.file("extdata/XSYG_file.xsyg", - package = "Luminescence"), - fastForward = TRUE, import = TRUE, - verbose = TRUE), - "list") - }) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_replicate_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_replicate_RLum.R deleted file mode 100644 index d913e3c69..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_replicate_RLum.R +++ /dev/null @@ -1,11 +0,0 @@ -test_that("Test replication of RLum-objects", { - testthat::skip_on_cran() - - data(ExampleData.RLum.Analysis, envir = environment()) - expect_silent(results <- rep(IRSAR.RF.Data[[1]], 5)) - expect_silent(rep(IRSAR.RF.Data[[1]])) - - ##check - expect_equal(length(results),5) - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_report_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_report_RLum.R deleted file mode 100644 index d06dc4288..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_report_RLum.R +++ /dev/null @@ -1,29 +0,0 @@ -test_that("Test Simple RLum Report", { - testthat::skip_on_cran() - - ## the test fails on AppVeyor for no obvious reason on the windows - ## platform ... attempts to reproduce this failure failed. So - ## we skip this platform for the test - testthat::skip_on_os("windows") - - ### load example data - data(ExampleData.DeValues, envir = environment()) - SW({ - temp <- calc_CommonDose(ExampleData.DeValues$CA1) - }) - - expect_error(report_RLum(temp, css.file = "error"), - "Couldn't find the specified CSS file") - - # create the standard HTML report - testthat::expect_null(report_RLum(object = temp, timestamp = FALSE, show_report = FALSE)) - testthat::expect_null(report_RLum(object = temp, timestamp = TRUE, - show_report = FALSE, compact = FALSE)) - - ## compact view - expect_null(report_RLum(list(temp, temp), - show_report = FALSE, compact = TRUE)) - - ## data.frame - expect_null(report_RLum(ExampleData.DeValues$CA1)) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_scale_GammaDose.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_scale_GammaDose.R deleted file mode 100644 index 3cb85633c..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_scale_GammaDose.R +++ /dev/null @@ -1,155 +0,0 @@ -data("ExampleData.ScaleGammaDose", envir = environment()) -d <- ExampleData.ScaleGammaDose - -## Conversion factors: Liritzisetal2013 -results <- scale_GammaDose(data = d, - conversion_factors = "Liritzisetal2013", - fractional_gamma_dose = "Aitken1985", - plot = FALSE, verbose = FALSE) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - expect_equal(is(results), c("RLum.Results", "RLum")) - expect_equal(length(results), 6) - expect_equal(is(results$summary)[1], "data.frame") -}) - -test_that("check values from output example", { - testthat::skip_on_cran() - - expect_equal(formatC(results$summary$dose_rate_total, 4), "0.9242") - expect_equal(formatC(results$summary$dose_rate_total_err, 4), "0.2131") -}) - -## Conversion factors: Guerinetal2011 -results <- scale_GammaDose(data = d, - conversion_factors = "Guerinetal2011", - fractional_gamma_dose = "Aitken1985", - plot = FALSE, verbose = FALSE) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - expect_equal(is(results), c("RLum.Results", "RLum")) - expect_equal(length(results), 6) - expect_equal(is(results$summary)[1], "data.frame") -}) - -test_that("check values from output example", { - testthat::skip_on_cran() - - expect_equal(formatC(results$summary$dose_rate_total, 4), "0.9214") - expect_equal(formatC(results$summary$dose_rate_total_err, 4), "0.2124") -}) - -## Conversion factors: Guerinetal2011 -results <- scale_GammaDose(data = d, - conversion_factors = "AdamiecAitken1998", - fractional_gamma_dose = "Aitken1985", - plot = FALSE, verbose = FALSE) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - expect_equal(is(results), c("RLum.Results", "RLum")) - expect_equal(length(results), 6) - expect_equal(is(results$summary)[1], "data.frame") -}) - -test_that("check values from output example", { - testthat::skip_on_cran() - - expect_equal(formatC(results$summary$dose_rate_total, 4), "0.9123") - expect_equal(formatC(results$summary$dose_rate_total_err, 4), "0.2097") -}) - -## CONSOLE & PLOT OUTPUT -test_that("console & plot", { - expect_output({ - scale_GammaDose(d, plot = TRUE, verbose = TRUE) - scale_GammaDose(d, plot = TRUE, plot_single = FALSE, verbose = TRUE) - }) -}) - - -## WARNINGS & FAILURES -test_that("check input data", { - testthat::skip_on_cran() - - expect_error( - scale_GammaDose(NA, plot = FALSE, verbose = TRUE), - "must be a data frame" - ) - expect_error( - scale_GammaDose(d[ ,1:10], plot = FALSE, verbose = TRUE), - "must have 12 columns" - ) - SW({ - expect_warning({ - tmp <- d - colnames(tmp) <- letters[1:ncol(tmp)] - scale_GammaDose(tmp, plot = FALSE, verbose = TRUE) - }, - "Unexpected column names" - ) - }) - expect_error({ - tmp <- d - tmp$sample_offset <- NA - scale_GammaDose(tmp, plot = FALSE, verbose = TRUE) - }, - "Only one layer must be contain a numeric value in column 'sample_offset'" - ) - expect_error({ - tmp <- d - tmp$sample_offset[5] <- "target" - scale_GammaDose(tmp, plot = FALSE, verbose = TRUE) - }, - "Non-numeric value in the the row of the target layer." - ) - expect_error({ - tmp <- d - tmp$sample_offset[5] <- -1 - scale_GammaDose(tmp, plot = FALSE, verbose = TRUE) - }, - "The numeric value in 'sample_offset' must be positive." - ) - expect_error({ - tmp <- d - tmp$sample_offset[5] <- 20 - scale_GammaDose(tmp, plot = FALSE, verbose = TRUE) - }, - "Impossible! Sample offset larger than the target-layer's thickness!" - ) - expect_error({ - scale_GammaDose(d, conversion_factors = c("a", "b"), plot = FALSE, verbose = TRUE) - }, - "must be an object of length 1 and of class 'character'." - ) - expect_error({ - scale_GammaDose(d, conversion_factors = 1, plot = FALSE, verbose = TRUE) - }, - "must be an object of length 1 and of class 'character'." - ) - expect_error({ - scale_GammaDose(d, conversion_factors = "HansGuenter2020", plot = FALSE, verbose = TRUE) - }, - "Invalid 'conversion_factors'. Valid options:" - ) - expect_error({ - scale_GammaDose(d, fractional_gamma_dose = c("a", "b"), plot = FALSE, verbose = TRUE) - }, - "must be an object of length 1 and of class 'character'." - ) - expect_error({ - scale_GammaDose(d, fractional_gamma_dose = 1, plot = FALSE, verbose = TRUE) - }, - "must be an object of length 1 and of class 'character'." - ) - expect_error({ - scale_GammaDose(d, fractional_gamma_dose = "momgetthecameraiamontheinternet1995", plot = FALSE, verbose = TRUE) - }, - "Invalid 'fractional_gamma_dose'. Valid options:" - ) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_smooth_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_smooth_RLum.R deleted file mode 100644 index 71d2820b5..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_smooth_RLum.R +++ /dev/null @@ -1,37 +0,0 @@ -data(ExampleData.CW_OSL_Curve, envir = environment()) -temp <- - set_RLum( - class = "RLum.Data.Curve", - recordType = "OSL", - data = as.matrix(ExampleData.CW_OSL_Curve) - ) - -##create RLum.Analysis object -temp_analysis <- set_RLum("RLum.Analysis", records = list(temp, temp)) - -test_that("check class and length of output", { - testthat::skip_on_cran() - - ##standard tests - expect_s4_class(temp, class = "RLum.Data.Curve") - expect_s4_class(smooth_RLum(temp), class = "RLum.Data.Curve") - - ##test on a list - ##RLum list - expect_type(smooth_RLum(list(temp, temp)), "list") - - ##normal list - expect_type(smooth_RLum(list(a = 1, b = 2)), "list") - - ##test on an RLum.Analysis-object - expect_s4_class(smooth_RLum(temp_analysis), "RLum.Analysis") - -}) - -test_that("check values from output example", { - testthat::skip_on_cran() - - expect_equal(round(mean(smooth_RLum(temp, k = 5)[,2], na.rm = TRUE), 0), 100) - expect_equal(round(mean(smooth_RLum(temp, k = 10)[,2], na.rm = TRUE), 0), 85) - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_structure_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_structure_RLum.R deleted file mode 100644 index 3e538fbb0..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_structure_RLum.R +++ /dev/null @@ -1,11 +0,0 @@ -test_that("Test whether the function works", { - testthat::skip_on_cran() - - data(ExampleData.RLum.Analysis, envir = environment()) - expect_silent(structure_RLum(IRSAR.RF.Data)) - expect_s3_class(structure_RLum(IRSAR.RF.Data), "data.frame") - - ##test a list of such elements - expect_type(structure_RLum(list(IRSAR.RF.Data,IRSAR.RF.Data, "a")), "list") - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_subset_RLum.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_subset_RLum.R deleted file mode 100644 index a485a46a8..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_subset_RLum.R +++ /dev/null @@ -1,32 +0,0 @@ -# RLum.Analysis ----------------------------------------------------------- -test_that("subset RLum.Analysis", { - testthat::skip_on_cran() - - data(ExampleData.RLum.Analysis, envir = environment()) - temp <- IRSAR.RF.Data - - ## subset.RLum.Analysis() - S3 method - ### empty call - expect_s4_class(subset(temp), "RLum.Analysis") - expect_length(subset(temp), length(temp)) - expect_identical(subset(temp)[[1]], temp[[1]]) - - ### errors - expect_error(subset(temp, LTYPE == "RF"), - "Invalid subset expression, valid terms are") # FIXME(mcol): long function name produced by .throw_error() - SW({ - expect_message(expect_null(subset(temp, recordType == "xx")), - "'subset' expression produced an empty selection, NULL returned") - }) - - ### valid - expect_s4_class(subset(temp, recordType == "RF"), class = "RLum.Analysis") - expect_s4_class(subset(temp, recordType == "RF")[[1]], class = "RLum.Data.Curve") - expect_length(subset(temp, recordType == "RF"), n = length(temp)) - - ## get_RLum(, subset = ()) - expect_s4_class(get_RLum(temp, subset = recordType == "RF"), class = "RLum.Analysis") - expect_s4_class(get_RLum(temp, subset = recordType == "RF")[[1]], class = "RLum.Data.Curve") - expect_length(get_RLum(temp, subset = recordType == "RF"), n = length(temp)) - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_subset_SingleGrainData.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_subset_SingleGrainData.R deleted file mode 100644 index b9dab6f2e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_subset_SingleGrainData.R +++ /dev/null @@ -1,21 +0,0 @@ -test_that("Check subset_SingleGrain", { - testthat::skip_on_cran() - - ## get example ready - data(ExampleData.BINfileData, envir = environment()) - - ## set POSITION/GRAIN pair dataset - selection <- data.frame(POSITION = c(1,5,7), GRAIN = c(0,0,0)) - - ## crash function - expect_error( - object = subset_SingleGrainData("error"), - regexp = "\\[subset\\_SingleGrainData\\(\\)\\] Only Risoe.BINfileData-class objects are allowed as input!") - - ## standard run - expect_s4_class(subset_SingleGrainData(object = CWOSL.SAR.Data, selection = selection), "Risoe.BINfileData") - - ## try something different for the input - expect_s4_class(subset_SingleGrainData(object = CWOSL.SAR.Data, selection = as.matrix(selection)), "Risoe.BINfileData") - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_template_DRAC.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_template_DRAC.R deleted file mode 100644 index ac2de019e..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_template_DRAC.R +++ /dev/null @@ -1,45 +0,0 @@ -##Full check -test_that("Check template creation ", { - testthat::skip_on_cran() - - ## test output class - SW({ - expect_message(res <- template_DRAC(), - "IMPORTANT NOTE") - }) - expect_s3_class(res, "DRAC.list") - expect_s3_class(template_DRAC(notification = FALSE), "DRAC.list") - expect_s3_class(template_DRAC(nrow = 10, notification = FALSE), "DRAC.list") - - ## test presets - expect_identical(as.numeric(template_DRAC(notification = FALSE, preset = "quartz_coarse")$`a-value`), 0.035) - expect_identical(as.numeric(template_DRAC(notification = FALSE, preset = "quartz_fine")$`a-value`), 0.035) - expect_identical(as.numeric(template_DRAC(notification = FALSE, preset = "feldspar_coarse")$`a-value`), 0.08) - expect_identical(as.numeric(template_DRAC(notification = FALSE, preset = "polymineral_fine")$`a-value`), 0.08) - expect_identical(as.numeric(template_DRAC(notification = FALSE, preset = "DRAC-example_quartz")$`De (Gy)`), 20) - expect_identical(as.numeric(template_DRAC(notification = FALSE, preset = "DRAC-example_feldspar")$`De (Gy)`), 15) - expect_identical(as.numeric(template_DRAC(notification = FALSE, preset = "DRAC-example_polymineral")$`De (Gy)`), 204.47) - - expect_true( - do.call(all.equal, as.list(template_DRAC(nrow = 2, notification = FALSE, preset = "DRAC-example_quartz")$`De (Gy)`)) - ) - - ## misc tests - expect_true(all(is.na(template_DRAC(notification = FALSE)))) - expect_true(!all(is.na(template_DRAC(preset = "DRAC-example_polymineral", notification = FALSE)))) - expect_equal(length(template_DRAC(notification = FALSE)), 53) - expect_equal(length(template_DRAC(nrow = 10, notification = FALSE)[[1]]), 10) - expect_s3_class(template_DRAC(nrow = -1, notification = FALSE), "DRAC.list") - - ## expect failure - expect_error(template_DRAC("preset"), - "'nrow' must be a positive integer scalar") - expect_warning(template_DRAC(nrow = 5001, notification = FALSE), - regexp = "\\[template_DRAC\\(\\)\\] More than 5000 datasets might not be supported!") - expect_error(template_DRAC(preset = "does_not_exist"), - "Invalid preset") - expect_error(template_DRAC(preset = c("does_not_exist", "neither_this_one")), - "'preset' must be a 'character' of length 1") - expect_error(template_DRAC(preset = 999), - "'preset' must be a 'character' of length 1") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_trim_RLum.Data.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_trim_RLum.Data.R deleted file mode 100644 index 64c2e7516..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_trim_RLum.Data.R +++ /dev/null @@ -1,146 +0,0 @@ -test_that("RLum.Data.Curve", { - testthat::skip_on_cran() - - data(ExampleData.BINfileData, envir = environment()) - temp <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = 1) - - ## trim with range - t <- testthat::expect_type( - object = trim_RLum.Data(temp$TL, trim_range = c(20,50)), - type = "list") - - ## check output length - testthat::expect_length( - object = t[[1]]@data[,1], n = 31) - - ## trim maximum only - t <- testthat::expect_type( - object = trim_RLum.Data(temp$TL, trim_range = c(50)), - type = "list") - - ## check output length - testthat::expect_length( - object = t[[1]]@data[,1], n = 50) - - ## trim with nothing - t <- testthat::expect_type( - object = trim_RLum.Data(temp$TL, trim_range = NULL), - type = "list") - - ## check output length - testthat::expect_length( - object = t[[1]]@data[,1], n = 250) - - ## trim with wrong curve type ... this should do nothing - ## because the object is just parsed through - ## on top we use a single object instead of list only - t <- testthat::expect_s4_class( - object = trim_RLum.Data(temp@records[[1]], recordType = "OSL", trim_range = NULL), - class = "RLum.Data.Curve") - - ## check output length - testthat::expect_length( - object = t@data[,1], n = 250) - - ## test some edge cases from trim - ## 1 - testthat::expect_s4_class( - object = trim_RLum.Data(temp@records[[1]], trim_range = c(1)), - class = "RLum.Data.Curve") - ## 0 - testthat::expect_s4_class( - object = trim_RLum.Data(temp@records[[1]], trim_range = c(0)), - class = "RLum.Data.Curve") - ## -1 - testthat::expect_s4_class( - object = trim_RLum.Data(temp@records[[1]], trim_range = c(-1)), - class = "RLum.Data.Curve") - ## c(1,2,3) - testthat::expect_s4_class( - object = trim_RLum.Data(temp@records[[1]], trim_range = c(1:3)), - class = "RLum.Data.Curve") - - -}) - -test_that("RLum.Data.Spectrum", { - testthat::skip_on_cran() - - ## simple test for RLum.Data.Spectrum ... this can be kept - ## simple because everything else was tested already - data(ExampleData.XSYG, envir = environment()) - - t <- testthat::expect_s4_class( - object = trim_RLum.Data(TL.Spectrum, trim_range = c(2, 4)), - class = "RLum.Data.Spectrum") - - testthat::expect_length(object = t@data[1,], n = 3) - -}) - -test_that("RLum.Data.Image", { - testthat::skip_on_cran() - - ## simple test for RLum.Data.Spectrum ... this can be kept - ## simple because everything else was tested already - data(ExampleData.RLum.Data.Image, envir = environment()) - - testthat::expect_s4_class( - object = trim_RLum.Data(ExampleData.RLum.Data.Image, recordType = c(10,100)), - class = "RLum.Data.Image") - -}) - -test_that("RLum.Analysis", { - testthat::skip_on_cran() - - ##load example data - data(ExampleData.BINfileData, envir = environment()) - temp <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = 1) - - ## generate case where one OSL curve has one channel less - temp@records[[2]]@data <- temp@records[[2]]@data[-nrow(temp[[2]]@data),] - - ## now all OSL curves should be shortened to 999 - t <- testthat::expect_s4_class( - object = trim_RLum.Data(temp), - class = "RLum.Analysis") - - ## check for OSL, the TL must remain untouched - testthat::expect_length( - object = t@records[[4]]@data[,1], n = 999) - testthat::expect_length( - object = t@records[[1]]@data[,1], n = 250) - - ## apply a trimming to all curves - t <- testthat::expect_s4_class( - object = trim_RLum.Data(temp, trim_range = c(10,20)), - class = "RLum.Analysis") - - ## check for two curves - testthat::expect_length( - object = t@records[[4]]@data[,1], n = 11) - testthat::expect_length( - object = t@records[[1]]@data[,1], n = 11) - - ## apply a trimming to TL curves only - t <- testthat::expect_s4_class( - object = trim_RLum.Data(temp, recordType = "OSL", trim_range = c(10,20)), - class = "RLum.Analysis") - ## check for two curves - testthat::expect_length( - object = t@records[[4]]@data[,1], n = 11) - testthat::expect_length( - object = t@records[[1]]@data[,1], n = 250) - -}) - - -test_that("Crash function", { - testthat::skip_on_cran() - - ## trigger stop - testthat::expect_error( - object = trim_RLum.Data("error"), - regexp = "\\[trim\\_RLum.Data\\(\\)\\] Unsupported input class\\!") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_use_DRAC.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_use_DRAC.R deleted file mode 100644 index 240ccc73d..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_use_DRAC.R +++ /dev/null @@ -1,78 +0,0 @@ -##Full check -test_that("Test DRAC", { - testthat::skip_on_cran() - - ##use manual example - ##create template - SW({ - input <- template_DRAC(preset = "DRAC-example_quartz") - }) - - ##test - expect_s3_class(input, "DRAC.list") - - ##fill (which also tests the methods) - input$`Project ID` <- "DRAC-Example" - input$`Sample ID` <- "Quartz" - input$`Conversion factors` <- "AdamiecAitken1998" - input$`External U (ppm)` <- 3.4 - input$`errExternal U (ppm)` <- 0.51 - input$`External Th (ppm)` <- 14.47 - input$`errExternal Th (ppm)` <- 1.69 - input$`External K (%)` <- 1.2 - input$`errExternal K (%)` <- 0.14 - input$`Calculate external Rb from K conc?` <- "Y" - input$`Calculate internal Rb from K conc?` <- "Y" - input$`Scale gammadoserate at shallow depths?` <- "Y" - input$`Grain size min (microns)` <- 90 - input$`Grain size max (microns)` <- 125 - input$`Water content ((wet weight - dry weight)/dry weight) %` <- 5 - input$`errWater content %` <- 2 - input$`Depth (m)` <- 2.2 - input$`errDepth (m)` <- 0.22 - input$`Overburden density (g cm-3)` <- 1.8 - input$`errOverburden density (g cm-3)` <- 0.1 - input$`Latitude (decimal degrees)` <- 30.0000 - input$`Longitude (decimal degrees)` <- 70.0000 - input$`Altitude (m)` <- 150 - input$`De (Gy)` <- 20 - input$`errDe (Gy)` <- 0.2 - - ##run DRAC - SW({ - output <- expect_s4_class(use_DRAC(input), "RLum.Results") - }) - - ## print method for DRAC.highlights - expect_output(print(output$DRAC$highlights), regexp = "TO:GP = errAge") - - ## DRAC.data.frame - input.df <- as.data.frame(input) - class(input.df) <- c("data.frame", "DRAC.data.frame") - expect_s4_class(use_DRAC(input.df, verbose = FALSE), - "RLum.Results") - - ## CSV input - expect_s4_class(use_DRAC(test_path("_data/DRAC_Input_Template.csv"), - verbose = FALSE), - "RLum.Results") - - ## XLS input - fake.xls <- system.file("extdata/clippy.xls", package = "readxl") - expect_error(use_DRAC(fake.xls), - "you are not using the original DRAC v1.1 XLSX template") - - ## crash function - ## wrong file name - expect_error(use_DRAC("error"), "\\[use_DRAC\\(\\)\\] It seems that the file doesn't exist!") - expect_error(use_DRAC(NA), - "The provided data object is not a valid DRAC template") - - ## exceed allowed limit - SW({ - expect_warning(input <- template_DRAC(preset = "DRAC-example_quartz", - nrow = 5001), - "More than 5000 datasets might not be supported") - }) - expect_error(use_DRAC(input), "The limit of allowed datasets is 5000!") -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_verify_SingleGrainData.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_verify_SingleGrainData.R deleted file mode 100644 index a5db4bfad..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_verify_SingleGrainData.R +++ /dev/null @@ -1,57 +0,0 @@ -test_that("Various function test", { - testthat::skip_on_cran() - - expect_error(verify_SingleGrainData("test"), - "Input type 'character' is not allowed for this function") - - data(ExampleData.XSYG, envir = environment()) - object <- get_RLum( - OSL.SARMeasurement$Sequence.Object, recordType = "OSL (UVVIS)", drop = FALSE) - - ## RLum.Analysis object - expect_warning(output <- verify_SingleGrainData(object), - "selection_id is NA, nothing removed, everything selected") - expect_s4_class(output, "RLum.Results") - expect_s3_class(output$selection_full, "data.frame") - expect_equal(sum(output@data$selection_full$VALID), 11) - expect_equal(output@originator, "verify_SingleGrainData") - - expect_output(res <- verify_SingleGrainData(object, cleanup = TRUE, - cleanup_level = "curve", - threshold = 100), - "RLum.Analysis object reduced to records") - expect_s4_class(res, "RLum.Analysis") - expect_equal(res@originator, "verify_SingleGrainData") - expect_length(res@records, 5) - - ## threshold too high, empty object generated - expect_output(res <- verify_SingleGrainData(object, cleanup = TRUE, - cleanup_level = "curve", - threshold = 2000), - "RLum.Analysis object reduced to records") - expect_s4_class(res, "RLum.Analysis") - expect_equal(res@originator, "read_XSYG2R") - expect_length(res@records, 0) - - ## Risoe.BINfileData - data(ExampleData.BINfileData, envir = environment()) - res <- expect_silent(verify_SingleGrainData(CWOSL.SAR.Data)) - expect_s4_class(res, "RLum.Results") - - res <- expect_output(verify_SingleGrainData(CWOSL.SAR.Data, cleanup = TRUE), - "Risoe.BINfileData object reduced to records") - expect_s4_class(res, "Risoe.BINfileData") - - obj.risoe <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = 1) - res <- expect_silent(verify_SingleGrainData(obj.risoe)) - expect_s4_class(res, "RLum.Results") - - ##check options - expect_silent(suppressWarnings(verify_SingleGrainData(object, plot = TRUE))) - expect_silent(suppressWarnings(verify_SingleGrainData(object, threshold = 100))) - expect_silent(suppressWarnings(verify_SingleGrainData(object, verbose = FALSE))) - expect_silent(suppressWarnings(verify_SingleGrainData(object, cleanup = TRUE))) - expect_silent(verify_SingleGrainData(object, cleanup_level = "curve")) - expect_silent(suppressWarnings(verify_SingleGrainData(list(object), cleanup = TRUE))) - expect_silent(suppressWarnings(verify_SingleGrainData(list(object)))) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_write_R2BIN.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_write_R2BIN.R deleted file mode 100644 index 29118bf59..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_write_R2BIN.R +++ /dev/null @@ -1,120 +0,0 @@ -test_that("write to empty connection", { - testthat::skip_on_cran() - -#Unit test for write_BIN2R() function - -#create data file -data(ExampleData.BINfileData, envir = environment()) - - ##empty RisoeBINfileData object - empty <- set_Risoe.BINfileData() - - ##replace the raw by numeric - CWOSL.SAR.Data@METADATA$VERSION <- as.numeric(CWOSL.SAR.Data@METADATA$VERSION) - CWOSL.SAR.Data@METADATA[] <- lapply(CWOSL.SAR.Data@METADATA, function(x){ - if(is.factor(x)){ - as.character(x) - }else{ - x - } - }) - - ##combing with existing BIN-file object - new <- as.data.frame( - data.table::rbindlist(l = list(empty@METADATA,CWOSL.SAR.Data@METADATA),fill = TRUE), - stringsAsFactors = FALSE) - - ##new object - new <- set_Risoe.BINfileData(METADATA = new, DATA = CWOSL.SAR.Data@DATA) - - ##replace NA values - new@METADATA[is.na(new@METADATA)] <- 0 - - ##replace RECTYPE - new@METADATA$RECTYPE <- 1 - - ##reduce files size considerably down to two records - new <- subset(new, ID == 1:2) - - ##create files - path <- tempfile() - SW({ - write_R2BIN(object = new, file = paste0(path, "BINfile_V3.bin"), version = "03") - write_R2BIN(object = new, file = paste0(path, "BINfile_V4.bin"), version = "04") - write_R2BIN(object = new, file = paste0(path, "BINfile_V5.binx"), version = "05") - write_R2BIN(object = new, file = paste0(path, "BINfile_V6.binx"), version = "06") - write_R2BIN(object = new, file = paste0(path, "BINfile_V7.binx"), version = "07") - write_R2BIN(object = new, file = paste0(path, "BINfile_V8.binx"), version = "08") - }) - - temp <- new - temp@METADATA[1, "TIME"] <- "1215" - temp@METADATA[1, "SEQUENCE"] <- "123456" - temp@METADATA[1, "SAMPLE"] <- "" - temp@METADATA[1, "COMMENT"] <- "" - temp@.RESERVED <- list(val1 = c("a", "b"), val2 = c("c", "d")) - SW({ - write_R2BIN(object = temp, file = paste0(path, "BINfile_V3.bin"), - version = "03") - temp@METADATA[, "VERSION"] <- 4 - write_R2BIN(object = temp, file = paste0(path, "BINfile_V4.bin"), - version = "04") - temp@METADATA[, "VERSION"] <- 5 - write_R2BIN(object = temp, file = paste0(path, "BINfile_V5.binx"), - version = "05") - temp@METADATA[, "VERSION"] <- 6 - write_R2BIN(object = temp, file = paste0(path, "BINfile_V6.binx"), - version = "06") - temp@METADATA[, "VERSION"] <- 7 - write_R2BIN(object = temp, file = paste0(path, "BINfile_V7.binx"), - version = "07") - temp@METADATA[1, "TIME"] <- NA - temp@METADATA[, "VERSION"] <- 8 - write_R2BIN(object = temp, file = paste0(path, "BINfile_V8.binx"), - version = "08") - }) - - ##catch errors - expect_error(write_R2BIN(object = new, file = FALSE), - "argument 'file' has to be of type character") - expect_error(write_R2BIN(object = "a", file = ""), "[write_R2BIN()] Input object is not of type Risoe.BINfileData!", fixed = TRUE) - expect_error(suppressWarnings(write_R2BIN(object = set_Risoe.BINfileData(), file = ""))) - - temp <- new - temp@METADATA <- temp@METADATA[, 1:79] - expect_error(write_R2BIN(object = temp, file = "test"), - "Your Risoe.BINfileData object is not compatible with the latest") - - temp <- new - temp@METADATA[1, "SEQUENCE"] <- "1234567890" - expect_error(write_R2BIN(object = temp, file = "test"), - "Value in 'SEQUENCE' exceeds storage limit") - - temp <- new - temp@METADATA[1, "USER"] <- "1234567890" - expect_error(write_R2BIN(object = temp, file = "test"), - "'USER' exceeds storage limit") - - temp <- new - temp@METADATA[1, "SAMPLE"] <- paste0(rep("a", 25), collapse="") - expect_error(write_R2BIN(object = temp, file = "test"), - "'SAMPLE' exceeds storage limit") - - temp <- new - temp@DATA[[2]] <- 1:25000 - temp@METADATA[1, "POSITION"] <- paste0(rep("a", 50), collapse="") - expect_error(write_R2BIN(object = temp, file = "test"), - "records contain more than 9,999 data points") - expect_warning( - expect_error(write_R2BIN(object = temp, compatibility.mode = TRUE, - file = paste0(path, "BINfile_V8.binx")), - "'COMMENT' exceeds storage limit"), - "Some data sets are longer than 9,999 points") - - ## silent correction of the file extension - SW({ - skip_on_os("windows") # FIXME(mcol) - write_R2BIN(object = new, file = paste0(path, "BINfile_V8.bin"), - version = "08") - }) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_write_R2TIFF.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_write_R2TIFF.R deleted file mode 100644 index 94791c384..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_write_R2TIFF.R +++ /dev/null @@ -1,24 +0,0 @@ -test_that("Test general functionality", { - testthat::skip_on_cran() - - ## load example data - data(ExampleData.RLum.Data.Image, envir = environment()) - data(ExampleData.XSYG, envir = environment()) - - ##crash function - expect_error(write_R2TIFF(object = "test"), - "\\[write\\_R2TIFF\\(\\)\\] Only RLum.Data.Image and RLum.Data.Spectrum objects are supported!") - - expect_error(write_R2TIFF(object = ExampleData.RLum.Data.Image, file = "error/error"), - "\\[write\\_R2TIFF\\(\\)\\] Path does not exist!") - - ## export RLum.Data.Image - expect_null(write_R2TIFF(ExampleData.RLum.Data.Image, file = tempfile(fileext = "tiff"))) - - ## export RLum.Data.Spectrum - expect_null(write_R2TIFF(TL.Spectrum, file = tempfile(fileext = "tiff"))) - - ## a list - expect_null(write_R2TIFF(list(ExampleData.RLum.Data.Image, TL.Spectrum), file = tempfile(fileext = "tiff"))) - -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_write_RLum2CSV.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_write_RLum2CSV.R deleted file mode 100644 index b814379c7..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_write_RLum2CSV.R +++ /dev/null @@ -1,56 +0,0 @@ -test_that("test errors and general export function", { - testthat::skip_on_cran() - - ##test error - expect_error(write_RLum2CSV(), - "input object is missing") - expect_error(write_RLum2CSV(object = "", export = FALSE), - regexp = "[write_RLum2CSV()] Object needs to be a member of the object class RLum!", - fixed = TRUE) - - ##test export - data("ExampleData.portableOSL", envir = environment()) - expect_error(write_RLum2CSV(ExampleData.portableOSL[[1]], export = TRUE, - path = "non-existing"), - "Directory provided via the argument 'path' does not exist") - - ## move temporarily to avoid polluting the working directory - cwd <- setwd(tempdir()) - expect_message( - expect_null(write_RLum2CSV(ExampleData.portableOSL[[1]], export = TRUE)), - "Path automatically set to") - expect_type(write_RLum2CSV(ExampleData.portableOSL, export = FALSE), "list") - setwd(cwd) - - data("ExampleData.RLum.Data.Image", envir = environment()) - write_RLum2CSV(ExampleData.RLum.Data.Image, path = tempdir()) - - ##test RLum.Results objects - ## load example data - data(ExampleData.DeValues, envir = environment()) - SW({ - results <- calc_CommonDose(ExampleData.DeValues$CA1) - }) - - ##using option compact - expect_warning(write_RLum2CSV(object = results,export = FALSE), - regexp = "elements could not be converted to a CSV-structure!") - - ##using option compact = FALSE - expect_warning(write_RLum2CSV(object = results, export = FALSE, - compact = FALSE), - "elements could not be converted to a CSV-structure") - expect_warning(write_RLum2CSV(object = results,export = FALSE, compact = TRUE), - regexp = "elements could not be converted to a CSV-structure!") - - ##real export - expect_warning( - write_RLum2CSV(object = results, path = tempdir(), compact = TRUE), - regexp = "elements could not be converted to a CSV-structure!") - - ## data.frame - df <- results@data$data - expect_null(write_RLum2CSV(object = df, path = tempdir())) - attr(df, "filename") <- "test" - expect_null(write_RLum2CSV(object = df, path = tempdir())) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_zzz.R b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_zzz.R deleted file mode 100644 index 9351521bb..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/tests/testthat/test_zzz.R +++ /dev/null @@ -1,30 +0,0 @@ -test_that("Test zzz functions ... they should still work", { - testthat::skip_on_cran() - - ##get right answer - expect_equal(get_rightAnswer(), 46) - expect_equal(get_rightAnswer("test"), 46) - - ##get quote - expect_silent(get_Quote()) - expect_silent(get_Quote(ID = 1)) - expect_silent(get_Quote(ID = 10, separated = TRUE)) - expect_silent(get_Quote(ID = 1e06)) - - ##tune data - expect_warning(tune_Data(1:10)) - expect_warning(tune_Data(data.frame(runif(n = 10, 8,12),runif(n = 10, 0.1,0.3) ), decrease.error = TRUE)) - expect_warning(tune_Data(data.frame(runif(n = 10, 8,12),runif(n = 10, 0.1,0.3) ), increase.data = TRUE)) - - ##sTeve - ## read example data set - data(ExampleData.DeValues, envir = environment()) - ExampleData.DeValues <- - Second2Gray(ExampleData.DeValues$BT998, c(0.0438,0.0019)) - - ## create plot straightforward - expect_silent(plot_KDE(data = ExampleData.DeValues)) - expect_silent(sTeve(type = 1)) - expect_silent(sTeve(type = 2, t_animation = 1)) - expect_silent(sTeve(type = 3, t_animation = 1, n.tree = 2)) -}) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/vignettes/S4classObjects.pdf.asis b/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/vignettes/S4classObjects.pdf.asis deleted file mode 100644 index b4728c24d..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00_pkg_src/Luminescence/vignettes/S4classObjects.pdf.asis +++ /dev/null @@ -1,6 +0,0 @@ -%\VignetteIndexEntry{S4-class Object Structure in 'Luminescence'} -%\VignetteEngine{R.rsp::asis} -%\VignetteKeyword{PDF} -%\VignetteKeyword{HTML} -%\VignetteKeyword{vignette} -%\VignetteKeyword{package} diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00check.log b/Luminescence.BuildResults/Luminescence.Rcheck/00check.log deleted file mode 100644 index 8b83f8757..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00check.log +++ /dev/null @@ -1,78 +0,0 @@ -* using log directory ‘/Users/kreutzer/GitHub/Luminescence/Luminescence.BuildResults/Luminescence.Rcheck’ -* using R version 4.4.1 Patched (2024-08-21 r87049) -* using platform: aarch64-apple-darwin20 -* R was compiled by - Apple clang version 14.0.0 (clang-1400.0.29.202) - GNU Fortran (GCC) 12.2.0 -* running under: macOS Sonoma 14.6.1 -* using session charset: UTF-8 -* checking for file ‘Luminescence/DESCRIPTION’ ... OK -* checking extension type ... Package -* this is package ‘Luminescence’ version ‘0.9.25’ -* package encoding: UTF-8 -* checking package namespace information ... OK -* checking package dependencies ... OK -* checking if this is a source package ... OK -* checking if there is a namespace ... OK -* checking for executable files ... OK -* checking for hidden files and directories ... OK -* checking for portable file names ... OK -* checking for sufficient/correct file permissions ... OK -* checking whether package ‘Luminescence’ can be installed ... OK -* used C++ compiler: ‘Apple clang version 15.0.0 (clang-1500.3.9.4)’ -* used SDK: ‘’ -* checking C++ specification ... OK - Not all R platforms support C++17 -* checking installed package size ... OK -* checking package directory ... OK -* checking ‘build’ directory ... OK -* checking DESCRIPTION meta-information ... OK -* checking top-level files ... OK -* checking for left-over files ... OK -* checking index information ... OK -* checking package subdirectories ... OK -* checking code files for non-ASCII characters ... OK -* checking R files for syntax errors ... OK -* checking whether the package can be loaded ... OK -* checking whether the package can be loaded with stated dependencies ... OK -* checking whether the package can be unloaded cleanly ... OK -* checking whether the namespace can be loaded with stated dependencies ... OK -* checking whether the namespace can be unloaded cleanly ... OK -* checking whether startup messages can be suppressed ... OK -* checking dependencies in R code ... OK -* checking S3 generic/method consistency ... OK -* checking replacement functions ... OK -* checking foreign function calls ... OK -* checking R code for possible problems ... OK -* checking Rd files ... OK -* checking Rd metadata ... OK -* checking Rd cross-references ... OK -* checking for missing documentation entries ... OK -* checking for code/documentation mismatches ... OK -* checking Rd \usage sections ... OK -* checking Rd contents ... OK -* checking for unstated dependencies in examples ... OK -* checking contents of ‘data’ directory ... OK -* checking data for non-ASCII characters ... OK -* checking data for ASCII and uncompressed saves ... OK -* checking line endings in C/C++/Fortran sources/headers ... OK -* checking line endings in Makefiles ... OK -* checking compilation flags in Makevars ... OK -* checking for GNU extensions in Makefiles ... OK -* checking for portable use of $(BLAS_LIBS) and $(LAPACK_LIBS) ... OK -* checking use of PKG_*FLAGS in Makefiles ... OK -* checking compiled code ... OK -* checking sizes of PDF files under ‘inst/doc’ ... OK -* checking installed files from ‘inst/doc’ ... OK -* checking files in ‘vignettes’ ... OK -* checking examples ... OK -* checking for unstated dependencies in ‘tests’ ... OK -* checking tests ... OK - Running ‘spelling.R’ - Running ‘testthat.R’ -* checking for unstated dependencies in vignettes ... OK -* checking package vignettes ... OK -* checking re-building of vignette outputs ... OK -* checking PDF version of manual ... OK -* DONE -Status: OK diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/00install.out b/Luminescence.BuildResults/Luminescence.Rcheck/00install.out deleted file mode 100644 index 0f92c2105..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/00install.out +++ /dev/null @@ -1,27 +0,0 @@ -* installing *source* package ‘Luminescence’ ... -** using staged installation -** libs -using C++ compiler: ‘Apple clang version 15.0.0 (clang-1500.3.9.4)’ -using C++17 -using SDK: ‘’ -clang++ -arch arm64 -std=gnu++17 -I"/Library/Frameworks/R.framework/Resources/include" -DNDEBUG -I../inst/include -I'/Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/library/Rcpp/include' -I'/Users/kreutzer/GitHub/Luminescence/Luminescence.BuildResults/Library/RcppArmadillo/include' -I/opt/R/arm64/include -fPIC -falign-functions=64 -Wall -g -O2 -c RcppExports.cpp -o RcppExports.o -clang++ -arch arm64 -std=gnu++17 -I"/Library/Frameworks/R.framework/Resources/include" -DNDEBUG -I../inst/include -I'/Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/library/Rcpp/include' -I'/Users/kreutzer/GitHub/Luminescence/Luminescence.BuildResults/Library/RcppArmadillo/include' -I/opt/R/arm64/include -fPIC -falign-functions=64 -Wall -g -O2 -c create_UID.cpp -o create_UID.o -clang++ -arch arm64 -std=gnu++17 -I"/Library/Frameworks/R.framework/Resources/include" -DNDEBUG -I../inst/include -I'/Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/library/Rcpp/include' -I'/Users/kreutzer/GitHub/Luminescence/Luminescence.BuildResults/Library/RcppArmadillo/include' -I/opt/R/arm64/include -fPIC -falign-functions=64 -Wall -g -O2 -c src_analyse_IRSARRF_SRS.cpp -o src_analyse_IRSARRF_SRS.o -clang++ -arch arm64 -std=gnu++17 -I"/Library/Frameworks/R.framework/Resources/include" -DNDEBUG -I../inst/include -I'/Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/library/Rcpp/include' -I'/Users/kreutzer/GitHub/Luminescence/Luminescence.BuildResults/Library/RcppArmadillo/include' -I/opt/R/arm64/include -fPIC -falign-functions=64 -Wall -g -O2 -c src_create_RLumDataCurve_matrix.cpp -o src_create_RLumDataCurve_matrix.o -clang++ -arch arm64 -std=gnu++17 -I"/Library/Frameworks/R.framework/Resources/include" -DNDEBUG -I../inst/include -I'/Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/library/Rcpp/include' -I'/Users/kreutzer/GitHub/Luminescence/Luminescence.BuildResults/Library/RcppArmadillo/include' -I/opt/R/arm64/include -fPIC -falign-functions=64 -Wall -g -O2 -c src_get_XSYG_curve_values.cpp -o src_get_XSYG_curve_values.o -clang++ -arch arm64 -std=gnu++17 -dynamiclib -Wl,-headerpad_max_install_names -undefined dynamic_lookup -L/Library/Frameworks/R.framework/Resources/lib -L/opt/R/arm64/lib -o Luminescence.so RcppExports.o create_UID.o src_analyse_IRSARRF_SRS.o src_create_RLumDataCurve_matrix.o src_get_XSYG_curve_values.o -F/Library/Frameworks/R.framework/.. -framework R -Wl,-framework -Wl,CoreFoundation -installing to /Users/kreutzer/GitHub/Luminescence/Luminescence.BuildResults/Luminescence.Rcheck/00LOCK-Luminescence/00new/Luminescence/libs -** R -** data -** inst -** byte-compile and prepare package for lazy loading -** help -*** installing help indices -*** copying figures -** building package indices -** installing vignettes -** testing if installed package can be loaded from temporary location -** checking absolute paths in shared objects and dynamic libraries -** testing if installed package can be loaded from final location -** testing if installed package keeps a record of temporary installation path -* DONE (Luminescence) diff --git a/Luminescence.BuildResults/Luminescence.Rcheck/Luminescence-Ex.R b/Luminescence.BuildResults/Luminescence.Rcheck/Luminescence-Ex.R deleted file mode 100644 index 602fe5f31..000000000 --- a/Luminescence.BuildResults/Luminescence.Rcheck/Luminescence-Ex.R +++ /dev/null @@ -1,5966 +0,0 @@ -pkgname <- "Luminescence" -source(file.path(R.home("share"), "R", "examples-header.R")) -options(warn = 1) -base::assign(".ExTimings", "Luminescence-Ex.timings", pos = 'CheckExEnv') -base::cat("name\tuser\tsystem\telapsed\n", file=base::get(".ExTimings", pos = 'CheckExEnv')) -base::assign(".format_ptime", -function(x) { - if(!is.na(x[4L])) x[1L] <- x[1L] + x[4L] - if(!is.na(x[5L])) x[2L] <- x[2L] + x[5L] - options(OutDec = '.') - format(x[1L:3L], digits = 7L) -}, -pos = 'CheckExEnv') - -### * -library('Luminescence') - -base::assign(".oldSearch", base::search(), pos = 'CheckExEnv') -base::assign(".old_wd", base::getwd(), pos = 'CheckExEnv') -cleanEx() -nameEx("Analyse_SAR.OSLdata") -### * Analyse_SAR.OSLdata - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: Analyse_SAR.OSLdata -### Title: Analyse SAR CW-OSL measurements. -### Aliases: Analyse_SAR.OSLdata -### Keywords: datagen dplot - -### ** Examples - -##load data -data(ExampleData.BINfileData, envir = environment()) - -##analyse data -output <- Analyse_SAR.OSLdata(input.data = CWOSL.SAR.Data, - signal.integral = c(1:5), - background.integral = c(900:1000), - position = c(1:1), - output.plot = TRUE) - -##combine results relevant for further analysis -output.SAR <- data.frame(Dose = output$LnLxTnTx[[1]]$Dose, - LxTx = output$LnLxTnTx[[1]]$LxTx, - LxTx.Error = output$LnLxTnTx[[1]]$LxTx.Error) -output.SAR - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("Analyse_SAR.OSLdata", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("BaseDataSet.ConversionFactors") -### * BaseDataSet.ConversionFactors - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: BaseDataSet.ConversionFactors -### Title: Base data set of dose-rate conversion factors -### Aliases: BaseDataSet.ConversionFactors -### Keywords: datasets - -### ** Examples - - -## Load data -data("BaseDataSet.ConversionFactors", envir = environment()) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("BaseDataSet.ConversionFactors", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("BaseDataSet.CosmicDoseRate") -### * BaseDataSet.CosmicDoseRate - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: BaseDataSet.CosmicDoseRate -### Title: Base data set for cosmic dose rate calculation -### Aliases: BaseDataSet.CosmicDoseRate values.cosmic.Softcomp -### values.factor.Altitude values.par.FJH -### Keywords: datasets - -### ** Examples - - -##load data -data(BaseDataSet.CosmicDoseRate) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("BaseDataSet.CosmicDoseRate", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("BaseDataSet.FractionalGammaDose") -### * BaseDataSet.FractionalGammaDose - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: BaseDataSet.FractionalGammaDose -### Title: Base data set of fractional gamma-dose values -### Aliases: BaseDataSet.FractionalGammaDose -### Keywords: datasets - -### ** Examples - - -## Load data -data("BaseDataSet.FractionalGammaDose", envir = environment()) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("BaseDataSet.FractionalGammaDose", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("BaseDataSet.GrainSizeAttenuation") -### * BaseDataSet.GrainSizeAttenuation - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: BaseDataSet.GrainSizeAttenuation -### Title: Base dataset for grain size attenuation data by Guérin et al. -### (2012) -### Aliases: BaseDataSet.GrainSizeAttenuation -### Keywords: datasets - -### ** Examples - - -## load data -data("BaseDataSet.GrainSizeAttenuation", envir = environment()) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("BaseDataSet.GrainSizeAttenuation", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("CW2pHMi") -### * CW2pHMi - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: CW2pHMi -### Title: Transform a CW-OSL curve into a pHM-OSL curve via interpolation -### under hyperbolic modulation conditions -### Aliases: CW2pHMi -### Keywords: manip - -### ** Examples - - -##(1) - simple transformation - -##load CW-OSL curve data -data(ExampleData.CW_OSL_Curve, envir = environment()) - -##transform values -values.transformed<-CW2pHMi(ExampleData.CW_OSL_Curve) - -##plot -plot(values.transformed$x, values.transformed$y.t, log = "x") - -##(2) - load CW-OSL curve from BIN-file and plot transformed values - -##load BINfile -#BINfileData<-readBIN2R("[path to BIN-file]") -data(ExampleData.BINfileData, envir = environment()) - -##grep first CW-OSL curve from ALQ 1 -curve.ID<-CWOSL.SAR.Data@METADATA[CWOSL.SAR.Data@METADATA[,"LTYPE"]=="OSL" & - CWOSL.SAR.Data@METADATA[,"POSITION"]==1 - ,"ID"] - -curve.HIGH<-CWOSL.SAR.Data@METADATA[CWOSL.SAR.Data@METADATA[,"ID"]==curve.ID[1] - ,"HIGH"] - -curve.NPOINTS<-CWOSL.SAR.Data@METADATA[CWOSL.SAR.Data@METADATA[,"ID"]==curve.ID[1] - ,"NPOINTS"] - -##combine curve to data set - -curve<-data.frame(x = seq(curve.HIGH/curve.NPOINTS,curve.HIGH, - by = curve.HIGH/curve.NPOINTS), - y=unlist(CWOSL.SAR.Data@DATA[curve.ID[1]])) - - -##transform values - -curve.transformed <- CW2pHMi(curve) - -##plot curve -plot(curve.transformed$x, curve.transformed$y.t, log = "x") - - -##(3) - produce Fig. 4 from Bos & Wallinga (2012) - -##load data -data(ExampleData.CW_OSL_Curve, envir = environment()) -values <- CW_Curve.BosWallinga2012 - -##open plot area -plot(NA, NA, - xlim=c(0.001,10), - ylim=c(0,8000), - ylab="pseudo OSL (cts/0.01 s)", - xlab="t [s]", - log="x", - main="Fig. 4 - Bos & Wallinga (2012)") - -values.t<-CW2pLMi(values, P=1/20) -lines(values[1:length(values.t[,1]),1],CW2pLMi(values, P=1/20)[,2], - col="red" ,lwd=1.3) -text(0.03,4500,"LM", col="red" ,cex=.8) - -values.t<-CW2pHMi(values, delta=40) -lines(values[1:length(values.t[,1]),1],CW2pHMi(values, delta=40)[,2], - col="black", lwd=1.3) -text(0.005,3000,"HM", cex=.8) - -values.t<-CW2pPMi(values, P=1/10) -lines(values[1:length(values.t[,1]),1],CW2pPMi(values, P=1/10)[,2], - col="blue", lwd=1.3) -text(0.5,6500,"PM", col="blue" ,cex=.8) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("CW2pHMi", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("CW2pLM") -### * CW2pLM - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: CW2pLM -### Title: Transform a CW-OSL curve into a pLM-OSL curve -### Aliases: CW2pLM -### Keywords: manip - -### ** Examples - - -##read curve from CWOSL.SAR.Data transform curve and plot values -data(ExampleData.BINfileData, envir = environment()) - -##read id for the 1st OSL curve -id.OSL <- CWOSL.SAR.Data@METADATA[CWOSL.SAR.Data@METADATA[,"LTYPE"] == "OSL","ID"] - -##produce x and y (time and count data for the data set) -x<-seq(CWOSL.SAR.Data@METADATA[id.OSL[1],"HIGH"]/CWOSL.SAR.Data@METADATA[id.OSL[1],"NPOINTS"], - CWOSL.SAR.Data@METADATA[id.OSL[1],"HIGH"], - by = CWOSL.SAR.Data@METADATA[id.OSL[1],"HIGH"]/CWOSL.SAR.Data@METADATA[id.OSL[1],"NPOINTS"]) -y <- unlist(CWOSL.SAR.Data@DATA[id.OSL[1]]) -values <- data.frame(x,y) - -##transform values -values.transformed <- CW2pLM(values) - -##plot -plot(values.transformed) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("CW2pLM", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("CW2pLMi") -### * CW2pLMi - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: CW2pLMi -### Title: Transform a CW-OSL curve into a pLM-OSL curve via interpolation -### under linear modulation conditions -### Aliases: CW2pLMi -### Keywords: manip - -### ** Examples - - -##(1) -##load CW-OSL curve data -data(ExampleData.CW_OSL_Curve, envir = environment()) - -##transform values -values.transformed <- CW2pLMi(ExampleData.CW_OSL_Curve) - -##plot -plot(values.transformed$x, values.transformed$y.t, log = "x") - -##(2) - produce Fig. 4 from Bos & Wallinga (2012) -##load data -data(ExampleData.CW_OSL_Curve, envir = environment()) -values <- CW_Curve.BosWallinga2012 - -##open plot area -plot(NA, NA, - xlim = c(0.001,10), - ylim = c(0,8000), - ylab = "pseudo OSL (cts/0.01 s)", - xlab = "t [s]", - log = "x", - main = "Fig. 4 - Bos & Wallinga (2012)") - - -values.t <- CW2pLMi(values, P = 1/20) -lines(values[1:length(values.t[,1]),1],CW2pLMi(values, P = 1/20)[,2], - col = "red", lwd = 1.3) -text(0.03,4500,"LM", col = "red", cex = .8) - -values.t <- CW2pHMi(values, delta = 40) -lines(values[1:length(values.t[,1]),1],CW2pHMi(values, delta = 40)[,2], - col = "black", lwd = 1.3) -text(0.005,3000,"HM", cex =.8) - -values.t <- CW2pPMi(values, P = 1/10) -lines(values[1:length(values.t[,1]),1], CW2pPMi(values, P = 1/10)[,2], - col = "blue", lwd = 1.3) -text(0.5,6500,"PM", col = "blue", cex = .8) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("CW2pLMi", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("CW2pPMi") -### * CW2pPMi - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: CW2pPMi -### Title: Transform a CW-OSL curve into a pPM-OSL curve via interpolation -### under parabolic modulation conditions -### Aliases: CW2pPMi -### Keywords: manip - -### ** Examples - - - -##(1) -##load CW-OSL curve data -data(ExampleData.CW_OSL_Curve, envir = environment()) - -##transform values -values.transformed <- CW2pPMi(ExampleData.CW_OSL_Curve) - -##plot -plot(values.transformed$x,values.transformed$y.t, log = "x") - -##(2) - produce Fig. 4 from Bos & Wallinga (2012) - -##load data -data(ExampleData.CW_OSL_Curve, envir = environment()) -values <- CW_Curve.BosWallinga2012 - -##open plot area -plot(NA, NA, - xlim = c(0.001,10), - ylim = c(0,8000), - ylab = "pseudo OSL (cts/0.01 s)", - xlab = "t [s]", - log = "x", - main = "Fig. 4 - Bos & Wallinga (2012)") - -values.t <- CW2pLMi(values, P = 1/20) -lines(values[1:length(values.t[,1]),1],CW2pLMi(values, P = 1/20)[,2], - col = "red",lwd = 1.3) -text(0.03,4500,"LM", col = "red", cex = .8) - -values.t <- CW2pHMi(values, delta = 40) -lines(values[1:length(values.t[,1]),1], CW2pHMi(values, delta = 40)[,2], - col = "black", lwd = 1.3) -text(0.005,3000,"HM", cex = .8) - -values.t <- CW2pPMi(values, P = 1/10) -lines(values[1:length(values.t[,1]),1], CW2pPMi(values, P = 1/10)[,2], - col = "blue", lwd = 1.3) -text(0.5,6500,"PM", col = "blue", cex = .8) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("CW2pPMi", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("ExampleData.Al2O3C") -### * ExampleData.Al2O3C - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: ExampleData.Al2O3C -### Title: Example Al2O3:C Measurement Data -### Aliases: ExampleData.Al2O3C data_CrossTalk data_ITC -### Keywords: datasets - -### ** Examples - - -##(1) curves -data(ExampleData.Al2O3C, envir = environment()) -plot_RLum(data_ITC[1:2]) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("ExampleData.Al2O3C", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("ExampleData.BINfileData") -### * ExampleData.BINfileData - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: ExampleData.BINfileData -### Title: Example data from a SAR OSL and SAR TL measurement for the -### package Luminescence -### Aliases: ExampleData.BINfileData CWOSL.SAR.Data TL.SAR.Data -### Keywords: datasets - -### ** Examples - - -## show first 5 elements of the METADATA and DATA elements in the terminal -data(ExampleData.BINfileData, envir = environment()) -CWOSL.SAR.Data@METADATA[1:5,] -CWOSL.SAR.Data@DATA[1:5] - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("ExampleData.BINfileData", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("ExampleData.CW_OSL_Curve") -### * ExampleData.CW_OSL_Curve - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: ExampleData.CW_OSL_Curve -### Title: Example CW-OSL curve data for the package Luminescence -### Aliases: ExampleData.CW_OSL_Curve CW_Curve.BosWallinga2012 -### Keywords: datasets - -### ** Examples - - -data(ExampleData.CW_OSL_Curve, envir = environment()) -plot(ExampleData.CW_OSL_Curve) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("ExampleData.CW_OSL_Curve", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("ExampleData.CobbleData") -### * ExampleData.CobbleData - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: ExampleData.CobbleData -### Title: Example data for calc_CobbleDoseRate() -### Aliases: ExampleData.CobbleData -### Keywords: datasets - -### ** Examples - - -## Load data -data("ExampleData.CobbleData", envir = environment()) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("ExampleData.CobbleData", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("ExampleData.DeValues") -### * ExampleData.DeValues - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: ExampleData.DeValues -### Title: Example De data sets for the package Luminescence -### Aliases: ExampleData.DeValues -### Keywords: datasets - -### ** Examples - - -##(1) plot values as histogram -data(ExampleData.DeValues, envir = environment()) -plot_Histogram(ExampleData.DeValues$BT998, xlab = "De [s]") - -##(2) plot values as histogram (with second to gray conversion) -data(ExampleData.DeValues, envir = environment()) - -De.values <- Second2Gray(ExampleData.DeValues$BT998, - dose.rate = c(0.0438, 0.0019)) - - -plot_Histogram(De.values, xlab = "De [Gy]") - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("ExampleData.DeValues", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("ExampleData.Fading") -### * ExampleData.Fading - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: ExampleData.Fading -### Title: Example data for feldspar fading measurements -### Aliases: ExampleData.Fading -### Keywords: datasets - -### ** Examples - - -## Load example data -data("ExampleData.Fading", envir = environment()) - -## Get fading measurement data of the IR50 signal -IR50_fading <- ExampleData.Fading$fading.data$IR50 -head(IR50_fading) - -## Determine g-value and rho' for the IR50 signal -IR50_fading.res <- analyse_FadingMeasurement(IR50_fading) - -## Show g-value and rho' results -gval <- get_RLum(IR50_fading.res) -rhop <- get_RLum(IR50_fading.res, "rho_prime") - -gval -rhop - -## Get LxTx values of the IR50 DE measurement -IR50_De.LxTx <- ExampleData.Fading$equivalentDose.data$IR50 - -## Calculate the De of the IR50 signal -IR50_De <- plot_GrowthCurve(IR50_De.LxTx, - mode = "interpolation", - fit.method = "EXP") - -## Extract the calculated De and its error -IR50_De.res <- get_RLum(IR50_De) -De <- c(IR50_De.res$De, IR50_De.res$De.Error) - -## Apply fading correction (age conversion greatly simplified) -IR50_Age <- De / 7.00 -IR50_Age.corr <- calc_FadingCorr(IR50_Age, g_value = IR50_fading.res) - - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("ExampleData.Fading", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("ExampleData.FittingLM") -### * ExampleData.FittingLM - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: ExampleData.FittingLM -### Title: Example data for fit_LMCurve() in the package Luminescence -### Aliases: ExampleData.FittingLM values.curve values.curveBG - -### ** Examples - - -##show LM data -data(ExampleData.FittingLM, envir = environment()) -plot(values.curve,log="x") - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("ExampleData.FittingLM", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("ExampleData.LxTxData") -### * ExampleData.LxTxData - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: ExampleData.LxTxData -### Title: Example Lx/Tx data from CW-OSL SAR measurement -### Aliases: ExampleData.LxTxData LxTxData - -### ** Examples - - -## plot Lx/Tx data vs dose [s] -data(ExampleData.LxTxData, envir = environment()) -plot(LxTxData$Dose,LxTxData$LxTx) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("ExampleData.LxTxData", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("ExampleData.LxTxOSLData") -### * ExampleData.LxTxOSLData - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: ExampleData.LxTxOSLData -### Title: Example Lx and Tx curve data from an artificial OSL measurement -### Aliases: ExampleData.LxTxOSLData Lx.data Tx.data - -### ** Examples - - -##load data -data(ExampleData.LxTxOSLData, envir = environment()) - -##plot data -plot(Lx.data) -plot(Tx.data) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("ExampleData.LxTxOSLData", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("ExampleData.MortarData") -### * ExampleData.MortarData - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: ExampleData.MortarData -### Title: Example equivalent dose data from mortar samples -### Aliases: ExampleData.MortarData MortarData - -### ** Examples - - -##load data -data(ExampleData.MortarData, envir = environment()) - -##plot data -plot(MortarData) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("ExampleData.MortarData", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("ExampleData.RLum.Analysis") -### * ExampleData.RLum.Analysis - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: ExampleData.RLum.Analysis -### Title: Example data as RLum.Analysis objects -### Aliases: ExampleData.RLum.Analysis IRSAR.RF.Data -### Keywords: datasets - -### ** Examples - - -##load data -data(ExampleData.RLum.Analysis, envir = environment()) - -##plot data -plot_RLum(IRSAR.RF.Data) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("ExampleData.RLum.Analysis", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("ExampleData.RLum.Data.Image") -### * ExampleData.RLum.Data.Image - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: ExampleData.RLum.Data.Image -### Title: Example data as RLum.Data.Image objects -### Aliases: ExampleData.RLum.Data.Image -### Keywords: datasets - -### ** Examples - - -##load data -data(ExampleData.RLum.Data.Image, envir = environment()) - -##plot data -plot_RLum(ExampleData.RLum.Data.Image) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("ExampleData.RLum.Data.Image", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("ExampleData.ScaleGammaDose") -### * ExampleData.ScaleGammaDose - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: ExampleData.ScaleGammaDose -### Title: Example data for scale_GammaDose() -### Aliases: ExampleData.ScaleGammaDose -### Keywords: datasets - -### ** Examples - - -## Load data -data("ExampleData.ScaleGammaDose", envir = environment()) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("ExampleData.ScaleGammaDose", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("ExampleData.SurfaceExposure") -### * ExampleData.SurfaceExposure - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: ExampleData.SurfaceExposure -### Title: Example OSL surface exposure dating data -### Aliases: ExampleData.SurfaceExposure -### Keywords: datasets - -### ** Examples - - -## ExampleData.SurfaceExposure$sample_1 -sigmaphi <- 5e-10 -age <- 10000 -mu <- 0.9 -x <- seq(0, 10, 0.1) -fun <- exp(-sigmaphi * age * 365.25*24*3600 * exp(-mu * x)) - -set.seed(666) -synth_1 <- data.frame(depth = x, - intensity = jitter(fun, 1, 0.1), - error = runif(length(x), 0.01, 0.2)) - -## VALIDATE sample_1 -fit_SurfaceExposure(synth_1, mu = mu, sigmaphi = sigmaphi) - - - - -## ExampleData.SurfaceExposure$sample_2 -sigmaphi <- 5e-10 -age <- 10000 -mu <- 0.9 -x <- seq(0, 10, 0.1) -Ddot <- 2.5 / 1000 / 365.25 / 24 / 60 / 60 # 2.5 Gy/ka in Seconds -D0 <- 40 -fun <- (sigmaphi * exp(-mu * x) * - exp(-(age * 365.25*24*3600) * - (sigmaphi * exp(-mu * x) + Ddot/D0)) + Ddot/D0) / - (sigmaphi * exp(-mu * x) + Ddot/D0) - -set.seed(666) -synth_2 <- data.frame(depth = x, - intensity = jitter(fun, 1, 0.1), - error = runif(length(x), 0.01, 0.2)) - -## VALIDATE sample_2 -fit_SurfaceExposure(synth_2, mu = mu, sigmaphi = sigmaphi, Ddot = 2.5, D0 = D0) - - - -## ExampleData.SurfaceExposure$set_1 -sigmaphi <- 5e-10 -mu <- 0.9 -x <- seq(0, 15, 0.2) -age <- c(1e3, 1e4, 1e5, 1e6) -set.seed(666) - -synth_3 <- vector("list", length = length(age)) - -for (i in 1:length(age)) { - fun <- exp(-sigmaphi * age[i] * 365.25*24*3600 * exp(-mu * x)) - synth_3[[i]] <- data.frame(depth = x, - intensity = jitter(fun, 1, 0.05)) -} - - -## VALIDATE set_1 -fit_SurfaceExposure(synth_3, age = age, sigmaphi = sigmaphi) - - - -## ExampleData.SurfaceExposure$set_2 -sigmaphi <- 5e-10 -mu <- 0.9 -x <- seq(0, 15, 0.2) -age <- c(1e2, 1e3, 1e4, 1e5, 1e6) -Ddot <- 1.0 / 1000 / 365.25 / 24 / 60 / 60 # 2.0 Gy/ka in Seconds -D0 <- 40 -set.seed(666) - -synth_4 <- vector("list", length = length(age)) - -for (i in 1:length(age)) { - fun <- (sigmaphi * exp(-mu * x) * - exp(-(age[i] * 365.25*24*3600) * - (sigmaphi * exp(-mu * x) + Ddot/D0)) + Ddot/D0) / - (sigmaphi * exp(-mu * x) + Ddot/D0) - - synth_4[[i]] <- data.frame(depth = x, - intensity = jitter(fun, 1, 0.05)) -} - - -## VALIDATE set_2 -fit_SurfaceExposure(synth_4, age = age, sigmaphi = sigmaphi, D0 = D0, Ddot = 1.0) - -## Not run: -##D ExampleData.SurfaceExposure <- list( -##D sample_1 = synth_1, -##D sample_2 = synth_2, -##D set_1 = synth_3, -##D set_2 = synth_4 -##D ) -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("ExampleData.SurfaceExposure", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("ExampleData.TR_OSL") -### * ExampleData.TR_OSL - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: ExampleData.TR_OSL -### Title: Example TR-OSL data -### Aliases: ExampleData.TR_OSL -### Keywords: datasets - -### ** Examples - - -##(1) curves -data(ExampleData.TR_OSL, envir = environment()) -plot_RLum(ExampleData.TR_OSL) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("ExampleData.TR_OSL", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("ExampleData.XSYG") -### * ExampleData.XSYG - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: ExampleData.XSYG -### Title: Example data for a SAR OSL measurement and a TL spectrum using a -### lexsyg reader -### Aliases: ExampleData.XSYG OSL.SARMeasurement TL.Spectrum -### Keywords: datasets - -### ** Examples - -##show data -data(ExampleData.XSYG, envir = environment()) - -## ========================================= -##(1) OSL.SARMeasurement -OSL.SARMeasurement - -##show $Sequence.Object -OSL.SARMeasurement$Sequence.Object - -##grep OSL curves and plot the first curve -OSLcurve <- get_RLum(OSL.SARMeasurement$Sequence.Object, -recordType="OSL")[[1]] -plot_RLum(OSLcurve) - -## ========================================= -##(2) TL.Spectrum -TL.Spectrum - -##plot simple spectrum (2D) -plot_RLum.Data.Spectrum(TL.Spectrum, - plot.type="contour", - xlim = c(310,750), - ylim = c(0,300), - bin.rows=10, - bin.cols = 1) - -##plot 3d spectrum (uncomment for usage) -# plot_RLum.Data.Spectrum(TL.Spectrum, plot.type="persp", -# xlim = c(310,750), ylim = c(0,300), bin.rows=10, -# bin.cols = 1) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("ExampleData.XSYG", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("ExampleData.portableOSL") -### * ExampleData.portableOSL - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: ExampleData.portableOSL -### Title: Example portable OSL curve data for the package Luminescence -### Aliases: ExampleData.portableOSL -### Keywords: datasets - -### ** Examples - - -data(ExampleData.portableOSL, envir = environment()) -plot_RLum(ExampleData.portableOSL) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("ExampleData.portableOSL", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("GitHub-API") -### * GitHub-API - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: GitHub-API -### Title: GitHub API -### Aliases: GitHub-API github_commits github_branches github_issues - -### ** Examples - - -## Not run: -##D github_branches(user = "r-lum", repo = "luminescence") -##D github_issues(user = "r-lum", repo = "luminescence") -##D github_commits(user = "r-lum", repo = "luminescence", branch = "master", n = 10) -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("GitHub-API", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("PSL2Risoe.BINfileData") -### * PSL2Risoe.BINfileData - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: PSL2Risoe.BINfileData -### Title: Convert portable OSL data to a Risoe.BINfileData object -### Aliases: PSL2Risoe.BINfileData -### Keywords: IO - -### ** Examples - - -# (1) load and plot example data set -data("ExampleData.portableOSL", envir = environment()) -plot_RLum(ExampleData.portableOSL) - -# (2) merge all RLum.Analysis objects into one -merged <- merge_RLum(ExampleData.portableOSL) -merged - -# (3) convert to RisoeBINfile object -bin <- PSL2Risoe.BINfileData(merged) -bin - -# (4) write Risoe BIN file -## Not run: -##D write_R2BIN(bin, "~/portableOSL.binx") -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("PSL2Risoe.BINfileData", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("RLum-class") -### * RLum-class - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: RLum-class -### Title: Class '"RLum"' -### Aliases: RLum-class replicate_RLum,RLum-method -### Keywords: classes - -### ** Examples - - -showClass("RLum") - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("RLum-class", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("RLum.Analysis-class") -### * RLum.Analysis-class - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: RLum.Analysis-class -### Title: Class '"RLum.Analysis"' -### Aliases: RLum.Analysis-class show,RLum.Analysis-method -### set_RLum,RLum.Analysis-method get_RLum,RLum.Analysis-method -### structure_RLum,RLum.Analysis-method length_RLum,RLum.Analysis-method -### names_RLum,RLum.Analysis-method smooth_RLum,RLum.Analysis-method -### Keywords: classes internal methods - -### ** Examples - - -showClass("RLum.Analysis") - -##set empty object -set_RLum(class = "RLum.Analysis") - -###use example data -##load data -data(ExampleData.RLum.Analysis, envir = environment()) - -##show curves in object -get_RLum(IRSAR.RF.Data) - -##show only the first object, but by keeping the object -get_RLum(IRSAR.RF.Data, record.id = 1, drop = FALSE) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("RLum.Analysis-class", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("RLum.Data-class") -### * RLum.Data-class - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: RLum.Data-class -### Title: Class '"RLum.Data"' -### Aliases: RLum.Data-class -### Keywords: classes internal - -### ** Examples - - -showClass("RLum.Data") - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("RLum.Data-class", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("RLum.Data.Curve-class") -### * RLum.Data.Curve-class - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: RLum.Data.Curve-class -### Title: Class '"RLum.Data.Curve"' -### Aliases: RLum.Data.Curve-class show,RLum.Data.Curve-method -### set_RLum,RLum.Data.Curve-method get_RLum,RLum.Data.Curve-method -### length_RLum,RLum.Data.Curve-method names_RLum,RLum.Data.Curve-method -### bin_RLum.Data,RLum.Data.Curve-method -### smooth_RLum,RLum.Data.Curve-method -### Keywords: classes internal - -### ** Examples - - -showClass("RLum.Data.Curve") - -##set empty curve object -set_RLum(class = "RLum.Data.Curve") - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("RLum.Data.Curve-class", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("RLum.Data.Image-class") -### * RLum.Data.Image-class - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: RLum.Data.Image-class -### Title: Class '"RLum.Data.Image"' -### Aliases: RLum.Data.Image-class show,RLum.Data.Image-method -### set_RLum,RLum.Data.Image-method get_RLum,RLum.Data.Image-method -### names_RLum,RLum.Data.Image-method -### Keywords: classes internal - -### ** Examples - - -showClass("RLum.Data.Image") - -##create empty RLum.Data.Image object -set_RLum(class = "RLum.Data.Image") - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("RLum.Data.Image-class", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("RLum.Data.Spectrum-class") -### * RLum.Data.Spectrum-class - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: RLum.Data.Spectrum-class -### Title: Class '"RLum.Data.Spectrum"' -### Aliases: RLum.Data.Spectrum-class show,RLum.Data.Spectrum-method -### set_RLum,RLum.Data.Spectrum-method get_RLum,RLum.Data.Spectrum-method -### names_RLum,RLum.Data.Spectrum-method -### bin_RLum.Data,RLum.Data.Spectrum-method -### Keywords: classes internal - -### ** Examples - - -showClass("RLum.Data.Spectrum") - -##show example data -data(ExampleData.XSYG, envir = environment()) -TL.Spectrum - -##show data matrix -get_RLum(TL.Spectrum) - -##plot spectrum -## Not run: -##D plot_RLum(TL.Spectrum) -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("RLum.Data.Spectrum-class", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("RLum.Results-class") -### * RLum.Results-class - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: RLum.Results-class -### Title: Class '"RLum.Results"' -### Aliases: RLum.Results-class show,RLum.Results-method -### set_RLum,RLum.Results-method get_RLum,RLum.Results-method -### length_RLum,RLum.Results-method names_RLum,RLum.Results-method -### Keywords: classes internal methods - -### ** Examples - - -showClass("RLum.Results") - -##create an empty object from this class -set_RLum(class = "RLum.Results") - -##use another function to show how it works - -##Basic calculation of the dose rate for a specific date - dose.rate <- calc_SourceDoseRate( - measurement.date = "2012-01-27", - calib.date = "2014-12-19", - calib.dose.rate = 0.0438, - calib.error = 0.0019) - -##show object -dose.rate - -##get results -get_RLum(dose.rate) - -##get parameters used for the calcualtion from the same object -get_RLum(dose.rate, data.object = "parameters") - -##alternatively objects can be accessed using S3 generics, such as -dose.rate$parameters - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("RLum.Results-class", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("Risoe.BINfileData-class") -### * Risoe.BINfileData-class - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: Risoe.BINfileData-class -### Title: Class '"Risoe.BINfileData"' -### Aliases: Risoe.BINfileData-class show,Risoe.BINfileData-method -### set_Risoe.BINfileData,ANY-method -### get_Risoe.BINfileData,Risoe.BINfileData-method -### Keywords: classes internal - -### ** Examples - - -showClass("Risoe.BINfileData") - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("Risoe.BINfileData-class", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("Risoe.BINfileData2RLum.Analysis") -### * Risoe.BINfileData2RLum.Analysis - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: Risoe.BINfileData2RLum.Analysis -### Title: Convert Risoe.BINfileData object to an RLum.Analysis object -### Aliases: Risoe.BINfileData2RLum.Analysis -### Keywords: manip - -### ** Examples - - -##load data -data(ExampleData.BINfileData, envir = environment()) - -##convert values for position 1 -Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = 1) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("Risoe.BINfileData2RLum.Analysis", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("Second2Gray") -### * Second2Gray - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: Second2Gray -### Title: Converting equivalent dose values from seconds (s) to Gray (Gy) -### Aliases: Second2Gray -### Keywords: manip - -### ** Examples - - -##(A) for known source dose rate at date of measurement -## - load De data from the example data help file -data(ExampleData.DeValues, envir = environment()) -## - convert De(s) to De(Gy) -Second2Gray(ExampleData.DeValues$BT998, c(0.0438,0.0019)) - - - - - -##(B) for source dose rate calibration data -## - calculate source dose rate first -dose.rate <- calc_SourceDoseRate(measurement.date = "2012-01-27", - calib.date = "2014-12-19", - calib.dose.rate = 0.0438, - calib.error = 0.0019) -# read example data -data(ExampleData.DeValues, envir = environment()) - -# apply dose.rate to convert De(s) to De(Gy) -Second2Gray(ExampleData.DeValues$BT998, dose.rate) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("Second2Gray", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("analyse_Al2O3C_CrossTalk") -### * analyse_Al2O3C_CrossTalk - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: analyse_Al2O3C_CrossTalk -### Title: Al2O3:C Reader Cross Talk Analysis -### Aliases: analyse_Al2O3C_CrossTalk -### Keywords: datagen - -### ** Examples - - -##load data -data(ExampleData.Al2O3C, envir = environment()) - -##run analysis -analyse_Al2O3C_CrossTalk(data_CrossTalk) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("analyse_Al2O3C_CrossTalk", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("analyse_Al2O3C_ITC") -### * analyse_Al2O3C_ITC - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: analyse_Al2O3C_ITC -### Title: Al2O3 Irradiation Time Correction Analysis -### Aliases: analyse_Al2O3C_ITC -### Keywords: datagen - -### ** Examples - - -##load data -data(ExampleData.Al2O3C, envir = environment()) - -##run analysis -analyse_Al2O3C_ITC(data_ITC) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("analyse_Al2O3C_ITC", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("analyse_Al2O3C_Measurement") -### * analyse_Al2O3C_Measurement - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: analyse_Al2O3C_Measurement -### Title: Al2O3:C Passive Dosimeter Measurement Analysis -### Aliases: analyse_Al2O3C_Measurement -### Keywords: datagen - -### ** Examples - -##load data -data(ExampleData.Al2O3C, envir = environment()) - -##run analysis -analyse_Al2O3C_Measurement(data_CrossTalk) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("analyse_Al2O3C_Measurement", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("analyse_FadingMeasurement") -### * analyse_FadingMeasurement - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: analyse_FadingMeasurement -### Title: Analyse fading measurements and returns the fading rate per -### decade (g-value) -### Aliases: analyse_FadingMeasurement -### Keywords: datagen - -### ** Examples - - -## load example data (sample UNIL/NB123, see ?ExampleData.Fading) -data("ExampleData.Fading", envir = environment()) - -##(1) get fading measurement data (here a three column data.frame) -fading_data <- ExampleData.Fading$fading.data$IR50 - -##(2) run analysis -g_value <- analyse_FadingMeasurement( -fading_data, -plot = TRUE, -verbose = TRUE, -n.MC = 10) - -##(3) this can be further used in the function -## to correct the age according to Huntley & Lamothe, 2001 -results <- calc_FadingCorr( -age.faded = c(100,2), -g_value = g_value, -n.MC = 10) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("analyse_FadingMeasurement", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("analyse_IRSAR.RF") -### * analyse_IRSAR.RF - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: analyse_IRSAR.RF -### Title: Analyse IRSAR RF measurements -### Aliases: analyse_IRSAR.RF -### Keywords: datagen - -### ** Examples - - -##load data -data(ExampleData.RLum.Analysis, envir = environment()) - -##(1) perform analysis using the method 'FIT' -results <- analyse_IRSAR.RF(object = IRSAR.RF.Data) - -##show De results and test paramter results -get_RLum(results, data.object = "data") -get_RLum(results, data.object = "test_parameters") - -##(2) perform analysis using the method 'SLIDE' -results <- analyse_IRSAR.RF(object = IRSAR.RF.Data, method = "SLIDE", n.MC = 1) - -## Not run: -##D ##(3) perform analysis using the method 'SLIDE' and method control option -##D ## 'trace -##D results <- analyse_IRSAR.RF( -##D object = IRSAR.RF.Data, -##D method = "SLIDE", -##D method.control = list(trace = TRUE)) -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("analyse_IRSAR.RF", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("analyse_SAR.CWOSL") -### * analyse_SAR.CWOSL - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: analyse_SAR.CWOSL -### Title: Analyse SAR CW-OSL measurements -### Aliases: analyse_SAR.CWOSL -### Keywords: datagen plot - -### ** Examples - - -##load data -##ExampleData.BINfileData contains two BINfileData objects -##CWOSL.SAR.Data and TL.SAR.Data -data(ExampleData.BINfileData, envir = environment()) - -##transform the values from the first position in a RLum.Analysis object -object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) - -##perform SAR analysis and set rejection criteria -results <- analyse_SAR.CWOSL( -object = object, -signal.integral.min = 1, -signal.integral.max = 2, -background.integral.min = 900, -background.integral.max = 1000, -log = "x", -fit.method = "EXP", -rejection.criteria = list( - recycling.ratio = 10, - recuperation.rate = 10, - testdose.error = 10, - palaeodose.error = 10, - recuperation_reference = "Natural", - exceed.max.regpoint = TRUE) -) - -##show De results -get_RLum(results) - -##show LnTnLxTx table -get_RLum(results, data.object = "LnLxTnTx.table") - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("analyse_SAR.CWOSL", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("analyse_SAR.TL") -### * analyse_SAR.TL - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: analyse_SAR.TL -### Title: Analyse SAR TL measurements -### Aliases: analyse_SAR.TL -### Keywords: datagen plot - -### ** Examples - - -##load data -data(ExampleData.BINfileData, envir = environment()) - -##transform the values from the first position in a RLum.Analysis object -object <- Risoe.BINfileData2RLum.Analysis(TL.SAR.Data, pos=3) - -##perform analysis -analyse_SAR.TL( - object = object, - signal.integral.min = 210, - signal.integral.max = 220, - fit.method = "EXP OR LIN", - sequence.structure = c("SIGNAL", "BACKGROUND")) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("analyse_SAR.TL", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("analyse_baSAR") -### * analyse_baSAR - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: analyse_baSAR -### Title: Bayesian models (baSAR) applied on luminescence data -### Aliases: analyse_baSAR -### Keywords: datagen - -### ** Examples - - -##(1) load package test data set -data(ExampleData.BINfileData, envir = environment()) - -##(2) selecting relevant curves, and limit dataset -CWOSL.SAR.Data <- subset( - CWOSL.SAR.Data, - subset = POSITION%in%c(1:3) & LTYPE == "OSL") - -## Not run: -##D ##(3) run analysis -##D ##please not that the here selected parameters are -##D ##choosen for performance, not for reliability -##D results <- analyse_baSAR( -##D object = CWOSL.SAR.Data, -##D source_doserate = c(0.04, 0.001), -##D signal.integral = c(1:2), -##D background.integral = c(80:100), -##D fit.method = "LIN", -##D plot = FALSE, -##D n.MCMC = 200 -##D -##D ) -##D -##D print(results) -##D -##D -##D ##XLS_file template -##D ##copy and paste this the code below in the terminal -##D ##you can further use the function write.csv() to export the example -##D -##D XLS_file <- -##D structure( -##D list( -##D BIN_FILE = NA_character_, -##D DISC = NA_real_, -##D GRAIN = NA_real_), -##D .Names = c("BIN_FILE", "DISC", "GRAIN"), -##D class = "data.frame", -##D row.names = 1L -##D ) -##D -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("analyse_baSAR", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("analyse_pIRIRSequence") -### * analyse_pIRIRSequence - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: analyse_pIRIRSequence -### Title: Analyse post-IR IRSL measurement sequences -### Aliases: analyse_pIRIRSequence -### Keywords: datagen plot - -### ** Examples - - - -### NOTE: For this example existing example data are used. These data are non pIRIR data. -### -##(1) Compile example data set based on existing example data (SAR quartz measurement) -##(a) Load example data -data(ExampleData.BINfileData, envir = environment()) - -##(b) Transform the values from the first position in a RLum.Analysis object -object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) - -##(c) Grep curves and exclude the last two (one TL and one IRSL) -object <- get_RLum(object, record.id = c(-29,-30)) - -##(d) Define new sequence structure and set new RLum.Analysis object -sequence.structure <- c(1,2,2,3,4,4) -sequence.structure <- as.vector(sapply(seq(0,length(object)-1,by = 4), - function(x){sequence.structure + x})) - -object <- sapply(1:length(sequence.structure), function(x){ - - object[[sequence.structure[x]]] - -}) - -object <- set_RLum(class = "RLum.Analysis", records = object, protocol = "pIRIR") - -##(2) Perform pIRIR analysis (for this example with quartz OSL data!) -## Note: output as single plots to avoid problems with this example -results <- analyse_pIRIRSequence(object, - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - fit.method = "EXP", - sequence.structure = c("TL", "pseudoIRSL1", "pseudoIRSL2"), - main = "Pseudo pIRIR data set based on quartz OSL", - plot.single = TRUE) - - -##(3) Perform pIRIR analysis (for this example with quartz OSL data!) -## Alternative for PDF output, uncomment and complete for usage -## Not run: -##D tempfile <- tempfile(fileext = ".pdf") -##D pdf(file = tempfile, height = 15, width = 15) -##D results <- analyse_pIRIRSequence(object, -##D signal.integral.min = 1, -##D signal.integral.max = 2, -##D background.integral.min = 900, -##D background.integral.max = 1000, -##D fit.method = "EXP", -##D main = "Pseudo pIRIR data set based on quartz OSL") -##D -##D dev.off() -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("analyse_pIRIRSequence", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("analyse_portableOSL") -### * analyse_portableOSL - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: analyse_portableOSL -### Title: Analyse portable CW-OSL measurements -### Aliases: analyse_portableOSL -### Keywords: datagen plot - -### ** Examples - - -## example profile plot -# (1) load example data set -data("ExampleData.portableOSL", envir = environment()) - -# (2) merge and plot all RLum.Analysis objects -merged <- merge_RLum(ExampleData.portableOSL) -plot_RLum( - object = merged, - combine = TRUE, - records_max = 5, - legend.pos = "outside") -merged - -# (3) analyse and plot -results <- analyse_portableOSL( - merged, - signal.integral = 1:5, - invert = FALSE, - normalise = TRUE) -get_RLum(results) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("analyse_portableOSL", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("apply_CosmicRayRemoval") -### * apply_CosmicRayRemoval - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: apply_CosmicRayRemoval -### Title: Function to remove cosmic rays from an RLum.Data.Spectrum S4 -### class object -### Aliases: apply_CosmicRayRemoval -### Keywords: manip - -### ** Examples - - -##(1) - use with your own data and combine (uncomment for usage) -## run two times the default method and smooth with another method -## your.spectrum <- apply_CosmicRayRemoval(your.spectrum, method = "Pych") -## your.spectrum <- apply_CosmicRayRemoval(your.spectrum, method = "Pych") -## your.spectrum <- apply_CosmicRayRemoval(your.spectrum, method = "smooth") - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("apply_CosmicRayRemoval", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("apply_EfficiencyCorrection") -### * apply_EfficiencyCorrection - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: apply_EfficiencyCorrection -### Title: Function to apply spectral efficiency correction to -### RLum.Data.Spectrum S4 class objects -### Aliases: apply_EfficiencyCorrection -### Keywords: manip - -### ** Examples - - -##(1) - use with your own data (uncomment for usage) -## spectral.efficiency <- read.csv("your data") -## -## your.spectrum <- apply_EfficiencyCorrection(your.spectrum, ) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("apply_EfficiencyCorrection", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("bin_RLum.Data") -### * bin_RLum.Data - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: bin_RLum.Data -### Title: Channel binning - method dispatcher -### Aliases: bin_RLum.Data -### Keywords: utilities - -### ** Examples - - -##load example data -data(ExampleData.CW_OSL_Curve, envir = environment()) - -##create RLum.Data.Curve object from this example -curve <- - set_RLum( - class = "RLum.Data.Curve", - recordType = "OSL", - data = as.matrix(ExampleData.CW_OSL_Curve) - ) - -##plot data without and with 2 and 4 channel binning -plot_RLum(curve) -plot_RLum(bin_RLum.Data(curve, bin_size = 2)) -plot_RLum(bin_RLum.Data(curve, bin_size = 4)) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("bin_RLum.Data", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_AliquotSize") -### * calc_AliquotSize - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_AliquotSize -### Title: Estimate the amount of grains on an aliquot -### Aliases: calc_AliquotSize - -### ** Examples - - -## Estimate the amount of grains on a small aliquot -calc_AliquotSize(grain.size = c(100,150), sample.diameter = 1, MC.iter = 100) - -## Calculate the mean packing density of large aliquots -calc_AliquotSize(grain.size = c(100,200), sample.diameter = 8, - grains.counted = c(2525,2312,2880), MC.iter = 100) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_AliquotSize", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_AverageDose") -### * calc_AverageDose - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_AverageDose -### Title: Calculate the Average Dose and the dose rate dispersion -### Aliases: calc_AverageDose -### Keywords: datagen - -### ** Examples - - -##Example 01 using package example data -##load example data -data(ExampleData.DeValues, envir = environment()) - -##calculate Average dose -##(use only the first 56 values here) -AD <- calc_AverageDose(ExampleData.DeValues$CA1[1:56,], sigma_m = 0.1) - -##plot De and set Average dose as central value -plot_AbanicoPlot( - data = ExampleData.DeValues$CA1[1:56,], - z.0 = AD$summary$AVERAGE_DOSE) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_AverageDose", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_CentralDose") -### * calc_CentralDose - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_CentralDose -### Title: Apply the central age model (CAM) after Galbraith et al. (1999) -### to a given De distribution -### Aliases: calc_CentralDose - -### ** Examples - - -##load example data -data(ExampleData.DeValues, envir = environment()) - -##apply the central dose model -calc_CentralDose(ExampleData.DeValues$CA1) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_CentralDose", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_CobbleDoseRate") -### * calc_CobbleDoseRate - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_CobbleDoseRate -### Title: Calculate dose rate of slices in a spherical cobble -### Aliases: calc_CobbleDoseRate -### Keywords: datagen - -### ** Examples - -## load example data -data("ExampleData.CobbleData", envir = environment()) - -## run function -calc_CobbleDoseRate(ExampleData.CobbleData) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_CobbleDoseRate", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_CommonDose") -### * calc_CommonDose - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_CommonDose -### Title: Apply the (un-)logged common age model after Galbraith et al. -### (1999) to a given De distribution -### Aliases: calc_CommonDose - -### ** Examples - - -## load example data -data(ExampleData.DeValues, envir = environment()) - -## apply the common dose model -calc_CommonDose(ExampleData.DeValues$CA1) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_CommonDose", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_CosmicDoseRate") -### * calc_CosmicDoseRate - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_CosmicDoseRate -### Title: Calculate the cosmic dose rate -### Aliases: calc_CosmicDoseRate - -### ** Examples - - -##(1) calculate cosmic dose rate (one absorber) -calc_CosmicDoseRate(depth = 2.78, density = 1.7, - latitude = 38.06451, longitude = 1.49646, - altitude = 364, error = 10) - -##(2a) calculate cosmic dose rate (two absorber) -calc_CosmicDoseRate(depth = c(5.0, 2.78), density = c(2.65, 1.7), - latitude = 38.06451, longitude = 1.49646, - altitude = 364, error = 10) - -##(2b) calculate cosmic dose rate (two absorber) and -##correct for geomagnetic field changes -calc_CosmicDoseRate(depth = c(5.0, 2.78), density = c(2.65, 1.7), - latitude = 12.04332, longitude = 4.43243, - altitude = 364, corr.fieldChanges = TRUE, - est.age = 67, error = 15) - - -##(3) calculate cosmic dose rate and export results to .csv file -#calculate cosmic dose rate and save to variable -results<- calc_CosmicDoseRate(depth = 2.78, density = 1.7, - latitude = 38.06451, longitude = 1.49646, - altitude = 364, error = 10) - -# the results can be accessed by -get_RLum(results, "summary") - -#export results to .csv file - uncomment for usage -#write.csv(results, file = "c:/users/public/results.csv") - -##(4) calculate cosmic dose rate for 6 samples from the same profile -## and save to .csv file -#calculate cosmic dose rate and save to variable -results<- calc_CosmicDoseRate(depth = c(0.1, 0.5 , 2.1, 2.7, 4.2, 6.3), - density = 1.7, latitude = 38.06451, - longitude = 1.49646, altitude = 364, - error = 10) - -#export results to .csv file - uncomment for usage -#write.csv(results, file = "c:/users/public/results_profile.csv") - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_CosmicDoseRate", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_FadingCorr") -### * calc_FadingCorr - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_FadingCorr -### Title: Fading Correction after Huntley & Lamothe (2001) -### Aliases: calc_FadingCorr -### Keywords: datagen - -### ** Examples - - -##run the examples given in the appendix of Huntley and Lamothe, 2001 - -##(1) faded age: 100 a -results <- calc_FadingCorr( - age.faded = c(0.1,0), - g_value = c(5.0, 1.0), - tc = 2592000, - tc.g_value = 172800, - n.MC = 100) - -##(2) faded age: 1 ka -results <- calc_FadingCorr( - age.faded = c(1,0), - g_value = c(5.0, 1.0), - tc = 2592000, - tc.g_value = 172800, - n.MC = 100) - -##(3) faded age: 10.0 ka -results <- calc_FadingCorr( - age.faded = c(10,0), - g_value = c(5.0, 1.0), - tc = 2592000, - tc.g_value = 172800, - n.MC = 100) - -##access the last output -get_RLum(results) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_FadingCorr", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_FastRatio") -### * calc_FastRatio - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_FastRatio -### Title: Calculate the Fast Ratio for CW-OSL curves -### Aliases: calc_FastRatio - -### ** Examples - -# load example CW-OSL curve -data("ExampleData.CW_OSL_Curve") - -# calculate the fast ratio w/o further adjustments -res <- calc_FastRatio(ExampleData.CW_OSL_Curve) - -# show the summary table -get_RLum(res) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_FastRatio", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_FiniteMixture") -### * calc_FiniteMixture - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_FiniteMixture -### Title: Apply the finite mixture model (FMM) after Galbraith (2005) to a -### given De distribution -### Aliases: calc_FiniteMixture - -### ** Examples - - -## load example data -data(ExampleData.DeValues, envir = environment()) - -## (1) apply the finite mixture model -## NOTE: the data set is not suitable for the finite mixture model, -## which is why a very small sigmab is necessary -calc_FiniteMixture(ExampleData.DeValues$CA1, - sigmab = 0.2, n.components = 2, - grain.probability = TRUE) - -## (2) repeat the finite mixture model for 2, 3 and 4 maximum number of fitted -## components and save results -## NOTE: The following example is computationally intensive. Please un-comment -## the following lines to make the example work. -FMM<- calc_FiniteMixture(ExampleData.DeValues$CA1, - sigmab = 0.2, n.components = c(2:4), - pdf.weight = TRUE, dose.scale = c(0, 100)) - -## show structure of the results -FMM - -## show the results on equivalent dose, standard error and proportion of -## fitted components -get_RLum(object = FMM, data.object = "components") - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_FiniteMixture", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_FuchsLang2001") -### * calc_FuchsLang2001 - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_FuchsLang2001 -### Title: Apply the model after Fuchs & Lang (2001) to a given De -### distribution. -### Aliases: calc_FuchsLang2001 -### Keywords: dplot - -### ** Examples - -## load example data -data(ExampleData.DeValues, envir = environment()) - -## calculate De according to Fuchs & Lang (2001) -temp<- calc_FuchsLang2001(ExampleData.DeValues$BT998, cvThreshold = 5) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_FuchsLang2001", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_HomogeneityTest") -### * calc_HomogeneityTest - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_HomogeneityTest -### Title: Apply a simple homogeneity test after Galbraith (2003) -### Aliases: calc_HomogeneityTest - -### ** Examples - - -## load example data -data(ExampleData.DeValues, envir = environment()) - -## apply the homogeneity test -calc_HomogeneityTest(ExampleData.DeValues$BT998) - -## using the data presented by Galbraith (2003) -df <- - data.frame( - x = c(30.1, 53.8, 54.3, 29.0, 47.6, 44.2, 43.1), - y = c(4.8, 7.1, 6.8, 4.3, 5.2, 5.9, 3.0)) - -calc_HomogeneityTest(df) - - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_HomogeneityTest", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_Huntley2006") -### * calc_Huntley2006 - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_Huntley2006 -### Title: Apply the Huntley (2006) model -### Aliases: calc_Huntley2006 -### Keywords: datagen - -### ** Examples - - -## Load example data (sample UNIL/NB123, see ?ExampleData.Fading) -data("ExampleData.Fading", envir = environment()) - -## (1) Set all relevant parameters -# a. fading measurement data (IR50) -fading_data <- ExampleData.Fading$fading.data$IR50 - -# b. Dose response curve data -data <- ExampleData.Fading$equivalentDose.data$IR50 - -## (2) Define required function parameters -ddot <- c(7.00, 0.004) -readerDdot <- c(0.134, 0.0067) - -# Analyse fading measurement and get an estimate of rho'. -# Note that the RLum.Results object can be directly used for further processing. -# The number of MC runs is reduced for this example -rhop <- analyse_FadingMeasurement(fading_data, plot = TRUE, verbose = FALSE, n.MC = 10) - -## (3) Apply the Kars et al. (2008) model to the data -kars <- calc_Huntley2006( - data = data, - rhop = rhop, - ddot = ddot, - readerDdot = readerDdot, - n.MC = 25) - - -## Not run: -##D # You can also provide LnTn values separately via the 'LnTn' argument. -##D # Note, however, that the data frame for 'data' must then NOT contain -##D # a LnTn value. See argument descriptions! -##D LnTn <- data.frame( -##D LnTn = c(1.84833, 2.24833), -##D nTn.error = c(0.17, 0.22)) -##D -##D LxTx <- data[2:nrow(data), ] -##D -##D kars <- calc_Huntley2006( -##D data = LxTx, -##D LnTn = LnTn, -##D rhop = rhop, -##D ddot = ddot, -##D readerDdot = readerDdot, -##D n.MC = 25) -## End(Not run) - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_Huntley2006", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_IEU") -### * calc_IEU - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_IEU -### Title: Apply the internal-external-uncertainty (IEU) model after -### Thomsen et al. (2007) to a given De distribution -### Aliases: calc_IEU - -### ** Examples - - -## load data -data(ExampleData.DeValues, envir = environment()) - -## apply the IEU model -ieu <- calc_IEU(ExampleData.DeValues$CA1, a = 0.2, b = 1.9, interval = 1) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_IEU", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_Kars2008") -### * calc_Kars2008 - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_Kars2008 -### Title: Apply the Kars et al. (2008) model (deprecated) -### Aliases: calc_Kars2008 -### Keywords: datagen - -### ** Examples - - -## Load example data (sample UNIL/NB123, see ?ExampleData.Fading) -data("ExampleData.Fading", envir = environment()) - -## (1) Set all relevant parameters -# a. fading measurement data (IR50) -fading_data <- ExampleData.Fading$fading.data$IR50 - -# b. Dose response curve data -data <- ExampleData.Fading$equivalentDose.data$IR50 - -## (2) Define required function parameters -ddot <- c(7.00, 0.004) -readerDdot <- c(0.134, 0.0067) - -# Analyse fading measurement and get an estimate of rho'. -# Note that the RLum.Results object can be directly used for further processing. -# The number of MC runs is reduced for this example -rhop <- analyse_FadingMeasurement(fading_data, plot = TRUE, verbose = FALSE, n.MC = 10) - -## (3) Apply the Kars et al. (2008) model to the data -kars <- suppressWarnings( - calc_Kars2008(data = data, - rhop = rhop, - ddot = ddot, - readerDdot = readerDdot, - n.MC = 25) -) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_Kars2008", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_Lamothe2003") -### * calc_Lamothe2003 - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_Lamothe2003 -### Title: Apply fading correction after Lamothe et al., 2003 -### Aliases: calc_Lamothe2003 -### Keywords: datagen - -### ** Examples - - -##load data -##ExampleData.BINfileData contains two BINfileData objects -##CWOSL.SAR.Data and TL.SAR.Data -data(ExampleData.BINfileData, envir = environment()) - -##transform the values from the first position in a RLum.Analysis object -object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) - -##perform SAR analysis and set rejection criteria -results <- analyse_SAR.CWOSL( -object = object, -signal.integral.min = 1, -signal.integral.max = 2, -background.integral.min = 900, -background.integral.max = 1000, -verbose = FALSE, -plot = FALSE, -onlyLxTxTable = TRUE -) - -##run fading correction -results_corr <- calc_Lamothe2003( - object = results, - dose_rate.envir = c(1.676 , 0.180), - dose_rate.source = c(0.184, 0.003), - g_value = c(2.36, 0.6), - plot = TRUE, - fit.method = "EXP") - - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_Lamothe2003", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_MaxDose") -### * calc_MaxDose - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_MaxDose -### Title: Apply the maximum age model to a given De distribution -### Aliases: calc_MaxDose - -### ** Examples - - -## load example data -data(ExampleData.DeValues, envir = environment()) - -# apply the maximum dose model -calc_MaxDose(ExampleData.DeValues$CA1, sigmab = 0.2, par = 3) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_MaxDose", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_MinDose") -### * calc_MinDose - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_MinDose -### Title: Apply the (un-)logged minimum age model (MAM) after Galbraith et -### al. (1999) to a given De distribution -### Aliases: calc_MinDose - -### ** Examples - - -## Load example data -data(ExampleData.DeValues, envir = environment()) - -# (1) Apply the minimum age model with minimum required parameters. -# By default, this will apply the un-logged 3-parameter MAM. -calc_MinDose(data = ExampleData.DeValues$CA1, sigmab = 0.1) - -## Not run: -##D # (2) Re-run the model, but save results to a variable and turn -##D # plotting of the log-likelihood profiles off. -##D mam <- calc_MinDose( -##D data = ExampleData.DeValues$CA1, -##D sigmab = 0.1, -##D plot = FALSE) -##D -##D # Show structure of the RLum.Results object -##D mam -##D -##D # Show summary table that contains the most relevant results -##D res <- get_RLum(mam, "summary") -##D res -##D -##D # Plot the log likelihood profiles retroactively, because before -##D # we set plot = FALSE -##D plot_RLum(mam) -##D -##D # Plot the dose distribution in an abanico plot and draw a line -##D # at the minimum dose estimate -##D plot_AbanicoPlot(data = ExampleData.DeValues$CA1, -##D main = "3-parameter Minimum Age Model", -##D line = mam,polygon.col = "none", -##D hist = TRUE, -##D rug = TRUE, -##D summary = c("n", "mean", "mean.weighted", "median", "in.ci"), -##D centrality = res$de, -##D line.col = "red", -##D grid.col = "none", -##D line.label = paste0(round(res$de, 1), "\U00B1", -##D round(res$de_err, 1), " Gy"), -##D bw = 0.1, -##D ylim = c(-25, 18), -##D summary.pos = "topleft", -##D mtext = bquote("Parameters: " ~ -##D sigma[b] == .(get_RLum(mam, "args")$sigmab) ~ ", " ~ -##D gamma == .(round(log(res$de), 1)) ~ ", " ~ -##D sigma == .(round(res$sig, 1)) ~ ", " ~ -##D rho == .(round(res$p0, 2)))) -##D -##D -##D -##D # (3) Run the minimum age model with bootstrap -##D # NOTE: Bootstrapping is computationally intensive -##D # (3.1) run the minimum age model with default values for bootstrapping -##D calc_MinDose(data = ExampleData.DeValues$CA1, -##D sigmab = 0.15, -##D bootstrap = TRUE) -##D -##D # (3.2) Bootstrap control parameters -##D mam <- calc_MinDose(data = ExampleData.DeValues$CA1, -##D sigmab = 0.15, -##D bootstrap = TRUE, -##D bs.M = 300, -##D bs.N = 500, -##D bs.h = 4, -##D sigmab.sd = 0.06, -##D plot = FALSE) -##D -##D # Plot the results -##D plot_RLum(mam) -##D -##D # save bootstrap results in a separate variable -##D bs <- get_RLum(mam, "bootstrap") -##D -##D # show structure of the bootstrap results -##D str(bs, max.level = 2, give.attr = FALSE) -##D -##D # print summary of minimum dose and likelihood pairs -##D summary(bs$pairs$gamma) -##D -##D # Show polynomial fits of the bootstrap pairs -##D bs$poly.fits$poly.three -##D -##D # Plot various statistics of the fit using the generic plot() function -##D par(mfcol=c(2,2)) -##D plot(bs$poly.fits$poly.three, ask = FALSE) -##D -##D # Show the fitted values of the polynomials -##D summary(bs$poly.fits$poly.three$fitted.values) -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_MinDose", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_OSLLxTxRatio") -### * calc_OSLLxTxRatio - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_OSLLxTxRatio -### Title: Calculate 'Lx/Tx' ratio for CW-OSL curves -### Aliases: calc_OSLLxTxRatio -### Keywords: datagen - -### ** Examples - - -##load data -data(ExampleData.LxTxOSLData, envir = environment()) - -##calculate Lx/Tx ratio -results <- calc_OSLLxTxRatio( - Lx.data = Lx.data, - Tx.data = Tx.data, - signal.integral = c(1:2), - background.integral = c(85:100)) - -##get results object -get_RLum(results) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_OSLLxTxRatio", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_SourceDoseRate") -### * calc_SourceDoseRate - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_SourceDoseRate -### Title: Calculation of the source dose rate via the date of measurement -### Aliases: calc_SourceDoseRate -### Keywords: manip - -### ** Examples - - - -##(1) Simple function usage -##Basic calculation of the dose rate for a specific date -dose.rate <- calc_SourceDoseRate(measurement.date = "2012-01-27", - calib.date = "2014-12-19", - calib.dose.rate = 0.0438, - calib.error = 0.0019) - -##show results -get_RLum(dose.rate) - -##(2) Usage in combination with another function (e.g., Second2Gray() ) -## load example data -data(ExampleData.DeValues, envir = environment()) - -## use the calculated variable dose.rate as input argument -## to convert De(s) to De(Gy) -Second2Gray(ExampleData.DeValues$BT998, dose.rate) - -##(3) source rate prediction and plotting -dose.rate <- calc_SourceDoseRate(measurement.date = "2012-01-27", - calib.date = "2014-12-19", - calib.dose.rate = 0.0438, - calib.error = 0.0019, - predict = 1000) -plot_RLum(dose.rate) - - -##(4) export output to a LaTeX table (example using the package 'xtable') -## Not run: -##D xtable::xtable(get_RLum(dose.rate)) -##D -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_SourceDoseRate", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_Statistics") -### * calc_Statistics - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_Statistics -### Title: Function to calculate statistic measures -### Aliases: calc_Statistics -### Keywords: datagen - -### ** Examples - - -## load example data -data(ExampleData.DeValues, envir = environment()) - -## show a rough plot of the data to illustrate the non-normal distribution -plot_KDE(ExampleData.DeValues$BT998) - -## calculate statistics and show output -str(calc_Statistics(ExampleData.DeValues$BT998)) - -## Not run: -##D ## now the same for 10000 normal distributed random numbers with equal errors -##D x <- as.data.frame(cbind(rnorm(n = 10^5, mean = 0, sd = 1), -##D rep(0.001, 10^5))) -##D -##D ## note the congruent results for weighted and unweighted measures -##D str(calc_Statistics(x)) -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_Statistics", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_TLLxTxRatio") -### * calc_TLLxTxRatio - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_TLLxTxRatio -### Title: Calculate the Lx/Tx ratio for a given set of TL curves -beta -### version- -### Aliases: calc_TLLxTxRatio -### Keywords: datagen - -### ** Examples - - -##load package example data -data(ExampleData.BINfileData, envir = environment()) - -##convert Risoe.BINfileData into a curve object -temp <- Risoe.BINfileData2RLum.Analysis(TL.SAR.Data, pos = 3) - - -Lx.data.signal <- get_RLum(temp, record.id=1) -Lx.data.background <- get_RLum(temp, record.id=2) -Tx.data.signal <- get_RLum(temp, record.id=3) -Tx.data.background <- get_RLum(temp, record.id=4) -signal.integral.min <- 210 -signal.integral.max <- 230 - -output <- calc_TLLxTxRatio( - Lx.data.signal, - Lx.data.background, - Tx.data.signal, - Tx.data.background, - signal.integral.min, - signal.integral.max) -get_RLum(output) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_TLLxTxRatio", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_ThermalLifetime") -### * calc_ThermalLifetime - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_ThermalLifetime -### Title: Calculates the Thermal Lifetime using the Arrhenius equation -### Aliases: calc_ThermalLifetime -### Keywords: datagen - -### ** Examples - - -##EXAMPLE 1 -##calculation for two trap-depths with similar frequency factor for different temperatures -E <- c(1.66, 1.70) -s <- 1e+13 -T <- 10:20 -temp <- calc_ThermalLifetime( - E = E, - s = s, - T = T, - output_unit = "Ma" -) -contour(x = E, y = T, z = temp$lifetimes[1,,], - ylab = "Temperature [\u00B0C]", - xlab = "Trap depth [eV]", - main = "Thermal Lifetime Contour Plot" -) -mtext(side = 3, "(values quoted in Ma)") - -##EXAMPLE 2 -##profiling of thermal life time for E and s and their standard error -E <- c(1.600, 0.003) -s <- c(1e+13,1e+011) -T <- 20 -calc_ThermalLifetime( - E = E, - s = s, - T = T, - profiling = TRUE, - output_unit = "Ma" -) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_ThermalLifetime", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_WodaFuchs2008") -### * calc_WodaFuchs2008 - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_WodaFuchs2008 -### Title: Obtain the equivalent dose using the approach by Woda and Fuchs -### 2008 -### Aliases: calc_WodaFuchs2008 - -### ** Examples - - -## read example data set -data(ExampleData.DeValues, envir = environment()) - -results <- calc_WodaFuchs2008( - data = ExampleData.DeValues$CA1, - xlab = expression(paste(D[e], " [Gy]")) - ) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_WodaFuchs2008", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_gSGC") -### * calc_gSGC - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_gSGC -### Title: Calculate De value based on the gSGC by Li et al., 2015 -### Aliases: calc_gSGC -### Keywords: datagen - -### ** Examples - - -results <- calc_gSGC(data = data.frame( -LnTn = 2.361, LnTn.error = 0.087, -Lr1Tr1 = 2.744, Lr1Tr1.error = 0.091, -Dr1 = 34.4)) - -get_RLum(results, data.object = "De") - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_gSGC", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("calc_gSGC_feldspar") -### * calc_gSGC_feldspar - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: calc_gSGC_feldspar -### Title: Calculate Global Standardised Growth Curve (gSGC) for Feldspar -### MET-pIRIR -### Aliases: calc_gSGC_feldspar -### Keywords: datagen - -### ** Examples - - -##test on a generated random sample -n_samples <- 10 -data <- data.frame( - LnTn = rnorm(n=n_samples, mean=1.0, sd=0.02), - LnTn.error = rnorm(n=n_samples, mean=0.05, sd=0.002), - Lr1Tr1 = rnorm(n=n_samples, mean=1.0, sd=0.02), - Lr1Tr1.error = rnorm(n=n_samples, mean=0.05, sd=0.002), - Dr1 = rep(100,n_samples)) - -results <- calc_gSGC_feldspar( - data = data, gSGC.type = "50LxTx", - plot = FALSE) - -plot_AbanicoPlot(results) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("calc_gSGC_feldspar", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("combine_De_Dr") -### * combine_De_Dr - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: combine_De_Dr -### Title: Combine Dose Rate and Equivalent Dose Distribution -### Aliases: combine_De_Dr -### Keywords: datagen distribution dplot - -### ** Examples - -## set parameters -Dr <- stats::rlnorm (1000, 0, 0.3) -De <- 50*sample(Dr, 50, replace = TRUE) -s <- stats::rnorm(50, 10, 2) - -## run modelling -## note: modify parameters for more realistic results -## Not run: -##D results <- combine_De_Dr( -##D Dr = Dr, -##D int_OD = 0.1, -##D De, -##D s, -##D Age_range = c(0,100), -##D method_control = list( -##D n.iter = 100, -##D n.chains = 1)) -##D -##D ## show models used -##D writeLines(results@info$model_IAM) -##D writeLines(results@info$model_BCAM) -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("combine_De_Dr", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("convert_Activity2Concentration") -### * convert_Activity2Concentration - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: convert_Activity2Concentration -### Title: Convert Nuclide Activities to Abundance and Vice Versa -### Aliases: convert_Activity2Concentration -### Keywords: IO - -### ** Examples - - -##construct data.frame -data <- data.frame( - NUCLIDES = c("U-238", "Th-232", "K-40"), - VALUE = c(40,80,100), - VALUE_ERROR = c(4,8,10), - stringsAsFactors = FALSE) - -##perform analysis -convert_Activity2Concentration(data) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("convert_Activity2Concentration", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("convert_BIN2CSV") -### * convert_BIN2CSV - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: convert_BIN2CSV -### Title: Export Risoe BIN-file(s) to CSV-files -### Aliases: convert_BIN2CSV -### Keywords: IO - -### ** Examples - - -##transform Risoe.BINfileData values to a list -data(ExampleData.BINfileData, envir = environment()) -convert_BIN2CSV(subset(CWOSL.SAR.Data, POSITION == 1), export = FALSE) - -## Not run: -##D ##select your BIN-file -##D file <- file.choose() -##D -##D ##convert -##D convert_BIN2CSV(file) -##D -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("convert_BIN2CSV", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("convert_Concentration2DoseRate") -### * convert_Concentration2DoseRate - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: convert_Concentration2DoseRate -### Title: Dose-rate conversion function -### Aliases: convert_Concentration2DoseRate -### Keywords: datagen - -### ** Examples - - -## create input template -input <- convert_Concentration2DoseRate() - -## fill input -input$Mineral <- "FS" -input$K <- 2.13 -input$K_SE <- 0.07 -input$Th <- 9.76 -input$Th_SE <- 0.32 -input$U <- 2.24 -input$U_SE <- 0.12 -input$GrainSize <- 200 -input$WaterContent <- 30 -input$WaterContent_SE <- 5 - -## convert -convert_Concentration2DoseRate(input) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("convert_Concentration2DoseRate", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("convert_Daybreak2CSV") -### * convert_Daybreak2CSV - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: convert_Daybreak2CSV -### Title: Export measurement data produced by a Daybreak luminescence -### reader to CSV-files -### Aliases: convert_Daybreak2CSV -### Keywords: IO - -### ** Examples - - -## Not run: -##D ##select your BIN-file -##D file <- file.choose() -##D -##D ##convert -##D convert_Daybreak2CSV(file) -##D -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("convert_Daybreak2CSV", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("convert_PSL2CSV") -### * convert_PSL2CSV - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: convert_PSL2CSV -### Title: Export PSL-file(s) to CSV-files -### Aliases: convert_PSL2CSV -### Keywords: IO - -### ** Examples - - -## export into single data.frame -file <- system.file("extdata/DorNie_0016.psl", package="Luminescence") -convert_PSL2CSV(file, export = FALSE, single_table = TRUE) - - -## Not run: -##D ##select your BIN-file -##D file <- file.choose() -##D -##D ##convert -##D convert_PSL2CSV(file) -##D -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("convert_PSL2CSV", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("convert_RLum2Risoe.BINfileData") -### * convert_RLum2Risoe.BINfileData - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: convert_RLum2Risoe.BINfileData -### Title: Converts RLum.Analysis-objects and RLum.Data.Curve-objects to -### RLum2Risoe.BINfileData-objects -### Aliases: convert_RLum2Risoe.BINfileData -### Keywords: IO - -### ** Examples - - -##simple conversion using the example dataset -data(ExampleData.RLum.Analysis, envir = environment()) -convert_RLum2Risoe.BINfileData(IRSAR.RF.Data) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("convert_RLum2Risoe.BINfileData", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("convert_SG2MG") -### * convert_SG2MG - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: convert_SG2MG -### Title: Converts Single-Grain Data to Multiple-Grain Data -### Aliases: convert_SG2MG -### Keywords: IO - -### ** Examples - -## simple run -## (please not that the example is not using SG data) -data(ExampleData.BINfileData, envir = environment()) -convert_SG2MG(CWOSL.SAR.Data) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("convert_SG2MG", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("convert_Wavelength2Energy") -### * convert_Wavelength2Energy - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: convert_Wavelength2Energy -### Title: Emission Spectra Conversion from Wavelength to Energy Scales -### (Jacobian Conversion) -### Aliases: convert_Wavelength2Energy -### Keywords: IO - -### ** Examples - - -##=====================## -##(1) Literature example after Mooney et al. (2013) -##(1.1) create matrix -m <- matrix( - data = c(seq(400, 800, 50), rep(1, 9)), ncol = 2) - -##(1.2) set plot function to reproduce the -##literature figure -p <- function(m) { - plot(x = m[, 1], y = m[, 2]) - polygon( - x = c(m[, 1], rev(m[, 1])), - y = c(m[, 2], rep(0, nrow(m)))) - for (i in 1:nrow(m)) { - lines(x = rep(m[i, 1], 2), y = c(0, m[i, 2])) - } -} - -##(1.3) plot curves -par(mfrow = c(1,2)) -p(m) -p(convert_Wavelength2Energy(m)) - -##=====================## -##(2) Another example using density curves -##create dataset -xy <- density( - c(rnorm(n = 100, mean = 500, sd = 20), - rnorm(n = 100, mean = 800, sd = 20))) -xy <- data.frame(xy$x, xy$y) - -##plot -par(mfrow = c(1,2)) -plot( - xy, - type = "l", - xlim = c(150, 1000), - xlab = "Wavelength [nm]", - ylab = "Luminescence [a.u.]" -) -plot( - convert_Wavelength2Energy(xy), - xy$y, - type = "l", - xlim = c(1.23, 8.3), - xlab = "Energy [eV]", - ylab = "Luminescence [a.u.]" -) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("convert_Wavelength2Energy", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -graphics::par(get("par.postscript", pos = 'CheckExEnv')) -cleanEx() -nameEx("convert_XSYG2CSV") -### * convert_XSYG2CSV - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: convert_XSYG2CSV -### Title: Export XSYG-file(s) to CSV-files -### Aliases: convert_XSYG2CSV -### Keywords: IO - -### ** Examples - - -##transform XSYG-file values to a list -data(ExampleData.XSYG, envir = environment()) -convert_XSYG2CSV(OSL.SARMeasurement$Sequence.Object[1:10], export = FALSE) - -## Not run: -##D ##select your BIN-file -##D file <- file.choose() -##D -##D ##convert -##D convert_XSYG2CSV(file) -##D -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("convert_XSYG2CSV", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("extract_IrradiationTimes") -### * extract_IrradiationTimes - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: extract_IrradiationTimes -### Title: Extract Irradiation Times from an XSYG-file -### Aliases: extract_IrradiationTimes -### Keywords: IO manip - -### ** Examples - -## (1) - example for your own data -## -## set files and run function -# -# file.XSYG <- file.choose() -# file.BINX <- file.choose() -# -# output <- extract_IrradiationTimes(file.XSYG = file.XSYG, file.BINX = file.BINX) -# get_RLum(output) -# -## export results additionally to a CSV.file in the same directory as the XSYG-file -# write.table(x = get_RLum(output), -# file = paste0(file.BINX,"_extract_IrradiationTimes.csv"), -# sep = ";", -# row.names = FALSE) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("extract_IrradiationTimes", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("extract_ROI") -### * extract_ROI - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: extract_ROI -### Title: Extract Pixel Values through Circular Region-of-Interests (ROI) -### from an Image -### Aliases: extract_ROI -### Keywords: manip - -### ** Examples - - -m <- matrix(runif(100,0,255), ncol = 10, nrow = 10) -roi <- matrix(c(2.,4,2,5,6,7,3,1,1), ncol = 3) -extract_ROI(object = m, roi = roi, plot = TRUE) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("extract_ROI", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("fit_CWCurve") -### * fit_CWCurve - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: fit_CWCurve -### Title: Nonlinear Least Squares Fit for CW-OSL curves -beta version- -### Aliases: fit_CWCurve -### Keywords: dplot models - -### ** Examples - - -##load data -data(ExampleData.CW_OSL_Curve, envir = environment()) - -##fit data -fit <- fit_CWCurve(values = ExampleData.CW_OSL_Curve, - main = "CW Curve Fit", - n.components.max = 4, - log = "x") - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("fit_CWCurve", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("fit_EmissionSpectra") -### * fit_EmissionSpectra - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: fit_EmissionSpectra -### Title: Luminescence Emission Spectra Deconvolution -### Aliases: fit_EmissionSpectra -### Keywords: datagen - -### ** Examples - - -##load example data -data(ExampleData.XSYG, envir = environment()) - -##subtract background -TL.Spectrum@data <- TL.Spectrum@data[] - TL.Spectrum@data[,15] - -results <- fit_EmissionSpectra( - object = TL.Spectrum, - frame = 5, - method_control = list(max.runs = 10) -) - -##deconvolution of a TL spectrum -## Not run: -##D -##D ##load example data -##D -##D ##replace 0 values -##D results <- fit_EmissionSpectra( -##D object = TL.Spectrum, -##D frame = 5, main = "TL spectrum" -##D ) -##D -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("fit_EmissionSpectra", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("fit_LMCurve") -### * fit_LMCurve - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: fit_LMCurve -### Title: Nonlinear Least Squares Fit for LM-OSL curves -### Aliases: fit_LMCurve -### Keywords: dplot models - -### ** Examples - - -##(1) fit LM data without background subtraction -data(ExampleData.FittingLM, envir = environment()) -fit_LMCurve(values = values.curve, n.components = 3, log = "x") - -##(2) fit LM data with background subtraction and export as JPEG -## -alter file path for your preferred system -##jpeg(file = "~/Desktop/Fit_Output%03d.jpg", quality = 100, -## height = 3000, width = 3000, res = 300) -data(ExampleData.FittingLM, envir = environment()) -fit_LMCurve(values = values.curve, values.bg = values.curveBG, - n.components = 2, log = "x", plot.BG = TRUE) -##dev.off() - -##(3) fit LM data with manual start parameters -data(ExampleData.FittingLM, envir = environment()) -fit_LMCurve(values = values.curve, - values.bg = values.curveBG, - n.components = 3, - log = "x", - start_values = data.frame(Im = c(170,25,400), xm = c(56,200,1500))) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("fit_LMCurve", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("fit_OSLLifeTimes") -### * fit_OSLLifeTimes - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: fit_OSLLifeTimes -### Title: Fitting and Deconvolution of OSL Lifetime Components -### Aliases: fit_OSLLifeTimes - -### ** Examples - - -##load example data -data(ExampleData.TR_OSL, envir = environment()) - -##fit lifetimes (short run) -fit_OSLLifeTimes( - object = ExampleData.TR_OSL, - n.components = 1) - -##long example -## Not run: -##D fit_OSLLifeTimes( -##D object = ExampleData.TR_OSL) -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("fit_OSLLifeTimes", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("fit_SurfaceExposure") -### * fit_SurfaceExposure - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: fit_SurfaceExposure -### Title: Nonlinear Least Squares Fit for OSL surface exposure data -### Aliases: fit_SurfaceExposure -### Keywords: datagen - -### ** Examples - - -## Load example data -data("ExampleData.SurfaceExposure") - -## Example 1 - Single sample -# Known parameters: 10000 a, mu = 0.9, sigmaphi = 5e-10 -sample_1 <- ExampleData.SurfaceExposure$sample_1 -head(sample_1) -results <- fit_SurfaceExposure( - data = sample_1, - mu = 0.9, - sigmaphi = 5e-10) -get_RLum(results) - - -## Example 2 - Single sample and considering dose rate -# Known parameters: 10000 a, mu = 0.9, sigmaphi = 5e-10, -# dose rate = 2.5 Gy/ka, D0 = 40 Gy -sample_2 <- ExampleData.SurfaceExposure$sample_2 -head(sample_2) -results <- fit_SurfaceExposure( - data = sample_2, - mu = 0.9, - sigmaphi = 5e-10, - Ddot = 2.5, - D0 = 40) -get_RLum(results) - -## Example 3 - Multiple samples (global fit) to better constrain 'mu' -# Known parameters: ages = 1e3, 1e4, 1e5, 1e6 a, mu = 0.9, sigmaphi = 5e-10 -set_1 <- ExampleData.SurfaceExposure$set_1 -str(set_1, max.level = 2) -results <- fit_SurfaceExposure( - data = set_1, - age = c(1e3, 1e4, 1e5, 1e6), - sigmaphi = 5e-10) -get_RLum(results) - - -## Example 4 - Multiple samples (global fit) and considering dose rate -# Known parameters: ages = 1e2, 1e3, 1e4, 1e5, 1e6 a, mu = 0.9, sigmaphi = 5e-10, -# dose rate = 1.0 Ga/ka, D0 = 40 Gy -set_2 <- ExampleData.SurfaceExposure$set_2 -str(set_2, max.level = 2) -results <- fit_SurfaceExposure( - data = set_2, - age = c(1e2, 1e3, 1e4, 1e5, 1e6), - sigmaphi = 5e-10, - Ddot = 1, - D0 = 40) -get_RLum(results) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("fit_SurfaceExposure", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("fit_ThermalQuenching") -### * fit_ThermalQuenching - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: fit_ThermalQuenching -### Title: Fitting Thermal Quenching Data -### Aliases: fit_ThermalQuenching - -### ** Examples - - -##create short example dataset -data <- data.frame( - T = c(25, 40, 50, 60, 70, 80, 90, 100, 110), - V = c(0.06, 0.058, 0.052, 0.051, 0.041, 0.034, 0.035, 0.033, 0.032), - V_X = c(0.012, 0.009, 0.008, 0.008, 0.007, 0.006, 0.005, 0.005, 0.004)) - -##fit -fit_ThermalQuenching( - data = data, - n.MC = NULL) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("fit_ThermalQuenching", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("get_Layout") -### * get_Layout - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: get_Layout -### Title: Collection of layout definitions -### Aliases: get_Layout - -### ** Examples - - -## read example data set -data(ExampleData.DeValues, envir = environment()) - -## show structure of the default layout definition -layout.default <- get_Layout(layout = "default") -str(layout.default) - -## show colour definitions for Abanico plot, only -layout.default$abanico$colour - -## set Abanico plot title colour to orange -layout.default$abanico$colour$main <- "orange" - -## create Abanico plot with modofied layout definition -plot_AbanicoPlot(data = ExampleData.DeValues, - layout = layout.default) - -## create Abanico plot with predefined layout "journal" -plot_AbanicoPlot(data = ExampleData.DeValues, - layout = "journal") - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("get_Layout", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("get_Quote") -### * get_Quote - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: get_Quote -### Title: Function to return essential quotes -### Aliases: get_Quote - -### ** Examples - - -## ask for an arbitrary quote -get_Quote() - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("get_Quote", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("get_RLum") -### * get_RLum - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: get_RLum -### Title: General accessors function for RLum S4 class objects -### Aliases: get_RLum get_RLum,list-method get_RLum,NULL-method -### Keywords: utilities - -### ** Examples - - -##Example based using data and from the calc_CentralDose() function - -##load example data -data(ExampleData.DeValues, envir = environment()) - -##apply the central dose model 1st time -temp1 <- calc_CentralDose(ExampleData.DeValues$CA1) - -##get results and store them in a new object -temp.get <- get_RLum(object = temp1) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("get_RLum", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("get_rightAnswer") -### * get_rightAnswer - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: get_rightAnswer -### Title: Function to get the right answer -### Aliases: get_rightAnswer - -### ** Examples - - -## you really want to know? -get_rightAnswer() - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("get_rightAnswer", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("import_Data") -### * import_Data - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: import_Data -### Title: Import Luminescence Data into R -### Aliases: import_Data -### Keywords: datagen - -### ** Examples - - -## import BINX/BIN -file <- system.file("extdata/BINfile_V8.binx", package = "Luminescence") -temp <- import_Data(file) - -## RF data -file <- system.file("extdata", "RF_file.rf", package = "Luminescence") -temp <- import_Data(file) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("import_Data", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("install_DevelopmentVersion") -### * install_DevelopmentVersion - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: install_DevelopmentVersion -### Title: Attempts to install the development version of the -### 'Luminescence' package -### Aliases: install_DevelopmentVersion - -### ** Examples - - -## Not run: -##D install_DevelopmentVersion() -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("install_DevelopmentVersion", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("merge_RLum.Analysis") -### * merge_RLum.Analysis - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: merge_RLum.Analysis -### Title: Merge function for RLum.Analysis S4 class objects -### Aliases: merge_RLum.Analysis -### Keywords: internal utilities - -### ** Examples - - - -##merge different RLum objects from the example data -data(ExampleData.RLum.Analysis, envir = environment()) -data(ExampleData.BINfileData, envir = environment()) - -object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) -curve <- get_RLum(object)[[2]] - -temp.merged <- merge_RLum.Analysis(list(curve, IRSAR.RF.Data, IRSAR.RF.Data)) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("merge_RLum.Analysis", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("merge_RLum.Data.Curve") -### * merge_RLum.Data.Curve - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: merge_RLum.Data.Curve -### Title: Merge function for RLum.Data.Curve S4 class objects -### Aliases: merge_RLum.Data.Curve -### Keywords: internal utilities - -### ** Examples - - - -##load example data -data(ExampleData.XSYG, envir = environment()) - -##grep first and 3d TL curves -TL.curves <- get_RLum(OSL.SARMeasurement$Sequence.Object, recordType = "TL (UVVIS)") -TL.curve.1 <- TL.curves[[1]] -TL.curve.3 <- TL.curves[[3]] - -##plot single curves -plot_RLum(TL.curve.1) -plot_RLum(TL.curve.3) - -##subtract the 1st curve from the 2nd and plot -TL.curve.merged <- merge_RLum.Data.Curve(list(TL.curve.3, TL.curve.1), merge.method = "/") -plot_RLum(TL.curve.merged) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("merge_RLum.Data.Curve", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("merge_RLum") -### * merge_RLum - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: merge_RLum -### Title: General merge function for RLum S4 class objects -### Aliases: merge_RLum -### Keywords: utilities - -### ** Examples - - - -##Example based using data and from the calc_CentralDose() function - -##load example data -data(ExampleData.DeValues, envir = environment()) - -##apply the central dose model 1st time -temp1 <- calc_CentralDose(ExampleData.DeValues$CA1) - -##apply the central dose model 2nd time -temp2 <- calc_CentralDose(ExampleData.DeValues$CA1) - -##merge the results and store them in a new object -temp.merged <- get_RLum(merge_RLum(objects = list(temp1, temp2))) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("merge_RLum", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("merge_Risoe.BINfileData") -### * merge_Risoe.BINfileData - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: merge_Risoe.BINfileData -### Title: Merge Risoe.BINfileData objects or Risoe BIN-files -### Aliases: merge_Risoe.BINfileData -### Keywords: IO manip - -### ** Examples - - -##merge two objects -data(ExampleData.BINfileData, envir = environment()) - -object1 <- CWOSL.SAR.Data -object2 <- CWOSL.SAR.Data - -object.new <- merge_Risoe.BINfileData(c(object1, object2)) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("merge_Risoe.BINfileData", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("methods_RLum") -### * methods_RLum - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: methods_RLum -### Title: methods_RLum -### Aliases: methods_RLum plot.list plot.RLum.Results plot.RLum.Analysis -### plot.RLum.Data.Curve plot.RLum.Data.Spectrum plot.RLum.Data.Image -### plot.Risoe.BINfileData hist.RLum.Results hist.RLum.Data.Image -### hist.RLum.Data.Curve hist.RLum.Analysis summary.RLum.Results -### summary.RLum.Analysis summary.RLum.Data.Image summary.RLum.Data.Curve -### subset.Risoe.BINfileData subset.RLum.Analysis bin bin.RLum.Data.Curve -### bin.RLum.Data.Spectrum length.RLum.Results length.RLum.Analysis -### length.RLum.Data.Curve length.Risoe.BINfileData dim.RLum.Data.Curve -### dim.RLum.Data.Spectrum rep.RLum names.RLum.Data.Curve -### names.RLum.Data.Spectrum names.RLum.Data.Image names.RLum.Analysis -### names.RLum.Results names.Risoe.BINfileData -### row.names.RLum.Data.Spectrum as.data.frame.RLum.Data.Curve -### as.data.frame.RLum.Data.Spectrum as.data.frame.Risoe.BINfileData -### as.list.RLum.Results as.list.RLum.Data.Curve as.list.RLum.Data.Image -### as.list.RLum.Analysis as.matrix.RLum.Data.Curve -### as.matrix.RLum.Data.Spectrum as.matrix.RLum.Data.Image is.RLum -### is.RLum.Data is.RLum.Data.Curve is.RLum.Data.Spectrum -### is.RLum.Data.Image is.RLum.Analysis is.RLum.Results merge.RLum -### unlist.RLum.Analysis +.RLum.Data.Curve -.RLum.Data.Curve -### *.RLum.Data.Curve /.RLum.Data.Curve [.RLum.Data.Curve -### [.RLum.Data.Spectrum [.RLum.Data.Image [.RLum.Analysis [.RLum.Results -### [<-.RLum.Data.Curve [[.RLum.Analysis [[.RLum.Results -### $.RLum.Data.Curve $.RLum.Analysis $.RLum.Results -### Keywords: internal - -### ** Examples - - -##load example data -data(ExampleData.RLum.Analysis, envir = environment()) - - -##combine curve is various ways -curve1 <- IRSAR.RF.Data[[1]] -curve2 <- IRSAR.RF.Data[[1]] -curve1 + curve2 -curve1 - curve2 -curve1 / curve2 -curve1 * curve2 - - -##`$` access curves -IRSAR.RF.Data$RF - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("methods_RLum", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("plot_AbanicoPlot") -### * plot_AbanicoPlot - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: plot_AbanicoPlot -### Title: Function to create an Abanico Plot. -### Aliases: plot_AbanicoPlot - -### ** Examples - - -## load example data and recalculate to Gray -data(ExampleData.DeValues, envir = environment()) -ExampleData.DeValues <- ExampleData.DeValues$CA1 - -## plot the example data straightforward -plot_AbanicoPlot(data = ExampleData.DeValues) - -## now with linear z-scale -plot_AbanicoPlot(data = ExampleData.DeValues, - log.z = FALSE) - -## now with output of the plot parameters -plot1 <- plot_AbanicoPlot(data = ExampleData.DeValues, - output = TRUE) -str(plot1) -plot1$zlim - -## now with adjusted z-scale limits -plot_AbanicoPlot(data = ExampleData.DeValues, - zlim = c(10, 200)) - -## now with adjusted x-scale limits -plot_AbanicoPlot(data = ExampleData.DeValues, - xlim = c(0, 20)) - -## now with rug to indicate individual values in KDE part -plot_AbanicoPlot(data = ExampleData.DeValues, - rug = TRUE) - -## now with a smaller bandwidth for the KDE plot -plot_AbanicoPlot(data = ExampleData.DeValues, - bw = 0.04) - -## now with a histogram instead of the KDE plot -plot_AbanicoPlot(data = ExampleData.DeValues, - hist = TRUE, - kde = FALSE) - -## now with a KDE plot and histogram with manual number of bins -plot_AbanicoPlot(data = ExampleData.DeValues, - hist = TRUE, - breaks = 20) - -## now with a KDE plot and a dot plot -plot_AbanicoPlot(data = ExampleData.DeValues, - dots = TRUE) - -## now with user-defined plot ratio -plot_AbanicoPlot(data = ExampleData.DeValues, - plot.ratio = 0.5) -## now with user-defined central value -plot_AbanicoPlot(data = ExampleData.DeValues, - z.0 = 70) - -## now with median as central value -plot_AbanicoPlot(data = ExampleData.DeValues, - z.0 = "median") - -## now with the 17-83 percentile range as definition of scatter -plot_AbanicoPlot(data = ExampleData.DeValues, - z.0 = "median", - dispersion = "p17") - -## now with user-defined green line for minimum age model -CAM <- calc_CentralDose(ExampleData.DeValues, - plot = FALSE) - -plot_AbanicoPlot(data = ExampleData.DeValues, - line = CAM, - line.col = "darkgreen", - line.label = "CAM") - -## now create plot with legend, colour, different points and smaller scale -plot_AbanicoPlot(data = ExampleData.DeValues, - legend = "Sample 1", - col = "tomato4", - bar.col = "peachpuff", - pch = "R", - cex = 0.8) - -## now without 2-sigma bar, polygon, grid lines and central value line -plot_AbanicoPlot(data = ExampleData.DeValues, - bar.col = FALSE, - polygon.col = FALSE, - grid.col = FALSE, - y.axis = FALSE, - lwd = 0) - -## now with direct display of De errors, without 2-sigma bar -plot_AbanicoPlot(data = ExampleData.DeValues, - bar.col = FALSE, - ylab = "", - y.axis = FALSE, - error.bars = TRUE) - -## now with user-defined axes labels -plot_AbanicoPlot(data = ExampleData.DeValues, - xlab = c("Data error (%)", - "Data precision"), - ylab = "Scatter", - zlab = "Equivalent dose [Gy]") - -## now with minimum, maximum and median value indicated -plot_AbanicoPlot(data = ExampleData.DeValues, - stats = c("min", "max", "median")) - -## now with a brief statistical summary as subheader -plot_AbanicoPlot(data = ExampleData.DeValues, - summary = c("n", "in.2s")) - -## now with another statistical summary -plot_AbanicoPlot(data = ExampleData.DeValues, - summary = c("mean.weighted", "median"), - summary.pos = "topleft") - -## now a plot with two 2-sigma bars for one data set -plot_AbanicoPlot(data = ExampleData.DeValues, - bar = c(30, 100)) - -## now the data set is split into sub-groups, one is manipulated -data.1 <- ExampleData.DeValues[1:30,] -data.2 <- ExampleData.DeValues[31:62,] * 1.3 - -## now a common dataset is created from the two subgroups -data.3 <- list(data.1, data.2) - -## now the two data sets are plotted in one plot -plot_AbanicoPlot(data = data.3) - -## now with some graphical modification -plot_AbanicoPlot(data = data.3, - z.0 = "median", - col = c("steelblue4", "orange4"), - bar.col = c("steelblue3", "orange3"), - polygon.col = c("steelblue1", "orange1"), - pch = c(2, 6), - angle = c(30, 50), - summary = c("n", "in.2s", "median")) - -## create Abanico plot with predefined layout definition -plot_AbanicoPlot(data = ExampleData.DeValues, - layout = "journal") - -## now with predefined layout definition and further modifications -plot_AbanicoPlot( - data = data.3, - z.0 = "median", - layout = "journal", - col = c("steelblue4", "orange4"), - bar.col = adjustcolor(c("steelblue3", "orange3"), - alpha.f = 0.5), - polygon.col = c("steelblue3", "orange3")) - -## for further information on layout definitions see documentation -## of function get_Layout() - -## now with manually added plot content -## create empty plot with numeric output -AP <- plot_AbanicoPlot(data = ExampleData.DeValues, - pch = NA, - output = TRUE) - -## identify data in 2 sigma range -in_2sigma <- AP$data[[1]]$data.in.2s - -## restore function-internal plot parameters -par(AP$par) - -## add points inside 2-sigma range -points(x = AP$data[[1]]$precision[in_2sigma], - y = AP$data[[1]]$std.estimate.plot[in_2sigma], - pch = 16) - -## add points outside 2-sigma range -points(x = AP$data[[1]]$precision[!in_2sigma], - y = AP$data[[1]]$std.estimate.plot[!in_2sigma], - pch = 1) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("plot_AbanicoPlot", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -graphics::par(get("par.postscript", pos = 'CheckExEnv')) -cleanEx() -nameEx("plot_DRCSummary") -### * plot_DRCSummary - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: plot_DRCSummary -### Title: Create a Dose-Response Curve Summary Plot -### Aliases: plot_DRCSummary - -### ** Examples - - -#load data example data -data(ExampleData.BINfileData, envir = environment()) - -#transform the values from the first position in a RLum.Analysis object -object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) - -results <- analyse_SAR.CWOSL( - object = object, - signal.integral.min = 1, - signal.integral.max = 2, - background.integral.min = 900, - background.integral.max = 1000, - plot = FALSE - ) - -##plot only DRC -plot_DRCSummary(results) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("plot_DRCSummary", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("plot_DRTResults") -### * plot_DRTResults - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: plot_DRTResults -### Title: Visualise dose recovery test results -### Aliases: plot_DRTResults -### Keywords: dplot - -### ** Examples - - -## read example data set and misapply them for this plot type -data(ExampleData.DeValues, envir = environment()) - -## plot values -plot_DRTResults( - values = ExampleData.DeValues$BT998[7:11,], - given.dose = 2800, - mtext = "Example data") - -## plot values with legend -plot_DRTResults( - values = ExampleData.DeValues$BT998[7:11,], - given.dose = 2800, - legend = "Test data set") - -## create and plot two subsets with randomised values -x.1 <- ExampleData.DeValues$BT998[7:11,] -x.2 <- ExampleData.DeValues$BT998[7:11,] * c(runif(5, 0.9, 1.1), 1) - -plot_DRTResults( - values = list(x.1, x.2), - given.dose = 2800) - -## some more user-defined plot parameters -plot_DRTResults( - values = list(x.1, x.2), - given.dose = 2800, - pch = c(2, 5), - col = c("orange", "blue"), - xlim = c(0, 8), - ylim = c(0.85, 1.15), - xlab = "Sample aliquot") - -## plot the data with user-defined statistical measures as legend -plot_DRTResults( - values = list(x.1, x.2), - given.dose = 2800, - summary = c("n", "weighted$mean", "sd.abs")) - -## plot the data with user-defined statistical measures as sub-header -plot_DRTResults( - values = list(x.1, x.2), - given.dose = 2800, - summary = c("n", "weighted$mean", "sd.abs"), - summary.pos = "sub") - -## plot the data grouped by preheat temperatures -plot_DRTResults( - values = ExampleData.DeValues$BT998[7:11,], - given.dose = 2800, - preheat = c(200, 200, 200, 240, 240)) - -## read example data set and misapply them for this plot type -data(ExampleData.DeValues, envir = environment()) - -## plot values -plot_DRTResults( - values = ExampleData.DeValues$BT998[7:11,], - given.dose = 2800, - mtext = "Example data") - -## plot two data sets grouped by preheat temperatures -plot_DRTResults( - values = list(x.1, x.2), - given.dose = 2800, - preheat = c(200, 200, 200, 240, 240)) - -## plot the data grouped by preheat temperatures as boxplots -plot_DRTResults( - values = ExampleData.DeValues$BT998[7:11,], - given.dose = 2800, - preheat = c(200, 200, 200, 240, 240), - boxplot = TRUE) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("plot_DRTResults", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("plot_DetPlot") -### * plot_DetPlot - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: plot_DetPlot -### Title: Create De(t) plot -### Aliases: plot_DetPlot - -### ** Examples - - -## Not run: -##D ##load data -##D ##ExampleData.BINfileData contains two BINfileData objects -##D ##CWOSL.SAR.Data and TL.SAR.Data -##D data(ExampleData.BINfileData, envir = environment()) -##D -##D ##transform the values from the first position in a RLum.Analysis object -##D object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) -##D -##D plot_DetPlot( -##D object, -##D signal.integral.min = 1, -##D signal.integral.max = 3, -##D background.integral.min = 900, -##D background.integral.max = 1000, -##D n.channels = 5) -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("plot_DetPlot", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("plot_FilterCombinations") -### * plot_FilterCombinations - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: plot_FilterCombinations -### Title: Plot filter combinations along with the (optional) net -### transmission window -### Aliases: plot_FilterCombinations -### Keywords: aplot datagen - -### ** Examples - - -## (For legal reasons no real filter data are provided) - -## Create filter sets -filter1 <- density(rnorm(100, mean = 450, sd = 20)) -filter1 <- matrix(c(filter1$x, filter1$y/max(filter1$y)), ncol = 2) -filter2 <- matrix(c(200:799,rep(c(0,0.8,0),each = 200)), ncol = 2) - -## Example 1 (standard) -plot_FilterCombinations(filters = list(filter1, filter2)) - -## Example 2 (with d and P value and name for filter 2) -results <- plot_FilterCombinations( -filters = list(filter_1 = filter1, Rectangle = list(filter2, d = 2, P = 0.6))) -results - -## Example 3 show optical density -plot(results$OD_total) - -## Not run: -##D ##Example 4 -##D ##show the filters using the interactive mode -##D plot_FilterCombinations(filters = list(filter1, filter2), interactive = TRUE) -##D -## End(Not run) - - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("plot_FilterCombinations", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("plot_GrowthCurve") -### * plot_GrowthCurve - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: plot_GrowthCurve -### Title: Fit and plot a dose-response curve for luminescence data (Lx/Tx -### against dose) -### Aliases: plot_GrowthCurve - -### ** Examples - - -##(1) plot growth curve for a dummy data.set and show De value -data(ExampleData.LxTxData, envir = environment()) -temp <- plot_GrowthCurve(LxTxData) -get_RLum(temp) - -##(1b) horizontal plot arrangement -layout(mat = matrix(c(1,1,2,3), ncol = 2)) -plot_GrowthCurve(LxTxData, output.plotExtended.single = TRUE) - -##(1c) to access the fitting value try -get_RLum(temp, data.object = "Fit") - -##(2) plot the growth curve only - uncomment to use -##pdf(file = "~/Desktop/Growth_Curve_Dummy.pdf", paper = "special") -plot_GrowthCurve(LxTxData) -##dev.off() - -##(3) plot growth curve with pdf output - uncomment to use, single output -##pdf(file = "~/Desktop/Growth_Curve_Dummy.pdf", paper = "special") -plot_GrowthCurve(LxTxData, output.plotExtended.single = TRUE) -##dev.off() - -##(4) plot resulting function for given interval x -x <- seq(1,10000, by = 100) -plot( - x = x, - y = eval(temp$Formula), - type = "l" -) - -##(5) plot using the 'extrapolation' mode -LxTxData[1,2:3] <- c(0.5, 0.001) -print(plot_GrowthCurve(LxTxData,mode = "extrapolation")) - -##(6) plot using the 'alternate' mode -LxTxData[1,2:3] <- c(0.5, 0.001) -print(plot_GrowthCurve(LxTxData,mode = "alternate")) - -##(7) import and fit test data set by Berger & Huntley 1989 -QNL84_2_unbleached <- -read.table(system.file("extdata/QNL84_2_unbleached.txt", package = "Luminescence")) - -results <- plot_GrowthCurve( - QNL84_2_unbleached, - mode = "extrapolation", - plot = FALSE, - verbose = FALSE) - -#calculate confidence interval for the parameters -#as alternative error estimation -confint(results$Fit, level = 0.68) - - -## Not run: -##D QNL84_2_bleached <- -##D read.table(system.file("extdata/QNL84_2_bleached.txt", package = "Luminescence")) -##D STRB87_1_unbleached <- -##D read.table(system.file("extdata/STRB87_1_unbleached.txt", package = "Luminescence")) -##D STRB87_1_bleached <- -##D read.table(system.file("extdata/STRB87_1_bleached.txt", package = "Luminescence")) -##D -##D print( -##D plot_GrowthCurve( -##D QNL84_2_bleached, -##D mode = "alternate", -##D plot = FALSE, -##D verbose = FALSE)$Fit) -##D -##D print( -##D plot_GrowthCurve( -##D STRB87_1_unbleached, -##D mode = "alternate", -##D plot = FALSE, -##D verbose = FALSE)$Fit) -##D -##D print( -##D plot_GrowthCurve( -##D STRB87_1_bleached, -##D mode = "alternate", -##D plot = FALSE, -##D verbose = FALSE)$Fit) -##D -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("plot_GrowthCurve", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("plot_Histogram") -### * plot_Histogram - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: plot_Histogram -### Title: Plot a histogram with separate error plot -### Aliases: plot_Histogram - -### ** Examples - - -## load data -data(ExampleData.DeValues, envir = environment()) -ExampleData.DeValues <- - Second2Gray(ExampleData.DeValues$BT998, dose.rate = c(0.0438,0.0019)) - -## plot histogram the easiest way -plot_Histogram(ExampleData.DeValues) - -## plot histogram with some more modifications -plot_Histogram(ExampleData.DeValues, - rug = TRUE, - normal_curve = TRUE, - cex.global = 0.9, - pch = 2, - colour = c("grey", "black", "blue", "green"), - summary = c("n", "mean", "sdrel"), - summary.pos = "topleft", - main = "Histogram of De-values", - mtext = "Example data set", - ylab = c(expression(paste(D[e], " distribution")), - "Standard error"), - xlim = c(100, 250), - ylim = c(0, 0.1, 5, 20)) - - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("plot_Histogram", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("plot_KDE") -### * plot_KDE - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: plot_KDE -### Title: Plot kernel density estimate with statistics -### Aliases: plot_KDE - -### ** Examples - - -## read example data set -data(ExampleData.DeValues, envir = environment()) -ExampleData.DeValues <- - Second2Gray(ExampleData.DeValues$BT998, c(0.0438,0.0019)) - -## create plot straightforward -plot_KDE(data = ExampleData.DeValues) - -## create plot with logarithmic x-axis -plot_KDE(data = ExampleData.DeValues, - log = "x") - -## create plot with user-defined labels and axes limits -plot_KDE(data = ExampleData.DeValues, - main = "Dose distribution", - xlab = "Dose (s)", - ylab = c("KDE estimate", "Cumulative dose value"), - xlim = c(100, 250), - ylim = c(0, 0.08, 0, 30)) - -## create plot with boxplot option -plot_KDE(data = ExampleData.DeValues, - boxplot = TRUE) - -## create plot with statistical summary below header -plot_KDE(data = ExampleData.DeValues, - summary = c("n", "median", "skewness", "in.2s")) - -## create plot with statistical summary as legend -plot_KDE(data = ExampleData.DeValues, - summary = c("n", "mean", "sd.rel", "se.abs"), - summary.pos = "topleft") - -## split data set into sub-groups, one is manipulated, and merge again -data.1 <- ExampleData.DeValues[1:15,] -data.2 <- ExampleData.DeValues[16:25,] * 1.3 -data.3 <- list(data.1, data.2) - -## create plot with two subsets straightforward -plot_KDE(data = data.3) - -## create plot with two subsets and summary legend at user coordinates -plot_KDE(data = data.3, - summary = c("n", "median", "skewness"), - summary.pos = c(110, 0.07), - col = c("blue", "orange")) - -## example of how to use the numerical output of the function -## return plot output to draw a thicker KDE line -KDE_out <- plot_KDE(data = ExampleData.DeValues, -output = TRUE) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("plot_KDE", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("plot_NRt") -### * plot_NRt - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: plot_NRt -### Title: Visualise natural/regenerated signal ratios -### Aliases: plot_NRt - -### ** Examples - - -## load example data -data("ExampleData.BINfileData", envir = environment()) - -## EXAMPLE 1 - -## convert Risoe.BINfileData object to RLum.Analysis object -data <- Risoe.BINfileData2RLum.Analysis(object = CWOSL.SAR.Data, pos = 8, ltype = "OSL") - -## extract all OSL curves -allCurves <- get_RLum(data) - -## keep only the natural and regenerated signal curves -pos <- seq(1, 9, 2) -curves <- allCurves[pos] - -## plot a standard NR(t) plot -plot_NRt(curves) - -## re-plot with rolling mean data smoothing -plot_NRt(curves, smooth = "rmean", k = 10) - -## re-plot with a logarithmic x-axis -plot_NRt(curves, log = "x", smooth = "rmean", k = 5) - -## re-plot with custom axes ranges -plot_NRt(curves, smooth = "rmean", k = 5, - xlim = c(0.1, 5), ylim = c(0.4, 1.6), - legend.pos = "bottomleft") - -## re-plot with smoothing spline on log scale -plot_NRt(curves, smooth = "spline", log = "x", - legend.pos = "top") - -## EXAMPLE 2 - -# you may also use this function to check whether all -# TD curves follow the same shape (making it a TnTx(t) plot). -posTD <- seq(2, 14, 2) -curves <- allCurves[posTD] - -plot_NRt(curves, main = "TnTx(t) Plot", - smooth = "rmean", k = 20, - ylab = "TD natural / TD regenerated", - xlim = c(0, 20), legend = FALSE) - -## EXAMPLE 3 - -# extract data from all positions -data <- lapply(1:24, FUN = function(pos) { - Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = pos, ltype = "OSL") -}) - -# get individual curve data from each aliquot -aliquot <- lapply(data, get_RLum) - -# set graphical parameters -par(mfrow = c(2, 2)) - -# create NR(t) plots for all aliquots -for (i in 1:length(aliquot)) { - plot_NRt(aliquot[[i]][pos], - main = paste0("Aliquot #", i), - smooth = "rmean", k = 20, - xlim = c(0, 10), - cex = 0.6, legend.pos = "bottomleft") -} - -# reset graphical parameters -par(mfrow = c(1, 1)) - - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("plot_NRt", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -graphics::par(get("par.postscript", pos = 'CheckExEnv')) -cleanEx() -nameEx("plot_OSLAgeSummary") -### * plot_OSLAgeSummary - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: plot_OSLAgeSummary -### Title: Plot Posterior OSL-Age Summary -### Aliases: plot_OSLAgeSummary -### Keywords: dplot hplot - -### ** Examples - -##generate random data -set.seed(1234) -object <- rnorm(1000, 100, 10) -plot_OSLAgeSummary(object) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("plot_OSLAgeSummary", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("plot_RLum.Analysis") -### * plot_RLum.Analysis - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: plot_RLum.Analysis -### Title: Plot function for an RLum.Analysis S4 class object -### Aliases: plot_RLum.Analysis -### Keywords: aplot - -### ** Examples - - -##load data -data(ExampleData.BINfileData, envir = environment()) - -##convert values for position 1 -temp <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1) - -##(1) plot (combine) TL curves in one plot -plot_RLum.Analysis( -temp, -subset = list(recordType = "TL"), -combine = TRUE, -norm = TRUE, -abline = list(v = c(110)) -) - -##(2) same as example (1) but using -## the argument smooth = TRUE -plot_RLum.Analysis( -temp, -subset = list(recordType = "TL"), -combine = TRUE, -norm = TRUE, -smooth = TRUE, -abline = list(v = c(110)) -) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("plot_RLum.Analysis", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("plot_RLum.Data.Curve") -### * plot_RLum.Data.Curve - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: plot_RLum.Data.Curve -### Title: Plot function for an RLum.Data.Curve S4 class object -### Aliases: plot_RLum.Data.Curve -### Keywords: aplot - -### ** Examples - - -##plot curve data - -#load Example data -data(ExampleData.CW_OSL_Curve, envir = environment()) - -#transform data.frame to RLum.Data.Curve object -temp <- as(ExampleData.CW_OSL_Curve, "RLum.Data.Curve") - -#plot RLum.Data.Curve object -plot_RLum.Data.Curve(temp) - - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("plot_RLum.Data.Curve", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("plot_RLum.Data.Image") -### * plot_RLum.Data.Image - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: plot_RLum.Data.Image -### Title: Plot function for an 'RLum.Data.Image' S4 class object -### Aliases: plot_RLum.Data.Image -### Keywords: aplot - -### ** Examples - - -##load data -data(ExampleData.RLum.Data.Image, envir = environment()) - -##plot data -plot_RLum.Data.Image(ExampleData.RLum.Data.Image) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("plot_RLum.Data.Image", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("plot_RLum.Data.Spectrum") -### * plot_RLum.Data.Spectrum - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: plot_RLum.Data.Spectrum -### Title: Plot function for an RLum.Data.Spectrum S4 class object -### Aliases: plot_RLum.Data.Spectrum -### Keywords: aplot - -### ** Examples - - -##load example data -data(ExampleData.XSYG, envir = environment()) - -##(1)plot simple spectrum (2D) - image -plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type="image", - xlim = c(310,750), - ylim = c(0,300), - bin.rows=10, - bin.cols = 1) - -##(2) plot spectrum (3D) -plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type="persp", - xlim = c(310,750), - ylim = c(0,100), - bin.rows=10, - bin.cols = 1) - -##(3) plot spectrum on energy axis -##please note the background subtraction -plot_RLum.Data.Spectrum(TL.Spectrum, -plot.type="persp", -ylim = c(0,200), -bin.rows=10, -bg.channels = 10, -bin.cols = 1, -xaxis.energy = TRUE) - -##(4) plot multiple lines (2D) - multiple.lines (with ylim) -plot_RLum.Data.Spectrum( - TL.Spectrum, - plot.type="multiple.lines", - xlim = c(310,750), - ylim = c(0,100), - bin.rows=10, - bin.cols = 1) - -## Not run: -##D ##(4) interactive plot using the package plotly ("surface") -##D plot_RLum.Data.Spectrum(TL.Spectrum, plot.type="interactive", -##D xlim = c(310,750), ylim = c(0,300), bin.rows=10, -##D bin.cols = 1) -##D -##D ##(5) interactive plot using the package plotly ("contour") -##D plot_RLum.Data.Spectrum(TL.Spectrum, plot.type="interactive", -##D xlim = c(310,750), ylim = c(0,300), bin.rows=10, -##D bin.cols = 1, -##D type = "contour", -##D showscale = TRUE) -##D -##D ##(6) interactive plot using the package plotly ("heatmap") -##D plot_RLum.Data.Spectrum(TL.Spectrum, plot.type="interactive", -##D xlim = c(310,750), ylim = c(0,300), bin.rows=10, -##D bin.cols = 1, -##D type = "heatmap", -##D showscale = TRUE) -##D -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("plot_RLum.Data.Spectrum", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("plot_RLum") -### * plot_RLum - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: plot_RLum -### Title: General plot function for RLum S4 class objects -### Aliases: plot_RLum -### Keywords: dplot - -### ** Examples - -#load Example data -data(ExampleData.CW_OSL_Curve, envir = environment()) - -#transform data.frame to RLum.Data.Curve object -temp <- as(ExampleData.CW_OSL_Curve, "RLum.Data.Curve") - -#plot RLum object -plot_RLum(temp) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("plot_RLum", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("plot_RLum.Results") -### * plot_RLum.Results - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: plot_RLum.Results -### Title: Plot function for an RLum.Results S4 class object -### Aliases: plot_RLum.Results -### Keywords: aplot - -### ** Examples - - - -###load data -data(ExampleData.DeValues, envir = environment()) - -# apply the un-logged minimum age model -mam <- calc_MinDose(data = ExampleData.DeValues$CA1, sigmab = 0.2, log = TRUE, plot = FALSE) - -##plot -plot_RLum.Results(mam) - -# estimate the number of grains on an aliquot -grains<- calc_AliquotSize(grain.size = c(100,150), sample.diameter = 1, plot = FALSE, MC.iter = 100) - -##plot -plot_RLum.Results(grains) - - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("plot_RLum.Results", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("plot_ROI") -### * plot_ROI - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: plot_ROI -### Title: Create Regions of Interest (ROI) Graphic -### Aliases: plot_ROI -### Keywords: datagen plot - -### ** Examples - - -## simple example -file <- system.file("extdata", "RF_file.rf", package = "Luminescence") -temp <- read_RF2R(file) -plot_ROI(temp) - -## in combination with extract_ROI() -m <- matrix(runif(100,0,255), ncol = 10, nrow = 10) -roi <- matrix(c(2.,4,2,5,6,7,3,1,1), ncol = 3) -t <- extract_ROI(object = m, roi = roi) -plot_ROI(t, bg_image = m) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("plot_ROI", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("plot_RadialPlot") -### * plot_RadialPlot - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: plot_RadialPlot -### Title: Function to create a Radial Plot -### Aliases: plot_RadialPlot - -### ** Examples - - -## load example data -data(ExampleData.DeValues, envir = environment()) -ExampleData.DeValues <- Second2Gray( - ExampleData.DeValues$BT998, c(0.0438,0.0019)) - -## plot the example data straightforward -plot_RadialPlot(data = ExampleData.DeValues) - -## now with linear z-scale -plot_RadialPlot( - data = ExampleData.DeValues, - log.z = FALSE) - -## now with output of the plot parameters -plot1 <- plot_RadialPlot( - data = ExampleData.DeValues, - log.z = FALSE, - output = TRUE) -plot1 -plot1$zlim - -## now with adjusted z-scale limits -plot_RadialPlot( - data = ExampleData.DeValues, - log.z = FALSE, - xlim = c(0, 5), - zlim = c(100, 200)) - -## now the two plots with serious but seasonally changing fun -#plot_RadialPlot(data = data.3, fun = TRUE) - -## now with user-defined central value, in log-scale again -plot_RadialPlot( - data = ExampleData.DeValues, - central.value = 150) - -## now with a rug, indicating individual De values at the z-scale -plot_RadialPlot( - data = ExampleData.DeValues, - rug = TRUE) - -## now with legend, colour, different points and smaller scale -plot_RadialPlot( - data = ExampleData.DeValues, - legend.text = "Sample 1", - col = "tomato4", - bar.col = "peachpuff", - pch = "R", - cex = 0.8) - -## now without 2-sigma bar, y-axis, grid lines and central value line -plot_RadialPlot( - data = ExampleData.DeValues, - bar.col = "none", - grid.col = "none", - y.ticks = FALSE, - lwd = 0) - -## now with user-defined axes labels -plot_RadialPlot( - data = ExampleData.DeValues, - xlab = c("Data error (%)", "Data precision"), - ylab = "Scatter", - zlab = "Equivalent dose [Gy]") - -## now with minimum, maximum and median value indicated -plot_RadialPlot( - data = ExampleData.DeValues, - central.value = 150, - stats = c("min", "max", "median")) - -## now with a brief statistical summary -plot_RadialPlot( - data = ExampleData.DeValues, - summary = c("n", "in.2s")) - -## now with another statistical summary as subheader -plot_RadialPlot( - data = ExampleData.DeValues, - summary = c("mean.weighted", "median"), - summary.pos = "sub") - -## now the data set is split into sub-groups, one is manipulated -data.1 <- ExampleData.DeValues[1:15,] -data.2 <- ExampleData.DeValues[16:25,] * 1.3 - -## now a common dataset is created from the two subgroups -data.3 <- list(data.1, data.2) - -## now the two data sets are plotted in one plot -plot_RadialPlot(data = data.3) - -## now with some graphical modification -plot_RadialPlot( - data = data.3, - col = c("darkblue", "darkgreen"), - bar.col = c("lightblue", "lightgreen"), - pch = c(2, 6), - summary = c("n", "in.2s"), - summary.pos = "sub", - legend = c("Sample 1", "Sample 2")) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("plot_RadialPlot", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("plot_Risoe.BINfileData") -### * plot_Risoe.BINfileData - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: plot_Risoe.BINfileData -### Title: Plot single luminescence curves from a BIN file object -### Aliases: plot_Risoe.BINfileData -### Keywords: dplot - -### ** Examples - - -##load data -data(ExampleData.BINfileData, envir = environment()) - -##plot all curves from the first position to the desktop -#pdf(file = "~/Desktop/CurveOutput.pdf", paper = "a4", height = 11, onefile = TRUE) - -##example - load from *.bin file -#BINfile<- file.choose() -#BINfileData<-read_BIN2R(BINfile) - -#par(mfrow = c(4,3), oma = c(0.5,1,0.5,1)) -#plot_Risoe.BINfileData(CWOSL.SAR.Data,position = 1) -#mtext(side = 4, BINfile, outer = TRUE, col = "blue", cex = .7) -#dev.off() - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("plot_Risoe.BINfileData", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("plot_ViolinPlot") -### * plot_ViolinPlot - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: plot_ViolinPlot -### Title: Create a violin plot -### Aliases: plot_ViolinPlot - -### ** Examples - - -## read example data set -data(ExampleData.DeValues, envir = environment()) -ExampleData.DeValues <- Second2Gray(ExampleData.DeValues$BT998, c(0.0438,0.0019)) - -## create plot straightforward -plot_ViolinPlot(data = ExampleData.DeValues) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("plot_ViolinPlot", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("read_BIN2R") -### * read_BIN2R - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: read_BIN2R -### Title: Import Risø BIN/BINX-files into R -### Aliases: read_BIN2R -### Keywords: IO - -### ** Examples - - -file <- system.file("extdata/BINfile_V8.binx", package = "Luminescence") -temp <- read_BIN2R(file) -temp - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("read_BIN2R", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("read_Daybreak2R") -### * read_Daybreak2R - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: read_Daybreak2R -### Title: Import measurement data produced by a Daybreak TL/OSL reader -### into R -### Aliases: read_Daybreak2R -### Keywords: IO - -### ** Examples - - -## Not run: -##D file <- system.file("extdata/Daybreak_TestFile.txt", package = "Luminescence") -##D temp <- read_Daybreak2R(file) -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("read_Daybreak2R", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("read_HeliosOSL2R") -### * read_HeliosOSL2R - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: read_HeliosOSL2R -### Title: Import Luminescence Data from Helios Luminescence Reader -### Aliases: read_HeliosOSL2R -### Keywords: IO - -### ** Examples - -file <- system.file("extdata/HeliosOSL_Example.osl", package = "Luminescence") -read_HeliosOSL2R(file) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("read_HeliosOSL2R", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("read_PSL2R") -### * read_PSL2R - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: read_PSL2R -### Title: Import PSL files to R -### Aliases: read_PSL2R -### Keywords: IO - -### ** Examples - - -# (1) Import PSL file to R - -file <- system.file("extdata", "DorNie_0016.psl", package = "Luminescence") -psl <- read_PSL2R(file, drop_bg = FALSE, as_decay_curve = TRUE, smooth = TRUE, merge = FALSE) -print(str(psl, max.level = 3)) -plot(psl, combine = TRUE) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("read_PSL2R", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("read_RF2R") -### * read_RF2R - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: read_RF2R -### Title: Import RF-files to R -### Aliases: read_RF2R -### Keywords: IO - -### ** Examples - - -##Import -file <- system.file("extdata", "RF_file.rf", package = "Luminescence") -temp <- read_RF2R(file) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("read_RF2R", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("read_SPE2R") -### * read_SPE2R - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: read_SPE2R -### Title: Import Princeton Instruments (TM) SPE-file into R -### Aliases: read_SPE2R -### Keywords: IO - -### ** Examples - - -## to run examples uncomment lines and run the code - -##(1) Import data as RLum.Data.Spectrum object -#file <- file.choose() -#temp <- read_SPE2R(file) -#temp - -##(2) Import data as RLum.Data.Image object -#file <- file.choose() -#temp <- read_SPE2R(file, output.object = "RLum.Data.Image") -#temp - -##(3) Import data as matrix object -#file <- file.choose() -#temp <- read_SPE2R(file, output.object = "matrix") -#temp - -##(4) Export raw data to csv, if temp is a RLum.Data.Spectrum object -# write.table(x = get_RLum(temp), -# file = "[your path and filename]", -# sep = ";", row.names = FALSE) - - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("read_SPE2R", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("read_TIFF2R") -### * read_TIFF2R - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: read_TIFF2R -### Title: Import TIFF Image Data into R -### Aliases: read_TIFF2R -### Keywords: IO - -### ** Examples - - -## Not run: -##D file <- file.choose() -##D image <- read_TIFF2R(file) -##D -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("read_TIFF2R", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("read_XSYG2R") -### * read_XSYG2R - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: read_XSYG2R -### Title: Import XSYG files to R -### Aliases: read_XSYG2R -### Keywords: IO - -### ** Examples - - -##(1) import XSYG file to R (uncomment for usage) - -#FILE <- file.choose() -#temp <- read_XSYG2R(FILE) - -##(2) additional examples for pure XML import using the package XML -## (uncomment for usage) - - ##import entire XML file - #FILE <- file.choose() - #temp <- XML::xmlRoot(XML::xmlTreeParse(FILE)) - - ##search for specific subnodes with curves containing 'OSL' - #getNodeSet(temp, "//Sample/Sequence/Record[@recordType = 'OSL']/Curve") - -##(2) How to extract single curves ... after import -data(ExampleData.XSYG, envir = environment()) - -##grep one OSL curves and plot the first curve -OSLcurve <- get_RLum(OSL.SARMeasurement$Sequence.Object, recordType="OSL")[[1]] - -##(3) How to see the structure of an object? -structure_RLum(OSL.SARMeasurement$Sequence.Object) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("read_XSYG2R", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("report_RLum") -### * report_RLum - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: report_RLum -### Title: Create a HTML-report for (RLum) objects -### Aliases: report_RLum - -### ** Examples - - -## Not run: -##D ## Example: RLum.Results ---- -##D -##D # load example data -##D data("ExampleData.DeValues") -##D -##D # apply the MAM-3 age model and save results -##D mam <- calc_MinDose(ExampleData.DeValues$CA1, sigmab = 0.2) -##D -##D # create the HTML report -##D report_RLum(object = mam, file = "~/CA1_MAM.Rmd", -##D timestamp = FALSE, -##D title = "MAM-3 for sample CA1") -##D -##D # when creating a report the input file is automatically saved to a -##D # .Rds file (see saveRDS()). -##D mam_report <- readRDS("~/CA1_MAM.Rds") -##D all.equal(mam, mam_report) -##D -##D -##D ## Example: Temporary file & Viewer/Browser ---- -##D -##D # (a) -##D # Specifying a filename is not necessarily required. If no filename is provided, -##D # the report is rendered in a temporary file. If you use the RStudio IDE, the -##D # temporary report is shown in the interactive Viewer pane. -##D report_RLum(object = mam) -##D -##D # (b) -##D # Additionally, you can view the HTML report in your system's default web browser. -##D report_RLum(object = mam, launch.browser = TRUE) -##D -##D -##D ## Example: RLum.Analysis ---- -##D -##D data("ExampleData.RLum.Analysis") -##D -##D # create the HTML report (note that specifying a file -##D # extension is not necessary) -##D report_RLum(object = IRSAR.RF.Data, file = "~/IRSAR_RF") -##D -##D -##D ## Example: RLum.Data.Curve ---- -##D -##D data.curve <- get_RLum(IRSAR.RF.Data)[[1]] -##D -##D # create the HTML report -##D report_RLum(object = data.curve, file = "~/Data_Curve") -##D -##D ## Example: Any other object ---- -##D x <- list(x = 1:10, -##D y = runif(10, -5, 5), -##D z = data.frame(a = LETTERS[1:20], b = dnorm(0:9)), -##D NA) -##D -##D report_RLum(object = x, file = "~/arbitray_list") -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("report_RLum", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("sTeve") -### * sTeve - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: sTeve -### Title: sTeve - sophisticated tool for efficient data validation and -### evaluation -### Aliases: sTeve -### Keywords: manip - -### ** Examples - - -##no example available - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("sTeve", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("scale_GammaDose") -### * scale_GammaDose - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: scale_GammaDose -### Title: Calculate the gamma dose deposited within a sample taking -### layer-to-layer variations in radioactivity into account (according to -### Aitken, 1985) -### Aliases: scale_GammaDose -### Keywords: datagen - -### ** Examples - - -# Load example data -data("ExampleData.ScaleGammaDose", envir = environment()) -x <- ExampleData.ScaleGammaDose - -# Scale gamma dose rate -results <- scale_GammaDose(data = x, - conversion_factors = "Cresswelletal2018", - fractional_gamma_dose = "Aitken1985", - verbose = TRUE, - plot = TRUE) - -get_RLum(results) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("scale_GammaDose", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("set_RLum") -### * set_RLum - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: set_RLum -### Title: General set function for RLum S4 class objects -### Aliases: set_RLum -### Keywords: utilities - -### ** Examples - - -##produce empty objects from each class -set_RLum(class = "RLum.Data.Curve") -set_RLum(class = "RLum.Data.Spectrum") -set_RLum(class = "RLum.Data.Spectrum") -set_RLum(class = "RLum.Analysis") -set_RLum(class = "RLum.Results") - -##produce a curve object with arbitrary curve values -object <- set_RLum( -class = "RLum.Data.Curve", -curveType = "arbitrary", -recordType = "OSL", -data = matrix(c(1:100,exp(-c(1:100))),ncol = 2)) - -##plot this curve object -plot_RLum(object) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("set_RLum", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("smooth_RLum") -### * smooth_RLum - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: smooth_RLum -### Title: Smoothing of data -### Aliases: smooth_RLum smooth_RLum,list-method -### Keywords: utilities - -### ** Examples - - -##load example data -data(ExampleData.CW_OSL_Curve, envir = environment()) - -##create RLum.Data.Curve object from this example -curve <- - set_RLum( - class = "RLum.Data.Curve", - recordType = "OSL", - data = as.matrix(ExampleData.CW_OSL_Curve) - ) - -##plot data without and with smoothing -plot_RLum(curve) -plot_RLum(smooth_RLum(curve)) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("smooth_RLum", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("structure_RLum") -### * structure_RLum - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: structure_RLum -### Title: General structure function for RLum S4 class objects -### Aliases: structure_RLum structure_RLum,list-method -### Keywords: utilities - -### ** Examples - - -##load example data -data(ExampleData.XSYG, envir = environment()) - -##show structure -structure_RLum(OSL.SARMeasurement$Sequence.Object) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("structure_RLum", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("subset_SingleGrainData") -### * subset_SingleGrainData - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: subset_SingleGrainData -### Title: Simple Subsetting of Single Grain Data from Risø BIN/BINX files -### Aliases: subset_SingleGrainData -### Keywords: datagen manip - -### ** Examples - - -## load example data -data(ExampleData.BINfileData, envir = environment()) - -## set POSITION/GRAIN pair dataset -selection <- data.frame(POSITION = c(1,5,7), GRAIN = c(0,0,0)) - -##subset -subset_SingleGrainData(object = CWOSL.SAR.Data, selection = selection) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("subset_SingleGrainData", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("template_DRAC") -### * template_DRAC - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: template_DRAC -### Title: Create a DRAC input data template (v1.2) -### Aliases: template_DRAC - -### ** Examples - - -# create a new DRAC input input -input <- template_DRAC(preset = "DRAC-example_quartz") - -# show content of the input -print(input) -print(input$`Project ID`) -print(input[[4]]) - - -## Example: DRAC Quartz example -# note that you only have to assign new values where they -# are different to the default values -input$`Project ID` <- "DRAC-Example" -input$`Sample ID` <- "Quartz" -input$`Conversion factors` <- "AdamiecAitken1998" -input$`External U (ppm)` <- 3.4 -input$`errExternal U (ppm)` <- 0.51 -input$`External Th (ppm)` <- 14.47 -input$`errExternal Th (ppm)` <- 1.69 -input$`External K (%)` <- 1.2 -input$`errExternal K (%)` <- 0.14 -input$`Calculate external Rb from K conc?` <- "N" -input$`Calculate internal Rb from K conc?` <- "N" -input$`Scale gammadoserate at shallow depths?` <- "N" -input$`Grain size min (microns)` <- 90 -input$`Grain size max (microns)` <- 125 -input$`Water content ((wet weight - dry weight)/dry weight) %` <- 5 -input$`errWater content %` <- 2 -input$`Depth (m)` <- 2.2 -input$`errDepth (m)` <- 0.22 -input$`Overburden density (g cm-3)` <- 1.8 -input$`errOverburden density (g cm-3)` <- 0.1 -input$`Latitude (decimal degrees)` <- 30.0000 -input$`Longitude (decimal degrees)` <- 70.0000 -input$`Altitude (m)` <- 150 -input$`De (Gy)` <- 20 -input$`errDe (Gy)` <- 0.2 - -# use DRAC -## Not run: -##D output <- use_DRAC(input) -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("template_DRAC", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("trim_RLum.Data") -### * trim_RLum.Data - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: trim_RLum.Data -### Title: Trim Channels of RLum.Data-class Objects -### Aliases: trim_RLum.Data -### Keywords: manip - -### ** Examples - -## trim all TL curves in the object to channels 10 to 20 -data(ExampleData.BINfileData, envir = environment()) -temp <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = 1) - -c <- trim_RLum.Data( -object = temp, -recordType = "TL", -trim_range = c(10,20)) - -plot_RLum.Analysis( -object = c, -combine = TRUE, -subset = list(recordType = "TL")) - -## simulate a situation where one OSL curve -## in the dataset has only 999 channels instead of 1000 -## all curves should be limited to 999 -temp@records[[2]]@data <- temp@records[[2]]@data[-nrow(temp[[2]]@data),] - -c <- trim_RLum.Data(object = temp) -nrow(c@records[[4]]@data) - - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("trim_RLum.Data", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("tune_Data") -### * tune_Data - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: tune_Data -### Title: Tune data for experimental purpose -### Aliases: tune_Data -### Keywords: manip - -### ** Examples - - -## load example data set -data(ExampleData.DeValues, envir = environment()) -x <- ExampleData.DeValues$CA1 - -## plot original data -plot_AbanicoPlot(data = x, - summary = c("n", "mean")) - -## decrease error by 10 % -plot_AbanicoPlot(data = tune_Data(x, decrease.error = 0.1), - summary = c("n", "mean")) - -## increase sample size by 200 % -#plot_AbanicoPlot(data = tune_Data(x, increase.data = 2) , -# summary = c("n", "mean")) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("tune_Data", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("use_DRAC") -### * use_DRAC - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: use_DRAC -### Title: Use DRAC to calculate dose rate data -### Aliases: use_DRAC - -### ** Examples - - -## (1) Method using the DRAC spreadsheet - -file <- "/PATH/TO/DRAC_Input_Template.csv" - -# send the actual IO template spreadsheet to DRAC -## Not run: -##D use_DRAC(file = file) -## End(Not run) - - - -## (2) Method using an R template object - -# Create a template -input <- template_DRAC(preset = "DRAC-example_quartz") - -# Fill the template with values -input$`Project ID` <- "DRAC-Example" -input$`Sample ID` <- "Quartz" -input$`Conversion factors` <- "AdamiecAitken1998" -input$`External U (ppm)` <- 3.4 -input$`errExternal U (ppm)` <- 0.51 -input$`External Th (ppm)` <- 14.47 -input$`errExternal Th (ppm)` <- 1.69 -input$`External K (%)` <- 1.2 -input$`errExternal K (%)` <- 0.14 -input$`Calculate external Rb from K conc?` <- "N" -input$`Calculate internal Rb from K conc?` <- "N" -input$`Scale gammadoserate at shallow depths?` <- "N" -input$`Grain size min (microns)` <- 90 -input$`Grain size max (microns)` <- 125 -input$`Water content ((wet weight - dry weight)/dry weight) %` <- 5 -input$`errWater content %` <- 2 -input$`Depth (m)` <- 2.2 -input$`errDepth (m)` <- 0.22 -input$`Overburden density (g cm-3)` <- 1.8 -input$`errOverburden density (g cm-3)` <- 0.1 -input$`Latitude (decimal degrees)` <- 30.0000 -input$`Longitude (decimal degrees)` <- 70.0000 -input$`Altitude (m)` <- 150 -input$`De (Gy)` <- 20 -input$`errDe (Gy)` <- 0.2 - -# use DRAC -## Not run: -##D output <- use_DRAC(input) -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("use_DRAC", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("verify_SingleGrainData") -### * verify_SingleGrainData - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: verify_SingleGrainData -### Title: Verify single grain data sets and check for invalid grains, i.e. -### zero-light level grains -### Aliases: verify_SingleGrainData -### Keywords: datagen manip - -### ** Examples - - -##01 - basic example I -##just show how to apply the function -data(ExampleData.XSYG, envir = environment()) - -##verify and get data.frame out of it -verify_SingleGrainData(OSL.SARMeasurement$Sequence.Object)$selection_full - -##02 - basic example II -data(ExampleData.BINfileData, envir = environment()) -id <- verify_SingleGrainData(object = CWOSL.SAR.Data, -cleanup_level = "aliquot")$selection_id - -## Not run: -##D ##03 - advanced example I -##D ##importing and exporting a BIN-file -##D -##D ##select and import file -##D file <- file.choose() -##D object <- read_BIN2R(file) -##D -##D ##remove invalid aliquots(!) -##D object <- verify_SingleGrainData(object, cleanup = TRUE) -##D -##D ##export to new BIN-file -##D write_R2BIN(object, paste0(dirname(file),"/", basename(file), "_CLEANED.BIN")) -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("verify_SingleGrainData", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("write_R2BIN") -### * write_R2BIN - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: write_R2BIN -### Title: Export Risoe.BINfileData into Risø BIN/BINX-file -### Aliases: write_R2BIN -### Keywords: IO - -### ** Examples - -##load example dataset -file <- system.file("extdata/BINfile_V8.binx", package = "Luminescence") -temp <- read_BIN2R(file) - -##create temporary file path -##(for usage replace by own path) -temp_file <- tempfile(pattern = "output", fileext = ".binx") - -##export to temporary file path -write_R2BIN(temp, file = temp_file) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("write_R2BIN", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("write_R2TIFF") -### * write_R2TIFF - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: write_R2TIFF -### Title: Export RLum.Data.Image and RLum.Data.Spectrum objects to TIFF -### Images -### Aliases: write_R2TIFF -### Keywords: IO - -### ** Examples - -data(ExampleData.RLum.Data.Image, envir = environment()) -write_R2TIFF(ExampleData.RLum.Data.Image, file = tempfile()) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("write_R2TIFF", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -cleanEx() -nameEx("write_RLum2CSV") -### * write_RLum2CSV - -flush(stderr()); flush(stdout()) - -base::assign(".ptime", proc.time(), pos = "CheckExEnv") -### Name: write_RLum2CSV -### Title: Export RLum-objects to CSV -### Aliases: write_RLum2CSV -### Keywords: IO - -### ** Examples - - -##transform values to a list (and do not write) -data(ExampleData.BINfileData, envir = environment()) -object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data)[[1]] -write_RLum2CSV(object, export = FALSE) - -## Not run: -##D -##D ##create temporary filepath -##D ##(for usage replace by own path) -##D temp_file <- tempfile(pattern = "output", fileext = ".csv") -##D -##D ##write CSV-file to working directory -##D write_RLum2CSV(temp_file) -##D -## End(Not run) - - - - -base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -base::cat("write_RLum2CSV", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") -### *